/[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 86 by dpavlin, Thu Mar 6 22:57:16 2008 UTC revision 89 by dpavlin, Fri Mar 7 00:43:45 2008 UTC
# Line 55  my $follows_path = 'follows.log'; Line 55  my $follows_path = 'follows.log';
55    
56  my $DSN = 'DBI:Pg:dbname=' . $NICK;  my $DSN = 'DBI:Pg:dbname=' . $NICK;
57    
 # log output encoding  
 my $ENCODING = 'ISO-8859-2';  
58  my $TIMESTAMP = '%Y-%m-%d %H:%M:%S';  my $TIMESTAMP = '%Y-%m-%d %H:%M:%S';
59    
60  my $sleep_on_error = 5;  my $sleep_on_error = 5;
# Line 77  my $url = "http://$HOSTNAME:$http_port"; Line 75  my $url = "http://$HOSTNAME:$http_port";
75  use POE qw(Component::IRC Wheel::FollowTail Component::Server::HTTP);  use POE qw(Component::IRC Wheel::FollowTail Component::Server::HTTP);
76  use HTTP::Status;  use HTTP::Status;
77  use DBI;  use DBI;
 use Encode qw/from_to is_utf8/;  
78  use Regexp::Common qw /URI/;  use Regexp::Common qw /URI/;
79  use CGI::Simple;  use CGI::Simple;
80  use HTML::TagCloud;  use HTML::TagCloud;
# Line 104  GetOptions( Line 101  GetOptions(
101          'log:s' => \$log_path,          'log:s' => \$log_path,
102  );  );
103    
104  $SIG{__DIE__} = sub {  #$SIG{__DIE__} = sub {
105          confess "fatal error";  #       confess "fatal error";
106  };  #};
107    
108  open(STDOUT, '>', $log_path) || warn "can't redirect log to $log_path: $!";  open(STDOUT, '>', $log_path) || warn "can't redirect log to $log_path: $!";
109    
110  sub _log {  sub _log {
111          my $out = strftime($TIMESTAMP,localtime()) . ' ' . join(" ",@_) . $/;          print strftime($TIMESTAMP,localtime()) . ' ' . join(" ",@_) . $/;
         from_to( $out, 'UTF-8', $ENCODING );  
         print $out;  
112  }  }
113    
114  # LOG following  # LOG following
# Line 282  sub meta { Line 277  sub meta {
277    
278    
279    
280  my $sth = $dbh->prepare(qq{  my $sth_insert_log = $dbh->prepare(qq{
281  insert into log  insert into log
282          (channel, me, nick, message, time)          (channel, me, nick, message, time)
283  values (?,?,?,?,?)  values (?,?,?,?,?)
# Line 534  sub add_tag { Line 529  sub add_tag {
529          return unless ($arg->{id} && $arg->{message});          return unless ($arg->{id} && $arg->{message});
530    
531          my $m = $arg->{message};          my $m = $arg->{message};
         from_to('UTF-8', 'iso-8859-2', $m) if (is_utf8($m));  
532    
533          my @tags;          my @tags;
534    
# Line 603  sub save_message { Line 597  sub save_message {
597                  $a->{me} ? "***" . $a->{nick} : "<" . $a->{nick} . ">",                  $a->{me} ? "***" . $a->{nick} : "<" . $a->{nick} . ">",
598                  " " . $a->{message};                  " " . $a->{message};
599    
600          $sth->execute($a->{channel}, $a->{me}, $a->{nick}, $a->{message}, $a->{time});          $sth_insert_log->execute($a->{channel}, $a->{me}, $a->{nick}, $a->{message}, $a->{time});
601          add_tag( id => $dbh->last_insert_id(undef,undef,"log",undef), %$a );          add_tag( id => $dbh->last_insert_id(undef,undef,"log",undef), %$a );
602  }  }
603    
# Line 655  sub rss_fetch { Line 649  sub rss_fetch {
649          # how many messages to send out when feed is seen for the first time?          # how many messages to send out when feed is seen for the first time?
650          my $send_rss_msgs = 1;          my $send_rss_msgs = 1;
651    
652            _log "RSS fetch", $args->{url};
653    
654          my $feed = XML::Feed->parse(URI->new( $args->{url} ));          my $feed = XML::Feed->parse(URI->new( $args->{url} ));
655          if ( ! $feed ) {          if ( ! $feed ) {
656                  _log("can't fetch RSS ", $args->{url});                  _log("can't fetch RSS ", $args->{url});
657                  return;                  return;
658          }          }
659          my $updates = 0;          my ( $total, $updates ) = ( 0, 0 );
660          for my $entry ($feed->entries) {          for my $entry ($feed->entries) {
661                    $total++;
662    
663                  # seen allready?                  # seen allready?
664                  return if $_rss->{$feed->link}->{seen}->{$entry->id}++ > 0;                  return if $_rss->{$feed->link}->{seen}->{$entry->id}++ > 0;
# Line 679  sub rss_fetch { Line 676  sub rss_fetch {
676  #               $msg .= prefix( ' id ' , $entry->id );  #               $msg .= prefix( ' id ' , $entry->id );
677    
678                  if ( $args->{kernel} && $send_rss_msgs ) {                  if ( $args->{kernel} && $send_rss_msgs ) {
                         warn "# sending to $CHANNEL\n";  
679                          $send_rss_msgs--;                          $send_rss_msgs--;
680                            _log('RSS', $msg);
681                            $sth_insert_log->execute( $CHANNEL, 1, $NICK, $msg, undef );
682                          $args->{kernel}->post( $IRC_ALIAS => notice => $CHANNEL, $msg );                          $args->{kernel}->post( $IRC_ALIAS => notice => $CHANNEL, $msg );
683                          $updates++;                          $updates++;
                         save_message( channel => $CHANNEL, me => 1, nick => $NICK, message => $msg );  
                         _log('RSS', $msg);  
684                  }                  }
685          }          }
686    
# Line 693  sub rss_fetch { Line 689  sub rss_fetch {
689          $sql .= qq{where id = } . $args->{id};          $sql .= qq{where id = } . $args->{id};
690          eval { $dbh->do( $sql ) };          eval { $dbh->do( $sql ) };
691    
692            _log "RSS got $total items of which $updates new";
693    
694          return $updates;          return $updates;
695  }  }
696    
# Line 710  sub rss_fetch_all { Line 708  sub rss_fetch_all {
708          warn "# ",$sth->rows," active RSS feeds\n";          warn "# ",$sth->rows," active RSS feeds\n";
709          my $count = 0;          my $count = 0;
710          while (my $row = $sth->fetchrow_hashref) {          while (my $row = $sth->fetchrow_hashref) {
                 warn "+++ fetch RSS feed: ",dump( $row );  
711                  $row->{kernel} = $kernel if $kernel;                  $row->{kernel} = $kernel if $kernel;
712                  $count += rss_fetch( $row );                  $count += rss_fetch( $row );
713          }          }
714          return "OK, fetched $count posts from " . $sth->rows . " feeds";          return "OK, fetched $count posts from " . $sth->rows . " feeds";
715  }  }
716    
 my $rss_last_poll = time();  
