# Copyright (c) 2012 ISHIKAWA Mutsumi <ishikawa@hanzubon.jp>
# This program is covered by the GNU General Public License 2
#
-package Mubot4FB;
-
+package Mubot4FB::FB;
use strict;
use utf8;
-use base 'Bot::BasicBot';
use Facebook::Graph;
use LWP::UserAgent;
use HTTP::Request::Common;
-use DBI qw/:sql_types/;
-use POSIX 'strftime';
use Data::Dumper;
-my $mu_re = qr/^([^\s]+)\s+((?:https?|ftps?):\/\/[^\s]+)\s+(.+)$/i;
-my $irc_type = 1;
+sub new {
+ my $proto = shift;
+ my $class = ref $proto || $proto;
+ my $self = {cfg => shift};
+ bless $self, $class;
+
+ $self->init();
+ return $self;
+}
-sub fb_init {
+sub init {
my ($me) = @_;
my $fb = Facebook::Graph->new(app_id => $me->{cfg}->{fb_app_id},
secret => $me->{cfg}->{fb_app_secret},
return $me->{fbo} = Facebook::Graph->new(access_token => $page_access_token);
}
+sub publish {
+ my ($me, $text, $uri) = @_;
+
+ return $me->{fbo}->add_post($me->{cfg}->{fb_page_id})
+ ->set_message($text)
+ ->set_link_uri($uri)
+ ->publish()
+ ->as_hashref();
+}
+
+sub post_uri {
+ my ($me, $post_id) = @_;
+
+ return $me->{cfg}->{fb_page_url} . 'posts/' . $post_id;
+}
+
+sub remove {
+ my ($me, $post_id) = @_;
+
+ my $uri = $me->{fbo}->query->find($post_id)->uri_as_string;
+ my $req = HTTP::Request::Common::DELETE($uri);
+ warn Dumper($req) if ($me->{cfg}->{debug});
+ my $resp;
+ $resp = LWP::UserAgent->new->request($req);
+ warn Dumper($resp) if ($me->{cfg}->{debug});
+ if ($resp->is_success && $resp->code == 200 && $resp->content eq 'true') {
+ return 1;
+ } else {
+ warn 'DELETE ERROR: http code: ' . $resp->code() . ' , http content: ' . $resp->content;
+ return 0;
+ }
+}
+
+1;
+package Mubot4FB;
+
+use strict;
+use utf8;
+
+use base 'Bot::BasicBot';
+use DBI qw/:sql_types/;
+use POSIX 'strftime';
+
+use Data::Dumper;
+
+my $mu_re = qr/^([^\s]+)\s+((?:https?|ftps?):\/\/[^\s]+)\s+(.+)$/i;
+my $irc_type = 1;
+
sub db_init {
my ($me) = @_;
$me->{dbh} = DBI->connect('DBI:mysql:'.$me->{cfg}->{database}, $me->{cfg}->{db_user}, $me->{cfg}->{db_pass},{mysql_enable_utf8 => 1}) || die $DBI::errstr;
$me->{last_search} = {};
}
-sub publish {
- my ($me, $text, $uri) = @_;
-
- return $me->{fbo}->add_post($me->{cfg}->{fb_page_id})
- ->set_message($text)
- ->set_link_uri($uri)
- ->publish()
- ->as_hashref();
-}
-
sub init {
my ($me) = @_;
- $me->fb_init();
+ $me->{fb} = Mubot4FB::FB->new($me->{cfg});
$me->db_init();
}
-sub _check_dup {
- my ($me, $args, $uri) = @_;
-
- my $found = 0;
-
+sub _db_check_dup {
+ my ($me, $db_args) = @_;
my $sth = $me->{dbh}->prepare('select * from posts where uri = ? order by post_time desc limit 1');
- my $rv = $sth->execute($uri);
- my $res = $sth->fetchrow_hashref;
- if ($res) {
- if ($res->{post_time} < time() - 7 * 24 * 60 * 60) {
- $me->_response($args, 'だいぶ前 '.$me->_format_submit($res).'にいってたにゃー '.$me->_fb_post_uri($res->{fb_post_id}));
- } else {
- $me->_response($args, '既に '.$me->_format_submit($res).'に言ってますよ? '.$me->{cfg}->{fb_page_url}.'posts/'.$res->{fb_post_id});
- $found = 1;
- }
- }
- $sth->finish;
+ my $rv = $sth->execute($db_args->{uri});
+ my $ret = $sth->fetchrow_hashref;
- return $found;
-};
+ $sth->finish;
+ return $ret;
+}
sub _db_insert {
my ($me, $db_args) = @_;
my ($scheme, $path) = split(/:\/\//, $db_args->{uri});
- my $sth = $me->{dbh}->prepare("insert into posts (submitter, fb_post_id, uri, prefix, suffix, scheme, path, post_time) values (?, ?, ?, ?, ?, ?, ?, ?)");
+ my $sth = $me->{dbh}->prepare("insert into posts (submitter, fb_post_id, uri, prefix, comment, scheme, path, post_time) values (?, ?, ?, ?, ?, ?, ?, ?)");
$sth->bind_param(1, $db_args->{submitter}, SQL_VARCHAR);
$sth->bind_param(2, $db_args->{fb_post_id}, SQL_BIGINT);
$sth->bind_param(3, $db_args->{uri}, SQL_VARCHAR);
$sth->bind_param(4, $db_args->{prefix}, SQL_VARCHAR);
- $sth->bind_param(5, $db_args->{suffix}, SQL_VARCHAR);
+ $sth->bind_param(5, $db_args->{comment}, SQL_VARCHAR);
$sth->bind_param(6, $scheme, SQL_VARCHAR);
$sth->bind_param(7, $path, SQL_VARCHAR);
$sth->bind_param(8, time, SQL_BIGINT);
}
sub _db_search {
- my ($me, $word) = @_;
+ my ($me, $db_args) = @_;
- my $column = $word =~ /:\/\// ? 'uri' : 'path';
- my $w = '%' . $word . '%';
- my $sth = $me->{dbh}->prepare('select * from posts where prefix like ? or '.$column.' like ? or suffix like ? order by post_time desc limit 1000');
+ my $column = $db_args->{word} =~ /:\/\// ? 'uri' : 'path';
+ my $w = '%' . $db_args->{word} . '%';
+ my $sth = $me->{dbh}->prepare('select * from posts where prefix like ? or '.$column.' like ? or comment like ? order by post_time desc limit 1000');
$sth->bind_param(1, $w, SQL_VARCHAR);
$sth->bind_param(2, $w, SQL_VARCHAR);
$sth->bind_param(3, $w, SQL_VARCHAR);
}
sub _db_search_lastpost {
- my ($me, $who) = @_;
+ my ($me, $db_args) = @_;
my $sth = $me->{dbh}->prepare('select * from posts where submitter = ? order by post_time desc limit 1');
- $sth->bind_param(1, $who, SQL_VARCHAR);
+ $sth->bind_param(1, $db_args->{who}, SQL_VARCHAR);
$sth->execute();
my $ret = $sth->fetchrow_hashref();
return $ret;
}
-sub _fb_post_uri {
- my ($me, $post_id) = @_;
-
- return $me->{cfg}->{fb_page_url} . 'posts/' . $post_id;
-}
-
-sub _fb_delete {
- my ($me, $post_id) = @_;
-
- my $req = HTTP::Request::Common::DELETE($me->_fb_post_uri($post_id));
- $req->header('Content-Length', 0);
- my $resp;
- eval{$resp = LWP::UserAgent->new->request($req)};
- return !$@;
-}
-
sub _format_submit {
my ($me, $e) = @_;
- return $e->{submitter}.'が『'.$e->{prefix}.' '.$e->{uri}.' '.$e->{suffix}.'』と'.strftime('%Y-%m-%d %H:%M:%S', localtime($e->{post_time}));
+ return $e->{submitter}.'が『'.$e->{prefix}.' '.$e->{uri}.' '.$e->{comment}.'』と'.strftime('%Y-%m-%d %H:%M:%S', localtime($e->{post_time}));
}
sub _response {
sub _add {
my ($me, $args) =@_;
- my $post_ok = 1;
my ($resp, $resp_msg);
if ($args->{body} =~ /$mu_re/) {
my $prefix = $1;
my $uri = $2;
- my $suffix = $3;
- my $text = $args->{who} . '曰く、'.$prefix.' '.$suffix;
-
- return 0 if ($me->_check_dup($args, $uri));
-
- eval{$resp = $me->publish($text, $uri)};
- if ($@) {
- $me->fb_init();
- eval{$resp = $me->publish($text, $uri)};
- $post_ok = 0 if ($@);
- }
-
- if ($post_ok) {
- my (undef, $post_id) = split(/_/, $resp->{id});
- $me->_db_insert({submitter => $args->{who},
- fb_post_id => $post_id,
- uri => $uri,
- prefix => $prefix,
- suffix => $suffix});
- $resp_msg = $args->{who} . ': うい '.$me->_fb_post_uri($post_id).' で登録';
+ my $comment = $3;
+ my $text = $args->{who} . '曰く、'.$prefix.' '.$comment;
+
+ if (my $res = $me->_db_check_dup({uri =>$uri})) {
+ if ($res->{post_time} < time() - 7 * 24 * 60 * 60) {
+ $resp_msg = 'だいぶ前 '.$me->_format_submit($res).'にいってたにゃー '.$me->{fb}->post_uri($res->{fb_post_id});
+ } else {
+ $resp_msg = '既に '.$me->_format_submit($res).'に言ってますよ? '.$me->{fb}->post_uri($res->{fb_post_id});
+ }
} else {
- $resp_msg = 'can not post to facebook';
- }
+ my $post_ok = 1;
+ eval{$resp = $me->{fb}->publish($text, $uri)};
+ if ($@) {
+ $me->fb_init();
+ eval{$resp = $me->{fb}->publish($text, $uri)};
+ $post_ok = 0 if ($@);
+ }
+ if ($post_ok) {
+ my (undef, $post_id) = split(/_/, $resp->{id});
+ $me->_db_insert({submitter => $args->{who},
+ fb_post_id => $post_id,
+ uri => $uri,
+ prefix => $prefix,
+ comment => $comment});
+ $resp_msg = $args->{who} . ': うい '.$me->{fb}->post_uri($post_id).' で登録';
+ } else {
+ $resp_msg = 'can not post to facebook';
+ }
+ }
return $resp_msg;
}
return 0;
sub _delete_prev {
my ($me, $args) = @_;
- my $last_post = $me->_db_search_lastpost($args->{who});
+ my $last_post = $me->_db_search_lastpost({who => $args->{who}});
if (!defined $last_post) {
return $args->{who}.': いまのっていつの? というか ないし';
} elsif ($last_post->{post_time} < time() - 3600) {
- return $args->{who}.': いまのっていつの? 最後のはこれだけど古いんだにゃ ' . $me->_fb_post_uri($last_post->{fb_post_id});
+ return $args->{who}.': いまのっていつの? 最後のはこれだけど古いんだにゃ ' . $me->{fb}->post_uri($last_post->{fb_post_id});
} else {
return $me->_delete($args, $last_post->{'fb_post_id'});
}
$me->{dbh}->begin_work;
if ($resp = $me->_db_delete({fb_post_id => $post_id, submitter => $args->{who}})) {
# fb 側のエントリを削除しないといけない
- if ($me->_fb_delete($post_id)) {
+ if ($me->{fb}->remove($post_id)) {
$me->{dbh}->commit;
- $resp_msg = $args->{who} . ': 削除しました ' . $me->_fb_post_uri($post_id);
+ $resp_msg = $args->{who} . ': 削除しました ' . $me->{fb}->post_uri($post_id);
} else {
- $resp_msg = $args->{who} . ': 削除に失敗しましたよ? ' . $me->_fb_post_uri($post_id);
+ $resp_msg = $args->{who} . ': 削除に失敗しましたよ? ' . $me->{fb}->post_uri($post_id);
$me->{dbh}->rollback;
}
} else {
- $resp_msg = $args->{who} . ': そんな投稿ないよ? ' . $me->_fb_post_uri($post_id);
+ $resp_msg = $args->{who} . ': そんな投稿ないよ? ' . $me->{fb}->post_uri($post_id);
$me->{dbh}->rollback;
}
return $resp_msg;
if ($args->{body} =~ /^ふみくん\s+(.+)\?\s*$/) {
$me->{last_search}->{$args->{who}} = undef;
- $me->{last_search}->{$args->{who}} = $me->_db_search($1);
+ $me->{last_search}->{$args->{who}} = $me->_db_search({word => $1});
return $me->_search_next($args);
}
}
my $count = @{$me->{last_search}->{$args->{who}}};
if ($count) {
}
- $resp_msg = $args->{who} . ': ' . $me->_format_submit($ent).'に言ってた '.($count ? '[ほか'.$count.'件] ' : '[ほかにはもうないよ] ').$me->_fb_post_uri($ent->{fb_post_id});
+ $resp_msg = $args->{who} . ': ' . $me->_format_submit($ent).'に言ってた '.($count ? '[ほか'.$count.'件] ' : '[ほかにはもうないよ] ').$me->{fb}->post_uri($ent->{fb_post_id});
}
}
return $resp_msg;
use strict;
use utf8;
-use Config::Simple;
+use Config::Any;
+use Hash::Merge::Simple;
+use Data::Recursive::Encode;
+
+use Data::Dumper;
my $config_name = $ARGV[0] || 'not_found';
-my %cfg;
-my $config_path = ('/etc/mubot4fb/', $ENV{HOME} . '/.mubot4fb/', $ENV{PWD} . '/mubot4fb_');
-foreach my $c ($config_path) {
- my $config = $c . $config_name . '.conf';
- Config::Simple->import_from($config, \%cfg) if (-e $config);
+my $cfg = {};
+my $config_path = ['/etc/mubot4fb/'.$config_name,
+ $ENV{HOME} . '/.mubot4fb/'. $config_name,
+ $ENV{PWD} . '/mubot4fb_' . $config_name];
+
+my $c = Config::Any->load_stems({stems => $config_path, use_ext => 1, flatten_to_hash => 1});
+foreach my $i (keys %$c) {
+ $cfg = Hash::Merge::Simple->merge($cfg, $c->{$i});
}
-die 'missing config file' unless (keys %cfg);
+die 'missing config file' unless (keys %$cfg);
die 'missing some config parameters should be defined (irc_server, fb_app_id, fb_app_secret, fb_access_code, fb_page_id fb_postback_url)'
- if (!defined $cfg{'irc_server'}
- || !defined $cfg{'fb_app_id'}
- || !defined $cfg{'fb_app_secret'}
- || !defined $cfg{'fb_access_code'}
- || !defined $cfg{'fb_page_id'}
- || !defined $cfg{'fb_postback_url'}
- || !defined $cfg{'db_user'}
- || !defined $cfg{'db_pass'}
+ if (!defined $cfg->{'irc_server'}
+ || !defined $cfg->{'fb_app_id'}
+ || !defined $cfg->{'fb_app_secret'}
+ || !defined $cfg->{'fb_access_code'}
+ || !defined $cfg->{'fb_page_id'}
+ || !defined $cfg->{'fb_postback_url'}
+ || !defined $cfg->{'db_user'}
+ || !defined $cfg->{'db_pass'}
);
-
-$cfg{irc_port} ||= 6667;
-$cfg{irc_channels} ||= ['#mubot4fb'];
-$cfg{irc_nick} ||= 'mubot4fb';
-$cfg{irc_name}||= $cfg{irc_nick};
-$cfg{irc_charset} ||= 'utf8';
-$cfg{database} ||= 'mubot4fb';
-
-my $bot = Mubot4FB->new(server => $cfg{'irc_server'},
- port => $cfg{'irc_port'},
- channels => $cfg{'irc_channels'},
- nick => $cfg{'irc_nick'},
- username => $cfg{'irc_name'},
- name => $cfg{'irc_name'},
- charset => $cfg{'irc_charset'},
- cfg => \%cfg)->run();
+$cfg = Data::Recursive::Encode->decode('utf8', $cfg);
+
+$cfg->{irc_port} ||= 6667;
+$cfg->{irc_channels} ||= ['#mubot4fb'];
+$cfg->{irc_nick} ||= 'mubot4fb';
+$cfg->{irc_name}||= $cfg->{irc_nick};
+$cfg->{irc_charset} ||= 'utf8';
+$cfg->{database} ||= 'mubot4fb';
+$cfg->{debug} ||= 0;
+
+my $bot = Mubot4FB->new(server => $cfg->{'irc_server'},
+ port => $cfg->{'irc_port'},
+ channels => $cfg->{'irc_channels'},
+ nick => $cfg->{'irc_nick'},
+ username => $cfg->{'irc_name'},
+ name => $cfg->{'irc_name'},
+ charset => $cfg->{'irc_charset'},
+ cfg => $cfg)->run();
1;