10 |
|
|
11 |
./irc-logger.pl |
./irc-logger.pl |
12 |
|
|
13 |
|
=head2 Options |
14 |
|
|
15 |
|
=over 4 |
16 |
|
|
17 |
|
=item --import-dircproxy=filename |
18 |
|
|
19 |
|
Import log from C<dircproxy> to C<irc-logger> database |
20 |
|
|
21 |
=head1 DESCRIPTION |
=head1 DESCRIPTION |
22 |
|
|
23 |
log all conversation on irc channel |
log all conversation on irc channel |
63 |
use HTML::TagCloud; |
use HTML::TagCloud; |
64 |
use POSIX qw/strftime/; |
use POSIX qw/strftime/; |
65 |
use HTML::CalendarMonthSimple; |
use HTML::CalendarMonthSimple; |
66 |
|
use Getopt::Long; |
67 |
|
use DateTime; |
68 |
|
|
69 |
|
my $import_dircproxy; |
70 |
|
GetOptions( |
71 |
|
'import-dircproxy:s' => \$import_dircproxy, |
72 |
|
); |
73 |
|
|
74 |
my $dbh = DBI->connect($DSN,"","", { RaiseError => 1, AutoCommit => 1 }) || die $DBI::errstr; |
my $dbh = DBI->connect($DSN,"","", { RaiseError => 1, AutoCommit => 1 }) || die $DBI::errstr; |
75 |
|
|
100 |
|
|
101 |
my $sth = $dbh->prepare(qq{ |
my $sth = $dbh->prepare(qq{ |
102 |
insert into log |
insert into log |
103 |
(channel, me, nick, message) |
(channel, me, nick, message, time) |
104 |
values (?,?,?,?) |
values (?,?,?,?,?) |
105 |
}); |
}); |
106 |
|
|
107 |
my $tags; |
my $tags; |
296 |
return @msgs; |
return @msgs; |
297 |
} |
} |
298 |
|
|
299 |
|
# tags support |
300 |
|
|
301 |
my $SKIPPING = 0; # if skipping, how many we've done |
my $cloud = HTML::TagCloud->new; |
302 |
my $SEND_QUEUE; # cache |
|
303 |
|
=head2 add_tag |
304 |
|
|
305 |
|
add_tag( id => 42, message => 'irc message' ); |
306 |
|
|
307 |
|
=cut |
308 |
|
|
309 |
|
sub add_tag { |
310 |
|
my $arg = {@_}; |
311 |
|
|
312 |
|
return unless ($arg->{id} && $arg->{message}); |
313 |
|
|
314 |
|
my $m = $arg->{message}; |
315 |
|
from_to('UTF-8', 'iso-8859-2', $m) if (is_utf8($m)); |
316 |
|
|
317 |
|
while ($m =~ s#$tag_regex##s) { |
318 |
|
my $tag = $1; |
319 |
|
next if (! $tag || $tag =~ m/https?:/i); |
320 |
|
push @{ $tags->{$tag} }, $arg->{id}; |
321 |
|
#warn "+tag $tag: $arg->{id}\n"; |
322 |
|
$cloud->add($tag, "?tag=$tag", scalar @{$tags->{$tag}} + 1); |
323 |
|
} |
324 |
|
} |
325 |
|
|
326 |
|
=head2 seed_tags |
327 |
|
|
328 |
|
Read all tags from database and create in-memory cache for tags |
329 |
|
|
330 |
|
=cut |
331 |
|
|
332 |
|
sub seed_tags { |
333 |
|
my $sth = $dbh->prepare(qq{ select id,message from log where message like '%//%' }); |
334 |
|
$sth->execute; |
335 |
|
while (my $row = $sth->fetchrow_hashref) { |
336 |
|
add_tag( %$row ); |
337 |
|
} |
338 |
|
|
339 |
|
foreach my $tag (keys %$tags) { |
340 |
|
$cloud->add($tag, "?tag=$tag", scalar @{$tags->{$tag}} + 1); |
341 |
|
} |
342 |
|
} |
343 |
|
|
344 |
|
seed_tags; |
345 |
|
|
|
POE::Component::IRC->new($IRC_ALIAS); |
|
346 |
|
|
347 |
=head2 save_message |
=head2 save_message |
348 |
|
|
349 |
save_message($channel,$me,$nick,$msg); |
save_message( |
350 |
|
channel => '#foobar', |
351 |
|
me => 0, |
352 |
|
nick => 'dpavlin', |
353 |
|
msg => 'test message', |
354 |
|
time => '2006-06-25 18:57:18', |
355 |
|
); |
356 |
|
|
357 |
|
C<time> is optional, it will use C<< now() >> if it's not available. |
358 |
|
|
359 |
|
C<me> if not specified will be C<0> (not C</me> message) |
360 |
|
|
361 |
=cut |
=cut |
362 |
|
|
363 |
sub save_message { |
sub save_message { |
364 |
my ($channel,$me,$nick,$msg) = @_; |
my $a = {@_}; |
365 |
$me ||= 0; |
$a->{me} ||= 0; |
366 |
$sth->execute($channel, $me, $nick, $msg); |
|
367 |
|
print |
368 |
|
$a->{time} ? $a->{time} . " " : strftime($TIMESTAMP,localtime()), |
369 |
|
$a->{channel}, " ", |
370 |
|
$a->{me} ? "***" . $a->{nick} : "<" . $a->{nick} . ">", |
371 |
|
" " . $a->{msg} . "\n"; |
372 |
|
|
373 |
|
from_to($a->{msg}, 'UTF-8', $ENCODING); |
374 |
|
|
375 |
|
$sth->execute($a->{channel}, $a->{me}, $a->{nick}, $a->{msg}, $a->{time}); |
376 |
add_tag( id => $dbh->last_insert_id(undef,undef,"log",undef), |
add_tag( id => $dbh->last_insert_id(undef,undef,"log",undef), |
377 |
message => $msg); |
message => $a->{msg}); |
378 |
|
} |
379 |
|
|
380 |
|
if ($import_dircproxy) { |
381 |
|
open(my $l, $import_dircproxy) || die "can't open $import_dircproxy: $!"; |
382 |
|
warn "importing $import_dircproxy...\n"; |
383 |
|
my $tz_offset = 2 * 60 * 60; # TZ GMT+2 |
384 |
|
while(<$l>) { |
385 |
|
chomp; |
386 |
|
if (/^@(\d+)\s(\S+)\s(.+)$/) { |
387 |
|
my ($time, $nick, $msg) = ($1,$2,$3); |
388 |
|
|
389 |
|
my $dt = DateTime->from_epoch( epoch => $time + $tz_offset ); |
390 |
|
|
391 |
|
my $me = 0; |
392 |
|
$me = 1 if ($nick =~ m/^\[\S+]/); |
393 |
|
$nick =~ s/^[\[<]([^!]+).*$/$1/; |
394 |
|
|
395 |
|
$msg =~ s/^ACTION\s+// if ($me); |
396 |
|
|
397 |
|
save_message( |
398 |
|
channel => $CHANNEL, |
399 |
|
me => $me, |
400 |
|
nick => $nick, |
401 |
|
msg => $msg, |
402 |
|
time => $dt->ymd . " " . $dt->hms, |
403 |
|
) if ($nick !~ m/^-/); |
404 |
|
|
405 |
|
} else { |
406 |
|
warn "can't parse: $_\n"; |
407 |
|
} |
408 |
|
} |
409 |
|
close($l); |
410 |
|
warn "import over\n"; |
411 |
|
exit; |
412 |
} |
} |
413 |
|
|
414 |
|
|
415 |
|
# |
416 |
|
# POE handing part |
417 |
|
# |
418 |
|
|
419 |
|
my $SKIPPING = 0; # if skipping, how many we've done |
420 |
|
my $SEND_QUEUE; # cache |
421 |
|
|
422 |
|
POE::Component::IRC->new($IRC_ALIAS); |
423 |
|
|
424 |
POE::Session->create( inline_states => |
POE::Session->create( inline_states => |
425 |
{_start => sub { |
{_start => sub { |
426 |
$_[KERNEL]->post($IRC_ALIAS => register => 'all'); |
$_[KERNEL]->post($IRC_ALIAS => register => 'all'); |
439 |
my $channel = $_[ARG1]->[0]; |
my $channel = $_[ARG1]->[0]; |
440 |
my $msg = $_[ARG2]; |
my $msg = $_[ARG2]; |
441 |
|
|
442 |
from_to($msg, 'UTF-8', $ENCODING); |
save_message( channel => $channel, me => 0, nick => $nick, msg => $msg); |
|
|
|
|
print "$channel: <$nick> $msg\n"; |
|
|
save_message($channel, 0, $nick, $msg); |
|
443 |
}, |
}, |
444 |
irc_ctcp_action => sub { |
irc_ctcp_action => sub { |
445 |
my $kernel = $_[KERNEL]; |
my $kernel = $_[KERNEL]; |
447 |
my $channel = $_[ARG1]->[0]; |
my $channel = $_[ARG1]->[0]; |
448 |
my $msg = $_[ARG2]; |
my $msg = $_[ARG2]; |
449 |
|
|
450 |
from_to($msg, 'UTF-8', $ENCODING); |
save_message( channel => $channel, me => 1, nick => $nick, msg => $msg); |
|
|
|
|
print "$channel ***$nick $msg\n"; |
|
|
save_message($channel, 1, $nick, $msg); |
|
451 |
}, |
}, |
452 |
irc_msg => sub { |
irc_msg => sub { |
453 |
my $kernel = $_[KERNEL]; |
my $kernel = $_[KERNEL]; |
609 |
}, |
}, |
610 |
); |
); |
611 |
|
|
|
# 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; |
|
|
|
|
612 |
# http server |
# http server |
613 |
|
|
614 |
my $httpd = POE::Component::Server::HTTP->new( |
my $httpd = POE::Component::Server::HTTP->new( |
705 |
fmt => { |
fmt => { |
706 |
date => sub { |
date => sub { |
707 |
my $date = shift || return; |
my $date = shift || return; |
708 |
qq{<hr/><div class="date"><a href="/?date=$date">$date</a></div> '}; |
qq{<hr/><div class="date"><a href="/?date=$date">$date</a></div>}; |
709 |
}, |
}, |
710 |
time => '<span class="time">%s</span> ', |
time => '<span class="time">%s</span> ', |
711 |
time_channel => '<span class="channel">%s %s</span> ', |
time_channel => '<span class="channel">%s %s</span> ', |