/[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 50 by dpavlin, Sun Mar 18 15:37:05 2007 UTC revision 87 by dpavlin, Fri Mar 7 00:18:02 2008 UTC
# Line 22  Import log from C<dircproxy> to C<irc-lo Line 22  Import log from C<dircproxy> to C<irc-lo
22    
23  Name of log file  Name of log file
24    
25    =item --follow=file.log
26    
27    Follows new messages in file
28    
29  =back  =back
30    
31  =head1 DESCRIPTION  =head1 DESCRIPTION
# Line 32  log all conversation on irc channel Line 36  log all conversation on irc channel
36    
37  ## CONFIG  ## CONFIG
38    
39  my $HOSTNAME = `hostname`;  my $HOSTNAME = `hostname -f`;
40    chomp($HOSTNAME);
41    
42  my $NICK = 'irc-logger';  my $NICK = 'irc-logger';
43  $NICK .= '-dev' if ($HOSTNAME =~ m/llin/);  $NICK .= '-dev' if ($HOSTNAME =~ m/llin/);
# Line 45  my $CHANNEL = '#razmjenavjestina'; Line 50  my $CHANNEL = '#razmjenavjestina';
50  $CHANNEL = '#irc-logger' if ($HOSTNAME =~ m/llin/);  $CHANNEL = '#irc-logger' if ($HOSTNAME =~ m/llin/);
51  my $IRC_ALIAS = "log";  my $IRC_ALIAS = "log";
52    
53  my %FOLLOWS =  # default log to follow and announce messages
54    (  my $follows_path = 'follows.log';
    ACCESS => "/var/log/apache/access.log",  
    ERROR => "/var/log/apache/error.log",  
   );  
55    
56  my $DSN = 'DBI:Pg:dbname=' . $NICK;  my $DSN = 'DBI:Pg:dbname=' . $NICK;
57    
58    # log output encoding
59  my $ENCODING = 'ISO-8859-2';  my $ENCODING = 'ISO-8859-2';
60  my $TIMESTAMP = '%Y-%m-%d %H:%M:%S';  my $TIMESTAMP = '%Y-%m-%d %H:%M:%S';
61    
62  my $sleep_on_error = 5;  my $sleep_on_error = 5;
63    
64  ## END CONFIG  # number of last tags to keep in circular buffer
65    my $last_x_tags = 50;
66    
67    # don't pull rss feeds more often than this
68    my $rss_min_delay = 60;
69    $rss_min_delay = 15;
70    
71    my $http_port = $NICK =~ m/-dev/ ? 8001 : 8000;
72    
73    my $url = "http://$HOSTNAME:$http_port";
74    
75    ## END CONFIG
76    
77  use POE qw(Component::IRC Wheel::FollowTail Component::Server::HTTP);  use POE qw(Component::IRC Wheel::FollowTail Component::Server::HTTP);
78  use HTTP::Status;  use HTTP::Status;
# Line 73  use POSIX qw/strftime/; Line 85  use POSIX qw/strftime/;
85  use HTML::CalendarMonthSimple;  use HTML::CalendarMonthSimple;
86  use Getopt::Long;  use Getopt::Long;
87  use DateTime;  use DateTime;
88    use URI::Escape;
89  use Data::Dump qw/dump/;  use Data::Dump qw/dump/;
90    use DateTime::Format::ISO8601;
91    use Carp qw/confess/;
92    use XML::Feed;
93    use DateTime::Format::Flexible;
94    
95    my $use_twitter = 1;
96    eval { require Net::Twitter; };
97    $use_twitter = 0 if ($@);
98    
99  my $import_dircproxy;  my $import_dircproxy;
100  my $log_path;  my $log_path;
101  GetOptions(  GetOptions(
102          'import-dircproxy:s' => \$import_dircproxy,          'import-dircproxy:s' => \$import_dircproxy,
103            'follows:s' => \$follows_path,
104          'log:s' => \$log_path,          'log:s' => \$log_path,
105  );  );
106    
107    #$SIG{__DIE__} = sub {
108    #       confess "fatal error";
109    #};
110    
111  open(STDOUT, '>', $log_path) || warn "can't redirect log to $log_path: $!";  open(STDOUT, '>', $log_path) || warn "can't redirect log to $log_path: $!";
112    
113  sub _log {  sub _log {
114          print strftime($TIMESTAMP,localtime()), ' ', join(" ",@_), $/;          my $out = strftime($TIMESTAMP,localtime()) . ' ' . join(" ",@_) . $/;
115            from_to( $out, 'UTF-8', $ENCODING );
116            print $out;
117  }  }
118    
119    # LOG following
120    
121    my %FOLLOWS =
122      (
123    #   ACCESS => "/var/log/apache/access.log",
124    #   ERROR => "/var/log/apache/error.log",
125      );
126    
127    sub add_follow_path {
128            my $path = shift;
129            my $name = $path;
130            $name =~ s/\..*$//;
131            warn "# using $path to announce messages from $name\n";
132            $FOLLOWS{$name} = $path;
133    }
134    
135    add_follow_path( $follows_path ) if ( -e $follows_path );
136    
137    # HTML formatters
138    
139    my %escape = ('<'=>'&lt;', '>'=>'&gt;', '&'=>'&amp;', '"'=>'&quot;');
140    my $escape_re  = join '|' => keys %escape;
141    
142    my $tag_regex = '\b([\w-_]+)//';
143    
144    my %nick_enumerator;
145    my $max_color = 0;
146    
147    my $filter = {
148            message => sub {
149                    my $m = shift || return;
150    
151                    # protect HTML from wiki modifications
152                    sub e {
153                            my $t = shift;
154                            return 'uri_unescape{' . uri_escape($t) . '}';
155                    }
156    
157                    $m =~ s/($escape_re)/$escape{$1}/gs;
158                    $m =~ s#($RE{URI}{HTTP})#e(qq{<a href="$1">$1</a>})#egs ||
159                    $m =~ s#\/(\w+)\/#<i>$1</i>#gs;
160                    $m =~ s#$tag_regex#e(qq{<a href="$url?tag=$1" class="tag">$1</a>})#egs;
161                    $m =~ s#\*(\w+)\*#<b>$1</b>#gs;
162                    $m =~ s#_(\w+)_#<u>$1</u>#gs;
163    
164                    $m =~ s#uri_unescape{([^}]+)}#uri_unescape($1)#egs;
165                    return $m;
166            },
167            nick => sub {
168                    my $n = shift || return;
169                    if (! $nick_enumerator{$n})  {
170                            my $max = scalar keys %nick_enumerator;
171                            $nick_enumerator{$n} = $max + 1;
172                    }
173                    return '<span class="nick col-' .
174                            ( $nick_enumerator{$n} % $max_color ) .
175                            '">' . $n . '</span>';
176            },
177    };
178    
179  my $dbh = DBI->connect($DSN,"","", { RaiseError => 1, AutoCommit => 1 }) || die $DBI::errstr;  my $dbh = DBI->connect($DSN,"","", { RaiseError => 1, AutoCommit => 1 }) || die $DBI::errstr;
180    
181  my $sql_schema = {  my $sql_schema = {
182          log => '          log => qq{
183  create table log (  create table log (
184          id serial,          id serial,
185          time timestamp default now(),          time timestamp default now(),
# Line 105  create table log ( Line 193  create table log (
193  create index log_time on log(time);  create index log_time on log(time);
194  create index log_channel on log(channel);  create index log_channel on log(channel);
195  create index log_nick on log(nick);  create index log_nick on log(nick);
196          ',          },
197          meta => '          meta => q{
198  create table meta (  create table meta (
199          nick text not null,          nick text not null,
200          channel text not null,          channel text not null,
201          name text not null,          name text not null,
202          value text,          value text,
203          changed timestamp default now(),          changed timestamp default 'now()',
204          primary key(nick,channel,name)          primary key(nick,channel,name)
205  );  );
206          ',          },
207            feeds => qq{
208    create table feeds (
209            id serial,
210            url text not null,
211            name text,
212            delay interval not null default '5 min',
213            active boolean default true,
214            last_update timestamp default 'now()',
215            polls int default 0,
216            updates int default 0
217    );
218    create unique index feeds_url on feeds(url);
219    insert into feeds (url,name) values ('http://wiki.razmjenavjestina.org/feed/workspace/razmjenavjestina?category=Recent%20Changes','wiki');
220            },
221  };  };
222    
223  foreach my $table ( keys %$sql_schema ) {  foreach my $table ( keys %$sql_schema ) {
# Line 179  sub meta { Line 281  sub meta {
281    
282    
283    
284  my $sth = $dbh->prepare(qq{  my $sth_insert_log = $dbh->prepare(qq{
285  insert into log  insert into log
286          (channel, me, nick, message, time)          (channel, me, nick, message, time)
287  values (?,?,?,?,?)  values (?,?,?,?,?)
# Line 187  values (?,?,?,?,?) Line 289  values (?,?,?,?,?)
289    
290    
291  my $tags;  my $tags;
 my $tag_regex = '\b([\w-_]+)//';  
292    
293  =head2 get_from_log  =head2 get_from_log
294    
# Line 224  C<me>, C<nick> and C<message> keys. Line 325  C<me>, C<nick> and C<message> keys.
325  sub get_from_log {  sub get_from_log {
326          my $args = {@_};          my $args = {@_};
327    
328          $args->{fmt} ||= {          if ( ! $args->{fmt} ) {
329                  date => '[%s] ',                  $args->{fmt} = {
330                  time => '{%s} ',                          date => '[%s] ',
331                  time_channel => '{%s %s} ',                          time => '{%s} ',
332                  nick => '%s: ',                          time_channel => '{%s %s} ',
333                  me_nick => '***%s ',                          nick => '%s: ',
334                  message => '%s',                          me_nick => '***%s ',
335          };                          message => '%s',
336                    };
337            }
338    
339          my $sql_message = qq{          my $sql_message = qq{
340                  select                  select
# Line 254  sub get_from_log { Line 357  sub get_from_log {
357    
358          my $sql = $context ? $sql_context : $sql_message;          my $sql = $context ? $sql_context : $sql_message;
359    
360          $sql .= " where message ilike ? or nick ilike ? " if ($args->{search});          sub check_date {
361          $sql .= " where id in (" . join(",", @{ $tags->{ $args->{tag} } }) . ") " if ($args->{tag} && $tags->{ $args->{tag} });                  my $date = shift || return;
362          $sql .= " where date(time) = ? " if ($args->{date});                  my $new_date = eval { DateTime::Format::ISO8601->parse_datetime( $date )->ymd; };
363          $sql .= " order by log.time desc";                  if ( $@ ) {
364          $sql .= " limit " . $args->{limit} if ($args->{limit});                          warn "invalid date $date\n";
365                            $new_date = DateTime->now->ymd;
366                    }
367                    return $new_date;
368            }
369    
370            my @where;
371            my @args;
372    
         my $sth = $dbh->prepare( $sql );  
373          if (my $search = $args->{search}) {          if (my $search = $args->{search}) {
374                  $search =~ s/^\s+//;                  $search =~ s/^\s+//;
375                  $search =~ s/\s+$//;                  $search =~ s/\s+$//;
376                  $sth->execute( ( '%' . $search . '%' ) x 2 );                  push @where, 'message ilike ? or nick ilike ?';
377                  _log "search for '$search' returned ", $sth->rows, " results ", $context || '';                  push @args, ( ( '%' . $search . '%' ) x 2 );
378          } elsif (my $tag = $args->{tag}) {                  _log "search for '$search'";
                 $sth->execute();  
                 _log "tag '$tag' returned ", $sth->rows, " results ", $context || '';  
         } elsif (my $date = $args->{date}) {  
                 $sth->execute($date);  
                 _log "found ", $sth->rows, " messages for date $date ", $context || '';  
         } else {  
                 $sth->execute();  
379          }          }
380    
381            if ($args->{tag} && $tags->{ $args->{tag} }) {
382                    push @where, 'id in (' . join(',', @{ $tags->{ $args->{tag} } }) . ')';
383                    _log "search for tags $args->{tag}";
384            }
385    
386            if (my $date = $args->{date} ) {
387                    $date = check_date( $date );
388                    push @where, 'date(time) = ?';
389                    push @args, $date;
390                    _log "search for date $date";
391            }
392    
393            $sql .= " where " . join(" and ", @where) if @where;
394    
395            $sql .= " order by log.time desc";
396            $sql .= " limit " . $args->{limit} if ($args->{limit});
397    
398            #warn "### sql: $sql ", dump( @args );
399    
400            my $sth = $dbh->prepare( $sql );
401            eval { $sth->execute( @args ) };
402            return if $@;
403    
404          my $last_row = {          my $last_row = {
405                  date => '',                  date => '',
406                  time => '',                  time => '',
# Line 395  my $cloud = HTML::TagCloud->new; Line 521  my $cloud = HTML::TagCloud->new;
521    
522  =head2 add_tag  =head2 add_tag
523    
524   add_tag( id => 42, message => 'irc message' );   add_tag( id => 42, message => 'irc message', nick => 'foobar' [, me => 1 ] );
525    
526  =cut  =cut
527    
528    my @last_tags;
529    
530  sub add_tag {  sub add_tag {
531          my $arg = {@_};          my $arg = {@_};
532    
# Line 407  sub add_tag { Line 535  sub add_tag {
535          my $m = $arg->{message};          my $m = $arg->{message};
536          from_to('UTF-8', 'iso-8859-2', $m) if (is_utf8($m));          from_to('UTF-8', 'iso-8859-2', $m) if (is_utf8($m));
537    
538            my @tags;
539    
540          while ($m =~ s#$tag_regex##s) {          while ($m =~ s#$tag_regex##s) {
541                  my $tag = $1;                  my $tag = $1;
542                  next if (! $tag || $tag =~ m/https?:/i);                  next if (! $tag || $tag =~ m/https?:/i);
543                  push @{ $tags->{$tag} }, $arg->{id};                  push @{ $tags->{$tag} }, $arg->{id};
544                  #warn "+tag $tag: $arg->{id}\n";                  #warn "+tag $tag: $arg->{id}\n";
545                  $cloud->add($tag, "?tag=$tag", scalar @{$tags->{$tag}} + 1);                  $cloud->add($tag, "$url?tag=$tag", scalar @{$tags->{$tag}} + 1);
546                    push @tags, $tag;
547    
548          }          }
549    
550            if ( @tags ) {
551                    pop @last_tags if $#last_tags == $last_x_tags;
552                    unshift @last_tags, { tags => [ @tags ], %$arg };
553            }
554    
555  }  }
556    
557  =head2 seed_tags  =head2 seed_tags
# Line 423  Read all tags from database and create i Line 561  Read all tags from database and create i
561  =cut  =cut
562    
563  sub seed_tags {  sub seed_tags {
564          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 });
565          $sth->execute;          $sth->execute;
566          while (my $row = $sth->fetchrow_hashref) {          while (my $row = $sth->fetchrow_hashref) {
567                  add_tag( %$row );                  add_tag( %$row );
568          }          }
569    
570          foreach my $tag (keys %$tags) {          foreach my $tag (keys %$tags) {
571                  $cloud->add($tag, "?tag=$tag", scalar @{$tags->{$tag}} + 1);                  $cloud->add($tag, "$url?tag=$tag", scalar @{$tags->{$tag}} + 1);
572          }          }
573  }  }
574    
# Line 443  seed_tags; Line 581  seed_tags;
581          channel => '#foobar',          channel => '#foobar',
582          me => 0,          me => 0,
583          nick => 'dpavlin',          nick => 'dpavlin',
584          msg => 'test message',          message => 'test message',
585          time => '2006-06-25 18:57:18',          time => '2006-06-25 18:57:18',
586    );    );
587    
# Line 455  C<me> if not specified will be C<0> (not Line 593  C<me> if not specified will be C<0> (not
593    
594  sub save_message {  sub save_message {
595          my $a = {@_};          my $a = {@_};
596            confess "have msg" if $a->{msg};
597          $a->{me} ||= 0;          $a->{me} ||= 0;
598          $a->{time} ||= strftime($TIMESTAMP,localtime());          $a->{time} ||= strftime($TIMESTAMP,localtime());
599    
600          _log          _log
601                  $a->{channel}, " ",                  $a->{channel}, " ",
602                  $a->{me} ? "***" . $a->{nick} : "<" . $a->{nick} . ">",                  $a->{me} ? "***" . $a->{nick} : "<" . $a->{nick} . ">",
603                  " " . $a->{msg};                  " " . $a->{message};
604    
605          from_to($a->{msg}, 'UTF-8', $ENCODING);          $sth_insert_log->execute($a->{channel}, $a->{me}, $a->{nick}, $a->{message}, $a->{time});
606            add_tag( id => $dbh->last_insert_id(undef,undef,"log",undef), %$a );
         $sth->execute($a->{channel}, $a->{me}, $a->{nick}, $a->{msg}, $a->{time});  
         add_tag( id => $dbh->last_insert_id(undef,undef,"log",undef),  
                 message => $a->{msg});  
607  }  }
608    
609    
610  if ($import_dircproxy) {  if ($import_dircproxy) {
611          open(my $l, $import_dircproxy) || die "can't open $import_dircproxy: $!";          open(my $l, $import_dircproxy) || die "can't open $import_dircproxy: $!";
612          warn "importing $import_dircproxy...\n";          warn "importing $import_dircproxy...\n";
613          my $tz_offset = 2 * 60 * 60;    # TZ GMT+2          my $tz_offset = 1 * 60 * 60;    # TZ GMT+2
614          while(<$l>) {          while(<$l>) {
615                  chomp;                  chomp;
616                  if (/^@(\d+)\s(\S+)\s(.+)$/) {                  if (/^@(\d+)\s(\S+)\s(.+)$/) {
# Line 492  if ($import_dircproxy) { Line 628  if ($import_dircproxy) {
628                                  channel => $CHANNEL,                                  channel => $CHANNEL,
629                                  me => $me,                                  me => $me,
630                                  nick => $nick,                                  nick => $nick,
631                                  msg => $msg,                                  message => $msg,
632                                  time => $dt->ymd . " " . $dt->hms,                                  time => $dt->ymd . " " . $dt->hms,
633                          ) if ($nick !~ m/^-/);                          ) if ($nick !~ m/^-/);
634    
# Line 505  if ($import_dircproxy) { Line 641  if ($import_dircproxy) {
641          exit;          exit;
642  }  }
643    
644    #
645    # RSS follow
646    #
647    
648    my $_rss;
649    
650    
651    sub rss_fetch {
652            my ($args) = @_;
653    
654            # how many messages to send out when feed is seen for the first time?
655            my $send_rss_msgs = 1;
656    
657            _log "RSS fetch", $args->{url};
658    
659            my $feed = XML::Feed->parse(URI->new( $args->{url} ));
660            if ( ! $feed ) {
661                    _log("can't fetch RSS ", $args->{url});
662                    return;
663            }
664            my ( $total, $updates ) = ( 0, 0 );
665            for my $entry ($feed->entries) {
666                    $total++;
667    
668                    # seen allready?
669                    return if $_rss->{$feed->link}->{seen}->{$entry->id}++ > 0;
670    
671                    sub prefix {
672                            my ($txt,$var) = @_;
673                            $var =~ s/^\s+//g;
674                            return $txt . $var if $var;
675                    }
676    
677                    my $msg;
678                    $msg .= prefix( 'From: ' , $feed->title );
679                    $msg .= prefix( ' by ' , $entry->author );
680                    $msg .= prefix( ' -- ' , $entry->link );
681    #               $msg .= prefix( ' id ' , $entry->id );
682    
683                    if ( $args->{kernel} && $send_rss_msgs ) {
684                            warn "# sending to $CHANNEL\n";
685                            $send_rss_msgs--;
686                            $args->{kernel}->post( $IRC_ALIAS => notice => $CHANNEL, $msg );
687                            $updates++;
688                            #$sth_insert_log->execute( $CHANNEL, 1, $NICK, $msg, undef );
689                            _log('RSS', $msg);
690                    }
691            }
692    
693            my $sql = qq{ update feeds set last_update = now(), polls = polls + 1 };
694            $sql .= qq{, updates = updates + $updates } if $updates;
695            $sql .= qq{where id = } . $args->{id};
696            eval { $dbh->do( $sql ) };
697    
698            _log "RSS got $total items of which $updates new";
699    
700            return $updates;
701    }
702    
703    sub rss_fetch_all {
704            my $kernel = shift;
705            my $sql = qq{
706                    select id, url, name
707                    from feeds
708                    where active is true
709            };
710            # limit to newer feeds only if we are not sending messages out
711            $sql .= qq{     and last_update + delay < now() } if $kernel;
712            my $sth = $dbh->prepare( $sql );
713            $sth->execute();
714            warn "# ",$sth->rows," active RSS feeds\n";
715            my $count = 0;
716            while (my $row = $sth->fetchrow_hashref) {
717                    $row->{kernel} = $kernel if $kernel;
718                    $count += rss_fetch( $row );
719            }
720            return "OK, fetched $count posts from " . $sth->rows . " feeds";
721    }
722    
723    
724    sub rss_check_updates {
725            my $kernel = shift;
726            my $last_t = $_rss->{last_poll} || time();
727            my $t = time();
728            if ( $last_t - $t > $rss_min_delay ) {
729                    $_rss->{last_poll} = $t;
730                    _log rss_fetch_all( $kernel );
731            }
732    }
733    
734    # seed rss seen cache so we won't send out all items on startup
735    _log rss_fetch_all;
736    
737  #  #
738  # POE handing part  # POE handing part
# Line 516  my $ping;                                              # ping stats Line 744  my $ping;                                              # ping stats
744    
745  POE::Component::IRC->new($IRC_ALIAS);  POE::Component::IRC->new($IRC_ALIAS);
746    
747  POE::Session->create( inline_states =>  POE::Session->create( inline_states => {
748     {_start => sub {                _start => sub {      
749                  $_[KERNEL]->post($IRC_ALIAS => register => 'all');                  $_[KERNEL]->post($IRC_ALIAS => register => 'all');
750                  $_[KERNEL]->post($IRC_ALIAS => connect => $CONNECT);                  $_[KERNEL]->post($IRC_ALIAS => connect => $CONNECT);
751      },      },
752      irc_255 => sub {    # server is done blabbing      irc_255 => sub {    # server is done blabbing
753                  $_[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;  
754                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "IDENTIFY $NICK" );                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "IDENTIFY $NICK" );
755      },      },
756      irc_public => sub {      irc_public => sub {
# Line 534  POE::Session->create( inline_states => Line 759  POE::Session->create( inline_states =>
759                  my $channel = $_[ARG1]->[0];                  my $channel = $_[ARG1]->[0];
760                  my $msg = $_[ARG2];                  my $msg = $_[ARG2];
761    
762                  save_message( channel => $channel, me => 0, nick => $nick, msg => $msg);                  save_message( channel => $channel, me => 0, nick => $nick, message => $msg);
763                  meta( $nick, $channel, 'last-msg', $msg );                  meta( $nick, $channel, 'last-msg', $msg );
764      },      },
765      irc_ctcp_action => sub {      irc_ctcp_action => sub {
# Line 543  POE::Session->create( inline_states => Line 768  POE::Session->create( inline_states =>
768                  my $channel = $_[ARG1]->[0];                  my $channel = $_[ARG1]->[0];
769                  my $msg = $_[ARG2];                  my $msg = $_[ARG2];
770    
771                  save_message( channel => $channel, me => 1, nick => $nick, msg => $msg);                  save_message( channel => $channel, me => 1, nick => $nick, message => $msg);
772    
773                  if ( my $twitter = ( $nick, $channel, 'twitter' ) ) {                  if ( $use_twitter ) {
774                          _log("FIXME: send twitter for $nick on $channel [$twitter]");                          if ( my $twitter = meta( $nick, $NICK, 'twitter' ) ) {
775                                    my ($login,$passwd) = split(/\s+/,$twitter,2);
776                                    _log("sending twitter for $nick/$login on $channel ");
777                                    my $bot = Net::Twitter->new( username=>$login, password=>$passwd );
778                                    $bot->update("<${channel}> $msg");
779                            }
780                  }                  }
781    
782      },      },
783          irc_ping => sub {          irc_ping => sub {
784                  warn "pong ", $_[ARG0], $/;                  _log( "pong ", $_[ARG0] );
785                  $ping->{ $_[ARG0] }++;                  $ping->{ $_[ARG0] }++;
786                    rss_check_updates( $_[KERNEL] );
787          },          },
788          irc_invite => sub {          irc_invite => sub {
789                  my $kernel = $_[KERNEL];                  my $kernel = $_[KERNEL];
790                  my $nick = (split /!/, $_[ARG0])[0];                  my $nick = (split /!/, $_[ARG0])[0];
791                  my $channel = $_[ARG1];                  my $channel = $_[ARG1];
792    
793                  warn "invited to $channel by $nick";                  _log "invited to $channel by $nick";
794    
795                  $_[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..." );
796                  $_[KERNEL]->post($IRC_ALIAS => join => $channel);                  $_[KERNEL]->post($IRC_ALIAS => join => $channel);
# Line 570  POE::Session->create( inline_states => Line 801  POE::Session->create( inline_states =>
801                  my $nick = (split /!/, $_[ARG0])[0];                  my $nick = (split /!/, $_[ARG0])[0];
802                  my $msg = $_[ARG2];                  my $msg = $_[ARG2];
803                  my $channel = $_[ARG1]->[0];                  my $channel = $_[ARG1]->[0];
                 from_to($msg, 'UTF-8', $ENCODING);  
804    
805                  my $res = "unknown command '$msg', try /msg $NICK help!";                  my $res = "unknown command '$msg', try /msg $NICK help!";
806                  my @out;                  my @out;
# Line 593  POE::Session->create( inline_states => Line 823  POE::Session->create( inline_states =>
823    
824                          my $sth = $dbh->prepare(qq{                          my $sth = $dbh->prepare(qq{
825                                  select                                  select
826                                          nick,                                          trim(both '_' from nick) as nick,
827                                          count(*) as count,                                          count(*) as count,
828                                          sum(length(message)) as len                                          sum(length(message)) as len
829                                  from log                                  from log
830                                  group by nick                                  group by trim(both '_' from nick)
831                                  order by len desc,count desc                                  order by len desc,count desc
832                                  limit $nr                                  limit $nr
833                          });                          });
# Line 614  POE::Session->create( inline_states => Line 844  POE::Session->create( inline_states =>
844    
845                          foreach my $res (get_from_log( limit => $limit )) {                          foreach my $res (get_from_log( limit => $limit )) {
846                                  _log "last: $res";                                  _log "last: $res";
                                 from_to($res, $ENCODING, 'UTF-8');  
847                                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );                                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );
848                          }                          }
849    
# Line 629  POE::Session->create( inline_states => Line 858  POE::Session->create( inline_states =>
858                                          search => $what,                                          search => $what,
859                                  )) {                                  )) {
860                                  _log "search [$what]: $res";                                  _log "search [$what]: $res";
                                 from_to($res, $ENCODING, 'UTF-8');  
861                                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );                                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );
862                          }                          }
863    
# Line 669  POE::Session->create( inline_states => Line 897  POE::Session->create( inline_states =>
897    
898                  } elsif ($msg =~ m/^ping/) {                  } elsif ($msg =~ m/^ping/) {
899                          $res = "ping = " . dump( $ping );                          $res = "ping = " . dump( $ping );
900                  } elsif ($msg =~ m/^(?:twitter)\s+(\S+)\s+(.*?)/) {                  } elsif ($msg =~ m/^conf(?:ig)*\s*(last-size|twitter)*\s*(.*)/) {
                         if ( defined( $2 ) ) {  
                                 meta($nick, $channel, 'twitter', "$1\t$2");  
                                 $res = "saved twitter auth for $1 -- /me on $channel will auto-update twitter status";  
                         } else {  
                                 meta($nick, $channel, 'twitter', '' );  
                                 $res = "removed twitter status update for /me on $channel";  
                         }  
                 } elsif ($msg =~ m/^conf(?:ig)*\s*(last-size)*\s*(\d*)/) {  
901                          if ( ! defined( $1 ) ) {                          if ( ! defined( $1 ) ) {
902                                  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 = ? });
903                                  $sth->execute( $nick, $channel );                                  $sth->execute( $nick, $channel );
904                                  $res = "config for $nick ";                                  $res = "config for $nick on $channel";
905                                  while ( my ($n,$v) = $sth->fetchrow_array ) {                                  while ( my ($n,$v) = $sth->fetchrow_array ) {
906                                          $res .= "| $n = $v";                                          $res .= " | $n = $v";
907                                  }                                  }
908                          } elsif ( defined( $2 ) ) {                          } elsif ( ! $2 ) {
                                 meta( $nick, $channel, $1, $2 );  
                                 $res = "saved $1 = $2";  
                         } else {  
909                                  my $val = meta( $nick, $channel, $1 );                                  my $val = meta( $nick, $channel, $1 );
910                                  $res = "current $1 = " . ( $val ? $val : 'undefined' );                                  $res = "current $1 = " . ( $val ? $val : 'undefined' );
911                            } else {
912                                    my $validate = {
913                                            'last-size' => qr/^\d+/,
914                                            'twitter' => qr/^\w+\s+\w+/,
915                                    };
916    
917                                    my ( $op, $val ) = ( $1, $2 );
918    
919                                    if ( my $regex = $validate->{$op} ) {
920                                            if ( $val =~ $regex ) {
921                                                    meta( $nick, $channel, $op, $val );
922                                                    $res = "saved $op = $val";
923                                            } else {
924                                                    $res = "config option $op = $val doesn't validate against $regex";
925                                            }
926                                    } else {
927                                            $res = "config option $op doesn't exist";
928                                    }
929                          }                          }
930                    } elsif ($msg =~ m/^rss-update/) {
931                            $res = rss_fetch_all( $_[KERNEL] );
932                    } elsif ($msg =~ m/^rss-clean/) {
933                            $_rss = undef;
934                            $res = "OK, cleaned RSS cache";
935                    } elsif ($msg =~ m!^rss-(add|remove|stop|start)\s+(http://\S+)\s*(.*)!) {
936                            my $sql = {
937                                    add             => qq{ insert into feeds (url,name) values (?,?) },
938    #                               remove  => qq{ delete from feeds                                where url = ? and name = ? },
939                                    start   => qq{ update feeds set active = true   where url = ? -- ? },
940                                    stop    => qq{ update feeds set active = false  where url = ? -- ? },
941                                    
942                            };
943                            if (my $q = $sql->{$1} ) {
944                                    my $sth = $dbh->prepare( $q );
945                                    warn "## SQL $q ( $2 | $3 )\n";
946                                    eval { $sth->execute( $2, $3 ) };
947                            }
948    
949                            $res ||= "OK, RSS $1 : $2 - $3";
950                  }                  }
951    
952                  if ($res) {                  if ($res) {
953                          _log ">> [$nick] $res";                          _log ">> [$nick] $res";
                         from_to($res, $ENCODING, 'UTF-8');  
954                          $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );                          $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );
955                  }                  }
956    
957                    rss_check_updates( $_[KERNEL] );
958          },          },
959          irc_477 => sub {          irc_477 => sub {
960                  _log "# irc_477: ",$_[ARG1];                  _log "# irc_477: ",$_[ARG1];
# Line 738  POE::Session->create( inline_states => Line 993  POE::Session->create( inline_states =>
993                          "";                          "";
994        0;                        # false for signals        0;                        # false for signals
995      },      },
     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);  
     }  
