/[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 74 by dpavlin, Sun Dec 16 20:17:26 2007 UTC revision 118 by dpavlin, Wed Mar 12 18:21:03 2008 UTC
# Line 2  Line 2 
2  use strict;  use strict;
3  $|++;  $|++;
4    
5    use POE qw(Component::IRC Component::Server::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    
22  =head1 NAME  =head1 NAME
23    
24  irc-logger.pl  irc-logger.pl
# Line 20  Import log from C<dircproxy> to C<irc-lo Line 37  Import log from C<dircproxy> to C<irc-lo
37    
38  =item --log=irc-logger.log  =item --log=irc-logger.log
39    
 Name of log file  
   
40  =back  =back
41    
42  =head1 DESCRIPTION  =head1 DESCRIPTION
# Line 32  log all conversation on irc channel Line 47  log all conversation on irc channel
47    
48  ## CONFIG  ## CONFIG
49    
50    my $irc_config = {
51            nick => 'irc-logger',
52            server => 'irc.freenode.net',
53            port => 6667,
54            ircname => 'Anna the bot: try /msg irc-logger help',
55    };
56    
57  my $HOSTNAME = `hostname -f`;  my $HOSTNAME = `hostname -f`;
58  chomp($HOSTNAME);  chomp($HOSTNAME);
59    
60  my $NICK = 'irc-logger';  
 $NICK .= '-dev' if ($HOSTNAME =~ m/llin/);  
 my $CONNECT =  
   {Server => 'irc.freenode.net',  
    Nick => $NICK,  
    Ircname => "try /msg $NICK help",  
   };  
61  my $CHANNEL = '#razmjenavjestina';  my $CHANNEL = '#razmjenavjestina';
 $CHANNEL = '#irc-logger' if ($HOSTNAME =~ m/llin/);  
 my $IRC_ALIAS = "log";  
62    
63  my %FOLLOWS =  if ( $HOSTNAME =~ m/llin/ ) {
64    (          $irc_config->{nick} = 'irc-logger-llin';
65     ACCESS => "/var/log/apache/access.log",  #       $irc_config = {
66     ERROR => "/var/log/apache/error.log",  #               nick => 'irc-logger-llin',
67    );  #               server => 'localhost',
68    #               port => 6668,
69    #       };
70            $CHANNEL = '#irc-logger';
71    } elsif ( $HOSTNAME =~ m/lugarin/ ) {
72            $irc_config->{server} = 'irc.carnet.hr';
73            $CHANNEL = '#riss';
74    }
75    
76    my @channels = ( $CHANNEL );
77    
78    warn "# config = ", dump( $irc_config ), $/;
79    
80    my $NICK = $irc_config->{nick} or die "no nick?";
81    
82  my $DSN = 'DBI:Pg:dbname=' . $NICK;  my $DSN = 'DBI:Pg:dbname=' . $NICK;
83    
 my $ENCODING = 'ISO-8859-2';  
84  my $TIMESTAMP = '%Y-%m-%d %H:%M:%S';  my $TIMESTAMP = '%Y-%m-%d %H:%M:%S';
85    
86  my $sleep_on_error = 5;  my $sleep_on_error = 5;
87    
88    # number of last tags to keep in circular buffer
89    my $last_x_tags = 50;
90    
91    # don't pull rss feeds more often than this
92    my $rss_min_delay = 60;
93    
94  my $http_port = $NICK =~ m/-dev/ ? 8001 : 8000;  my $http_port = $NICK =~ m/-dev/ ? 8001 : 8000;
95    
96  my $url = "http://$HOSTNAME:$http_port";  my $url = "http://$HOSTNAME:$http_port";
97    
98  ## END CONFIG  ## END CONFIG
99    
   
   
 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;  
   
100  my $use_twitter = 1;  my $use_twitter = 1;
101  eval { require Net::Twitter; };  eval { require Net::Twitter; };
102  $use_twitter = 0 if ($@);  $use_twitter = 0 if ($@);
# Line 96  GetOptions( Line 108  GetOptions(
108          'log:s' => \$log_path,          'log:s' => \$log_path,
109  );  );
110    
111  $SIG{__DIE__} = sub {  #$SIG{__DIE__} = sub {
112          confess "fatal error";  #       confess "fatal error";
113  };  #};
   
 open(STDOUT, '>', $log_path) || warn "can't redirect log to $log_path: $!";  
