/[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 52 by dpavlin, Sun Mar 18 16:45:18 2007 UTC revision 99 by dpavlin, Fri Mar 7 17:13:30 2008 UTC
# Line 20  Import log from C<dircproxy> to C<irc-lo Line 20  Import log from C<dircproxy> to C<irc-lo
20    
21  =item --log=irc-logger.log  =item --log=irc-logger.log
22    
 Name of log file  
   
23  =back  =back
24    
25  =head1 DESCRIPTION  =head1 DESCRIPTION
# Line 32  log all conversation on irc channel Line 30  log all conversation on irc channel
30    
31  ## CONFIG  ## CONFIG
32    
33  my $HOSTNAME = `hostname`;  my $HOSTNAME = `hostname -f`;
34    chomp($HOSTNAME);
35    
36  my $NICK = 'irc-logger';  my $NICK = 'irc-logger';
37  $NICK .= '-dev' if ($HOSTNAME =~ m/llin/);  $NICK .= '-dev' if ($HOSTNAME =~ m/llin/);
# Line 45  my $CHANNEL = '#razmjenavjestina'; Line 44  my $CHANNEL = '#razmjenavjestina';
44  $CHANNEL = '#irc-logger' if ($HOSTNAME =~ m/llin/);  $CHANNEL = '#irc-logger' if ($HOSTNAME =~ m/llin/);
45  my $IRC_ALIAS = "log";  my $IRC_ALIAS = "log";
46    
 my %FOLLOWS =  
   (  
    ACCESS => "/var/log/apache/access.log",  
    ERROR => "/var/log/apache/error.log",  
   );  
   
47  my $DSN = 'DBI:Pg:dbname=' . $NICK;  my $DSN = 'DBI:Pg:dbname=' . $NICK;
48    
 my $ENCODING = 'ISO-8859-2';  
49  my $TIMESTAMP = '%Y-%m-%d %H:%M:%S';  my $TIMESTAMP = '%Y-%m-%d %H:%M:%S';
50    
51  my $sleep_on_error = 5;  my $sleep_on_error = 5;
52    
53  ## END CONFIG  # number of last tags to keep in circular buffer
54    my $last_x_tags = 50;
55    
56    # don't pull rss feeds more often than this
57    my $rss_min_delay = 60;
58    
59    my $http_port = $NICK =~ m/-dev/ ? 8001 : 8000;
60    
61    my $url = "http://$HOSTNAME:$http_port";
62    
63  use POE qw(Component::IRC Wheel::FollowTail Component::Server::HTTP);  ## END CONFIG
64    
65    use POE qw(Component::IRC Component::Server::HTTP);
66  use HTTP::Status;  use HTTP::Status;
67  use DBI;  use DBI;
 use Encode qw/from_to is_utf8/;  
68  use Regexp::Common qw /URI/;  use Regexp::Common qw /URI/;
69  use CGI::Simple;  use CGI::Simple;
70  use HTML::TagCloud;  use HTML::TagCloud;
# Line 73  use POSIX qw/strftime/; Line 72  use POSIX qw/strftime/;
72  use HTML::CalendarMonthSimple;  use HTML::CalendarMonthSimple;
73  use Getopt::Long;  use Getopt::Long;
74  use DateTime;  use DateTime;
75    use URI::Escape;
76  use Data::Dump qw/dump/;  use Data::Dump qw/dump/;
77    use DateTime::Format::ISO8601;
78    use Carp qw/confess/;
79    use XML::Feed;
80    use DateTime::Format::Flexible;
81    
82    my $use_twitter = 1;
83    eval { require Net::Twitter; };
84    $use_twitter = 0 if ($@);
85    
86  my $import_dircproxy;  my $import_dircproxy;
87  my $log_path;  my $log_path;
# Line 82  GetOptions( Line 90  GetOptions(
90          'log:s' => \$log_path,          'log:s' => \$log_path,
91  );  );
92    
93    #$SIG{__DIE__} = sub {
94    #       confess "fatal error";
95    #};
96    
97  open(STDOUT, '>', $log_path) || warn "can't redirect log to $log_path: $!";  open(STDOUT, '>', $log_path) || warn "can't redirect log to $log_path: $!";
98    
99  sub _log {  sub _log {
100          print strftime($TIMESTAMP,localtime()), ' ', join(" ",@_), $/;          print strftime($TIMESTAMP,localtime()) . ' ' . join(" ",@_) . $/;
101  }  }
102    
103    # HTML formatters
104    
105    my %escape = ('<'=>'&lt;', '>'=>'&gt;', '&'=>'&amp;', '"'=>'&quot;');
106    my $escape_re  = join '|' => keys %escape;
107    
108    my $tag_regex = '\b([\w-_]+)//';
109    
110    my %nick_enumerator;
111    my $max_color = 0;
112    
113    my $filter = {
114            message => sub {
115                    my $m = shift || return;
116    
117                    # protect HTML from wiki modifications
118                    sub e {
119                            my $t = shift;
120                            return 'uri_unescape{' . uri_escape($t, '^a-zA-Z0-9') . '}';
121                    }
122    
123                    $m =~ s/($escape_re)/$escape{$1}/gs;
124                    $m =~ s#($RE{URI}{HTTP})#e(qq{<a href="$1">$1</a>})#egs;
125                    $m =~ s#\/(\w+)\/#<i>$1</i>#gs;
126                    $m =~ s#$tag_regex#e(qq{<a href="$url?tag=$1" class="tag">$1</a>})#egs;
127                    $m =~ s#\*(\w+)\*#<b>$1</b>#gs;
128                    $m =~ s#_(\w+)_#<u>$1</u>#gs;
129    
130                    $m =~ s#uri_unescape{([^}]+)}#uri_unescape($1)#egs;
131                    return $m;
132            },
133            nick => sub {
134                    my $n = shift || return;
135                    if (! $nick_enumerator{$n})  {
136                            my $max = scalar keys %nick_enumerator;
137                            $nick_enumerator{$n} = $max + 1;
138                    }
139                    return '<span class="nick col-' .
140                            ( $nick_enumerator{$n} % $max_color ) .
141                            '">' . $n . '</span>';
142            },
143    };
144    
145  my $dbh = DBI->connect($DSN,"","", { RaiseError => 1, AutoCommit => 1 }) || die $DBI::errstr;  my $dbh = DBI->connect($DSN,"","", { RaiseError => 1, AutoCommit => 1 }) || die $DBI::errstr;
146    $dbh->do( qq{ set client_encoding = 'UTF-8' } );
147    
148  my $sql_schema = {  my $sql_schema = {
149          log => '          log => qq{
150  create table log (  create table log (
151          id serial,          id serial,
152          time timestamp default now(),          time timestamp default now(),
# Line 105  create table log ( Line 160  create table log (
160  create index log_time on log(time);  create index log_time on log(time);
161  create index log_channel on log(channel);  create index log_channel on log(channel);
162  create index log_nick on log(nick);  create index log_nick on log(nick);
163          ',          },
164          meta => '          meta => q{
165  create table meta (  create table meta (
166          nick text not null,          nick text not null,
167          channel text not null,          channel text not null,
168          name text not null,          name text not null,
169          value text,          value text,
170          changed timestamp default now(),          changed timestamp default 'now()',
171          primary key(nick,channel,name)          primary key(nick,channel,name)
172  );  );
173          ',          },
174            feeds => qq{
175    create table feeds (
176            id serial,
177            url text not null,
178            name text,
179            delay interval not null default '5 min',
180            active boolean default true,
181            channel text not null,
182            nick text not null,
183            private boolean default false,
184            last_update timestamp default 'now()',
185            polls int default 0,
186            updates int default 0
187    );
188    create unique index feeds_url on feeds(url);
189    insert into feeds (url,name,channel,nick) values ('http://wiki.razmjenavjestina.org/feed/workspace/razmjenavjestina?category=Recent%20Changes','wiki','$CHANNEL','dpavlin');
190            },
191  };  };
192    
193  foreach my $table ( keys %$sql_schema ) {  foreach my $table ( keys %$sql_schema ) {
# Line 158  sub meta { Line 230  sub meta {
230                  if ( $@ || ! $sth->rows ) {                  if ( $@ || ! $sth->rows ) {
231                          $sth = $dbh->prepare(qq{ insert into meta (value,nick,channel,name,changed) values (?,?,?,?,now()) });                          $sth = $dbh->prepare(qq{ insert into meta (value,nick,channel,name,changed) values (?,?,?,?,now()) });
232                          $sth->execute( $value, $nick, $channel, $name );                          $sth->execute( $value, $nick, $channel, $name );
233                          _log "created $nick/$channel/$name = $value";                          warn "## created $nick/$channel/$name = $value\n";
234                  } else {                  } else {
235                          _log "updated $nick/$channel/$name = $value ";                          warn "## updated $nick/$channel/$name = $value\n";
236                  }                  }
237    
238                  return $value;                  return $value;
# Line 170  sub meta { Line 242  sub meta {
242                  my $sth = $dbh->prepare(qq{ select value,changed from meta where nick = ? and channel = ? and name = ? });                  my $sth = $dbh->prepare(qq{ select value,changed from meta where nick = ? and channel = ? and name = ? });
243                  $sth->execute( $nick, $channel, $name );                  $sth->execute( $nick, $channel, $name );
244                  my ($v,$c) = $sth->fetchrow_array;                  my ($v,$c) = $sth->fetchrow_array;
245                  _log "fetched $nick/$channel/$name = $v [$c]";                  warn "## fetched $nick/$channel/$name = $v [$c]\n";
246                  return ($v,$c) if wantarray;                  return ($v,$c) if wantarray;
247                  return $v;                  return $v;
248    
# Line 179  sub meta { Line 251  sub meta {
251    
252    
253    
254  my $sth = $dbh->prepare(qq{  my $sth_insert_log = $dbh->prepare(qq{
255  insert into log  insert into log
256          (channel, me, nick, message, time)          (channel, me, nick, message, time)
257  values (?,?,?,?,?)  values (?,?,?,?,?)
# Line 187  values (?,?,?,?,?) Line 259  values (?,?,?,?,?)
259    
260    
261  my $tags;  my $tags;
 my $tag_regex = '\b([\w-_]+)//';  
262    
263  =head2 get_from_log  =head2 get_from_log
264    
# Line 224  C<me>, C<nick> and C<message> keys. Line 295  C<me>, C<nick> and C<message> keys.
295  sub get_from_log {  sub get_from_log {
296          my $args = {@_};          my $args = {@_};
297    
298          $args->{fmt} ||= {          if ( ! $args->{fmt} ) {
299                  date => '[%s] ',                  $args->{fmt} = {
300                  time => '{%s} ',                          date => '[%s] ',
301                  time_channel => '{%s %s} ',                          time => '{%s} ',
302                  nick => '%s: ',                          time_channel => '{%s %s} ',
303                  me_nick => '***%s ',                          nick => '%s: ',
304                  message => '%s',                          me_nick => '***%s ',
305          };                          message => '%s',
306                    };
307            }
308    
309          my $sql_message = qq{          my $sql_message = qq{
310                  select                  select
# Line 254  sub get_from_log { Line 327  sub get_from_log {
327    
328          my $sql = $context ? $sql_context : $sql_message;          my $sql = $context ? $sql_context : $sql_message;
329    
330          $sql .= " where message ilike ? or nick ilike ? " if ($args->{search});          sub check_date {
331          $sql .= " where id in (" . join(",", @{ $tags->{ $args->{tag} } }) . ") " if ($args->{tag} && $tags->{ $args->{tag} });                  my $date = shift || return;
332          $sql .= " where date(time) = ? " if ($args->{date});                  my $new_date = eval { DateTime::Format::ISO8601->parse_datetime( $date )->ymd; };
333          $sql .= " order by log.time desc";                  if ( $@ ) {
334          $sql .= " limit " . $args->{limit} if ($args->{limit});                          warn "invalid date $date\n";
335                            $new_date = DateTime->now->ymd;
336                    }
337                    return $new_date;
338            }
339    
340            my @where;
341            my @args;
342    
         my $sth = $dbh->prepare( $sql );  
343          if (my $search = $args->{search}) {          if (my $search = $args->{search}) {
344                  $search =~ s/^\s+//;                  $search =~ s/^\s+//;
345                  $search =~ s/\s+$//;                  $search =~ s/\s+$//;
346                  $sth->execute( ( '%' . $search . '%' ) x 2 );                  push @where, 'message ilike ? or nick ilike ?';
347                  _log "search for '$search' returned ", $sth->rows, " results ", $context || '';                  push @args, ( ( '%' . $search . '%' ) x 2 );
348          } elsif (my $tag = $args->{tag}) {                  _log "search for '$search'";
349                  $sth->execute();          }
350                  _log "tag '$tag' returned ", $sth->rows, " results ", $context || '';  
351          } elsif (my $date = $args->{date}) {          if ($args->{tag} && $tags->{ $args->{tag} }) {
352                  $sth->execute($date);                  push @where, 'id in (' . join(',', @{ $tags->{ $args->{tag} } }) . ')';
353                  _log "found ", $sth->rows, " messages for date $date ", $context || '';                  _log "search for tags $args->{tag}";
         } else {  
                 $sth->execute();  
354          }          }
355    
356            if (my $date = $args->{date} ) {
357                    $date = check_date( $date );
358                    push @where, 'date(time) = ?';
359                    push @args, $date;
360                    _log "search for date $date";
361            }
362    
363            $sql .= " where " . join(" and ", @where) if @where;
364    
365            $sql .= " order by log.time desc";
366            $sql .= " limit " . $args->{limit} if ($args->{limit});
367    
368            #warn "### sql: $sql ", dump( @args );
369    
370            my $sth = $dbh->prepare( $sql );
371            eval { $sth->execute( @args ) };
372            return if $@;
373    
374          my $last_row = {          my $last_row = {
375                  date => '',                  date => '',
376                  time => '',                  time => '',
# Line 395  my $cloud = HTML::TagCloud->new; Line 491  my $cloud = HTML::TagCloud->new;
491    
492  =head2 add_tag  =head2 add_tag
493    
494   add_tag( id => 42, message => 'irc message' );   add_tag( id => 42, message => 'irc message', nick => 'foobar' [, me => 1 ] );
495    
496  =cut  =cut
497    
498    my @last_tags;
499    
500  sub add_tag {  sub add_tag {
501          my $arg = {@_};          my $arg = {@_};
502    
503          return unless ($arg->{id} && $arg->{message});          return unless ($arg->{id} && $arg->{message});
504    
505          my $m = $arg->{message};          my $m = $arg->{message};
506          from_to('UTF-8', 'iso-8859-2', $m) if (is_utf8($m));  
507            my @tags;
508    
509          while ($m =~ s#$tag_regex##s) {          while ($m =~ s#$tag_regex##s) {
510                  my $tag = $1;                  my $tag = $1;
511                  next if (! $tag || $tag =~ m/https?:/i);                  next if (! $tag || $tag =~ m/https?:/i);
512                  push @{ $tags->{$tag} }, $arg->{id};                  push @{ $tags->{$tag} }, $arg->{id};
513                  #warn "+tag $tag: $arg->{id}\n";                  #warn "+tag $tag: $arg->{id}\n";
514                  $cloud->add($tag, "?tag=$tag", scalar @{$tags->{$tag}} + 1);                  $cloud->add($tag, "$url?tag=$tag", scalar @{$tags->{$tag}} + 1);
515                    push @tags, $tag;
516    
517            }
518    
519            if ( @tags ) {
520                    pop @last_tags if $#last_tags == $last_x_tags;
521                    unshift @last_tags, { tags => [ @tags ], %$arg };
522          }          }
523    
524  }  }
525    
526  =head2 seed_tags  =head2 seed_tags
# Line 423  Read all tags from database and create i Line 530  Read all tags from database and create i
530  =cut  =cut
531    
532  sub seed_tags {  sub seed_tags {
533          my $sth = $dbh->prepare(qq{ select id,message 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 });
534          $sth->execute;          $sth->execute;
535          while (my $row = $sth->fetchrow_hashref) {          while (my $row = $sth->fetchrow_hashref) {
536                  add_tag( %$row );                  add_tag( %$row );
537          }          }
538    
539          foreach my $tag (keys %$tags) {          foreach my $tag (keys %$tags) {
540                  $cloud->add($tag, "?tag=$tag", scalar @{$tags->{$tag}} + 1);                  $cloud->add($tag, "$url?tag=$tag", scalar @{$tags->{$tag}} + 1);
541          }          }
542  }  }
543    
# Line 443  seed_tags; Line 550  seed_tags;
550          channel => '#foobar',          channel => '#foobar',
551          me => 0,          me => 0,
552          nick => 'dpavlin',          nick => 'dpavlin',
553          msg => 'test message',          message => 'test message',
554          time => '2006-06-25 18:57:18',          time => '2006-06-25 18:57:18',
555    );    );
556    
# Line 455  C<me> if not specified will be C<0> (not Line 562  C<me> if not specified will be C<0> (not
562    
563  sub save_message {  sub save_message {
564          my $a = {@_};          my $a = {@_};
565            confess "have msg" if $a->{msg};
566          $a->{me} ||= 0;          $a->{me} ||= 0;
567          $a->{time} ||= strftime($TIMESTAMP,localtime());          $a->{time} ||= strftime($TIMESTAMP,localtime());
568    
569          _log          _log
570                  $a->{channel}, " ",                  $a->{channel}, " ",
571                  $a->{me} ? "***" . $a->{nick} : "<" . $a->{nick} . ">",                  $a->{me} ? "***" . $a->{nick} : "<" . $a->{nick} . ">",
572                  " " . $a->{msg};                  " " . $a->{message};
   
         from_to($a->{msg}, 'UTF-8', $ENCODING);  
573    
574          $sth->execute($a->{channel}, $a->{me}, $a->{nick}, $a->{msg}, $a->{time});          $sth_insert_log->execute($a->{channel}, $a->{me}, $a->{nick}, $a->{message}, $a->{time});
575          add_tag( id => $dbh->last_insert_id(undef,undef,"log",undef),          add_tag( id => $dbh->last_insert_id(undef,undef,"log",undef), %$a );
                 message => $a->{msg});  
576  }  }
577    
578    
579  if ($import_dircproxy) {  if ($import_dircproxy) {
580          open(my $l, $import_dircproxy) || die "can't open $import_dircproxy: $!";          open(my $l, $import_dircproxy) || die "can't open $import_dircproxy: $!";
581          warn "importing $import_dircproxy...\n";          warn "importing $import_dircproxy...\n";
582          my $tz_offset = 2 * 60 * 60;    # TZ GMT+2          my $tz_offset = 1 * 60 * 60;    # TZ GMT+2
583          while(<$l>) {          while(<$l>) {
584                  chomp;                  chomp;
585                  if (/^@(\d+)\s(\S+)\s(.+)$/) {                  if (/^@(\d+)\s(\S+)\s(.+)$/) {
# Line 492  if ($import_dircproxy) { Line 597  if ($import_dircproxy) {
597                                  channel => $CHANNEL,                                  channel => $CHANNEL,
598                                  me => $me,                                  me => $me,
599                                  nick => $nick,                                  nick => $nick,
600                                  msg => $msg,                                  message => $msg,
601                                  time => $dt->ymd . " " . $dt->hms,                                  time => $dt->ymd . " " . $dt->hms,
602                          ) if ($nick !~ m/^-/);                          ) if ($nick !~ m/^-/);
603    
# Line 505  if ($import_dircproxy) { Line 610  if ($import_dircproxy) {
610          exit;          exit;
611  }  }
612    
613    #
614    # RSS follow
615    #
616    
617    my $_rss;
618    
619    
620    sub rss_fetch {
621            my ($args) = @_;
622    
623            # how many messages to send out when feed is seen for the first time?
624            my $send_rss_msgs = 1;
625    
626            _log "RSS fetch", $args->{url};
627    
628            my $feed = XML::Feed->parse(URI->new( $args->{url} ));
629            if ( ! $feed ) {
630                    _log("can't fetch RSS ", $args->{url});
631                    return;
632            }
633    
634            my ( $total, $updates ) = ( 0, 0 );
635            for my $entry ($feed->entries) {
636                    $total++;
637    
638                    # seen allready?
639                    next if $_rss->{$args->{channel}}->{$feed->link}->{$entry->id}++ > 0;
640    
641                    sub prefix {
642                            my ($txt,$var) = @_;
643                            $var =~ s/\s+/ /gs;
644                            $var =~ s/^\s+//g;
645                            $var =~ s/\s+$//g;
646                            return $txt . $var if $var;
647                    }
648    
649                    # fix absolute and relative links to feed entries
650                    my $link = $entry->link;
651                    if ( $link =~ m!^/! ) {
652                            my $host = $args->{url};
653                            $host =~ s!^(http://[^/]+).*$!$1!;      #!vim
654                            $link = "$host/$link";
655                    } elsif ( $link !~ m!^http! ) {
656                            $link = $args->{url} . $link;
657                    }
658                    $link =~ s!//+!/!g;
659    
660                    my $msg;
661                    $msg .= prefix( 'From: ' , $args->{name} || $feed->title );
662                    $msg .= prefix( ' by ' , $entry->author );
663                    $msg .= prefix( ' | ' , $entry->title );
664                    $msg .= prefix( ' | ' , $link );
665    #               $msg .= prefix( ' id ' , $entry->id );
666    
667                    if ( $args->{kernel} && $send_rss_msgs ) {
668                            $send_rss_msgs--;
669                            $sth_insert_log->execute( $args->{channel}, 1, $NICK, $msg, 'now()' );
670                            my ( $type, $to ) = ( 'notice', $args->{channel} );
671                            ( $type, $to ) = ( 'privmsg', $args->{nick} ) if $args->{private};
672                            _log(">> $type $to |", $msg);
673                            $args->{kernel}->post( $IRC_ALIAS => $type => $to, $msg );
674                            $updates++;
675                    }
676            }
677    
678            my $sql = qq{ update feeds set last_update = now(), polls = polls + 1 };
679            $sql .= qq{, updates = updates + $updates } if $updates;
680            $sql .= qq{where id = } . $args->{id};
681            eval { $dbh->do( $sql ) };
682    
683            _log "RSS got $total items of which $updates new";
684    
685            return $updates;
686    }
687    
688    sub rss_fetch_all {
689            my $kernel = shift;
690            my $sql = qq{
691                    select id, url, name, channel, nick, private
692                    from feeds
693                    where active is true
694            };
695            # limit to newer feeds only if we are not sending messages out
696            $sql .= qq{     and last_update + delay < now() } if $kernel;
697            my $sth = $dbh->prepare( $sql );
698            $sth->execute();
699            warn "# ",$sth->rows," active RSS feeds\n";
700            my $count = 0;
701            while (my $row = $sth->fetchrow_hashref) {
702                    $row->{kernel} = $kernel if $kernel;
703                    $count += rss_fetch( $row );
704            }
705            return "OK, fetched $count posts from " . $sth->rows . " feeds";
706    }
707    
708    
709    sub rss_check_updates {
710            my $kernel = shift;
711            $_rss->{last_poll} ||= time();
712            my $dt = time() - $_rss->{last_poll};
713            warn "## rss_check_updates $dt > $rss_min_delay\n";
714            if ( $dt > $rss_min_delay ) {
715                    $_rss->{last_poll} = time();
716                    _log rss_fetch_all( $kernel );
717            }
718    }
719    
720    # seed rss seen cache so we won't send out all items on startup
721    _log rss_fetch_all;
722    
723  #  #
724  # POE handing part  # POE handing part
725  #  #
726    
 my $SKIPPING = 0;               # if skipping, how many we've done  
 my $SEND_QUEUE;                 # cache  
727  my $ping;                                               # ping stats  my $ping;                                               # ping stats
728    
729  POE::Component::IRC->new($IRC_ALIAS);  POE::Component::IRC->new($IRC_ALIAS);
730    
731  POE::Session->create( inline_states =>  POE::Session->create( inline_states => {
732     {_start => sub {                _start => sub {      
733                  $_[KERNEL]->post($IRC_ALIAS => register => 'all');                  $_[KERNEL]->post($IRC_ALIAS => register => 'all');
734                  $_[KERNEL]->post($IRC_ALIAS => connect => $CONNECT);                  $_[KERNEL]->post($IRC_ALIAS => connect => $CONNECT);
735      },      },
736      irc_255 => sub {    # server is done blabbing      irc_255 => sub {    # server is done blabbing
737                  $_[KERNEL]->post($IRC_ALIAS => join => $CHANNEL);                  $_[KERNEL]->post($IRC_ALIAS => join => $CHANNEL);
                 $_[KERNEL]->post($IRC_ALIAS => join => '#logger');  
                 $_[KERNEL]->yield("heartbeat"); # start heartbeat  
 #               $_[KERNEL]->yield("my_add", $_) for keys %FOLLOWS;  
738                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "IDENTIFY $NICK" );                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "IDENTIFY $NICK" );
739      },      },
740      irc_public => sub {      irc_public => sub {
# Line 534  POE::Session->create( inline_states => Line 743  POE::Session->create( inline_states =>
743                  my $channel = $_[ARG1]->[0];                  my $channel = $_[ARG1]->[0];
744                  my $msg = $_[ARG2];                  my $msg = $_[ARG2];
745    
746                  save_message( channel => $channel, me => 0, nick => $nick, msg => $msg);                  save_message( channel => $channel, me => 0, nick => $nick, message => $msg);
747                  meta( $nick, $channel, 'last-msg', $msg );                  meta( $nick, $channel, 'last-msg', $msg );
748                    rss_check_updates( $kernel );
749      },      },
750      irc_ctcp_action => sub {      irc_ctcp_action => sub {
751                  my $kernel = $_[KERNEL];                  my $kernel = $_[KERNEL];
# Line 543  POE::Session->create( inline_states => Line 753  POE::Session->create( inline_states =>
753                  my $channel = $_[ARG1]->[0];                  my $channel = $_[ARG1]->[0];
754                  my $msg = $_[ARG2];                  my $msg = $_[ARG2];
755    
756                  save_message( channel => $channel, me => 1, nick => $nick, msg => $msg);                  save_message( channel => $channel, me => 1, nick => $nick, message => $msg);
757    
758                  if ( my $twitter = ( $nick, $channel, 'twitter' ) ) {                  if ( $use_twitter ) {
759                          _log("FIXME: send twitter for $nick on $channel [$twitter]");                          if ( my $twitter = meta( $nick, $NICK, 'twitter' ) ) {
760                                    my ($login,$passwd) = split(/\s+/,$twitter,2);
761                                    _log("sending twitter for $nick/$login on $channel ");
762                                    my $bot = Net::Twitter->new( username=>$login, password=>$passwd );
763                                    $bot->update("<${channel}> $msg");
764                            }
765                  }                  }
766    
767      },      },
768          irc_ping => sub {          irc_ping => sub {
769                  warn "pong ", $_[ARG0], $/;                  _log( "pong ", $_[ARG0] );
770                  $ping->{ $_[ARG0] }++;                  $ping->{ $_[ARG0] }++;
771                    rss_check_updates( $_[KERNEL] );
772          },          },
773          irc_invite => sub {          irc_invite => sub {
774                  my $kernel = $_[KERNEL];                  my $kernel = $_[KERNEL];
775                  my $nick = (split /!/, $_[ARG0])[0];                  my $nick = (split /!/, $_[ARG0])[0];
776                  my $channel = $_[ARG1];                  my $channel = $_[ARG1];
777    
778                  warn "invited to $channel by $nick";                  _log "invited to $channel by $nick";
779    
780                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, "how nice of you to invite me to $channel, I'll be right there..." );                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, "how nice of you to invite me to $channel, I'll be right there..." );
781                  $_[KERNEL]->post($IRC_ALIAS => join => $channel);                  $_[KERNEL]->post($IRC_ALIAS => join => $channel);
# Line 570  POE::Session->create( inline_states => Line 786  POE::Session->create( inline_states =>
786                  my $nick = (split /!/, $_[ARG0])[0];                  my $nick = (split /!/, $_[ARG0])[0];
787                  my $msg = $_[ARG2];                  my $msg = $_[ARG2];
788                  my $channel = $_[ARG1]->[0];                  my $channel = $_[ARG1]->[0];
                 from_to($msg, 'UTF-8', $ENCODING);  
789    
790                  my $res = "unknown command '$msg', try /msg $NICK help!";                  my $res = "unknown command '$msg', try /msg $NICK help!";
791                  my @out;                  my @out;
# Line 593  POE::Session->create( inline_states => Line 808  POE::Session->create( inline_states =>
808    
809                          my $sth = $dbh->prepare(qq{                          my $sth = $dbh->prepare(qq{
810                                  select                                  select
811                                          nick,                                          trim(both '_' from nick) as nick,
812                                          count(*) as count,                                          count(*) as count,
813                                          sum(length(message)) as len                                          sum(length(message)) as len
814                                  from log                                  from log
815                                  group by nick                                  group by trim(both '_' from nick)
816                                  order by len desc,count desc                                  order by len desc,count desc
817                                  limit $nr                                  limit $nr
818                          });                          });
# Line 614  POE::Session->create( inline_states => Line 829  POE::Session->create( inline_states =>
829    
830                          foreach my $res (get_from_log( limit => $limit )) {                          foreach my $res (get_from_log( limit => $limit )) {
831                                  _log "last: $res";                                  _log "last: $res";
                                 from_to($res, $ENCODING, 'UTF-8');  
832                                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );                                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );
833                          }                          }
834    
# Line 629  POE::Session->create( inline_states => Line 843  POE::Session->create( inline_states =>
843                                          search => $what,                                          search => $what,
844                                  )) {                                  )) {
845                                  _log "search [$what]: $res";                                  _log "search [$what]: $res";
                                 from_to($res, $ENCODING, 'UTF-8');  
846                                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );                                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );
847                          }                          }
848    
# Line 699  POE::Session->create( inline_states => Line 912  POE::Session->create( inline_states =>
912                                          $res = "config option $op doesn't exist";                                          $res = "config option $op doesn't exist";
913                                  }                                  }
914                          }                          }
915                    } elsif ($msg =~ m/^rss-update/) {
916                            $res = rss_fetch_all( $_[KERNEL] );
917                    } elsif ($msg =~ m/^rss-clean/) {
918                            $_rss = undef;
919                            $dbh->do( qq{ update feeds set last_update = now() - delay } );
920                            $res = "OK, cleaned RSS cache";
921                    } elsif ($msg =~ m/^rss-list/) {
922                            my $sth = $dbh->prepare(qq{ select url,name,last_update,active,channel,nick,private from feeds });
923                            $sth->execute;
924                            while (my @row = $sth->fetchrow_array) {
925                                    $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, join(' | ',@row) );
926                            }
927                            $res = '';
928                    } elsif ($msg =~ m!^rss-(add|remove|stop|start)(?:-(private))?\s+(http://\S+)\s*(.*)!) {
929                            my ( $command, $sub, $url, $arg ) = ( $1,$2,$3,$4 );
930    
931                            my $channel = $1 if ( $arg =~ s/\s*(#\S+)\s*// );
932                            $channel = $nick if $sub eq 'private';
933    
934                            my $sql = {
935                                    add             => qq{ insert into feeds (url,name,channel,nick,private) values (?,?,?,?,?) },
936    #                               remove  => qq{ delete from feeds                                where url = ? and name = ? },
937                                    start   => qq{ update feeds set active = true   where url = ? },
938                                    stop    => qq{ update feeds set active = false  where url = ? },
939                            };
940    
941                            if ( $command eq 'add' && ! $channel ) {
942                                    $res = "ERROR: got '$msg' which doesn't have #channel in it, ignoring!";
943                            } elsif (my $q = $sql->{$command} ) {
944                                    my $sth = $dbh->prepare( $q );
945                                    my @data = ( $url );
946                                    if ( $command eq 'add' ) {
947                                            push @data, ( $arg, $channel, $nick, $sub eq 'private' ? 1 : 0 );
948                                    }
949                                    warn "## $command SQL $q with ",dump( @data ),"\n";
950                                    eval { $sth->execute( @data ) };
951                                    if ($@) {
952                                            $res = "ERROR: $@";
953                                    } else {
954                                            $res = "OK, RSS [$command|$sub|$url|$arg]";
955                                    }
956                            } else {
957                                    $res = "ERROR: don't know what to do with: $msg";
958                            }
959                  }                  }
960    
961                  if ($res) {                  if ($res) {
962                          _log ">> [$nick] $res";                          _log ">> [$nick] $res";
                         from_to($res, $ENCODING, 'UTF-8');  
963                          $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );                          $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );
964                  }                  }
965    
966                    rss_check_updates( $_[KERNEL] );
967          },          },
968          irc_477 => sub {          irc_477 => sub {
969                  _log "# irc_477: ",$_[ARG1];                  _log "# irc_477: ",$_[ARG1];
# Line 745  POE::Session->create( inline_states => Line 1002  POE::Session->create( inline_states =>
1002                          "";                          "";
1003        0;                        # false for signals        0;                        # false for signals
1004      },      },
     my_add => sub {  
       my $trailing = $_[ARG0];  
       my $session = $_[SESSION];  
       POE::Session->create  
           (inline_states =>  
            {_start => sub {  
               $_[HEAP]->{wheel} =  
                 POE::Wheel::FollowTail->new  
                     (  
                      Filename => $FOLLOWS{$trailing},  
                      InputEvent => 'got_line',  
                     );  
             },  
             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);  
     }  
1005     },     },
1006    );    );
1007    
1008  # http server  # http server
1009    
1010  my $httpd = POE::Component::Server::HTTP->new(  my $httpd = POE::Component::Server::HTTP->new(
1011          Port => $NICK =~ m/-dev/ ? 8001 : 8000,          Port => $http_port,
1012            PreHandler => {
1013                    '/' => sub {
1014                            $_[0]->header(Connection => 'close')
1015                    }
1016            },
1017          ContentHandler => { '/' => \&root_handler },          ContentHandler => { '/' => \&root_handler },
1018          Headers        => { Server => 'irc-logger' },          Headers        => { Server => 'irc-logger' },
1019  );  );
1020    
 my %escape = ('<'=>'&lt;', '>'=>'&gt;', '&'=>'&amp;', '"'=>'&quot;');  
 my $escape_re  = join '|' => keys %escape;  
   
