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/^([^ ]+) (https?:\/\/[^ ]+) (.+)$/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
 131         my $sth = $me->{dbh}->prepare('select * from posts where match(prefix,'.$column.',suffix) against(?) order by post_time desc limit 1000');
 132         $sth->bind_param(1, $word, SQL_VARCHAR);
 133         $sth->execute();
 134
 135         my $ret = $sth->fetchall_arrayref({});
 136         $sth->finish;
 137
 138         return $ret;
 139 }
 140
 141 sub _db_search_lastpost {
 142         my ($me, $who) = @_;
 143
 144         my $sth = $me->{dbh}->prepare('select * from posts where submitter = ? order by post_time desc limit 1');
 145         $sth->bind_param(1, $who, SQL_VARCHAR);
 146         $sth->execute();
 147
 148         my $ret = $sth->fetch_arrayref();
 149         $sth->finish;
 150
 151         return $ret;
 152 }
 153
 154 sub _fb_post_uri {
 155         my ($me, $post_id) = @_;
 156
 157         return $me->{cfg}->{fb_page_url} . 'posts/' . $post_id;
 158 }
 159
 160 sub _fb_delete {
 161         my ($me, $post_id) = @_;
 162
 163         my $req = HTTP::Request::Common::DELETE($me->_fb_post_uri($post_id));
 164         $req->header('Content-Length', 0);
 165         my $resp;
 166         eval{$resp = LWP::UserAgent->new->request($req)};
 167         return !$@;
 168 }
 169
 170 sub _format_submit {
 171         my ($me, $e) = @_;
 172
 173         return $e->{submitter}.'が『'.$e->{prefix}.' '.$e->{uri}.' '.$e->{suffix}.'』と'.strftime('%Y-%m-%d %H:%M:%S', localtime($e->{post_time}));
 174 }
 175
 176 sub _response {
 177         my ($me, $args, $msg) = @_;
 178
 179         $me->say(channel => $args->{channel},
 180                  body => $msg);
 181 }
 182
 183 sub _add {
 184         my ($me, $args)  =@_;
 185         my $post_ok = 1;
 186         my ($resp, $resp_msg);
 187
 188         if ($args->{body} =~ /$mu_re/) {
 189                 my $prefix = $1;
 190                 my $uri = $2;
 191                 my $suffix = $3;
 192                 my $text = $args->{who} . '曰く、'.$prefix.' '.$suffix;
 193
 194                 return 0 if ($me->_check_dup($args, $uri));
 195
 196                 eval{$resp = $me->publish($text, $uri)};
 197                 if ($@) {
 198                         $me->fb_init();
 199                         eval{$resp = $me->publish($text, $uri)};
 200                         $post_ok = 0 if ($@);
 201                 }
 202
 203                 if ($post_ok) {
 204                         my (undef, $post_id) = split(/_/, $resp->{id});
 205                         $me->_db_insert({submitter => $args->{who},
 206                                          fb_post_id => $post_id,
 207                                          uri => $uri,
 208                                          prefix => $prefix,
 209                                          suffix => $suffix});
 210                         $resp_msg = $args->{who} . ': うい  '.$me->_fb_post_uri($post_id).' で登録';
 211                 } else {
 212                         $resp_msg = 'can not post to facebook';
 213                 }
 214
 215                 return $resp_msg;
 216         }
 217         return 0;
 218 }
 219
 220 sub _delete_prev {
 221         my ($me, $args) = @_;
 222
 223         return _not_yet();
 224 }
 225
 226 sub _delete {
 227         my ($me, $args, $post_id)  =@_;
 228         my ($resp_msg,$resp);
 229
 230         $me->{dbh}->begin_work;
 231         if ($resp = $me->_db_delete({fb_post_id => $post_id, submitter => $args->{who}})) {
 232                 # fb 側のエントリを削除しないといけない
 233                 if ($me->_fb_delete($post_id)) {
 234                         $me->{dbh}->commit;
 235                         $resp_msg = $args->{who} . ': 削除しました ' . $me->_fb_post_uri($post_id);
 236                 } else {
 237                         $resp_msg = '削除に失敗しましたよ? ' . $me->_fb_post_uri($post_id);
 238                         $me->{dbh}->rollback;
 239                 }
 240         } else {
 241                 $resp_msg = 'そんな投稿ないよ? ' . $me->_fb_post_uri($post_id);
 242                 $me->{dbh}->rollback;
 243         }
 244         return $resp_msg;
 245 }
 246
 247 sub _search_start {
 248         my ($me, $args)  = @_;
 249
 250         if ($args->{body} =~ /^ふみくん\s+(.+)\?\s*$/) {
 251                 $me->{last_search}->{$args->{who}} = undef;
 252                 $me->{last_search}->{$args->{who}} = $me->_db_search($1);
 253                 return $me->_search_next($args);
 254         }
 255 }
 256
 257 sub _search_next {
 258         my ($me, $args)  = @_;
 259
 260         my $resp_msg = 'ないっす';
 261         if (defined $me->{last_search}->{$args->{who}}) {
 262                 my $ent = pop($me->{last_search}->{$args->{who}});
 263                 if ($ent) {
 264                         my $count = @{$me->{last_search}->{$args->{who}}};
 265                         if ($count) {
 266                         }
 267                         $resp_msg = $args->{who} . ': ' . $me->_format_submit($ent).'に言ってた '.($count ? '[ほか'.$count.'件] ' : '[ほかにはもうないよ] ').$me->_fb_post_uri($ent->{fb_post_id});
 268                 }
 269         }
 270         return $resp_msg;
 271 }
 272
 273 sub _not_yet {
 274         return 'まだ実装してないです';
 275 }
 276
 277 sub said {
 278         my ($me, $args) = @_;
 279         my $resp_msg;
 280
 281         if ($args->{body} =~ /$mu_re/) {
 282                 $resp_msg = $me->_add($args) unless ($1 eq 'deb');
 283         } elsif ($args->{body} =~ /^ふみくん\s+(.+)\s*$/) {
 284                 my $cmd = $1;
 285                 if ($cmd eq 'いまのなし') {
 286                         $resp_msg = $me->_delete_prev($args);
 287                 } elsif ($cmd =~ /削除\s+(?:$me->{cfg}->{fb_page_url}posts\/)?([0-9]+)$/) {
 288                         $resp_msg = $me->_delete($args, $1);
 289                 } elsif ($cmd =~ /\?$/) {
 290                         $resp_msg = $me->_search_start($args);
 291                 } elsif ($cmd =~ /つぎ/) {
 292                         $resp_msg = $me->_search_next($args);
 293                 }
 294         }
 295
 296         $me->_response($args, $resp_msg) if ($resp_msg);
 297 }
 298
 299 package main;
 300 use strict;
 301 use utf8;
 302
 303 use Config::Simple;
 304
 305 my $config_name = $ARGV[0] || 'not_found';
 306
 307 my %cfg;
 308 my $config_path = ('/etc/mubot4fb/', $ENV{HOME} . '/.mubot4fb/', $ENV{PWD} . '/mubot4fb_');
 309 foreach my $c ($config_path) {
 310         my $config = $c . $config_name . '.conf';
 311         Config::Simple->import_from($config, \%cfg) if (-e $config);
 312 }
 313 die 'missing config file' unless (keys %cfg);
 314
 315 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)'
 316   if (!defined $cfg{'irc_server'}
 317       || !defined $cfg{'fb_app_id'}
 318       || !defined $cfg{'fb_app_secret'}
 319       || !defined $cfg{'fb_access_code'}
 320       || !defined $cfg{'fb_page_id'}
 321       || !defined $cfg{'fb_postback_url'}
 322       || !defined $cfg{'db_user'}
 323       || !defined $cfg{'db_pass'}
 324     );
 325
 326 $cfg{irc_port} ||= 6667;
 327 $cfg{irc_channels} ||= ['#mubot4fb'];
 328 $cfg{irc_nick} ||= 'mubot4fb';
 329 $cfg{irc_name}||= $cfg{irc_nick};
 330 $cfg{irc_charset} ||= 'utf8';
 331 $cfg{database} ||= 'mubot4fb';
 332
 333 my $bot = Mubot4FB->new(server => $cfg{'irc_server'},
 334                         port => $cfg{'irc_port'},
 335                         channels => $cfg{'irc_channels'},
 336                         nick => $cfg{'irc_nick'},
 337                         username => $cfg{'irc_name'},
 338                         name => $cfg{'irc_name'},
 339                         charset => $cfg{'irc_charset'},
 340                         cfg => \%cfg)->run();
 341
 342 1;