114    
115  sub _log {  sub _log {
116          print strftime($TIMESTAMP,localtime()), ' ', join(" ",@_), $/;          print strftime($TIMESTAMP,localtime()) . ' ' . join(" ",map { ref($_) ? dump( $_ ) : $_ } @_) . $/;
117  }  }
118    
119    open(STDOUT, '>', $log_path) && warn "log to $log_path: $!\n";
120    
121  # HTML formatters  # HTML formatters
122    
123  my %escape = ('<'=>'&lt;', '>'=>'&gt;', '&'=>'&amp;', '"'=>'&quot;');  my %escape = ('<'=>'&lt;', '>'=>'&gt;', '&'=>'&amp;', '"'=>'&quot;');
# Line 123  my $filter = { Line 135  my $filter = {
135                  # protect HTML from wiki modifications                  # protect HTML from wiki modifications
136                  sub e {                  sub e {
137                          my $t = shift;                          my $t = shift;
138                          return 'uri_unescape{' . uri_escape($t) . '}';                          return 'uri_unescape{' . uri_escape($t, '^a-zA-Z0-9') . '}';
139                  }                  }
140    
141                  $m =~ s/($escape_re)/$escape{$1}/gs;                  $m =~ s/($escape_re)/$escape{$1}/gs;
142                  $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;
143                  $m =~ s#\/(\w+)\/#<i>$1</i>#gs;                  $m =~ s#\/(\w+)\/#<i>$1</i>#gs;
144                  $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;
145                  $m =~ s#\*(\w+)\*#<b>$1</b>#gs;                  $m =~ s#\*(\w+)\*#<b>$1</b>#gs;
# Line 148  my $filter = { Line 160  my $filter = {
160          },          },
161  };  };
162    
163    # POE IRC
164    my $poe_irc = POE::Component::IRC->spawn( %$irc_config ) or
165            die "can't start ", dump( $irc_config ), ": $!";
166    
167    my $irc = $poe_irc->session_id();
168    _log "IRC session_id $irc";
169    
170  my $dbh = DBI->connect($DSN,"","", { RaiseError => 1, AutoCommit => 1 }) || die $DBI::errstr;  my $dbh = DBI->connect($DSN,"","", { RaiseError => 1, AutoCommit => 1 }) || die $DBI::errstr;
171    $dbh->do( qq{ set client_encoding = 'UTF-8' } );
172    
173  my $sql_schema = {  my $sql_schema = {
174          log => '          log => qq{
175  create table log (  create table log (
176          id serial,          id serial,
177          time timestamp default now(),          time timestamp default now(),
# Line 165  create table log ( Line 185  create table log (
185  create index log_time on log(time);  create index log_time on log(time);
186  create index log_channel on log(channel);  create index log_channel on log(channel);
187  create index log_nick on log(nick);  create index log_nick on log(nick);
188          ',          },
189          meta => '          meta => q{
190  create table meta (  create table meta (
191          nick text not null,          nick text not null,
192          channel text not null,          channel text not null,
193          name text not null,          name text not null,
194          value text,          value text,
195          changed timestamp default now(),          changed timestamp default 'now()',
196          primary key(nick,channel,name)          primary key(nick,channel,name)
197  );  );
198          ',          },
199            feeds => qq{
200    create table feeds (
201            id serial,
202            url text not null,
203            name text,
204            delay interval not null default '5 min',
205            active boolean default true,
206            channel text not null,
207            nick text not null,
208            private boolean default false,
209            last_update timestamp default 'now()',
210            polls int default 0,
211            updates int default 0
212    );
213    create unique index feeds_url on feeds(url);
214    insert into feeds (url,name,channel,nick) values ('http://wiki.razmjenavjestina.org/feed/workspace/razmjenavjestina?category=Recent%20Changes','wiki','$CHANNEL','dpavlin');
215            },
216  };  };
217    
218  foreach my $table ( keys %$sql_schema ) {  foreach my $table ( keys %$sql_schema ) {
# Line 218  sub meta { Line 255  sub meta {
255                  if ( $@ || ! $sth->rows ) {                  if ( $@ || ! $sth->rows ) {
256                          $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()) });
257                          $sth->execute( $value, $nick, $channel, $name );                          $sth->execute( $value, $nick, $channel, $name );
258                          _log "created $nick/$channel/$name = $value";                          warn "## created $nick/$channel/$name = $value\n";
259                  } else {                  } else {
260                          _log "updated $nick/$channel/$name = $value ";                          warn "## updated $nick/$channel/$name = $value\n";
261                  }                  }
262    
263                  return $value;                  return $value;
# Line 230  sub meta { Line 267  sub meta {
267                  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 = ? });
268                  $sth->execute( $nick, $channel, $name );                  $sth->execute( $nick, $channel, $name );
269                  my ($v,$c) = $sth->fetchrow_array;                  my ($v,$c) = $sth->fetchrow_array;
270                  _log "fetched $nick/$channel/$name = $v [$c]";                  warn "## fetched $nick/$channel/$name = $v [$c]\n";
271                  return ($v,$c) if wantarray;                  return ($v,$c) if wantarray;
272                  return $v;                  return $v;
273    
# Line 239  sub meta { Line 276  sub meta {
276    
277    
278    
279  my $sth = $dbh->prepare(qq{  my $sth_insert_log = $dbh->prepare(qq{
280  insert into log  insert into log
281          (channel, me, nick, message, time)          (channel, me, nick, message, time)
282  values (?,?,?,?,?)  values (?,?,?,?,?)
# Line 327  sub get_from_log { Line 364  sub get_from_log {
364    
365          my @where;          my @where;
366          my @args;          my @args;
367            my $msg;
368    
369          if (my $search = $args->{search}) {          if (my $search = $args->{search}) {
370                  $search =~ s/^\s+//;                  $search =~ s/^\s+//;
371                  $search =~ s/\s+$//;                  $search =~ s/\s+$//;
372                  push @where, 'message ilike ? or nick ilike ?';                  push @where, 'message ilike ? or nick ilike ?';
373                  push @args, ( ( '%' . $search . '%' ) x 2 );                  push @args, ( ( '%' . $search . '%' ) x 2 );
374                  _log "search for '$search'";                  $msg = "Search for '$search'";
375          }          }
376    
377          if ($args->{tag} && $tags->{ $args->{tag} }) {          if ($args->{tag} && $tags->{ $args->{tag} }) {
378                  push @where, 'id in (' . join(',', @{ $tags->{ $args->{tag} } }) . ')';                  push @where, 'id in (' . join(',', @{ $tags->{ $args->{tag} } }) . ')';
379                  _log "search for tags $args->{tag}";                  $msg = "Search for tags $args->{tag}";
380          }          }
381    
382          if (my $date = $args->{date} ) {          if (my $date = $args->{date} ) {
383                  $date = check_date( $date );                  $date = check_date( $date );
384                  push @where, 'date(time) = ?';                  push @where, 'date(time) = ?';
385                  push @args, $date;                  push @args, $date;
386                  _log "search for date $date";                  $msg = "search for date $date";
387          }          }
388    
389          $sql .= " where " . join(" and ", @where) if @where;          $sql .= " where " . join(" and ", @where) if @where;
# Line 359  sub get_from_log { Line 397  sub get_from_log {
397          eval { $sth->execute( @args ) };          eval { $sth->execute( @args ) };
398          return if $@;          return if $@;
399    
400            my $nr_results = $sth->rows;
401    
402          my $last_row = {          my $last_row = {
403                  date => '',                  date => '',
404                  time => '',                  time => '',
# Line 379  sub get_from_log { Line 419  sub get_from_log {
419    
420          return @rows if ($args->{full_rows});          return @rows if ($args->{full_rows});
421    
422          my @msgs = (          $msg .= ' produced ' . (
423                  "Showing " . ($#rows + 1) . " messages..."                  $nr_results == 0 ? 'no results' :
424                    $nr_results == 0 ? 'one result' :
425                            $nr_results . ' results'
426          );          );
427    
428            my @msgs = ( $msg );
429    
430          if ($context) {          if ($context) {
431                  my @ids = @rows;                  my @ids = @rows;
432                  @rows = ();                  @rows = ();
# Line 439  sub get_from_log { Line 483  sub get_from_log {
483  #                       $row->{nick} = $nick;  #                       $row->{nick} = $nick;
484  #               }  #               }
485    
486                    $append = 0 if $row->{me};
487    
488                  if ($last_row->{nick} ne $nick) {                  if ($last_row->{nick} ne $nick) {
489                          # 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
490                          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 483  my $cloud = HTML::TagCloud->new; Line 529  my $cloud = HTML::TagCloud->new;
529    
530  =cut  =cut
531    
 my $last_x_tags = 5;  
532  my @last_tags;  my @last_tags;
533    
534  sub add_tag {  sub add_tag {
# Line 492  sub add_tag { Line 537  sub add_tag {
537          return unless ($arg->{id} && $arg->{message});          return unless ($arg->{id} && $arg->{message});
538    
539          my $m = $arg->{message};          my $m = $arg->{message};
         from_to('UTF-8', 'iso-8859-2', $m) if (is_utf8($m));  
540    
541          my @tags;          my @tags;
542    
# Line 561  sub save_message { Line 605  sub save_message {
605                  $a->{me} ? "***" . $a->{nick} : "<" . $a->{nick} . ">",                  $a->{me} ? "***" . $a->{nick} : "<" . $a->{nick} . ">",
606                  " " . $a->{message};                  " " . $a->{message};
607    
608          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});  
609          add_tag( id => $dbh->last_insert_id(undef,undef,"log",undef), %$a );          add_tag( id => $dbh->last_insert_id(undef,undef,"log",undef), %$a );
610  }  }
611    
# Line 602  if ($import_dircproxy) { Line 644  if ($import_dircproxy) {
644          exit;          exit;
645  }  }
646    
   
647  #  #
648  # POE handing part  # RSS follow
649  #  #
650    
651  my $SKIPPING = 0;               # if skipping, how many we've done  my $_stat;
652  my $SEND_QUEUE;                 # cache  
653  my $ping;                                               # ping stats  
654    sub rss_fetch {
655  POE::Component::IRC->new($IRC_ALIAS);          my ($args) = @_;
656    
657  POE::Session->create( inline_states =>          # how many messages to send out when feed is seen for the first time?
658     {_start => sub {                my $send_rss_msgs = 1;
659                  $_[KERNEL]->post($IRC_ALIAS => register => 'all');  
660                  $_[KERNEL]->post($IRC_ALIAS => connect => $CONNECT);          _log "RSS fetch", $args->{url};
661    
662            my $feed = XML::Feed->parse(URI->new( $args->{url} ));
663            if ( ! $feed ) {
664                    _log("can't fetch RSS ", $args->{url});
665                    return;
666            }
667    
668            $_stat->{rss}->{url2link}->{ $args->{url} } = $feed->link;
669    
670            my ( $total, $updates ) = ( 0, 0 );
671            for my $entry ($feed->entries) {
672                    $total++;
673    
674                    # seen allready?
675                    next if $_stat->{rss}->{seen}->{$args->{channel}}->{$feed->link}->{$entry->id}++ > 0;
676    
677                    sub prefix {
678                            my ($txt,$var) = @_;
679                            $var =~ s/\s+/ /gs;
680                            $var =~ s/^\s+//g;
681                            $var =~ s/\s+$//g;
682                            return $txt . $var if $var;
683                    }
684    
685                    # fix absolute and relative links to feed entries
686                    my $link = $entry->link;
687                    if ( $link =~ m!^/! ) {
688                            my $host = $args->{url};
689                            $host =~ s!^(http://[^/]+).*$!$1!;      #!vim
690                            $link = "$host/$link";
691                    } elsif ( $link !~ m!^http! ) {
692                            $link = $args->{url} . $link;
693                    }
694    
695                    my $msg;
696                    $msg .= prefix( 'From: ' , $args->{name} || $feed->title );
697                    $msg .= prefix( ' by ' , $entry->author );
698                    $msg .= prefix( ' | ' , $entry->title );
699                    $msg .= prefix( ' | ' , $link );
700    #               $msg .= prefix( ' id ' , $entry->id );
701                    if ( my $tags = $entry->category ) {
702                            $tags =~ s!^\s+!!;
703                            $tags =~ s!\s*$! !;
704                            $tags =~ s!,?\s+!// !g;
705                            $msg .= prefix( ' ' , $tags );
706                    }
707    
708                    if ( $args->{kernel} && $send_rss_msgs ) {
709                            $send_rss_msgs--;
710                            if ( ! $args->{private} ) {
711                                    # FIXME bug! should be save_message
712    #                               save_message( channel => $args->{channel}, me => 1, nick => $NICK, message => $msg );
713                                    $sth_insert_log->execute( $args->{channel}, 1, $NICK, $msg, 'now()' );
714                            }
715                            my ( $type, $to ) = ( 'notice', $args->{channel} );
716                            ( $type, $to ) = ( 'privmsg', $args->{nick} ) if $args->{private};
717                            _log(">> $type $to", $msg);
718                            $args->{kernel}->post( $irc => $type => $to, $msg );
719                            $updates++;
720                    }
721            }
722    
723            my $sql = qq{ update feeds set last_update = now(), polls = polls + 1 };
724            $sql .= qq{, updates = updates + $updates } if $updates;
725            $sql .= qq{where id = } . $args->{id};
726            eval { $dbh->do( $sql ) };
727    
728            _log "RSS got $total items of which $updates new";
729    
730            return $updates;
731    }
732    
733    sub rss_fetch_all {
734            my $kernel = shift;
735            my $sql = qq{
736                    select id, url, name, channel, nick, private
737                    from feeds
738                    where active is true
739            };
740            # limit to newer feeds only if we are not sending messages out
741            $sql .= qq{     and last_update + delay < now() } if $kernel;
742            my $sth = $dbh->prepare( $sql );
743            $sth->execute();
744            warn "# ",$sth->rows," active RSS feeds\n";
745            my $count = 0;
746            while (my $row = $sth->fetchrow_hashref) {
747                    $row->{kernel} = $kernel if $kernel;
748                    $count += rss_fetch( $row );
749            }
750            return "OK, fetched $count posts from " . $sth->rows . " feeds";
751    }
752    
753    
754    sub rss_check_updates {
755            my $kernel = shift;
756            $_stat->{rss}->{last_poll} ||= time();
757            my $dt = time() - $_stat->{rss}->{last_poll};
758            warn "## rss_check_updates $dt > $rss_min_delay\n";
759            if ( $dt > $rss_min_delay ) {
760                    $_stat->{rss}->{last_poll} = time();
761                    _log rss_fetch_all( $kernel );
762            }
763    }
764    
765    # seed rss seen cache so we won't send out all items on startup
766    _log rss_fetch_all;
767    
768    POE::Session->create( inline_states => {
769            _start => sub {      
770                    $_[KERNEL]->post( $irc => register => 'all' );
771                    $_[KERNEL]->post( $irc => connect => {} );
772      },      },
773            irc_001 => sub {
774                    my ($kernel,$sender) = @_[KERNEL,SENDER];
775                    my $poco_object = $sender->get_heap();
776                    _log "connected to",$poco_object->server_name();
777                    $kernel->post( $sender => join => $_ ) for @channels;
778                    undef;
779            },
780      irc_255 => sub {    # server is done blabbing      irc_255 => sub {    # server is done blabbing
781                  $_[KERNEL]->post($IRC_ALIAS => join => $CHANNEL);                  $_[KERNEL]->post( $irc => 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" );  
782      },      },
783      irc_public => sub {      irc_public => sub {
784                  my $kernel = $_[KERNEL];                  my $kernel = $_[KERNEL];
# Line 633  POE::Session->create( inline_states => Line 788  POE::Session->create( inline_states =>
788    
789                  save_message( channel => $channel, me => 0, nick => $nick, message => $msg);                  save_message( channel => $channel, me => 0, nick => $nick, message => $msg);
790                  meta( $nick, $channel, 'last-msg', $msg );                  meta( $nick, $channel, 'last-msg', $msg );
791                    rss_check_updates( $kernel );
792      },      },
793      irc_ctcp_action => sub {      irc_ctcp_action => sub {
794                  my $kernel = $_[KERNEL];                  my $kernel = $_[KERNEL];
# Line 653  POE::Session->create( inline_states => Line 809  POE::Session->create( inline_states =>
809    
810      },      },
811          irc_ping => sub {          irc_ping => sub {
812                  warn "pong ", $_[ARG0], $/;                  _log( "pong ", $_[ARG0] );
813                  $ping->{ $_[ARG0] }++;                  $_stat->{ping}->{ $_[ARG0] }++;
814                    rss_check_updates( $_[KERNEL] );
815          },          },
816          irc_invite => sub {          irc_invite => sub {
817                  my $kernel = $_[KERNEL];                  my $kernel = $_[KERNEL];
818                  my $nick = (split /!/, $_[ARG0])[0];                  my $nick = (split /!/, $_[ARG0])[0];
819                  my $channel = $_[ARG1];                  my $channel = $_[ARG1];
820    
821                  warn "invited to $channel by $nick";                  _log "invited to $channel by $nick";
822    
823                  $_[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..." );
824                  $_[KERNEL]->post($IRC_ALIAS => join => $channel);                  $_[KERNEL]->post( $irc => 'join' => $channel );
825    
826          },          },
827          irc_msg => sub {          irc_msg => sub {
# Line 672  POE::Session->create( inline_states => Line 829  POE::Session->create( inline_states =>
829                  my $nick = (split /!/, $_[ARG0])[0];                  my $nick = (split /!/, $_[ARG0])[0];
830                  my $msg = $_[ARG2];                  my $msg = $_[ARG2];
831                  my $channel = $_[ARG1]->[0];                  my $channel = $_[ARG1]->[0];
                 from_to($msg, 'UTF-8', $ENCODING);  
832    
833                  my $res = "unknown command '$msg', try /msg $NICK help!";                  my $res = "unknown command '$msg', try /msg $NICK help!";
834                  my @out;                  my @out;
# Line 683  POE::Session->create( inline_states => Line 839  POE::Session->create( inline_states =>
839    
840                          $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";
841    
842                  } elsif ($msg =~ m/^msg\s+(\S+)\s+(.*)$/i) {                  } elsif ($msg =~ m/^(privmsg|notice)\s+(\S+)\s+(.*)$/i) {
843    
844                          _log ">> /msg $1 $2";                          _log ">> /$1 $2 $3";
845                          $_[KERNEL]->post( $IRC_ALIAS => privmsg => $1, $2 );                          $_[KERNEL]->post( $irc => $1 => $2, $3 );
846                          $res = '';                          $res = '';
847    
848                  } elsif ($msg =~ m/^stat.*?\s*(\d*)/i) {                  } elsif ($msg =~ m/^stat.*?\s*(\d*)/i) {
# Line 716  POE::Session->create( inline_states => Line 872  POE::Session->create( inline_states =>
872    
873                          foreach my $res (get_from_log( limit => $limit )) {                          foreach my $res (get_from_log( limit => $limit )) {
874                                  _log "last: $res";                                  _log "last: $res";
875                                  from_to($res, $ENCODING, 'UTF-8');                                  $_[KERNEL]->post( $irc => privmsg => $nick, $res );
                                 $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );  
876                          }                          }
877    
878                          $res = '';                          $res = '';
# Line 731  POE::Session->create( inline_states => Line 886  POE::Session->create( inline_states =>
886                                          search => $what,                                          search => $what,
887                                  )) {                                  )) {
888                                  _log "search [$what]: $res";                                  _log "search [$what]: $res";
889                                  from_to($res, $ENCODING, 'UTF-8');                                  $_[KERNEL]->post( $irc => privmsg => $nick, $res );
                                 $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );  
890                          }                          }
891    
892                          $res = '';                          $res = '';
# Line 767  POE::Session->create( inline_states => Line 921  POE::Session->create( inline_states =>
921                                  " : " . ( $stat->{vote}->{'-'} || 0 ) . " --" .                                  " : " . ( $stat->{vote}->{'-'} || 0 ) . " --" .
922                                  " from " . ( join(", ", @nicks) || 'nobody' );                                  " from " . ( join(", ", @nicks) || 'nobody' );
923    
924                          $_[KERNEL]->post( $IRC_ALIAS => notice => $nick, $res );                          $_[KERNEL]->post( $irc => notice => $nick, $res );
925    
926                  } elsif ($msg =~ m/^ping/) {                  } elsif ($msg =~ m/^ping/) {
927                          $res = "ping = " . dump( $ping );                          $res = "ping = " . dump( $_stat->{ping} );
928                  } elsif ($msg =~ m/^conf(?:ig)*\s*(last-size|twitter)*\s*(.*)/) {                  } elsif ($msg =~ m/^conf(?:ig)*\s*(last-size|twitter)*\s*(.*)/) {
929                          if ( ! defined( $1 ) ) {                          if ( ! defined( $1 ) ) {
930                                  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 801  POE::Session->create( inline_states => Line 955  POE::Session->create( inline_states =>
955                                          $res = "config option $op doesn't exist";                                          $res = "config option $op doesn't exist";
956                                  }                                  }
957                          }                          }
958                    } elsif ($msg =~ m/^rss-update/) {
959                            $res = rss_fetch_all( $_[KERNEL] );
960                    } elsif ($msg =~ m/^rss-list/) {
961                            my $sth = $dbh->prepare(qq{ select url,name,last_update,active,channel,nick,private from feeds });
962                            $sth->execute;
963                            while (my @row = $sth->fetchrow_array) {
964                                    $_[KERNEL]->post( $irc => privmsg => $nick, join(' | ',@row) );
965                            }
966                            $res = '';
967                    } elsif ($msg =~ m!^rss-(add|remove|stop|start|clean)(?:-(private))?\s+(http://\S+)\s*(.*)!) {
968                            my ( $command, $sub, $url, $arg ) = ( $1,$2,$3,$4 );
969    
970                            my $channel = $1 if ( $arg =~ s/\s*(#\S+)\s*// );
971                            $channel = $nick if $sub eq 'private';
972    
973                            my $sql = {
974                                    add     => qq{ insert into feeds (url,name,channel,nick,private) values (?,?,?,?,?) },
975    #                               remove  => qq{ delete from feeds                                where url = ? and name = ? },
976                                    start   => qq{ update feeds set active = true   where url = ? },
977                                    stop    => qq{ update feeds set active = false  where url = ? },
978                                    clean   => qq{ update feeds set last_update = now() - delay where url = ? },
979                            };
980    
981                            if ( $command eq 'add' && ! $channel ) {
982                                    $res = "ERROR: got '$msg' which doesn't have #channel in it, ignoring!";
983                            } elsif (my $q = $sql->{$command} ) {
984                                    my $sth = $dbh->prepare( $q );
985                                    my @data = ( $url );
986                                    if ( $command eq 'add' ) {
987                                            push @data, ( $arg, $channel, $nick, $sub eq 'private' ? 1 : 0 );
988                                    }
989                                    warn "## $command SQL $q with ",dump( @data ),"\n";
990                                    eval { $sth->execute( @data ) };
991                                    if ($@) {
992                                            $res = "ERROR: $@";
993                                    } else {
994                                            $res = "OK, RSS executed $command " . ( $sub ? "-$sub" : '' ) ."on $channel url $url";
995                                            if ( $command eq 'clean' ) {
996                                                    my $seen = $_stat->{rss}->{seen} || die "no seen?";
997                                                    my $want_link = $_stat->{rss}->{url2link}->{$url} || warn "no url2link($url)";
998                                                    foreach my $c ( keys %$seen ) {
999                                                            my $c_hash = $seen->{$c} || die "no seen->{$c}";
1000                                                            die "not HASH with rss links but ", dump($c_hash) unless ref($c_hash) eq 'HASH';
1001                                                            foreach my $link ( keys %$c_hash ) {
1002                                                                    next unless $link eq $want_link;
1003                                                                    _log "RSS removed seen $c $url $link";
1004                                                            }
1005                                                    }
1006                                            }
1007                                    }
1008                            } else {
1009                                    $res = "ERROR: don't know what to do with: $msg";
1010                            }
1011                    } elsif ($msg =~ m/^rss-clean/) {
1012                            # this makes sense because we didn't catch rss-clean http://... before!
1013                            $_stat->{rss} = undef;
1014                            $dbh->do( qq{ update feeds set last_update = now() - delay } );
1015                            $res = "OK, cleaned RSS cache";
1016                  }                  }
1017    
1018                  if ($res) {                  if ($res) {
1019                          _log ">> [$nick] $res";                          _log ">> [$nick] $res";
1020                          from_to($res, $ENCODING, 'UTF-8');                          $_[KERNEL]->post( $irc => privmsg => $nick, $res );
                         $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );  
1021                  }                  }
1022    
1023                    rss_check_updates( $_[KERNEL] );
1024          },          },
1025            irc_372 => sub {
1026                    _log "<< motd",$_[ARG0],$_[ARG1];
1027            },
1028            irc_375 => sub {
1029                    _log "<< motd", $_[ARG0], "start";
1030            },
1031            irc_376 => sub {
1032                    _log "<< motd", $_[ARG0], "end";
1033            },
1034    #       irc_433 => sub {
1035    #               print "# irc_433: ",$_[ARG1], "\n";
1036    #               warn "## indetify $NICK\n";
1037    #               $_[KERNEL]->post( $irc => privmsg => 'nickserv', "IDENTIFY $NICK" );
1038    #       },
1039    #       irc_451 # please register
1040          irc_477 => sub {          irc_477 => sub {
1041                  _log "# irc_477: ",$_[ARG1];                  _log "<< irc_477: ",$_[ARG1];
1042                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "register $NICK" );                  _log ">> IDENTIFY $NICK";
1043                    $_[KERNEL]->post( $irc => privmsg => 'NickServ', "IDENTIFY $NICK" );
1044          },          },
1045          irc_505 => sub {          irc_505 => sub {
1046                  _log "# irc_505: ",$_[ARG1];                  _log "<< irc_505: ",$_[ARG1];
1047                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "register $NICK" );                  _log ">> register $NICK";
1048  #               $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "set hide email on" );                  $_[KERNEL]->post( $irc => privmsg => 'NickServ', "register $NICK" );
1049  #               $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "set email dpavlin\@rot13.org" );  #               $_[KERNEL]->post( $irc => privmsg => 'nickserv', "IDENTIFY $NICK" );
1050    #               $_[KERNEL]->post( $irc => privmsg => 'nickserv', "set hide email on" );
1051    #               $_[KERNEL]->post( $irc => privmsg => 'nickserv', "set email dpavlin\@rot13.org" );
1052          },          },
1053          irc_registered => sub {          irc_registered => sub {
1054                  _log "## registrated $NICK";                  _log "<< registered $NICK";
                 $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "IDENTIFY $NICK" );  
1055          },          },
1056          irc_disconnected => sub {          irc_disconnected => sub {
1057                  _log "## disconnected, reconnecting again";                  _log "## disconnected.. sleeping for $sleep_on_error seconds and reconnecting again";
1058                  $_[KERNEL]->post($IRC_ALIAS => connect => $CONNECT);                  sleep($sleep_on_error);
1059                    $_[KERNEL]->post( $irc => connect => {} );
1060          },          },
1061          irc_socketerr => sub {          irc_socketerr => sub {
1062                  _log "## socket error... sleeping for $sleep_on_error seconds and retry";                  _log "## socket error... sleeping for $sleep_on_error seconds and retry";
1063                  sleep($sleep_on_error);                  sleep($sleep_on_error);
1064                  $_[KERNEL]->post($IRC_ALIAS => connect => $CONNECT);                  $_[KERNEL]->post( $irc => connect => {} );
1065            },
1066            irc_notice => sub {
1067                    _log "<< notice from ", $_[ARG0], $_[ARG1], $_[ARG2];
1068                    my $m = $_[ARG2];
1069                    if ( $m =~ m!/msg.*(NickServ).*(IDENTIFY)!i ) {
1070                            _log ">> suggested to $1 $2";
1071                            $_[KERNEL]->post( $irc => privmsg => $1, "$2 $NICK" );
1072                    } elsif ( $m =~ m!\Q$NICK\E.*registered!i ) {
1073                            _log ">> registreted, so IDENTIFY";
1074                            $_[KERNEL]->post( $irc => privmsg => 'nickserv', "IDENTIFY $NICK" );
1075                    } else {
1076                            warn "## ignore $m\n";
1077                    }
1078            },
1079            irc_snotice => sub {
1080                    _log "<< snotice", $_[ARG0]; #dump( $_[ARG0],$_[ARG1], $_[ARG2] );
1081                    if ( $_[ARG0] =~ m!/(QUOTE)\s+(PASS\s+\d+)!i ) {
1082                            warn ">> $1 | $2\n";
1083                            $_[KERNEL]->post( $irc => lc($1) => $2);
1084                    }
1085          },          },
 #       irc_433 => sub {  
 #               print "# irc_433: ",$_[ARG1], "\n";  
 #               warn "## indetify $NICK\n";  
 #               $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "IDENTIFY $NICK" );  
 #       },  
1086      _child => sub {},      _child => sub {},
1087      _default => sub {      _default => sub {
1088                  _log sprintf "sID:%s %s %s",                  _log sprintf "sID:%s %s %s",
# Line 847  POE::Session->create( inline_states => Line 1092  POE::Session->create( inline_states =>
1092                          "";                          "";
1093        0;                        # false for signals        0;                        # false for signals
1094      },      },
     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',  
                     );  
             },  
             got_line => sub {  
               $_[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);  
     }  
1095     },     },
1096    );    );
1097    
1098  # http server  # http server
1099    
1100    _log "WEB archive at $url";
1101    
1102  my $httpd = POE::Component::Server::HTTP->new(  my $httpd = POE::Component::Server::HTTP->new(
1103          Port => $http_port,          Port => $http_port,
1104            PreHandler => {
1105                    '/' => sub {
1106                            $_[0]->header(Connection => 'close')
1107                    }
1108            },
1109          ContentHandler => { '/' => \&root_handler },          ContentHandler => { '/' => \&root_handler },
1110          Headers        => { Server => 'irc-logger' },          Headers        => { Server => 'irc-logger' },
1111  );  );
# Line 953  foreach my $c (@cols) { Line 1145  foreach my $c (@cols) {
1145          $style .= ".col-${max_color} { background: $c }\n";          $style .= ".col-${max_color} { background: $c }\n";
1146          $max_color++;          $max_color++;
1147  }  }
1148  warn "defined $max_color colors for users...\n";  _log "WEB defined $max_color colors for users...";
1149    
1150  sub root_handler {  sub root_handler {
1151          my ($request, $response) = @_;          my ($request, $response) = @_;
1152          $response->code(RC_OK);          $response->code(RC_OK);
1153    
1154            # this doesn't seem to work, so moved to PreHandler
1155            #$response->header(Connection => 'close');
1156    
1157          return RC_OK if $request->uri =~ m/favicon.ico$/;          return RC_OK if $request->uri =~ m/favicon.ico$/;
1158    
1159          my $q;          my $q;
# Line 972  sub root_handler { Line 1167  sub root_handler {
1167          }          }
1168    
1169          my $search = $q->param('search') || $q->param('grep') || '';          my $search = $q->param('search') || $q->param('grep') || '';
1170            my $r_url = $request->url;
1171    
1172            my @commands = qw( tags last-tag follow stat );
1173            my $commands_re = join('|',@commands);
1174    
1175            if ($r_url =~ m#/rss(?:/($commands_re.*)\w*(?:=(\d+))?)?#i) {
1176                    my $show = lc($1);
1177                    my $nr = $2;
1178    
         if ($request->url =~ m#/rss#i) {  
1179                  my $type = 'RSS';       # Atom                  my $type = 'RSS';       # Atom
1180    
1181                  $response->content_type( 'application/' . lc($type) . '+xml' );                  $response->content_type( 'application/' . lc($type) . '+xml' );
# Line 982  sub root_handler { Line 1184  sub root_handler {
1184                  #warn "create $type feed from ",dump( @last_tags );                  #warn "create $type feed from ",dump( @last_tags );
1185    
1186                  my $feed = XML::Feed->new( $type );                  my $feed = XML::Feed->new( $type );
   
                 $feed->title( "last $last_x_tags from $CHANNEL" );  
1187                  $feed->link( $url );                  $feed->link( $url );
                 $feed->description( "collects messages which have tags// in them" );  
1188    
1189                  foreach my $m ( @last_tags ) {                  my $rc = RC_OK;
1190  #                       warn dump( $m );  
1191                          #my $tags = join(' ', @{$m->{tags}} );                  if ( $show eq 'tags' ) {
1192                            $nr ||= 50;
1193                            $feed->title( "tags from $CHANNEL" );
1194                            $feed->link( "$url/tags" );
1195                            $feed->description( "tag cloud created from messages on channel $CHANNEL which have tags// in them" );
1196                            my $feed_entry = XML::Feed::Entry->new($type);
1197                            $feed_entry->title( "$nr tags from $CHANNEL" );
1198                            $feed_entry->author( $NICK );
1199                            $feed_entry->link( '/#tags'  );
1200    
1201                            $feed_entry->content(
1202                                    qq{<![CDATA[<style type="text/css">}
1203                                    . $cloud->css
1204                                    . qq{</style>}
1205                                    . $cloud->html( $nr )
1206                                    . qq{]]>}
1207                            );
1208                            $feed->add_entry( $feed_entry );
1209    
1210                    } elsif ( $show eq 'last-tag' ) {
1211    
1212                            $nr ||= $last_x_tags;
1213                            $nr = $last_x_tags if $nr > $last_x_tags;
1214    
1215                            $feed->title( "last $nr tagged messages from $CHANNEL" );
1216                            $feed->description( "collects messages which have tags// in them" );
1217    
1218                            foreach my $m ( @last_tags ) {
1219    #                               warn dump( $m );
1220                                    #my $tags = join(' ', @{$m->{tags}} );
1221                                    my $feed_entry = XML::Feed::Entry->new($type);
1222                                    $feed_entry->title( $m->{nick} . '@' . $m->{time} );
1223                                    $feed_entry->author( $m->{nick} );
1224                                    $feed_entry->link( '/#' . $m->{id}  );
1225                                    $feed_entry->issued( DateTime::Format::Flexible->build( $m->{time} ) );
1226    
1227                                    my $message = $filter->{message}->( $m->{message} );
1228                                    $message .= "<br/>\n" unless $message =~ m!<(/p|br/?)>!;
1229    #                               warn "## message = $message\n";
1230    
1231                                    #$feed_entry->summary(
1232                                    $feed_entry->content(
1233                                            "<![CDATA[$message]]>"
1234                                    );
1235                                    $feed_entry->category( join(', ', @{$m->{tags}}) );
1236                                    $feed->add_entry( $feed_entry );
1237    
1238                                    $nr--;
1239                                    last if $nr <= 0;
1240    
1241                            }
1242    
1243                    } elsif ( $show =~ m/^follow/ ) {
1244    
1245                            $feed->title( "Feeds which this bot follows" );
1246    
1247                            my $sth = $dbh->prepare( qq{ select * from feeds order by last_update desc } );
1248                            $sth->execute;
1249                            while (my $row = $sth->fetchrow_hashref) {
1250                                    my $feed_entry = XML::Feed::Entry->new($type);
1251                                    $feed_entry->title( $row->{name} );
1252                                    $feed_entry->link( $row->{url}  );
1253                                    $feed_entry->issued( DateTime::Format::Flexible->build( $row->{last_update} ) );
1254                                    $feed_entry->content(
1255                                            '<![CDATA[<pre>' . dump( $row ) . '</pre>]]>'
1256                                    );
1257                                    $feed->add_entry( $feed_entry );
1258                            }
1259    
1260                    } elsif ( $show =~ m/^stat/ ) {
1261    
1262                          my $feed_entry = XML::Feed::Entry->new($type);                          my $feed_entry = XML::Feed::Entry->new($type);
1263                          $feed_entry->title( $m->{nick} . '@' . $m->{time} );                          $feed_entry->title( "Internal stats" );
                         $feed_entry->author( $m->{nick} );  
                         $feed_entry->link( '/#' . $m->{id}  );  
                         $feed_entry->issued( DateTime::Format::Flexible->build( $m->{time} ) );  
                         #$feed_entry->summary(  
1264                          $feed_entry->content(                          $feed_entry->content(
1265                                  '<![CDATA[' .                                  '<![CDATA[<pre>' . dump( $_stat ) . '</pre>]]>'
 #                               $filter->{nick}->( $m->{nick} ) .  
 #                               '<tt>' . $m->{nick} . '</tt> ' .  
                                 $filter->{message}->( $m->{message} ) .  
                                 "<br/>\n]]>"  
1266                          );                          );
                         $feed_entry->category( join(', ', @{$m->{tags}}) );  
1267                          $feed->add_entry( $feed_entry );                          $feed->add_entry( $feed_entry );
1268    
1269                    } else {
1270                            _log "WEB unknown rss request $r_url";
1271                            $feed->title( "unknown $r_url" );
1272                            foreach my $c ( @commands ) {
1273                                    my $feed_entry = XML::Feed::Entry->new($type);
1274                                    $feed_entry->title( "rss/$c" );
1275                                    $feed_entry->link( "$url/rss/$c" );
1276                                    $feed->add_entry( $feed_entry );
1277                            }
1278                            $rc = RC_DENY;
1279                  }                  }
1280    
1281                  $response->content( $feed->as_xml );                  $response->content( $feed->as_xml );
1282                  return RC_OK;                  return $rc;
1283          }          }
1284    
1285          if ( $@ ) {          if ( $@ ) {
1286                  warn "$@";                  warn "$@";
1287          }          }
1288    
1289          $response->content_type("text/html; charset=$ENCODING");          $response->content_type("text/html; charset=UTF-8");
1290    
1291          my $html =          my $html =
1292                  qq{<html><head><title>$NICK</title><style type="text/css">$style} .                  qq{<html><head><title>$NICK</title><style type="text/css">$style}
1293                  $cloud->css .                  . $cloud->css
1294                  qq{</style></head><body>} .                  . qq{</style></head><body>}
1295                  qq{                  . qq{
1296                  <form method="post" class="search" action="/">                  <form method="post" class="search" action="/">
1297                  <input type="text" name="search" value="$search" size="10">                  <input type="text" name="search" value="$search" size="10">
1298                  <input type="submit" value="search">                  <input type="submit" value="search">
1299                  </form>                  </form>
1300                  } .                  }
1301                  $cloud->html(500) .                  . $cloud->html(500)
1302                  qq{<p>};                  . qq{<p>};
1303          if ($request->url =~ m#/history#) {  
1304            if ($request->url =~ m#/tags?#) {
1305                    # nop
1306            } elsif ($request->url =~ m#/history#) {
1307                  my $sth = $dbh->prepare(qq{                  my $sth = $dbh->prepare(qq{
1308                          select date(time) as date,count(*) as nr,sum(length(message)) as len                          select date(time) as date,count(*) as nr,sum(length(message)) as len
1309                                  from log                                  from log
# Line 1061  sub root_handler { Line 1335  sub root_handler {
1335                                  $cal->weekdays('MON','TUE','WED','THU','FRI');                                  $cal->weekdays('MON','TUE','WED','THU','FRI');
1336                                  ($l_yyyy,$l_mm) = ($yyyy,$mm);                                  ($l_yyyy,$l_mm) = ($yyyy,$mm);
1337                          }                          }
1338                          $cal->setcontent($dd, qq{                          $cal->setcontent($dd, qq[
1339                                  <a href="$url?date=$row->{date}">$row->{nr}</a><br/>$row->{len}                                  <a href="$url?date=$row->{date}">$row->{nr}</a><br/>$row->{len}
1340                          });                          ]) if $cal;
1341                                                    
1342                  }                  }
1343                  $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.74  
changed lines
  Added in v.118
  ViewVC Help
Powered by ViewVC 1.1.26