/[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 72 by dpavlin, Sun Dec 16 19:03:35 2007 UTC revision 112 by dpavlin, Mon Mar 10 13:02:32 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 $HOSTNAME = `hostname`;  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`;
58    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-dev';
65     ACCESS => "/var/log/apache/access.log",  #       $irc_config = {
66     ERROR => "/var/log/apache/error.log",  #               nick => 'irc-logger-dev',
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  my $http_port = $NICK =~ m/-dev/ ? 8001 : 8000;  # number of last tags to keep in circular buffer
89  my $http_hostname = `hostname`;  my $last_x_tags = 50;
 chomp( $http_hostname );  
90    
91  ## END CONFIG  # 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;
95    
96    my $url = "http://$HOSTNAME:$http_port";
97    
98  use POE qw(Component::IRC Wheel::FollowTail Component::Server::HTTP);  ## END CONFIG
 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;  
99    
100  my $use_twitter = 1;  my $use_twitter = 1;
101  eval { require Net::Twitter; };  eval { require Net::Twitter; };
# Line 95  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  };  #};
114    
115  open(STDOUT, '>', $log_path) || warn "can't redirect log to $log_path: $!";  open(STDOUT, '>', $log_path) || warn "can't redirect log to $log_path: $!";
116    
117  sub _log {  sub _log {
118          print strftime($TIMESTAMP,localtime()), ' ', join(" ",@_), $/;          print strftime($TIMESTAMP,localtime()) . ' ' . join(" ",@_) . $/;
119  }  }
120    
121  # HTML formatters  # HTML formatters
# Line 122  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="?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;
146                  $m =~ s#_(\w+)_#<u>$1</u>#gs;                  $m =~ s#_(\w+)_#<u>$1</u>#gs;
147    
# Line 147  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 164  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 217  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 229  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 238  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 326  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 358  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 378  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 438  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 482  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 491  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 500  sub add_tag { Line 545  sub add_tag {
545                  next if (! $tag || $tag =~ m/https?:/i);                  next if (! $tag || $tag =~ m/https?:/i);
546                  push @{ $tags->{$tag} }, $arg->{id};                  push @{ $tags->{$tag} }, $arg->{id};
547                  #warn "+tag $tag: $arg->{id}\n";                  #warn "+tag $tag: $arg->{id}\n";
548                  $cloud->add($tag, "?tag=$tag", scalar @{$tags->{$tag}} + 1);                  $cloud->add($tag, "$url?tag=$tag", scalar @{$tags->{$tag}} + 1);
549                  push @tags, $tag;                  push @tags, $tag;
550    
551          }          }
552    
553          if ( @tags ) {          if ( @tags ) {
554                  shift @last_tags if $#last_tags == $last_x_tags;                  pop @last_tags if $#last_tags == $last_x_tags;
555                  push @last_tags, { tags => [ @tags ], %$arg };                  unshift @last_tags, { tags => [ @tags ], %$arg };
556          }          }
557    
558  }  }
# Line 519  Read all tags from database and create i Line 564  Read all tags from database and create i
564  =cut  =cut
565    
566  sub seed_tags {  sub seed_tags {
567          my $sth = $dbh->prepare(qq{ select id,message,nick,me,time from log where message like '%//%' });          my $sth = $dbh->prepare(qq{ select id,message,nick,me,time from log where message like '%//%' order by time asc });
568          $sth->execute;          $sth->execute;
569          while (my $row = $sth->fetchrow_hashref) {          while (my $row = $sth->fetchrow_hashref) {
570                  add_tag( %$row );                  add_tag( %$row );
571          }          }
572    
573          foreach my $tag (keys %$tags) {          foreach my $tag (keys %$tags) {
574                  $cloud->add($tag, "?tag=$tag", scalar @{$tags->{$tag}} + 1);                  $cloud->add($tag, "$url?tag=$tag", scalar @{$tags->{$tag}} + 1);
575          }          }
576  }  }
577    
# Line 560  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 601  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            my ( $total, $updates ) = ( 0, 0 );
669            for my $entry ($feed->entries) {
670                    $total++;
671    
672                    # seen allready?
673                    next if $_stat->{rss}->{seen}->{$args->{channel}}->{$feed->link}->{$entry->id}++ > 0;
674    
675                    sub prefix {
676                            my ($txt,$var) = @_;
677                            $var =~ s/\s+/ /gs;
678                            $var =~ s/^\s+//g;
679                            $var =~ s/\s+$//g;
680                            return $txt . $var if $var;
681                    }
682    
683                    # fix absolute and relative links to feed entries
684                    my $link = $entry->link;
685                    if ( $link =~ m!^/! ) {
686                            my $host = $args->{url};
687                            $host =~ s!^(http://[^/]+).*$!$1!;      #!vim
688                            $link = "$host/$link";
689                    } elsif ( $link !~ m!^http! ) {
690                            $link = $args->{url} . $link;
691                    }
692    
693                    my $msg;
694                    $msg .= prefix( 'From: ' , $args->{name} || $feed->title );
695                    $msg .= prefix( ' by ' , $entry->author );
696                    $msg .= prefix( ' | ' , $entry->title );
697                    $msg .= prefix( ' | ' , $link );
698    #               $msg .= prefix( ' id ' , $entry->id );
699    
700                    if ( $args->{kernel} && $send_rss_msgs ) {
701                            $send_rss_msgs--;
702                            if ( ! $args->{private} ) {
703                                    # FIXME bug! should be save_message
704    #                               save_message( channel => $args->{channel}, me => 1, nick => $NICK, message => $msg );
705                                    $sth_insert_log->execute( $args->{channel}, 1, $NICK, $msg, 'now()' );
706                            }
707                            my ( $type, $to ) = ( 'notice', $args->{channel} );
708                            ( $type, $to ) = ( 'privmsg', $args->{nick} ) if $args->{private};
709                            _log(">> $type $to", $msg);
710                            $args->{kernel}->post( $irc => $type => $to, $msg );
711                            $updates++;
712                    }
713            }
714    
715            my $sql = qq{ update feeds set last_update = now(), polls = polls + 1 };
716            $sql .= qq{, updates = updates + $updates } if $updates;
717            $sql .= qq{where id = } . $args->{id};
718            eval { $dbh->do( $sql ) };
719    
720            _log "RSS got $total items of which $updates new";
721    
722            return $updates;
723    }
724    
725    sub rss_fetch_all {
726            my $kernel = shift;
727            my $sql = qq{
728                    select id, url, name, channel, nick, private
729                    from feeds
730                    where active is true
731            };
732            # limit to newer feeds only if we are not sending messages out
733            $sql .= qq{     and last_update + delay < now() } if $kernel;
734            my $sth = $dbh->prepare( $sql );
735            $sth->execute();
736            warn "# ",$sth->rows," active RSS feeds\n";
737            my $count = 0;
738            while (my $row = $sth->fetchrow_hashref) {
739                    $row->{kernel} = $kernel if $kernel;
740                    $count += rss_fetch( $row );
741            }
742            return "OK, fetched $count posts from " . $sth->rows . " feeds";
743    }
744    
745    
746    sub rss_check_updates {
747            my $kernel = shift;
748            $_stat->{rss}->{last_poll} ||= time();
749            my $dt = time() - $_stat->{rss}->{last_poll};
750            warn "## rss_check_updates $dt > $rss_min_delay\n";
751            if ( $dt > $rss_min_delay ) {
752                    $_stat->{rss}->{last_poll} = time();
753                    _log rss_fetch_all( $kernel );
754            }
755    }
756    
757    # seed rss seen cache so we won't send out all items on startup
758    _log rss_fetch_all;
759    
760    POE::Session->create( inline_states => {
761            _start => sub {      
762                    $_[KERNEL]->post( $irc => register => 'all' );
763                    $_[KERNEL]->post( $irc => connect => {} );
764      },      },
765            irc_001 => sub {
766                    my ($kernel,$sender) = @_[KERNEL,SENDER];
767                    my $poco_object = $sender->get_heap();
768                    _log "connected to",$poco_object->server_name();
769                    $kernel->post( $sender => join => $_ ) for @channels;
770                    undef;
771            },
772      irc_255 => sub {    # server is done blabbing      irc_255 => sub {    # server is done blabbing
773                  $_[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" );  
774      },      },
775      irc_public => sub {      irc_public => sub {
776                  my $kernel = $_[KERNEL];                  my $kernel = $_[KERNEL];
# Line 632  POE::Session->create( inline_states => Line 780  POE::Session->create( inline_states =>
780    
781                  save_message( channel => $channel, me => 0, nick => $nick, message => $msg);                  save_message( channel => $channel, me => 0, nick => $nick, message => $msg);
782                  meta( $nick, $channel, 'last-msg', $msg );                  meta( $nick, $channel, 'last-msg', $msg );
783                    rss_check_updates( $kernel );
784      },      },
785      irc_ctcp_action => sub {      irc_ctcp_action => sub {
786                  my $kernel = $_[KERNEL];                  my $kernel = $_[KERNEL];
# Line 652  POE::Session->create( inline_states => Line 801  POE::Session->create( inline_states =>
801    
802      },      },
803          irc_ping => sub {          irc_ping => sub {
804                  warn "pong ", $_[ARG0], $/;                  _log( "pong ", $_[ARG0] );
805                  $ping->{ $_[ARG0] }++;                  $_stat->{ping}->{ $_[ARG0] }++;
806                    rss_check_updates( $_[KERNEL] );
807          },          },
808          irc_invite => sub {          irc_invite => sub {
809                  my $kernel = $_[KERNEL];                  my $kernel = $_[KERNEL];
810                  my $nick = (split /!/, $_[ARG0])[0];                  my $nick = (split /!/, $_[ARG0])[0];
811                  my $channel = $_[ARG1];                  my $channel = $_[ARG1];
812    
813                  warn "invited to $channel by $nick";                  _log "invited to $channel by $nick";
814    
815                  $_[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..." );
816                  $_[KERNEL]->post($IRC_ALIAS => join => $channel);                  $_[KERNEL]->post( $irc => 'join' => $channel );
817    
818          },          },
819          irc_msg => sub {          irc_msg => sub {
# Line 671  POE::Session->create( inline_states => Line 821  POE::Session->create( inline_states =>
821                  my $nick = (split /!/, $_[ARG0])[0];                  my $nick = (split /!/, $_[ARG0])[0];
822                  my $msg = $_[ARG2];                  my $msg = $_[ARG2];
823                  my $channel = $_[ARG1]->[0];                  my $channel = $_[ARG1]->[0];
                 from_to($msg, 'UTF-8', $ENCODING);  
824    
825                  my $res = "unknown command '$msg', try /msg $NICK help!";                  my $res = "unknown command '$msg', try /msg $NICK help!";
826                  my @out;                  my @out;
# Line 682  POE::Session->create( inline_states => Line 831  POE::Session->create( inline_states =>
831    
832                          $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";
833    
834                  } elsif ($msg =~ m/^msg\s+(\S+)\s+(.*)$/i) {                  } elsif ($msg =~ m/^(privmsg|notice)\s+(\S+)\s+(.*)$/i) {
835    
836                          _log ">> /msg $1 $2";                          _log ">> /$1 $2 $3";
837                          $_[KERNEL]->post( $IRC_ALIAS => privmsg => $1, $2 );                          $_[KERNEL]->post( $irc => $1 => $2, $3 );
838                          $res = '';                          $res = '';
839    
840                  } elsif ($msg =~ m/^stat.*?\s*(\d*)/i) {                  } elsif ($msg =~ m/^stat.*?\s*(\d*)/i) {
# Line 715  POE::Session->create( inline_states => Line 864  POE::Session->create( inline_states =>
864    
865                          foreach my $res (get_from_log( limit => $limit )) {                          foreach my $res (get_from_log( limit => $limit )) {
866                                  _log "last: $res";                                  _log "last: $res";
867                                  from_to($res, $ENCODING, 'UTF-8');                                  $_[KERNEL]->post( $irc => privmsg => $nick, $res );
                                 $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );  
868                          }                          }
869    
870                          $res = '';                          $res = '';
# Line 730  POE::Session->create( inline_states => Line 878  POE::Session->create( inline_states =>
878                                          search => $what,                                          search => $what,
879                                  )) {                                  )) {
880                                  _log "search [$what]: $res";                                  _log "search [$what]: $res";
881                                  from_to($res, $ENCODING, 'UTF-8');                                  $_[KERNEL]->post( $irc => privmsg => $nick, $res );
                                 $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );  
882                          }                          }
883    
884                          $res = '';                          $res = '';
# Line 766  POE::Session->create( inline_states => Line 913  POE::Session->create( inline_states =>
913                                  " : " . ( $stat->{vote}->{'-'} || 0 ) . " --" .                                  " : " . ( $stat->{vote}->{'-'} || 0 ) . " --" .
914                                  " from " . ( join(", ", @nicks) || 'nobody' );                                  " from " . ( join(", ", @nicks) || 'nobody' );
915    
916                          $_[KERNEL]->post( $IRC_ALIAS => notice => $nick, $res );                          $_[KERNEL]->post( $irc => notice => $nick, $res );
917    
918                  } elsif ($msg =~ m/^ping/) {                  } elsif ($msg =~ m/^ping/) {
919                          $res = "ping = " . dump( $ping );                          $res = "ping = " . dump( $_stat->{ping} );
920                  } elsif ($msg =~ m/^conf(?:ig)*\s*(last-size|twitter)*\s*(.*)/) {                  } elsif ($msg =~ m/^conf(?:ig)*\s*(last-size|twitter)*\s*(.*)/) {
921                          if ( ! defined( $1 ) ) {                          if ( ! defined( $1 ) ) {
922                                  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 800  POE::Session->create( inline_states => Line 947  POE::Session->create( inline_states =>
947                                          $res = "config option $op doesn't exist";                                          $res = "config option $op doesn't exist";
948                                  }                                  }
949                          }                          }
950                    } elsif ($msg =~ m/^rss-update/) {
951                            $res = rss_fetch_all( $_[KERNEL] );
952                    } elsif ($msg =~ m/^rss-clean/) {
953                            $_stat->{rss} = undef;
954                            $dbh->do( qq{ update feeds set last_update = now() - delay } );
955                            $res = "OK, cleaned RSS cache";
956                    } elsif ($msg =~ m/^rss-list/) {
957                            my $sth = $dbh->prepare(qq{ select url,name,last_update,active,channel,nick,private from feeds });
958                            $sth->execute;
959                            while (my @row = $sth->fetchrow_array) {
960                                    $_[KERNEL]->post( $irc => privmsg => $nick, join(' | ',@row) );
961                            }
962                            $res = '';
963                    } elsif ($msg =~ m!^rss-(add|remove|stop|start)(?:-(private))?\s+(http://\S+)\s*(.*)!) {
964                            my ( $command, $sub, $url, $arg ) = ( $1,$2,$3,$4 );
965    
966                            my $channel = $1 if ( $arg =~ s/\s*(#\S+)\s*// );
967                            $channel = $nick if $sub eq 'private';
968    
969                            my $sql = {
970                                    add     => qq{ insert into feeds (url,name,channel,nick,private) values (?,?,?,?,?) },
971    #                               remove  => qq{ delete from feeds                                where url = ? and name = ? },
972                                    start   => qq{ update feeds set active = true   where url = ? },
973                                    stop    => qq{ update feeds set active = false  where url = ? },
974                            };
975    
976                            if ( $command eq 'add' && ! $channel ) {
977                                    $res = "ERROR: got '$msg' which doesn't have #channel in it, ignoring!";
978                            } elsif (my $q = $sql->{$command} ) {
979                                    my $sth = $dbh->prepare( $q );
980                                    my @data = ( $url );
981                                    if ( $command eq 'add' ) {
982                                            push @data, ( $arg, $channel, $nick, $sub eq 'private' ? 1 : 0 );
983                                    }
984                                    warn "## $command SQL $q with ",dump( @data ),"\n";
985                                    eval { $sth->execute( @data ) };
986                                    if ($@) {
987                                            $res = "ERROR: $@";
988                                    } else {
989                                            $res = "OK, RSS [$command|$sub|$url|$arg]";
990                                    }
991                            } else {
992                                    $res = "ERROR: don't know what to do with: $msg";
993                            }
994                  }                  }
995    
996                  if ($res) {                  if ($res) {
997                          _log ">> [$nick] $res";                          _log ">> [$nick] $res";
998                          from_to($res, $ENCODING, 'UTF-8');                          $_[KERNEL]->post( $irc => privmsg => $nick, $res );
                         $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );  
999                  }                  }
1000    
1001                    rss_check_updates( $_[KERNEL] );
1002            },
1003            irc_372 => sub {
1004                    _log "<< motd",$_[ARG0],$_[ARG1];
1005            },
1006            irc_375 => sub {
1007                    _log "<< motd", $_[ARG0], "start";
1008            },
1009            irc_376 => sub {
1010                    _log "<< motd", $_[ARG0], "end";
1011          },          },
1012          irc_477 => sub {          irc_477 => sub {
1013                  _log "# irc_477: ",$_[ARG1];                  _log "<< irc_477: ",$_[ARG1];
1014                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "register $NICK" );                  $_[KERNEL]->post( $irc => privmsg => 'nickserv', "register $NICK" );
1015          },          },
1016          irc_505 => sub {          irc_505 => sub {
1017                  _log "# irc_505: ",$_[ARG1];                  _log "<< irc_505: ",$_[ARG1];
1018                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "register $NICK" );                  $_[KERNEL]->post( $irc => privmsg => 'nickserv', "register $NICK" );
1019  #               $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "set hide email on" );  #               $_[KERNEL]->post( $irc => privmsg => 'nickserv', "set hide email on" );
1020  #               $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "set email dpavlin\@rot13.org" );  #               $_[KERNEL]->post( $irc => privmsg => 'nickserv', "set email dpavlin\@rot13.org" );
1021          },          },
1022          irc_registered => sub {          irc_registered => sub {
1023                  _log "## registrated $NICK";                  _log "<< registered $NICK";
                 $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "IDENTIFY $NICK" );  
1024          },          },
1025          irc_disconnected => sub {          irc_disconnected => sub {
1026                  _log "## disconnected, reconnecting again";                  _log "## disconnected.. sleeping for $sleep_on_error seconds and reconnecting again";
1027                  $_[KERNEL]->post($IRC_ALIAS => connect => $CONNECT);                  sleep($sleep_on_error);
1028                    $_[KERNEL]->post( $irc => connect => {} );
1029          },          },
1030          irc_socketerr => sub {          irc_socketerr => sub {
1031                  _log "## socket error... sleeping for $sleep_on_error seconds and retry";                  _log "## socket error... sleeping for $sleep_on_error seconds and retry";
1032                  sleep($sleep_on_error);                  sleep($sleep_on_error);
1033                  $_[KERNEL]->post($IRC_ALIAS => connect => $CONNECT);                  $_[KERNEL]->post( $irc => connect => {} );
1034          },          },
1035  #       irc_433 => sub {  #       irc_433 => sub {
1036  #               print "# irc_433: ",$_[ARG1], "\n";  #               print "# irc_433: ",$_[ARG1], "\n";
1037  #               warn "## indetify $NICK\n";  #               warn "## indetify $NICK\n";
1038  #               $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "IDENTIFY $NICK" );  #               $_[KERNEL]->post( $irc => privmsg => 'nickserv', "IDENTIFY $NICK" );
1039  #       },  #       },
1040    #       irc_451 # please register
1041            irc_notice => sub {
1042                    _log "<< notice",$_[ARG0];
1043                    if ( $_[ARG0] =~ m!/msg\s+NickServ\s+IDENTIFY!i ) {
1044                            $_[KERNEL]->post( $irc => privmsg => 'nickserv', "IDENTIFY $NICK" );
1045                    }
1046            },
1047            irc_snotice => sub {
1048                    _log "<< snotice",$_[ARG0];
1049                    if ( $_[ARG0] =~ m!/(QUOTE)\s+(PASS\s+\d+)!i ) {
1050                            warn ">> $1 | $2\n";
1051                            $_[KERNEL]->post( $irc => lc($1) => $2);
1052                    }
1053            },
1054      _child => sub {},      _child => sub {},
1055      _default => sub {      _default => sub {
1056                  _log sprintf "sID:%s %s %s",                  _log sprintf "sID:%s %s %s",
# Line 846  POE::Session->create( inline_states => Line 1060  POE::Session->create( inline_states =>
1060                          "";                          "";
1061        0;                        # false for signals        0;                        # false for signals
1062      },      },
     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);  
     }  
1063     },     },
1064    );    );
1065    
# Line 913  POE::Session->create( inline_states => Line 1067  POE::Session->create( inline_states =>
1067    
1068  my $httpd = POE::Component::Server::HTTP->new(  my $httpd = POE::Component::Server::HTTP->new(
1069          Port => $http_port,          Port => $http_port,
1070            PreHandler => {
1071                    '/' => sub {
1072                            $_[0]->header(Connection => 'close')
1073                    }
1074            },
1075          ContentHandler => { '/' => \&root_handler },          ContentHandler => { '/' => \&root_handler },
1076          Headers        => { Server => 'irc-logger' },          Headers        => { Server => 'irc-logger' },
1077  );  );
# Line 958  sub root_handler { Line 1117  sub root_handler {
1117          my ($request, $response) = @_;          my ($request, $response) = @_;
1118          $response->code(RC_OK);          $response->code(RC_OK);
1119    
1120            # this doesn't seem to work, so moved to PreHandler
1121            #$response->header(Connection => 'close');
1122    
1123            return RC_OK if $request->uri =~ m/favicon.ico$/;
1124    
1125          my $q;          my $q;
1126    
1127          if ( $request->method eq 'POST' ) {          if ( $request->method eq 'POST' ) {
# Line 969  sub root_handler { Line 1133  sub root_handler {
1133          }          }
1134    
1135          my $search = $q->param('search') || $q->param('grep') || '';          my $search = $q->param('search') || $q->param('grep') || '';
1136            my $r_url = $request->url;
1137    
1138            my @commands = qw( tags last-tag follow stat );
1139            my $commands_re = join('|',@commands);
1140    
1141            if ($r_url =~ m#/rss(?:/($commands_re.*)\w*(?:=(\d+))?)?#i) {
1142                    my $show = lc($1);
1143                    my $nr = $2;
1144    
         if ($request->url =~ m#/rss#i) {  
1145                  my $type = 'RSS';       # Atom                  my $type = 'RSS';       # Atom
1146    
1147                  $response->content_type( 'application/' . lc($type) . '+xml' );                  $response->content_type( 'application/' . lc($type) . '+xml' );
1148    
1149                  my $html = '<!-- error -->';                  my $html = '<!-- error -->';
1150                  warn "create $type feed from ",dump( @last_tags );                  #warn "create $type feed from ",dump( @last_tags );
1151    
1152                  my $feed = XML::Feed->new( $type );                  my $feed = XML::Feed->new( $type );
1153                    $feed->link( $url );
1154    
1155                  $feed->title( "last $last_x_tags from $CHANNEL" );                  my $rc = RC_OK;
1156  #               $feed->link( "http://$http_hostname:$http_port" );  
1157                  $feed->description( "collects messages which have tags// in them" );                  if ( $show eq 'tags' ) {
1158                            $nr ||= 50;
1159                  foreach my $m ( @last_tags ) {                          $feed->title( "tags from $CHANNEL" );
1160                          warn dump( $m );                          $feed->link( "$url/tags" );
1161                          #my $tags = join(' ', @{$m->{tags}} );                          $feed->description( "tag cloud created from messages on channel $CHANNEL which have tags// in them" );
1162                          my $feed_entry = XML::Feed::Entry->new($type);                          my $feed_entry = XML::Feed::Entry->new($type);
1163                          $feed_entry->title( $m->{nick} . '@' . $m->{time} );                          $feed_entry->title( "$nr tags from $CHANNEL" );
1164                          $feed_entry->author( $m->{nick} );                          $feed_entry->author( $NICK );
1165  #                       $feed_entry->link(  );                          $feed_entry->link( '/#tags'  );
1166                          $feed_entry->issued( DateTime::Format::Flexible->build( $m->{time} ) );  
1167                          $feed_entry->summary(                          $feed_entry->content(
1168                                  '<![CDATA[' .                                  qq{<![CDATA[<style type="text/css">}
1169  #                               $filter->{nick}->( $m->{nick} ) .                                  . $cloud->css
1170  #                               '<tt>' . $m->{nick} . '</tt> ' .                                  . qq{</style>}
1171                                  $filter->{message}->( $m->{message} ) .                                  . $cloud->html( $nr )
1172                                  ']]>'                                  . qq{]]>}
1173                          );                          );
                         $feed_entry->category( join(', ', @{$m->{tags}}) );  
1174                          $feed->add_entry( $feed_entry );                          $feed->add_entry( $feed_entry );
1175    
1176                    } elsif ( $show eq 'last-tag' ) {
1177    
1178                            $nr ||= $last_x_tags;
1179                            $nr = $last_x_tags if $nr > $last_x_tags;
1180    
1181                            $feed->title( "last $nr tagged messages from $CHANNEL" );
1182                            $feed->description( "collects messages which have tags// in them" );
1183    
1184                            foreach my $m ( @last_tags ) {
1185    #                               warn dump( $m );
1186                                    #my $tags = join(' ', @{$m->{tags}} );
1187                                    my $feed_entry = XML::Feed::Entry->new($type);
1188                                    $feed_entry->title( $m->{nick} . '@' . $m->{time} );
1189                                    $feed_entry->author( $m->{nick} );
1190                                    $feed_entry->link( '/#' . $m->{id}  );
1191                                    $feed_entry->issued( DateTime::Format::Flexible->build( $m->{time} ) );
1192    
1193                                    my $message = $filter->{message}->( $m->{message} );
1194                                    $message .= "<br/>\n" unless $message =~ m!<(/p|br/?)>!;
1195    #                               warn "## message = $message\n";
1196    
1197                                    #$feed_entry->summary(
1198                                    $feed_entry->content(
1199                                            "<![CDATA[$message]]>"
1200                                    );
1201                                    $feed_entry->category( join(', ', @{$m->{tags}}) );
1202                                    $feed->add_entry( $feed_entry );
1203    
1204                                    $nr--;
1205                                    last if $nr <= 0;
1206    
1207                            }
1208    
1209                    } elsif ( $show =~ m/^follow/ ) {
1210    
1211                            $feed->title( "Feeds which this bot follows" );
1212    
1213                            my $sth = $dbh->prepare( qq{ select * from feeds order by last_update desc } );
1214                            $sth->execute;
1215                            while (my $row = $sth->fetchrow_hashref) {
1216                                    my $feed_entry = XML::Feed::Entry->new($type);
1217                                    $feed_entry->title( $row->{name} );
1218                                    $feed_entry->link( $row->{url}  );
1219                                    $feed_entry->issued( DateTime::Format::Flexible->build( $row->{last_update} ) );
1220                                    $feed_entry->content(
1221                                            '<![CDATA[<pre>' . dump( $row ) . '</pre>]]>'
1222                                    );
1223                                    $feed->add_entry( $feed_entry );
1224                            }
1225    
1226                    } elsif ( $show =~ m/^stat/ ) {
1227    
1228                            my $feed_entry = XML::Feed::Entry->new($type);
1229                            $feed_entry->title( "Internal stats" );
1230                            $feed_entry->content(
1231                                    '<![CDATA[<pre>' . dump( $_stat ) . '</pre>]]>'
1232                            );
1233                            $feed->add_entry( $feed_entry );
1234    
1235                    } else {
1236                            _log "unknown rss request $r_url";
1237                            $feed->title( "unknown $r_url" );
1238                            foreach my $c ( @commands ) {
1239                                    my $feed_entry = XML::Feed::Entry->new($type);
1240                                    $feed_entry->title( "rss/$c" );
1241                                    $feed_entry->link( "$url/rss/$c" );
1242                                    $feed->add_entry( $feed_entry );
1243                            }
1244                            $rc = RC_DENY;
1245                  }                  }
1246    
1247                  $response->content( $feed->as_xml );                  $response->content( $feed->as_xml );
1248                  return RC_OK;                  return $rc;
1249          }          }
1250    
1251          if ( $@ ) {          if ( $@ ) {
1252                  warn "$@";                  warn "$@";
1253          }          }
1254    
1255          $response->content_type("text/html; charset=$ENCODING");          $response->content_type("text/html; charset=UTF-8");
1256    
1257          my $html =          my $html =
1258                  qq{<html><head><title>$NICK</title><style type="text/css">$style} .                  qq{<html><head><title>$NICK</title><style type="text/css">$style}
1259                  $cloud->css .                  . $cloud->css
1260                  qq{</style></head><body>} .                  . qq{</style></head><body>}
1261                  qq{                  . qq{
1262                  <form method="post" class="search" action="/">                  <form method="post" class="search" action="/">
1263                  <input type="text" name="search" value="$search" size="10">                  <input type="text" name="search" value="$search" size="10">
1264                  <input type="submit" value="search">                  <input type="submit" value="search">
1265                  </form>                  </form>
1266                  } .                  }
1267                  $cloud->html(500) .                  . $cloud->html(500)
1268                  qq{<p>};                  . qq{<p>};
1269          if ($request->url =~ m#/history#) {  
1270            if ($request->url =~ m#/tags?#) {
1271                    # nop
1272            } elsif ($request->url =~ m#/history#) {
1273                  my $sth = $dbh->prepare(qq{                  my $sth = $dbh->prepare(qq{
1274                          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
1275                                  from log                                  from log
# Line 1057  sub root_handler { Line 1301  sub root_handler {
1301                                  $cal->weekdays('MON','TUE','WED','THU','FRI');                                  $cal->weekdays('MON','TUE','WED','THU','FRI');
1302                                  ($l_yyyy,$l_mm) = ($yyyy,$mm);                                  ($l_yyyy,$l_mm) = ($yyyy,$mm);
1303                          }                          }
1304                          $cal->setcontent($dd, qq{                          $cal->setcontent($dd, qq[
1305                                  <a href="/?date=$row->{date}">$row->{nr}</a><br/>$row->{len}                                  <a href="$url?date=$row->{date}">$row->{nr}</a><br/>$row->{len}
1306                          });                          ]) if $cal;
1307                                                    
1308                  }                  }
1309                  $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 1074  sub root_handler { Line 1318  sub root_handler {
1318                                  fmt => {                                  fmt => {
1319                                          date => sub {                                          date => sub {
1320                                                  my $date = shift || return;                                                  my $date = shift || return;
1321                                                  qq{<hr/><div class="date"><a href="/?date=$date">$date</a></div>};                                                  qq{<hr/><div class="date"><a href="$url?date=$date">$date</a></div>};
1322                                          },                                          },
1323                                          time => '<span class="time">%s</span> ',                                          time => '<span class="time">%s</span> ',
1324                                          time_channel => '<span class="channel">%s %s</span> ',                                          time_channel => '<span class="channel">%s %s</span> ',
# Line 1093  sub root_handler { Line 1337  sub root_handler {
1337          </body></html>};          </body></html>};
1338    
1339          $response->content( $html );          $response->content( $html );
1340            warn "<< ", $request->method, " ", $request->uri, " created ", length($html), " bytes\n";
1341          return RC_OK;          return RC_OK;
1342  }  }
1343    
Legend:
Removed from v.72  
changed lines
  Added in v.112
  ViewVC Help
Powered by ViewVC 1.1.26