/[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 93 by dpavlin, Fri Mar 7 10:35:04 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    $rss_min_delay = 15;
59    
60    my $http_port = $NICK =~ m/-dev/ ? 8001 : 8000;
61    
62    my $url = "http://$HOSTNAME:$http_port";
63    
64  use POE qw(Component::IRC Wheel::FollowTail Component::Server::HTTP);  ## END CONFIG
65    
66    use POE qw(Component::IRC Component::Server::HTTP);
67  use HTTP::Status;  use HTTP::Status;
68  use DBI;  use DBI;
 use Encode qw/from_to is_utf8/;  
69  use Regexp::Common qw /URI/;  use Regexp::Common qw /URI/;
70  use CGI::Simple;  use CGI::Simple;
71  use HTML::TagCloud;  use HTML::TagCloud;
# Line 73  use POSIX qw/strftime/; Line 73  use POSIX qw/strftime/;
73  use HTML::CalendarMonthSimple;  use HTML::CalendarMonthSimple;
74  use Getopt::Long;  use Getopt::Long;
75  use DateTime;  use DateTime;
76    use URI::Escape;
77  use Data::Dump qw/dump/;  use Data::Dump qw/dump/;
78    use DateTime::Format::ISO8601;
79    use Carp qw/confess/;
80    use XML::Feed;
81    use DateTime::Format::Flexible;
82    
83    my $use_twitter = 1;
84    eval { require Net::Twitter; };
85    $use_twitter = 0 if ($@);
86    
87  my $import_dircproxy;  my $import_dircproxy;
88  my $log_path;  my $log_path;
# Line 82  GetOptions( Line 91  GetOptions(
91          'log:s' => \$log_path,          'log:s' => \$log_path,
92  );  );
93    
94    #$SIG{__DIE__} = sub {
95    #       confess "fatal error";
96    #};
97    
98  open(STDOUT, '>', $log_path) || warn "can't redirect log to $log_path: $!";  open(STDOUT, '>', $log_path) || warn "can't redirect log to $log_path: $!";
99    
100  sub _log {  sub _log {
101          print strftime($TIMESTAMP,localtime()), ' ', join(" ",@_), $/;          print strftime($TIMESTAMP,localtime()) . ' ' . join(" ",@_) . $/;
102  }  }
103    
104    # HTML formatters
105    
106    my %escape = ('<'=>'&lt;', '>'=>'&gt;', '&'=>'&amp;', '"'=>'&quot;');
107    my $escape_re  = join '|' => keys %escape;
108    
109    my $tag_regex = '\b([\w-_]+)//';
110    
111    my %nick_enumerator;
112    my $max_color = 0;
113    
114    my $filter = {
115            message => sub {
116                    my $m = shift || return;
117    
118                    # protect HTML from wiki modifications
119                    sub e {
120                            my $t = shift;
121                            return 'uri_unescape{' . uri_escape($t) . '}';
122                    }
123    
124                    $m =~ s/($escape_re)/$escape{$1}/gs;
125                    $m =~ s#($RE{URI}{HTTP})#e(qq{<a href="$1">$1</a>})#egs ||
126                    $m =~ s#\/(\w+)\/#<i>$1</i>#gs;
127                    $m =~ s#$tag_regex#e(qq{<a href="$url?tag=$1" class="tag">$1</a>})#egs;
128                    $m =~ s#\*(\w+)\*#<b>$1</b>#gs;
129                    $m =~ s#_(\w+)_#<u>$1</u>#gs;
130    
131                    $m =~ s#uri_unescape{([^}]+)}#uri_unescape($1)#egs;
132                    return $m;
133            },
134            nick => sub {
135                    my $n = shift || return;
136                    if (! $nick_enumerator{$n})  {
137                            my $max = scalar keys %nick_enumerator;
138                            $nick_enumerator{$n} = $max + 1;
139                    }
140                    return '<span class="nick col-' .
141                            ( $nick_enumerator{$n} % $max_color ) .
142                            '">' . $n . '</span>';
143            },
144    };
145    
146  my $dbh = DBI->connect($DSN,"","", { RaiseError => 1, AutoCommit => 1 }) || die $DBI::errstr;  my $dbh = DBI->connect($DSN,"","", { RaiseError => 1, AutoCommit => 1 }) || die $DBI::errstr;
147    $dbh->do( qq{ set client_encoding = 'UTF-8' } );
148    
149  my $sql_schema = {  my $sql_schema = {
150          log => '          log => qq{
151  create table log (  create table log (
152          id serial,          id serial,
153          time timestamp default now(),          time timestamp default now(),
# Line 105  create table log ( Line 161  create table log (
161  create index log_time on log(time);  create index log_time on log(time);
162  create index log_channel on log(channel);  create index log_channel on log(channel);
163  create index log_nick on log(nick);  create index log_nick on log(nick);
164          ',          },
165          meta => '          meta => q{
166  create table meta (  create table meta (
167          nick text not null,          nick text not null,
168          channel text not null,          channel text not null,
169          name text not null,          name text not null,
170          value text,          value text,
171          changed timestamp default now(),          changed timestamp default 'now()',
172          primary key(nick,channel,name)          primary key(nick,channel,name)
173  );  );
174          ',          },
175            feeds => qq{
176    create table feeds (
177            id serial,
178            url text not null,
179            name text,
180            delay interval not null default '5 min',
181            active boolean default true,
182            last_update timestamp default 'now()',
183            polls int default 0,
184            updates int default 0
185    );
186    create unique index feeds_url on feeds(url);
187    insert into feeds (url,name) values ('http://wiki.razmjenavjestina.org/feed/workspace/razmjenavjestina?category=Recent%20Changes','wiki');
188            },
189  };  };
190    
191  foreach my $table ( keys %$sql_schema ) {  foreach my $table ( keys %$sql_schema ) {
# Line 179  sub meta { Line 249  sub meta {
249    
250    
251    
252  my $sth = $dbh->prepare(qq{  my $sth_insert_log = $dbh->prepare(qq{
253  insert into log  insert into log
254          (channel, me, nick, message, time)          (channel, me, nick, message, time)
255  values (?,?,?,?,?)  values (?,?,?,?,?)
# Line 187  values (?,?,?,?,?) Line 257  values (?,?,?,?,?)
257    
258    
259  my $tags;  my $tags;
 my $tag_regex = '\b([\w-_]+)//';  
260    
261  =head2 get_from_log  =head2 get_from_log
262    
# Line 224  C<me>, C<nick> and C<message> keys. Line 293  C<me>, C<nick> and C<message> keys.
293  sub get_from_log {  sub get_from_log {
294          my $args = {@_};          my $args = {@_};
295    
296          $args->{fmt} ||= {          if ( ! $args->{fmt} ) {
297                  date => '[%s] ',                  $args->{fmt} = {
298                  time => '{%s} ',                          date => '[%s] ',
299                  time_channel => '{%s %s} ',                          time => '{%s} ',
300                  nick => '%s: ',                          time_channel => '{%s %s} ',
301                  me_nick => '***%s ',                          nick => '%s: ',
302                  message => '%s',                          me_nick => '***%s ',
303          };                          message => '%s',
304                    };
305            }
306    
307          my $sql_message = qq{          my $sql_message = qq{
308                  select                  select
# Line 254  sub get_from_log { Line 325  sub get_from_log {
325    
326          my $sql = $context ? $sql_context : $sql_message;          my $sql = $context ? $sql_context : $sql_message;
327    
328          $sql .= " where message ilike ? or nick ilike ? " if ($args->{search});          sub check_date {
329          $sql .= " where id in (" . join(",", @{ $tags->{ $args->{tag} } }) . ") " if ($args->{tag} && $tags->{ $args->{tag} });                  my $date = shift || return;
330          $sql .= " where date(time) = ? " if ($args->{date});                  my $new_date = eval { DateTime::Format::ISO8601->parse_datetime( $date )->ymd; };
331          $sql .= " order by log.time desc";                  if ( $@ ) {
332          $sql .= " limit " . $args->{limit} if ($args->{limit});                          warn "invalid date $date\n";
333                            $new_date = DateTime->now->ymd;
334                    }
335                    return $new_date;
336            }
337    
338            my @where;
339            my @args;
340    
         my $sth = $dbh->prepare( $sql );  
341          if (my $search = $args->{search}) {          if (my $search = $args->{search}) {
342                  $search =~ s/^\s+//;                  $search =~ s/^\s+//;
343                  $search =~ s/\s+$//;                  $search =~ s/\s+$//;
344                  $sth->execute( ( '%' . $search . '%' ) x 2 );                  push @where, 'message ilike ? or nick ilike ?';
345                  _log "search for '$search' returned ", $sth->rows, " results ", $context || '';                  push @args, ( ( '%' . $search . '%' ) x 2 );
346          } 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();  
347          }          }
348    
349            if ($args->{tag} && $tags->{ $args->{tag} }) {
350                    push @where, 'id in (' . join(',', @{ $tags->{ $args->{tag} } }) . ')';
351                    _log "search for tags $args->{tag}";
352            }
353    
354            if (my $date = $args->{date} ) {
355                    $date = check_date( $date );
356                    push @where, 'date(time) = ?';
357                    push @args, $date;
358                    _log "search for date $date";
359            }
360    
361            $sql .= " where " . join(" and ", @where) if @where;
362    
363            $sql .= " order by log.time desc";
364            $sql .= " limit " . $args->{limit} if ($args->{limit});
365    
366            #warn "### sql: $sql ", dump( @args );
367    
368            my $sth = $dbh->prepare( $sql );
369            eval { $sth->execute( @args ) };
370            return if $@;
371    
372          my $last_row = {          my $last_row = {
373                  date => '',                  date => '',
374                  time => '',                  time => '',
# Line 395  my $cloud = HTML::TagCloud->new; Line 489  my $cloud = HTML::TagCloud->new;
489    
490  =head2 add_tag  =head2 add_tag
491    
492   add_tag( id => 42, message => 'irc message' );   add_tag( id => 42, message => 'irc message', nick => 'foobar' [, me => 1 ] );
493    
494  =cut  =cut
495    
496    my @last_tags;
497    
498  sub add_tag {  sub add_tag {
499          my $arg = {@_};          my $arg = {@_};
500    
501          return unless ($arg->{id} && $arg->{message});          return unless ($arg->{id} && $arg->{message});
502    
503          my $m = $arg->{message};          my $m = $arg->{message};
504          from_to('UTF-8', 'iso-8859-2', $m) if (is_utf8($m));  
505            my @tags;
506    
507          while ($m =~ s#$tag_regex##s) {          while ($m =~ s#$tag_regex##s) {
508                  my $tag = $1;                  my $tag = $1;
509                  next if (! $tag || $tag =~ m/https?:/i);                  next if (! $tag || $tag =~ m/https?:/i);
510                  push @{ $tags->{$tag} }, $arg->{id};                  push @{ $tags->{$tag} }, $arg->{id};
511                  #warn "+tag $tag: $arg->{id}\n";                  #warn "+tag $tag: $arg->{id}\n";
512                  $cloud->add($tag, "?tag=$tag", scalar @{$tags->{$tag}} + 1);                  $cloud->add($tag, "$url?tag=$tag", scalar @{$tags->{$tag}} + 1);
513                    push @tags, $tag;
514    
515            }
516    
517            if ( @tags ) {
518                    pop @last_tags if $#last_tags == $last_x_tags;
519                    unshift @last_tags, { tags => [ @tags ], %$arg };
520          }          }
521    
522  }  }
523    
524  =head2 seed_tags  =head2 seed_tags
# Line 423  Read all tags from database and create i Line 528  Read all tags from database and create i
528  =cut  =cut
529    
530  sub seed_tags {  sub seed_tags {
531          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 });
532          $sth->execute;          $sth->execute;
533          while (my $row = $sth->fetchrow_hashref) {          while (my $row = $sth->fetchrow_hashref) {
534                  add_tag( %$row );                  add_tag( %$row );
535          }          }
536    
537          foreach my $tag (keys %$tags) {          foreach my $tag (keys %$tags) {
538                  $cloud->add($tag, "?tag=$tag", scalar @{$tags->{$tag}} + 1);                  $cloud->add($tag, "$url?tag=$tag", scalar @{$tags->{$tag}} + 1);
539          }          }
540  }  }
541    
# Line 443  seed_tags; Line 548  seed_tags;
548          channel => '#foobar',          channel => '#foobar',
549          me => 0,          me => 0,
550          nick => 'dpavlin',          nick => 'dpavlin',
551          msg => 'test message',          message => 'test message',
552          time => '2006-06-25 18:57:18',          time => '2006-06-25 18:57:18',
553    );    );
554    
# Line 455  C<me> if not specified will be C<0> (not Line 560  C<me> if not specified will be C<0> (not
560    
561  sub save_message {  sub save_message {
562          my $a = {@_};          my $a = {@_};
563            confess "have msg" if $a->{msg};
564          $a->{me} ||= 0;          $a->{me} ||= 0;
565          $a->{time} ||= strftime($TIMESTAMP,localtime());          $a->{time} ||= strftime($TIMESTAMP,localtime());
566    
567          _log          _log
568                  $a->{channel}, " ",                  $a->{channel}, " ",
569                  $a->{me} ? "***" . $a->{nick} : "<" . $a->{nick} . ">",                  $a->{me} ? "***" . $a->{nick} : "<" . $a->{nick} . ">",
570                  " " . $a->{msg};                  " " . $a->{message};
   
         from_to($a->{msg}, 'UTF-8', $ENCODING);  
571    
572          $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});
573          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});  
574  }  }
575    
576    
577  if ($import_dircproxy) {  if ($import_dircproxy) {
578          open(my $l, $import_dircproxy) || die "can't open $import_dircproxy: $!";          open(my $l, $import_dircproxy) || die "can't open $import_dircproxy: $!";
579          warn "importing $import_dircproxy...\n";          warn "importing $import_dircproxy...\n";
580          my $tz_offset = 2 * 60 * 60;    # TZ GMT+2          my $tz_offset = 1 * 60 * 60;    # TZ GMT+2
581          while(<$l>) {          while(<$l>) {
582                  chomp;                  chomp;
583                  if (/^@(\d+)\s(\S+)\s(.+)$/) {                  if (/^@(\d+)\s(\S+)\s(.+)$/) {
# Line 492  if ($import_dircproxy) { Line 595  if ($import_dircproxy) {
595                                  channel => $CHANNEL,                                  channel => $CHANNEL,
596                                  me => $me,                                  me => $me,
597                                  nick => $nick,                                  nick => $nick,
598                                  msg => $msg,                                  message => $msg,
599                                  time => $dt->ymd . " " . $dt->hms,                                  time => $dt->ymd . " " . $dt->hms,
600                          ) if ($nick !~ m/^-/);                          ) if ($nick !~ m/^-/);
601    
# Line 505  if ($import_dircproxy) { Line 608  if ($import_dircproxy) {
608          exit;          exit;
609  }  }
610    
611    #
612    # RSS follow
613    #
614    
615    my $_rss;
616    
617    
618    sub rss_fetch {
619            my ($args) = @_;
620    
621            # how many messages to send out when feed is seen for the first time?
622            my $send_rss_msgs = 1;
623    
624            _log "RSS fetch", $args->{url};
625    
626            my $feed = XML::Feed->parse(URI->new( $args->{url} ));
627            if ( ! $feed ) {
628                    _log("can't fetch RSS ", $args->{url});
629                    return;
630            }
631    
632            my ( $total, $updates ) = ( 0, 0 );
633            for my $entry ($feed->entries) {
634                    $total++;
635    
636                    # seen allready?
637                    next if $_rss->{$feed->link}->{seen}->{$entry->id}++ > 0;
638    
639                    sub prefix {
640                            my ($txt,$var) = @_;
641                            $var =~ s/\s+/ /gs;
642                            $var =~ s/^\s+//g;
643                            $var =~ s/\s+$//g;
644                            return $txt . $var if $var;
645                    }
646    
647                    my $msg;
648                    $msg .= prefix( 'From: ' , $args->{name} || $feed->title );
649                    $msg .= prefix( ' by ' , $entry->author );
650                    $msg .= prefix( ' | ' , $entry->title );
651                    $msg .= prefix( ' | ' , $entry->link );
652    #               $msg .= prefix( ' id ' , $entry->id );
653    
654                    if ( $args->{kernel} && $send_rss_msgs ) {
655                            $send_rss_msgs--;
656                            _log('>>', $msg);
657                            $sth_insert_log->execute( $CHANNEL, 1, $NICK, $msg, 'now()' );
658                            $args->{kernel}->post( $IRC_ALIAS => notice => $CHANNEL, $msg );
659                            $updates++;
660                    }
661            }
662    
663            my $sql = qq{ update feeds set last_update = now(), polls = polls + 1 };
664            $sql .= qq{, updates = updates + $updates } if $updates;
665            $sql .= qq{where id = } . $args->{id};
666            eval { $dbh->do( $sql ) };
667    
668            _log "RSS got $total items of which $updates new";
669    
670            return $updates;
671    }
672    
673    sub rss_fetch_all {
674            my $kernel = shift;
675            my $sql = qq{
676                    select id, url, name
677                    from feeds
678                    where active is true
679            };
680            # limit to newer feeds only if we are not sending messages out
681            $sql .= qq{     and last_update + delay < now() } if $kernel;
682            my $sth = $dbh->prepare( $sql );
683            $sth->execute();
684            warn "# ",$sth->rows," active RSS feeds\n";
685            my $count = 0;
686            while (my $row = $sth->fetchrow_hashref) {
687                    $row->{kernel} = $kernel if $kernel;
688                    $count += rss_fetch( $row );
689            }
690            return "OK, fetched $count posts from " . $sth->rows . " feeds";
691    }
692    
693    
694    sub rss_check_updates {
695            my $kernel = shift;
696            my $last_t = $_rss->{last_poll} || time();
697            my $t = time();
698            if ( $t - $last_t > $rss_min_delay ) {
699                    $_rss->{last_poll} = $t;
700                    _log rss_fetch_all( $kernel );
701            }
702    }
703    
704    # seed rss seen cache so we won't send out all items on startup
705    _log rss_fetch_all;
706    
707  #  #
708  # POE handing part  # POE handing part
709  #  #
710    
 my $SKIPPING = 0;               # if skipping, how many we've done  
 my $SEND_QUEUE;                 # cache  
711  my $ping;                                               # ping stats  my $ping;                                               # ping stats
712    
713  POE::Component::IRC->new($IRC_ALIAS);  POE::Component::IRC->new($IRC_ALIAS);
714    
715  POE::Session->create( inline_states =>  POE::Session->create( inline_states => {
716     {_start => sub {                _start => sub {      
717                  $_[KERNEL]->post($IRC_ALIAS => register => 'all');                  $_[KERNEL]->post($IRC_ALIAS => register => 'all');
718                  $_[KERNEL]->post($IRC_ALIAS => connect => $CONNECT);                  $_[KERNEL]->post($IRC_ALIAS => connect => $CONNECT);
719      },      },
720      irc_255 => sub {    # server is done blabbing      irc_255 => sub {    # server is done blabbing
721                  $_[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;  
722                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "IDENTIFY $NICK" );                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "IDENTIFY $NICK" );
723      },      },
724      irc_public => sub {      irc_public => sub {
# Line 534  POE::Session->create( inline_states => Line 727  POE::Session->create( inline_states =>
727                  my $channel = $_[ARG1]->[0];                  my $channel = $_[ARG1]->[0];
728                  my $msg = $_[ARG2];                  my $msg = $_[ARG2];
729    
730                  save_message( channel => $channel, me => 0, nick => $nick, msg => $msg);                  save_message( channel => $channel, me => 0, nick => $nick, message => $msg);
731                  meta( $nick, $channel, 'last-msg', $msg );                  meta( $nick, $channel, 'last-msg', $msg );
732      },      },
733      irc_ctcp_action => sub {      irc_ctcp_action => sub {
# Line 543  POE::Session->create( inline_states => Line 736  POE::Session->create( inline_states =>
736                  my $channel = $_[ARG1]->[0];                  my $channel = $_[ARG1]->[0];
737                  my $msg = $_[ARG2];                  my $msg = $_[ARG2];
738    
739                  save_message( channel => $channel, me => 1, nick => $nick, msg => $msg);                  save_message( channel => $channel, me => 1, nick => $nick, message => $msg);
740    
741                  if ( my $twitter = ( $nick, $channel, 'twitter' ) ) {                  if ( $use_twitter ) {
742                          _log("FIXME: send twitter for $nick on $channel [$twitter]");                          if ( my $twitter = meta( $nick, $NICK, 'twitter' ) ) {
743                                    my ($login,$passwd) = split(/\s+/,$twitter,2);
744                                    _log("sending twitter for $nick/$login on $channel ");
745                                    my $bot = Net::Twitter->new( username=>$login, password=>$passwd );
746                                    $bot->update("<${channel}> $msg");
747                            }
748                  }                  }
749    
750      },      },
751          irc_ping => sub {          irc_ping => sub {
752                  warn "pong ", $_[ARG0], $/;                  _log( "pong ", $_[ARG0] );
753                  $ping->{ $_[ARG0] }++;                  $ping->{ $_[ARG0] }++;
754                    rss_check_updates( $_[KERNEL] );
755          },          },
756          irc_invite => sub {          irc_invite => sub {
757                  my $kernel = $_[KERNEL];                  my $kernel = $_[KERNEL];
758                  my $nick = (split /!/, $_[ARG0])[0];                  my $nick = (split /!/, $_[ARG0])[0];
759                  my $channel = $_[ARG1];                  my $channel = $_[ARG1];
760    
761                  warn "invited to $channel by $nick";                  _log "invited to $channel by $nick";
762    
763                  $_[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..." );
764                  $_[KERNEL]->post($IRC_ALIAS => join => $channel);                  $_[KERNEL]->post($IRC_ALIAS => join => $channel);
# Line 570  POE::Session->create( inline_states => Line 769  POE::Session->create( inline_states =>
769                  my $nick = (split /!/, $_[ARG0])[0];                  my $nick = (split /!/, $_[ARG0])[0];
770                  my $msg = $_[ARG2];                  my $msg = $_[ARG2];
771                  my $channel = $_[ARG1]->[0];                  my $channel = $_[ARG1]->[0];
                 from_to($msg, 'UTF-8', $ENCODING);  
772    
773                  my $res = "unknown command '$msg', try /msg $NICK help!";                  my $res = "unknown command '$msg', try /msg $NICK help!";
774                  my @out;                  my @out;
# Line 593  POE::Session->create( inline_states => Line 791  POE::Session->create( inline_states =>
791    
792                          my $sth = $dbh->prepare(qq{                          my $sth = $dbh->prepare(qq{
793                                  select                                  select
794                                          nick,                                          trim(both '_' from nick) as nick,
795                                          count(*) as count,                                          count(*) as count,
796                                          sum(length(message)) as len                                          sum(length(message)) as len
797                                  from log                                  from log
798                                  group by nick                                  group by trim(both '_' from nick)
799                                  order by len desc,count desc                                  order by len desc,count desc
800                                  limit $nr                                  limit $nr
801                          });                          });
# Line 614  POE::Session->create( inline_states => Line 812  POE::Session->create( inline_states =>
812    
813                          foreach my $res (get_from_log( limit => $limit )) {                          foreach my $res (get_from_log( limit => $limit )) {
814                                  _log "last: $res";                                  _log "last: $res";
                                 from_to($res, $ENCODING, 'UTF-8');  
815                                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );                                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );
816                          }                          }
817    
# Line 629  POE::Session->create( inline_states => Line 826  POE::Session->create( inline_states =>
826                                          search => $what,                                          search => $what,
827                                  )) {                                  )) {
828                                  _log "search [$what]: $res";                                  _log "search [$what]: $res";
                                 from_to($res, $ENCODING, 'UTF-8');  
829                                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );                                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );
830                          }                          }
831    
# Line 669  POE::Session->create( inline_states => Line 865  POE::Session->create( inline_states =>
865    
866                  } elsif ($msg =~ m/^ping/) {                  } elsif ($msg =~ m/^ping/) {
867                          $res = "ping = " . dump( $ping );                          $res = "ping = " . dump( $ping );
868                  } 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*)/) {  
869                          if ( ! defined( $1 ) ) {                          if ( ! defined( $1 ) ) {
870                                  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 = ? });
871                                  $sth->execute( $nick, $channel );                                  $sth->execute( $nick, $channel );
872                                  $res = "config for $nick ";                                  $res = "config for $nick on $channel";
873                                  while ( my ($n,$v) = $sth->fetchrow_array ) {                                  while ( my ($n,$v) = $sth->fetchrow_array ) {
874                                          $res .= "| $n = $v";                                          $res .= " | $n = $v";
875                                  }                                  }
876                          } elsif ( defined( $2 ) ) {                          } elsif ( ! $2 ) {
                                 meta( $nick, $channel, $1, $2 );  
                                 $res = "saved $1 = $2";  
                         } else {  
877                                  my $val = meta( $nick, $channel, $1 );                                  my $val = meta( $nick, $channel, $1 );
878                                  $res = "current $1 = " . ( $val ? $val : 'undefined' );                                  $res = "current $1 = " . ( $val ? $val : 'undefined' );
879                            } else {
880                                    my $validate = {
881                                            'last-size' => qr/^\d+/,
882                                            'twitter' => qr/^\w+\s+\w+/,
883                                    };
884    
885                                    my ( $op, $val ) = ( $1, $2 );
886    
887                                    if ( my $regex = $validate->{$op} ) {
888                                            if ( $val =~ $regex ) {
889                                                    meta( $nick, $channel, $op, $val );
890                                                    $res = "saved $op = $val";
891                                            } else {
892                                                    $res = "config option $op = $val doesn't validate against $regex";
893                                            }
894                                    } else {
895                                            $res = "config option $op doesn't exist";
896                                    }
897                            }
898                    } elsif ($msg =~ m/^rss-update/) {
899                            $res = rss_fetch_all( $_[KERNEL] );
900                    } elsif ($msg =~ m/^rss-clean/) {
901                            $_rss = undef;
902                            $dbh->do( qq{ update feeds set last_update = now() - delay } );
903                            $res = "OK, cleaned RSS cache";
904                    } elsif ($msg =~ m/^rss-list/) {
905                            my $sth = $dbh->prepare(qq{ select url,name,last_update,active from feeds });
906                            $sth->execute;
907                            while (my @row = $sth->fetchrow_array) {
908                                    $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, join(' | ',@row) );
909                            }
910                            $res = '';
911                    } elsif ($msg =~ m!^rss-(add|remove|stop|start)\s+(http://\S+)\s*(.*)!) {
912                            my $sql = {
913                                    add             => qq{ insert into feeds (url,name) values (?,?) },
914    #                               remove  => qq{ delete from feeds                                where url = ? and name = ? },
915                                    start   => qq{ update feeds set active = true   where url = ? },
916                                    stop    => qq{ update feeds set active = false  where url = ? },
917                                    
918                            };
919                            if (my $q = $sql->{$1} ) {
920                                    my $sth = $dbh->prepare( $q );
921                                    my @data = ( $2 );
922                                    push @data, $3 if ( $q =~ s/\?//g == 2 );
923                                    warn "## $1 SQL $q with ",dump( @data ),"\n";
924                                    eval { $sth->execute( @data ) };
925                          }                          }
926    
927                            $res = "OK, RSS $1 : $2 - $3";
928                  }                  }
929    
930                  if ($res) {                  if ($res) {
931                          _log ">> [$nick] $res";                          _log ">> [$nick] $res";
                         from_to($res, $ENCODING, 'UTF-8');  
932                          $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );                          $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );
933                  }                  }
934    
935                    rss_check_updates( $_[KERNEL] );
936          },          },
937          irc_477 => sub {          irc_477 => sub {
938                  _log "# irc_477: ",$_[ARG1];                  _log "# irc_477: ",$_[ARG1];
# Line 738  POE::Session->create( inline_states => Line 971  POE::Session->create( inline_states =>
971                          "";                          "";
972        0;                        # false for signals        0;                        # false for signals
973      },      },
     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);  
     }  
