/[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 100 by dpavlin, Sat Mar 8 00:14:41 2008 UTC
# Line 20  Import log from C<dircproxy> to C<irc-lo Line 20  Import log from C<dircproxy> to C<irc-lo
20    
21  =item --log=irc-logger.log  =item --log=irc-logger.log
22    
 Name of log file  
   
 =item --follow=file.log  
   
 Follows new messages in file  
   
23  =back  =back
24    
25  =head1 DESCRIPTION  =head1 DESCRIPTION
# Line 50  my $CHANNEL = '#razmjenavjestina'; Line 44  my $CHANNEL = '#razmjenavjestina';
44  $CHANNEL = '#irc-logger' if ($HOSTNAME =~ m/llin/);  $CHANNEL = '#irc-logger' if ($HOSTNAME =~ m/llin/);
45  my $IRC_ALIAS = "log";  my $IRC_ALIAS = "log";
46    
 # default log to follow and announce messages  
 my $follows_path = 'follows.log';  
   
47  my $DSN = 'DBI:Pg:dbname=' . $NICK;  my $DSN = 'DBI:Pg:dbname=' . $NICK;
48    
 # log output encoding  
 my $ENCODING = 'ISO-8859-2';  
49  my $TIMESTAMP = '%Y-%m-%d %H:%M:%S';  my $TIMESTAMP = '%Y-%m-%d %H:%M:%S';
50    
51  my $sleep_on_error = 5;  my $sleep_on_error = 5;
# Line 66  my $last_x_tags = 50; Line 55  my $last_x_tags = 50;
55    
56  # don't pull rss feeds more often than this  # don't pull rss feeds more often than this
57  my $rss_min_delay = 60;  my $rss_min_delay = 60;
 $rss_min_delay = 15;  
58    
59  my $http_port = $NICK =~ m/-dev/ ? 8001 : 8000;  my $http_port = $NICK =~ m/-dev/ ? 8001 : 8000;
60    
# Line 74  my $url = "http://$HOSTNAME:$http_port"; Line 62  my $url = "http://$HOSTNAME:$http_port";
62    
63  ## END CONFIG  ## END CONFIG
64    
65  use POE qw(Component::IRC Wheel::FollowTail Component::Server::HTTP);  use POE qw(Component::IRC Component::Server::HTTP);
66  use HTTP::Status;  use HTTP::Status;
67  use DBI;  use DBI;
 use Encode qw/from_to is_utf8/;  
68  use Regexp::Common qw /URI/;  use Regexp::Common qw /URI/;
69  use CGI::Simple;  use CGI::Simple;
70  use HTML::TagCloud;  use HTML::TagCloud;
# Line 100  my $import_dircproxy; Line 87  my $import_dircproxy;
87  my $log_path;  my $log_path;
88  GetOptions(  GetOptions(
89          'import-dircproxy:s' => \$import_dircproxy,          'import-dircproxy:s' => \$import_dircproxy,
         'follows:s' => \$follows_path,  
90          'log:s' => \$log_path,          'log:s' => \$log_path,
91  );  );
92    
93  $SIG{__DIE__} = sub {  #$SIG{__DIE__} = sub {
94          confess "fatal error";  #       confess "fatal error";
95  };  #};
96    
97  open(STDOUT, '>', $log_path) || warn "can't redirect log to $log_path: $!";  open(STDOUT, '>', $log_path) || warn "can't redirect log to $log_path: $!";
98    
99  sub _log {  sub _log {
100          my $out = strftime($TIMESTAMP,localtime()) . ' ' . join(" ",@_) . $/;          print strftime($TIMESTAMP,localtime()) . ' ' . join(" ",@_) . $/;
         from_to( $out, 'UTF-8', $ENCODING );  
         print $out;  
 }  
   
 # LOG following  
   
 my %FOLLOWS =  
   (  
 #   ACCESS => "/var/log/apache/access.log",  
 #   ERROR => "/var/log/apache/error.log",  
   );  
   
 sub add_follow_path {  
         my $path = shift;  
         my $name = $path;  
         $name =~ s/\..*$//;  
         warn "# using $path to announce messages from $name\n";  
         $FOLLOWS{$name} = $path;  
101  }  }
102    
 add_follow_path( $follows_path ) if ( -e $follows_path );  
   
103  # HTML formatters  # HTML formatters
104    
105  my %escape = ('<'=>'&lt;', '>'=>'&gt;', '&'=>'&amp;', '"'=>'&quot;');  my %escape = ('<'=>'&lt;', '>'=>'&gt;', '&'=>'&amp;', '"'=>'&quot;');
# Line 151  my $filter = { Line 117  my $filter = {
117                  # protect HTML from wiki modifications                  # protect HTML from wiki modifications
118                  sub e {                  sub e {
119                          my $t = shift;                          my $t = shift;
120                          return 'uri_unescape{' . uri_escape($t) . '}';                          return 'uri_unescape{' . uri_escape($t, '^a-zA-Z0-9') . '}';
121                  }                  }
122    
123                  $m =~ s/($escape_re)/$escape{$1}/gs;                  $m =~ s/($escape_re)/$escape{$1}/gs;
124                  $m =~ s#($RE{URI}{HTTP})#e(qq{<a href="$1">$1</a>})#egs ||                  $m =~ s#($RE{URI}{HTTP})#e(qq{<a href="$1">$1</a>})#egs;
125                  $m =~ s#\/(\w+)\/#<i>$1</i>#gs;                  $m =~ s#\/(\w+)\/#<i>$1</i>#gs;
126                  $m =~ s#$tag_regex#e(qq{<a href="$url?tag=$1" class="tag">$1</a>})#egs;                  $m =~ s#$tag_regex#e(qq{<a href="$url?tag=$1" class="tag">$1</a>})#egs;
127                  $m =~ s#\*(\w+)\*#<b>$1</b>#gs;                  $m =~ s#\*(\w+)\*#<b>$1</b>#gs;
# Line 212  create table feeds ( Line 178  create table feeds (
178          name text,          name text,
179          delay interval not null default '5 min',          delay interval not null default '5 min',
180          active boolean default true,          active boolean default true,
181            channel text not null,
182            nick text not null,
183            private boolean default false,
184          last_update timestamp default 'now()',          last_update timestamp default 'now()',
185          polls int default 0,          polls int default 0,
186          updates int default 0          updates int default 0
187  );  );
188  create unique index feeds_url on feeds(url);  create unique index feeds_url on feeds(url);
189  insert into feeds (url,name) values ('http://wiki.razmjenavjestina.org/feed/workspace/razmjenavjestina?category=Recent%20Changes','wiki');  insert into feeds (url,name,channel,nick) values ('http://wiki.razmjenavjestina.org/feed/workspace/razmjenavjestina?category=Recent%20Changes','wiki','$CHANNEL','dpavlin');
190          },          },
191  };  };
192    
# Line 261  sub meta { Line 230  sub meta {
230                  if ( $@ || ! $sth->rows ) {                  if ( $@ || ! $sth->rows ) {
231                          $sth = $dbh->prepare(qq{ insert into meta (value,nick,channel,name,changed) values (?,?,?,?,now()) });                          $sth = $dbh->prepare(qq{ insert into meta (value,nick,channel,name,changed) values (?,?,?,?,now()) });
232                          $sth->execute( $value, $nick, $channel, $name );                          $sth->execute( $value, $nick, $channel, $name );
233                          _log "created $nick/$channel/$name = $value";                          warn "## created $nick/$channel/$name = $value\n";
234                  } else {                  } else {
235                          _log "updated $nick/$channel/$name = $value ";                          warn "## updated $nick/$channel/$name = $value\n";
236                  }                  }
237    
238                  return $value;                  return $value;
# Line 273  sub meta { Line 242  sub meta {
242                  my $sth = $dbh->prepare(qq{ select value,changed from meta where nick = ? and channel = ? and name = ? });                  my $sth = $dbh->prepare(qq{ select value,changed from meta where nick = ? and channel = ? and name = ? });
243                  $sth->execute( $nick, $channel, $name );                  $sth->execute( $nick, $channel, $name );
244                  my ($v,$c) = $sth->fetchrow_array;                  my ($v,$c) = $sth->fetchrow_array;
245                  _log "fetched $nick/$channel/$name = $v [$c]";                  warn "## fetched $nick/$channel/$name = $v [$c]\n";
246                  return ($v,$c) if wantarray;                  return ($v,$c) if wantarray;
247                  return $v;                  return $v;
248    
# Line 282  sub meta { Line 251  sub meta {
251    
252    
253    
254  my $sth = $dbh->prepare(qq{  my $sth_insert_log = $dbh->prepare(qq{
255  insert into log  insert into log
256          (channel, me, nick, message, time)          (channel, me, nick, message, time)
257  values (?,?,?,?,?)  values (?,?,?,?,?)
# Line 370  sub get_from_log { Line 339  sub get_from_log {
339    
340          my @where;          my @where;
341          my @args;          my @args;
342            my $msg;
343    
344          if (my $search = $args->{search}) {          if (my $search = $args->{search}) {
345                  $search =~ s/^\s+//;                  $search =~ s/^\s+//;
346                  $search =~ s/\s+$//;                  $search =~ s/\s+$//;
347                  push @where, 'message ilike ? or nick ilike ?';                  push @where, 'message ilike ? or nick ilike ?';
348                  push @args, ( ( '%' . $search . '%' ) x 2 );                  push @args, ( ( '%' . $search . '%' ) x 2 );
349                  _log "search for '$search'";                  $msg = "Search for '$search'";
350          }          }
351    
352          if ($args->{tag} && $tags->{ $args->{tag} }) {          if ($args->{tag} && $tags->{ $args->{tag} }) {
353                  push @where, 'id in (' . join(',', @{ $tags->{ $args->{tag} } }) . ')';                  push @where, 'id in (' . join(',', @{ $tags->{ $args->{tag} } }) . ')';
354                  _log "search for tags $args->{tag}";                  $msg = "Search for tags $args->{tag}";
355          }          }
356    
357          if (my $date = $args->{date} ) {          if (my $date = $args->{date} ) {
358                  $date = check_date( $date );                  $date = check_date( $date );
359                  push @where, 'date(time) = ?';                  push @where, 'date(time) = ?';
360                  push @args, $date;                  push @args, $date;
361                  _log "search for date $date";                  $msg = "search for date $date";
362          }          }
363    
364          $sql .= " where " . join(" and ", @where) if @where;          $sql .= " where " . join(" and ", @where) if @where;
# Line 402  sub get_from_log { Line 372  sub get_from_log {
372          eval { $sth->execute( @args ) };          eval { $sth->execute( @args ) };
373          return if $@;          return if $@;
374    
375            my $nr_results = $sth->rows;
376    
377          my $last_row = {          my $last_row = {
378                  date => '',                  date => '',
379                  time => '',                  time => '',
# Line 422  sub get_from_log { Line 394  sub get_from_log {
394    
395          return @rows if ($args->{full_rows});          return @rows if ($args->{full_rows});
396    
397          my @msgs = (          $msg .= ' produced ' . (
398                  "Showing " . ($#rows + 1) . " messages..."                  $nr_results == 0 ? 'no results' :
399                    $nr_results == 0 ? 'one result' :
400                            $nr_results . ' results'
401          );          );
402    
403            my @msgs = ( $msg );
404    
405          if ($context) {          if ($context) {
406                  my @ids = @rows;                  my @ids = @rows;
407                  @rows = ();                  @rows = ();
# Line 534  sub add_tag { Line 510  sub add_tag {
510          return unless ($arg->{id} && $arg->{message});          return unless ($arg->{id} && $arg->{message});
511    
512          my $m = $arg->{message};          my $m = $arg->{message};
         from_to('UTF-8', 'iso-8859-2', $m) if (is_utf8($m));  
513    
514          my @tags;          my @tags;
515    
# Line 603  sub save_message { Line 578  sub save_message {
578                  $a->{me} ? "***" . $a->{nick} : "<" . $a->{nick} . ">",                  $a->{me} ? "***" . $a->{nick} : "<" . $a->{nick} . ">",
579                  " " . $a->{message};                  " " . $a->{message};
580    
581          $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});
582          add_tag( id => $dbh->last_insert_id(undef,undef,"log",undef), %$a );          add_tag( id => $dbh->last_insert_id(undef,undef,"log",undef), %$a );
583  }  }
584    
# Line 655  sub rss_fetch { Line 630  sub rss_fetch {
630          # 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?
631          my $send_rss_msgs = 1;          my $send_rss_msgs = 1;
632    
633            _log "RSS fetch", $args->{url};
634    
635          my $feed = XML::Feed->parse(URI->new( $args->{url} ));          my $feed = XML::Feed->parse(URI->new( $args->{url} ));
636          if ( ! $feed ) {          if ( ! $feed ) {
637                  _log("can't fetch RSS ", $args->{url});                  _log("can't fetch RSS ", $args->{url});
638                  return;                  return;
639          }          }
640          my $updates = 0;  
641            my ( $total, $updates ) = ( 0, 0 );
642          for my $entry ($feed->entries) {          for my $entry ($feed->entries) {
643                    $total++;
644    
645                  # seen allready?                  # seen allready?
646                  return if $_rss->{$feed->link}->{seen}->{$entry->id}++ > 0;                  next if $_rss->{$args->{channel}}->{$feed->link}->{$entry->id}++ > 0;
647    
648                  sub prefix {                  sub prefix {
649                          my ($txt,$var) = @_;                          my ($txt,$var) = @_;
650                            $var =~ s/\s+/ /gs;
651                          $var =~ s/^\s+//g;                          $var =~ s/^\s+//g;
652                            $var =~ s/\s+$//g;
653                          return $txt . $var if $var;                          return $txt . $var if $var;
654                  }                  }
655    
656                    # fix absolute and relative links to feed entries
657                    my $link = $entry->link;
658                    if ( $link =~ m!^/! ) {
659                            my $host = $args->{url};
660                            $host =~ s!^(http://[^/]+).*$!$1!;      #!vim
661                            $link = "$host/$link";
662                    } elsif ( $link !~ m!^http! ) {
663                            $link = $args->{url} . $link;
664                    }
665    
666                  my $msg;                  my $msg;
667                  $msg .= prefix( 'From: ' , $feed->title );                  $msg .= prefix( 'From: ' , $args->{name} || $feed->title );
668                  $msg .= prefix( ' by ' , $entry->author );                  $msg .= prefix( ' by ' , $entry->author );
669                  $msg .= prefix( ' -- ' , $entry->link );                  $msg .= prefix( ' | ' , $entry->title );
670                    $msg .= prefix( ' | ' , $link );
671  #               $msg .= prefix( ' id ' , $entry->id );  #               $msg .= prefix( ' id ' , $entry->id );
672    
673                  if ( $args->{kernel} && $send_rss_msgs ) {                  if ( $args->{kernel} && $send_rss_msgs ) {
                         warn "# sending to $CHANNEL\n";  
674                          $send_rss_msgs--;                          $send_rss_msgs--;
675                          $args->{kernel}->post( $IRC_ALIAS => notice => $CHANNEL, $msg );                          $sth_insert_log->execute( $args->{channel}, 1, $NICK, $msg, 'now()' );
676                            my ( $type, $to ) = ( 'notice', $args->{channel} );
677                            ( $type, $to ) = ( 'privmsg', $args->{nick} ) if $args->{private};
678                            _log(">> $type $to |", $msg);
679                            $args->{kernel}->post( $IRC_ALIAS => $type => $to, $msg );
680                          $updates++;                          $updates++;
                         save_message( channel => $CHANNEL, me => 1, nick => $NICK, message => $msg );  
                         _log('RSS', $msg);  
681                  }                  }
682          }          }
683    
# Line 693  sub rss_fetch { Line 686  sub rss_fetch {
686          $sql .= qq{where id = } . $args->{id};          $sql .= qq{where id = } . $args->{id};
687          eval { $dbh->do( $sql ) };          eval { $dbh->do( $sql ) };
688    
689            _log "RSS got $total items of which $updates new";
690    
691          return $updates;          return $updates;
692  }  }
693    
694  sub rss_fetch_all {  sub rss_fetch_all {
695          my $kernel = shift;          my $kernel = shift;
696          my $sql = qq{          my $sql = qq{
697                  select id, url, name                  select id, url, name, channel, nick, private
698                  from feeds                  from feeds
699                  where active is true                  where active is true
700          };          };
# Line 710  sub rss_fetch_all { Line 705  sub rss_fetch_all {
705          warn "# ",$sth->rows," active RSS feeds\n";          warn "# ",$sth->rows," active RSS feeds\n";
706          my $count = 0;          my $count = 0;
707          while (my $row = $sth->fetchrow_hashref) {          while (my $row = $sth->fetchrow_hashref) {
                 warn "+++ fetch RSS feed: ",dump( $row );  
708                  $row->{kernel} = $kernel if $kernel;                  $row->{kernel} = $kernel if $kernel;
709                  $count += rss_fetch( $row );                  $count += rss_fetch( $row );
710          }          }
711          return "OK, fetched $count posts from " . $sth->rows . " feeds";          return "OK, fetched $count posts from " . $sth->rows . " feeds";
712  }  }
713    
 my $rss_last_poll = time();  
714    
715  sub rss_check_updates {  sub rss_check_updates {
716          my $kernel = shift;          my $kernel = shift;
717          my $t = time();          $_rss->{last_poll} ||= time();
718          if ( $rss_last_poll - $t > $rss_min_delay ) {          my $dt = time() - $_rss->{last_poll};
719                  $rss_last_poll = $t;          warn "## rss_check_updates $dt > $rss_min_delay\n";
720            if ( $dt > $rss_min_delay ) {
721                    $_rss->{last_poll} = time();
722                  _log rss_fetch_all( $kernel );                  _log rss_fetch_all( $kernel );
723          }          }
724  }  }
# Line 735  _log rss_fetch_all; Line 730  _log rss_fetch_all;
730  # POE handing part  # POE handing part
731  #  #
732    
 my $SKIPPING = 0;               # if skipping, how many we've done  
 my $SEND_QUEUE;                 # cache  
733  my $ping;                                               # ping stats  my $ping;                                               # ping stats
734    
735  POE::Component::IRC->new($IRC_ALIAS);  POE::Component::IRC->new($IRC_ALIAS);
# Line 748  POE::Session->create( inline_states => { Line 741  POE::Session->create( inline_states => {
741      },      },
742      irc_255 => sub {    # server is done blabbing      irc_255 => sub {    # server is done blabbing
743                  $_[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;  
744                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "IDENTIFY $NICK" );                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "IDENTIFY $NICK" );
745      },      },
746      irc_public => sub {      irc_public => sub {
# Line 761  POE::Session->create( inline_states => { Line 751  POE::Session->create( inline_states => {
751    
752                  save_message( channel => $channel, me => 0, nick => $nick, message => $msg);                  save_message( channel => $channel, me => 0, nick => $nick, message => $msg);
753                  meta( $nick, $channel, 'last-msg', $msg );                  meta( $nick, $channel, 'last-msg', $msg );
754                    rss_check_updates( $kernel );
755      },      },
756      irc_ctcp_action => sub {      irc_ctcp_action => sub {
757                  my $kernel = $_[KERNEL];                  my $kernel = $_[KERNEL];
# Line 931  POE::Session->create( inline_states => { Line 922  POE::Session->create( inline_states => {
922                          $res = rss_fetch_all( $_[KERNEL] );                          $res = rss_fetch_all( $_[KERNEL] );
923                  } elsif ($msg =~ m/^rss-clean/) {                  } elsif ($msg =~ m/^rss-clean/) {
924                          $_rss = undef;                          $_rss = undef;
925                            $dbh->do( qq{ update feeds set last_update = now() - delay } );
926                          $res = "OK, cleaned RSS cache";                          $res = "OK, cleaned RSS cache";
927                  } elsif ($msg =~ m!^rss-(add|remove|stop|start)\s+(http://\S+)\s*(.*)!) {                  } elsif ($msg =~ m/^rss-list/) {
928                            my $sth = $dbh->prepare(qq{ select url,name,last_update,active,channel,nick,private from feeds });
929                            $sth->execute;
930                            while (my @row = $sth->fetchrow_array) {
931                                    $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, join(' | ',@row) );
932                            }
933                            $res = '';
934                    } elsif ($msg =~ m!^rss-(add|remove|stop|start)(?:-(private))?\s+(http://\S+)\s*(.*)!) {
935                            my ( $command, $sub, $url, $arg ) = ( $1,$2,$3,$4 );
936    
937                            my $channel = $1 if ( $arg =~ s/\s*(#\S+)\s*// );
938                            $channel = $nick if $sub eq 'private';
939    
940                          my $sql = {                          my $sql = {
941                                  add             => qq{ insert into feeds (url,name) values (?,?) },                                  add             => qq{ insert into feeds (url,name,channel,nick,private) values (?,?,?,?,?) },
942  #                               remove  => qq{ delete from feeds                                where url = ? and name = ? },  #                               remove  => qq{ delete from feeds                                where url = ? and name = ? },
943                                  start   => qq{ update feeds set active = true   where url = ? -- ? },                                  start   => qq{ update feeds set active = true   where url = ? },
944                                  stop    => qq{ update feeds set active = false  where url = ? -- ? },                                  stop    => qq{ update feeds set active = false  where url = ? },
                                   
945                          };                          };
946                          if (my $q = $sql->{$1} ) {  
947                            if ( $command eq 'add' && ! $channel ) {
948                                    $res = "ERROR: got '$msg' which doesn't have #channel in it, ignoring!";
949                            } elsif (my $q = $sql->{$command} ) {
950                                  my $sth = $dbh->prepare( $q );                                  my $sth = $dbh->prepare( $q );
951                                  warn "## SQL $q ( $2 | $3 )\n";                                  my @data = ( $url );
952                                  eval { $sth->execute( $2, $3 ) };                                  if ( $command eq 'add' ) {
953                                            push @data, ( $arg, $channel, $nick, $sub eq 'private' ? 1 : 0 );
954                                    }
955                                    warn "## $command SQL $q with ",dump( @data ),"\n";
956                                    eval { $sth->execute( @data ) };
957                                    if ($@) {
958                                            $res = "ERROR: $@";
959                                    } else {
960                                            $res = "OK, RSS [$command|$sub|$url|$arg]";
961                                    }
962                            } else {
963                                    $res = "ERROR: don't know what to do with: $msg";
964                          }                          }
   
                         $res ||= "OK, RSS $1 : $2 - $3";  
965                  }                  }
966    
967                  if ($res) {                  if ($res) {
# Line 993  POE::Session->create( inline_states => { Line 1008  POE::Session->create( inline_states => {
1008                          "";                          "";
1009        0;                        # false for signals        0;                        # false for signals
1010      },      },
     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);  
     }  
1011     },     },
1012    );    );
1013    
# Line 1211  sub root_handler { Line 1165  sub root_handler {
1165                                  $feed->add_entry( $feed_entry );                                  $feed->add_entry( $feed_entry );
1166                          }                          }
1167    
1168                            my $feed_entry = XML::Feed::Entry->new($type);
1169                            $feed_entry->title( "Internal stats" );
1170                            $feed_entry->content(
1171                                    '<![CDATA[<pre>' . dump( $_rss ) . '</pre>]]>'
1172                            );
1173                            $feed->add_entry( $feed_entry );
1174    
1175                  } else {                  } else {
1176                          _log "unknown rss request ",$request->url;                          _log "unknown rss request ",$request->url;
1177                          return RC_DENY;                          return RC_DENY;
# Line 1275  sub root_handler { Line 1236  sub root_handler {
1236                          }                          }
1237                          $cal->setcontent($dd, qq[                          $cal->setcontent($dd, qq[
1238                                  <a href="$url?date=$row->{date}">$row->{nr}</a><br/>$row->{len}                                  <a href="$url?date=$row->{date}">$row->{nr}</a><br/>$row->{len}
1239                          ]);                          ]) if $cal;
1240                                                    
1241                  }                  }
1242                  $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.100
  ViewVC Help
Powered by ViewVC 1.1.26