996     },     },
997    );    );
998    
999  # http server  # http server
1000    
1001  my $httpd = POE::Component::Server::HTTP->new(  my $httpd = POE::Component::Server::HTTP->new(
1002          Port => $NICK =~ m/-dev/ ? 8001 : 8000,          Port => $http_port,
1003            PreHandler => {
1004                    '/' => sub {
1005                            $_[0]->header(Connection => 'close')
1006                    }
1007            },
1008          ContentHandler => { '/' => \&root_handler },          ContentHandler => { '/' => \&root_handler },
1009          Headers        => { Server => 'irc-logger' },          Headers        => { Server => 'irc-logger' },
1010  );  );
1011    
 my %escape = ('<'=>'&lt;', '>'=>'&gt;', '&'=>'&amp;', '"'=>'&quot;');  
 my $escape_re  = join '|' => keys %escape;  
   
1012  my $style = <<'_END_OF_STYLE_';  my $style = <<'_END_OF_STYLE_';
1013  p { margin: 0; padding: 0.1em; }  p { margin: 0; padding: 0.1em; }
1014  .time, .channel { color: #808080; font-size: 60%; }  .time, .channel { color: #808080; font-size: 60%; }
# Line 819  p { margin: 0; padding: 0.1em; } Line 1016  p { margin: 0; padding: 0.1em; }
1016  .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 ; }
1017  .message { color: #000000; font-size: 100%; }  .message { color: #000000; font-size: 100%; }
1018  .search { float: right; }  .search { float: right; }
1019    a:link.tag, a:visited.tag { border: 1px dashed #ccc; backgound: #ccc; text-decoration: none }
1020    a:hover.tag { border: 1px solid #eee }
1021    hr { border: 1px dashed #ccc; height: 1px; clear: both; }
1022    /*
1023  .col-0 { background: #ffff66 }  .col-0 { background: #ffff66 }
1024  .col-1 { background: #a0ffff }  .col-1 { background: #a0ffff }
1025  .col-2 { background: #99ff99 }  .col-2 { background: #99ff99 }
1026  .col-3 { background: #ff9999 }  .col-3 { background: #ff9999 }
1027  .col-4 { background: #ff66ff }  .col-4 { background: #ff66ff }
1028  a:link.tag, a:visited.tag { border: 1px dashed #ccc; backgound: #ccc; text-decoration: none }  */
1029  a:hover.tag { border: 1px solid #eee }  .calendar { border: 1px solid red; width: 100%; }
1030  hr { border: 1px dashed #ccc; height: 1px; clear: both; }  .month { border: 0px; width: 100%; }
1031  _END_OF_STYLE_  _END_OF_STYLE_
1032    
1033  my $max_color = 4;  $max_color = 0;
1034    
1035  my %nick_enumerator;  my @cols = qw(
1036            #ffcccc #ccffe6 #ccccff #e6ccff #ffccff #ffcce6 #ff9999 #ffcc99 #ffff99
1037            #ccff99 #99ff99 #99ffcc #99ccff #9999ff #cc99ff #ff6666 #ffb366 #ffff66
1038            #66ff66 #66ffb3 #66b3ff #6666ff #ff3333 #33ff33 #3399ff #3333ff #ff3399
1039            #a0a0a0 #ff0000 #ffff00 #80ff00 #0000ff #8000ff #ff00ff #ff0080 #994d00
1040            #999900 #009900 #cc0066 #c0c0c0 #ccff99 #99ff33 #808080 #660033 #ffffff
1041    );
1042    
1043    foreach my $c (@cols) {
1044            $style .= ".col-${max_color} { background: $c }\n";
1045            $max_color++;
1046    }
1047    warn "defined $max_color colors for users...\n";
1048    
1049  sub root_handler {  sub root_handler {
1050          my ($request, $response) = @_;          my ($request, $response) = @_;
1051          $response->code(RC_OK);          $response->code(RC_OK);
1052          $response->content_type("text/html; charset=$ENCODING");  
1053            # this doesn't seem to work, so moved to PreHandler
1054            #$response->header(Connection => 'close');
1055    
1056            return RC_OK if $request->uri =~ m/favicon.ico$/;
1057    
1058          my $q;          my $q;
1059    
# Line 850  sub root_handler { Line 1067  sub root_handler {
1067    
1068          my $search = $q->param('search') || $q->param('grep') || '';          my $search = $q->param('search') || $q->param('grep') || '';
1069    
1070            if ($request->url =~ m#/rss(?:/(tags|last-tag|follow.*)\w*(?:=(\d+))?)?#i) {
1071                    my $show = lc($1);
1072                    my $nr = $2;
1073    
1074                    my $type = 'RSS';       # Atom
1075    
1076                    $response->content_type( 'application/' . lc($type) . '+xml' );
1077    
1078                    my $html = '<!-- error -->';
1079                    #warn "create $type feed from ",dump( @last_tags );
1080    
1081                    my $feed = XML::Feed->new( $type );
1082                    $feed->link( $url );
1083    
1084                    if ( $show eq 'tags' ) {
1085                            $nr ||= 50;
1086                            $feed->title( "tags from $CHANNEL" );
1087                            $feed->link( "$url/tags" );
1088                            $feed->description( "tag cloud created from messages on channel $CHANNEL which have tags// in them" );
1089                            my $feed_entry = XML::Feed::Entry->new($type);
1090                            $feed_entry->title( "$nr tags from $CHANNEL" );
1091                            $feed_entry->author( $NICK );
1092                            $feed_entry->link( '/#tags'  );
1093    
1094                            $feed_entry->content(
1095                                    qq{<![CDATA[<style type="text/css">}
1096                                    . $cloud->css
1097                                    . qq{</style>}
1098                                    . $cloud->html( $nr )
1099                                    . qq{]]>}
1100                            );
1101                            $feed->add_entry( $feed_entry );
1102    
1103                    } elsif ( $show eq 'last-tag' ) {
1104    
1105                            $nr ||= $last_x_tags;
1106                            $nr = $last_x_tags if $nr > $last_x_tags;
1107    
1108                            $feed->title( "last $nr tagged messages from $CHANNEL" );
1109                            $feed->description( "collects messages which have tags// in them" );
1110    
1111                            foreach my $m ( @last_tags ) {
1112    #                               warn dump( $m );
1113                                    #my $tags = join(' ', @{$m->{tags}} );
1114                                    my $feed_entry = XML::Feed::Entry->new($type);
1115                                    $feed_entry->title( $m->{nick} . '@' . $m->{time} );
1116                                    $feed_entry->author( $m->{nick} );
1117                                    $feed_entry->link( '/#' . $m->{id}  );
1118                                    $feed_entry->issued( DateTime::Format::Flexible->build( $m->{time} ) );
1119    
1120                                    my $message = $filter->{message}->( $m->{message} );
1121                                    $message .= "<br/>\n" unless $message =~ m!<(/p|br/?)>!;
1122    #                               warn "## message = $message\n";
1123    
1124                                    #$feed_entry->summary(
1125                                    $feed_entry->content(
1126                                            "<![CDATA[$message]]>"
1127                                    );
1128                                    $feed_entry->category( join(', ', @{$m->{tags}}) );
1129                                    $feed->add_entry( $feed_entry );
1130    
1131                                    $nr--;
1132                                    last if $nr <= 0;
1133    
1134                            }
1135    
1136                    } elsif ( $show =~ m/^follow/ ) {
1137    
1138                            $feed->title( "Feeds which this bot follows" );
1139    
1140                            my $sth = $dbh->prepare( qq{ select * from feeds order by last_update desc } );
1141                            $sth->execute;
1142                            while (my $row = $sth->fetchrow_hashref) {
1143                                    my $feed_entry = XML::Feed::Entry->new($type);
1144                                    $feed_entry->title( $row->{name} );
1145                                    $feed_entry->link( $row->{url}  );
1146                                    $feed_entry->issued( DateTime::Format::Flexible->build( $row->{last_update} ) );
1147                                    $feed_entry->content(
1148                                            '<![CDATA[<pre>' . dump( $row ) . '</pre>]]>'
1149                                    );
1150                                    $feed->add_entry( $feed_entry );
1151                            }
1152    
1153                    } else {
1154                            _log "unknown rss request ",$request->url;
1155                            return RC_DENY;
1156                    }
1157    
1158                    $response->content( $feed->as_xml );
1159                    return RC_OK;
1160            }
1161    
1162            if ( $@ ) {
1163                    warn "$@";
1164            }
1165    
1166            $response->content_type("text/html; charset=UTF-8");
1167    
1168          my $html =          my $html =
1169                  qq{<html><head><title>$NICK</title><style type="text/css">$style} .                  qq{<html><head><title>$NICK</title><style type="text/css">$style}
1170                  $cloud->css .                  . $cloud->css
1171                  qq{</style></head><body>} .                  . qq{</style></head><body>}
1172                  qq{                  . qq{
1173                  <form method="post" class="search" action="/">                  <form method="post" class="search" action="/">
1174                  <input type="text" name="search" value="$search" size="10">                  <input type="text" name="search" value="$search" size="10">
1175                  <input type="submit" value="search">                  <input type="submit" value="search">
1176                  </form>                  </form>
1177                  } .                  }
1178                  $cloud->html(500) .                  . $cloud->html(500)
1179                  qq{<p>};                  . qq{<p>};
1180          if ($request->url =~ m#/history#) {  
1181            if ($request->url =~ m#/tags?#) {
1182                    # nop
1183            } elsif ($request->url =~ m#/history#) {
1184                  my $sth = $dbh->prepare(qq{                  my $sth = $dbh->prepare(qq{
1185                          select date(time) as date,count(*) as nr                          select date(time) as date,count(*) as nr,sum(length(message)) as len
1186                                  from log                                  from log
1187                                  group by date(time)                                  group by date(time)
1188                                  order by date(time) desc                                  order by date(time) desc
1189                  });                  });
1190                  $sth->execute();                  $sth->execute();
1191                  my ($l_yyyy,$l_mm) = (0,0);                  my ($l_yyyy,$l_mm) = (0,0);
1192                    $html .= qq{<table class="calendar"><tr>};
1193                  my $cal;                  my $cal;
1194                    my $ord = 0;
1195                  while (my $row = $sth->fetchrow_hashref) {                  while (my $row = $sth->fetchrow_hashref) {
1196                          # this is probably PostgreSQL specific, expects ISO date                          # this is probably PostgreSQL specific, expects ISO date
1197                          my ($yyyy,$mm,$dd) = split(/-/, $row->{date});                          my ($yyyy,$mm,$dd) = split(/-/, $row->{date});
1198                          if ($yyyy != $l_yyyy || $mm != $l_mm) {                          if ($yyyy != $l_yyyy || $mm != $l_mm) {
1199                                  $html .= $cal->as_HTML() if ($cal);                                  if ( $cal ) {
1200                                            $html .= qq{<td valign="top">} . $cal->as_HTML() . qq{</td>};
1201                                            $ord++;
1202                                            $html .= qq{</tr><tr>} if ( $ord % 3 == 0 );
1203                                    }
1204                                  $cal = new HTML::CalendarMonthSimple('month'=>$mm,'year'=>$yyyy);                                  $cal = new HTML::CalendarMonthSimple('month'=>$mm,'year'=>$yyyy);
1205                                  $cal->border(2);                                  $cal->border(1);
1206                                    $cal->width('30%');
1207                                    $cal->cellheight('5em');
1208                                    $cal->tableclass('month');
1209                                    #$cal->cellclass('day');
1210                                    $cal->sunday('SUN');
1211                                    $cal->saturday('SAT');
1212                                    $cal->weekdays('MON','TUE','WED','THU','FRI');
1213                                  ($l_yyyy,$l_mm) = ($yyyy,$mm);                                  ($l_yyyy,$l_mm) = ($yyyy,$mm);
1214                          }                          }
1215                          $cal->setcontent($dd, qq{                          $cal->setcontent($dd, qq[
1216                                  <a href="/?date=$row->{date}">$row->{nr}</a>                                  <a href="$url?date=$row->{date}">$row->{nr}</a><br/>$row->{len}
1217                          });                          ]);
1218                            
1219                  }                  }
1220                  $html .= $cal->as_HTML() if ($cal);                  $html .= qq{<td valign="top">} . $cal->as_HTML() . qq{</td></tr></table>};
1221    
1222          } else {          } else {
1223                  $html .= join("</p><p>",                  $html .= join("</p><p>",
1224                          get_from_log(                          get_from_log(
1225                                  limit => $q->param('last') || $q->param('date') ? undef : 100,                                  limit => ( $q->param('last') || $q->param('date') ) ? undef : 100,
1226                                  search => $search || undef,                                  search => $search || undef,
1227                                  tag => $q->param('tag') || undef,                                  tag => $q->param('tag') || undef,
1228                                  date => $q->param('date') || undef,                                  date => $q->param('date') || undef,
1229                                  fmt => {                                  fmt => {
1230                                          date => sub {                                          date => sub {
1231                                                  my $date = shift || return;                                                  my $date = shift || return;
1232                                                  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>};
1233                                          },                                          },
1234                                          time => '<span class="time">%s</span> ',                                          time => '<span class="time">%s</span> ',
1235                                          time_channel => '<span class="channel">%s %s</span> ',                                          time_channel => '<span class="channel">%s %s</span> ',
# Line 905  sub root_handler { Line 1237  sub root_handler {
1237                                          me_nick => '***%s&nbsp;',                                          me_nick => '***%s&nbsp;',
1238                                          message => '<span class="message">%s</span>',                                          message => '<span class="message">%s</span>',
1239                                  },                                  },
1240                                  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>';  
                                         },  
                                 },  
1241                          )                          )
1242                  );                  );
1243          }          }
# Line 934  sub root_handler { Line 1248  sub root_handler {
1248          </body></html>};          </body></html>};
1249    
1250          $response->content( $html );          $response->content( $html );
1251            warn "<< ", $request->method, " ", $request->uri, " created ", length($html), " bytes\n";
1252          return RC_OK;          return RC_OK;
1253  }  }
1254    
Legend:
Removed from v.50  
changed lines
  Added in v.87
  ViewVC Help
Powered by ViewVC 1.1.26