/[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 129 by dpavlin, Fri Mar 14 17:44:23 2008 UTC
# Line 2  Line 2 
2  use strict;  use strict;
3  $|++;  $|++;
4    
5    use POE qw(Component::IRC Component::Server::HTTP Component::Client::HTTP);
6    use HTTP::Status;
7    use DBI;
8    use Regexp::Common qw /URI/;
9    use CGI::Simple;
10    use HTML::TagCloud;
11    use POSIX qw/strftime/;
12    use HTML::CalendarMonthSimple;
13    use Getopt::Long;
14    use DateTime;
15    use URI::Escape;
16    use Data::Dump qw/dump/;
17    use DateTime::Format::ISO8601;
18    use Carp qw/confess/;
19    use XML::Feed;
20    use DateTime::Format::Flexible;
21    use Encode;
22    
23  =head1 NAME  =head1 NAME
24    
25  irc-logger.pl  irc-logger.pl
# Line 20  Import log from C<dircproxy> to C<irc-lo Line 38  Import log from C<dircproxy> to C<irc-lo
38    
39  =item --log=irc-logger.log  =item --log=irc-logger.log
40    
 Name of log file  
   
 =item --follow=file.log  
   
 Follows new messages in file  
   
41  =back  =back
42    
43  =head1 DESCRIPTION  =head1 DESCRIPTION
# Line 36  log all conversation on irc channel Line 48  log all conversation on irc channel
48    
49  ## CONFIG  ## CONFIG
50    
51    my $debug = 0;
52    
53    my $irc_config = {
54            nick => 'irc-logger',
55            server => 'irc.freenode.net',
56            port => 6667,
57            ircname => 'Anna the bot: try /msg irc-logger help',
58    };
59    
60  my $HOSTNAME = `hostname -f`;  my $HOSTNAME = `hostname -f`;
61  chomp($HOSTNAME);  chomp($HOSTNAME);
62    
63  my $NICK = 'irc-logger';  
 $NICK .= '-dev' if ($HOSTNAME =~ m/llin/);  
 my $CONNECT =  
   {Server => 'irc.freenode.net',  
    Nick => $NICK,  
    Ircname => "try /msg $NICK help",  
   };  
64  my $CHANNEL = '#razmjenavjestina';  my $CHANNEL = '#razmjenavjestina';
 $CHANNEL = '#irc-logger' if ($HOSTNAME =~ m/llin/);  
 my $IRC_ALIAS = "log";  
65    
66  # default log to follow and announce messages  if ( $HOSTNAME =~ m/llin/ ) {
67  my $follows_path = 'follows.log';          $irc_config->{nick} = 'irc-logger-llin';
68    #       $irc_config = {
69    #               nick => 'irc-logger-llin',
70    #               server => 'localhost',
71    #               port => 6668,
72    #       };
73            $CHANNEL = '#irc-logger';
74    } elsif ( $HOSTNAME =~ m/lugarin/ ) {
75            $irc_config->{server} = 'irc.carnet.hr';
76            $CHANNEL = '#riss';
77    }
78    
79    my @channels = ( $CHANNEL );
80    
81    warn "## config = ", dump( $irc_config ) if $debug;
82    
83    my $NICK = $irc_config->{nick} or die "no nick?";
84    
85  my $DSN = 'DBI:Pg:dbname=' . $NICK;  my $DSN = 'DBI:Pg:dbname=' . $NICK;
86    
 # log output encoding  
 my $ENCODING = 'ISO-8859-2';  
87  my $TIMESTAMP = '%Y-%m-%d %H:%M:%S';  my $TIMESTAMP = '%Y-%m-%d %H:%M:%S';
88    
89  my $sleep_on_error = 5;  my $sleep_on_error = 5;
# Line 66  my $last_x_tags = 50; Line 93  my $last_x_tags = 50;
93    
94  # don't pull rss feeds more often than this  # don't pull rss feeds more often than this
95  my $rss_min_delay = 60;  my $rss_min_delay = 60;
 $rss_min_delay = 15;  
96    
97  my $http_port = $NICK =~ m/-dev/ ? 8001 : 8000;  my $http_port = $NICK =~ m/-dev/ ? 8001 : 8000;
98    
# Line 74  my $url = "http://$HOSTNAME:$http_port"; Line 100  my $url = "http://$HOSTNAME:$http_port";
100    
101  ## END CONFIG  ## END CONFIG
102    
 use POE qw(Component::IRC Wheel::FollowTail Component::Server::HTTP);  
 use HTTP::Status;  
 use DBI;  
 use Encode qw/from_to is_utf8/;  
 use Regexp::Common qw /URI/;  
 use CGI::Simple;  
 use HTML::TagCloud;  
 use POSIX qw/strftime/;  
 use HTML::CalendarMonthSimple;  
 use Getopt::Long;  
 use DateTime;  
 use URI::Escape;  
 use Data::Dump qw/dump/;  
 use DateTime::Format::ISO8601;  
 use Carp qw/confess/;  
 use XML::Feed;  
 use DateTime::Format::Flexible;  
   
103  my $use_twitter = 1;  my $use_twitter = 1;
104  eval { require Net::Twitter; };  eval { require Net::Twitter; };
105  $use_twitter = 0 if ($@);  $use_twitter = 0 if ($@);
# Line 100  my $import_dircproxy; Line 108  my $import_dircproxy;
108  my $log_path;  my $log_path;
109  GetOptions(  GetOptions(
110          'import-dircproxy:s' => \$import_dircproxy,          'import-dircproxy:s' => \$import_dircproxy,
         'follows:s' => \$follows_path,  
111          'log:s' => \$log_path,          'log:s' => \$log_path,
112            'debug!' => \$debug,
113  );  );
114    
115  $SIG{__DIE__} = sub {  #$SIG{__DIE__} = sub {
116          confess "fatal error";  #       confess "fatal error";
117  };  #};
   
 open(STDOUT, '>', $log_path) || warn "can't redirect log to $log_path: $!";  
