mubot4fb.pl

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