1021  my $style = <<'_END_OF_STYLE_';  my $style = <<'_END_OF_STYLE_';
1022  p { margin: 0; padding: 0.1em; }  p { margin: 0; padding: 0.1em; }
1023  .time, .channel { color: #808080; font-size: 60%; }  .time, .channel { color: #808080; font-size: 60%; }
# Line 826  p { margin: 0; padding: 0.1em; } Line 1025  p { margin: 0; padding: 0.1em; }
1025  .nick { color: #000000; font-size: 80%; padding: 2px; font-family: courier, courier new, monospace ; }  .nick { color: #000000; font-size: 80%; padding: 2px; font-family: courier, courier new, monospace ; }
1026  .message { color: #000000; font-size: 100%; }  .message { color: #000000; font-size: 100%; }
1027  .search { float: right; }  .search { float: right; }
1028    a:link.tag, a:visited.tag { border: 1px dashed #ccc; backgound: #ccc; text-decoration: none }
1029    a:hover.tag { border: 1px solid #eee }
1030    hr { border: 1px dashed #ccc; height: 1px; clear: both; }
1031    /*
1032  .col-0 { background: #ffff66 }  .col-0 { background: #ffff66 }
1033  .col-1 { background: #a0ffff }  .col-1 { background: #a0ffff }
1034  .col-2 { background: #99ff99 }  .col-2 { background: #99ff99 }
1035  .col-3 { background: #ff9999 }  .col-3 { background: #ff9999 }
1036  .col-4 { background: #ff66ff }  .col-4 { background: #ff66ff }
1037  a:link.tag, a:visited.tag { border: 1px dashed #ccc; backgound: #ccc; text-decoration: none }  */
1038  a:hover.tag { border: 1px solid #eee }  .calendar { border: 1px solid red; width: 100%; }
1039  hr { border: 1px dashed #ccc; height: 1px; clear: both; }  .month { border: 0px; width: 100%; }
1040  _END_OF_STYLE_  _END_OF_STYLE_
1041    
1042  my $max_color = 4;  $max_color = 0;
1043    
1044  my %nick_enumerator;  my @cols = qw(
1045            #ffcccc #ccffe6 #ccccff #e6ccff #ffccff #ffcce6 #ff9999 #ffcc99 #ffff99
1046            #ccff99 #99ff99 #99ffcc #99ccff #9999ff #cc99ff #ff6666 #ffb366 #ffff66
1047            #66ff66 #66ffb3 #66b3ff #6666ff #ff3333 #33ff33 #3399ff #3333ff #ff3399
1048            #a0a0a0 #ff0000 #ffff00 #80ff00 #0000ff #8000ff #ff00ff #ff0080 #994d00
1049            #999900 #009900 #cc0066 #c0c0c0 #ccff99 #99ff33 #808080 #660033 #ffffff
1050    );
1051    
1052    foreach my $c (@cols) {
1053            $style .= ".col-${max_color} { background: $c }\n";
1054            $max_color++;
1055    }
1056    warn "defined $max_color colors for users...\n";
1057    
1058  sub root_handler {  sub root_handler {
1059          my ($request, $response) = @_;          my ($request, $response) = @_;
1060          $response->code(RC_OK);          $response->code(RC_OK);
1061          $response->content_type("text/html; charset=$ENCODING");  
1062            # this doesn't seem to work, so moved to PreHandler
1063            #$response->header(Connection => 'close');
1064    
1065            return RC_OK if $request->uri =~ m/favicon.ico$/;
1066    
1067          my $q;          my $q;
1068    
# Line 857  sub root_handler { Line 1076  sub root_handler {
1076    
1077          my $search = $q->param('search') || $q->param('grep') || '';          my $search = $q->param('search') || $q->param('grep') || '';
1078    
1079            if ($request->url =~ m#/rss(?:/(tags|last-tag|follow.*)\w*(?:=(\d+))?)?#i) {
1080                    my $show = lc($1);
1081                    my $nr = $2;
1082    
1083                    my $type = 'RSS';       # Atom
1084    
1085                    $response->content_type( 'application/' . lc($type) . '+xml' );
1086    
1087                    my $html = '<!-- error -->';
1088                    #warn "create $type feed from ",dump( @last_tags );
1089    
1090                    my $feed = XML::Feed->new( $type );
1091                    $feed->link( $url );
1092    
1093                    if ( $show eq 'tags' ) {
1094                            $nr ||= 50;
1095                            $feed->title( "tags from $CHANNEL" );
1096                            $feed->link( "$url/tags" );
1097                            $feed->description( "tag cloud created from messages on channel $CHANNEL which have tags// in them" );
1098                            my $feed_entry = XML::Feed::Entry->new($type);
1099                            $feed_entry->title( "$nr tags from $CHANNEL" );
1100                            $feed_entry->author( $NICK );
1101                            $feed_entry->link( '/#tags'  );
1102    
1103                            $feed_entry->content(
1104                                    qq{<![CDATA[<style type="text/css">}
1105                                    . $cloud->css
1106                                    . qq{</style>}
1107                                    . $cloud->html( $nr )
1108                                    . qq{]]>}
1109                            );
1110                            $feed->add_entry( $feed_entry );
1111    
1112                    } elsif ( $show eq 'last-tag' ) {
1113    
1114                            $nr ||= $last_x_tags;
1115                            $nr = $last_x_tags if $nr > $last_x_tags;
1116    
1117                            $feed->title( "last $nr tagged messages from $CHANNEL" );
1118                            $feed->description( "collects messages which have tags// in them" );
1119    
1120                            foreach my $m ( @last_tags ) {
1121    #                               warn dump( $m );
1122                                    #my $tags = join(' ', @{$m->{tags}} );
1123                                    my $feed_entry = XML::Feed::Entry->new($type);
1124                                    $feed_entry->title( $m->{nick} . '@' . $m->{time} );
1125                                    $feed_entry->author( $m->{nick} );
1126                                    $feed_entry->link( '/#' . $m->{id}  );
1127                                    $feed_entry->issued( DateTime::Format::Flexible->build( $m->{time} ) );
1128    
1129                                    my $message = $filter->{message}->( $m->{message} );
1130                                    $message .= "<br/>\n" unless $message =~ m!<(/p|br/?)>!;
1131    #                               warn "## message = $message\n";
1132    
1133                                    #$feed_entry->summary(
1134                                    $feed_entry->content(
1135                                            "<![CDATA[$message]]>"
1136                                    );
1137                                    $feed_entry->category( join(', ', @{$m->{tags}}) );
1138                                    $feed->add_entry( $feed_entry );
1139    
1140                                    $nr--;
1141                                    last if $nr <= 0;
1142    
1143                            }
1144    
1145                    } elsif ( $show =~ m/^follow/ ) {
1146    
1147                            $feed->title( "Feeds which this bot follows" );
1148    
1149                            my $sth = $dbh->prepare( qq{ select * from feeds order by last_update desc } );
1150                            $sth->execute;
1151                            while (my $row = $sth->fetchrow_hashref) {
1152                                    my $feed_entry = XML::Feed::Entry->new($type);
1153                                    $feed_entry->title( $row->{name} );
1154                                    $feed_entry->link( $row->{url}  );
1155                                    $feed_entry->issued( DateTime::Format::Flexible->build( $row->{last_update} ) );
1156                                    $feed_entry->content(
1157                                            '<![CDATA[<pre>' . dump( $row ) . '</pre>]]>'
1158                                    );
1159                                    $feed->add_entry( $feed_entry );
1160                            }
1161    
1162                            my $feed_entry = XML::Feed::Entry->new($type);
1163                            $feed_entry->title( "Internal stats" );
1164                            $feed_entry->content(
1165                                    '<![CDATA[<pre>' . dump( $_rss ) . '</pre>]]>'
1166                            );
1167                            $feed->add_entry( $feed_entry );
1168    
1169                    } else {
1170                            _log "unknown rss request ",$request->url;
1171                            return RC_DENY;
1172                    }
1173    
1174                    $response->content( $feed->as_xml );
1175                    return RC_OK;
1176            }
1177    
1178            if ( $@ ) {
1179                    warn "$@";
1180            }
1181    
1182            $response->content_type("text/html; charset=UTF-8");
1183    
1184          my $html =          my $html =
1185                  qq{<html><head><title>$NICK</title><style type="text/css">$style} .                  qq{<html><head><title>$NICK</title><style type="text/css">$style}
1186                  $cloud->css .                  . $cloud->css
1187                  qq{</style></head><body>} .                  . qq{</style></head><body>}
1188                  qq{                  . qq{
1189                  <form method="post" class="search" action="/">                  <form method="post" class="search" action="/">
1190                  <input type="text" name="search" value="$search" size="10">                  <input type="text" name="search" value="$search" size="10">
1191                  <input type="submit" value="search">                  <input type="submit" value="search">
1192                  </form>                  </form>
1193                  } .                  }
1194                  $cloud->html(500) .                  . $cloud->html(500)
1195                  qq{<p>};                  . qq{<p>};
1196          if ($request->url =~ m#/history#) {  
1197            if ($request->url =~ m#/tags?#) {
1198                    # nop
1199            } elsif ($request->url =~ m#/history#) {
1200                  my $sth = $dbh->prepare(qq{                  my $sth = $dbh->prepare(qq{
1201                          select date(time) as date,count(*) as nr                          select date(time) as date,count(*) as nr,sum(length(message)) as len
1202                                  from log                                  from log
1203                                  group by date(time)                                  group by date(time)
1204                                  order by date(time) desc                                  order by date(time) desc
1205                  });                  });
1206                  $sth->execute();                  $sth->execute();
1207                  my ($l_yyyy,$l_mm) = (0,0);                  my ($l_yyyy,$l_mm) = (0,0);
1208                    $html .= qq{<table class="calendar"><tr>};
1209                  my $cal;                  my $cal;
1210                    my $ord = 0;
1211                  while (my $row = $sth->fetchrow_hashref) {                  while (my $row = $sth->fetchrow_hashref) {
1212                          # this is probably PostgreSQL specific, expects ISO date                          # this is probably PostgreSQL specific, expects ISO date
1213                          my ($yyyy,$mm,$dd) = split(/-/, $row->{date});                          my ($yyyy,$mm,$dd) = split(/-/, $row->{date});
1214                          if ($yyyy != $l_yyyy || $mm != $l_mm) {                          if ($yyyy != $l_yyyy || $mm != $l_mm) {
1215                                  $html .= $cal->as_HTML() if ($cal);                                  if ( $cal ) {
1216                                            $html .= qq{<td valign="top">} . $cal->as_HTML() . qq{</td>};
1217                                            $ord++;
1218                                            $html .= qq{</tr><tr>} if ( $ord % 3 == 0 );
1219                                    }
1220                                  $cal = new HTML::CalendarMonthSimple('month'=>$mm,'year'=>$yyyy);                                  $cal = new HTML::CalendarMonthSimple('month'=>$mm,'year'=>$yyyy);
1221                                  $cal->border(2);                                  $cal->border(1);
1222                                    $cal->width('30%');
1223                                    $cal->cellheight('5em');
1224                                    $cal->tableclass('month');
1225                                    #$cal->cellclass('day');
1226                                    $cal->sunday('SUN');
1227                                    $cal->saturday('SAT');
1228                                    $cal->weekdays('MON','TUE','WED','THU','FRI');
1229                                  ($l_yyyy,$l_mm) = ($yyyy,$mm);                                  ($l_yyyy,$l_mm) = ($yyyy,$mm);
1230                          }                          }
1231                          $cal->setcontent($dd, qq{                          $cal->setcontent($dd, qq[
1232                                  <a href="/?date=$row->{date}">$row->{nr}</a>                                  <a href="$url?date=$row->{date}">$row->{nr}</a><br/>$row->{len}
1233                          });                          ]) if $cal;
1234                            
1235                  }                  }
1236                  $html .= $cal->as_HTML() if ($cal);                  $html .= qq{<td valign="top">} . $cal->as_HTML() . qq{</td></tr></table>};
1237    
1238          } else {          } else {
1239                  $html .= join("</p><p>",                  $html .= join("</p><p>",
1240                          get_from_log(                          get_from_log(
1241                                  limit => $q->param('last') || $q->param('date') ? undef : 100,                                  limit => ( $q->param('last') || $q->param('date') ) ? undef : 100,
1242                                  search => $search || undef,                                  search => $search || undef,
1243                                  tag => $q->param('tag') || undef,                                  tag => $q->param('tag') || undef,
1244                                  date => $q->param('date') || undef,                                  date => $q->param('date') || undef,
1245                                  fmt => {                                  fmt => {
1246                                          date => sub {                                          date => sub {
1247                                                  my $date = shift || return;                                                  my $date = shift || return;
1248                                                  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>};
1249                                          },                                          },
1250                                          time => '<span class="time">%s</span> ',                                          time => '<span class="time">%s</span> ',
1251                                          time_channel => '<span class="channel">%s %s</span> ',                                          time_channel => '<span class="channel">%s %s</span> ',
# Line 912  sub root_handler { Line 1253  sub root_handler {
1253                                          me_nick => '***%s&nbsp;',                                          me_nick => '***%s&nbsp;',
1254                                          message => '<span class="message">%s</span>',                                          message => '<span class="message">%s</span>',
1255                                  },                                  },
1256                                  filter => {                                  filter => $filter,
                                         message => sub {  
                                                 my $m = shift || return;  
                                                 $m =~ s/($escape_re)/$escape{$1}/gs;  
                                                 $m =~ s#($RE{URI}{HTTP})#<a href="$1">$1</a>#gs;  
                                                 $m =~ s#$tag_regex#<a href="?tag=$1" class="tag">$1</a>#g;  
                                                 return $m;  
                                         },  
                                         nick => sub {  
                                                 my $n = shift || return;  
                                                 if (! $nick_enumerator{$n})  {  
                                                         my $max = scalar keys %nick_enumerator;  
                                                         $nick_enumerator{$n} = $max + 1;  
                                                 }  
                                                 return '<span class="nick col-' .  
                                                         ( $nick_enumerator{$n} % $max_color ) .  
                                                         '">' . $n . '</span>';  
                                         },  
                                 },  
1257                          )                          )
1258                  );                  );
1259          }          }
# Line 941  sub root_handler { Line 1264  sub root_handler {
1264          </body></html>};          </body></html>};
1265    
1266          $response->content( $html );          $response->content( $html );
1267            warn "<< ", $request->method, " ", $request->uri, " created ", length($html), " bytes\n";
1268          return RC_OK;          return RC_OK;
1269  }  }
1270    
Legend:
Removed from v.52  
changed lines
  Added in v.99
  ViewVC Help
Powered by ViewVC 1.1.26