/[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 99 by dpavlin, Fri Mar 7 17:13:30 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    
 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 65  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 73  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 99  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          print strftime($TIMESTAMP,localtime()), ' ', join(" ",@_), $/;          print strftime($TIMESTAMP,localtime()) . ' ' . join(" ",@_) . $/;
 }  
   
 # 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 148  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 174  my $filter = { Line 143  my $filter = {
143  };  };
144    
145  my $dbh = DBI->connect($DSN,"","", { RaiseError => 1, AutoCommit => 1 }) || die $DBI::errstr;  my $dbh = DBI->connect($DSN,"","", { RaiseError => 1, AutoCommit => 1 }) || die $DBI::errstr;
146    $dbh->do( qq{ set client_encoding = 'UTF-8' } );
147    
148  my $sql_schema = {  my $sql_schema = {
149          log => qq{          log => qq{
# Line 206  create table feeds ( Line 176  create table feeds (
176          id serial,          id serial,
177          url text not null,          url text not null,
178          name text,          name text,
179          delay interval not null default '30 sec', --'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 257  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 269  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 278  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 530  sub add_tag { Line 503  sub add_tag {
503          return unless ($arg->{id} && $arg->{message});          return unless ($arg->{id} && $arg->{message});
504    
505          my $m = $arg->{message};          my $m = $arg->{message};
         from_to('UTF-8', 'iso-8859-2', $m) if (is_utf8($m));  
506    
507          my @tags;          my @tags;
508    
# Line 599  sub save_message { Line 571  sub save_message {
571                  $a->{me} ? "***" . $a->{nick} : "<" . $a->{nick} . ">",                  $a->{me} ? "***" . $a->{nick} : "<" . $a->{nick} . ">",
572                  " " . $a->{message};                  " " . $a->{message};
573    
574          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});  
575          add_tag( id => $dbh->last_insert_id(undef,undef,"log",undef), %$a );          add_tag( id => $dbh->last_insert_id(undef,undef,"log",undef), %$a );
576  }  }
577    
# Line 653  sub rss_fetch { Line 623  sub rss_fetch {
623          # 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?
624          my $send_rss_msgs = 1;          my $send_rss_msgs = 1;
625    
626            _log "RSS fetch", $args->{url};
627    
628          my $feed = XML::Feed->parse(URI->new( $args->{url} ));          my $feed = XML::Feed->parse(URI->new( $args->{url} ));
629          if ( ! $feed ) {          if ( ! $feed ) {
630                  _log("can't fetch RSS ", $args->{url});                  _log("can't fetch RSS ", $args->{url});
631                  return;                  return;
632          }          }
633          my $updates = 0;  
634            my ( $total, $updates ) = ( 0, 0 );
635          for my $entry ($feed->entries) {          for my $entry ($feed->entries) {
636                    $total++;
637    
638                  # seen allready?                  # seen allready?
639                  return if $_rss->{$feed->link}->{seen}->{$entry->id}++ > 0;                  next if $_rss->{$args->{channel}}->{$feed->link}->{$entry->id}++ > 0;
640    
641                  sub prefix {                  sub prefix {
642                          my ($txt,$var) = @_;                          my ($txt,$var) = @_;
643                            $var =~ s/\s+/ /gs;
644                          $var =~ s/^\s+//g;                          $var =~ s/^\s+//g;
645                            $var =~ s/\s+$//g;
646                          return $txt . $var if $var;                          return $txt . $var if $var;
647                  }                  }
648    
649                    # fix absolute and relative links to feed entries
650                    my $link = $entry->link;
651                    if ( $link =~ m!^/! ) {
652                            my $host = $args->{url};
653                            $host =~ s!^(http://[^/]+).*$!$1!;      #!vim
654                            $link = "$host/$link";
655                    } elsif ( $link !~ m!^http! ) {
656                            $link = $args->{url} . $link;
657                    }
658                    $link =~ s!//+!/!g;
659    
660                  my $msg;                  my $msg;
661                  $msg .= prefix( 'From: ' , $feed->title );                  $msg .= prefix( 'From: ' , $args->{name} || $feed->title );
662                  $msg .= prefix( ' by ' , $entry->author );                  $msg .= prefix( ' by ' , $entry->author );
663                  $msg .= prefix( ' -- ' , $entry->link );                  $msg .= prefix( ' | ' , $entry->title );
664                    $msg .= prefix( ' | ' , $link );
665  #               $msg .= prefix( ' id ' , $entry->id );  #               $msg .= prefix( ' id ' , $entry->id );
666    
                 _log('RSS', $msg);  
   
667                  if ( $args->{kernel} && $send_rss_msgs ) {                  if ( $args->{kernel} && $send_rss_msgs ) {
                         warn "# sending to $CHANNEL\n";  
668                          $send_rss_msgs--;                          $send_rss_msgs--;
669                          $args->{kernel}->post( $IRC_ALIAS => notice => $CHANNEL, $msg );                          $sth_insert_log->execute( $args->{channel}, 1, $NICK, $msg, 'now()' );
670                            my ( $type, $to ) = ( 'notice', $args->{channel} );
671                            ( $type, $to ) = ( 'privmsg', $args->{nick} ) if $args->{private};
672                            _log(">> $type $to |", $msg);
673                            $args->{kernel}->post( $IRC_ALIAS => $type => $to, $msg );
674                          $updates++;                          $updates++;
675                  }                  }
676          }          }
# Line 689  sub rss_fetch { Line 678  sub rss_fetch {
678          my $sql = qq{ update feeds set last_update = now(), polls = polls + 1 };          my $sql = qq{ update feeds set last_update = now(), polls = polls + 1 };
679          $sql .= qq{, updates = updates + $updates } if $updates;          $sql .= qq{, updates = updates + $updates } if $updates;
680          $sql .= qq{where id = } . $args->{id};          $sql .= qq{where id = } . $args->{id};
681          $dbh->do( $sql );          eval { $dbh->do( $sql ) };
682    
683            _log "RSS got $total items of which $updates new";
684    
685          return $updates;          return $updates;
686  }  }
# Line 697  sub rss_fetch { Line 688  sub rss_fetch {
688  sub rss_fetch_all {  sub rss_fetch_all {
689          my $kernel = shift;          my $kernel = shift;
690          my $sql = qq{          my $sql = qq{
691                  select id, url, name                  select id, url, name, channel, nick, private
692                  from feeds                  from feeds
693                  where active is true                  where active is true
694          };          };
# Line 708  sub rss_fetch_all { Line 699  sub rss_fetch_all {
699          warn "# ",$sth->rows," active RSS feeds\n";          warn "# ",$sth->rows," active RSS feeds\n";
700          my $count = 0;          my $count = 0;
701          while (my $row = $sth->fetchrow_hashref) {          while (my $row = $sth->fetchrow_hashref) {
                 warn "+++ fetch RSS feed: ",dump( $row );  
702                  $row->{kernel} = $kernel if $kernel;                  $row->{kernel} = $kernel if $kernel;
703                  $count += rss_fetch( $row );                  $count += rss_fetch( $row );
704          }          }
705          return "OK, fetched $count posts from " . $sth->rows . " feeds";          return "OK, fetched $count posts from " . $sth->rows . " feeds";
706  }  }
707    
 my $rss_last_poll = time();  