717    
718  sub rss_check_updates {  sub rss_check_updates {
719          my $kernel = shift;          my $kernel = shift;
720            my $last_t = $_rss->{last_poll} || time();
721          my $t = time();          my $t = time();
722          if ( $rss_last_poll - $t > $rss_min_delay ) {          if ( $last_t - $t > $rss_min_delay ) {
723                  $rss_last_poll = $t;                  $_rss->{last_poll} = $t;
724                  _log rss_fetch_all( $kernel );                  _log rss_fetch_all( $kernel );
725          }          }
726  }  }
# Line 748  POE::Session->create( inline_states => { Line 745  POE::Session->create( inline_states => {
745      },      },
746      irc_255 => sub {    # server is done blabbing      irc_255 => sub {    # server is done blabbing
747                  $_[KERNEL]->post($IRC_ALIAS => join => $CHANNEL);                  $_[KERNEL]->post($IRC_ALIAS => join => $CHANNEL);
                 $_[KERNEL]->post($IRC_ALIAS => join => '#logger');  
                 $_[KERNEL]->yield("heartbeat"); # start heartbeat  
                 $_[KERNEL]->yield("my_add", $_) for keys %FOLLOWS;  
748                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "IDENTIFY $NICK" );                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "IDENTIFY $NICK" );
749      },      },
750      irc_public => sub {      irc_public => sub {
# Line 993  POE::Session->create( inline_states => { Line 987  POE::Session->create( inline_states => {
987                          "";                          "";
988        0;                        # false for signals        0;                        # false for signals
989      },      },
     my_add => sub {  
       my $trailing = $_[ARG0];  
       my $session = $_[SESSION];  
       POE::Session->create  
           (inline_states =>  
            {_start => sub {  
               $_[HEAP]->{wheel} =  
                 POE::Wheel::FollowTail->new  
                     (  
                      Filename => $FOLLOWS{$trailing},  
                      InputEvent => 'got_line',  
                     );  
                                 warn "+++ following $trailing at $FOLLOWS{$trailing}\n";  
             },  
             got_line => sub {  
                                 warn "+++ $trailing : $_[ARG0]\n";  
                                 $_[KERNEL]->post($session => my_tailed => time, $trailing, $_[ARG0]);  
             },  
            },  
           );  
       
     },  
     my_tailed => sub {  
       my ($time, $file, $line) = @_[ARG0..ARG2];  
       ## $time will be undef on a probe, or a time value if a real line  
   
       ## PoCo::IRC has throttling built in, but no external visibility  
       ## so this is reaching "under the hood"  
       $SEND_QUEUE ||=  
         $_[KERNEL]->alias_resolve($IRC_ALIAS)->get_heap->{send_queue};  
   
       ## handle "no need to keep skipping" transition  
       if ($SKIPPING and @$SEND_QUEUE < 1) {  
         $_[KERNEL]->post($IRC_ALIAS => privmsg => $CHANNEL =>  
                          "[discarded $SKIPPING messages]");  
         $SKIPPING = 0;  
       }  
   
       ## handle potential message display  
       if ($time) {  
         if ($SKIPPING or @$SEND_QUEUE > 3) { # 3 msgs per 10 seconds  
           $SKIPPING++;  
         } else {  
           my @time = localtime $time;  
           $_[KERNEL]->post($IRC_ALIAS => privmsg => $CHANNEL =>  
                            sprintf "%02d:%02d:%02d: %s: %s",  
                            ($time[2] + 11) % 12 + 1, $time[1], $time[0],  
                            $file, $line);  
         }  
       }  
   
       ## handle re-probe/flush if skipping  
       if ($SKIPPING) {  
         $_[KERNEL]->delay($_[STATE] => 0.5); # $time will be undef  
       }  
   
     },  
     my_heartbeat => sub {  
       $_[KERNEL]->yield(my_tailed => time, "heartbeat", "beep");  
       $_[KERNEL]->delay($_[STATE] => 10);  
     }  
990     },     },
991    );    );
992    
# Line 1275  sub root_handler { Line 1208  sub root_handler {
1208                          }                          }
1209                          $cal->setcontent($dd, qq[                          $cal->setcontent($dd, qq[
1210                                  <a href="$url?date=$row->{date}">$row->{nr}</a><br/>$row->{len}                                  <a href="$url?date=$row->{date}">$row->{nr}</a><br/>$row->{len}
1211                          ]);                          ]) if $cal;
1212                                                    
1213                  }                  }
1214                  $html .= qq{<td valign="top">} . $cal->as_HTML() . qq{</td></tr></table>};                  $html .= qq{<td valign="top">} . $cal->as_HTML() . qq{</td></tr></table>};
Legend:
Removed from v.86  
changed lines
  Added in v.89
  ViewVC Help
Powered by ViewVC 1.1.26