118    
119  sub _log {  sub _log {
120          my $out = strftime($TIMESTAMP,localtime()) . ' ' . join(" ",@_) . $/;          print strftime($TIMESTAMP,localtime()) . ' ' . join(" ",map { ref($_) ? dump( $_ ) : $_ } @_) . $/;
         from_to( $out, 'UTF-8', $ENCODING );  
         print $out;  
121  }  }
122    
123  # LOG following  open(STDOUT, '>', $log_path) && warn "log to $log_path: $!\n";
   
 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;  
 }  
124    
 add_follow_path( $follows_path ) if ( -e $follows_path );  
125    
126  # HTML formatters  # HTML formatters
127    
# Line 151  my $filter = { Line 140  my $filter = {
140                  # protect HTML from wiki modifications                  # protect HTML from wiki modifications
141                  sub e {                  sub e {
142                          my $t = shift;                          my $t = shift;
143                          return 'uri_unescape{' . uri_escape($t) . '}';                          return 'uri_unescape{' . uri_escape($t, '^a-zA-Z0-9') . '}';
144                  }                  }
145    
146                  $m =~ s/($escape_re)/$escape{$1}/gs;                  $m =~ s/($escape_re)/$escape{$1}/gs;
147                  $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;
148                  $m =~ s#\/(\w+)\/#<i>$1</i>#gs;                  $m =~ s#\/(\w+)\/#<i>$1</i>#gs;
149                  $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;
150                  $m =~ s#\*(\w+)\*#<b>$1</b>#gs;                  $m =~ s#\*(\w+)\*#<b>$1</b>#gs;
# Line 176  my $filter = { Line 165  my $filter = {
165          },          },
166  };  };
167    
168    # POE IRC
169    my $poe_irc = POE::Component::IRC->spawn( %$irc_config ) or
170            die "can't start ", dump( $irc_config ), ": $!";
171    
172    my $irc = $poe_irc->session_id();
173    _log "IRC session_id $irc";
174    
175  my $dbh = DBI->connect($DSN,"","", { RaiseError => 1, AutoCommit => 1 }) || die $DBI::errstr;  my $dbh = DBI->connect($DSN,"","", { RaiseError => 1, AutoCommit => 1 }) || die $DBI::errstr;
176  $dbh->do( qq{ set client_encoding = 'UTF-8' } );  $dbh->do( qq{ set client_encoding = 'UTF-8' } );
177    
# Line 212  create table feeds ( Line 208  create table feeds (
208          name text,          name text,
209          delay interval not null default '5 min',          delay interval not null default '5 min',
210          active boolean default true,          active boolean default true,
211            channel text not null,
212            nick text not null,
213            private boolean default false,
214          last_update timestamp default 'now()',          last_update timestamp default 'now()',
215          polls int default 0,          polls int default 0,
216          updates int default 0          updates int default 0
217  );  );
218  create unique index feeds_url on feeds(url);  create unique index feeds_url on feeds(url);
219  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');
220          },          },
221  };  };
222    
# Line 261  sub meta { Line 260  sub meta {
260                  if ( $@ || ! $sth->rows ) {                  if ( $@ || ! $sth->rows ) {
261                          $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()) });
262                          $sth->execute( $value, $nick, $channel, $name );                          $sth->execute( $value, $nick, $channel, $name );
263                          _log "created $nick/$channel/$name = $value";                          warn "## created $nick/$channel/$name = $value\n";
264                  } else {                  } else {
265                          _log "updated $nick/$channel/$name = $value ";                          warn "## updated $nick/$channel/$name = $value\n";
266                  }                  }
267    
268                  return $value;                  return $value;
# Line 273  sub meta { Line 272  sub meta {
272                  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 = ? });
273                  $sth->execute( $nick, $channel, $name );                  $sth->execute( $nick, $channel, $name );
274                  my ($v,$c) = $sth->fetchrow_array;                  my ($v,$c) = $sth->fetchrow_array;
275                  _log "fetched $nick/$channel/$name = $v [$c]";                  warn "## fetched $nick/$channel/$name = $v [$c]\n";
276                  return ($v,$c) if wantarray;                  return ($v,$c) if wantarray;
277                  return $v;                  return $v;
278    
# 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 370  sub get_from_log { Line 369  sub get_from_log {
369    
370          my @where;          my @where;
371          my @args;          my @args;
372            my $msg;
373    
374          if (my $search = $args->{search}) {          if (my $search = $args->{search}) {
375                  $search =~ s/^\s+//;                  $search =~ s/^\s+//;
376                  $search =~ s/\s+$//;                  $search =~ s/\s+$//;
377                  push @where, 'message ilike ? or nick ilike ?';                  push @where, 'message ilike ? or nick ilike ?';
378                  push @args, ( ( '%' . $search . '%' ) x 2 );                  push @args, ( ( '%' . $search . '%' ) x 2 );
379                  _log "search for '$search'";                  $msg = "Search for '$search'";
380          }          }
381    
382          if ($args->{tag} && $tags->{ $args->{tag} }) {          if ($args->{tag} && $tags->{ $args->{tag} }) {
383                  push @where, 'id in (' . join(',', @{ $tags->{ $args->{tag} } }) . ')';                  push @where, 'id in (' . join(',', @{ $tags->{ $args->{tag} } }) . ')';
384                  _log "search for tags $args->{tag}";                  $msg = "Search for tags $args->{tag}";
385          }          }
386    
387          if (my $date = $args->{date} ) {          if (my $date = $args->{date} ) {
388                  $date = check_date( $date );                  $date = check_date( $date );
389                  push @where, 'date(time) = ?';                  push @where, 'date(time) = ?';
390                  push @args, $date;                  push @args, $date;
391                  _log "search for date $date";                  $msg = "search for date $date";
392          }          }
393    
394          $sql .= " where " . join(" and ", @where) if @where;          $sql .= " where " . join(" and ", @where) if @where;
# Line 402  sub get_from_log { Line 402  sub get_from_log {
402          eval { $sth->execute( @args ) };          eval { $sth->execute( @args ) };
403          return if $@;          return if $@;
404    
405            my $nr_results = $sth->rows;
406    
407          my $last_row = {          my $last_row = {
408                  date => '',                  date => '',
409                  time => '',                  time => '',
# Line 422  sub get_from_log { Line 424  sub get_from_log {
424    
425          return @rows if ($args->{full_rows});          return @rows if ($args->{full_rows});
426    
427          my @msgs = (          $msg .= ' produced ' . (
428                  "Showing " . ($#rows + 1) . " messages..."                  $nr_results == 0 ? 'no results' :
429                    $nr_results == 0 ? 'one result' :
430                            $nr_results . ' results'
431          );          );
432    
433            my @msgs = ( $msg );
434    
435          if ($context) {          if ($context) {
436                  my @ids = @rows;                  my @ids = @rows;
437                  @rows = ();                  @rows = ();
# Line 482  sub get_from_log { Line 488  sub get_from_log {
488  #                       $row->{nick} = $nick;  #                       $row->{nick} = $nick;
489  #               }  #               }
490    
491                    $append = 0 if $row->{me};
492    
493                  if ($last_row->{nick} ne $nick) {                  if ($last_row->{nick} ne $nick) {
494                          # obfu way to find format for me_nick if needed or fallback to default                          # obfu way to find format for me_nick if needed or fallback to default
495                          my $fmt = $row->{me} ? ( $args->{fmt}->{me_nick} || $args->{fmt}->{nick} ) : $args->{fmt}->{nick};                          my $fmt = $row->{me} ? ( $args->{fmt}->{me_nick} || $args->{fmt}->{nick} ) : $args->{fmt}->{nick};
# Line 534  sub add_tag { Line 542  sub add_tag {
542          return unless ($arg->{id} && $arg->{message});          return unless ($arg->{id} && $arg->{message});
543    
544          my $m = $arg->{message};          my $m = $arg->{message};
         from_to('UTF-8', 'iso-8859-2', $m) if (is_utf8($m));  
545    
546          my @tags;          my @tags;
547    
# Line 598  sub save_message { Line 605  sub save_message {
605          $a->{me} ||= 0;          $a->{me} ||= 0;
606          $a->{time} ||= strftime($TIMESTAMP,localtime());          $a->{time} ||= strftime($TIMESTAMP,localtime());
607    
608          _log          _log "ARCHIVE",
609                  $a->{channel}, " ",                  $a->{channel}, " ",
610                  $a->{me} ? "***" . $a->{nick} : "<" . $a->{nick} . ">",                  $a->{me} ? "***" . $a->{nick} : "<" . $a->{nick} . ">",
611                  " " . $a->{message};                  " " . $a->{message};
612    
613          $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});
614          add_tag( id => $dbh->last_insert_id(undef,undef,"log",undef), %$a );          add_tag( id => $dbh->last_insert_id(undef,undef,"log",undef), %$a );
615  }  }
616    
# Line 646  if ($import_dircproxy) { Line 653  if ($import_dircproxy) {
653  # RSS follow  # RSS follow
654  #  #
655    
656  my $_rss;  my $_stat;
657    
658    POE::Component::Client::HTTP->spawn(
659            Alias   => 'rss-fetch',
660            Timeout => 30,
661    );
662    
663    =head2 rss_parse_xml
664    
665      rss_parse_xml({
666            url => 'http://www.example.com/rss',
667            send_rss_msgs => 42,
668      });
669    
670  sub rss_fetch {  =cut
671          my ($args) = @_;  
672    sub rss_parse_xml {
673            my ($kernel,$args) = @_;
674    
675            warn "## rss_parse_xml ",dump( @_ ) if $debug;
676    
677          # 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?
678          my $send_rss_msgs = 1;          my $send_rss_msgs = $args->{send_rss_msgs};
679            $send_rss_msgs = 1 if ! defined $send_rss_msgs;
680    
681            warn "## RSS fetch first $send_rss_msgs items from", $args->{url} if $debug;
682    
683          my $feed = XML::Feed->parse(URI->new( $args->{url} ));          my $feed = XML::Feed->parse( \$args->{xml} );
684          if ( ! $feed ) {          if ( ! $feed ) {
685                  _log("can't fetch RSS ", $args->{url});                  _log "can't fetch RSS ", $args->{url}, XML::Feed->errstr;
686                  return;                  return;
687          }          }
688          my $updates = 0;  
689            $_stat->{rss}->{url2link}->{ $args->{url} } = $feed->link;
690    
691            my ( $total, $updates ) = ( 0, 0 );
692          for my $entry ($feed->entries) {          for my $entry ($feed->entries) {
693                    $total++;
694    
695                    my $seen_times = $_stat->{rss}->{seen}->{$args->{channel}}->{$feed->link}->{$entry->id}++;
696                  # seen allready?                  # seen allready?
697                  return if $_rss->{$feed->link}->{seen}->{$entry->id}++ > 0;                  warn "## $seen_times ",$entry->id if $debug;
698                    next if $seen_times > 0;
699    
700                  sub prefix {                  sub prefix {
701                          my ($txt,$var) = @_;                          my ($txt,$var) = @_;
702                            $var =~ s/\s+/ /gs;
703                          $var =~ s/^\s+//g;                          $var =~ s/^\s+//g;
704                            $var =~ s/\s+$//g;
705                          return $txt . $var if $var;                          return $txt . $var if $var;
706                  }                  }
707    
708                    # fix absolute and relative links to feed entries
709                    my $link = $entry->link;
710                    if ( $link =~ m!^/! ) {
711                            my $host = $args->{url};
712                            $host =~ s!^(http://[^/]+).*$!$1!;      #!vim
713                            $link = "$host/$link";
714                    } elsif ( $link !~ m!^http! ) {
715                            $link = $args->{url} . $link;
716                    }
717    
718                  my $msg;                  my $msg;
719                  $msg .= prefix( 'From: ' , $feed->title );                  $msg .= prefix( 'From: ' , $args->{name} || $feed->title );
720                  $msg .= prefix( ' by ' , $entry->author );                  $msg .= prefix( ' by ' , $entry->author );
721                  $msg .= prefix( ' -- ' , $entry->link );                  $msg .= prefix( ' | ' , $entry->title );
722                    $msg .= prefix( ' | ' , $link );
723  #               $msg .= prefix( ' id ' , $entry->id );  #               $msg .= prefix( ' id ' , $entry->id );
724                    if ( my $tags = $entry->category ) {
725                            $tags =~ s!^\s+!!;
726                            $tags =~ s!\s*$! !;
727                            $tags =~ s!,?\s+!// !g;
728                            $msg .= prefix( ' ' , $tags );
729                    }
730    
731                  if ( $args->{kernel} && $send_rss_msgs ) {                  if ( $seen_times == 0 && $send_rss_msgs ) {
                         warn "# sending to $CHANNEL\n";  
732                          $send_rss_msgs--;                          $send_rss_msgs--;
733                          $args->{kernel}->post( $IRC_ALIAS => notice => $CHANNEL, $msg );                          if ( ! $args->{private} ) {
734                                    # FIXME bug! should be save_message
735                                    save_message( channel => $args->{channel}, me => 1, nick => $NICK, message => $msg );
736    #                               $sth_insert_log->execute( $args->{channel}, 1, $NICK, $msg, 'now()' );
737                            }
738                            my ( $type, $to ) = ( 'notice', $args->{channel} );
739                            ( $type, $to ) = ( 'privmsg', $args->{nick} ) if $args->{private};
740    
741                            _log(">> RSS $type to $to:", $msg);
742                            $kernel->post( $irc => $type => $to => $msg );
743    
744                          $updates++;                          $updates++;
                         save_message( channel => $CHANNEL, me => 1, nick => $NICK, message => $msg );  
                         _log('RSS', $msg);  
745                  }                  }
746          }          }
747    
# Line 693  sub rss_fetch { Line 750  sub rss_fetch {
750          $sql .= qq{where id = } . $args->{id};          $sql .= qq{where id = } . $args->{id};
751          eval { $dbh->do( $sql ) };          eval { $dbh->do( $sql ) };
752    
753            _log "RSS $updates/$total new items from", $args->{url};
754    
755          return $updates;          return $updates;
756  }  }
757    
758  sub rss_fetch_all {  sub rss_fetch_all {
759          my $kernel = shift;          my ( $kernel, $send_rss_msgs )  = @_;
760            warn "## rss_fetch_all -- send_rss_msgs: $send_rss_msgs\n" if $debug;
761          my $sql = qq{          my $sql = qq{
762                  select id, url, name                  select id, url, name, channel, nick, private
763                  from feeds                  from feeds
764                  where active is true                  where active is true
765          };          };
766          # limit to newer feeds only if we are not sending messages out          # limit to newer feeds only if we are not sending messages out
767          $sql .= qq{     and last_update + delay < now() } if $kernel;          $sql .= qq{     and last_update + delay < now() } if defined ( $_stat->{rss}->{fetch} );
768          my $sth = $dbh->prepare( $sql );          my $sth = $dbh->prepare( $sql );
769          $sth->execute();          $sth->execute();
770          warn "# ",$sth->rows," active RSS feeds\n";          warn "# ",$sth->rows," active RSS feeds\n";
771          my $count = 0;          my $count = 0;
772          while (my $row = $sth->fetchrow_hashref) {          while (my $row = $sth->fetchrow_hashref) {
773                  warn "+++ fetch RSS feed: ",dump( $row );                  $row->{send_rss_msgs} = $send_rss_msgs if defined $send_rss_msgs;
774                  $row->{kernel} = $kernel if $kernel;                  $_stat->{rss}->{fetch}->{ $row->{url} } = $row;
775                  $count += rss_fetch( $row );                  $kernel->post(
776                            'rss-fetch',
777                            'request',
778                            'rss_response',
779                            HTTP::Request->new( GET => $row->{url} ),
780                    );
781                    warn "## queued rss-fetch ", dump( $row ) if $debug;
782          }          }
783          return "OK, fetched $count posts from " . $sth->rows . " feeds";          return "OK, scheduled " . $sth->rows . " feeds for refresh";
784  }  }
785    
 my $rss_last_poll = time();  
786    
787  sub rss_check_updates {  sub rss_check_updates {
788          my $kernel = shift;          my $kernel = shift;
789          my $t = time();          $_stat->{rss}->{last_poll} ||= time();
790          if ( $rss_last_poll - $t > $rss_min_delay ) {          my $dt = time() - $_stat->{rss}->{last_poll};
791                  $rss_last_poll = $t;          if ( $dt > $rss_min_delay ) {
792                    warn "## rss_check_updates $dt > $rss_min_delay\n";
793                    $_stat->{rss}->{last_poll} = time();
794                  _log rss_fetch_all( $kernel );                  _log rss_fetch_all( $kernel );
795          }          }
796  }  }
797    
 # seed rss seen cache so we won't send out all items on startup  
 _log rss_fetch_all;  
   
 #  
 # POE handing part  
 #  
   
 my $SKIPPING = 0;               # if skipping, how many we've done  
 my $SEND_QUEUE;                 # cache  
 my $ping;                                               # ping stats  
   
 POE::Component::IRC->new($IRC_ALIAS);  
   
798  POE::Session->create( inline_states => {  POE::Session->create( inline_states => {
799          _start => sub {                _start => sub {      
800                  $_[KERNEL]->post($IRC_ALIAS => register => 'all');                  $_[KERNEL]->post( $irc => register => 'all' );
801                  $_[KERNEL]->post($IRC_ALIAS => connect => $CONNECT);                  $_[KERNEL]->post( $irc => connect => {} );
     },  
     irc_255 => sub {    # server is done blabbing  
                 $_[KERNEL]->post($IRC_ALIAS => join => $CHANNEL);  
                 $_[KERNEL]->post($IRC_ALIAS => join => '#logger');  
                 $_[KERNEL]->yield("heartbeat"); # start heartbeat  
                 $_[KERNEL]->yield("my_add", $_) for keys %FOLLOWS;  
                 $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "IDENTIFY $NICK" );  
802      },      },
803            irc_001 => sub {
804                    my ($kernel,$sender) = @_[KERNEL,SENDER];
805                    my $poco_object = $sender->get_heap();
806                    _log "connected to",$poco_object->server_name();
807                    $kernel->post( $sender => join => $_ ) for @channels;
808                    # seen RSS cache, so don't send out messages
809                    _log rss_fetch_all( $kernel, 0 );
810                    undef;
811            },
812    #       irc_255 => sub {        # server is done blabbing
813    #               $_[KERNEL]->post( $irc => join => $CHANNEL);
814    #       },
815      irc_public => sub {      irc_public => sub {
816                  my $kernel = $_[KERNEL];                  my $kernel = $_[KERNEL];
817                  my $nick = (split /!/, $_[ARG0])[0];                  my $nick = (split /!/, $_[ARG0])[0];
# Line 761  POE::Session->create( inline_states => { Line 820  POE::Session->create( inline_states => {
820    
821                  save_message( channel => $channel, me => 0, nick => $nick, message => $msg);                  save_message( channel => $channel, me => 0, nick => $nick, message => $msg);
822                  meta( $nick, $channel, 'last-msg', $msg );                  meta( $nick, $channel, 'last-msg', $msg );
823                    rss_check_updates( $kernel );
824      },      },
825      irc_ctcp_action => sub {      irc_ctcp_action => sub {
826                  my $kernel = $_[KERNEL];                  my $kernel = $_[KERNEL];
# Line 782  POE::Session->create( inline_states => { Line 842  POE::Session->create( inline_states => {
842      },      },
843          irc_ping => sub {          irc_ping => sub {
844                  _log( "pong ", $_[ARG0] );                  _log( "pong ", $_[ARG0] );
845                  $ping->{ $_[ARG0] }++;                  $_stat->{ping}->{ $_[ARG0] }++;
846                  rss_check_updates( $_[KERNEL] );                  rss_check_updates( $_[KERNEL] );
847          },          },
848          irc_invite => sub {          irc_invite => sub {
# Line 792  POE::Session->create( inline_states => { Line 852  POE::Session->create( inline_states => {
852    
853                  _log "invited to $channel by $nick";                  _log "invited to $channel by $nick";
854    
855                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, "how nice of you to invite me to $channel, I'll be right there..." );                  $_[KERNEL]->post( $irc => privmsg => $nick, "how nice of you to invite me to $channel, I'll be right there..." );
856                  $_[KERNEL]->post($IRC_ALIAS => join => $channel);                  $_[KERNEL]->post( $irc => 'join' => $channel );
857    
858          },          },
859          irc_msg => sub {          irc_msg => sub {
# Line 801  POE::Session->create( inline_states => { Line 861  POE::Session->create( inline_states => {
861                  my $nick = (split /!/, $_[ARG0])[0];                  my $nick = (split /!/, $_[ARG0])[0];
862                  my $msg = $_[ARG2];                  my $msg = $_[ARG2];
863                  my $channel = $_[ARG1]->[0];                  my $channel = $_[ARG1]->[0];
864                    warn "# ARG = ",dump( @_[ARG0,ARG1,ARG2] ) if $debug;
865    
866                  my $res = "unknown command '$msg', try /msg $NICK help!";                  my $res = "unknown command '$msg', try /msg $NICK help!";
867                  my @out;                  my @out;
# Line 811  POE::Session->create( inline_states => { Line 872  POE::Session->create( inline_states => {
872    
873                          $res = "usage: /msg $NICK comand | commands: stat - user/message stat | last - show backtrace | grep foobar - find foobar";                          $res = "usage: /msg $NICK comand | commands: stat - user/message stat | last - show backtrace | grep foobar - find foobar";
874    
875                  } elsif ($msg =~ m/^msg\s+(\S+)\s+(.*)$/i) {                  } elsif ($msg =~ m/^(privmsg|notice)\s+(\S+)\s+(.*)$/i) {
876    
877                          _log ">> /msg $1 $2";                          _log ">> /$1 $2 $3";
878                          $_[KERNEL]->post( $IRC_ALIAS => privmsg => $1, $2 );                          $_[KERNEL]->post( $irc => $1 => $2, $3 );
879                          $res = '';                          $res = '';
880    
881                  } elsif ($msg =~ m/^stat.*?\s*(\d*)/i) {                  } elsif ($msg =~ m/^stat.*?\s*(\d*)/i) {
# Line 844  POE::Session->create( inline_states => { Line 905  POE::Session->create( inline_states => {
905    
906                          foreach my $res (get_from_log( limit => $limit )) {                          foreach my $res (get_from_log( limit => $limit )) {
907                                  _log "last: $res";                                  _log "last: $res";
908                                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );                                  $_[KERNEL]->post( $irc => privmsg => $nick, $res );
909                          }                          }
910    
911                          $res = '';                          $res = '';
# Line 858  POE::Session->create( inline_states => { Line 919  POE::Session->create( inline_states => {
919                                          search => $what,                                          search => $what,
920                                  )) {                                  )) {
921                                  _log "search [$what]: $res";                                  _log "search [$what]: $res";
922                                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );                                  $_[KERNEL]->post( $irc => privmsg => $nick, $res );
923                          }                          }
924    
925                          $res = '';                          $res = '';
# Line 893  POE::Session->create( inline_states => { Line 954  POE::Session->create( inline_states => {
954                                  " : " . ( $stat->{vote}->{'-'} || 0 ) . " --" .                                  " : " . ( $stat->{vote}->{'-'} || 0 ) . " --" .
955                                  " from " . ( join(", ", @nicks) || 'nobody' );                                  " from " . ( join(", ", @nicks) || 'nobody' );
956    
957                          $_[KERNEL]->post( $IRC_ALIAS => notice => $nick, $res );                          $_[KERNEL]->post( $irc => notice => $nick, $res );
958    
959                  } elsif ($msg =~ m/^ping/) {                  } elsif ($msg =~ m/^ping/) {
960                          $res = "ping = " . dump( $ping );                          $res = "ping = " . dump( $_stat->{ping} );
961                  } elsif ($msg =~ m/^conf(?:ig)*\s*(last-size|twitter)*\s*(.*)/) {                  } elsif ($msg =~ m/^conf(?:ig)*\s*(last-size|twitter)*\s*(.*)/) {
962                          if ( ! defined( $1 ) ) {                          if ( ! defined( $1 ) ) {
963                                  my $sth = $dbh->prepare(qq{ select name,value,changed from meta where nick = ? and channel = ? });                                  my $sth = $dbh->prepare(qq{ select name,value,changed from meta where nick = ? and channel = ? });
# Line 929  POE::Session->create( inline_states => { Line 990  POE::Session->create( inline_states => {
990                          }                          }
991                  } elsif ($msg =~ m/^rss-update/) {                  } elsif ($msg =~ m/^rss-update/) {
992                          $res = rss_fetch_all( $_[KERNEL] );                          $res = rss_fetch_all( $_[KERNEL] );
993                  } elsif ($msg =~ m/^rss-clean/) {                  } elsif ($msg =~ m/^rss-list/) {
994                          $_rss = undef;                          my $sth = $dbh->prepare(qq{ select url,name,last_update,active,channel,nick,private from feeds });
995                          $res = "OK, cleaned RSS cache";                          $sth->execute;
996                  } elsif ($msg =~ m!^rss-(add|remove|stop|start)\s+(http://\S+)\s*(.*)!) {                          while (my @row = $sth->fetchrow_array) {
997                                    $_[KERNEL]->post( $irc => privmsg => $nick, join(' | ',@row) );
998                            }
999                            $res = '';
1000                    } elsif ($msg =~ m!^rss-(add|remove|stop|start|clean)(?:-(private))?\s+(http://\S+)\s*(.*)!) {
1001                            my ( $command, $sub, $url, $arg ) = ( $1,$2,$3,$4 );
1002    
1003                            my $channel = $1 if ( $arg =~ s/\s*(#\S+)\s*// );
1004                            $channel = $nick if $sub eq 'private';
1005    
1006                          my $sql = {                          my $sql = {
1007                                  add             => qq{ insert into feeds (url,name) values (?,?) },                                  add     => qq{ insert into feeds (url,name,channel,nick,private) values (?,?,?,?,?) },
1008  #                               remove  => qq{ delete from feeds                                where url = ? and name = ? },                                  remove  => qq{ delete from feeds                                where url = ? and nick = ? },
1009                                  start   => qq{ update feeds set active = true   where url = ? -- ? },                                  start   => qq{ update feeds set active = true   where url = ? },
1010                                  stop    => qq{ update feeds set active = false  where url = ? -- ? },                                  stop    => qq{ update feeds set active = false  where url = ? },
1011                                                                    clean   => qq{ update feeds set last_update = now() - delay where url = ? },
1012                          };                          };
1013                          if (my $q = $sql->{$1} ) {  
1014                            if ( $command eq 'add' && ! $channel ) {
1015                                    $res = "ERROR: got '$msg' which doesn't have #channel in it, ignoring!";
1016                            } elsif (my $q = $sql->{$command} ) {
1017                                  my $sth = $dbh->prepare( $q );                                  my $sth = $dbh->prepare( $q );
1018                                  warn "## SQL $q ( $2 | $3 )\n";                                  my @data = ( $url );
1019                                  eval { $sth->execute( $2, $3 ) };                                  if ( $command eq 'add' ) {
1020                                            push @data, ( $arg, $channel, $nick, $sub eq 'private' ? 1 : 0 );
1021                                    } elsif ( $command eq 'remove' ) {
1022                                            push @data, $nick;
1023                                    }
1024                                    warn "## $command SQL $q with ",dump( @data ),"\n";
1025                                    eval { $sth->execute( @data ) };
1026                                    if ($@) {
1027                                            $res = "ERROR: $@";
1028                                    } else {
1029                                            $res = "OK, RSS executed $command" .
1030                                                    ( $sub ? "-$sub " : ' ' ) .
1031                                                    ( $channel ? "on $channel " : '' ) .
1032                                                    "url $url";
1033                                            if ( $command eq 'clean' ) {
1034                                                    my $seen = $_stat->{rss}->{seen} || die "no seen?";
1035                                                    my $want_link = $_stat->{rss}->{url2link}->{$url} || warn "no url2link($url)";
1036                                                    foreach my $c ( keys %$seen ) {
1037                                                            my $c_hash = $seen->{$c} || die "no seen->{$c}";
1038                                                            die "not HASH with rss links but ", dump($c_hash) unless ref($c_hash) eq 'HASH';
1039                                                            foreach my $link ( keys %$c_hash ) {
1040                                                                    next unless $link eq $want_link;
1041                                                                    _log "RSS removed seen $c $url $link";
1042                                                            }
1043                                                    }
1044                                            } elsif ( $command eq 'add' ) {
1045                                                    rss_fetch_all( $_[KERNEL] );
1046                                            }
1047                                    }
1048                            } else {
1049                                    $res = "ERROR: don't know what to do with: $msg";
1050                          }                          }
1051                    } elsif ($msg =~ m/^rss-clean/) {
1052                          $res ||= "OK, RSS $1 : $2 - $3";                          # this makes sense because we didn't catch rss-clean http://... before!
1053                            $_stat->{rss} = undef;
1054                            $dbh->do( qq{ update feeds set last_update = now() - delay } );
1055                            $res = rss_fetch_all( $_[KERNEL] );
1056                  }                  }
1057    
1058                  if ($res) {                  if ($res) {
1059                          _log ">> [$nick] $res";                          _log ">> [$nick] $res";
1060                          $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );                          $_[KERNEL]->post( $irc => privmsg => $nick, $res );
1061                  }                  }
1062    
1063                  rss_check_updates( $_[KERNEL] );                  rss_check_updates( $_[KERNEL] );
1064          },          },
1065            irc_372 => sub {
1066                    _log "<< motd",$_[ARG0],$_[ARG1];
1067            },
1068            irc_375 => sub {
1069                    _log "<< motd", $_[ARG0], "start";
1070            },
1071            irc_376 => sub {
1072                    _log "<< motd", $_[ARG0], "end";
1073            },
1074    #       irc_433 => sub {
1075    #               print "# irc_433: ",$_[ARG1], "\n";
1076    #               warn "## indetify $NICK\n";
1077    #               $_[KERNEL]->post( $irc => privmsg => 'nickserv', "IDENTIFY $NICK" );
1078    #       },
1079    #       irc_451 # please register
1080          irc_477 => sub {          irc_477 => sub {
1081                  _log "# irc_477: ",$_[ARG1];                  _log "<< irc_477: ",$_[ARG1];
1082                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "register $NICK" );                  _log ">> IDENTIFY $NICK";
1083                    $_[KERNEL]->post( $irc => privmsg => 'NickServ', "IDENTIFY $NICK" );
1084          },          },
1085          irc_505 => sub {          irc_505 => sub {
1086                  _log "# irc_505: ",$_[ARG1];                  _log "<< irc_505: ",$_[ARG1];
1087                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "register $NICK" );                  _log ">> register $NICK";
1088  #               $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "set hide email on" );                  $_[KERNEL]->post( $irc => privmsg => 'NickServ', "register $NICK" );
1089  #               $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "set email dpavlin\@rot13.org" );  #               $_[KERNEL]->post( $irc => privmsg => 'nickserv', "IDENTIFY $NICK" );
1090    #               $_[KERNEL]->post( $irc => privmsg => 'nickserv', "set hide email on" );
1091    #               $_[KERNEL]->post( $irc => privmsg => 'nickserv', "set email dpavlin\@rot13.org" );
1092          },          },
1093          irc_registered => sub {          irc_registered => sub {
1094                  _log "## registrated $NICK";                  _log "<< registered $NICK";
                 $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "IDENTIFY $NICK" );  
1095          },          },
1096          irc_disconnected => sub {          irc_disconnected => sub {
1097                  _log "## disconnected, reconnecting again";                  _log "## disconnected.. sleeping for $sleep_on_error seconds and reconnecting again";
1098                  $_[KERNEL]->post($IRC_ALIAS => connect => $CONNECT);                  sleep($sleep_on_error);
1099                    $_[KERNEL]->post( $irc => connect => {} );
1100          },          },
1101          irc_socketerr => sub {          irc_socketerr => sub {
1102                  _log "## socket error... sleeping for $sleep_on_error seconds and retry";                  _log "## socket error... sleeping for $sleep_on_error seconds and retry";
1103                  sleep($sleep_on_error);                  sleep($sleep_on_error);
1104                  $_[KERNEL]->post($IRC_ALIAS => connect => $CONNECT);                  $_[KERNEL]->post( $irc => connect => {} );
1105            },
1106            irc_notice => sub {
1107                    _log "<< notice from ", $_[ARG0], $_[ARG1], $_[ARG2];
1108                    my $m = $_[ARG2];
1109                    if ( $m =~ m!/msg.*(NickServ).*(IDENTIFY)!i ) {
1110                            _log ">> suggested to $1 $2";
1111                            $_[KERNEL]->post( $irc => privmsg => $1, "$2 $NICK" );
1112                    } elsif ( $m =~ m!\Q$NICK\E.*registered!i ) {
1113                            _log ">> registreted, so IDENTIFY";
1114                            $_[KERNEL]->post( $irc => privmsg => 'nickserv', "IDENTIFY $NICK" );
1115                    } else {
1116                            warn "## ignore $m\n" if $debug;
1117                    }
1118            },
1119            irc_snotice => sub {
1120                    _log "<< snotice", $_[ARG0]; #dump( $_[ARG0],$_[ARG1], $_[ARG2] );
1121                    if ( $_[ARG0] =~ m!/(QUOTE)\s+(PASS\s+\d+)!i ) {
1122                            warn ">> $1 | $2\n";
1123                            $_[KERNEL]->post( $irc => lc($1) => $2);
1124                    }
1125          },          },
 #       irc_433 => sub {  
 #               print "# irc_433: ",$_[ARG1], "\n";  
 #               warn "## indetify $NICK\n";  
 #               $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "IDENTIFY $NICK" );  
 #       },  
