/[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 85 by dpavlin, Thu Mar 6 22:16:27 2008 UTC revision 87 by dpavlin, Fri Mar 7 00:18:02 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    
58    # log output encoding
59  my $ENCODING = 'ISO-8859-2';  my $ENCODING = 'ISO-8859-2';
60  my $TIMESTAMP = '%Y-%m-%d %H:%M:%S';  my $TIMESTAMP = '%Y-%m-%d %H:%M:%S';
61    
# Line 103  GetOptions( Line 104  GetOptions(
104          'log:s' => \$log_path,          'log:s' => \$log_path,
105  );  );
106    
107  $SIG{__DIE__} = sub {  #$SIG{__DIE__} = sub {
108          confess "fatal error";  #       confess "fatal error";
109  };  #};
110    
111  open(STDOUT, '>', $log_path) || warn "can't redirect log to $log_path: $!";  open(STDOUT, '>', $log_path) || warn "can't redirect log to $log_path: $!";
112    
113  sub _log {  sub _log {
114          print strftime($TIMESTAMP,localtime()), ' ', join(" ",@_), $/;          my $out = strftime($TIMESTAMP,localtime()) . ' ' . join(" ",@_) . $/;
115            from_to( $out, 'UTF-8', $ENCODING );
116            print $out;
117  }  }
118    
119  # LOG following  # LOG following
# Line 206  create table feeds ( Line 209  create table feeds (
209          id serial,          id serial,
210          url text not null,          url text not null,
211          name text,          name text,
212          delay interval not null default '30 sec', --'5 min',          delay interval not null default '5 min',
213          active boolean default true,          active boolean default true,
214          last_update timestamp default 'now()',          last_update timestamp default 'now()',
215          polls int default 0,          polls int default 0,
# Line 278  sub meta { Line 281  sub meta {
281    
282    
283    
284  my $sth = $dbh->prepare(qq{  my $sth_insert_log = $dbh->prepare(qq{
285  insert into log  insert into log
286          (channel, me, nick, message, time)          (channel, me, nick, message, time)
287  values (?,?,?,?,?)  values (?,?,?,?,?)
# Line 599  sub save_message { Line 602  sub save_message {
602                  $a->{me} ? "***" . $a->{nick} : "<" . $a->{nick} . ">",                  $a->{me} ? "***" . $a->{nick} : "<" . $a->{nick} . ">",
603                  " " . $a->{message};                  " " . $a->{message};
604    
605          from_to($a->{message}, 'UTF-8', $ENCODING);          $sth_insert_log->execute($a->{channel}, $a->{me}, $a->{nick}, $a->{message}, $a->{time});
   
         $sth->execute($a->{channel}, $a->{me}, $a->{nick}, $a->{message}, $a->{time});  
606          add_tag( id => $dbh->last_insert_id(undef,undef,"log",undef), %$a );          add_tag( id => $dbh->last_insert_id(undef,undef,"log",undef), %$a );
607  }  }
608    
# Line 653  sub rss_fetch { Line 654  sub rss_fetch {
654          # 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?
655          my $send_rss_msgs = 1;          my $send_rss_msgs = 1;
656    
657            _log "RSS fetch", $args->{url};
658    
659          my $feed = XML::Feed->parse(URI->new( $args->{url} ));          my $feed = XML::Feed->parse(URI->new( $args->{url} ));
660          if ( ! $feed ) {          if ( ! $feed ) {
661                  _log("can't fetch RSS ", $args->{url});                  _log("can't fetch RSS ", $args->{url});
662                  return;                  return;
663          }          }
664          my $updates = 0;          my ( $total, $updates ) = ( 0, 0 );
665          for my $entry ($feed->entries) {          for my $entry ($feed->entries) {
666                    $total++;
667    
668                  # seen allready?                  # seen allready?
669                  return if $_rss->{$feed->link}->{seen}->{$entry->id}++ > 0;                  return if $_rss->{$feed->link}->{seen}->{$entry->id}++ > 0;
# Line 676  sub rss_fetch { Line 680  sub rss_fetch {
680                  $msg .= prefix( ' -- ' , $entry->link );                  $msg .= prefix( ' -- ' , $entry->link );
681  #               $msg .= prefix( ' id ' , $entry->id );  #               $msg .= prefix( ' id ' , $entry->id );
682    
                 _log('RSS', $msg);  
   
683                  if ( $args->{kernel} && $send_rss_msgs ) {                  if ( $args->{kernel} && $send_rss_msgs ) {
684                          warn "# sending to $CHANNEL\n";                          warn "# sending to $CHANNEL\n";
685                          $send_rss_msgs--;                          $send_rss_msgs--;
686                          $args->{kernel}->post( $IRC_ALIAS => notice => $CHANNEL, $msg );                          $args->{kernel}->post( $IRC_ALIAS => notice => $CHANNEL, $msg );
687                          $updates++;                          $updates++;
688                            #$sth_insert_log->execute( $CHANNEL, 1, $NICK, $msg, undef );
689                            _log('RSS', $msg);
690                  }                  }
691          }          }
692    
693          my $sql = qq{ update feeds set last_update = now(), polls = polls + 1 };          my $sql = qq{ update feeds set last_update = now(), polls = polls + 1 };
694          $sql .= qq{, updates = updates + $updates } if $updates;          $sql .= qq{, updates = updates + $updates } if $updates;
695          $sql .= qq{where id = } . $args->{id};          $sql .= qq{where id = } . $args->{id};
696          $dbh->do( $sql );          eval { $dbh->do( $sql ) };
697    
698            _log "RSS got $total items of which $updates new";
699    
700          return $updates;          return $updates;
701  }  }
# Line 708  sub rss_fetch_all { Line 714  sub rss_fetch_all {
714          warn "# ",$sth->rows," active RSS feeds\n";          warn "# ",$sth->rows," active RSS feeds\n";
715          my $count = 0;          my $count = 0;
716          while (my $row = $sth->fetchrow_hashref) {          while (my $row = $sth->fetchrow_hashref) {
                 warn "+++ fetch RSS feed: ",dump( $row );  
717                  $row->{kernel} = $kernel if $kernel;                  $row->{kernel} = $kernel if $kernel;
718                  $count += rss_fetch( $row );                  $count += rss_fetch( $row );
719          }          }
720          return "OK, fetched $count posts from " . $sth->rows . " feeds";          return "OK, fetched $count posts from " . $sth->rows . " feeds";
721  }  }
722    
 my $rss_last_poll = time();  