974     },     },
975    );    );
976    
977  # http server  # http server
978    
979  my $httpd = POE::Component::Server::HTTP->new(  my $httpd = POE::Component::Server::HTTP->new(
980          Port => $NICK =~ m/-dev/ ? 8001 : 8000,          Port => $http_port,
981            PreHandler => {
982                    '/' => sub {
983                            $_[0]->header(Connection => 'close')
984                    }
985            },
986          ContentHandler => { '/' => \&root_handler },          ContentHandler => { '/' => \&root_handler },
987          Headers        => { Server => 'irc-logger' },          Headers        => { Server => 'irc-logger' },
988  );  );
989    
 my %escape = ('<'=>'&lt;', '>'=>'&gt;', '&'=>'&amp;', '"'=>'&quot;');  
 my $escape_re  = join '|' => keys %escape;  
   
990  my $style = <<'_END_OF_STYLE_';  my $style = <<'_END_OF_STYLE_';
991  p { margin: 0; padding: 0.1em; }  p { margin: 0; padding: 0.1em; }
992  .time, .channel { color: #808080; font-size: 60%; }  .time, .channel { color: #808080; font-size: 60%; }
# Line 819  p { margin: 0; padding: 0.1em; } Line 994  p { margin: 0; padding: 0.1em; }
994  .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 ; }
995  .message { color: #000000; font-size: 100%; }  .message { color: #000000; font-size: 100%; }
996  .search { float: right; }  .search { float: right; }
997    a:link.tag, a:visited.tag { border: 1px dashed #ccc; backgound: #ccc; text-decoration: none }
998    a:hover.tag { border: 1px solid #eee }
999    hr { border: 1px dashed #ccc; height: 1px; clear: both; }
1000    /*
1001  .col-0 { background: #ffff66 }  .col-0 { background: #ffff66 }
1002  .col-1 { background: #a0ffff }  .col-1 { background: #a0ffff }
1003  .col-2 { background: #99ff99 }  .col-2 { background: #99ff99 }
1004  .col-3 { background: #ff9999 }  .col-3 { background: #ff9999 }
1005  .col-4 { background: #ff66ff }  .col-4 { background: #ff66ff }
1006  a:link.tag, a:visited.tag { border: 1px dashed #ccc; backgound: #ccc; text-decoration: none }  */
1007  a:hover.tag { border: 1px solid #eee }  .calendar { border: 1px solid red; width: 100%; }
1008  hr { border: 1px dashed #ccc; height: 1px; clear: both; }  .month { border: 0px; width: 100%; }
1009  _END_OF_STYLE_  _END_OF_STYLE_
1010    
1011  my $max_color = 4;  $max_color = 0;
1012    
1013  my %nick_enumerator;  my @cols = qw(
1014            #ffcccc #ccffe6 #ccccff #e6ccff #ffccff #ffcce6 #ff9999 #ffcc99 #ffff99
1015            #ccff99 #99ff99 #99ffcc #99ccff #9999ff #cc99ff #ff6666 #ffb366 #ffff66
1016            #66ff66 #66ffb3 #66b3ff #6666ff #ff3333 #33ff33 #3399ff #3333ff #ff3399
1017            #a0a0a0 #ff0000 #ffff00 #80ff00 #0000ff #8000ff #ff00ff #ff0080 #994d00
1018            #999900 #009900 #cc0066 #c0c0c0 #ccff99 #99ff33 #808080 #660033 #ffffff
1019    );
1020    
1021    foreach my $c (@cols) {
1022            $style .= ".col-${max_color} { background: $c }\n";
1023            $max_color++;
1024    }
1025    warn "defined $max_color colors for users...\n";
1026    
1027  sub root_handler {  sub root_handler {
1028          my ($request, $response) = @_;          my ($request, $response) = @_;
1029          $response->code(RC_OK);          $response->code(RC_OK);
1030          $response->content_type("text/html; charset=$ENCODING");  
1031            # this doesn't seem to work, so moved to PreHandler
1032            #$response->header(Connection => 'close');
1033    
1034            return RC_OK if $request->uri =~ m/favicon.ico$/;
1035    
1036          my $q;          my $q;
1037    
# Line 850  sub root_handler { Line 1045  sub root_handler {
1045    
1046          my $search = $q->param('search') || $q->param('grep') || '';          my $search = $q->param('search') || $q->param('grep') || '';
1047    
1048            if ($request->url =~ m#/rss(?:/(tags|last-tag|follow.*)\w*(?:=(\d+))?)?#i) {
1049                    my $show = lc($1);
1050                    my $nr = $2;
1051    
1052                    my $type = 'RSS';       # Atom
1053    
1054                    $response->content_type( 'application/' . lc($type) . '+xml' );
1055    
1056                    my $html = '<!-- error -->';
1057                    #warn "create $type feed from ",dump( @last_tags );
1058    
1059                    my $feed = XML::Feed->new( $type );
1060                    $feed->link( $url );
1061    
1062                    if ( $show eq 'tags' ) {
1063                            $nr ||= 50;
1064                            $feed->title( "tags from $CHANNEL" );
1065                            $feed->link( "$url/tags" );
1066                            $feed->description( "tag cloud created from messages on channel $CHANNEL which have tags// in them" );
1067                            my $feed_entry = XML::Feed::Entry->new($type);
1068                            $feed_entry->title( "$nr tags from $CHANNEL" );
1069                            $feed_entry->author( $NICK );
1070                            $feed_entry->link( '/#tags'  );
1071    
1072                            $feed_entry->content(
1073                                    qq{<![CDATA[<style type="text/css">}
1074                                    . $cloud->css
1075                                    . qq{</style>}
1076                                    . $cloud->html( $nr )
1077                                    . qq{]]>}
1078                            );
1079                            $feed->add_entry( $feed_entry );
1080    
1081                    } elsif ( $show eq 'last-tag' ) {
1082    
1083                            $nr ||= $last_x_tags;
1084                            $nr = $last_x_tags if $nr > $last_x_tags;
1085    
1086                            $feed->title( "last $nr tagged messages from $CHANNEL" );
1087                            $feed->description( "collects messages which have tags// in them" );
1088    
1089                            foreach my $m ( @last_tags ) {
1090    #                               warn dump( $m );
1091                                    #my $tags = join(' ', @{$m->{tags}} );
1092                                    my $feed_entry = XML::Feed::Entry->new($type);
1093                                    $feed_entry->title( $m->{nick} . '@' . $m->{time} );
1094                                    $feed_entry->author( $m->{nick} );
1095                                    $feed_entry->link( '/#' . $m->{id}  );
1096                                    $feed_entry->issued( DateTime::Format::Flexible->build( $m->{time} ) );
1097    
1098                                    my $message = $filter->{message}->( $m->{message} );
1099                                    $message .= "<br/>\n" unless $message =~ m!<(/p|br/?)>!;
1100    #                               warn "## message = $message\n";
1101    
1102                                    #$feed_entry->summary(
1103                                    $feed_entry->content(
1104                                            "<![CDATA[$message]]>"
1105                                    );
1106                                    $feed_entry->category( join(', ', @{$m->{tags}}) );
1107                                    $feed->add_entry( $feed_entry );
1108    
1109                                    $nr--;
1110                                    last if $nr <= 0;
1111    
1112                            }
1113    
1114                    } elsif ( $show =~ m/^follow/ ) {
1115    
1116                            $feed->title( "Feeds which this bot follows" );
1117    
1118                            my $sth = $dbh->prepare( qq{ select * from feeds order by last_update desc } );
1119                            $sth->execute;
1120                            while (my $row = $sth->fetchrow_hashref) {
1121                                    my $feed_entry = XML::Feed::Entry->new($type);
1122                                    $feed_entry->title( $row->{name} );
1123                                    $feed_entry->link( $row->{url}  );
1124                                    $feed_entry->issued( DateTime::Format::Flexible->build( $row->{last_update} ) );
1125                                    $feed_entry->content(
1126                                            '<![CDATA[<pre>' . dump( $row ) . '</pre>]]>'
1127                                    );
1128                                    $feed->add_entry( $feed_entry );
1129                            }
1130    
1131                    } else {
1132                            _log "unknown rss request ",$request->url;
1133                            return RC_DENY;
1134                    }
1135    
1136                    $response->content( $feed->as_xml );
1137                    return RC_OK;
1138            }
1139    
1140            if ( $@ ) {
1141                    warn "$@";
1142            }
1143    
1144            $response->content_type("text/html; charset=UTF-8");
1145    
1146          my $html =          my $html =
1147                  qq{<html><head><title>$NICK</title><style type="text/css">$style} .                  qq{<html><head><title>$NICK</title><style type="text/css">$style}
1148                  $cloud->css .                  . $cloud->css
1149                  qq{</style></head><body>} .                  . qq{</style></head><body>}
1150                  qq{                  . qq{
1151                  <form method="post" class="search" action="/">                  <form method="post" class="search" action="/">
1152                  <input type="text" name="search" value="$search" size="10">                  <input type="text" name="search" value="$search" size="10">
1153                  <input type="submit" value="search">                  <input type="submit" value="search">
1154                  </form>                  </form>
1155                  } .                  }
1156                  $cloud->html(500) .                  . $cloud->html(500)
1157                  qq{<p>};                  . qq{<p>};
1158          if ($request->url =~ m#/history#) {  
1159            if ($request->url =~ m#/tags?#) {
1160                    # nop
1161            } elsif ($request->url =~ m#/history#) {
1162                  my $sth = $dbh->prepare(qq{                  my $sth = $dbh->prepare(qq{
1163                          select date(time) as date,count(*) as nr                          select date(time) as date,count(*) as nr,sum(length(message)) as len
1164                                  from log                                  from log
1165                                  group by date(time)                                  group by date(time)
1166                                  order by date(time) desc                                  order by date(time) desc
1167                  });                  });
1168                  $sth->execute();                  $sth->execute();
1169                  my ($l_yyyy,$l_mm) = (0,0);                  my ($l_yyyy,$l_mm) = (0,0);
1170                    $html .= qq{<table class="calendar"><tr>};
1171                  my $cal;                  my $cal;
1172                    my $ord = 0;
1173                  while (my $row = $sth->fetchrow_hashref) {                  while (my $row = $sth->fetchrow_hashref) {
1174                          # this is probably PostgreSQL specific, expects ISO date                          # this is probably PostgreSQL specific, expects ISO date
1175                          my ($yyyy,$mm,$dd) = split(/-/, $row->{date});                          my ($yyyy,$mm,$dd) = split(/-/, $row->{date});
1176                          if ($yyyy != $l_yyyy || $mm != $l_mm) {                          if ($yyyy != $l_yyyy || $mm != $l_mm) {
1177                                  $html .= $cal->as_HTML() if ($cal);                                  if ( $cal ) {
1178                                            $html .= qq{<td valign="top">} . $cal->as_HTML() . qq{</td>};
1179                                            $ord++;
1180                                            $html .= qq{</tr><tr>} if ( $ord % 3 == 0 );
1181                                    }
1182                                  $cal = new HTML::CalendarMonthSimple('month'=>$mm,'year'=>$yyyy);                                  $cal = new HTML::CalendarMonthSimple('month'=>$mm,'year'=>$yyyy);
1183                                  $cal->border(2);                                  $cal->border(1);
1184                                    $cal->width('30%');
1185                                    $cal->cellheight('5em');
1186                                    $cal->tableclass('month');
1187                                    #$cal->cellclass('day');
1188                                    $cal->sunday('SUN');
1189                                    $cal->saturday('SAT');
1190                                    $cal->weekdays('MON','TUE','WED','THU','FRI');
1191                                  ($l_yyyy,$l_mm) = ($yyyy,$mm);                                  ($l_yyyy,$l_mm) = ($yyyy,$mm);
1192                          }                          }
1193                          $cal->setcontent($dd, qq{                          $cal->setcontent($dd, qq[
1194                                  <a href="/?date=$row->{date}">$row->{nr}</a>                                  <a href="$url?date=$row->{date}">$row->{nr}</a><br/>$row->{len}
1195                          });                          ]) if $cal;
1196                            
1197                  }                  }
1198                  $html .= $cal->as_HTML() if ($cal);                  $html .= qq{<td valign="top">} . $cal->as_HTML() . qq{</td></tr></table>};
1199    
1200          } else {          } else {
1201                  $html .= join("</p><p>",                  $html .= join("</p><p>",
1202                          get_from_log(                          get_from_log(
1203                                  limit => $q->param('last') || $q->param('date') ? undef : 100,                                  limit => ( $q->param('last') || $q->param('date') ) ? undef : 100,
1204                                  search => $search || undef,                                  search => $search || undef,
1205                                  tag => $q->param('tag') || undef,                                  tag => $q->param('tag') || undef,
1206                                  date => $q->param('date') || undef,                                  date => $q->param('date') || undef,
1207                                  fmt => {                                  fmt => {
1208                                          date => sub {                                          date => sub {
1209                                                  my $date = shift || return;                                                  my $date = shift || return;
1210                                                  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>};
1211                                          },                                          },
1212                                          time => '<span class="time">%s</span> ',                                          time => '<span class="time">%s</span> ',
1213                                          time_channel => '<span class="channel">%s %s</span> ',                                          time_channel => '<span class="channel">%s %s</span> ',
# Line 905  sub root_handler { Line 1215  sub root_handler {
1215                                          me_nick => '***%s&nbsp;',                                          me_nick => '***%s&nbsp;',
1216                                          message => '<span class="message">%s</span>',                                          message => '<span class="message">%s</span>',
1217                                  },                                  },
1218                                  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>';  
                                         },  
                                 },  
1219                          )                          )
1220                  );                  );
1221          }          }
# Line 934  sub root_handler { Line 1226  sub root_handler {
1226          </body></html>};          </body></html>};
1227    
1228          $response->content( $html );          $response->content( $html );
1229            warn "<< ", $request->method, " ", $request->uri, " created ", length($html), " bytes\n";
1230          return RC_OK;          return RC_OK;
1231  }  }
1232    
Legend:
Removed from v.50  
changed lines
  Added in v.93
  ViewVC Help
Powered by ViewVC 1.1.26