708    
709  sub rss_check_updates {  sub rss_check_updates {
710          my $kernel = shift;          my $kernel = shift;
711          my $t = time();          $_rss->{last_poll} ||= time();
712          if ( $rss_last_poll - $t > $rss_min_delay ) {          my $dt = time() - $_rss->{last_poll};
713                  $rss_last_poll = $t;          warn "## rss_check_updates $dt > $rss_min_delay\n";
714            if ( $dt > $rss_min_delay ) {
715                    $_rss->{last_poll} = time();
716                  _log rss_fetch_all( $kernel );                  _log rss_fetch_all( $kernel );
717          }          }
718  }  }
# Line 733  _log rss_fetch_all; Line 724  _log rss_fetch_all;
724  # POE handing part  # POE handing part
725  #  #
726    
 my $SKIPPING = 0;               # if skipping, how many we've done  
 my $SEND_QUEUE;                 # cache  
727  my $ping;                                               # ping stats  my $ping;                                               # ping stats
728    
729  POE::Component::IRC->new($IRC_ALIAS);  POE::Component::IRC->new($IRC_ALIAS);
# Line 746  POE::Session->create( inline_states => { Line 735  POE::Session->create( inline_states => {
735      },      },
736      irc_255 => sub {    # server is done blabbing      irc_255 => sub {    # server is done blabbing
737                  $_[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;  
738                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "IDENTIFY $NICK" );                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "IDENTIFY $NICK" );
739      },      },
740      irc_public => sub {      irc_public => sub {
# Line 759  POE::Session->create( inline_states => { Line 745  POE::Session->create( inline_states => {
745    
746                  save_message( channel => $channel, me => 0, nick => $nick, message => $msg);                  save_message( channel => $channel, me => 0, nick => $nick, message => $msg);
747                  meta( $nick, $channel, 'last-msg', $msg );                  meta( $nick, $channel, 'last-msg', $msg );
748                    rss_check_updates( $kernel );
749      },      },
750      irc_ctcp_action => sub {      irc_ctcp_action => sub {
751                  my $kernel = $_[KERNEL];                  my $kernel = $_[KERNEL];
# Line 799  POE::Session->create( inline_states => { Line 786  POE::Session->create( inline_states => {
786                  my $nick = (split /!/, $_[ARG0])[0];                  my $nick = (split /!/, $_[ARG0])[0];
787                  my $msg = $_[ARG2];                  my $msg = $_[ARG2];
788                  my $channel = $_[ARG1]->[0];                  my $channel = $_[ARG1]->[0];
                 from_to($msg, 'UTF-8', $ENCODING);  
789    
790                  my $res = "unknown command '$msg', try /msg $NICK help!";                  my $res = "unknown command '$msg', try /msg $NICK help!";
791                  my @out;                  my @out;
# Line 843  POE::Session->create( inline_states => { Line 829  POE::Session->create( inline_states => {
829    
830                          foreach my $res (get_from_log( limit => $limit )) {                          foreach my $res (get_from_log( limit => $limit )) {
831                                  _log "last: $res";                                  _log "last: $res";
                                 from_to($res, $ENCODING, 'UTF-8');  
832                                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );                                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );
833                          }                          }
834    
# Line 858  POE::Session->create( inline_states => { Line 843  POE::Session->create( inline_states => {
843                                          search => $what,                                          search => $what,
844                                  )) {                                  )) {
845                                  _log "search [$what]: $res";                                  _log "search [$what]: $res";
                                 from_to($res, $ENCODING, 'UTF-8');  
846                                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );                                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );
847                          }                          }
848    
# Line 932  POE::Session->create( inline_states => { Line 916  POE::Session->create( inline_states => {
916                          $res = rss_fetch_all( $_[KERNEL] );                          $res = rss_fetch_all( $_[KERNEL] );
917                  } elsif ($msg =~ m/^rss-clean/) {                  } elsif ($msg =~ m/^rss-clean/) {
918                          $_rss = undef;                          $_rss = undef;
919                            $dbh->do( qq{ update feeds set last_update = now() - delay } );
920                          $res = "OK, cleaned RSS cache";                          $res = "OK, cleaned RSS cache";
921                  } elsif ($msg =~ m!^rss-(add|remove|stop|start)\s+(http://\S+)\s*(.*)!) {                  } elsif ($msg =~ m/^rss-list/) {
922                            my $sth = $dbh->prepare(qq{ select url,name,last_update,active,channel,nick,private from feeds });
923                            $sth->execute;
924                            while (my @row = $sth->fetchrow_array) {
925                                    $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, join(' | ',@row) );
926                            }
927                            $res = '';
928                    } elsif ($msg =~ m!^rss-(add|remove|stop|start)(?:-(private))?\s+(http://\S+)\s*(.*)!) {
929                            my ( $command, $sub, $url, $arg ) = ( $1,$2,$3,$4 );
930    
931                            my $channel = $1 if ( $arg =~ s/\s*(#\S+)\s*// );
932                            $channel = $nick if $sub eq 'private';
933    
934                          my $sql = {                          my $sql = {
935                                  add             => qq{ insert into feeds (url,name) values (?,?) },                                  add             => qq{ insert into feeds (url,name,channel,nick,private) values (?,?,?,?,?) },
936  #                               remove  => qq{ delete from feeds                                where url = ? and name = ? },  #                               remove  => qq{ delete from feeds                                where url = ? and name = ? },
937                                  start   => qq{ update feeds set active = true   where url = ? -- ? },                                  start   => qq{ update feeds set active = true   where url = ? },
938                                  stop    => qq{ update feeds set active = false  where url = ? -- ? },                                  stop    => qq{ update feeds set active = false  where url = ? },
                                   
939                          };                          };
940                          if (my $q = $sql->{$1} ) {  
941                            if ( $command eq 'add' && ! $channel ) {
942                                    $res = "ERROR: got '$msg' which doesn't have #channel in it, ignoring!";
943                            } elsif (my $q = $sql->{$command} ) {
944                                  my $sth = $dbh->prepare( $q );                                  my $sth = $dbh->prepare( $q );
945                                  warn "## SQL $q ( $2 | $3 )\n";                                  my @data = ( $url );
946                                  eval { $sth->execute( $2, $3 ) };                                  if ( $command eq 'add' ) {
947                                            push @data, ( $arg, $channel, $nick, $sub eq 'private' ? 1 : 0 );
948                                    }
949                                    warn "## $command SQL $q with ",dump( @data ),"\n";
950                                    eval { $sth->execute( @data ) };
951                                    if ($@) {
952                                            $res = "ERROR: $@";
953                                    } else {
954                                            $res = "OK, RSS [$command|$sub|$url|$arg]";
955                                    }
956                            } else {
957                                    $res = "ERROR: don't know what to do with: $msg";
958                          }                          }
   
                         $res ||= "OK, RSS $1 : $2 - $3";  
959                  }                  }
960    
961                  if ($res) {                  if ($res) {
962                          _log ">> [$nick] $res";                          _log ">> [$nick] $res";
                         from_to($res, $ENCODING, 'UTF-8');  
963                          $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );                          $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );
964                  }                  }
965    
# Line 995  POE::Session->create( inline_states => { Line 1002  POE::Session->create( inline_states => {
1002                          "";                          "";
1003        0;                        # false for signals        0;                        # false for signals
1004      },      },
     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);  
     }  
