/[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 41 by dpavlin, Tue Oct 24 12:51:49 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 42  my $DSN = 'DBI:Pg:dbname=' . $NICK; Line 50  my $DSN = 'DBI:Pg:dbname=' . $NICK;
50  my $ENCODING = 'ISO-8859-2';  my $ENCODING = 'ISO-8859-2';
51  my $TIMESTAMP = '%Y-%m-%d %H:%M:%S';  my $TIMESTAMP = '%Y-%m-%d %H:%M:%S';
52    
53    my $sleep_on_error = 5;
54    
55  ## END CONFIG  ## END CONFIG
56    
57    
# Line 55  use CGI::Simple; Line 65  use CGI::Simple;
65  use HTML::TagCloud;  use HTML::TagCloud;
66  use POSIX qw/strftime/;  use POSIX qw/strftime/;
67  use HTML::CalendarMonthSimple;  use HTML::CalendarMonthSimple;
68    use Getopt::Long;
69    use DateTime;
70    
71    my $import_dircproxy;
72    GetOptions(
73            'import-dircproxy:s' => \$import_dircproxy,
74    );
75    
76  my $dbh = DBI->connect($DSN,"","", { RaiseError => 1, AutoCommit => 1 }) || die $DBI::errstr;  my $dbh = DBI->connect($DSN,"","", { RaiseError => 1, AutoCommit => 1 }) || die $DBI::errstr;
77    
# Line 85  _SQL_SCHEMA_ Line 102  _SQL_SCHEMA_
102    
103  my $sth = $dbh->prepare(qq{  my $sth = $dbh->prepare(qq{
104  insert into log  insert into log
105          (channel, me, nick, message)          (channel, me, nick, message, time)
106  values (?,?,?,?)  values (?,?,?,?,?)
107  });  });
108    
109  my $tags;  my $tags;
# Line 281  sub get_from_log { Line 298  sub get_from_log {
298          return @msgs;          return @msgs;
299  }  }
300    
301    # tags support
302    
303  my $SKIPPING = 0;               # if skipping, how many we've done  my $cloud = HTML::TagCloud->new;
304  my $SEND_QUEUE;                 # cache  
305    =head2 add_tag
306    
307     add_tag( id => 42, message => 'irc message' );
308    
309    =cut
310    
311    sub add_tag {
312            my $arg = {@_};
313    
314            return unless ($arg->{id} && $arg->{message});
315    
316            my $m = $arg->{message};
317            from_to('UTF-8', 'iso-8859-2', $m) if (is_utf8($m));
318    
319            while ($m =~ s#$tag_regex##s) {
320                    my $tag = $1;
321                    next if (! $tag || $tag =~ m/https?:/i);
322                    push @{ $tags->{$tag} }, $arg->{id};
323                    #warn "+tag $tag: $arg->{id}\n";
324                    $cloud->add($tag, "?tag=$tag", scalar @{$tags->{$tag}} + 1);
325            }
326    }
327    
328    =head2 seed_tags
329    
330    Read all tags from database and create in-memory cache for tags
331    
332    =cut
333    
334    sub seed_tags {
335            my $sth = $dbh->prepare(qq{ select id,message from log where message like '%//%' });
336            $sth->execute;
337            while (my $row = $sth->fetchrow_hashref) {
338                    add_tag( %$row );
339            }
340    
341            foreach my $tag (keys %$tags) {
342                    $cloud->add($tag, "?tag=$tag", scalar @{$tags->{$tag}} + 1);
343            }
344    }
345    
346    seed_tags;
347    
 POE::Component::IRC->new($IRC_ALIAS);  
