--- trunk/irc-logger.pl 2006/06/24 22:57:26 34
+++ trunk/irc-logger.pl 2007/02/02 21:37:52 42
@@ -10,6 +10,14 @@
./irc-logger.pl
+=head2 Options
+
+=over 4
+
+=item --import-dircproxy=filename
+
+Import log from C to C database
+
=head1 DESCRIPTION
log all conversation on irc channel
@@ -42,6 +50,8 @@
my $ENCODING = 'ISO-8859-2';
my $TIMESTAMP = '%Y-%m-%d %H:%M:%S';
+my $sleep_on_error = 5;
+
## END CONFIG
@@ -54,6 +64,14 @@
use CGI::Simple;
use HTML::TagCloud;
use POSIX qw/strftime/;
+use HTML::CalendarMonthSimple;
+use Getopt::Long;
+use DateTime;
+
+my $import_dircproxy;
+GetOptions(
+ 'import-dircproxy:s' => \$import_dircproxy,
+);
my $dbh = DBI->connect($DSN,"","", { RaiseError => 1, AutoCommit => 1 }) || die $DBI::errstr;
@@ -84,8 +102,8 @@
my $sth = $dbh->prepare(qq{
insert into log
- (channel, me, nick, message)
-values (?,?,?,?)
+ (channel, me, nick, message, time)
+values (?,?,?,?,?)
});
my $tags;
@@ -110,6 +128,7 @@
}
},
context => 5,
+ full_rows => 1,
);
Order is important. Fields are first passed through C (if available) and
@@ -117,13 +136,14 @@
C defines number of messages around each search hit for display.
+C will return database rows for each result with C, C, C,
+C, C and C keys.
+
=cut
sub get_from_log {
my $args = {@_};
- $args->{limit} ||= 10;
-
$args->{fmt} ||= {
date => '[%s] ',
time => '{%s} ',
@@ -156,8 +176,9 @@
$sql .= " where message ilike ? or nick ilike ? " if ($args->{search});
$sql .= " where id in (" . join(",", @{ $tags->{ $args->{tag} } }) . ") " if ($args->{tag} && $tags->{ $args->{tag} });
+ $sql .= " where date(time) = ? " if ($args->{date});
$sql .= " order by log.time desc";
- $sql .= " limit " . $args->{limit};
+ $sql .= " limit " . $args->{limit} if ($args->{limit});
my $sth = $dbh->prepare( $sql );
if (my $search = $args->{search}) {
@@ -168,6 +189,9 @@
} elsif (my $tag = $args->{tag}) {
$sth->execute();
warn "tag '$tag' returned ", $sth->rows, " results ", $context || '', "\n";
+ } elsif (my $date = $args->{date}) {
+ $sth->execute($date);
+ warn "found ", $sth->rows, " messages for date $date ", $context || '', "\n";
} else {
$sth->execute();
}
@@ -184,6 +208,13 @@
unshift @rows, $row;
}
+ # normalize nick names
+ map {
+ $_->{nick} =~ s/^_*(.*?)_*$/$1/
+ } @rows;
+
+ return @rows if ($args->{full_rows});
+
my @msgs = (
"Showing " . ($#rows + 1) . " messages..."
);
@@ -212,27 +243,37 @@
}
}
+ # sprintf which can take coderef as first parametar
+ sub cr_sprintf {
+ my $fmt = shift || return;
+ if (ref($fmt) eq 'CODE') {
+ $fmt->(@_);
+ } else {
+ sprintf($fmt, @_);
+ }
+ }
+
foreach my $row (@rows) {
$row->{time} =~ s#\.\d+##;
my $msg = '';
- $msg = sprintf($args->{fmt}->{date}, $row->{date}) . ' ' if ($last_row->{date} ne $row->{date});
+ $msg = cr_sprintf($args->{fmt}->{date}, $row->{date}) . ' ' if ($last_row->{date} ne $row->{date});
my $t = $row->{time};
if ($last_row->{channel} ne $row->{channel}) {
- $msg .= sprintf($args->{fmt}->{time_channel}, $t, $row->{channel});
+ $msg .= cr_sprintf($args->{fmt}->{time_channel}, $t, $row->{channel});
} else {
- $msg .= sprintf($args->{fmt}->{time}, $t);
+ $msg .= cr_sprintf($args->{fmt}->{time}, $t);
}
my $append = 1;
my $nick = $row->{nick};
- if ($nick =~ s/^_*(.*?)_*$/$1/) {
- $row->{nick} = $nick;
- }
+# if ($nick =~ s/^_*(.*?)_*$/$1/) {
+# $row->{nick} = $nick;
+# }
if ($last_row->{nick} ne $nick) {
# obfu way to find format for me_nick if needed or fallback to default
@@ -241,19 +282,19 @@
$nick = $args->{filter}->{nick}->($nick) if (ref($args->{filter}->{nick}) eq 'CODE');
- $msg .= sprintf( $fmt, $nick );
+ $msg .= cr_sprintf( $fmt, $nick );
$append = 0;
}
$args->{fmt}->{message} ||= '%s';
if (ref($args->{filter}->{message}) eq 'CODE') {
- $msg .= sprintf($args->{fmt}->{message},
+ $msg .= cr_sprintf($args->{fmt}->{message},
$args->{filter}->{message}->(
$row->{message}
)
);
} else {
- $msg .= sprintf($args->{fmt}->{message}, $row->{message});
+ $msg .= cr_sprintf($args->{fmt}->{message}, $row->{message});
}
if ($append && @msgs) {
@@ -268,6 +309,126 @@
return @msgs;
}
+# tags support
+
+my $cloud = HTML::TagCloud->new;
+
+=head2 add_tag
+
+ add_tag( id => 42, message => 'irc message' );
+
+=cut
+
+sub add_tag {
+ my $arg = {@_};
+
+ return unless ($arg->{id} && $arg->{message});
+
+ my $m = $arg->{message};
+ from_to('UTF-8', 'iso-8859-2', $m) if (is_utf8($m));
+
+ while ($m =~ s#$tag_regex##s) {
+ my $tag = $1;
+ next if (! $tag || $tag =~ m/https?:/i);
+ push @{ $tags->{$tag} }, $arg->{id};
+ #warn "+tag $tag: $arg->{id}\n";
+ $cloud->add($tag, "?tag=$tag", scalar @{$tags->{$tag}} + 1);
+ }
+}
+
+=head2 seed_tags
+
+Read all tags from database and create in-memory cache for tags
+
+=cut
+
+sub seed_tags {
+ my $sth = $dbh->prepare(qq{ select id,message from log where message like '%//%' });
+ $sth->execute;
+ while (my $row = $sth->fetchrow_hashref) {
+ add_tag( %$row );
+ }
+
+ foreach my $tag (keys %$tags) {
+ $cloud->add($tag, "?tag=$tag", scalar @{$tags->{$tag}} + 1);
+ }
+}
+
+seed_tags;
+
+
+=head2 save_message
+
+ save_message(
+ channel => '#foobar',
+ me => 0,
+ nick => 'dpavlin',
+ msg => 'test message',
+ time => '2006-06-25 18:57:18',
+ );
+
+C is optional, it will use C<< now() >> if it's not available.
+
+C if not specified will be C<0> (not C message)
+
+=cut
+
+sub save_message {
+ my $a = {@_};
+ $a->{me} ||= 0;
+ $a->{time} ||= strftime($TIMESTAMP,localtime());
+
+ print
+ $a->{time}, " ",
+ $a->{channel}, " ",
+ $a->{me} ? "***" . $a->{nick} : "<" . $a->{nick} . ">",
+ " " . $a->{msg} . "\n";
+
+ from_to($a->{msg}, 'UTF-8', $ENCODING);
+
+ $sth->execute($a->{channel}, $a->{me}, $a->{nick}, $a->{msg}, $a->{time});
+ add_tag( id => $dbh->last_insert_id(undef,undef,"log",undef),
+ message => $a->{msg});
+}
+
+if ($import_dircproxy) {
+ open(my $l, $import_dircproxy) || die "can't open $import_dircproxy: $!";
+ warn "importing $import_dircproxy...\n";
+ my $tz_offset = 2 * 60 * 60; # TZ GMT+2
+ while(<$l>) {
+ chomp;
+ if (/^@(\d+)\s(\S+)\s(.+)$/) {
+ my ($time, $nick, $msg) = ($1,$2,$3);
+
+ my $dt = DateTime->from_epoch( epoch => $time + $tz_offset );
+
+ my $me = 0;
+ $me = 1 if ($nick =~ m/^\[\S+]/);
+ $nick =~ s/^[\[<]([^!]+).*$/$1/;
+
+ $msg =~ s/^ACTION\s+// if ($me);
+
+ save_message(
+ channel => $CHANNEL,
+ me => $me,
+ nick => $nick,
+ msg => $msg,
+ time => $dt->ymd . " " . $dt->hms,
+ ) if ($nick !~ m/^-/);
+
+ } else {
+ warn "can't parse: $_\n";
+ }
+ }
+ close($l);
+ warn "import over\n";
+ exit;
+}
+
+
+#
+# POE handing part
+#
my $SKIPPING = 0; # if skipping, how many we've done
my $SEND_QUEUE; # cache
@@ -292,12 +453,7 @@
my $channel = $_[ARG1]->[0];
my $msg = $_[ARG2];
- from_to($msg, 'UTF-8', $ENCODING);
-
- print "$channel: <$nick> $msg\n";
- $sth->execute($channel, 0, $nick, $msg);
- add_tag( id => $dbh->last_insert_id(undef,undef,"log",undef),
- message => $msg);
+ save_message( channel => $channel, me => 0, nick => $nick, msg => $msg);
},
irc_ctcp_action => sub {
my $kernel = $_[KERNEL];
@@ -305,12 +461,7 @@
my $channel = $_[ARG1]->[0];
my $msg = $_[ARG2];
- from_to($msg, 'UTF-8', $ENCODING);
-
- print "$channel ***$nick $msg\n";
- $sth->execute($channel, 1, $nick, $msg);
- add_tag( id => $dbh->last_insert_id(undef,undef,"log",undef),
- message => $msg);
+ save_message( channel => $channel, me => 1, nick => $nick, msg => $msg);
},
irc_msg => sub {
my $kernel = $_[KERNEL];
@@ -338,18 +489,25 @@
my $nr = $1 || 10;
my $sth = $dbh->prepare(qq{
- select nick,count(*) from log group by nick order by count desc limit $nr
+ select
+ nick,
+ count(*) as count,
+ sum(length(message)) as len
+ from log
+ group by nick
+ order by len desc,count desc
+ limit $nr
});
$sth->execute();
$res = "Top $nr users: ";
my @users;
while (my $row = $sth->fetchrow_hashref) {
- push @users,$row->{nick} . ': ' . $row->{count};
+ push @users,$row->{nick} . ': ' . $row->{count} . '/' . $row->{len} . '=' . sprintf("%.2f", $row->{len}/$row->{count});
}
$res .= join(" | ", @users);
} elsif ($msg =~ m/^last.*?\s*(\d*)/i) {
- foreach my $res (get_from_log( limit => $1 )) {
+ foreach my $res (get_from_log( limit => ($1 || 100) )) {
print "last: $res\n";
from_to($res, $ENCODING, 'UTF-8');
$_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );
@@ -372,6 +530,35 @@
$res = '';
+ } elsif ($msg =~ m/^(?:count|poll)\s+(.*)(?:\s+(\d+))?\s*$/i) {
+
+ my ($what,$limit) = ($1,$2);
+ $limit ||= 100;
+
+ my $stat;
+
+ foreach my $res (get_from_log(
+ limit => $limit,
+ search => $what,
+ full_rows => 1,
+ )) {
+ while ($res->{message} =~ s/\Q$what\E(\+|\-)//) {
+ $stat->{vote}->{$1}++;
+ $stat->{from}->{ $res->{nick} }++;
+ }
+ }
+
+ my @nicks;
+ foreach my $nick (sort { $stat->{from}->{$a} cmp $stat->{from}->{$b} } keys %{ $stat->{from} }) {
+ push @nicks, $nick . $stat->{from}->{$nick} == 1 ? '' :
+ "(" . $stat->{from}->{$nick} . ")";
+ }
+
+ $res =
+ "+ " . ( $stat->{vote}->{'+'} || 0 ) . " : " .
+ "- " . ( $stat->{vote}->{'-'} || 0 ) .
+ " from " . ( join(", ", @nicks) || 'nobody' );
+
}
if ($res) {
@@ -395,6 +582,15 @@
warn "## indetify $NICK\n";
$_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "IDENTIFY $NICK" );
},
+ irc_disconnected => sub {
+ warn "## disconnected, reconnecting again\n";
+ $_[KERNEL]->post($IRC_ALIAS => connect => $CONNECT);
+ },
+ irc_socketerr => sub {
+ warn "## socket error... sleeping for $sleep_on_error seconds and retry";
+ sleep($sleep_on_error);
+ $_[KERNEL]->post($IRC_ALIAS => connect => $CONNECT);
+ },
# irc_433 => sub {
# print "# irc_433: ",$_[ARG1], "\n";
# warn "## indetify $NICK\n";
@@ -472,53 +668,6 @@
},
);
-# tags support
-
-my $cloud = HTML::TagCloud->new;
-
-=head2 add_tag
-
- add_tag( id => 42, message => 'irc message' );
-
-=cut
-
-sub add_tag {
- my $arg = {@_};
-
- return unless ($arg->{id} && $arg->{message});
-
- my $m = $arg->{message};
- from_to('UTF-8', 'iso-8859-2', $m) if (is_utf8($m));
-
- while ($m =~ s#$tag_regex##s) {
- my $tag = $1;
- next if (! $tag || $tag =~ m/https?:/i);
- push @{ $tags->{$tag} }, $arg->{id};
- #warn "+tag $tag: $arg->{id}\n";
- $cloud->add($tag, "?tag=$tag", scalar @{$tags->{$tag}} + 1);
- }
-}
-
-=head2 seed_tags
-
-Read all tags from database and create in-memory cache for tags
-
-=cut
-
-sub seed_tags {
- my $sth = $dbh->prepare(qq{ select id,message from log where message like '%//%' });
- $sth->execute;
- while (my $row = $sth->fetchrow_hashref) {
- add_tag( %$row );
- }
-
- foreach my $tag (keys %$tags) {
- $cloud->add($tag, "?tag=$tag", scalar @{$tags->{$tag}} + 1);
- }
-}
-
-seed_tags;
-
# http server
my $httpd = POE::Component::Server::HTTP->new(
@@ -544,6 +693,7 @@
.col-4 { background: #ff66ff }
a:link.tag, a:visited.tag { border: 1px dashed #ccc; backgound: #ccc; text-decoration: none }
a:hover.tag { border: 1px solid #eee }
+hr { border: 1px dashed #ccc; height: 1px; clear: both; }
_END_OF_STYLE_
my $max_color = 4;
@@ -567,7 +717,7 @@
my $search = $q->param('search') || $q->param('grep') || '';
- $response->content(
+ my $html =
qq{$NICK } .
@@ -578,14 +728,44 @@
} .
$cloud->html(500) .
- qq{} .
- join("
",
+ qq{
};
+ if ($request->url =~ m#/history#) {
+ my $sth = $dbh->prepare(qq{
+ select date(time) as date,count(*) as nr
+ from log
+ group by date(time)
+ order by date(time) desc
+ });
+ $sth->execute();
+ my ($l_yyyy,$l_mm) = (0,0);
+ my $cal;
+ while (my $row = $sth->fetchrow_hashref) {
+ # this is probably PostgreSQL specific, expects ISO date
+ my ($yyyy,$mm,$dd) = split(/-/, $row->{date});
+ if ($yyyy != $l_yyyy || $mm != $l_mm) {
+ $html .= $cal->as_HTML() if ($cal);
+ $cal = new HTML::CalendarMonthSimple('month'=>$mm,'year'=>$yyyy);
+ $cal->border(2);
+ ($l_yyyy,$l_mm) = ($yyyy,$mm);
+ }
+ $cal->setcontent($dd, qq{
+ $row->{nr}
+ });
+ }
+ $html .= $cal->as_HTML() if ($cal);
+
+ } else {
+ $html .= join("
",
get_from_log(
- limit => $q->param('last') || 100,
+ limit => $q->param('last') || $q->param('date') ? undef : 100,
search => $search || undef,
tag => $q->param('tag') || undef,
+ date => $q->param('date') || undef,
fmt => {
- date => '
%s
',
+ date => sub {
+ my $date = shift || return;
+ qq{ };
+ },
time => '%s ',
time_channel => '%s %s ',
nick => '%s: ',
@@ -612,9 +792,15 @@
},
},
)
- ) .
- qq{
}
- );
+ );
+ }
+
+ $html .= qq{
+
+ See history of all messages.
+