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