#!/usr/bin/perl
#
# Copyright (c) 2012 ISHIKAWA Mutsumi <ishikawa@hanzubon.jp>
# This program is covered by the GNU General Public License 2
#
package Mubot4FB;

use strict;
use utf8;

use base 'Bot::BasicBot';
use Facebook::Graph;
use LWP::UserAgent;
use HTTP::Request::Common;
use DBI qw/:sql_types/;
use POSIX 'strftime';

use Data::Dumper;

my $mu_re = qr/^([^\s]+)\s+((?:https?|ftps?):\/\/[^\s]+)\s+(.+)$/i;
my $irc_type = 1;

sub fb_init {
	my ($me) = @_;
	my $fb = Facebook::Graph->new(app_id   => $me->{cfg}->{fb_app_id},
				      secret   => $me->{cfg}->{fb_app_secret},
				      postback => $me->{cfg}->{fb_postback_url});

	my $res_token = $fb->request_access_token($me->{cfg}->{fb_access_code});
	die 'token get error' if (!defined $res_token || !$res_token->response->is_success);

	my $acts = $fb->fetch('me/accounts');
	die 'can not get account list' if(!defined $acts || !$acts);

	my $page_access_token = '';
	foreach my $d (@{$acts->{data}}) {
		if ($d->{id} eq $me->{cfg}->{fb_page_id}) {
			$page_access_token = $d->{'access_token'};
		}
	}
	die 'can not get access tokenfor page_id=' . $me->{cfg}->{fb_page_id} if ($page_access_token eq '');

	return $me->{fbo} = Facebook::Graph->new(access_token => $page_access_token);
}

sub db_init {
	my ($me) = @_;
	$me->{dbh} = DBI->connect('DBI:mysql:'.$me->{cfg}->{database}, $me->{cfg}->{db_user}, $me->{cfg}->{db_pass},{mysql_enable_utf8 => 1}) || die $DBI::errstr;
}

sub misc_init {
	my ($me) = @_;

	$me->{last_search} = {};
}

sub publish {
	my ($me, $text, $uri) = @_;

	return $me->{fbo}->add_post($me->{cfg}->{fb_page_id})
	    ->set_message($text)
	    ->set_link_uri($uri)
	    ->publish()
	    ->as_hashref();
}

sub init {
	my ($me) = @_;
	$me->fb_init();
	$me->db_init();
}

sub _check_dup {
	my ($me, $args, $uri) = @_;

	my $found = 0;

	my $sth = $me->{dbh}->prepare('select * from posts where uri = ? order by post_time desc limit 1');
	my $rv = $sth->execute($uri);
	my $res = $sth->fetchrow_hashref;
	if ($res) {
		if ($res->{post_time} < time() - 7 * 24 * 60 * 60) {
			$me->_response($args, 'だいぶ前 '.$me->_format_submit($res).'にいってたにゃー '.$me->_fb_post_uri($res->{fb_post_id}));
		} else {
			$me->_response($args, '既に '.$me->_format_submit($res).'に言ってますよ? '.$me->{cfg}->{fb_page_url}.'posts/'.$res->{fb_post_id});
			$found = 1;
		}
	}
	$sth->finish;

	return $found;
};

