lib/Mubot4FB/FB.pm

   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
  50 sub uri_fixer {
  51         my ($me, $uri) = @_;
  52
  53         #dir uri hacks for some buggy host...
  54         my ($scheme, $auth, $path, $query, $frag) = uri_split($uri);
  55
  56         if ($auth eq 'www.guardian.co.uk') {
  57                 my @q = split(/&/, $query);
  58                 push(@q, 'fb=optOut');
  59                 $query = join('&',@q);
  60                 $uri = uri_join($scheme, $auth, $path, $query, $frag);
  61         }
  62
  63         return $uri;
  64 }
  65
  66 sub publish {
  67         my ($me, $text, $uri) = @_;
  68
  69         return $me->{fbo}->add_post($me->{cfg}->{fb_page_id})
  70             ->set_message($text)
  71             ->set_link_uri($me->uri_fixer($uri))
  72             ->publish()
  73             ->as_hashref();
  74 }
  75
  76 sub post_uri {
  77         my ($me, $post_id) = @_;
  78
  79         return $me->{cfg}->{fb_page_url} . '/posts/' . $post_id;
  80 }
  81
  82 sub remove {
  83         my ($me, $post_id) = @_;
  84
  85         my $uri = $me->{fbo}->query->find($me->{cfg}->{fb_page_id}.'_'.$post_id)->uri_as_string;
  86         my $req = HTTP::Request::Common::DELETE($uri);
  87         warn Dumper($req) if ($me->{cfg}->{debug});
  88         my $resp;
  89         $resp = LWP::UserAgent->new->request($req);
  90         warn Dumper($resp) if ($me->{cfg}->{debug});
  91         if ($resp->is_success && $resp->code == 200 && $resp->content eq 'true') {
  92                 return 1;
  93         } else {
  94                 warn 'DELETE ERROR: http code: ' . $resp->code() . ' , http content: ' . $resp->content;
  95                 return 0;
  96         }
  97 }
  98
  99 1;