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