mubot4fb.pl

   1 #!/usr/bin/perl
   2 package Mubot4FB;
   3
   4 use strict;
   5 use utf8;
   6
   7 use base 'Bot::BasicBot';
   8 use Facebook::Graph;
   9 use LWP::UserAgent;
  10 use HTTP::Request::Common;
  11 use Encode;
  12 use DBI qw/:sql_types/;
  13 use POSIX 'strftime';
  14
  15 use Data::Dumper;
  16
  17 my $mu_re = qr/^([^ ]+) (https?:\/\/[^ ]+) (.+)$/i;
  18 my $irc_type = 1;
  19
  20 sub fb_init {
  21         my ($me) = @_;
  22         my $fb = Facebook::Graph->new(app_id   => $me->{cfg}->{fb_app_id},
  23                                       secret   => $me->{cfg}->{fb_app_secret},
  24                                       postback => $me->{cfg}->{fb_postback_url});
  25
  26         my $res_token = $fb->request_access_token($me->{cfg}->{fb_access_code});
  27         die 'token get error' if (!defined $res_token || !$res_token->response->is_success);
  28
  29         my $acts = $fb->fetch('me/accounts');
  30         die 'can not get account list' if(!defined $acts || !$acts);
  31
  32         my $page_access_token = '';
  33         foreach my $d (@{$acts->{data}}) {
  34                 if ($d->{id} eq $me->{cfg}->{fb_page_id}) {
  35                         $page_access_token = $d->{'access_token'};
  36                 }
  37         }
  38         die 'can not get access tokenfor page_id=' . $me->{cfg}->{fb_page_id} if ($page_access_token eq '');
  39
  40         return $me->{fbo} = Facebook::Graph->new(access_token => $page_access_token);
  41 }
  42
  43 sub db_init {
  44         my ($me) = @_;
  45         $me->{dbh} = DBI->connect('DBI:mysql:'.$me->{cfg}->{database}, $me->{cfg}->{db_user}, $me->{cfg}->{db_pass}) || die $DBI::errstr;
  46 }
  47
  48 sub misc_init {
  49         my ($me) = @_;
  50
  51         $me->{last_search} = {};
  52 }
  53
  54 sub publish {
  55         my ($me, $text, $uri) = @_;
  56
  57         return $me->{fbo}->add_post($me->{cfg}->{fb_page_id})
  58             ->set_message($text)
  59             ->set_link_uri($uri)
  60             ->publish()
  61             ->as_hashref();
  62 }
  63
  64 sub init {
  65         my ($me) = @_;
  66         $me->fb_init();
  67         $me->db_init();
  68 }
  69
  70 sub _check_dup {
  71         my ($me, $args, $uri) = @_;
  72
  73         my $found = 0;
  74
  75         my $sth = $me->{dbh}->prepare('select * from posts where uri = ? order by post_time desc limit 1');
  76         my $rv = $sth->execute($uri);
  77         my $res = $sth->fetchrow_hashref;
  78         if ($res) {
  79                 if ($res->{post_time} < time() - 7 * 24 * 60 * 60) {
  80                         $me->_response($args, 'だいぶ前 '.$me->_format_submit($res).'にいってたにゃー '.$me->_fb_post_uri($res->{fb_post_id}));
  81                 } else {
  82                         $me->_response($args, '既に '.$me->_format_submit($res).'に言ってますよ? '.$me->{cfg}->{fb_page_url}.'posts/'.$res->{fb_post_id});
  83                         $found = 1;
  84                 }
  85         }
  86         $sth->finish;
  87
  88         return $found;
  89 };
  90
  91 sub _db_insert {
  92         my ($me, $db_args) = @_;
  93
  94         my ($scheme, $path) = split(!://!, $db_args->{uri});
  95         my $sth = $me->{dbh}->prepare("insert into posts (submitter, fb_post_id, uri, prefix, suffix, scheme, path, post_time) values (?, ?, ?, ?, ?, ?)");
  96         $sth->bind_param(1, $db_args->{submitter}, SQL_TEXT);
  97         $sth->bind_param(2, $db_args->{fb_post_id}, SQL_BIGINT);
  98         $sth->bind_param(3, $db_args->{uri}, SQL_TEXT);
  99         $sth->bind_param(4, $db_args->{prefix}, SQL_TEXT);
 100         $sth->bind_param(5, $db_args->{suffix}, SQL_TEXT);
 101         $sth->bind_param(6, $scheme, SQL_TEXT);
 102         $sth->bind_param(7, $path, SQL_TEXT);
 103         $sth->bind_param(8, time, SQL_BIGINT);
 104         my $rv = $sth->execute();
 105         $sth->finish;
 106
 107         return $rv;
 108 }
 109
 110 sub _db_delete {
 111         my ($me, $db_args) = @_;
 112         $db_args->{submitter_type} ||= 1;
 113
 114         my $sth = $me->{dbh}->prepare("delete from posts where fb_post_id = ? and submitter = ? and submitter_type = ?");
 115
 116         $sth->bind_param(1, $db_args->{fb_post_id}, SQL_BIGINT);
 117         $sth->bind_param(2, $db_args->{submitter}, SQL_VARCHAR);
 118         $sth->bind_param(3, $db_args->{submitter_type}, SQL_INTEGER);
 119         my $rv = $sth->execute();
 120         my $ret = $rv ? $sth->rows : 0;
 121
 122         $sth->finish;
 123
 124         return $ret;
 125 }
 126
 127 sub _db_search {
 128         my ($me, $word) = @_;
 129
 130         $column ? $word =~ !://! ? 'uri' : 'path';
 131
 132         my $sth = $me->{dbh}->prepare('select * from posts where match(prefix,'.$column.',suffix) against(?) order by post_time desc limit 1000');
 133         $sth->bind_param(1, $word, SQL_VARCHAR);
 134         $sth->execute();
 135
 136         my $ret = $sth->fetchall_arrayref({});
 137         $sth->finish;
 138
 139         return $ret;
 140 }
 141
 142 sub _fb_post_uri {
 143         my ($me, $post_id) = @_;
 144
 145         return $me->{cfg}->{fb_page_url} . 'posts/' . $post_id;
 146 }
 147
 148 sub _fb_delete {
 149         my ($me, $post_id) = @_;
 150
 151         my $req = HTTP::Request::Common::DELETE($me->_fb_post_uri($post_id));
 152         $req->header('Content-Length', 0);
 153         my $resp;
 154         eval{$resp = LWP::UserAgent->new->request($req)};
 155         warn $resp;
 156         return !$@;
 157 }
 158
 159 sub _format_submit {
 160         my ($me, $e) = @_;
 161
 162         return decode('utf8', $e->{submitter}).'が「'.decode('utf8', $e->{prefix}).' '.decode('utf8', $e->{uri}).' '.decode('utf8', $e->{suffix}).'」と'.strftime('%Y-%m-%d %H:%M:%S', localtime($e->{post_time}));
 163 }
 164
 165 sub _response {
 166         my ($me, $args, $msg) = @_;
 167
 168         $me->say(channel => $args->{channel},
 169                  body => $msg);
 170 }
 171
 172 sub _add {
 173         my ($me, $args)  =@_;
 174         my $post_ok = 1;
 175         my ($resp, $resp_msg);
 176
 177         if ($args->{body} =~ /$mu_re/) {
 178                 my $prefix = $1;
 179                 my $uri = $2;
 180                 my $suffix = $3;
 181                 my $text = $args->{who} . '曰く、'.$prefix.' '.$suffix;
 182
 183                 return 0 if ($me->_check_dup($args, $uri));
 184
 185                 eval{$resp = $me->publish($text, $uri)};
 186                 if ($@) {
 187                         $me->fb_init();
 188                         eval{$resp = $me->publish($text, $uri)};
 189                         $post_ok = 0 if ($@);
 190                 }
 191
 192                 if ($post_ok) {
 193                         my (undef, $post_id) = split(/_/, $resp->{id});
 194                         $me->_db_insert({submitter => $args->{who},
 195                                          fb_post_id => $post_id,
 196                                          uri => $uri,
 197                                          prefix => $prefix,
 198                                          suffix => $suffix});
 199                         $resp_msg = $args->{who} . ': うい  '.$me->_fb_post_uri($post_id).' で登録';
 200                 } else {
 201                         $resp_msg = 'can not post to facebook';
 202                 }
 203
 204                 return $resp_msg;
 205         }
 206         return 0;
 207 }
 208
 209 sub _delete_prev {
 210         my ($me, $args) = @_;
 211
 212         return _not_yet();
 213 }
 214
 215 sub _delete {
 216         my ($me, $args, $post_id)  =@_;
 217         my $resp_msg;
 218
 219         $me->{dbh}->begin_work;
 220         if ($me->_db_delete({fb_post_id => $post_id, submitter => $args->{who}})) {
 221                 # fb 側のエントリを削除しないといけない
 222                 if ($me->_fb_delete($post_id)) {
 223                         $me->{dbh}->commit;
 224                         $resp_msg = $args->{who} . ': 削除しました ' . $me->_fb_post_uri($post_id);
 225                 } else {
 226                         $resp_msg = 'fail to delete facebook post: ' . $me->_fb_post_uri($post_id);
 227                         $me->{dbh}->rollback;
 228                 }
 229         } else {
 230                 $resp_msg = 'fail to delete facebook post from DB: ' . $me->_fb_post_uri($post_id);
 231                 $me->{dbh}->rollback;
 232         }
 233         return $resp_msg;
 234 }
 235
 236 sub _search_start {
 237         my ($me, $args)  = @_;
 238
 239         if ($args->{body} =~ /^ふみくん\s+(.+)\?\s*$/) {
 240                 $me->{last_search}->{$args->{who}} = undef;
 241                 $me->{last_search}->{$args->{who}} = $me->_db_search($1);
 242                 return $me->_search_next($args);
 243         }
 244 }
 245
 246 sub _search_next {
 247         my ($me, $args)  = @_;
 248
 249         my $resp_msg = 'ないっす';
 250         if (defined $me->{last_search}->{$args->{who}}) {
 251                 my $ent = pop($me->{last_search}->{$args->{who}});
 252                 if ($ent) {
 253                         my $count = @{$me->{last_search}->{$args->{who}}};
 254                         if ($count) {
 255                         }
 256                         $resp_msg = $args->{who} . ': ' . $me->_format_submit($ent).'に言ってた'.($count ? '[ほか'.$count.'件] ' : '[ほかにはもうないよ] ').$me->_fb_post_uri($ent->{fb_post_id});
 257                 }
 258         }
 259         return $resp_msg;
 260 }
 261
 262 sub _not_yet {
 263         return 'まだ実装してないです';
 264 }
 265
 266 sub said {
 267         my ($me, $args) = @_;
 268         my $resp_msg;
 269
 270         if ($args->{body} =~ /$mu_re/) {
 271                 $resp_msg = $me->_add($args) unless ($1 eq 'deb');
 272         } elsif ($args->{body} =~ /^ふみくん\s+(.+)\s*$/) {
 273                 my $cmd = $1;
 274                 if ($cmd eq 'いまのなし') {
 275                         $resp_msg = $me->_delete_prev($args);
 276                 } elsif ($cmd =~ /削除\s+(?:$me->{cfg}->{fb_page_url}posts\/)?([0-9]+)$/) {
 277                         $resp_msg = $me->_delete($args, $1);
 278                 } elsif ($cmd =~ /\?$/) {
 279                         $resp_msg = $me->_search_start($args);
 280                 } elsif ($cmd =~ /つぎ/) {
 281                         $resp_msg = $me->_search_next($args);
 282                 }
 283         }
 284
 285         $me->_response($args, $resp_msg) if ($resp_msg);
 286 }
 287
 288 package main;
 289 use strict;
 290 use utf8;
 291
 292 use Config::Simple;
 293 use File::Path;
 294
 295 my $config_name = $ARGV[0] || 'not_found';
 296
 297 my %cfg;
 298 my $config_path = ('/etc/mubot4fb/', $ENV{HOME} . '/.mubot4fb/', $ENV{PWD} . '/mubot4fb_');
 299 foreach my $c ($config_path) {
 300         my $config = $c . $config_name . '.conf';
 301         Config::Simple->import_from($config, \%cfg) if (-e $config);
 302 }
 303 die 'missing config file' unless (keys %cfg);
 304
 305 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)'
 306   if (!defined $cfg{'irc_server'}
 307       || !defined $cfg{'fb_app_id'}
 308       || !defined $cfg{'fb_app_secret'}
 309       || !defined $cfg{'fb_access_code'}
 310       || !defined $cfg{'fb_page_id'}
 311       || !defined $cfg{'fb_postback_url'}
 312       || !defined $cfg{'db_user'}
 313       || !defined $cfg{'db_pass'}
 314     );
 315
 316 $cfg{irc_port} ||= 6667;
 317 $cfg{irc_channels} ||= ['#mubot4fb'];
 318 $cfg{irc_nick} ||= 'mubot4fb';
 319 $cfg{irc_name}||= $cfg{irc_nick};
 320 $cfg{irc_charset} ||= 'utf8';
 321 $cfg{database} ||= 'mubot4fb';
 322
 323 my $bot = Mubot4FB->new(server => $cfg{'irc_server'},
 324                         port => $cfg{'irc_port'},
 325                         channels => $cfg{'irc_channels'},
 326                         nick => $cfg{'irc_nick'},
 327                         username => $cfg{'irc_name'},
 328                         name => $cfg{'irc_name'},
 329                         charset => $cfg{'irc_charset'},
 330                         cfg => \%cfg)->run();
 331
 332 1;