mubot4fb.pl

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