mubot4fb.pl

   1 #!/usr/bin/perl
   2 package Mubot4FB;
   3
   4 use strict;
   5 use utf8;
   6
   7 use Facebook::Graph;
   8 use Bot::BasicBot;
   9 use base 'Bot::BasicBot';
  10 use Encode;
  11 use DBI;
  12 use Data::Dumper;
  13
  14
  15 my $mu_re = qr/^([^ ]+) (https?:\/\/[^ ]+) (.+)$/i;
  16
  17 sub fb_init {
  18         my ($me) = @_;
  19         my $fb = Facebook::Graph->new(app_id   => $me->{cfg}->{fb_app_id},
  20                                       secret   => $me->{cfg}->{fb_app_secret},
  21                                       postback => $me->{cfg}->{fb_postback_url});
  22
  23         my $res_token = $fb->request_access_token($me->{cfg}->{fb_access_code});
  24         die 'token get error' if (!defined $res_token || !$res_token->response->is_success);
  25
  26         my $acts = $fb->fetch('me/accounts');
  27         die 'can not get account list' if(!defined $acts || !$acts);
  28
  29         my $page_access_token = '';
  30         foreach my $d (@{$acts->{data}}) {
  31                 if ($d->{id} eq $me->{cfg}->{fb_page_id}) {
  32                         $page_access_token = $d->{'access_token'};
  33                 }
  34         }
  35         die 'can not get access tokenfor page_id=' . $me->{cfg}->{fb_page_id} if ($page_access_token eq '');
  36
  37         return $me->{fbo} = Facebook::Graph->new(access_token => $page_access_token);
  38 }
  39
  40 sub db_init {
  41         my ($me) = @_;
  42         $me->{dbh} = DBI->connect('dbi:SQLite:dbname='.$me->{cfg}->{database}) || die $DBI::errstr;
  43 }
  44
  45 sub publish {
  46         my ($me, $text, $uri) = @_;
  47
  48         return $me->{fbo}->add_post($me->{cfg}->{fb_page_id})
  49             ->set_message($text)
  50             ->set_link_uri($uri)
  51             ->publish()
  52             ->as_hashref();
  53 }
  54
  55 sub init {
  56         my ($me) = @_;
  57         $me->fb_init();
  58         $me->db_init();
  59 }
  60
  61 sub _check_dup {
  62         my ($me, $uri) = @_;
  63
  64 };
  65
  66
  67 sub _response {
  68         my ($me, $args, $msg) = @_;
  69
  70         $me->say(channel => $args->{channel},
  71                  body => $msg);
  72 }
  73
  74 sub _add {
  75         my ($me, $args)  =@_;
  76         my $post_ok = 1;
  77         my ($resp, $resp_msg);
  78
  79         if ($args->{body} =~ /$mu_re/) {
  80                 my $text = $args->{who} . '曰く、' . $1 . ' ' . $3;
  81                 my $uri = $2;
  82
  83                 eval{$resp = $me->publish($text, $uri)};
  84                 if ($@) {
  85                         $me->fb_init();
  86                         eval{$resp = $me->publish($text, $uri)};
  87                         $post_ok = 0 if ($@);
  88                 }
  89
  90                 if ($post_ok) {
  91                         my (undef, $post_id) = split(/_/, $resp->{id});
  92                         $resp_msg = 'うい: ' . $me->{cfg}->{fb_page_url} . 'posts/' . $post_id .' で登録';
  93                 } else {
  94                         $resp_msg = 'can not post to facebook';
  95                 }
  96
  97                 return $resp_msg;
  98         }
  99         return 0;
 100 }
 101
 102 sub _delete_prev {
 103         my ($me, $args) = @_;
 104
 105         return _not_yet();
 106 }
 107
 108 sub _delete_id {
 109         my ($me, $args) = @_;
 110
 111         return _not_yet();
 112 }
 113
 114 sub _delete {
 115         my ($me, $id)  =@_;
 116
 117         return _not_yet();
 118 }
 119
 120 sub _search {
 121         my ($me, $id)  =@_;
 122
 123         return _not_yet();
 124 }
 125
 126 sub _not_yet {
 127         return 'まだ実装してないです';
 128 }
 129
 130 sub said {
 131         my ($me, $args) = @_;
 132         my $resp_msg;
 133
 134         if ($args->{body} =~ /$mu_re/) {
 135                 $resp_msg = $me->_add($args) unless ($1 eq 'deb');
 136         } elsif ($args->{body} =~ /^ふみくん (.+)/) {
 137                 my $cmd = $1;
 138                 if ($cmd eq 'いまのなし') {
 139                         $resp_msg = $me->_delete_prev($args);
 140                 } elsif ($cmd =~ /削除 ([0-9]+)$/) {
 141                         $resp_msg = $me->_delete($args, $1);
 142                 } elsif ($cmd =~ /\?$/) {
 143                         $resp_msg = $me->_search($args);
 144                 } elsif ($cmd =~ /つぎ/) {
 145                         $resp_msg = $me->_search_next($args);
 146                 }
 147         }
 148
 149         $me->_response($args, $resp_msg) if ($resp_msg);
 150 }
 151
 152 package main;
 153 use strict;
 154 use utf8;
 155
 156 use Config::Simple;
 157 use File::Path;
 158
 159 my $config_name = $ARGV[0] || 'not_found';
 160
 161 my %cfg;
 162 my $config_path = ('/etc/mubot4fb/', $ENV{HOME} . '/.mubot4fb/', $ENV{PWD} . '/mubot4fb_');
 163 foreach my $c ($config_path) {
 164         my $config = $c . $config_name . '.conf';
 165         Config::Simple->import_from($config, \%cfg) if (-e $config);
 166 }
 167 die 'missing config file' unless (keys %cfg);
 168
 169 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)'
 170   if (!defined $cfg{'irc_server'}
 171       || !defined $cfg{'fb_app_id'}
 172       || !defined $cfg{'fb_app_secret'}
 173       || !defined $cfg{'fb_access_code'}
 174       || !defined $cfg{'fb_page_id'}
 175       || !defined $cfg{'fb_postback_url'}
 176     );
 177
 178 $cfg{irc_port} ||= 6667;
 179 $cfg{irc_channels} ||= ['#mubot4fb'];
 180 $cfg{irc_nick} ||= 'mubot4fb';
 181 $cfg{irc_name}||= $cfg{irc_nick};
 182 $cfg{irc_charset} ||= 'utf-8';
 183 $cfg{database} ||= $ENV{HOME} . '/.mubot4fb/data/' . $config_name . '.sqlite';
 184
 185 my $bot = Mubot4FB->new(server => $cfg{'irc_server'},
 186                         port => $cfg{'irc_port'},
 187                         channels => $cfg{'irc_channels'},
 188                         nick => $cfg{'irc_nick'},
 189                         username => $cfg{'irc_name'},
 190                         name => $cfg{'irc_name'},
 191                         charset => $cfg{'irc_charset'},
 192                         cfg => \%cfg)->run();
 193
 194 1;