#!/usr/bin/perl
package Mubot4FB;
+
use strict;
+use utf8;
+
use Facebook::Graph;
use Bot::BasicBot;
use base 'Bot::BasicBot';
use Encode;
+use DBI;
+use Data::Dumper;
-use utf8;
+
+my $mu_re = qr/^([^ ]+) (https?:\/\/[^ ]+) (.+)$/i;
sub fb_init {
my ($me) = @_;
return $me->{fbo} = Facebook::Graph->new(access_token => $page_access_token);
}
+sub db_init {
+ my ($me) = @_;
+ $me->{dbh} = DBI->connect('dbi:SQLite:dbname='.$me->{cfg}->{database}) || die $DBI::errstr;
+}
+
sub publish {
my ($me, $text, $uri) = @_;
sub init {
my ($me) = @_;
$me->fb_init();
+ $me->db_init();
}
+sub _check_dup {
+ my ($me, $uri) = @_;
-sub said {
- my ($me, $args) = @_;
+};
- my ($resp, $resp_msg);
+
+sub _response {
+ my ($me, $args, $msg) = @_;
+
+ $me->say(channel => $args->{channel},
+ body => $msg);
+}
+
+sub _add {
+ my ($me, $args) =@_;
my $post_ok = 1;
+ my ($resp, $resp_msg);
- my $text = $args->{who} . ' ' . $args->{body};
- my $uri = 'http://hanzubon.jp/';
+ if ($args->{body} =~ /$mu_re/) {
+ my $text = $args->{who} . '曰く、' . $1 . ' ' . $3;
+ my $uri = $2;
- eval{$resp = $me->publish($text, $uri)};
- if ($@) {
- $me->fb_init();
eval{$resp = $me->publish($text, $uri)};
- $post_ok = 0 if ($@);
+ if ($@) {
+ $me->fb_init();
+ eval{$resp = $me->publish($text, $uri)};
+ $post_ok = 0 if ($@);
+ }
+
+ if ($post_ok) {
+ my (undef, $post_id) = split(/_/, $resp->{id});
+ $resp_msg = 'うい: ' . $me->{cfg}->{fb_page_url} . 'posts/' . $post_id .' で登録';
+ } else {
+ $resp_msg = 'can not post to facebook';
+ }
+
+ return $resp_msg;
}
+ return 0;
+}
+
+sub _delete_prev {
+ my ($me, $args) = @_;
- if ($post_ok) {
- my (undef, $post_id) = split(/_/, $resp->{id});
- $resp_msg = 'うい: ' . $me->{cfg}->{fb_page_url} . 'posts/' . $post_id .' で登録';
- } else {
- $resp_msg = 'can not post to facebook';
+ return _not_yet();
+}
+
+sub _delete_id {
+ my ($me, $args) = @_;
+
+ return _not_yet();
+}
+
+sub _delete {
+ my ($me, $id) =@_;
+
+ return _not_yet();
+}
+
+sub _search {
+ my ($me, $id) =@_;
+
+ return _not_yet();
+}
+
+sub _not_yet {
+ return 'まだ実装してないです';
+}
+
+sub said {
+ my ($me, $args) = @_;
+ my $resp_msg;
+
+ if ($args->{body} =~ /$mu_re/) {
+ $resp_msg = $me->_add($args) unless ($1 eq 'deb');
+ } elsif ($args->{body} =~ /^ふみくん (.+)/) {
+ my $cmd = $1;
+ if ($cmd eq 'いまのなし') {
+ $resp_msg = $me->_delete_prev($args);
+ } elsif ($cmd =~ /削除 ([0-9]+)$/) {
+ $resp_msg = $me->_delete($args, $1);
+ } elsif ($cmd =~ /\?$/) {
+ $resp_msg = $me->_search($args);
+ } elsif ($cmd =~ /つぎ/) {
+ $resp_msg = $me->_search_next($args);
+ }
}
- $me->say(channel => $args->{channel},
- body => $resp_msg);
+ $me->_response($args, $resp_msg) if ($resp_msg);
}
package main;
use utf8;
use Config::Simple;
+use File::Path;
my $config_name = $ARGV[0] || 'not_found';
$cfg{irc_nick} ||= 'mubot4fb';
$cfg{irc_name}||= $cfg{irc_nick};
$cfg{irc_charset} ||= 'utf-8';
+$cfg{database} ||= $ENV{HOME} . '/.mubot4fb/data/' . $config_name . '.sqlite';
my $bot = Mubot4FB->new(server => $cfg{'irc_server'},
port => $cfg{'irc_port'},