348    
349  =head2 save_message  =head2 save_message
350    
351    save_message($channel,$me,$nick,$msg);    save_message(
352            channel => '#foobar',
353            me => 0,
354            nick => 'dpavlin',
355            msg => 'test message',
356            time => '2006-06-25 18:57:18',
357      );
358    
359    C<time> is optional, it will use C<< now() >> if it's not available.
360    
361    C<me> if not specified will be C<0> (not C</me> message)
362    
363  =cut  =cut
364    
365  sub save_message {  sub save_message {
366          my ($channel,$me,$nick,$msg) = @_;          my $a = {@_};
367          $me ||= 0;          $a->{me} ||= 0;
368          $sth->execute($channel, $me, $nick, $msg);          $a->{time} ||= strftime($TIMESTAMP,localtime());
369    
370            print
371                    $a->{time}, " ",
372                    $a->{channel}, " ",
373                    $a->{me} ? "***" . $a->{nick} : "<" . $a->{nick} . ">",
374                    " " . $a->{msg} . "\n";
375    
376            from_to($a->{msg}, 'UTF-8', $ENCODING);
377    
378            $sth->execute($a->{channel}, $a->{me}, $a->{nick}, $a->{msg}, $a->{time});
379          add_tag( id => $dbh->last_insert_id(undef,undef,"log",undef),          add_tag( id => $dbh->last_insert_id(undef,undef,"log",undef),
380                  message => $msg);                  message => $a->{msg});
381  }  }
382    
383    if ($import_dircproxy) {
384            open(my $l, $import_dircproxy) || die "can't open $import_dircproxy: $!";
385            warn "importing $import_dircproxy...\n";
386            my $tz_offset = 2 * 60 * 60;    # TZ GMT+2
387            while(<$l>) {
388                    chomp;
389                    if (/^@(\d+)\s(\S+)\s(.+)$/) {
390                            my ($time, $nick, $msg) = ($1,$2,$3);
391    
392                            my $dt = DateTime->from_epoch( epoch => $time + $tz_offset );
393    
394                            my $me = 0;
395                            $me = 1 if ($nick =~ m/^\[\S+]/);
396                            $nick =~ s/^[\[<]([^!]+).*$/$1/;
397    
398                            $msg =~ s/^ACTION\s+// if ($me);
399    
400                            save_message(
401                                    channel => $CHANNEL,
402                                    me => $me,
403                                    nick => $nick,
404                                    msg => $msg,
405                                    time => $dt->ymd . " " . $dt->hms,
406                            ) if ($nick !~ m/^-/);
407    
408                    } else {
409                            warn "can't parse: $_\n";
410                    }
411            }
412            close($l);
413            warn "import over\n";
414            exit;
415    }
416    
417    
418    #
419    # POE handing part
420    #
421    
422    my $SKIPPING = 0;               # if skipping, how many we've done
423    my $SEND_QUEUE;                 # cache
424    
425    POE::Component::IRC->new($IRC_ALIAS);
426    
427  POE::Session->create( inline_states =>  POE::Session->create( inline_states =>
428     {_start => sub {           {_start => sub {      
429                  $_[KERNEL]->post($IRC_ALIAS => register => 'all');                  $_[KERNEL]->post($IRC_ALIAS => register => 'all');
# Line 319  POE::Session->create( inline_states => Line 442  POE::Session->create( inline_states =>
442                  my $channel = $_[ARG1]->[0];                  my $channel = $_[ARG1]->[0];
443                  my $msg = $_[ARG2];                  my $msg = $_[ARG2];
444    
445                  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);  
446      },      },
447      irc_ctcp_action => sub {      irc_ctcp_action => sub {
448                  my $kernel = $_[KERNEL];                  my $kernel = $_[KERNEL];
# Line 330  POE::Session->create( inline_states => Line 450  POE::Session->create( inline_states =>
450                  my $channel = $_[ARG1]->[0];                  my $channel = $_[ARG1]->[0];
451                  my $msg = $_[ARG2];                  my $msg = $_[ARG2];
452    
453                  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);  
454      },      },
455          irc_msg => sub {          irc_msg => sub {
456                  my $kernel = $_[KERNEL];                  my $kernel = $_[KERNEL];
# Line 361  POE::Session->create( inline_states => Line 478  POE::Session->create( inline_states =>
478                          my $nr = $1 || 10;                          my $nr = $1 || 10;
479    
480                          my $sth = $dbh->prepare(qq{                          my $sth = $dbh->prepare(qq{
481                                  select nick,count(*) from log group by nick order by count desc limit $nr                                  select
482                                            nick,
483                                            count(*) as count,
484                                            sum(length(message)) as len
485                                    from log
486                                    group by nick
487                                    order by len desc,count desc
488                                    limit $nr
489                          });                          });
490                          $sth->execute();                          $sth->execute();
491                          $res = "Top $nr users: ";                          $res = "Top $nr users: ";
492                          my @users;                          my @users;
493                          while (my $row = $sth->fetchrow_hashref) {                          while (my $row = $sth->fetchrow_hashref) {
494                                  push @users,$row->{nick} . ': ' . $row->{count};                                  push @users,$row->{nick} . ': ' . $row->{count} . '/' . $row->{len} . '=' . sprintf("%.2f", $row->{len}/$row->{count});
495                          }                          }
496                          $res .= join(" | ", @users);                          $res .= join(" | ", @users);
497                  } elsif ($msg =~ m/^last.*?\s*(\d*)/i) {                  } elsif ($msg =~ m/^last.*?\s*(\d*)/i) {
498    
499                          foreach my $res (get_from_log( limit => $1 )) {                          foreach my $res (get_from_log( limit => ($1 || 100) )) {
500                                  print "last: $res\n";                                  print "last: $res\n";
501                                  from_to($res, $ENCODING, 'UTF-8');                                  from_to($res, $ENCODING, 'UTF-8');
502                                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );                                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );
# Line 418  POE::Session->create( inline_states => Line 542  POE::Session->create( inline_states =>
542                  warn "## indetify $NICK\n";                  warn "## indetify $NICK\n";
543                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "IDENTIFY $NICK" );                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "IDENTIFY $NICK" );
544          },          },
545            irc_disconnected => sub {
546                    warn "## disconnected, reconnecting again\n";
547                    $_[KERNEL]->post($IRC_ALIAS => connect => $CONNECT);
548            },
549            irc_socketerr => sub {
550                    warn "## socket error... sleeping for $sleep_on_error seconds and retry";
551                    sleep($sleep_on_error);
552                    $_[KERNEL]->post($IRC_ALIAS => connect => $CONNECT);
553            },
554  #       irc_433 => sub {  #       irc_433 => sub {
555  #               print "# irc_433: ",$_[ARG1], "\n";  #               print "# irc_433: ",$_[ARG1], "\n";
556  #               warn "## indetify $NICK\n";  #               warn "## indetify $NICK\n";
# Line 495  POE::Session->create( inline_states => Line 628  POE::Session->create( inline_states =>
628     },     },
629    );    );
630    
 # 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;  
   
631  # http server  # http server
632    
633  my $httpd = POE::Component::Server::HTTP->new(  my $httpd = POE::Component::Server::HTTP->new(
# Line 638  sub root_handler { Line 724  sub root_handler {
724                                  fmt => {                                  fmt => {
725                                          date => sub {                                          date => sub {
726                                                  my $date = shift || return;                                                  my $date = shift || return;
727                                                  qq{<hr/><div class="date"><a href="/?date=$date">$date</a></div> '};                                                  qq{<hr/><div class="date"><a href="/?date=$date">$date</a></div>};
728                                          },                                          },
729                                          time => '<span class="time">%s</span> ',                                          time => '<span class="time">%s</span> ',
730                                          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.41
  ViewVC Help
Powered by ViewVC 1.1.26