1126      _child => sub {},      _child => sub {},
1127      _default => sub {      _default => sub {
1128                  _log sprintf "sID:%s %s %s",                  _log sprintf "sID:%s %s %s",
# Line 993  POE::Session->create( inline_states => { Line 1132  POE::Session->create( inline_states => {
1132                          "";                          "";
1133        0;                        # false for signals        0;                        # false for signals
1134      },      },
1135      my_add => sub {          rss_response => sub {
1136        my $trailing = $_[ARG0];                  my ($request_packet, $response_packet) = @_[ARG0, ARG1];
1137        my $session = $_[SESSION];                  my $request_object  = $request_packet->[0];
1138        POE::Session->create                  my $response_object = $response_packet->[0];
1139            (inline_states =>  
1140             {_start => sub {                  my $row = delete( $_stat->{rss}->{fetch}->{ $request_object->uri } );
1141                $_[HEAP]->{wheel} =                  if ( $row ) {
1142                  POE::Wheel::FollowTail->new                          $row->{xml} = $response_object->content;
1143                      (                          rss_parse_xml( $_[KERNEL], $row );
1144                       Filename => $FOLLOWS{$trailing},                  } else {
1145                       InputEvent => 'got_line',                          warn "## can't find rss->fetch for ", $request_object->uri;
1146                      );                  }
1147                                  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);  
     }  
1148     },     },
1149    );    );
1150    
1151  # http server  # http server
1152    
1153    _log "WEB archive at $url";
1154    
1155  my $httpd = POE::Component::Server::HTTP->new(  my $httpd = POE::Component::Server::HTTP->new(
1156          Port => $http_port,          Port => $http_port,
1157          PreHandler => {          PreHandler => {
# Line 1105  foreach my $c (@cols) { Line 1198  foreach my $c (@cols) {
1198          $style .= ".col-${max_color} { background: $c }\n";          $style .= ".col-${max_color} { background: $c }\n";
1199          $max_color++;          $max_color++;
1200  }  }
1201  warn "defined $max_color colors for users...\n";  _log "WEB defined $max_color colors for users...";
1202    
1203  sub root_handler {  sub root_handler {
1204          my ($request, $response) = @_;          my ($request, $response) = @_;
# Line 1127  sub root_handler { Line 1220  sub root_handler {
1220          }          }
1221    
1222          my $search = $q->param('search') || $q->param('grep') || '';          my $search = $q->param('search') || $q->param('grep') || '';
1223            my $r_url = $request->url;
1224    
1225            my @commands = qw( tags last-tag follow stat );
1226            my $commands_re = join('|',@commands);
1227    
1228          if ($request->url =~ m#/rss(?:/(tags|last-tag|follow.*)\w*(?:=(\d+))?)?#i) {          if ($r_url =~ m#/rss(?:/($commands_re.*)\w*(?:=(\d+))?)?#i) {
1229                  my $show = lc($1);                  my $show = lc($1);
1230                  my $nr = $2;                  my $nr = $2;
1231    
# Line 1142  sub root_handler { Line 1239  sub root_handler {
1239                  my $feed = XML::Feed->new( $type );                  my $feed = XML::Feed->new( $type );
1240                  $feed->link( $url );                  $feed->link( $url );
1241    
1242                    my $rc = RC_OK;
1243    
1244                  if ( $show eq 'tags' ) {                  if ( $show eq 'tags' ) {
1245                          $nr ||= 50;                          $nr ||= 50;
1246                          $feed->title( "tags from $CHANNEL" );                          $feed->title( "tags from $CHANNEL" );
# Line 1211  sub root_handler { Line 1310  sub root_handler {
1310                                  $feed->add_entry( $feed_entry );                                  $feed->add_entry( $feed_entry );
1311                          }                          }
1312    
1313                    } elsif ( $show =~ m/^stat/ ) {
1314    
1315                            my $feed_entry = XML::Feed::Entry->new($type);
1316                            $feed_entry->title( "Internal stats" );
1317                            $feed_entry->content(
1318                                    '<![CDATA[<pre>' . dump( $_stat ) . '</pre>]]>'
1319                            );
1320                            $feed->add_entry( $feed_entry );
1321    
1322                  } else {                  } else {
1323                          _log "unknown rss request ",$request->url;                          _log "WEB unknown rss request $r_url";
1324                          return RC_DENY;                          $feed->title( "unknown $r_url" );
1325                            foreach my $c ( @commands ) {
1326                                    my $feed_entry = XML::Feed::Entry->new($type);
1327                                    $feed_entry->title( "rss/$c" );
1328                                    $feed_entry->link( "$url/rss/$c" );
1329                                    $feed->add_entry( $feed_entry );
1330                            }
1331                            $rc = RC_DENY;
1332                  }                  }
1333    
1334                  $response->content( $feed->as_xml );                  $response->content( $feed->as_xml );
1335                  return RC_OK;                  return $rc;
1336          }          }
1337    
1338          if ( $@ ) {          if ( $@ ) {
# Line 1275  sub root_handler { Line 1390  sub root_handler {
1390                          }                          }
1391                          $cal->setcontent($dd, qq[                          $cal->setcontent($dd, qq[
1392                                  <a href="$url?date=$row->{date}">$row->{nr}</a><br/>$row->{len}                                  <a href="$url?date=$row->{date}">$row->{nr}</a><br/>$row->{len}
1393                          ]);                          ]) if $cal;
1394                                                    
1395                  }                  }
1396                  $html .= qq{<td valign="top">} . $cal->as_HTML() . qq{</td></tr></table>};                  $html .= qq{<td valign="top">} . $cal->as_HTML() . qq{</td></tr></table>};
# Line 1308  sub root_handler { Line 1423  sub root_handler {
1423          <p>See <a href="/history">history</a> of all messages.</p>          <p>See <a href="/history">history</a> of all messages.</p>
1424          </body></html>};          </body></html>};
1425    
1426          $response->content( $html );          $response->content( decode('utf-8',$html) );
1427          warn "<< ", $request->method, " ", $request->uri, " created ", length($html), " bytes\n";          warn "<< ", $request->method, " ", $request->uri, " created ", length($html), " bytes\n";
1428          return RC_OK;          return RC_OK;
1429  }  }
Legend:
Removed from v.86  
changed lines
  Added in v.129
  ViewVC Help
Powered by ViewVC 1.1.26