/[irc-logger]/trunk/bin/irc-logger.pl
This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!
ViewVC logotype

Diff of /trunk/bin/irc-logger.pl

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 36 by dpavlin, Sun Jun 25 16:37:39 2006 UTC revision 37 by dpavlin, Sun Jun 25 17:40:59 2006 UTC
# Line 10  irc-logger.pl Line 10  irc-logger.pl
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
# Line 55  use CGI::Simple; Line 63  use CGI::Simple;
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    
# Line 85  _SQL_SCHEMA_ Line 100  _SQL_SCHEMA_
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;
# Line 281  sub get_from_log { Line 296  sub get_from_log {
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');
# Line 319  POE::Session->create( inline_states => Line 439  POE::Session->create( inline_states =>
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];
# Line 330  POE::Session->create( inline_states => Line 447  POE::Session->create( inline_states =>
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];
# Line 495  POE::Session->create( inline_states => Line 609  POE::Session->create( inline_states =>
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(
# Line 638  sub root_handler { Line 705  sub root_handler {
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> ',

Legend:
Removed from v.36  
changed lines
  Added in v.37

  ViewVC Help
Powered by ViewVC 1.1.26