summaryrefslogtreecommitdiff
path: root/lib/Multi
diff options
context:
space:
mode:
Diffstat (limited to 'lib/Multi')
-rw-r--r--lib/Multi/Core.pm2
-rw-r--r--lib/Multi/IRC.pm70
-rw-r--r--lib/Multi/Maintenance.pm32
3 files changed, 84 insertions, 20 deletions
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;