/[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 87 by dpavlin, Fri Mar 7 00:18:02 2008 UTC
# Line 104  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    
# Line 177  my $filter = { Line 177  my $filter = {
177  };  };
178    
179  my $dbh = DBI->connect($DSN,"","", { RaiseError => 1, AutoCommit => 1 }) || die $DBI::errstr;  my $dbh = DBI->connect($DSN,"","", { RaiseError => 1, AutoCommit => 1 }) || die $DBI::errstr;
 $dbh->do( qq{ set client_encoding = 'UTF-8' } );  
180    
181  my $sql_schema = {  my $sql_schema = {
182          log => qq{          log => qq{
# Line 282  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 603  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          $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});
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 655  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 683  sub rss_fetch { Line 685  sub rss_fetch {
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                          save_message( channel => $CHANNEL, me => 1, nick => $NICK, message => $msg );                          #$sth_insert_log->execute( $CHANNEL, 1, $NICK, $msg, undef );
689                          _log('RSS', $msg);                          _log('RSS', $msg);
690                  }                  }
691          }          }
# Line 693  sub rss_fetch { Line 695  sub rss_fetch {
695          $sql .= qq{where id = } . $args->{id};          $sql .= qq{where id = } . $args->{id};
696          eval { $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  }  }
702    
# Line 710  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 748  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 993  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    
Legend:
Removed from v.86  
changed lines
  Added in v.87
  ViewVC Help
Powered by ViewVC 1.1.26