1005     },     },
1006    );    );
1007    
# Line 1183  sub root_handler { Line 1129  sub root_handler {
1129                                  my $message = $filter->{message}->( $m->{message} );                                  my $message = $filter->{message}->( $m->{message} );
1130                                  $message .= "<br/>\n" unless $message =~ m!<(/p|br/?)>!;                                  $message .= "<br/>\n" unless $message =~ m!<(/p|br/?)>!;
1131  #                               warn "## message = $message\n";  #                               warn "## message = $message\n";
                                 from_to( $message, $ENCODING, 'UTF-8' );  
1132    
1133                                  #$feed_entry->summary(                                  #$feed_entry->summary(
1134                                  $feed_entry->content(                                  $feed_entry->content(
# Line 1214  sub root_handler { Line 1159  sub root_handler {
1159                                  $feed->add_entry( $feed_entry );                                  $feed->add_entry( $feed_entry );
1160                          }                          }
1161    
1162                            my $feed_entry = XML::Feed::Entry->new($type);
1163                            $feed_entry->title( "Internal stats" );
1164                            $feed_entry->content(
1165                                    '<![CDATA[<pre>' . dump( $_rss ) . '</pre>]]>'
1166                            );
1167                            $feed->add_entry( $feed_entry );
1168    
1169                  } else {                  } else {
1170                          _log "unknown rss request ",$request->url;                          _log "unknown rss request ",$request->url;
1171                          return RC_DENY;                          return RC_DENY;
# Line 1227  sub root_handler { Line 1179  sub root_handler {
1179                  warn "$@";                  warn "$@";
1180          }          }
1181    
1182          $response->content_type("text/html; charset=$ENCODING");          $response->content_type("text/html; charset=UTF-8");
1183    
1184          my $html =          my $html =
1185                  qq{<html><head><title>$NICK</title><style type="text/css">$style}                  qq{<html><head><title>$NICK</title><style type="text/css">$style}
# Line 1278  sub root_handler { Line 1230  sub root_handler {
1230                          }                          }
1231                          $cal->setcontent($dd, qq[                          $cal->setcontent($dd, qq[
1232                                  <a href="$url?date=$row->{date}">$row->{nr}</a><br/>$row->{len}                                  <a href="$url?date=$row->{date}">$row->{nr}</a><br/>$row->{len}
1233                          ]);                          ]) if $cal;
1234                                                    
1235                  }                  }
1236                  $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.85  
changed lines
  Added in v.99
  ViewVC Help
Powered by ViewVC 1.1.26