sub _db_insert {
	my ($me, $db_args) = @_;

	my ($scheme, $path) = split(/:\/\//, $db_args->{uri});
	my $sth = $me->{dbh}->prepare("insert into posts (submitter, fb_post_id, uri, prefix, suffix, scheme, path, post_time) values (?, ?, ?, ?, ?, ?, ?, ?)");
	$sth->bind_param(1, $db_args->{submitter}, SQL_VARCHAR);
	$sth->bind_param(2, $db_args->{fb_post_id}, SQL_BIGINT);
	$sth->bind_param(3, $db_args->{uri}, SQL_VARCHAR);
	$sth->bind_param(4, $db_args->{prefix}, SQL_VARCHAR);
	$sth->bind_param(5, $db_args->{suffix}, SQL_VARCHAR);
	$sth->bind_param(6, $scheme, SQL_VARCHAR);
	$sth->bind_param(7, $path, SQL_VARCHAR);
	$sth->bind_param(8, time, SQL_BIGINT);
	my $rv = $sth->execute();
	$sth->finish;

	return $rv;
}

sub _db_delete {
	my ($me, $db_args) = @_;
	$db_args->{submitter_type} ||= 1;

	my $sth = $me->{dbh}->prepare("delete from posts where fb_post_id = ? and submitter = ? and submitter_type = ?");

	$sth->bind_param(1, $db_args->{fb_post_id}, SQL_BIGINT);
	$sth->bind_param(2, $db_args->{submitter}, SQL_VARCHAR);
	$sth->bind_param(3, $db_args->{submitter_type}, SQL_INTEGER);
	my $rv = $sth->execute();
	my $ret = $rv ? $sth->rows : 0;

	$sth->finish;

	return $ret;
}

sub _db_search {
	my ($me, $word) = @_;

	my $column = $word =~ /:\/\// ? 'uri' : 'path';
	my $w = '%' . $word . '%';
	my $sth = $me->{dbh}->prepare('select * from posts where prefix like ? or '.$column.' like ? or suffix like ? order by post_time desc limit 1000');
	$sth->bind_param(1, $w, SQL_VARCHAR);
	$sth->bind_param(2, $w, SQL_VARCHAR);
	$sth->bind_param(3, $w, SQL_VARCHAR);
	$sth->execute();

	my $ret = $sth->fetchall_arrayref({});
	$sth->finish;

	return $ret;
}

sub _db_search_lastpost {
	my ($me, $who) = @_;

	my $sth = $me->{dbh}->prepare('select * from posts where submitter = ? order by post_time desc limit 1');
	$sth->bind_param(1, $who, SQL_VARCHAR);
	$sth->execute();

	my $ret = $sth->fetchrow_hashref();
	$sth->finish;

	return $ret;
}

sub _fb_post_uri {
	my ($me, $post_id) = @_;

	return $me->{cfg}->{fb_page_url} . 'posts/' . $post_id;
}

sub _fb_delete {
	my ($me, $post_id) = @_;

	my $req = HTTP::Request::Common::DELETE($me->_fb_post_uri($post_id));
	$req->header('Content-Length', 0);
	my $resp;
	eval{$resp = LWP::UserAgent->new->request($req)};
	return !$@;
}

sub _format_submit {
	my ($me, $e) = @_;

	return $e->{submitter}.'が『'.$e->{prefix}.' '.$e->{uri}.' '.$e->{suffix}.'』と'.strftime('%Y-%m-%d %H:%M:%S', localtime($e->{post_time}));
}

sub _response {
	my ($me, $args, $msg) = @_;

	$me->say(channel => $args->{channel},
		 body => $msg);
}

sub _add {
	my ($me, $args)  =@_;
	my $post_ok = 1;
	my ($resp, $resp_msg);

	if ($args->{body} =~ /$mu_re/) {
		my $prefix = $1;
		my $uri = $2;
		my $suffix = $3;
		my $text = $args->{who} . '曰く、'.$prefix.' '.$suffix;

		return 0 if ($me->_check_dup($args, $uri));

		eval{$resp = $me->publish($text, $uri)};
		if ($@) {
			$me->fb_init();
			eval{$resp = $me->publish($text, $uri)};
			$post_ok = 0 if ($@);
		}

		if ($post_ok) {
			my (undef, $post_id) = split(/_/, $resp->{id});
			$me->_db_insert({submitter => $args->{who},
					 fb_post_id => $post_id,
					 uri => $uri,
					 prefix => $prefix,
					 suffix => $suffix});
			$resp_msg = $args->{who} . ': うい  '.$me->_fb_post_uri($post_id).' で登録';
		} else {
			$resp_msg = 'can not post to facebook';
		}

		return $resp_msg;
	}
	return 0;
}

sub _delete_prev {
	my ($me, $args) = @_;

	my $last_post = $me->_db_search_lastpost($args->{who});

	if (!defined $last_post) {
		return $args->{who}.': いまのっていつの? というか ないし';
	} elsif ($last_post->{post_time} < time() - 3600) {
		return $args->{who}.': いまのっていつの? 最後のはこれだけど古いんだにゃ ' . $me->_fb_post_uri($last_post->{fb_post_id});
	} else {
		return $me->_delete($args, $last_post->{'fb_post_id'});
	}
}

sub _delete {
	my ($me, $args, $post_id)  =@_;
	my ($resp_msg, $resp);

	$me->{dbh}->begin_work;
	if ($resp = $me->_db_delete({fb_post_id => $post_id, submitter => $args->{who}})) {
		# fb 側のエントリを削除しないといけない
		if ($me->_fb_delete($post_id)) {
			$me->{dbh}->commit;
			$resp_msg = $args->{who} . ': 削除しました ' . $me->_fb_post_uri($post_id);
		} else {
			$resp_msg = $args->{who} . ': 削除に失敗しましたよ? ' . $me->_fb_post_uri($post_id);
			$me->{dbh}->rollback;
		}
	} else {
		$resp_msg = $args->{who} . ': そんな投稿ないよ? ' . $me->_fb_post_uri($post_id);
		$me->{dbh}->rollback;
	}
	return $resp_msg;
}

sub _search_start {
	my ($me, $args)  = @_;

	if ($args->{body} =~ /^ふみくん\s+(.+)\?\s*$/) {
		$me->{last_search}->{$args->{who}} = undef;
		$me->{last_search}->{$args->{who}} = $me->_db_search($1);
		return $me->_search_next($args);
	}
}

sub _search_next {
	my ($me, $args)  = @_;

	my $resp_msg = 'ないっす';
	if (defined $me->{last_search}->{$args->{who}}) {
		my $ent = pop($me->{last_search}->{$args->{who}});
		if ($ent) {
			my $count = @{$me->{last_search}->{$args->{who}}};
			if ($count) {
			}
			$resp_msg = $args->{who} . ': ' . $me->_format_submit($ent).'に言ってた '.($count ? '[ほか'.$count.'件] ' : '[ほかにはもうないよ] ').$me->_fb_post_uri($ent->{fb_post_id});
		}
	}
	return $resp_msg;
}

sub _not_yet {
	return 'まだ実装してないです';
}

sub said {
	my ($me, $args) = @_;
	my $resp_msg;

	if ($args->{body} =~ /$mu_re/) {
		$resp_msg = $me->_add($args) unless ($1 eq 'deb');
	} elsif ($args->{body} =~ /^ふみくん\s+(.+)\s*$/) {
		my $cmd = $1;
		if ($cmd eq 'いまのなし') {
			$resp_msg = $me->_delete_prev($args);
		} elsif ($cmd =~ /削除\s+(?:$me->{cfg}->{fb_page_url}posts\/)?([0-9]+)$/) {
			$resp_msg = $me->_delete($args, $1);
		} elsif ($cmd =~ /\?$/) {
			$resp_msg = $me->_search_start($args);
		} elsif ($cmd =~ /つぎ/) {
			$resp_msg = $me->_search_next($args);
		}
	}

	$me->_response($args, $resp_msg) if ($resp_msg);
}

package main;
use strict;
use utf8;

use Config::Simple;

my $config_name = $ARGV[0] || 'not_found';

my %cfg;
my $config_path = ('/etc/mubot4fb/', $ENV{HOME} . '/.mubot4fb/', $ENV{PWD} . '/mubot4fb_');
foreach my $c ($config_path) {
	my $config = $c . $config_name . '.conf';
	Config::Simple->import_from($config, \%cfg) if (-e $config);
}
die 'missing config file' unless (keys %cfg);

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)'
  if (!defined $cfg{'irc_server'}
      || !defined $cfg{'fb_app_id'}
      || !defined $cfg{'fb_app_secret'}
      || !defined $cfg{'fb_access_code'}
      || !defined $cfg{'fb_page_id'}
      || !defined $cfg{'fb_postback_url'}
      || !defined $cfg{'db_user'}
      || !defined $cfg{'db_pass'}
    );

$cfg{irc_port} ||= 6667;
$cfg{irc_channels} ||= ['#mubot4fb'];
$cfg{irc_nick} ||= 'mubot4fb';
$cfg{irc_name}||= $cfg{irc_nick};
$cfg{irc_charset} ||= 'utf8';
$cfg{database} ||= 'mubot4fb';

my $bot = Mubot4FB->new(server => $cfg{'irc_server'},
			port => $cfg{'irc_port'},
			channels => $cfg{'irc_channels'},
			nick => $cfg{'irc_nick'},
			username => $cfg{'irc_name'},
			name => $cfg{'irc_name'},
			charset => $cfg{'irc_charset'},
			cfg => \%cfg)->run();

1;
