/[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 51 by dpavlin, Sun Mar 18 16:03:24 2007 UTC revision 95 by dpavlin, Fri Mar 7 11:16:05 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) . '}';
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            last_update timestamp default 'now()',
182            polls int default 0,
183            updates int default 0
184    );
185    create unique index feeds_url on feeds(url);
186    insert into feeds (url,name) values ('http://wiki.razmjenavjestina.org/feed/workspace/razmjenavjestina?category=Recent%20Changes','wiki');
187            },
188  };  };
189    
190  foreach my $table ( keys %$sql_schema ) {  foreach my $table ( keys %$sql_schema ) {
# Line 158  sub meta { Line 227  sub meta {
227                  if ( $@ || ! $sth->rows ) {                  if ( $@ || ! $sth->rows ) {
228                          $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()) });
229                          $sth->execute( $value, $nick, $channel, $name );                          $sth->execute( $value, $nick, $channel, $name );
230                          _log "created $nick/$channel/$name = $value";                          warn "## created $nick/$channel/$name = $value\n";
231                  } else {                  } else {
232                          _log "updated $nick/$channel/$name = $value ";                          warn "## updated $nick/$channel/$name = $value\n";
233                  }                  }
234    
235                  return $value;                  return $value;
# Line 170  sub meta { Line 239  sub meta {
239                  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 = ? });
240                  $sth->execute( $nick, $channel, $name );                  $sth->execute( $nick, $channel, $name );
241                  my ($v,$c) = $sth->fetchrow_array;                  my ($v,$c) = $sth->fetchrow_array;
242                  _log "fetched $nick/$channel/$name = $v [$c]";                  warn "## fetched $nick/$channel/$name = $v [$c]\n";
243                  return ($v,$c) if wantarray;                  return ($v,$c) if wantarray;
244                  return $v;                  return $v;
245    
# Line 179  sub meta { Line 248  sub meta {
248    
249    
250    
251  my $sth = $dbh->prepare(qq{  my $sth_insert_log = $dbh->prepare(qq{
252  insert into log  insert into log
253          (channel, me, nick, message, time)          (channel, me, nick, message, time)
254  values (?,?,?,?,?)  values (?,?,?,?,?)
# Line 187  values (?,?,?,?,?) Line 256  values (?,?,?,?,?)
256    
257    
258  my $tags;  my $tags;
 my $tag_regex = '\b([\w-_]+)//';  
259    
260  =head2 get_from_log  =head2 get_from_log
261    
# Line 224  C<me>, C<nick> and C<message> keys. Line 292  C<me>, C<nick> and C<message> keys.
292  sub get_from_log {  sub get_from_log {
293          my $args = {@_};          my $args = {@_};
294    
295          $args->{fmt} ||= {          if ( ! $args->{fmt} ) {
296                  date => '[%s] ',                  $args->{fmt} = {
297                  time => '{%s} ',                          date => '[%s] ',
298                  time_channel => '{%s %s} ',                          time => '{%s} ',
299                  nick => '%s: ',                          time_channel => '{%s %s} ',
300                  me_nick => '***%s ',                          nick => '%s: ',
301                  message => '%s',                          me_nick => '***%s ',
302          };                          message => '%s',
303                    };
304            }
305    
306          my $sql_message = qq{          my $sql_message = qq{
307                  select                  select
# Line 254  sub get_from_log { Line 324  sub get_from_log {
324    
325          my $sql = $context ? $sql_context : $sql_message;          my $sql = $context ? $sql_context : $sql_message;
326    
327          $sql .= " where message ilike ? or nick ilike ? " if ($args->{search});          sub check_date {
328          $sql .= " where id in (" . join(",", @{ $tags->{ $args->{tag} } }) . ") " if ($args->{tag} && $tags->{ $args->{tag} });                  my $date = shift || return;
329          $sql .= " where date(time) = ? " if ($args->{date});                  my $new_date = eval { DateTime::Format::ISO8601->parse_datetime( $date )->ymd; };
330          $sql .= " order by log.time desc";                  if ( $@ ) {
331          $sql .= " limit " . $args->{limit} if ($args->{limit});                          warn "invalid date $date\n";
332                            $new_date = DateTime->now->ymd;
333                    }
334                    return $new_date;
335            }
336    
337            my @where;
338            my @args;
339    
         my $sth = $dbh->prepare( $sql );  
340          if (my $search = $args->{search}) {          if (my $search = $args->{search}) {
341                  $search =~ s/^\s+//;                  $search =~ s/^\s+//;
342                  $search =~ s/\s+$//;                  $search =~ s/\s+$//;
343                  $sth->execute( ( '%' . $search . '%' ) x 2 );                  push @where, 'message ilike ? or nick ilike ?';
344                  _log "search for '$search' returned ", $sth->rows, " results ", $context || '';                  push @args, ( ( '%' . $search . '%' ) x 2 );
345          } elsif (my $tag = $args->{tag}) {                  _log "search for '$search'";
346                  $sth->execute();          }
347                  _log "tag '$tag' returned ", $sth->rows, " results ", $context || '';  
348          } elsif (my $date = $args->{date}) {          if ($args->{tag} && $tags->{ $args->{tag} }) {
349                  $sth->execute($date);                  push @where, 'id in (' . join(',', @{ $tags->{ $args->{tag} } }) . ')';
350                  _log "found ", $sth->rows, " messages for date $date ", $context || '';                  _log "search for tags $args->{tag}";
         } else {  
                 $sth->execute();  
351          }          }
352    
353            if (my $date = $args->{date} ) {
354                    $date = check_date( $date );
355                    push @where, 'date(time) = ?';
356                    push @args, $date;
357                    _log "search for date $date";
358            }
359    
360            $sql .= " where " . join(" and ", @where) if @where;
361    
362            $sql .= " order by log.time desc";
363            $sql .= " limit " . $args->{limit} if ($args->{limit});
364    
365            #warn "### sql: $sql ", dump( @args );
366    
367            my $sth = $dbh->prepare( $sql );
368            eval { $sth->execute( @args ) };
369            return if $@;
370    
371          my $last_row = {          my $last_row = {
372                  date => '',                  date => '',
373                  time => '',                  time => '',
# Line 395  my $cloud = HTML::TagCloud->new; Line 488  my $cloud = HTML::TagCloud->new;
488    
489  =head2 add_tag  =head2 add_tag
490    
491   add_tag( id => 42, message => 'irc message' );   add_tag( id => 42, message => 'irc message', nick => 'foobar' [, me => 1 ] );
492    
493  =cut  =cut
494    
495    my @last_tags;
496    
497  sub add_tag {  sub add_tag {
498          my $arg = {@_};          my $arg = {@_};
499    
500          return unless ($arg->{id} && $arg->{message});          return unless ($arg->{id} && $arg->{message});
501    
502          my $m = $arg->{message};          my $m = $arg->{message};
503          from_to('UTF-8', 'iso-8859-2', $m) if (is_utf8($m));  
504            my @tags;
505    
506          while ($m =~ s#$tag_regex##s) {          while ($m =~ s#$tag_regex##s) {
507                  my $tag = $1;                  my $tag = $1;
508                  next if (! $tag || $tag =~ m/https?:/i);                  next if (! $tag || $tag =~ m/https?:/i);
509                  push @{ $tags->{$tag} }, $arg->{id};                  push @{ $tags->{$tag} }, $arg->{id};
510                  #warn "+tag $tag: $arg->{id}\n";                  #warn "+tag $tag: $arg->{id}\n";
511                  $cloud->add($tag, "?tag=$tag", scalar @{$tags->{$tag}} + 1);                  $cloud->add($tag, "$url?tag=$tag", scalar @{$tags->{$tag}} + 1);
512                    push @tags, $tag;
513    
514            }
515    
516            if ( @tags ) {
517                    pop @last_tags if $#last_tags == $last_x_tags;
518                    unshift @last_tags, { tags => [ @tags ], %$arg };
519          }          }
520    
521  }  }
522    
523  =head2 seed_tags  =head2 seed_tags
# Line 423  Read all tags from database and create i Line 527  Read all tags from database and create i
527  =cut  =cut
528    
529  sub seed_tags {  sub seed_tags {
530          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 });
531          $sth->execute;          $sth->execute;
532          while (my $row = $sth->fetchrow_hashref) {          while (my $row = $sth->fetchrow_hashref) {
533                  add_tag( %$row );                  add_tag( %$row );
534          }          }
535    
536          foreach my $tag (keys %$tags) {          foreach my $tag (keys %$tags) {
537                  $cloud->add($tag, "?tag=$tag", scalar @{$tags->{$tag}} + 1);                  $cloud->add($tag, "$url?tag=$tag", scalar @{$tags->{$tag}} + 1);
538          }          }
539  }  }
540    
# Line 443  seed_tags; Line 547  seed_tags;
547          channel => '#foobar',          channel => '#foobar',
548          me => 0,          me => 0,
549          nick => 'dpavlin',          nick => 'dpavlin',
550          msg => 'test message',          message => 'test message',
551          time => '2006-06-25 18:57:18',          time => '2006-06-25 18:57:18',
552    );    );
553    
# Line 455  C<me> if not specified will be C<0> (not Line 559  C<me> if not specified will be C<0> (not
559    
560  sub save_message {  sub save_message {
561          my $a = {@_};          my $a = {@_};
562            confess "have msg" if $a->{msg};
563          $a->{me} ||= 0;          $a->{me} ||= 0;
564          $a->{time} ||= strftime($TIMESTAMP,localtime());          $a->{time} ||= strftime($TIMESTAMP,localtime());
565    
566          _log          _log
567                  $a->{channel}, " ",                  $a->{channel}, " ",
568                  $a->{me} ? "***" . $a->{nick} : "<" . $a->{nick} . ">",                  $a->{me} ? "***" . $a->{nick} : "<" . $a->{nick} . ">",
569                  " " . $a->{msg};                  " " . $a->{message};
   
         from_to($a->{msg}, 'UTF-8', $ENCODING);  
570    
571          $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});
572          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});  
573  }  }
574    
575    
576  if ($import_dircproxy) {  if ($import_dircproxy) {
577          open(my $l, $import_dircproxy) || die "can't open $import_dircproxy: $!";          open(my $l, $import_dircproxy) || die "can't open $import_dircproxy: $!";
578          warn "importing $import_dircproxy...\n";          warn "importing $import_dircproxy...\n";
579          my $tz_offset = 2 * 60 * 60;    # TZ GMT+2          my $tz_offset = 1 * 60 * 60;    # TZ GMT+2
580          while(<$l>) {          while(<$l>) {
581                  chomp;                  chomp;
582                  if (/^@(\d+)\s(\S+)\s(.+)$/) {                  if (/^@(\d+)\s(\S+)\s(.+)$/) {
# Line 492  if ($import_dircproxy) { Line 594  if ($import_dircproxy) {
594                                  channel => $CHANNEL,                                  channel => $CHANNEL,
595                                  me => $me,                                  me => $me,
596                                  nick => $nick,                                  nick => $nick,
597                                  msg => $msg,                                  message => $msg,
598                                  time => $dt->ymd . " " . $dt->hms,                                  time => $dt->ymd . " " . $dt->hms,
599                          ) if ($nick !~ m/^-/);                          ) if ($nick !~ m/^-/);
600    
# Line 505  if ($import_dircproxy) { Line 607  if ($import_dircproxy) {
607          exit;          exit;
608  }  }
609    
610    #
611    # RSS follow
612    #
613    
614    my $_rss;
615    
616    
617    sub rss_fetch {
618            my ($args) = @_;
619    
620            # how many messages to send out when feed is seen for the first time?
621            my $send_rss_msgs = 1;
622    
623            _log "RSS fetch", $args->{url};
624    
625            my $feed = XML::Feed->parse(URI->new( $args->{url} ));
626            if ( ! $feed ) {
627                    _log("can't fetch RSS ", $args->{url});
628                    return;
629            }
630    
631            my ( $total, $updates ) = ( 0, 0 );
632            for my $entry ($feed->entries) {
633                    $total++;
634    
635                    # seen allready?
636                    next if $_rss->{$feed->link}->{seen}->{$entry->id}++ > 0;
637    
638                    sub prefix {
639                            my ($txt,$var) = @_;
640                            $var =~ s/\s+/ /gs;
641                            $var =~ s/^\s+//g;
642                            $var =~ s/\s+$//g;
643                            return $txt . $var if $var;
644                    }
645    
646                    # fix absolute and relative links to feed entries
647                    my $link = $entry->link;
648                    if ( $link =~ m!^/! ) {
649                            my $host = $args->{url};
650                            $host =~ s!^(http://[^/]+).*$!$1!;      #!vim
651                            $link = "$host/$link";
652                    } elsif ( $link !~ m!^http! ) {
653                            $link = $args->{url} . $link;
654                    }
655                    $link =~ s!//+!/!g;
656    
657                    my $msg;
658                    $msg .= prefix( 'From: ' , $args->{name} || $feed->title );
659                    $msg .= prefix( ' by ' , $entry->author );
660                    $msg .= prefix( ' | ' , $entry->title );
661                    $msg .= prefix( ' | ' , $link );
662    #               $msg .= prefix( ' id ' , $entry->id );
663    
664                    if ( $args->{kernel} && $send_rss_msgs ) {
665                            $send_rss_msgs--;
666                            _log('>>', $msg);
667                            $sth_insert_log->execute( $CHANNEL, 1, $NICK, $msg, 'now()' );
668                            $args->{kernel}->post( $IRC_ALIAS => notice => $CHANNEL, $msg );
669                            $updates++;
670                    }
671            }
672    
673            my $sql = qq{ update feeds set last_update = now(), polls = polls + 1 };
674            $sql .= qq{, updates = updates + $updates } if $updates;
675            $sql .= qq{where id = } . $args->{id};
676            eval { $dbh->do( $sql ) };
677    
678            _log "RSS got $total items of which $updates new";
679    
680            return $updates;
681    }
682    
683    sub rss_fetch_all {
684            my $kernel = shift;
685            my $sql = qq{
686                    select id, url, name
687                    from feeds
688                    where active is true
689            };
690            # limit to newer feeds only if we are not sending messages out
691            $sql .= qq{     and last_update + delay < now() } if $kernel;
692            my $sth = $dbh->prepare( $sql );
693            $sth->execute();
694            warn "# ",$sth->rows," active RSS feeds\n";
695            my $count = 0;
696            while (my $row = $sth->fetchrow_hashref) {
697                    $row->{kernel} = $kernel if $kernel;
698                    $count += rss_fetch( $row );
699            }
700            return "OK, fetched $count posts from " . $sth->rows . " feeds";
701    }
702    
703    
704    sub rss_check_updates {
705            my $kernel = shift;
706            $_rss->{last_poll} ||= time();
707            my $dt = time() - $_rss->{last_poll};
708            warn "## rss_check_updates $dt > $rss_min_delay\n";
709            if ( $dt > $rss_min_delay ) {
710                    $_rss->{last_poll} = time();
711                    _log rss_fetch_all( $kernel );
712            }
713    }
714    
715    # seed rss seen cache so we won't send out all items on startup
716    _log rss_fetch_all;
717    
718  #  #
719  # POE handing part  # POE handing part
720  #  #
721    
 my $SKIPPING = 0;               # if skipping, how many we've done  
 my $SEND_QUEUE;                 # cache  
722  my $ping;                                               # ping stats  my $ping;                                               # ping stats
723    
724  POE::Component::IRC->new($IRC_ALIAS);  POE::Component::IRC->new($IRC_ALIAS);
725    
726  POE::Session->create( inline_states =>  POE::Session->create( inline_states => {
727     {_start => sub {                _start => sub {      
728                  $_[KERNEL]->post($IRC_ALIAS => register => 'all');                  $_[KERNEL]->post($IRC_ALIAS => register => 'all');
729                  $_[KERNEL]->post($IRC_ALIAS => connect => $CONNECT);                  $_[KERNEL]->post($IRC_ALIAS => connect => $CONNECT);
730      },      },
731      irc_255 => sub {    # server is done blabbing      irc_255 => sub {    # server is done blabbing
732                  $_[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;  
733                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "IDENTIFY $NICK" );                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "IDENTIFY $NICK" );
734      },      },
735      irc_public => sub {      irc_public => sub {
# Line 534  POE::Session->create( inline_states => Line 738  POE::Session->create( inline_states =>
738                  my $channel = $_[ARG1]->[0];                  my $channel = $_[ARG1]->[0];
739                  my $msg = $_[ARG2];                  my $msg = $_[ARG2];
740    
741                  save_message( channel => $channel, me => 0, nick => $nick, msg => $msg);                  save_message( channel => $channel, me => 0, nick => $nick, message => $msg);
742                  meta( $nick, $channel, 'last-msg', $msg );                  meta( $nick, $channel, 'last-msg', $msg );
743                    rss_check_updates( $kernel );
744      },      },
745      irc_ctcp_action => sub {      irc_ctcp_action => sub {
746                  my $kernel = $_[KERNEL];                  my $kernel = $_[KERNEL];
# Line 543  POE::Session->create( inline_states => Line 748  POE::Session->create( inline_states =>
748                  my $channel = $_[ARG1]->[0];                  my $channel = $_[ARG1]->[0];
749                  my $msg = $_[ARG2];                  my $msg = $_[ARG2];
750    
751                  save_message( channel => $channel, me => 1, nick => $nick, msg => $msg);                  save_message( channel => $channel, me => 1, nick => $nick, message => $msg);
752    
753                  if ( my $twitter = ( $nick, $channel, 'twitter' ) ) {                  if ( $use_twitter ) {
754                          _log("FIXME: send twitter for $nick on $channel [$twitter]");                          if ( my $twitter = meta( $nick, $NICK, 'twitter' ) ) {
755                                    my ($login,$passwd) = split(/\s+/,$twitter,2);
756                                    _log("sending twitter for $nick/$login on $channel ");
757                                    my $bot = Net::Twitter->new( username=>$login, password=>$passwd );
758                                    $bot->update("<${channel}> $msg");
759                            }
760                  }                  }
761    
762      },      },
763          irc_ping => sub {          irc_ping => sub {
764                  warn "pong ", $_[ARG0], $/;                  _log( "pong ", $_[ARG0] );
765                  $ping->{ $_[ARG0] }++;                  $ping->{ $_[ARG0] }++;
766                    rss_check_updates( $_[KERNEL] );
767          },          },
768          irc_invite => sub {          irc_invite => sub {
769                  my $kernel = $_[KERNEL];                  my $kernel = $_[KERNEL];
770                  my $nick = (split /!/, $_[ARG0])[0];                  my $nick = (split /!/, $_[ARG0])[0];
771                  my $channel = $_[ARG1];                  my $channel = $_[ARG1];
772    
773                  warn "invited to $channel by $nick";                  _log "invited to $channel by $nick";
774    
775                  $_[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..." );
776                  $_[KERNEL]->post($IRC_ALIAS => join => $channel);                  $_[KERNEL]->post($IRC_ALIAS => join => $channel);
# Line 570  POE::Session->create( inline_states => Line 781  POE::Session->create( inline_states =>
781                  my $nick = (split /!/, $_[ARG0])[0];                  my $nick = (split /!/, $_[ARG0])[0];
782                  my $msg = $_[ARG2];                  my $msg = $_[ARG2];
783                  my $channel = $_[ARG1]->[0];                  my $channel = $_[ARG1]->[0];
                 from_to($msg, 'UTF-8', $ENCODING);  
784    
785                  my $res = "unknown command '$msg', try /msg $NICK help!";                  my $res = "unknown command '$msg', try /msg $NICK help!";
786                  my @out;                  my @out;
# Line 593  POE::Session->create( inline_states => Line 803  POE::Session->create( inline_states =>
803    
804                          my $sth = $dbh->prepare(qq{                          my $sth = $dbh->prepare(qq{
805                                  select                                  select
806                                          nick,                                          trim(both '_' from nick) as nick,
807                                          count(*) as count,                                          count(*) as count,
808                                          sum(length(message)) as len                                          sum(length(message)) as len
809                                  from log                                  from log
810                                  group by nick                                  group by trim(both '_' from nick)
811                                  order by len desc,count desc                                  order by len desc,count desc
812                                  limit $nr                                  limit $nr
813                          });                          });
# Line 614  POE::Session->create( inline_states => Line 824  POE::Session->create( inline_states =>
824    
825                          foreach my $res (get_from_log( limit => $limit )) {                          foreach my $res (get_from_log( limit => $limit )) {
826                                  _log "last: $res";                                  _log "last: $res";
                                 from_to($res, $ENCODING, 'UTF-8');  
827                                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );                                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );
828                          }                          }
829    
# Line 629  POE::Session->create( inline_states => Line 838  POE::Session->create( inline_states =>
838                                          search => $what,                                          search => $what,
839                                  )) {                                  )) {
840                                  _log "search [$what]: $res";                                  _log "search [$what]: $res";
                                 from_to($res, $ENCODING, 'UTF-8');  
841                                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );                                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );
842                          }                          }
843    
# Line 673  POE::Session->create( inline_states => Line 881  POE::Session->create( inline_states =>
881                          if ( ! defined( $1 ) ) {                          if ( ! defined( $1 ) ) {
882                                  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 = ? });
883                                  $sth->execute( $nick, $channel );                                  $sth->execute( $nick, $channel );
884                                  $res = "config for $nick ";                                  $res = "config for $nick on $channel";
885                                  while ( my ($n,$v) = $sth->fetchrow_array ) {                                  while ( my ($n,$v) = $sth->fetchrow_array ) {
886                                          $res .= "| $n = $v";                                          $res .= " | $n = $v";
887                                  }                                  }
888                          } elsif ( ! $2 ) {                          } elsif ( ! $2 ) {
889                                  my $val = meta( $nick, $channel, $1 );                                  my $val = meta( $nick, $channel, $1 );
# Line 699  POE::Session->create( inline_states => Line 907  POE::Session->create( inline_states =>
907                                          $res = "config option $op doesn't exist";                                          $res = "config option $op doesn't exist";
908                                  }                                  }
909                          }                          }
910                    } elsif ($msg =~ m/^rss-update/) {
911                            $res = rss_fetch_all( $_[KERNEL] );
912                    } elsif ($msg =~ m/^rss-clean/) {
913                            $_rss = undef;
914                            $dbh->do( qq{ update feeds set last_update = now() - delay } );
915                            $res = "OK, cleaned RSS cache";
916                    } elsif ($msg =~ m/^rss-list/) {
917                            my $sth = $dbh->prepare(qq{ select url,name,last_update,active from feeds });
918                            $sth->execute;
919                            while (my @row = $sth->fetchrow_array) {
920                                    $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, join(' | ',@row) );
921                            }
922                            $res = '';
923                    } elsif ($msg =~ m!^rss-(add|remove|stop|start)\s+(http://\S+)\s*(.*)!) {
924                            my $sql = {
925                                    add             => qq{ insert into feeds (url,name) values (?,?) },
926    #                               remove  => qq{ delete from feeds                                where url = ? and name = ? },
927                                    start   => qq{ update feeds set active = true   where url = ? },
928                                    stop    => qq{ update feeds set active = false  where url = ? },
929                            };
930                            if (my $q = $sql->{$1} ) {
931                                    my $sth = $dbh->prepare( $q );
932                                    my @data = ( $2 );
933                                    push @data, $3 if ( $q =~ s/\?//g == 2 );
934                                    warn "## $1 SQL $q with ",dump( @data ),"\n";
935                                    eval { $sth->execute( @data ) };
936                            }
937    
938                            $res = "OK, RSS $1 : $2 - $3";
939                  }                  }
940    
941                  if ($res) {                  if ($res) {
942                          _log ">> [$nick] $res";                          _log ">> [$nick] $res";
                         from_to($res, $ENCODING, 'UTF-8');  
943                          $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );                          $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );
944                  }                  }
945    
946                    rss_check_updates( $_[KERNEL] );
947          },          },
948          irc_477 => sub {          irc_477 => sub {
949                  _log "# irc_477: ",$_[ARG1];                  _log "# irc_477: ",$_[ARG1];
# Line 745  POE::Session->create( inline_states => Line 982  POE::Session->create( inline_states =>
982                          "";                          "";
983        0;                        # false for signals        0;                        # false for signals
984      },      },
     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);  
     }  
