# # Multi::Anime - Fetches anime info from AniDB # package Multi::Anime; use strict; use warnings; use POE 'Wheel::UDP', 'Filter::Stream'; use Tie::ShareLite ':lock'; use Socket 'inet_ntoa'; use Time::HiRes 'time'; sub TIMEOUT () { 100 } # not part of the API sub LOGIN_ACCEPTED () { 200 } sub LOGIN_ACCEPTED_NEW_VER () { 201 } sub ANIME () { 230 } sub NO_SUCH_ANIME () { 330 } sub NOT_LOGGED_IN () { 403 } sub LOGIN_FIRST () { 501 } sub CLIENT_BANNED () { 504 } sub INVALID_SESSION () { 506 } sub BANNED () { 555 } sub ANIDB_OUT_OF_SERVICE () { 601 } sub SERVER_BUSY () { 602 } my @expected_codes = ( TIMEOUT, LOGIN_ACCEPTED, LOGIN_ACCEPTED_NEW_VER, ANIME, NO_SUCH_ANIME, NOT_LOGGED_IN, LOGIN_FIRST, INVALID_SESSION ); sub spawn { # The 'anime' command doesn't actually do anything, it just # adds IDs to process to the internal queue, which is seperate # from the global processing queue. # This module -only- fetches anime information in daemon mode! # Calling the anime command with an ID as argument will force # the information to be refreshed. This is not recommended, # just use 'anime' for normal usage. my $p = shift; POE::Session->create( package_states => [ $p => [qw| _start shutdown cmd_anime nextcmd receivepacket updateanime |], ], heap => { # POE::Wheels::UDP options LocalAddr => '0.0.0.0', LocalPort => 9000, PeerAddr => do { if(!$Multi::DAEMONIZE) { my $a = gethostbyname('api.anidb.info'); die "ERROR: Couldn't resolve domain" if !defined $a; inet_ntoa($a); } else { 0; } }, PeerPort => 9000, # AniDB UDP API options client => 'multi', clientver => 1, # Misc settings msgdelay => 10, timeout => 30, timeoutdelay => 0.4, # $delay = $msgdelay ^ (1 + $tm*$timeoutdelay) maxtimeoutdelay => 2*3600, # two hours cachetime => 30*24*3600, # one month # AniDB anime types: types => [ [ 'unknown', 'unknown', ], [ 'TV', 'TV Series' ], [ 'OVA', 'OVA' ], [ 'Movie', 'Movie' ], [ 'unknown', 'Other' ], [ 'unknown', 'Web' ], [ 'TV Special', 'TV Special' ], [ 'unknown', 'Music Video' ], ], @_, w => undef, s => '', # session key, '' = not logged in tm => 0, # number of repeated timeouts lm => 0, # timestamp of last outgoing message, 0=no running msg aid => 0, # anime ID of the last sent ANIME command tag => int(rand()*50000), }, ); } sub _start { $_[KERNEL]->alias_set('anime'); $_[KERNEL]->call(core => register => qr/^anime(?: ([0-9]+))?$/, 'cmd_anime'); # check for anime twice a day $_[KERNEL]->post(core => addcron => '0 0,12 * * *', 'anime'); $_[KERNEL]->sig('shutdown' => 'shutdown'); if(!$Multi::DAEMONIZE) { # init the UDP 'connection' $_[HEAP]{w} = POE::Wheel::UDP->new( (map { $_ => $_[HEAP]{$_} } qw| LocalAddr LocalPort PeerAddr PeerPort |), InputEvent => 'receivepacket', Filter => POE::Filter::Stream->new(), ); # start executing commands $_[KERNEL]->delay(nextcmd => 0); #$_[HEAP]{msgdelay}); } } sub shutdown { undef $_[HEAP]{w}; $_[KERNEL]->delay('nextcmd'); $_[KERNEL]->delay('receivepacket'); } sub cmd_anime { # cmd, arg my @push; if(!$_[ARG1]) { # only animes we have never fetched, or haven't been updated for a month my $q = $Multi::SQL->prepare(q| SELECT id FROM anime WHERE lastfetch < ? AND lastfetch <> -1|); $q->execute(int(time-$_[HEAP]{cachetime})); push @push, map $_->[0], @{$q->fetchall_arrayref([])}; $_[KERNEL]->call(core => log => 2, 'All anime info is up-to-date!') if !@push; } else { push @push, $_[ARG1]; } if(@push) { my $s = tie my %s, 'Tie::ShareLite', -key => $VNDB::S{sharedmem_key}, -create => 'yes', -destroy => 'no', -mode => 0666; $s->lock(LOCK_EX); my @q = $s{anime} ? @{$s{anime}} : (); push @q, grep { my $ia = $_; !(scalar grep $ia == $_, @q) } @push; $s{anime} = \@q; $s->unlock(); } $_[KERNEL]->post(core => finish => $_[ARG0]); } sub nextcmd { return if $_[HEAP]{lm}; my $s = tie my %s, 'Tie::ShareLite', -key => $VNDB::S{sharedmem_key}, -create => 'yes', -destroy => 'no', -mode => 0666; my @q = $s{anime} ? @{$s{anime}} : (); undef $s; if(!@q) { # nothing to do... $_[KERNEL]->delay(nextcmd => $_[HEAP]{msgdelay}); return; } my %cmd; # not logged in, get a session if(!$_[HEAP]{s}) { %cmd = ( command => 'AUTH', user => $_[HEAP]{user}, pass => $_[HEAP]{pass}, protover => 3, client => $_[HEAP]{client}, clientver => $_[HEAP]{clientver}, enc => 'UTF-8', ); $_[KERNEL]->call(core => log => 3, 'Authenticating with AniDB...'); } # logged in, get anime else { $_[HEAP]{aid} = $q[0]; %cmd = ( command => 'ANIME', aid => $q[0], acode => 3973121, # aid, ANN id, NFO id, year, type, romaji, kanji ); $_[KERNEL]->call(core => log => 3, 'Fetching info for a%d', $q[0]); } # send command my $cmd = delete $cmd{command}; $cmd{tag} = ++$_[HEAP]{tag}; $cmd{s} = $_[HEAP]{s} if $_[HEAP]{s}; $cmd .= ' '.join('&', map { $cmd{$_} =~ s/&/&/g; $cmd{$_} =~ s/\r?\n/
/g; $_.'='.$cmd{$_} } keys %cmd); $_[HEAP]{w}->put({ payload => [ $cmd ]}); #$_[KERNEL]->call(core => log => 3, '> %s', $cmd); $_[KERNEL]->delay(receivepacket => $_[HEAP]{timeout}, { payload => [ $_[HEAP]{tag}.' 100 TIMEOUT' ] }); $_[HEAP]{lm} = time; } sub receivepacket { # input, wheelid $_[KERNEL]->delay('receivepacket'); # disable the timeout my @r = split /\n/, $_[ARG0]{payload}[0]; my $delay = $_[HEAP]{msgdelay}; my($tag, $code, $msg) = ($1, $2, $3) if $r[0] =~ /^([0-9]+) ([0-9]+) (.+)$/; if(!grep $_ == $code, @expected_codes) { $_[KERNEL]->call(core => log => 1, "Received an unexpected reply after %.2fs!\n < %s", time-$_[HEAP]{lm}, join("\n < ", @r)); } else { $_[KERNEL]->call(core => log => 3, 'Received from AniDB after %.2fs: %d %s', time-$_[HEAP]{lm}, $code, $msg); } # just handle anime data, even if the tag is not correct if($code == ANIME) { $_[KERNEL]->yield(updateanime => $_[HEAP]{aid}, $r[1]); } # tag incorrect, ignore message if($tag != $_[HEAP]{tag}) { $_[KERNEL]->call(core => log => 3, 'Ignoring incorrect tag') if $code != ANIME; return; } # try again later if($code == TIMEOUT || $code == CLIENT_BANNED || $code == BANNED || $code == ANIDB_OUT_OF_SERVICE || $code == SERVER_BUSY) { $_[HEAP]{tm}++; $delay = $_[HEAP]{msgdelay}**(1 + $_[HEAP]{tm}*$_[HEAP]{timeoutdelay}); $delay = $_[HEAP]{maxtimeoutdelay} if $delay > $_[HEAP]{maxtimeoutdelay}; $_[KERNEL]->call(core => log => 1, 'Delaying %.0fs.', $delay); } # oops, wrong id if($code == NO_SUCH_ANIME) { $_[KERNEL]->yield(updateanime => $_[HEAP]{aid}, 'notfound'); } # ok, we have a session now if($code == LOGIN_ACCEPTED || $code == LOGIN_ACCEPTED_NEW_VER) { $_[HEAP]{s} = $1 if $msg =~ /^\s*([a-zA-Z0-9]{4,8}) /; } # oops, we should've logged in, get a new session if($code == NOT_LOGGED_IN || $code == LOGIN_FIRST || $code == INVALID_SESSION) { $_[HEAP]{s} = ''; } $_[HEAP]{lm} = $_[HEAP]{aid} = 0; $_[HEAP]{tm} = 0 if $delay == $_[HEAP]{msgdelay}; $_[KERNEL]->delay(nextcmd => $delay); } sub updateanime { # aid, data|'notfound' # aid, ANN id, NFO id, year, type, romaji, kanji, lastfetch my @col = $_[ARG1] eq 'notfound' ? ($_[ARG0], 0, 0, 0, 0, '', '', -1) : (split(/\|/, $_[ARG1], 7), int time); if($col[7] > 0) { for (@col) { $_ =~ s/
/\n/g; $_ =~ s/`/'/g; } $col[3] = $1 if $col[3] =~ /^([0-9]+)/; # remove multi-year stuff for(0..$#{$_[HEAP]{types}}) { $col[4] = $_ if lc($_[HEAP]{types}[$_][1]) eq lc($col[4]); } $col[4] = 0 if $col[4] !~ /^[0-9]+$/; $col[2] = '' if $col[2] =~ /^0,/; } # try to UPDATE first my $r = $Multi::SQL->do(q| UPDATE anime SET id = ?, ann_id = ?, nfo_id = ?, year = ?, type = ?, title_romaji = ?, title_kanji = ?, lastfetch = ? WHERE id = ?|, undef, @col, $col[0]); # fall back to INSERT when nothing was updated $Multi::SQL->do(q| INSERT INTO anime (id, ann_id, nfo_id, year, type, title_romaji, title_kanji, lastfetch) VALUES (?, ?, ?, ?, ?, ?, ?, ?)|, undef, @col) if $r < 1; # remove from queue my $s = tie my %s, 'Tie::ShareLite', -key => $VNDB::S{sharedmem_key}, -create => 'yes', -destroy => 'no', -mode => 0666; $s->lock(LOCK_EX); my @q = grep $_ != $_[ARG0], ($s{anime} ? @{$s{anime}} : ()); $s{anime} = \@q; $s->unlock(); $col[7] > 0 ? $_[KERNEL]->post(core => log => 2, 'Updated anime info for a%d', $col[0]) : $_[KERNEL]->post(core => log => 1, 'Anime a%d not found!', $col[0]); } 1;