From d2efb163c11a11e02abd7251fdfde3cb54c710ef Mon Sep 17 00:00:00 2001 From: yorhel Date: Thu, 24 Apr 2008 17:48:59 +0000 Subject: See the diff for lib/ChangeLog... git-svn-id: svn://vndb.org/vndb@4 1fe2e327-d9db-4752-bcf7-ef0cb4a1748b --- lib/ChangeLog | 7 ++ lib/Multi/Core.pm | 128 +++++++++++++++++++++++ lib/Multi/IRC.pm | 179 ++++++++++++++++++++++++++++++++ lib/Multi/RG.pm | 248 ++++++++++++++++++++++++++++++++++++++++++++ lib/Multi/Sitemap.pm | 156 ++++++++++++++++++++++++++++ lib/VNDB.pm | 13 +-- lib/VNDB/Util/DB.pm | 20 ++-- lib/VNDB/Util/Tools.pm | 33 +++--- lib/VNDB/VN.pm | 9 +- lib/global.pl | 3 + util/cleanimg.pl | 11 +- util/multi.pl | 96 +++++++++++++++++ util/relgraph.pl | 26 ++--- util/sitemap.pl | 5 +- util/updates/update_1.14.pl | 3 +- 15 files changed, 879 insertions(+), 58 deletions(-) create mode 100644 lib/Multi/Core.pm create mode 100644 lib/Multi/IRC.pm create mode 100644 lib/Multi/RG.pm create mode 100644 lib/Multi/Sitemap.pm create mode 100755 util/multi.pl mode change 100755 => 100644 util/relgraph.pl mode change 100755 => 100644 util/sitemap.pl mode change 100755 => 100644 util/updates/update_1.14.pl diff --git a/lib/ChangeLog b/lib/ChangeLog index 7f98bd3a..c161ab9c 100644 --- a/lib/ChangeLog +++ b/lib/ChangeLog @@ -9,6 +9,13 @@ TODO: - relation graphs and cover images now get an ID instead of MD5-sum - Added Nintendo Wii to platforms - Added 'hidden' flag, which should now be used instead of the delete option + - Fixed the ordering of nodes in the relation graphs + - Used global.pl as the central location of the PgSQL login info + - Wrote a daemon which handles several tasks: + - Generation of relation graphs + - Generation of the sitemap.xml.gz + - The IRC bot + + TODO: scaling/compressing of cover images 1.13 - 2008-04-04 - Fixed update_prev diff --git a/lib/Multi/Core.pm b/lib/Multi/Core.pm new file mode 100644 index 00000000..1eea66ca --- /dev/null +++ b/lib/Multi/Core.pm @@ -0,0 +1,128 @@ + +# +# Multi::Core - handles logging and the main command queue +# + +package Multi::Core; + +use strict; +use warnings; +use POE; +use Storable 'freeze', 'thaw'; +use IPC::ShareLite ':lock'; +use Time::HiRes 'time', 'gettimeofday', 'tv_interval'; # overload time() + + +sub spawn { + my $p = shift; + POE::Session->create( + package_states => [ + $p => [qw| _start register fetch queue execute finish log cmd_exit |], + ], + heap => { queue => [], cmds => [], running => 0, starttime => 0 }, + ); +} + + +sub _start { + $_[KERNEL]->alias_set('core'); + $_[KERNEL]->call(core => register => qr/^(exit|reload)$/, 'cmd_exit'); + $_[KERNEL]->yield(queue => $_) for (grep !/^-/, @ARGV); + $_[KERNEL]->yield(fetch => time) if $Multi::DAEMONIZE != 1; +} + + +sub register { # regex, state + push @{$_[HEAP]{cmds}}, [ $_[ARG0], $_[SENDER], $_[ARG1] ]; + (my $p = $_[SENDER][2]{$_[CALLER_STATE]}[0]) =~ s/^Multi:://; # NOT PORTABLE + $_[KERNEL]->call(core => log => 3, "Command '%s' handled by %s::%s", $_[ARG0], $p, $_[ARG1]); +} + + +sub fetch { # lastfetch + my $s = IPC::ShareLite->new(-key => $VNDB::SHMKEY,-create => 1, -destroy => 0); + $s->lock(LOCK_SH); + my $l = $s->fetch(); + if($l) { + my $cmds = thaw($l); + $_[KERNEL]->yield(queue => $_) for(@$cmds); + $s->lock(LOCK_EX); + $s->store(''); + } + $s->unlock; + undef $s; + + $_[KERNEL]->call(core => log => 1, 'Heartbeat took %.2fs, possible block', time-$_[ARG0]) + if time > $_[ARG0]+3; + $_[KERNEL]->delay(fetch => 1, time) if $Multi::DAEMONIZE == 0; +} + + +sub queue { # cmd + push @{$_[HEAP]{queue}}, $_[ARG0]; + $_[KERNEL]->call(core => log => 3, "Queuing '%s'. Queue size: %d", $_[ARG0], scalar @{$_[HEAP]{queue}}); + if(!$_[HEAP]{running}) { + $_[KERNEL]->yield(execute => $_[ARG0]); + $_[HEAP]{running} = 1; + } +} + + +sub execute { # cmd + $_[HEAP]{starttime} = [ gettimeofday ]; + my $cmd = (grep { $_[ARG0] =~ /$_->[0]/ } @{$_[HEAP]{cmds}})[0]; + if(!$cmd) { + $_[KERNEL]->call(core => log => 1, 'Unknown cmd: %s', $_[ARG0]); + $_[KERNEL]->yield(finish => $_[ARG0]); + return; + } + $_[KERNEL]->call(core => log => 2, 'Executing cmd: %s', $_[ARG0]); + $_[ARG0] =~ /$cmd->[0]/; # determine arguments (see perlvar for the magic) + my @arg = $#- ? map { substr $_[ARG0], $-[$_], $+[$_]-$-[$_] } 1..$#- : (); + $_[KERNEL]->post($cmd->[1] => $cmd->[2], $_[ARG0], @arg); +} + + +sub finish { # cmd [, stop ] + $_[HEAP]{running} = 0; + $_[HEAP]{queue} = [ grep { $_ ne $_[ARG0] } @{$_[HEAP]{queue}} ]; + $_[KERNEL]->call(core => log => 2, "Unqueuing '%s' after %.2fs. Queue size: %d", + $_[ARG0], tv_interval($_[HEAP]{starttime}), scalar @{$_[HEAP]{queue}}); + if(@{$_[HEAP]{queue}} && !$_[ARG1]) { + $_[KERNEL]->yield(execute => $_[HEAP]{queue}[0]); + $_[HEAP]{running} = 1; + } +} + + +sub log { # level, msg + return if $_[ARG0] > $Multi::LOGLVL; + #open(my $F, \&STDOUT); #'>>', $Multi::LOGDIR.'/multi.log'); + (my $p = $_[SENDER][2]{$_[CALLER_STATE]}[0]) =~ s/^Multi:://; # NOT PORTABLE + printf "[%s] (%s) %s::%s: %s\n", scalar localtime, + (qw|WRN ACT DBG|)[$_[ARG0]-1], $p, $_[CALLER_STATE], + $_[ARG2] ? sprintf($_[ARG1], @_[ARG2..$#_]) : $_[ARG1]; + #close $F; +} + + +sub cmd_exit { + $Multi::RESTART = 1 if $_[ARG0] eq 'reload'; + $_[KERNEL]->call(core => finish => $_[ARG0], 1); + $_[KERNEL]->call(core => log => 2, 'Exiting...'); + + + my $s = IPC::ShareLite->new(-key => 'VNDB',-create => 1, -destroy => 0); + $s->lock(LOCK_EX); + $s->store(freeze($_[HEAP]->{queue})); + $s->unlock(); + undef $s; + + $_[KERNEL]->delay('fetch'); # This'll make the current session stop + $_[KERNEL]->signal($_[KERNEL], 'shutdown'); # Broadcast to other sessions +} + + +1; + + diff --git a/lib/Multi/IRC.pm b/lib/Multi/IRC.pm new file mode 100644 index 00000000..3ab4790a --- /dev/null +++ b/lib/Multi/IRC.pm @@ -0,0 +1,179 @@ + +# +# Multi::IRC - HMX-12 Multi, the IRC bot +# + +package Multi::IRC; + +use strict; +use warnings; +use POE qw| + Component::IRC::State + Component::IRC::Plugin::Connector + Component::IRC::Plugin::CTCP + Component::IRC::Plugin::Logger + Component::IRC::Plugin::NickServID +|; +use POE::Component::IRC::Common ':ALL'; + + +sub spawn { + return if $Multi::DAEMONIZE != 0; # we don't provide any commands, after all + + my $p = shift; + my $irc = POE::Component::IRC::State->spawn( + alias => 'circ', + NoDNS => 1, + ); + POE::Session->create( + package_states => [ + $p => [qw| _start irc_001 irc_public irc_ctcp_action irc_msg vndbid shutdown |], + ], + heap => { irc => $irc, + o => { + user => 'Multi', + server => 'irc.synirc.net', + ircname => 'VNDB.org Multi', + channel => '#vndb', + @_ + } + } + ); +} + + +sub _start { + $_[KERNEL]->alias_set('irc'); + + $_[HEAP]{irc}->plugin_add( + Logger => POE::Component::IRC::Plugin::Logger->new( + Path => $Multi::LOGDIR, + Private => 0, + Public => 1, + )); + $_[HEAP]{irc}->plugin_add( + Connector => POE::Component::IRC::Plugin::Connector->new() + ); + $_[HEAP]{irc}->plugin_add( + CTCP => POE::Component::IRC::Plugin::CTCP->new( + version => $_[HEAP]{o}{ircname}.' v'.$Multi::VERSION, + userinfo => $_[HEAP]{o}{ircname}, + )); + $_[HEAP]{irc}->plugin_add( + NickServID => POE::Component::IRC::Plugin::NickServID->new( + Password => $_[HEAP]{o}{pass} + )) if $_[HEAP]{o}{pass}; + + $_[KERNEL]->post(circ => register => 'all'); + $_[KERNEL]->post(circ => connect => { + Nick => $_[HEAP]{o}{user}, + Username => 'u1', + Ircname => $_[HEAP]{o}{ircname}, + Server => $_[HEAP]{o}{server}, + }); + + $_[KERNEL]->sig('shutdown' => 'shutdown'); +} + + +sub irc_001 { + $_[KERNEL]->post(circ => join => $_[HEAP]{o}{channel}); + $_[KERNEL]->call(core => log => 2, 'Connected to IRC!'); +} + + +sub irc_public { + if($_[ARG2] =~ /^!info/) { + $_[KERNEL]->post(circ => privmsg => $_[ARG1][0], + 'Hello, I am HMX-12 Multi v'.$Multi::VERSION.' made by the great Yorhel! (Please ask Ayo for more info)'); + } else { + $_[KERNEL]->call(irc => vndbid => $_[ARG1][0], $_[ARG2]); + } +} + + +sub irc_ctcp_action { + $_[KERNEL]->call(irc => vndbid => $_[ARG1][0], $_[ARG2]); +} + + +sub irc_msg { + my $nick = ( split /!/, $_[ARG0] )[0]; + + if(!$_[HEAP]{irc}->is_channel_operator($_[HEAP]{o}{channel}, $nick) + && !$_[HEAP]{irc}->is_channel_owner($_[HEAP]{o}{channel}, $nick) + && !$_[HEAP]{irc}->is_channel_admin($_[HEAP]{o}{channel}, $nick)) { + $_[KERNEL]->post(circ => privmsg => $nick, 'You are not my master'); + return; + } + + my $m = $_[ARG2]; + if($m =~ /^say (.+)$/) { + $_[KERNEL]->post(circ => privmsg => $_[HEAP]{o}{channel}, $1); } + elsif($m =~ /^me (.+)$/) { + $_[KERNEL]->post(circ => ctcp => $_[HEAP]{o}{channel}, "ACTION $1"); } + elsif($m =~ /^cmd (.+)$/) { + $_[KERNEL]->post(core => queue => $1); } + elsif($m =~ /^eval (.+)$/) { + $_[KERNEL]->post(circ => privmsg => $nick, 'eval: '.$_) + for (split /\r?\n/, eval($1)||$@); } + else { + $_[KERNEL]->post(circ => privmsg => $nick, 'Unkown command'); } + + # TODO: add command to view the current queue, and a method to send log messages +} + + +sub vndbid { # dest, msg + my $m = $_[ARG1]; + my @id; + push @id, [$1,$2,$3,$4] while $m =~ s/^(.*)([uvpr])([0-9]+)(.*)$/ $1 $4 /i; + for (reverse @id) { + next if $$_[0] =~ /(\.org\/|[a-z])$/i || $$_[3] =~ /^[a-z]/i; + my($t, $id) = (lc($$_[1]), $$_[2]); + my $s = $Multi::SQL->prepare( + $t eq 'v' ? 'SELECT vr.title FROM vn_rev vr JOIN vn v ON v.latest = vr.id WHERE v.id = ?' : + $t eq 'u' ? 'SELECT u.username AS title FROM users u WHERE u.id = ?' : + $t eq 'p' ? 'SELECT pr.name AS title FROM producers_rev pr JOIN producers p ON p.latest = pr.id WHERE p.id = ?' : + 'SELECT rr.title FROM releases_rev rr JOIN releases r ON r.latest = rr.id WHERE r.id = ?' + ); + $s->execute($id); + my $r = $s->fetchrow_hashref; + $s->finish; + next if !$r || ref($r) ne 'HASH'; + $_[KERNEL]->post(circ => privmsg => $_[ARG0], sprintf + BOLD.RED.'['.RED.'%s%d'.RED.']'.NORMAL.' %s '.RED.'@'.NORMAL.LIGHT_GREY.' http://vndb.org/%s%d'.NORMAL, + $t, $id, $r->{title}, $t, $id + ); + } +} + + +sub shutdown { + $_[KERNEL]->post(circ => shutdown => 'Byebye!'); +} + + +1; + + + +__END__ + +# debug +sub _default { + my($event,$args) = @_[ ARG0 .. $#_ ]; + my $arg_number = 0; + for (@$args) { + print " ARG$arg_number = "; + if ( ref($_) eq 'ARRAY' ) { + print "$_ = [", join ( ", ", @$_ ), "]\n"; + } + else { + print "'".($_||'')."'\n"; + } + $arg_number++; + } + return 0; +} + diff --git a/lib/Multi/RG.pm b/lib/Multi/RG.pm new file mode 100644 index 00000000..9133a7a6 --- /dev/null +++ b/lib/Multi/RG.pm @@ -0,0 +1,248 @@ + +# +# Multi::RG - Relation graph generator +# + +package Multi::RG; + +use strict; +use warnings; +use POE; +use Text::Unidecode; +use GraphViz; + + +sub spawn { + my $p = shift; + POE::Session->create( + package_states => [ + $p => [qw| _start cmd_relgraph creategraph getrel relscomplete buildgraph graphcomplete |], + ], + heap => { + font => 's', + fsize => [ 9, 7, 10 ], # nodes, edges, node_title + imgdir => '/www/vndb/static/rg', + datdir => '/www/vndb/data/rg', + moy => [qw| Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec |], + @_, + } + ); +} + + +sub _start { + $_[KERNEL]->alias_set('rg'); + $_[KERNEL]->call(core => register => qr/^relgraph ((?:[0-9]+)(?:\s+[0-9]+)*|all)$/, 'cmd_relgraph'); +} + + +sub cmd_relgraph { + $_[HEAP]{curcmd} = $_[ARG0]; + + # determine vns to generate graphs for + if($_[ARG1] ne 'all') { + $_[HEAP]{todo} = [ split /\s/, $_[ARG1] ]; + } else { + my $q = $Multi::SQL->prepare('SELECT id FROM vn WHERE hidden = 0'); + $q->execute; + $_[HEAP]{todo} = [ map { $_->[0] } @{$q->fetchall_arrayref([])} ]; + } + + # generate first graph + $_[KERNEL]->yield(creategraph => $_[HEAP]{todo}[0]); +} + + +sub creategraph { # id + # Function order: + # creategraph + # getrel (recursive) + # relscomplete + # if !rels + # graphcomplete + # else + # buildgraph + # graphcomplete + + $_[KERNEL]->call(core => log => 3, 'Processing graph for v%d', $_[ARG0]); + $_[HEAP]{gv} = GraphViz->new( + #width => 700/96, + height => 2000/96, + ratio => 'compress', + ); + + $_[HEAP]{rels} = {}; # relations (key=vid1-vid2, value=relation) + $_[HEAP]{nodes} = {}; # nodes (key=vid, value=[ vid, title, date, lang, processed ]) + $_[HEAP]{vid} = $_[ARG0]; + $_[KERNEL]->yield(getrel => $_[ARG0]); +} + + +sub getrel { # vid + #return if $_[HEAP]{nodes}{$_[ARG0]} && $_[HEAP]{nodes}{$_[ARG0]}[4]; + $_[KERNEL]->call(core => log => 3, 'Fetching relations for v%d', $_[ARG0]); + + my $s = $Multi::SQL->prepare(q| + SELECT vr1.vid AS vid1, r.vid2, r.relation, vr1.title AS title1, vr2.title AS title2, + v1.c_released AS date1, v2.c_released AS date2, v1.c_languages AS lang1, v2.c_languages AS lang2 + FROM vn_relations r + JOIN vn_rev vr1 ON r.vid1 = vr1.id + JOIN vn v1 ON v1.latest = vr1.id + JOIN vn v2 ON r.vid2 = v2.id + JOIN vn_rev vr2 ON v2.latest = vr2.id + WHERE (r.vid2 = ? OR vr1.vid = ?)| + ); + $s->execute($_[ARG0], $_[ARG0]); + while(my $r = $s->fetchrow_hashref) { + if($r->{vid1} < $r->{vid2}) { + $_[HEAP]{rels}{$r->{vid1}.'-'.$r->{vid2}} = reverserel($r->{relation}); + } else { + $_[HEAP]{rels}{$r->{vid2}.'-'.$r->{vid1}} = $r->{relation} if $r->{vid1} < $r->{vid2}; + } + + for (1,2) { + my($vid, $title, $date, $lang) = @$r{ "vid$_", "title$_", "date$_", "lang$_" }; + if(!$_[HEAP]{nodes}{$vid}) { + $_[HEAP]{nodes}{$vid} = [ $vid, $title, $date, $lang, 0 ]; + $_[KERNEL]->yield(getrel => $vid) if $vid != $_[ARG0]; + } + } + $_[HEAP]{nodes}{$_[ARG0]}[4]++; + } + + $_[KERNEL]->yield('relscomplete') if !grep { !$_->[4] } values %{$_[HEAP]{nodes}}; +} + + +sub relscomplete { # heap->nodes and heap->rels are now assumed to contain all necessary data + if(!keys %{$_[HEAP]{nodes}}) { + $_[KERNEL]->call(core => log => 3, 'No relation graph for v%d', $_[HEAP]{vid}); + $Multi::SQL->do('UPDATE vn SET rgraph = 0 WHERE id = ?', undef, $_[HEAP]{vid}); + $_[HEAP]{nodes}{$_[HEAP]{vid}} = []; + $_[KERNEL]->yield('graphcomplete'); + return; + } + $_[KERNEL]->call(core => log => 3, 'Fetched all relation data'); + + # insert all nodes, ordered by release date + for (sort { $a->[2] <=> $b->[2] } values %{$_[HEAP]{nodes}}) { + my $date = sprintf '%08d', $_->[2]; + $date =~ s#^([0-9]{4})([0-9]{2}).+#$1==0?'N/A':$1==9999?'TBA':(($2&&$2>0?($_[HEAP]{moy}[$2-1].' '):'').$1)#e; + + my $title = unidecode($_->[1]); + $title = substr($title, 0, 27).'...' if length($title) > 30; + $title =~ s/&/&/g; + + $_[HEAP]{gv}->add_node($_->[0], + fontname => $_[HEAP]{font}, + shape => 'plaintext', + fontsize => $_[HEAP]{fsize}[0], + style => 'setlinewidth(0.5)', + URL => '/v'.$_->[0], + tooltip => $title, + label => sprintf( + '< + + +
%s
%s %s
>', + $_[HEAP]{fsize}[2], $title, $date, $_->[3]||'N/A' + ), + ); + } + + # @rels = ([ vid1, vid2, relation, date1, date2 ], ..), for easier processing + my @rels = map { + /^([0-9]+)-([0-9]+)$/; + [ $1, $2, $_[HEAP]{rels}{$_}, $_[HEAP]{nodes}{$1}[2], $_[HEAP]{nodes}{$2}[2] ] + } keys %{$_[HEAP]{rels}}; + + # insert all edges, ordered by release date again + for (sort { ($a->[3]>$a->[4]?$a->[4]:$a->[3]) <=> ($b->[3]>$b->[4]?$b->[4]:$b->[3]) } @rels) { + # [older game] -> [newer game] + if($_->[4] > $_->[3]) { + ($_->[0], $_->[1]) = ($_->[1], $_->[0]); + $_->[2] = reverserel($_->[2]); + } + $_[HEAP]{gv}->add_edge( + $_->[1] => $_->[0], + labeldistance => 2.5, + labelangle => -20, + labeljust => 'l', + dir => 'both', + minlen => 2, + fontname => $_[HEAP]{font}, + fontsize => $_[HEAP]{fsize}[1], + arrowsize => 0.7, + color => '#69a89a', + $VNDB::VRELW->{$_->[2]} ? ( + headlabel => $VNDB::VREL->[$_->[2]], + taillabel => $VNDB::VREL->[$_->[2]-1], + ) : $VNDB::VRELW->{$_->[2]+1} ? ( + headlabel => $VNDB::VREL->[$_->[2]], + taillabel => $VNDB::VREL->[$_->[2]+1], + ) : ( + label => ' '.$VNDB::VREL->[$_->[2]], + ), + ); + } + + $_[KERNEL]->yield('buildgraph'); +} + + +sub buildgraph { + # get a new ID + my $gid = $Multi::SQL->prepare("SELECT nextval('relgraph_seq')"); + $gid->execute; + $gid = $gid->fetchrow_arrayref->[0]; + my $gif = sprintf '%s/%02d/%d.gif', $_[HEAP]{imgdir}, $gid % 50, $gid; + my $cmap = sprintf '%s/%02d/%d.cmap', $_[HEAP]{datdir}, $gid % 50, $gid; + + # generate the graph + $_[HEAP]{gv}->as_gif($gif); + chmod 0666, $gif; + + # generate the image map + open my $F, '>', $cmap or die $!; + print $F '\n"; + (my $d = $_[HEAP]{gv}->as_cmapx) =~ s/(id|name)="[^"]+"/$1="rgraph"/g; + print $F $d; + close $F; + chmod 0666, $cmap; + + # update the VN table + $Multi::SQL->do(sprintf q| + UPDATE vn + SET rgraph = %d + WHERE id IN(%s)|, + $gid, join(',', keys %{$_[HEAP]{nodes}})); + + $_[KERNEL]->yield('graphcomplete'); +} + + +sub graphcomplete { # all actions to create the graph (after calling creategraph) are now done + $_[KERNEL]->call(core => log => 3, 'Generated the relation graph for v%d', $_[HEAP]{vid}); + + # remove processed vns, and check for other graphs in the queue + $_[HEAP]{todo} = [ grep { !$_[HEAP]{nodes}{$_} } @{$_[HEAP]{todo}} ]; + if(@{$_[HEAP]{todo}}) { + $_[KERNEL]->yield(creategraph => $_[HEAP]{todo}[0]); + } else { + $_[KERNEL]->post(core => finish => $_[HEAP]{curcmd}); + delete @{$_[HEAP]}{qw| vid nodes rels curcmd gv todo |}; + } +} + + + + + +# Not a POE handler, just a small macro +sub reverserel { # relation + return $VNDB::VRELW->{$_[0]} ? $_[0]-1 : $VNDB::VRELW->{$_[0]+1} ? $_[0]+1 : $_[0]; +} + + +1; + diff --git a/lib/Multi/Sitemap.pm b/lib/Multi/Sitemap.pm new file mode 100644 index 00000000..836fce5b --- /dev/null +++ b/lib/Multi/Sitemap.pm @@ -0,0 +1,156 @@ + +# +# Multi::Sitemap - The sitemap generator +# + +package Multi::Sitemap; + +use strict; +use warnings; +use POE; +use XML::Writer; +use PerlIO::gzip; +use DateTime; + + +sub spawn { + my $p = shift; + POE::Session->create( + package_states => [ + $p => [qw| _start cmd_sitemap staticpages vnpages releasepages producerpages finish addurl |], + ], + heap => { + output => '/www/vndb/www/sitemap.xml.gz', + baseurl => 'http://vndb.org', + @_, + } + ); +} + + +sub _start { + $_[KERNEL]->alias_set('sitemap'); + $_[KERNEL]->call(core => register => qr/^sitemap$/, 'cmd_sitemap'); + # TODO: add an event to run cmd_sitemap on a daily basis +} + + +sub cmd_sitemap { + # Function order: + # cmd_sitemap + # staticpages + # vnpages + # releasepages + # producerpages + # finish + + $_[HEAP]{cmd} = $_[ARG0]; + $_[HEAP]{urls} = 0; + + open($_[HEAP]{io}, '>:gzip', $_[HEAP]{output}) || die $1; + $_[HEAP]{xml} = new XML::Writer( + OUTPUT => $_[HEAP]{io}, + ENCODING => 'UTF-8', + DATA_MODE => 1, + DATA_INDENT => 1 + ); + $_[HEAP]{xml}->xmlDecl(); + $_[HEAP]{xml}->comment(q|NOTE: All URL's that require you to login or that may contain usernames are left out.|); + $_[HEAP]{xml}->startTag('urlset', xmlns => 'http://www.sitemaps.org/schemas/sitemap/0.9'); + + $_[KERNEL]->yield('staticpages'); +} + + +sub staticpages { + $_[KERNEL]->call(core => log => 3, 'Adding static pages'); + + $_[KERNEL]->call(sitemap => addurl => '', 'd'); + $_[KERNEL]->call(sitemap => addurl => 'faq', 'm'); + + $_[KERNEL]->call(sitemap => addurl => $_, 'w') + for ( (map { 'v/'.$_ } 'a'..'z'), 'v/all', 'v/cat', (map { 'p/'.$_ } 'a'..'z'), 'p/all'); + + $_[KERNEL]->yield('vnpages'); +} + + +sub vnpages { + $_[KERNEL]->call(core => log => 3, 'Adding visual novel pages'); + + my $q = $Multi::SQL->prepare(q| + SELECT v.id, c.added, v.rgraph + FROM vn v + JOIN vn_rev vr ON vr.id = v.latest + JOIN changes c ON vr.id = c.id + |); + $q->execute; + while(local $_ = $q->fetchrow_arrayref) { + $_[KERNEL]->call(sitemap => addurl => 'v/'.$_->[0], 'w', $_->[1], 0.7); + $_[KERNEL]->call(sitemap => addurl => 'v/'.$_->[0].'/rg', 'w', $_->[1], 0.7) if $_->[2]; + } + + $_[KERNEL]->yield('releasepages'); +} + + +sub releasepages { + $_[KERNEL]->call(core => log => 3, 'Adding release pages'); + + my $q = $Multi::SQL->prepare(q| + SELECT r.id, c.added + FROM releases r + JOIN releases_rev rr ON rr.id = r.latest + JOIN changes c ON c.id = rr.id + |); + $q->execute; + while(local $_ = $q->fetchrow_arrayref) { + $_[KERNEL]->call(sitemap => addurl => 'r/'.$_->[0], 'w', $_->[1], 0.3); + } + + $_[KERNEL]->yield('producerpages'); +} + + +sub producerpages { + $_[KERNEL]->call(core => log => 3, 'Adding producer pages'); + + my $q = $Multi::SQL->prepare(q| + SELECT p.id, c.added + FROM producers p + JOIN producers_rev pr ON pr.id = p.latest + JOIN changes c ON c.id = pr.id + |); + $q->execute; + while(local $_ = $q->fetchrow_arrayref) { + $_[KERNEL]->call(sitemap => addurl => 'p/'.$_->[0], 'w', $_->[1]); + } + + $_[KERNEL]->yield('finish'); +} + + +sub finish { + $_[HEAP]{xml}->endTag('urlset'); + $_[HEAP]{xml}->end(); + close $_[HEAP]{io}; + $_[KERNEL]->call(core => log => 2 => 'Wrote %d URLs in the sitemap', $_[HEAP]{urls}); + $_[KERNEL]->post(core => finish => $_[HEAP]{cmd}); + delete @{$_[HEAP]}{qw| xml io cmd urls |}; +} + + +sub addurl { # loc, changefreq, lastmod, priority + $_[HEAP]{xml}->startTag('url'); + $_[HEAP]{xml}->dataElement(loc => $_[HEAP]{baseurl}.'/'.$_[ARG0]); + $_[HEAP]{xml}->dataElement(changefreq => $_[ARG1]) if defined $_[ARG1]; + $_[HEAP]{xml}->dataElement(lastmod => DateTime->from_epoch(epoch => $_[ARG2])->ymd) if defined $_[ARG2]; + $_[HEAP]{xml}->dataElement(priority => $_[ARG3]) if defined $_[ARG3]; + $_[HEAP]{xml}->endTag('url'); + $_[HEAP]{urls}++; +} + + +1; + + diff --git a/lib/VNDB.pm b/lib/VNDB.pm index 9779d571..6cd0f6ff 100644 --- a/lib/VNDB.pm +++ b/lib/VNDB.pm @@ -3,6 +3,8 @@ package VNDB; use strict; use warnings; +require 'global.pl'; + our($VERSION, $DEBUG, %VNDBopts, @WARN); $DEBUG = 1; @@ -12,11 +14,6 @@ $VERSION = '1.14'; root_url => $DEBUG ? 'http://beta.vndb.org' : 'http://vndb.org', static_url => $DEBUG ? 'http://static.beta.vndb.org' : 'http://static.vndb.org', debug => $DEBUG, - sqlopts => { - user => 'vndb', - passwd => 'passwd', - database => 'vndb', - }, tplopts => { filename => 'main', searchdir => '/www/vndb/data/tpl', @@ -37,13 +34,9 @@ $VERSION = '1.14'; ], imgpath => '/www/vndb/static/cv', mappath => '/www/vndb/data/rg', - grapher => '/www/vndb/util/relgraph.pl', ); $VNDBopts{ranks}[0][1] = { (map{$_,1} map { keys %{$VNDBopts{ranks}[$_]} } 1..5) }; - -require 'global.pl'; - require Time::HiRes if $DEBUG; require Data::Dumper if $DEBUG; use VNDB::Util::Template; @@ -168,7 +161,7 @@ sub new { my $me = bless { %args, - _DB => VNDB::Util::DB->new(%{$args{sqlopts}}), + _DB => VNDB::Util::DB->new(@VNDB::DBLOGIN), _TPL => VNDB::Util::Template->new(%{$args{tplopts}}), }, $type; diff --git a/lib/VNDB/Util/DB.pm b/lib/VNDB/Util/DB.pm index 59088387..c93e0997 100644 --- a/lib/VNDB/Util/DB.pm +++ b/lib/VNDB/Util/DB.pm @@ -16,7 +16,7 @@ $VERSION = $VNDB::VERSION; DBGetUser DBAddUser DBUpdateUser DBGetVotes DBVoteStats DBAddVote DBDelVote DBGetVNList DBVNListStats DBAddVNList DBEditVNList DBDelVNList - DBGetVN DBAddVN DBEditVN DBDelVN DBHideVN + DBGetVN DBAddVN DBEditVN DBDelVN DBHideVN DBUndefRG DBGetRelease DBAddRelease DBEditRelease DBDelRelease DBHideRelease DBGetProducer DBGetProducerVN DBAddProducer DBEditProducer DBDelProducer DBHideProducer DBExec DBRow DBAll DBLastId @@ -35,7 +35,7 @@ sub new { my $me = shift; my $type = ref($me) || $me; - $me = bless { @_ }, $type; + $me = bless { o => \@_ }, $type; $me->DBInit(); @@ -47,13 +47,7 @@ sub DBInit { my $self = shift; my $info = $self->{_DB} || $self; - my $settings; - $settings .= "host=$info->{host};" if $info->{host}; - $settings .= "port=$info->{port};" if $info->{port}; - $settings .= "dbname=$info->{database}"; - - $info->{sql} = DBI->connect("dbi:Pg:$settings", - $info->{user}, $info->{passwd}, { + $info->{sql} = DBI->connect(@{$self->{o}}, { PrintError => 0, RaiseError => 1, AutoCommit => 0, pg_enable_utf8 => 1, } @@ -802,6 +796,14 @@ sub DBHideVN { # id, hidden } +sub DBUndefRG { # ids + my($s, @id) = @_; + $s->DBExec(q| + UPDATE vn + SET rgraph = 0 + WHERE id IN(!l)|, + \@id); +} #-----------------------------------------------------------------------------# diff --git a/lib/VNDB/Util/Tools.pm b/lib/VNDB/Util/Tools.pm index 4c873b55..fe031acb 100644 --- a/lib/VNDB/Util/Tools.pm +++ b/lib/VNDB/Util/Tools.pm @@ -4,10 +4,12 @@ package VNDB::Util::Tools; use strict; use warnings; use Encode; +use Storable 'freeze', 'thaw'; +use IPC::ShareLite ':lock'; use Exporter 'import'; our $VERSION = $VNDB::VERSION; -our @EXPORT = qw| FormCheck AddHid SendMail AddDefaultStuff |; +our @EXPORT = qw| FormCheck AddHid SendMail AddDefaultStuff RunCmd |; # Improved version of ParamsCheck @@ -62,12 +64,14 @@ sub FormCheck { return \%hash; } + sub AddHid { my $fh = $_[0]->FormCheck({ name => 'fh', required => 0, maxlength => 30 })->{fh}; $_[1]->{_hid} = { map { $_ => 1 } 'com', 'mod', split /,/, $fh } if $fh; } + sub _inarray { # errr... this is from when I didn't know about grep foreach (@{$_[1]}) { (return 1) if $_[0] eq $_; @@ -104,6 +108,7 @@ sub SendMail { } } + sub AddDefaultStuff { my $self = shift; @@ -124,22 +129,16 @@ sub AddDefaultStuff { } } -1; -__END__ -# from HTTP::Date, small function, so why load an entire module? -{ - my @DoW = qw(Sun Mon Tue Wed Thu Fri Sat); - my @MoY = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec); - - sub time2str { - my $time = shift; - $time = time unless defined $time; - my($sec, $min, $hour, $mday, $mon, $year, $wday) = gmtime($time); - sprintf('%s, %02d %s %04d %02d:%02d:%02d GMT', - $DoW[$wday], - $mday, $MoY[$mon], $year+1900, - $hour, $min, $sec); - } +sub RunCmd { # cmd + my $s = IPC::ShareLite->new(-key => $VNDB::SHMKEY, -create => 1, -destroy => 0); + $s->lock(LOCK_EX); + my $l = $s->fetch(); + my @queue = ($l?@{thaw($l)}:(), $_[1]); + $s->store(freeze(\@queue)); + $s->unlock(); } + +1; + diff --git a/lib/VNDB/VN.pm b/lib/VNDB/VN.pm index f2340037..ec1de95d 100644 --- a/lib/VNDB/VN.pm +++ b/lib/VNDB/VN.pm @@ -34,7 +34,7 @@ sub VNPage { $v->{next} = $self->DBGetHist(type => 'v', id => $id, next => $v->{cid}, showhid => 1)->[0]{id} if $r->{rev}; if($page eq 'rg' && $v->{rgraph}) { - open(my $F, '<', sprintf '%s/%02d/%d.cmap', $self->{mappath}, $v->{rgraph}%50, $v->{rgraph}) || die $!; + open(my $F, '<:utf8', sprintf '%s/%02d/%d.cmap', $self->{mappath}, $v->{rgraph}%50, $v->{rgraph}) || die $!; $v->{rmap} = join('', (<$F>)); close($F); } @@ -366,11 +366,8 @@ sub VNUpdReverse { # old, new, id, cid sub VNRecreateRel { # @ids my($s, @id) = @_; - $s->DBCommit; # creates deadlock otherwise - my $c = sprintf "%s %s", $s->{grapher}, join(' ', @id); - my $o = `$c`; - chomp $o; - warn "$$s{grapher}: $o\n" if $o; + $s->DBUndefRG(@id); + $s->RunCmd('relgraph '.join(' ',@id)); } diff --git a/lib/global.pl b/lib/global.pl index aea66f75..76985342 100644 --- a/lib/global.pl +++ b/lib/global.pl @@ -1,5 +1,8 @@ package VNDB; +our @DBLOGIN = ( 'dbi:Pg:dbname=vndb', 'vndb', 'passwd' ); +our $SHMKEY = 'VNDB'; + our $PLAT = { win => 'Windows', lin => 'Linux', diff --git a/util/cleanimg.pl b/util/cleanimg.pl index 527fdb3a..45032106 100644 --- a/util/cleanimg.pl +++ b/util/cleanimg.pl @@ -1,5 +1,12 @@ #!/usr/bin/perl + + +# +# O L D - D O N O T U S E ! +# + + use strict; use warnings; use Time::HiRes 'gettimeofday', 'tv_interval'; @@ -12,9 +19,11 @@ use Image::MetaData::JPEG; use File::Copy 'cp', 'mv'; use Digest::MD5; +require '/www/vndb/lib/global.pl'; + our $ST; -my $sql = DBI->connect('dbi:Pg:dbname=vndb', 'vndb', 'passwd', +my $sql = DBI->connect(@VNDB::DBLOGIN, { RaiseError => 1, PrintError => 0, AutoCommit => 1, pg_enable_utf8 => 1 }); my $imgpath = '/www/vndb/static/img'; diff --git a/util/multi.pl b/util/multi.pl new file mode 100755 index 00000000..b4b4cad2 --- /dev/null +++ b/util/multi.pl @@ -0,0 +1,96 @@ +#!/usr/bin/perl + +# This is just a small script to test and play around with a +# processing queue for actions on VNDB that do not have a +# strict time limit. i.e. resizing and optimizing cover images +# and (re)generating the relation graphs. Because I'm using +# the POE framework, it will also be possible to integrate +# Multi the IRC bot in the same process. +# +# The queue is an array of commands, and should be executed +# in chronological order. Commands are in the form of +# [cmd] [arguments] +# where [cmd] is an internal command, and [arguments] a +# whitespace seperated list of arguments. +# +# Commands can be added from the web interface using shared +# memory, or from IRC if Multi is going to integrated in here. + + +# Usage: +# ./multi.pl [-c] [-s] [cmd1] [cmd2] .. +# -c Do not daemonize, just execute the commands specified +# on the command line and exit. +# -s Same as -c, but also execute commands in the shared +# memory processing queue. +# -a Don't do anything, just add the commands specified on +# the command line to the shared memory processing queue. + + +# TODO: error handling + +# +# Multi - core namespace for initialisation and global variables +# + +package Multi; + +use strict; +use warnings; +use Time::HiRes; +use POE; +use Storable 'freeze', 'thaw'; +use IPC::ShareLite ':lock'; +use DBI; + +use lib '/www/vndb/lib'; +use Multi::Core; +use Multi::RG; +use Multi::Sitemap; +use Multi::IRC; + +BEGIN { require 'global.pl' } + + + $ENV{PATH} = '/usr/bin'; +our $VERSION = '0.9'; +our $LOGDIR = '/www/vndb/data/log'; +our $LOGLVL = 3; # 3:DEBUG, 2:ACTIONS, 1:WARN +our $RESTART = 0; +our $DAEMONIZE = (grep /^-c$/, @ARGV) ? 1 : (grep /^-s$/, @ARGV) ? 2 : 0; +our %MODULES = (); + + +if(grep /^-a$/, @ARGV) { + my $s = IPC::ShareLite->new(-key => $VNDB::SHMKEY,-create => 1, -destroy => 0); + $s->lock(LOCK_EX); + my $l = $s->fetch(); + my @queue = ($l?@{thaw($l)}:(), grep !/^-/, @ARGV); + $s->store(freeze(\@queue)); + $s->unlock(); + exit; +} + + +# one shared pgsql connection for all sessions +our $SQL = DBI->connect(@VNDB::DBLOGIN, + { PrintError => 1, RaiseError => 0, AutoCommit => 1, pg_enable_utf8 => 1 }); + + +Multi::Core->spawn(); +Multi::RG->spawn(); +Multi::Sitemap->spawn(); +Multi::IRC->spawn( + server => 'irc.synirc.net', + user => 'Multi_'.$$, + channel => '#vndb_test' +) if 0; + + +$SIG{__WARN__} = sub {(local$_=shift)=~s/\r?\n//;$poe_kernel->call(core=>log=>1,'__WARN__: '.$_)}; + +$poe_kernel->run(); +exec $0, grep /^-/, @ARGV if $RESTART; + + + diff --git a/util/relgraph.pl b/util/relgraph.pl old mode 100755 new mode 100644 index cdbd022b..a4ae486d --- a/util/relgraph.pl +++ b/util/relgraph.pl @@ -7,6 +7,7 @@ $ENV{PATH} = '/usr/bin'; # required for GraphViz use strict; use warnings; +no warnings 'once'; use Text::Unidecode; #use Time::HiRes 'gettimeofday', 'tv_interval'; #BEGIN { $S = [ gettimeofday ]; } @@ -23,7 +24,6 @@ require '/www/vndb/lib/global.pl'; my $font = 's'; #Comic Sans MSssss'; my @fsize = ( 9, 7, 10 ); # nodes, edges, node_title -my $tmpfile = '/tmp/vndb_graph.gif'; my $destdir = '/www/vndb/static/rg'; my $datdir = '/www/vndb/data/rg'; my $DEBUG = 0; @@ -67,8 +67,7 @@ my @edge_rel = map { -my $sql = DBI->connect('dbi:Pg:dbname=vndb', 'vndb', 'passwd', - { RaiseError => 1, PrintError => 0, AutoCommit => 0, pg_enable_utf8 => 1 }); +my $sql = DBI->connect(@VNDB::DBLOGIN, { RaiseError => 1, PrintError => 0, AutoCommit => 0, pg_enable_utf8 => 1 }); my %ids; my %nodes; my %rels; # "v1-v2" => 1 my @done; @@ -95,9 +94,9 @@ sub createGraph { # vid $sql->do(q|UPDATE vn SET rgraph = 0 WHERE id = ?|, undef, $id); return 0; } - + # correct order! - for (sort { $a->[2] cmp $b->[2] } values %nodes) { + for (sort { $a->[2] <=> $b->[2] } values %nodes) { $DEBUG && printf "ADD: %d\n", $_->[0]; $_->[2] =~ s#^([0-9]{4})([0-9]{2}).+#$1==0?'N/A':$1==9999?'TBA':(($2&&$2>0?($Time::CTime::MoY[$2-1].' '):'').$1)#e; $g->add_node($_->[0], %nodes_all, URL => '/v'.$_->[0], tooltip => $_->[1], label => sprintf @@ -110,10 +109,11 @@ sub createGraph { # vid # make sure to sort the edges on node release dates my @rel = map { [ split(/-/, $_), $rels{$_} ] } keys %rels; - for (sort { ($ids{$a->[0]}gt$ids{$a->[1]}?$ids{$a->[1]}:$ids{$a->[0]}) - cmp ($ids{$b->[0]}gt$ids{$b->[1]}?$ids{$b->[1]}:$ids{$b->[0]}) } @rel) { + for (sort { ($ids{$a->[0]} > $ids{$a->[1]} ? $ids{$a->[1]} : $ids{$a->[0]}) + cmp ($ids{$b->[0]} > $ids{$b->[1]} ? $ids{$b->[1]} : $ids{$b->[0]}) } @rel) { - if($ids{$_->[1]} gt $ids{$_->[0]}) { + # [older game] -> [newer game] + if($ids{$_->[1]} > $ids{$_->[0]}) { ($_->[0], $_->[1]) = ($_->[1], $_->[0]); $_->[2] = reverseRel($_->[2]); } @@ -121,7 +121,6 @@ sub createGraph { # vid $DEBUG && printf "ADD %d -> %d\n", $_->[1], $_->[0]; } - $DEBUG && print "IMAGE\n"; # get a new number @@ -158,20 +157,21 @@ sub createGraph { # vid sub getRel { # gobj, vid my($g, $id) = @_; - $ids{$id} = 0; # false but defined + #$ids{$id} = 0; # false but defined $DEBUG && printf "GET: %d\n", $id; my $s = $sql->prepare(q| SELECT vr1.vid AS vid1, r.vid2, r.relation, vr1.title AS title1, vr2.title AS title2, v1.c_released AS date1, v2.c_released AS date2, v1.c_languages AS lang1, v2.c_languages AS lang2 FROM vn_relations r JOIN vn_rev vr1 ON r.vid1 = vr1.id - JOIN vn v1 ON v1.id = vr1.vid + JOIN vn v1 ON v1.latest = vr1.id JOIN vn v2 ON r.vid2 = v2.id - JOIN vn_rev vr2 ON v2.id = vr2.vid - WHERE (r.vid2 = ? OR vr1.vid = ?) AND v1.latest = vr1.id| + JOIN vn_rev vr2 ON v2.latest = vr2.id + WHERE (r.vid2 = ? OR vr1.vid = ?)| ); $s->execute($id, $id); for my $r (@{$s->fetchall_arrayref({})}) { + $DEBUG && printf " %d: %d - %d\n", $id, $r->{vid1}, $r->{vid2}; if($r->{vid1} < $r->{vid2}) { $rels{$r->{vid1}.'-'.$r->{vid2}} = reverseRel($r->{relation}); } else { diff --git a/util/sitemap.pl b/util/sitemap.pl old mode 100755 new mode 100644 index 64b0957a..6fde2f80 --- a/util/sitemap.pl +++ b/util/sitemap.pl @@ -8,13 +8,16 @@ my %chfr = qw( a always h hourly d daily w weekly m monthly y yearly n ne # the code use strict; use warnings; +no warnings 'once'; use DBI; use POSIX; # for ceil(); use XML::Writer; use PerlIO::gzip; use DateTime; -my $sql = DBI->connect('dbi:Pg:dbname=vndb', 'vndb', 'passwd', +require '/www/vndb/lib/global.pl'; + +my $sql = DBI->connect(@VNDB::DBLOGIN, { RaiseError => 1, PrintError => 0, AutoCommit => 1, pg_enable_utf8 => 1 }); my $urls = 0; diff --git a/util/updates/update_1.14.pl b/util/updates/update_1.14.pl old mode 100755 new mode 100644 index 1bfc517a..9c4e787d --- a/util/updates/update_1.14.pl +++ b/util/updates/update_1.14.pl @@ -2,6 +2,7 @@ use strict; use warnings; +no warnings 'once'; use File::Path; use DBI; @@ -37,7 +38,7 @@ system('util/relgraph.pl'); # rename cover images -my $sql = DBI->connect('dbi:Pg:dbname=vndb', 'vndb', 'passwd', +my $sql = DBI->connect(@VNDB::DBLOGIN, { RaiseError => 0, PrintError => 1, AutoCommit => 1, pg_enable_utf8 => 1 }); $sql->do('CREATE SEQUENCE covers_seq'); $sql->do('ALTER TABLE vn_rev ADD COLUMN image_id integer NOT NULL DEFAULT 0'); -- cgit v1.2.3