use Irssi; use HTML::Scrape (); use anidb::scrape (); use URI::Escape (); use Storable (); use LWP::UserAgent (); use Encode (); use utf8; use HTML::Entities (); use Compress::Zlib (); use MIME::Base64 (); use subs qw(debug); our ($VERSION, %IRSSI, %SCRAPE); BEGIN { $VERSION = 0; # >_> %IRSSI = ( authors => 'Justin Lee, Tristan Willy', description => 'Scrape info from AniDB.net!', url => 'http://pikabot.googlecode.com/', contact => 'kool.name/tristan.willy at gmail.com', name => 'anidb' ); %SCRAPE = (); } sub debug(@) { Irssi::settings_get_bool("$IRSSI{name}_debug") or do { return (); }; print( join(': ', [caller(1)]->[3], @_) ); } sub message($$$$;$) { my ($server, $message, $nick, $address, $target) = @_; $message =~ /^\s*!anidb\s+(.*)/i or do { return (); }; length(my $query = $1) or do { return (); }; my %info; if ($query =~ /^\s*a?(?:id:?)?(\d+)\s*$/i) { %info = fetch($1) or do { $server->send_message( (defined($target) ? $target : $nick), "Sorry, $nick, I was unable to fetch .", not defined($target) ); return (); }; } else { %info = search($query) or do { $server->send_message( (defined($target) ? $target : $nick), "Sorry, $nick, I was unable to search for <$query>.", not defined($target) ); return (); }; } exists($info{SEARCH}) and do { @{$info{SEARCH}} > 1 and do { my $message = '{Results}'; foreach my $t (@{$info{SEARCH}}[0..4]) { my ($aid, $title) = each(%{$t}); $message .= " $aid:[ $title ]"; } $server->send_message( (defined($target) ? $target : $nick), $message, not defined($target) ); }; my ($aid) = keys(%{$info{SEARCH}->[0]}); %info = fetch($aid) or do { $server->send_message( (defined($target) ? $target : $nick), "Sorry, $nick, I was unable to fetch .", not defined($target) ); return (); }; }; exists($info{FAILURE}) and do { $server->send_message( (defined($target) ? $target : $nick), "Sorry, $nick, $info{FAILURE}.", not defined($target) ); return (); }; my $message = "{$info{AID}} <$info{TITLE}>"; exists($info{TITLES}) and do { foreach my $t qw(japanese english french) { #XXX this should be some config option exists($info{TITLES}->{$t}) and do { $message .= ' <'. $info{TITLES}->{$t} .'>'; }; } }; my @fetch = grep { !/^(?:TITLES?|AID)$/ } map { uc } split( /\s*,\s*/, Irssi::settings_get_str("$IRSSI{name}_fetch") ); foreach my $k (@fetch) { exists($info{$k}) or do { next; }; foreach my $j (sort keys(%{$info{$k}})) { $message .= " \L\u$j\E:[ "; if (ref($info{$k}->{$j}) eq 'ARRAY') { $message .= join(', ', @{$info{$k}->{$j}}); } else { $message .= $info{$k}->{$j}; } $message .= ' ]'; } } $message .= ' Link:[ '. aid_to_url($info{AID}) .' ]'; $server->send_message( (defined($target) ? $target : $nick), $message, not defined($target) ); } sub searchify($) { (defined($_[0]) and length($_[0])) or do { debug( 'Invalid input', (defined($_[0]) ? 'Zero-length value' : 'Undefined value') ); return (undef); }; # clean up white space chomp($_[0]); $_[0] =~ s/^\s+//; $_[0] =~ s/\s+$//; $_[0] =~ s/\s+/ /g; # escape the values $_[0] = URI::Escape::uri_escape($_[0]); # AniDB hack $_[0] =~ s/\%20/+/g; return ($_[0]); } sub aid_to_url($) { $_[0] =~ /^\s*(\d+)\s*$/ or do { debug( 'Invalid input', (defined($_[0]) ? $_[0] : 'Undefined value') ); return (undef); }; return ("http://anidb.net/a$1"); } sub url_type($) { $_[0] =~ /anidb\.(?:net|info).*\ba(?:id=)?\d+/i } sub url_to_aid($) { $_[0] =~ /anidb\.(?:net|info).*\ba(?:id=)?(\d+)/i or do { debug( 'Invalid input', (defined($_[0]) ? $_[0] : 'Undefined value') ); return (undef); }; return ($1); } sub aid_to_local($) { $_[0] =~ s/^\s*(\d+)\s*$/$1/ or do { debug( 'Invalid input', (defined($_[0]) ? $_[0] : 'Undefined value') ); return (undef); }; -d (my $dir = Irssi::settings_get_str("$IRSSI{name}_aid_dir")) or do { debug( 'Required setting not configured correctly', "$IRSSI{name}_aid_dir" ); return (undef); }; return ( join( '/', $dir, $_[0] ) ); } sub search_to_url($) { (defined($_[0]) and length($_[0])) or do { debug( 'Invalid input', (defined($_[0]) ? 'Zero-length value' : 'Undefined value') ); return (undef); }; return ( 'http://anidb.net/perl-bin/animedb.pl?show=animelist&adb.search='. $_[0]. '&do.search=search' ); } sub search_to_local($) { (defined($_[0]) and length($_[0])) or do { debug( 'Invalid input', (defined($_[0]) ? 'Zero-length value' : 'Undefined value') ); return (undef); }; -d (my $dir = Irssi::settings_get_str("$IRSSI{name}_query_dir")) or do { debug( 'Required setting not configured correctly', "$IRSSI{name}_query_dir" ); return (undef); }; #XXX: This is weird. :/ chomp(my $file = join('/', $dir, MIME::Base64::encode_base64($_[0]))); $file =~ s/\s*$//; return ($file); } sub purge($) { #XXX return (1); #XXX } # XXX XXX sub download($) { (defined($_[0]) and length($_[0])) or do { debug( 'Invalid input', (defined($_[0]) ? 'Zero-length value' : 'Undefined value') ); return (undef); }; ref(my $ua = LWP::UserAgent->new) or do { debug( 'Unable to build LWP::UserAgent object' ); return (undef); }; ref(my $rq = HTTP::Request->new(GET => $_[0])) or do { debug( 'Unable to build HTTP::Request object' ); return (undef); }; length(my $ref = Irssi::settings_get_str("$IRSSI{name}_lwp_refer")) or do { debug( 'Required setting not configured correctly', "$IRSSI{name}_lwp_refer" ); return (undef); }; $rq->header(Referer => $ref); $ua->timeout(Irssi::settings_get_int("$IRSSI{name}_lwp_timeout")); $ua->agent(Irssi::settings_get_str("$IRSSI{name}_lwp_agent")); defined(my $page = $ua->request($rq)) or do { debug( 'Request failed', $_[0] ); return (undef); }; $page->is_success or do { debug( 'Request was not successful', $page->code ); return (undef); }; return ( #XXX: Decoding the whole page is... well... a lot. # This should probably be moved to parse(), maybe # decode all the entities as they are stored in # the %info hash, or something. HTML::Entities::decode_entities( Encode::decode( 'utf8', (($page->content_encoding and $page->content_encoding eq 'gzip') ? Compress::Zlib::memGunzip($page->content) : $page->content) ) ), url_type($page->base) ); } sub parse_fetch($) { (defined($_[0]) and length($_[0])) or do { debug( 'Invalid input', (defined($_[0]) ? 'Zero-length value' : 'Undefined value') ); return (); }; my %info = (FETCHED => time); ref( my $scraper = HTML::Scrape->new( Machine => anidb::scrape->TITLE ) ) or do { debug( 'Unable to build scraper' ); return (); }; my @data = $scraper->scrape($_[0]) or do { return (); }; $info{AID} = each(%{$data[0]}); $info{TITLE} = $data[0]->{$info{AID}}; my @fetch = grep { eval('my $s = anidb::scrape->$_;') #XXX filter out bad names } map { uc # just because } split( /\s*,\s*/, Irssi::settings_get_str("$IRSSI{name}_fetch") ); foreach my $f (@fetch) { exists($info{$f}) and do { next; }; ref( $scraper = HTML::Scrape->new( Machine => anidb::scrape->$f ) ) or do { debug( 'Unable to construct machine', $f ); }; @data = $scraper->scrape($_[0]) or do { next; }; exists($SCRAPE{$f}) and do { @data = ($SCRAPE{$f}->(@data)); }; $info{$f} = ( @data > 1 ? ({ map { each(%{$_}) } @data }) : $data[0] ); } return (%info); } sub parse_search($) { (defined($_[0]) and length($_[0])) or do { debug( 'Invalid input', (defined($_[0]) ? 'Zero-length value' : 'Undefined value') ); return (); }; ref( my $scraper = HTML::Scrape->new( Machine => anidb::scrape->SEARCH ) ) or do { debug( 'Unable to build scraper' ); return (); }; my @data = $scraper->scrape($_[0]) or do { return (); }; return ( SEARCH => \@data, FETCHED => time ); } sub parse($$) { (defined($_[0]) and length($_[0])) or do { debug( 'Invalid input', (defined($_[0]) ? 'Zero-length value' : 'Undefined value') ); return (); }; my %info = ( $_[1] ? parse_fetch($_[0]) : parse_search($_[0]) ) or do { $scraper = HTML::Scrape->new( Machine => anidb::scrape->FAILURE ); my @fail = $scraper->scrape($_[0]) or do { debug( 'Unknown scrape failure, aborting' ); return (); }; return (each(%{$fail[0]})); }; return (%info); } sub fetch_remote($) { defined(my $url = aid_to_url($_[0])) or do { debug( 'Unable to generate URL' ); return (); }; my ($page, $type) = download($url) or do { debug( 'Unable to download URL', $url ); return (); }; return (parse($page, $type)); } sub fetch_local($) { defined(my $stored = aid_to_local($_[0])) or do { debug( 'Unable to generate file name' ); return (); }; -f $stored or do { return (); }; my $timeout = Irssi::settings_get_int( "$IRSSI{name}_file_timeout" ); my $info; #sigh... eval { $info = Storable::lock_retrieve($stored); }; $@ and do { debug( 'Unable to retrieve file', $stored ); return (); }; (time - $info->{FETCHED}) > $timeout and do { purge($stored) or do { debug( 'Unable to purge old file', $stored ); }; return (); }; return (%{$info}); } sub store_fetch($\%) { defined(my $store = aid_to_local($_[0])) or do { debug( 'Unable to generate file name' ); return (undef); }; eval { Storable::lock_store($_[1], $store); }; $@ and do { debug( 'Unable to store AID', $store ); return (undef); }; return (1); } sub fetch($) { (defined($_[0]) and $_[0] =~ /^\s*(\d+)\s*$/) or do { debug( 'Invalid input', (defined($_[0]) ? $_[0] : 'Undefined value') ); return (); }; my ($aid, %info) = ($1, $_[1]); %info = fetch_local($aid) or do { %info = fetch_remote($aid) or do { debug( 'Unable to fetch aid', $aid ); return (); }; store_fetch($aid, %info) or do { debug( 'Unable to store aid', $aid ); }; }; return (%info); } sub search_remote($) { defined(my $url = search_to_url($_[0])) or do { debug( 'Unable to generate URL' ); return (); }; my ($page, $type) = download($url) or do { debug( 'Unable to download URL', $url ); return (); }; return (parse($page, $type)); } sub search_local($) { defined(my $stored = search_to_local($_[0])) or do { debug( 'Unable generate file name' ); return (); }; -f $stored or do { return (); }; my $timeout = Irssi::settings_get_int( "$IRSSI{name}_file_timeout" ); my $search; #sigh... eval { $search = Storable::lock_retrieve($stored); }; $@ and do { debug( 'Unable to retrieve file', $stored ); return (); }; (time - $search->{FETCHED}) > $timeout and do { purge($stored) or do { debug( 'Unable to purge old file', $stored ); }; return (); }; return (%{$search}); } sub store_search($\%) { defined(my $store = search_to_local($_[0])) or do { debug( 'Unable to generate file name' ); return (undef); }; eval { Storable::lock_store($_[1], $store); }; $@ and do { debug( 'Unable to store search', $store ); return (undef); }; return (1); } sub search($) { defined(my $search = searchify($_[0])) or do { debug( 'Unable to generate search string' ); return (); }; my %info; %info = search_local($search) or do { %info = search_remote($search) or do { debug( 'Unable to search string', $search ); return (); }; if (exists($info{SEARCH})) { store_search($search, %info) or do { debug( 'Unable to store search', $search ); }; } elsif(exists($info{FAILURE})) { return (%info); } else { store_search( $search, %{ { SEARCH => [ { $info{AID} => $info{TITLE} } ], FETCHED => $info{FETCHED}, } } ) or do { debug( 'Unable to store search', $search ); }; store_fetch($info{AID}, %info) or do { debug( 'Unable to store AID', $info{AID} ); }; } }; if (exists($info{SEARCH})) { return (%info); } else { return ( %{ { SEARCH => [ { $info{AID} => $info{TITLE} } ], FETCHED => $info{FETCHED}, } } ); } } Irssi::settings_add_bool( $IRSSI{name}, "$IRSSI{name}_debug", 1 ); Irssi::settings_add_bool( $IRSSI{name}, "$IRSSI{name}_verbose", 0 ); Irssi::settings_add_str( $IRSSI{name}, "$IRSSI{name}_fetch", '' ); Irssi::settings_add_str( $IRSSI{name}, "$IRSSI{name}_lwp_agent", 'Mozilla/5.0 (X11; U; Linux; i686; en-US; '. 'rv:1.9.0.13; fixing your api would make life easier) '. 'Gecko/2009073022 Firefox/3.0.13' ); Irssi::settings_add_str( $IRSSI{name}, "$IRSSI{name}_aid_dir", '~/.irssi/anidb/aid' ); Irssi::settings_add_str( $IRSSI{name}, "$IRSSI{name}_query_dir", '~/.irssi/anidb/query' ); Irssi::settings_add_str( $IRSSI{name}, "$IRSSI{name}_lwp_refer", 'http://www.anidb.net/perl-bin/animedb.pl' ); Irssi::settings_add_int( $IRSSI{name}, "$IRSSI{name}_lwp_timeout", 30 ); Irssi::settings_add_int( $IRSSI{name}, "$IRSSI{name}_file_timeout", 864000 # 10 days, in seconds ); Irssi::settings_add_bool( $IRSSI{name}, "$IRSSI{name}_file_purge", 1 ); Irssi::signal_add( 'message public', 'message' ); Irssi::signal_add( 'message private', 'message' );