723    
724  sub rss_check_updates {  sub rss_check_updates {
725          my $kernel = shift;          my $kernel = shift;
726            my $last_t = $_rss->{last_poll} || time();
727          my $t = time();          my $t = time();
728          if ( $rss_last_poll - $t > $rss_min_delay ) {          if ( $last_t - $t > $rss_min_delay ) {
729                  $rss_last_poll = $t;                  $_rss->{last_poll} = $t;
730                  _log rss_fetch_all( $kernel );                  _log rss_fetch_all( $kernel );
731          }          }
732  }  }
# Line 746  POE::Session->create( inline_states => { Line 751  POE::Session->create( inline_states => {
751      },      },
752      irc_255 => sub {    # server is done blabbing      irc_255 => sub {    # server is done blabbing
753                  $_[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;  
754                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "IDENTIFY $NICK" );                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "IDENTIFY $NICK" );
755      },      },
756      irc_public => sub {      irc_public => sub {
# Line 799  POE::Session->create( inline_states => { Line 801  POE::Session->create( inline_states => {
801                  my $nick = (split /!/, $_[ARG0])[0];                  my $nick = (split /!/, $_[ARG0])[0];
802                  my $msg = $_[ARG2];                  my $msg = $_[ARG2];
803                  my $channel = $_[ARG1]->[0];                  my $channel = $_[ARG1]->[0];
                 from_to($msg, 'UTF-8', $ENCODING);  
804    
805                  my $res = "unknown command '$msg', try /msg $NICK help!";                  my $res = "unknown command '$msg', try /msg $NICK help!";
806                  my @out;                  my @out;
# Line 843  POE::Session->create( inline_states => { Line 844  POE::Session->create( inline_states => {
844    
845                          foreach my $res (get_from_log( limit => $limit )) {                          foreach my $res (get_from_log( limit => $limit )) {
846                                  _log "last: $res";                                  _log "last: $res";
                                 from_to($res, $ENCODING, 'UTF-8');  
847                                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );                                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );
848                          }                          }
849    
# Line 858  POE::Session->create( inline_states => { Line 858  POE::Session->create( inline_states => {
858                                          search => $what,                                          search => $what,
859                                  )) {                                  )) {
860                                  _log "search [$what]: $res";                                  _log "search [$what]: $res";
                                 from_to($res, $ENCODING, 'UTF-8');  
861                                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );                                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );
862                          }                          }
863    
# Line 952  POE::Session->create( inline_states => { Line 951  POE::Session->create( inline_states => {
951    
952                  if ($res) {                  if ($res) {
953                          _log ">> [$nick] $res";                          _log ">> [$nick] $res";
                         from_to($res, $ENCODING, 'UTF-8');  
954                          $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );                          $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );
955                  }                  }
956    
# Line 995  POE::Session->create( inline_states => { Line 993  POE::Session->create( inline_states => {
993                          "";                          "";
994        0;                        # false for signals        0;                        # false for signals
995      },      },
     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);  
     }  
996     },     },
997    );    );
998    
# Line 1183  sub root_handler { Line 1120  sub root_handler {
1120                                  my $message = $filter->{message}->( $m->{message} );                                  my $message = $filter->{message}->( $m->{message} );
1121                                  $message .= "<br/>\n" unless $message =~ m!<(/p|br/?)>!;                                  $message .= "<br/>\n" unless $message =~ m!<(/p|br/?)>!;
1122  #                               warn "## message = $message\n";  #                               warn "## message = $message\n";
                                 from_to( $message, $ENCODING, 'UTF-8' );  
1123    
1124                                  #$feed_entry->summary(                                  #$feed_entry->summary(
1125                                  $feed_entry->content(                                  $feed_entry->content(
# Line 1227  sub root_handler { Line 1163  sub root_handler {
1163                  warn "$@";                  warn "$@";
1164          }          }
1165    
1166          $response->content_type("text/html; charset=$ENCODING");          $response->content_type("text/html; charset=UTF-8");
1167    
1168          my $html =          my $html =
1169                  qq{<html><head><title>$NICK</title><style type="text/css">$style}                  qq{<html><head><title>$NICK</title><style type="text/css">$style}
Legend:
Removed from v.85  
changed lines
  Added in v.87
  ViewVC Help
Powered by ViewVC 1.1.26