985     },     },
986    );    );
987    
988  # http server  # http server
989    
990  my $httpd = POE::Component::Server::HTTP->new(  my $httpd = POE::Component::Server::HTTP->new(
991          Port => $NICK =~ m/-dev/ ? 8001 : 8000,          Port => $http_port,
992            PreHandler => {
993                    '/' => sub {
994                            $_[0]->header(Connection => 'close')
995                    }
996            },
997          ContentHandler => { '/' => \&root_handler },          ContentHandler => { '/' => \&root_handler },
998          Headers        => { Server => 'irc-logger' },          Headers        => { Server => 'irc-logger' },
999  );  );
1000    
 my %escape = ('<'=>'&lt;', '>'=>'&gt;', '&'=>'&amp;', '"'=>'&quot;');  
 my $escape_re  = join '|' => keys %escape;  
   
1001  my $style = <<'_END_OF_STYLE_';  my $style = <<'_END_OF_STYLE_';
1002  p { margin: 0; padding: 0.1em; }  p { margin: 0; padding: 0.1em; }
1003  .time, .channel { color: #808080; font-size: 60%; }  .time, .channel { color: #808080; font-size: 60%; }
# Line 826  p { margin: 0; padding: 0.1em; } Line 1005  p { margin: 0; padding: 0.1em; }
1005  .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 ; }
1006  .message { color: #000000; font-size: 100%; }  .message { color: #000000; font-size: 100%; }
1007  .search { float: right; }  .search { float: right; }
1008    a:link.tag, a:visited.tag { border: 1px dashed #ccc; backgound: #ccc; text-decoration: none }
1009    a:hover.tag { border: 1px solid #eee }
1010    hr { border: 1px dashed #ccc; height: 1px; clear: both; }
1011    /*
1012  .col-0 { background: #ffff66 }  .col-0 { background: #ffff66 }
1013  .col-1 { background: #a0ffff }  .col-1 { background: #a0ffff }
1014  .col-2 { background: #99ff99 }  .col-2 { background: #99ff99 }
1015  .col-3 { background: #ff9999 }  .col-3 { background: #ff9999 }
1016  .col-4 { background: #ff66ff }  .col-4 { background: #ff66ff }
1017  a:link.tag, a:visited.tag { border: 1px dashed #ccc; backgound: #ccc; text-decoration: none }  */
1018  a:hover.tag { border: 1px solid #eee }  .calendar { border: 1px solid red; width: 100%; }
1019  hr { border: 1px dashed #ccc; height: 1px; clear: both; }  .month { border: 0px; width: 100%; }
1020  _END_OF_STYLE_  _END_OF_STYLE_
1021    
1022  my $max_color = 4;  $max_color = 0;
1023    
1024  my %nick_enumerator;  my @cols = qw(
1025            #ffcccc #ccffe6 #ccccff #e6ccff #ffccff #ffcce6 #ff9999 #ffcc99 #ffff99
1026            #ccff99 #99ff99 #99ffcc #99ccff #9999ff #cc99ff #ff6666 #ffb366 #ffff66
1027            #66ff66 #66ffb3 #66b3ff #6666ff #ff3333 #33ff33 #3399ff #3333ff #ff3399
1028            #a0a0a0 #ff0000 #ffff00 #80ff00 #0000ff #8000ff #ff00ff #ff0080 #994d00
1029            #999900 #009900 #cc0066 #c0c0c0 #ccff99 #99ff33 #808080 #660033 #ffffff
1030    );
1031    
1032    foreach my $c (@cols) {
1033            $style .= ".col-${max_color} { background: $c }\n";
1034            $max_color++;
1035    }
1036    warn "defined $max_color colors for users...\n";
1037    
1038  sub root_handler {  sub root_handler {
1039          my ($request, $response) = @_;          my ($request, $response) = @_;
1040          $response->code(RC_OK);          $response->code(RC_OK);
1041          $response->content_type("text/html; charset=$ENCODING");  
1042            # this doesn't seem to work, so moved to PreHandler
1043            #$response->header(Connection => 'close');
1044    
1045            return RC_OK if $request->uri =~ m/favicon.ico$/;
1046    
1047          my $q;          my $q;
1048    
# Line 857  sub root_handler { Line 1056  sub root_handler {
1056    
1057          my $search = $q->param('search') || $q->param('grep') || '';          my $search = $q->param('search') || $q->param('grep') || '';
1058    
1059            if ($request->url =~ m#/rss(?:/(tags|last-tag|follow.*)\w*(?:=(\d+))?)?#i) {
1060                    my $show = lc($1);
1061                    my $nr = $2;
1062    
1063                    my $type = 'RSS';       # Atom
1064    
1065                    $response->content_type( 'application/' . lc($type) . '+xml' );
1066    
1067                    my $html = '<!-- error -->';
1068                    #warn "create $type feed from ",dump( @last_tags );
1069    
1070                    my $feed = XML::Feed->new( $type );
1071                    $feed->link( $url );
1072    
1073                    if ( $show eq 'tags' ) {
1074                            $nr ||= 50;
1075                            $feed->title( "tags from $CHANNEL" );
1076                            $feed->link( "$url/tags" );
1077                            $feed->description( "tag cloud created from messages on channel $CHANNEL which have tags// in them" );
1078                            my $feed_entry = XML::Feed::Entry->new($type);
1079                            $feed_entry->title( "$nr tags from $CHANNEL" );
1080                            $feed_entry->author( $NICK );
1081                            $feed_entry->link( '/#tags'  );
1082    
1083                            $feed_entry->content(
1084                                    qq{<![CDATA[<style type="text/css">}
1085                                    . $cloud->css
1086                                    . qq{</style>}
1087                                    . $cloud->html( $nr )
1088                                    . qq{]]>}
1089                            );
1090                            $feed->add_entry( $feed_entry );
1091    
1092                    } elsif ( $show eq 'last-tag' ) {
1093    
1094                            $nr ||= $last_x_tags;
1095                            $nr = $last_x_tags if $nr > $last_x_tags;
1096    
1097                            $feed->title( "last $nr tagged messages from $CHANNEL" );
1098                            $feed->description( "collects messages which have tags// in them" );
1099    
1100                            foreach my $m ( @last_tags ) {
1101    #                               warn dump( $m );
1102                                    #my $tags = join(' ', @{$m->{tags}} );
1103                                    my $feed_entry = XML::Feed::Entry->new($type);
1104                                    $feed_entry->title( $m->{nick} . '@' . $m->{time} );
1105                                    $feed_entry->author( $m->{nick} );
1106                                    $feed_entry->link( '/#' . $m->{id}  );
1107                                    $feed_entry->issued( DateTime::Format::Flexible->build( $m->{time} ) );
1108    
1109                                    my $message = $filter->{message}->( $m->{message} );
1110                                    $message .= "<br/>\n" unless $message =~ m!<(/p|br/?)>!;
1111    #                               warn "## message = $message\n";
1112    
1113                                    #$feed_entry->summary(
1114                                    $feed_entry->content(
1115                                            "<![CDATA[$message]]>"
1116                                    );
1117                                    $feed_entry->category( join(', ', @{$m->{tags}}) );
1118                                    $feed->add_entry( $feed_entry );
1119    
1120                                    $nr--;
1121                                    last if $nr <= 0;
1122    
1123                            }
1124    
1125                    } elsif ( $show =~ m/^follow/ ) {
1126    
1127                            $feed->title( "Feeds which this bot follows" );
1128    
1129                            my $sth = $dbh->prepare( qq{ select * from feeds order by last_update desc } );
1130                            $sth->execute;
1131                            while (my $row = $sth->fetchrow_hashref) {
1132                                    my $feed_entry = XML::Feed::Entry->new($type);
1133                                    $feed_entry->title( $row->{name} );
1134                                    $feed_entry->link( $row->{url}  );
1135                                    $feed_entry->issued( DateTime::Format::Flexible->build( $row->{last_update} ) );
1136                                    $feed_entry->content(
1137                                            '<![CDATA[<pre>' . dump( $row ) . '</pre>]]>'
1138                                    );
1139                                    $feed->add_entry( $feed_entry );
1140                            }
1141    
1142                    } else {
1143                            _log "unknown rss request ",$request->url;
1144                            return RC_DENY;
1145                    }
1146    
1147                    $response->content( $feed->as_xml );
1148                    return RC_OK;
1149            }
1150    
1151            if ( $@ ) {
1152                    warn "$@";
1153            }
1154    
1155            $response->content_type("text/html; charset=UTF-8");
1156    
1157          my $html =          my $html =
1158                  qq{<html><head><title>$NICK</title><style type="text/css">$style} .                  qq{<html><head><title>$NICK</title><style type="text/css">$style}
1159                  $cloud->css .                  . $cloud->css
1160                  qq{</style></head><body>} .                  . qq{</style></head><body>}
1161                  qq{                  . qq{
1162                  <form method="post" class="search" action="/">                  <form method="post" class="search" action="/">
1163                  <input type="text" name="search" value="$search" size="10">                  <input type="text" name="search" value="$search" size="10">
1164                  <input type="submit" value="search">                  <input type="submit" value="search">
1165                  </form>                  </form>
1166                  } .                  }
1167                  $cloud->html(500) .                  . $cloud->html(500)
1168                  qq{<p>};                  . qq{<p>};
1169          if ($request->url =~ m#/history#) {  
1170            if ($request->url =~ m#/tags?#) {
1171                    # nop
1172            } elsif ($request->url =~ m#/history#) {
1173                  my $sth = $dbh->prepare(qq{                  my $sth = $dbh->prepare(qq{
1174                          select date(time) as date,count(*) as nr                          select date(time) as date,count(*) as nr,sum(length(message)) as len
1175                                  from log                                  from log
1176                                  group by date(time)                                  group by date(time)
1177                                  order by date(time) desc                                  order by date(time) desc
1178                  });                  });
1179                  $sth->execute();                  $sth->execute();
1180                  my ($l_yyyy,$l_mm) = (0,0);                  my ($l_yyyy,$l_mm) = (0,0);
1181                    $html .= qq{<table class="calendar"><tr>};
1182                  my $cal;                  my $cal;
1183                    my $ord = 0;
1184                  while (my $row = $sth->fetchrow_hashref) {                  while (my $row = $sth->fetchrow_hashref) {
1185                          # this is probably PostgreSQL specific, expects ISO date                          # this is probably PostgreSQL specific, expects ISO date
1186                          my ($yyyy,$mm,$dd) = split(/-/, $row->{date});                          my ($yyyy,$mm,$dd) = split(/-/, $row->{date});
1187                          if ($yyyy != $l_yyyy || $mm != $l_mm) {                          if ($yyyy != $l_yyyy || $mm != $l_mm) {
1188                                  $html .= $cal->as_HTML() if ($cal);                                  if ( $cal ) {
1189                                            $html .= qq{<td valign="top">} . $cal->as_HTML() . qq{</td>};
1190                                            $ord++;
1191                                            $html .= qq{</tr><tr>} if ( $ord % 3 == 0 );
1192                                    }
1193                                  $cal = new HTML::CalendarMonthSimple('month'=>$mm,'year'=>$yyyy);                                  $cal = new HTML::CalendarMonthSimple('month'=>$mm,'year'=>$yyyy);
1194                                  $cal->border(2);                                  $cal->border(1);
1195                                    $cal->width('30%');
1196                                    $cal->cellheight('5em');
1197                                    $cal->tableclass('month');
1198                                    #$cal->cellclass('day');
1199                                    $cal->sunday('SUN');
1200                                    $cal->saturday('SAT');
1201                                    $cal->weekdays('MON','TUE','WED','THU','FRI');
1202                                  ($l_yyyy,$l_mm) = ($yyyy,$mm);                                  ($l_yyyy,$l_mm) = ($yyyy,$mm);
1203                          }                          }
1204                          $cal->setcontent($dd, qq{                          $cal->setcontent($dd, qq[
1205                                  <a href="/?date=$row->{date}">$row->{nr}</a>                                  <a href="$url?date=$row->{date}">$row->{nr}</a><br/>$row->{len}
1206                          });                          ]) if $cal;
1207                            
1208                  }                  }
1209                  $html .= $cal->as_HTML() if ($cal);                  $html .= qq{<td valign="top">} . $cal->as_HTML() . qq{</td></tr></table>};
1210    
1211          } else {          } else {
1212                  $html .= join("</p><p>",                  $html .= join("</p><p>",
1213                          get_from_log(                          get_from_log(
1214                                  limit => $q->param('last') || $q->param('date') ? undef : 100,                                  limit => ( $q->param('last') || $q->param('date') ) ? undef : 100,
1215                                  search => $search || undef,                                  search => $search || undef,
1216                                  tag => $q->param('tag') || undef,                                  tag => $q->param('tag') || undef,
1217                                  date => $q->param('date') || undef,                                  date => $q->param('date') || undef,
1218                                  fmt => {                                  fmt => {
1219                                          date => sub {                                          date => sub {
1220                                                  my $date = shift || return;                                                  my $date = shift || return;
1221                                                  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>};
1222                                          },                                          },
1223                                          time => '<span class="time">%s</span> ',                                          time => '<span class="time">%s</span> ',
1224                                          time_channel => '<span class="channel">%s %s</span> ',                                          time_channel => '<span class="channel">%s %s</span> ',
# Line 912  sub root_handler { Line 1226  sub root_handler {
1226                                          me_nick => '***%s&nbsp;',                                          me_nick => '***%s&nbsp;',
1227                                          message => '<span class="message">%s</span>',                                          message => '<span class="message">%s</span>',
1228                                  },                                  },
1229                                  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>';  
                                         },  
                                 },  
1230                          )                          )
1231                  );                  );
1232          }          }
# Line 941  sub root_handler { Line 1237  sub root_handler {
1237          </body></html>};          </body></html>};
1238    
1239          $response->content( $html );          $response->content( $html );
1240            warn "<< ", $request->method, " ", $request->uri, " created ", length($html), " bytes\n";
1241          return RC_OK;          return RC_OK;
1242  }  }
1243    
Legend:
Removed from v.51  
changed lines
  Added in v.95
  ViewVC Help
Powered by ViewVC 1.1.26