diff options
Diffstat (limited to 'lib')
-rw-r--r-- | lib/ChangeLog | 2 | ||||
-rw-r--r-- | lib/Multi/Core.pm | 2 | ||||
-rw-r--r-- | lib/Multi/IRC.pm | 70 | ||||
-rw-r--r-- | lib/Multi/Maintenance.pm | 32 |
4 files changed, 86 insertions, 20 deletions
diff --git a/lib/ChangeLog b/lib/ChangeLog index 5cc2c5a4..3f01492f 100644 --- a/lib/ChangeLog +++ b/lib/ChangeLog @@ -23,6 +23,8 @@ TODO: - Designed a better system to handle documentation - Created a centralised system for site errors within the same layout - Wrote some more documentation + - Multi::IRC now also handles d[0-9] IDs + - Multi::Maintenance automatically rotates Multi's logs 1.14 - 2008-04-26 - Removed the ID gap prevention method diff --git a/lib/Multi/Core.pm b/lib/Multi/Core.pm index 2d9ea85f..e9c67eb6 100644 --- a/lib/Multi/Core.pm +++ b/lib/Multi/Core.pm @@ -10,7 +10,7 @@ use warnings; use POE 'Component::Cron'; use Tie::ShareLite ':lock'; use Time::HiRes 'time', 'gettimeofday', 'tv_interval'; # overload time() -use DateTime::Event::Cron; # bug in PoCo::Cron +use DateTime::Event::Cron; # bug in PoCo::Cron (rt #35422, fixed in 0.019) sub spawn { diff --git a/lib/Multi/IRC.pm b/lib/Multi/IRC.pm index b8f6d44b..984d5d5d 100644 --- a/lib/Multi/IRC.pm +++ b/lib/Multi/IRC.pm @@ -56,7 +56,7 @@ sub _start { ); $_[HEAP]{irc}->plugin_add( CTCP => POE::Component::IRC::Plugin::CTCP->new( - version => $_[HEAP]{o}{ircname}.' v'.$Multi::VERSION, + version => $_[HEAP]{o}{ircname}.' v'.$VNDB::VERSION, userinfo => $_[HEAP]{o}{ircname}, )); $_[HEAP]{irc}->plugin_add( @@ -127,24 +127,60 @@ sub irc_msg { sub vndbid { # dest, msg my $m = $_[ARG1]; my @id; - push @id, [$1,$2,$3,$4] while $m =~ s/^(.*)([uvpr])([0-9]+)(.*)$/ $1 $4 /i; + push @id, [$1,$2,$3,$4] while $m =~ s/^(.*)([duvpr])([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 - ); + my($t, $id, $ext) = (lc($$_[1]), $$_[2], $$_[3]); + + if($t ne 'd') { + 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 + ); + + } else { + my $f = sprintf '/www/vndb/data/docs/%d', $id; + open my $F, '<', $f or next; + (my $title = <$F>) =~ s/^:TITLE://; + chomp($title); + + my($sub, $sec) = ('', 0); + if($ext && $ext =~ /^\.([0-9]+)/) { + my $fs = $1; + while(<$F>) { + next if !/^:SUB:/; + $sec++; + if($sec == $fs) { + chomp; + ($sub = $_) =~ s/^:SUB://; + last; + } + } + } + close $F; + + if(!$sub) { + $_[KERNEL]->post(circ => privmsg => $_[ARG0], sprintf + BOLD.RED.'['.RED.'d%d'.RED.']'.NORMAL.' %s '.RED.'@'.NORMAL.LIGHT_GREY.' http://vndb.org/d%d'.NORMAL, + $id, $title, $id + ); + } else { + $_[KERNEL]->post(circ => privmsg => $_[ARG0], sprintf + BOLD.RED.'['.RED.'d%d.%d'.RED.']'.NORMAL.' %s -> %s '.RED.'@'.NORMAL.LIGHT_GREY.' http://vndb.org/d%d#%d'.NORMAL, + $id, $sec, $title, $sub, $id, $sec + ); + } + } } } diff --git a/lib/Multi/Maintenance.pm b/lib/Multi/Maintenance.pm index 51fff936..1f1a337e 100644 --- a/lib/Multi/Maintenance.pm +++ b/lib/Multi/Maintenance.pm @@ -8,15 +8,17 @@ package Multi::Maintenance; use strict; use warnings; use POE; +use PerlIO::gzip; sub spawn { # WARNING: these maintenance tasks can block the process for a few seconds + # 'maintenance all' doesn't include log rotation my $p = shift; POE::Session->create( package_states => [ - $p => [qw| _start cmd_maintenance vncache ratings prevcache integrity unkanime |], + $p => [qw| _start cmd_maintenance vncache ratings prevcache integrity unkanime logrotate |], ], ); } @@ -24,10 +26,12 @@ sub spawn { sub _start { $_[KERNEL]->alias_set('maintenance'); - $_[KERNEL]->call(core => register => qr/^maintenance((?: (?:all|vncache|ratings|prevcache|integrity|unkanime))+)$/, 'cmd_maintenance'); + $_[KERNEL]->call(core => register => qr/^maintenance((?: (?:all|vncache|ratings|prevcache|integrity|unkanime|logrotate))+)$/, 'cmd_maintenance'); # Perform all maintenance functions every day on 0:00 $_[KERNEL]->post(core => addcron => '0 0 * * *', 'maintenance all'); + # rotate logs every 1st day of the month at 0:05 + $_[KERNEL]->post(core => addcron => '5 0 1 * *' => 'maintenance logrotate'); } @@ -39,6 +43,7 @@ sub cmd_maintenance { $_[KERNEL]->yield('prevcache') if /(?:prevcache|all)/; $_[KERNEL]->yield('integrity') if /(?:integrity|all)/; $_[KERNEL]->yield('unkanime') if /(?:unkanime|all)/; + $_[KERNEL]->yield('logrotate') if /logrotate/; $_[KERNEL]->post(core => finish => $_[ARG0]); } @@ -110,6 +115,29 @@ sub unkanime { } +sub logrotate { + my $dir = sprintf '%s/old', $Multi::LOGDIR; + mkdir $dir if !-d $dir; + + for (glob sprintf '%s/*', $Multi::LOGDIR) { + next if /^\./ || /~$/ || !-f; + my $f = /([^\/]+)$/ ? $1 : $_; + my $n = sprintf '%s/%s.%04d-%02d-%02d.gz', $dir, $f, (localtime)[5]+1900, (localtime)[4]+1, (localtime)[3]; + if(-f $n) { + $_[KERNEL]->call(core => log => 1, 'Logs already rotated earlier today!'); + return; + } + open my $I, '<', sprintf '%s/%s', $Multi::LOGDIR, $f; + open my $O, '>:gzip', $n; + print $O $_ while <$I>; + close $O; + close $I; + open $I, '>', sprintf '%s/%s', $Multi::LOGDIR, $f; + close $I; + } +} + + 1; |