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;