package SpringBot;
use strict;
use warnings;
use utf8;
#use Smart::Comments;
use base 'Bot::BasicBot';
use Encode::Guess;
use Encode qw(from_to encode decode);
use WWW::OpenResty::Simple;
use Params::Util qw(_ARRAY);
use Digest::MD5 qw(md5_hex);
use JSON::XS ();
my $json_xs = JSON::XS->new->allow_nonref;
use LWP::UserAgent;
my $ua = LWP::UserAgent->new;
$ua->agent('Mozilla/5.0');
$ua->timeout(3);
$ua->env_proxy;
$SIG{CHLD} = "IGNORE";
our @Brain = (
[0 => qr{https?://[^\(\)()?。]+} => \&process_url],
[0 => qr{(?:哈你个头|fuck|f\s*u\s*c\s*k|[^A-Za-z]TMD[^A-Za-z]|\bTMD\b|\bshit\b|\bf[us\*]ck(?:ing)?\b|\bdammit\b|\bdamn(?:\s+it)?\b|\bbastard\b|perl.*?邪教|\bMD\b)}i => \&punish_him],
[1 => qr{^\s*baidu\s+}i => \&baidu_stuff],
[0 => qr{^\s*trans\s+}i => \&tcn],
[0 => qr{^\s*word\s+}i => \&tdcn],
[0 => qr{^\s*emp(?:loyee)?\s+} => \&find_employee],
[1 => qr{.} => \&reply_crap],
[0 => qr{^\s*seen\s+([^??]+)\s*[??]?\s*$} => \&seen_person],
);
our %EncodingMap = (
'cp936' => 'gbk',
'utf8' => 'utf8',
'euc-cn' => 'gbk',
'big5-eten' => 'big5',
);
our $Resty;
sub new {
my $proto = shift;
my %args = @_;
my $account = delete $args{resty_account} or die "No account given";
my $password = delete $args{resty_password} or die "No password given";
$Resty = WWW::OpenResty::Simple->new(
{ server => 'api.openresty.org' }
);
$Resty->login($account, $password);
my $self = $proto->SUPER::new(%args);
$self->{_resty_account} = $account;
$self->{_resty_password} = $password;
### $self
$self;
}
sub resty_account {
return $_[0]->{_resty_account};
}
sub resty_password {
return $_[0]->{_resty_password};
}
sub channel {
$_[0]->{bot_channel};
}
sub said {
my ($self, $e) = @_;
my $text = $e->{raw_body};
my $sender = $e->{who};
my $channel = $e->{channel};
$self->{bot_channel} = $channel;
#$self->{channel} = $channel;
### said: $e
my $orig_text = $text;
$orig_text =~ s/[ \n]+$//gs;
#warn "public: $text";
my $charset = $self->charset;
### charset: $charset
my $say = sub {
my $msg = shift;
#from_to($msg, 'utf8', $charset);
#use Encode qw(is_utf8 decode);
#print $msg;
#log_error($msg);
#print "Hello............................\n";
#print "howdy............................\n";
eval {
for my $line (split /\n+/, $msg) {
next if $line =~ /^\s*$/;
$self->say(
channel => $channel,
body => $line,
);
#$self->log($channel, $self->nick, $line);
}
};
if ($@) { $self->log_error($@); }
};
my $enc = guess_charset($text, $charset);
# log_error("msg in charset: $enc\n");
# log_error("Charset: $charset\n");
#from_to($text, $enc, 'utf8');
#warn length($orig_text);
#if (length($orig_text) > 4 and $enc ne 'ascii' and $enc ne $charset and $text !~ /^\[\w+\]: /) {
#warn "Hit!\n";
#$say->("[$enc]: $text\n");
#}
$self->process_msg($text, $say, $sender) if $sender !~ /bot$/i;
#$self->log($e->{channel}, $e->{who}, $e->{raw_body});
return undef;
}
sub log_error {
my $error = shift;
#print $error;
warn $error;
open my $out, '>>springbot.error';
if ($out) {
print $out "Hello!!! >>>>>> log ", scalar(localtime), "\n";
print $out $error, "\n";
close $out;
}
}
sub handler {
}
sub log {
my ($self, $channel, $sender, $body, $type) = @_;
$type ||= 'msg';
return unless defined $channel and defined $sender and defined $body;
my $s = "[log]: $channel: $sender: $body: $type\n";
#print encode('utf8', $s);
$self->forkit(
channel => $channel,
handler => 'handler',
run => sub {
use File::Slurp;
#warn "HEY! I'm logging!\n";
my $res;
eval {
$res = $Resty->post(
'/=/model/IrcLog/~/~',
{ _user => $self->resty_account,
_password => md5_hex($self->resty_password) },
{
channel => $channel,
sender => $sender,
content => $body,
type => $type,
}
);
};
if ($@) {
log_error($@);
} else {
#use Data::Dumper;
#log_error(Dumper($res));
}
### Insert log message: $res
}
);
}
sub pick {
my ($list) = @_;
my $len = @$list;
my $i = int rand ($len);
warn $i;
$list->[$i];
}
sub process_msg {
my ($self, $orig_text, $say, $sender) = @_;
### $orig_text
my $nick = $self->nick;
for my $item (@Brain) {
#### $item
my $text = $orig_text;
my ($explicit, $pattern, $handle) = @$item;
my $is_explicit = ($text =~ s/^\s*\Q$nick\E\s*[::]\s*//);
### $text
### $is_explicit
if ($explicit) {
next unless $is_explicit;
}
if ($text =~ m{$pattern}) {
$handle->($self, $pattern, $text, $&, $say, $sender);
last;
}
}
}
sub process_url {
my ($self, $pattern, $text, $url, $say, $sender) = @_;
my $charset = $self->charset;
#$say->("Found URL: $match");
if ($url =~ /\.(?:avi|iso|msi|tar|gz|bz2|rpm|deb|dll|so|exe|mp3|rm|rmvb|bak|txt|jpg|jpeg|png|xml|tiff|gif|mov|flw|swf|sql)\b/i) { return; }
warn "Getting $url...\n";
$ua->max_size( 1024 * 3 );
$ua->timeout(3);
my $res = $ua->get($url);
if (!$res->is_success) {
warn $res->status_line;
return;
}
my $content = $res->content;
if (defined $content) {
if ($content =~ m{
(.*?)}is) {
my $title = $1;
$title =~ s/\n+//gs;
$title =~ s/\s+/ /g;
my $enc = guess_charset($title, $charset);
### $title
$title = decode($enc, $title);
### $enc
$title =~ s/\ / /g;
$title =~ s/\<//g;
$title =~ s/\"/"/g;
$title =~ s/\&/\&/g;
$say->($title);
}
} else {
warn "Failed to get $url.\n";
}
}
sub baidu_stuff {
my ($self, $pattern, $text, $cmd, $say, $sender) = @_;
### $pattern
### $text
### $cmd
$text =~ s/$pattern//;
#warn "CMD: $text";
$text =~ s/\n+//sg;
### $text
if ($text) {
use LWP::Simple;
$text = encode('gbk', $text);
my $url = "http://www.baidu.com/s?wd=$text";
### $url
my $content = get($url);
if (!$content) {
warn "Cannot open $url\n";
return;
}
if ($content =~ m{]*?href="([^"]+)" target="_blank">(.+?)}i) {
my ($url, $title) = ($1, $2);
$title = html2text($title);
my $msg = "$title ( $url )";
$msg = decode('gbk', $msg);
#print $say;
$say->("$sender: $msg");
}
}
}
sub seen_person {
my ($self, $pattern, $text, $matched, $say, $sender) = @_;
my $channel = $self->channel;
if ($text =~ m/$pattern/) {
my $sender = $1;
my $res;
eval {
$res = $Resty->get(
'/=/view/LastSeen/~/~',
{ sender => $sender, _user => $self->resty_account, _password => $self->resty_password }
);
};
if ($@) { $self->log_error($@); return }
if (_ARRAY($res)) {
my $row = $res->[0];
use DateTime;
use DateTime::Duration;
use DateTime::Format::Pg;
use DateTime::Format::Duration;
my $sent_on = DateTime::Format::Pg->parse_timestamp_with_time_zone($row->{sent_on});
my $now = DateTime->now;
my $duration = $now - $sent_on;
#my $duration = DateTime::Duration->new(
#years => 3,
#months => 2,
#days => 15,
#hours => 13,
# minutes => 35,
#seconds => 55
#);
my @s;
if (my $years = $duration->years) {
push @s, "$years years";
}
if (my $months = $duration->months) {
push @s, "$months months";
}
if (my $days = $duration->days) {
push @s, "$days days";
}
if (my $hours = $duration->hours) {
push @s, "$hours hours";
}
if (my $minutes = $duration->minutes) {
push @s, "$minutes minutes";
}
if (my $seconds = $duration->seconds) {
push @s, "$seconds seconds";
}
my $s = join(', ', @s);
$s =~ s/.*,/$& and /;
my $content = $row->{content};
my $msg = "$sender was last seen in $row->{channel} $s ago, saying \"$content\"";
$say->($msg);
} else {
$say->("sorry, i've never seen $sender here :(");
}
}
}
sub find_employee {
my ($self, $pattern, $text, $cmd, $say, $sender) = @_;
my %map = (
agentzh => '章亦春',
jianingy => '杨家宁',
arthas => '谢昕',
ywayne => '王熠',
leiyh => '雷永华',
highway => '周海维',
carriezh => '张皛珏',
tangch => 'cheng.tang',
whj => '王惠军',
laser => '何伟平',
Yi => '赵熠',
);
$text =~ s/$pattern//;
$text =~ s/\n+//sg;
$text =~ s/^\s+|\s+$//g;
if ($text) {
$text = $map{$text} || $text;
my $url = 'http://api.openresty.org/=/model/YahooStaff/~/' . $text;
$url = encode('utf8', $url),
### OpenResty URL: $url
my $res;
eval {
$res = $Resty->get(
$url,
{ _op => 'contains', _limit => 3, _order_by => 'order_id:desc' }
);
};
if ($@ =~ /Login required/i) {
$Resty->login($self->resty_account, $self->resty_password);
$res = $Resty->get(
$url,
{ _op => 'contains', _limit => 3, _order_by => 'order_id:desc' }
);
}
if (_ARRAY($res)) {
delete $_->{order_id} for @$res;
my $s = res2table($res);
$say->($s);
} else {
my @ans = (
'sorry, not found...',
'oops, i got nothing :(',
'sigh...none obtained :/',
'0 hits...',
);
my $ans = pick(\@ans);
$say->("$sender: $ans");
}
}
}
sub punish_him {
my ($self, $pattern , $text, $cmd, $say, $sender) = @_;
my @craps = (
"kills $sender",
"throws $sender off the cliff",
"slaps $sender around with a large trout",
"slaps a large trout around a bit with $sender",
"kicks $sender mercilessly",
"hands a big bomb to $sender",
"cuts off $sender\'s head",
);
my $s = pick(\@craps);
$self->emote(
channel => $self->channel,
body => "$s.",
);
}
sub reply_crap {
my ($self, $pattern , $text, $cmd, $say, $sender) = @_;
my @craps = (
"yes, i'm aware of that :)",
";)",
"why?",
"^_^",
"i see.",
"really?",
"hey!",
"cool",
":P",
"yo",
"hiya",
);
warn "About to generating craps...\n";
my $s = pick(\@craps);
warn $s;
$say->("$sender: $s");
}
sub html2text {
my $html = shift;
$html =~ s/<[^>]+>//g;
$html =~ s/\ / /g;
$html =~ s/\<//g;
$html =~ s/\&/\&/g;
$html;
}
sub guess_charset {
my ($data, $charset) = @_;
my @enc = qw( utf8 gbk Big5 Latin1 );
# warn "guess charset: $charset";
for my $enc ($charset, @enc) {
my $decoder = guess_encoding($data, $enc);
if (ref $decoder) {
# if ($enc ne 'ascii') {
# print "line $.: $enc message found: ", $decoder->decode($s), "\n";
# }
my $enc = $decoder->name;
$enc = $EncodingMap{$enc} || $enc;
return $enc;
}
}
return 'utf8';
}
sub res2table {
my ($res) = @_;
return '' if !defined $res or !@$res;
my @keys = reverse sort grep { $_ ne 'id' } keys %{ $res->[0] };
my @lines; # = join ' | ', map {
#my $e = $_;
#$e =~ s/_/ /g;
#$e =~ s/\b(?:im|id)\b/uc($&)/eg;
#$e =~ s/\b[A-Za-z]+\b/ucfirst($&)/eg;
#$e;
#} @keys;
for my $line (@$res) {
my @items;
for my $key (@keys) {
my $val = $line->{$key};
if (!defined $val) { $val = '' }
#$val = decode('utf8', $val);
$val =~ s/^\+86-//g;
$val =~ s/\&/\&/g;
push @items, $val;
}
push @lines, join ' | ', @items;
}
return join "\n", @lines;
}
sub tcn {
my ($self, $pattern, $text, $cmd, $say, $sender) = @_;
$text =~ s/$pattern//;
$text =~ s/\n+//sg;
if ($text) {
my $url;
my $dec_text = $text;
$text = encode('utf8', $text);
if (defined $dec_text && $dec_text =~ /\p{Han}+/) {
$url = "http://translate.google.cn/translate_a/t?client=t&text=$text&sl=zh-CN&tl=en";
}
else {
$url = "http://translate.google.cn/translate_a/t?client=t&text=$text&sl=en&tl=zh-CN";
}
my $res = $ua->get($url);
my $msg;
if ($res->is_success) {
$msg = $res->content;
$msg = $json_xs->decode($msg);
}
else {
$msg = 'sorry! somsomething is wrong.....';
}
$msg = decode('utf8', $msg);
$say->("$sender: $msg");
}
}
sub tdcn {
my ($self, $pattern, $text, $cmd, $say, $sender) = @_;
$text =~ s/$pattern//;
$text =~ s/\n+//sg;
if ($text) {
my $url;
# warn "1: $text\n";
my $dec_text = $text;
$text = encode('utf8', $text);
if ($dec_text =~ /\p{Han}+/) {
$url = "http://translate.google.cn/translate_dict/feeds?client=tr&restrict=pr&q=$text&langpair=zh-CN|en";
}
else {
$url = "http://translate.google.cn/translate_dict/feeds?client=tr&restrict=pr&q=$text&langpair=en|zh-CN";
}
my $res = $ua->get($url);
my $msg;
if ($res->is_success) {
$msg = tdcn_html_extract($res->content);
}
else {
$msg = 'sorry!, something is wrong....';
}
if (defined $msg) {
my $cnt = 0;
for (split "\n", $msg) {
next if $_ eq $text;
last if $cnt++ == 6;
$_ = decode('utf8', $_);
$say->("$sender: $_");
}
} else {
$say->("$sender: sorry, 0 hits.....");
}
}
}
sub tdcn_html_extract {
my $html = shift;
my $res;
while ($html =~ m{\s*(.+)\s*}mg){
$res .= "$1\n";
}
# warn "res: $res";
return $res;
}
1;