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