/[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

trunk/irc-logger.pl revision 6 by dpavlin, Mon Feb 27 12:41:10 2006 UTC trunk/bin/irc-logger.pl revision 89 by dpavlin, Fri Mar 7 00:43:45 2008 UTC
# Line 10  irc-logger.pl Line 10  irc-logger.pl
10    
11  ./irc-logger.pl  ./irc-logger.pl
12    
13    =head2 Options
14    
15    =over 4
16    
17    =item --import-dircproxy=filename
18    
19    Import log from C<dircproxy> to C<irc-logger> database
20    
21    =item --log=irc-logger.log
22    
23    Name of log file
24    
25    =item --follow=file.log
26    
27    Follows new messages in file
28    
29    =back
30    
31  =head1 DESCRIPTION  =head1 DESCRIPTION
32    
33  log all conversation on irc channel  log all conversation on irc channel
# Line 18  log all conversation on irc channel Line 36  log all conversation on irc channel
36    
37  ## CONFIG  ## CONFIG
38    
39    my $HOSTNAME = `hostname -f`;
40    chomp($HOSTNAME);
41    
42  my $NICK = 'irc-logger';  my $NICK = 'irc-logger';
43    $NICK .= '-dev' if ($HOSTNAME =~ m/llin/);
44  my $CONNECT =  my $CONNECT =
45    {Server => 'irc.freenode.net',    {Server => 'irc.freenode.net',
46     Nick => $NICK,     Nick => $NICK,
47     Ircname => 'logger: ask dpavlin@rot13.org'     Ircname => "try /msg $NICK help",
48    };    };
49  my $CHANNEL = '#razmjenavjestina';  my $CHANNEL = '#razmjenavjestina';
50    $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=irc-logger';  my $DSN = 'DBI:Pg:dbname=' . $NICK;
57    
58  ## END CONFIG  my $TIMESTAMP = '%Y-%m-%d %H:%M:%S';
59    
60    my $sleep_on_error = 5;
61    
62    # number of last tags to keep in circular buffer
63    my $last_x_tags = 50;
64    
65    # don't pull rss feeds more often than this
66    my $rss_min_delay = 60;
67    $rss_min_delay = 15;
68    
69    my $http_port = $NICK =~ m/-dev/ ? 8001 : 8000;
70    
71    my $url = "http://$HOSTNAME:$http_port";
72    
73    ## END CONFIG
74    
75  use POE qw(Component::IRC Wheel::FollowTail);  use POE qw(Component::IRC Wheel::FollowTail Component::Server::HTTP);
76    use HTTP::Status;
77  use DBI;  use DBI;
78  use Encode qw/from_to/;  use Regexp::Common qw /URI/;
79    use CGI::Simple;
80    use HTML::TagCloud;
81    use POSIX qw/strftime/;
82    use HTML::CalendarMonthSimple;
83    use Getopt::Long;
84    use DateTime;
85    use URI::Escape;
86    use Data::Dump qw/dump/;
87    use DateTime::Format::ISO8601;
88    use Carp qw/confess/;
89    use XML::Feed;
90    use DateTime::Format::Flexible;
91    
92    my $use_twitter = 1;
93    eval { require Net::Twitter; };
94    $use_twitter = 0 if ($@);
95    
96    my $import_dircproxy;
97    my $log_path;
98    GetOptions(
99            'import-dircproxy:s' => \$import_dircproxy,
100            'follows:s' => \$follows_path,
101            'log:s' => \$log_path,
102    );
103    
104    #$SIG{__DIE__} = sub {
105    #       confess "fatal error";
106    #};
107    
108  my $dbh = DBI->connect($DSN,"","", { RaiseError => 1, AutoCommit => 1 }) || die $DBI::errstr;  open(STDOUT, '>', $log_path) || warn "can't redirect log to $log_path: $!";
109    
110    sub _log {
111            print strftime($TIMESTAMP,localtime()) . ' ' . join(" ",@_) . $/;
112    }
113    
114    # LOG following
115    
116    my %FOLLOWS =
117      (
118    #   ACCESS => "/var/log/apache/access.log",
119    #   ERROR => "/var/log/apache/error.log",
120      );
121    
122  =for SQL schema  sub add_follow_path {
123            my $path = shift;
124            my $name = $path;
125            $name =~ s/\..*$//;
126            warn "# using $path to announce messages from $name\n";
127            $FOLLOWS{$name} = $path;
128    }
129    
130    add_follow_path( $follows_path ) if ( -e $follows_path );
131    
132    # HTML formatters
133    
134    my %escape = ('<'=>'&lt;', '>'=>'&gt;', '&'=>'&amp;', '"'=>'&quot;');
135    my $escape_re  = join '|' => keys %escape;
136    
137    my $tag_regex = '\b([\w-_]+)//';
138    
139    my %nick_enumerator;
140    my $max_color = 0;
141    
142    my $filter = {
143            message => sub {
144                    my $m = shift || return;
145    
146                    # protect HTML from wiki modifications
147                    sub e {
148                            my $t = shift;
149                            return 'uri_unescape{' . uri_escape($t) . '}';
150                    }
151    
152                    $m =~ s/($escape_re)/$escape{$1}/gs;
153                    $m =~ s#($RE{URI}{HTTP})#e(qq{<a href="$1">$1</a>})#egs ||
154                    $m =~ s#\/(\w+)\/#<i>$1</i>#gs;
155                    $m =~ s#$tag_regex#e(qq{<a href="$url?tag=$1" class="tag">$1</a>})#egs;
156                    $m =~ s#\*(\w+)\*#<b>$1</b>#gs;
157                    $m =~ s#_(\w+)_#<u>$1</u>#gs;
158    
159                    $m =~ s#uri_unescape{([^}]+)}#uri_unescape($1)#egs;
160                    return $m;
161            },
162            nick => sub {
163                    my $n = shift || return;
164                    if (! $nick_enumerator{$n})  {
165                            my $max = scalar keys %nick_enumerator;
166                            $nick_enumerator{$n} = $max + 1;
167                    }
168                    return '<span class="nick col-' .
169                            ( $nick_enumerator{$n} % $max_color ) .
170                            '">' . $n . '</span>';
171            },
172    };
173    
174    my $dbh = DBI->connect($DSN,"","", { RaiseError => 1, AutoCommit => 1 }) || die $DBI::errstr;
175    $dbh->do( qq{ set client_encoding = 'UTF-8' } );
176    
177  $dbh->do(qq{  my $sql_schema = {
178            log => qq{
179  create table log (  create table log (
180          id serial,          id serial,
181          time timestamp default now(),          time timestamp default now(),
182          channel text not null,          channel text not null,
183            me boolean default false,
184          nick text not null,          nick text not null,
185          message text not null,          message text not null,
186          primary key(id)          primary key(id)
# Line 61  create table log ( Line 189  create table log (
189  create index log_time on log(time);  create index log_time on log(time);
190  create index log_channel on log(channel);  create index log_channel on log(channel);
191  create index log_nick on log(nick);  create index log_nick on log(nick);
192            },
193            meta => q{
194    create table meta (
195            nick text not null,
196            channel text not null,
197            name text not null,
198            value text,
199            changed timestamp default 'now()',
200            primary key(nick,channel,name)
201    );
202            },
203            feeds => qq{
204    create table feeds (
205            id serial,
206            url text not null,
207            name text,
208            delay interval not null default '5 min',
209            active boolean default true,
210            last_update timestamp default 'now()',
211            polls int default 0,
212            updates int default 0
213    );
214    create unique index feeds_url on feeds(url);
215    insert into feeds (url,name) values ('http://wiki.razmjenavjestina.org/feed/workspace/razmjenavjestina?category=Recent%20Changes','wiki');
216            },
217    };
218    
219    foreach my $table ( keys %$sql_schema ) {
220    
221            eval {
222                    $dbh->do(qq{ select count(*) from $table });
223            };
224    
225            if ($@) {
226                    warn "creating database table $table in $DSN\n";
227                    $dbh->do( $sql_schema->{ $table } );
228            }
229    }
230    
231  });  
232    =head2 meta
233    
234    Set or get some meta data into database
235    
236            meta('nick','channel','var_name', $var_value );
237    
238            $var_value = meta('nick','channel','var_name');
239            ( $var_value, $changed ) = meta('nick','channel','var_name');
240    
241  =cut  =cut
242    
243  my $sth = $dbh->prepare(qq{  sub meta {
244            my ($nick,$channel,$name,$value) = @_;
245    
246            # normalize channel name
247            $channel =~ s/^#//;
248    
249            if (defined($value)) {
250    
251                    my $sth = $dbh->prepare(qq{ update meta set value = ?, changed = now() where nick = ? and channel = ? and name = ? });
252    
253                    eval { $sth->execute( $value, $nick, $channel, $name ) };
254    
255                    # error or no result
256                    if ( $@ || ! $sth->rows ) {
257                            $sth = $dbh->prepare(qq{ insert into meta (value,nick,channel,name,changed) values (?,?,?,?,now()) });
258                            $sth->execute( $value, $nick, $channel, $name );
259                            _log "created $nick/$channel/$name = $value";
260                    } else {
261                            _log "updated $nick/$channel/$name = $value ";
262                    }
263    
264                    return $value;
265    
266            } else {
267    
268                    my $sth = $dbh->prepare(qq{ select value,changed from meta where nick = ? and channel = ? and name = ? });
269                    $sth->execute( $nick, $channel, $name );
270                    my ($v,$c) = $sth->fetchrow_array;
271                    _log "fetched $nick/$channel/$name = $v [$c]";
272                    return ($v,$c) if wantarray;
273                    return $v;
274    
275            }
276    }
277    
278    
279    
280    my $sth_insert_log = $dbh->prepare(qq{
281  insert into log  insert into log
282          (channel, nick, message)          (channel, me, nick, message, time)
283  values (?,?,?)  values (?,?,?,?,?)
284  });  });
285    
286    
287    my $tags;
288    
289    =head2 get_from_log
290    
291     my @messages = get_from_log(
292            limit => 42,
293            search => '%what to stuff in ilike%',
294            fmt => {
295                    time => '{%s} ',
296                    time_channel => '{%s %s} ',
297                    nick => '%s: ',
298                    me_nick => '***%s ',
299                    message => '%s',
300            },
301            filter => {
302                    message => sub {
303                            # modify message content
304                            return shift;
305                    }
306            },
307            context => 5,
308            full_rows => 1,
309     );
310    
311    Order is important. Fields are first passed through C<filter> (if available) and
312    then throgh C<< sprintf($fmt->{message}, $message >> if available.
313    
314    C<context> defines number of messages around each search hit for display.
315    
316    C<full_rows> will return database rows for each result with C<date>, C<time>, C<channel>,
317    C<me>, C<nick> and C<message> keys.
318    
319    =cut
320    
321    sub get_from_log {
322            my $args = {@_};
323    
324            if ( ! $args->{fmt} ) {
325                    $args->{fmt} = {
326                            date => '[%s] ',
327                            time => '{%s} ',
328                            time_channel => '{%s %s} ',
329                            nick => '%s: ',
330                            me_nick => '***%s ',
331                            message => '%s',
332                    };
333            }
334    
335            my $sql_message = qq{
336                    select
337                            time::date as date,
338                            time::time as time,
339                            channel,
340                            me,
341                            nick,
342                            message
343                    from log
344            };
345    
346            my $sql_context = qq{
347                    select
348                            id
349                    from log
350            };
351    
352            my $context = $1 if ($args->{search} && $args->{search} =~ s/\s*\+(\d+)\s*/ /);
353    
354            my $sql = $context ? $sql_context : $sql_message;
355    
356            sub check_date {
357                    my $date = shift || return;
358                    my $new_date = eval { DateTime::Format::ISO8601->parse_datetime( $date )->ymd; };
359                    if ( $@ ) {
360                            warn "invalid date $date\n";
361                            $new_date = DateTime->now->ymd;
362                    }
363                    return $new_date;
364            }
365    
366            my @where;
367            my @args;
368    
369            if (my $search = $args->{search}) {
370                    $search =~ s/^\s+//;
371                    $search =~ s/\s+$//;
372                    push @where, 'message ilike ? or nick ilike ?';
373                    push @args, ( ( '%' . $search . '%' ) x 2 );
374                    _log "search for '$search'";
375            }
376    
377            if ($args->{tag} && $tags->{ $args->{tag} }) {
378                    push @where, 'id in (' . join(',', @{ $tags->{ $args->{tag} } }) . ')';
379                    _log "search for tags $args->{tag}";
380            }
381    
382            if (my $date = $args->{date} ) {
383                    $date = check_date( $date );
384                    push @where, 'date(time) = ?';
385                    push @args, $date;
386                    _log "search for date $date";
387            }
388    
389            $sql .= " where " . join(" and ", @where) if @where;
390    
391            $sql .= " order by log.time desc";
392            $sql .= " limit " . $args->{limit} if ($args->{limit});
393    
394            #warn "### sql: $sql ", dump( @args );
395    
396            my $sth = $dbh->prepare( $sql );
397            eval { $sth->execute( @args ) };
398            return if $@;
399    
400            my $last_row = {
401                    date => '',
402                    time => '',
403                    channel => '',
404                    nick => '',
405            };
406    
407            my @rows;
408    
409            while (my $row = $sth->fetchrow_hashref) {
410                    unshift @rows, $row;
411            }
412    
413            # normalize nick names
414            map {
415                    $_->{nick} =~ s/^_*(.*?)_*$/$1/
416            } @rows;
417    
418            return @rows if ($args->{full_rows});
419    
420            my @msgs = (
421                    "Showing " . ($#rows + 1) . " messages..."
422            );
423    
424            if ($context) {
425                    my @ids = @rows;
426                    @rows = ();
427    
428                    my $last_to = 0;
429    
430                    my $sth = $dbh->prepare( $sql_message . qq{ where id >= ? and id < ? } );
431                    foreach my $row_id (sort { $a->{id} <=> $b->{id} } @ids) {
432                            my $id = $row_id->{id} || die "can't find id in row";
433            
434                            my ($from, $to) = ($id - $context, $id + $context);
435                            $from = $last_to if ($from < $last_to);
436                            $last_to = $to;
437                            $sth->execute( $from, $to );
438    
439                            #warn "## id: $id from: $from to: $to returned: ", $sth->rows, "\n";
440    
441                            while (my $row = $sth->fetchrow_hashref) {
442                                    push @rows, $row;
443                            }
444    
445                    }
446            }
447    
448            # sprintf which can take coderef as first parametar
449            sub cr_sprintf {
450                    my $fmt = shift || return;
451                    if (ref($fmt) eq 'CODE') {
452                            $fmt->(@_);
453                    } else {
454                            sprintf($fmt, @_);
455                    }
456            }
457    
458            foreach my $row (@rows) {
459    
460                    $row->{time} =~ s#\.\d+##;
461    
462                    my $msg = '';
463    
464                    $msg = cr_sprintf($args->{fmt}->{date}, $row->{date}) . ' ' if ($last_row->{date} ne $row->{date});
465                    my $t = $row->{time};
466    
467                    if ($last_row->{channel} ne $row->{channel}) {
468                            $msg .= cr_sprintf($args->{fmt}->{time_channel}, $t, $row->{channel});
469                    } else {
470                            $msg .= cr_sprintf($args->{fmt}->{time}, $t);
471                    }
472    
473                    my $append = 1;
474    
475                    my $nick = $row->{nick};
476    #               if ($nick =~ s/^_*(.*?)_*$/$1/) {
477    #                       $row->{nick} = $nick;
478    #               }
479    
480                    if ($last_row->{nick} ne $nick) {
481                            # obfu way to find format for me_nick if needed or fallback to default
482                            my $fmt = $row->{me} ? ( $args->{fmt}->{me_nick} || $args->{fmt}->{nick} ) : $args->{fmt}->{nick};
483                            $fmt ||= '%s';
484    
485                            $nick = $args->{filter}->{nick}->($nick) if (ref($args->{filter}->{nick}) eq 'CODE');
486    
487                            $msg .= cr_sprintf( $fmt, $nick );
488                            $append = 0;
489                    }
490    
491                    $args->{fmt}->{message} ||= '%s';
492                    if (ref($args->{filter}->{message}) eq 'CODE') {
493                            $msg .= cr_sprintf($args->{fmt}->{message},
494                                    $args->{filter}->{message}->(
495                                            $row->{message}
496                                    )
497                            );
498                    } else {
499                            $msg .= cr_sprintf($args->{fmt}->{message}, $row->{message});
500                    }
501    
502                    if ($append && @msgs) {
503                            $msgs[$#msgs] .= " " . $msg;
504                    } else {
505                            push @msgs, $msg;
506                    }
507    
508                    $last_row = $row;
509            }
510    
511            return @msgs;
512    }
513    
514    # tags support
515    
516    my $cloud = HTML::TagCloud->new;
517    
518    =head2 add_tag
519    
520     add_tag( id => 42, message => 'irc message', nick => 'foobar' [, me => 1 ] );
521    
522    =cut
523    
524    my @last_tags;
525    
526    sub add_tag {
527            my $arg = {@_};
528    
529            return unless ($arg->{id} && $arg->{message});
530    
531            my $m = $arg->{message};
532    
533            my @tags;
534    
535            while ($m =~ s#$tag_regex##s) {
536                    my $tag = $1;
537                    next if (! $tag || $tag =~ m/https?:/i);
538                    push @{ $tags->{$tag} }, $arg->{id};
539                    #warn "+tag $tag: $arg->{id}\n";
540                    $cloud->add($tag, "$url?tag=$tag", scalar @{$tags->{$tag}} + 1);
541                    push @tags, $tag;
542    
543            }
544    
545            if ( @tags ) {
546                    pop @last_tags if $#last_tags == $last_x_tags;
547                    unshift @last_tags, { tags => [ @tags ], %$arg };
548            }
549    
550    }
551    
552    =head2 seed_tags
553    
554    Read all tags from database and create in-memory cache for tags
555    
556    =cut
557    
558    sub seed_tags {
559            my $sth = $dbh->prepare(qq{ select id,message,nick,me,time from log where message like '%//%' order by time asc });
560            $sth->execute;
561            while (my $row = $sth->fetchrow_hashref) {
562                    add_tag( %$row );
563            }
564    
565            foreach my $tag (keys %$tags) {
566                    $cloud->add($tag, "$url?tag=$tag", scalar @{$tags->{$tag}} + 1);
567            }
568    }
569    
570    seed_tags;
571    
572    
573    =head2 save_message
574    
575      save_message(
576            channel => '#foobar',
577            me => 0,
578            nick => 'dpavlin',
579            message => 'test message',
580            time => '2006-06-25 18:57:18',
581      );
582    
583    C<time> is optional, it will use C<< now() >> if it's not available.
584    
585    C<me> if not specified will be C<0> (not C</me> message)
586    
587    =cut
588    
589    sub save_message {
590            my $a = {@_};
591            confess "have msg" if $a->{msg};
592            $a->{me} ||= 0;
593            $a->{time} ||= strftime($TIMESTAMP,localtime());
594    
595            _log
596                    $a->{channel}, " ",
597                    $a->{me} ? "***" . $a->{nick} : "<" . $a->{nick} . ">",
598                    " " . $a->{message};
599    
600            $sth_insert_log->execute($a->{channel}, $a->{me}, $a->{nick}, $a->{message}, $a->{time});
601            add_tag( id => $dbh->last_insert_id(undef,undef,"log",undef), %$a );
602    }
603    
604    
605    if ($import_dircproxy) {
606            open(my $l, $import_dircproxy) || die "can't open $import_dircproxy: $!";
607            warn "importing $import_dircproxy...\n";
608            my $tz_offset = 1 * 60 * 60;    # TZ GMT+2
609            while(<$l>) {
610                    chomp;
611                    if (/^@(\d+)\s(\S+)\s(.+)$/) {
612                            my ($time, $nick, $msg) = ($1,$2,$3);
613    
614                            my $dt = DateTime->from_epoch( epoch => $time + $tz_offset );
615    
616                            my $me = 0;
617                            $me = 1 if ($nick =~ m/^\[\S+]/);
618                            $nick =~ s/^[\[<]([^!]+).*$/$1/;
619    
620                            $msg =~ s/^ACTION\s+// if ($me);
621    
622                            save_message(
623                                    channel => $CHANNEL,
624                                    me => $me,
625                                    nick => $nick,
626                                    message => $msg,
627                                    time => $dt->ymd . " " . $dt->hms,
628                            ) if ($nick !~ m/^-/);
629    
630                    } else {
631                            _log "can't parse: $_";
632                    }
633            }
634            close($l);
635            warn "import over\n";
636            exit;
637    }
638    
639    #
640    # RSS follow
641    #
642    
643    my $_rss;
644    
645    
646    sub rss_fetch {
647            my ($args) = @_;
648    
649            # how many messages to send out when feed is seen for the first time?
650            my $send_rss_msgs = 1;
651    
652            _log "RSS fetch", $args->{url};
653    
654            my $feed = XML::Feed->parse(URI->new( $args->{url} ));
655            if ( ! $feed ) {
656                    _log("can't fetch RSS ", $args->{url});
657                    return;
658            }
659            my ( $total, $updates ) = ( 0, 0 );
660            for my $entry ($feed->entries) {
661                    $total++;
662    
663                    # seen allready?
664                    return if $_rss->{$feed->link}->{seen}->{$entry->id}++ > 0;
665    
666                    sub prefix {
667                            my ($txt,$var) = @_;
668                            $var =~ s/^\s+//g;
669                            return $txt . $var if $var;
670                    }
671    
672                    my $msg;
673                    $msg .= prefix( 'From: ' , $feed->title );
674                    $msg .= prefix( ' by ' , $entry->author );
675                    $msg .= prefix( ' -- ' , $entry->link );
676    #               $msg .= prefix( ' id ' , $entry->id );
677    
678                    if ( $args->{kernel} && $send_rss_msgs ) {
679                            $send_rss_msgs--;
680                            _log('RSS', $msg);
681                            $sth_insert_log->execute( $CHANNEL, 1, $NICK, $msg, undef );
682                            $args->{kernel}->post( $IRC_ALIAS => notice => $CHANNEL, $msg );
683                            $updates++;
684                    }
685            }
686    
687            my $sql = qq{ update feeds set last_update = now(), polls = polls + 1 };
688            $sql .= qq{, updates = updates + $updates } if $updates;
689            $sql .= qq{where id = } . $args->{id};
690            eval { $dbh->do( $sql ) };
691    
692            _log "RSS got $total items of which $updates new";
693    
694            return $updates;
695    }
696    
697    sub rss_fetch_all {
698            my $kernel = shift;
699            my $sql = qq{
700                    select id, url, name
701                    from feeds
702                    where active is true
703            };
704            # limit to newer feeds only if we are not sending messages out
705            $sql .= qq{     and last_update + delay < now() } if $kernel;
706            my $sth = $dbh->prepare( $sql );
707            $sth->execute();
708            warn "# ",$sth->rows," active RSS feeds\n";
709            my $count = 0;
710            while (my $row = $sth->fetchrow_hashref) {
711                    $row->{kernel} = $kernel if $kernel;
712                    $count += rss_fetch( $row );
713            }
714            return "OK, fetched $count posts from " . $sth->rows . " feeds";
715    }
716    
717    
718    sub rss_check_updates {
719            my $kernel = shift;
720            my $last_t = $_rss->{last_poll} || time();
721            my $t = time();
722            if ( $last_t - $t > $rss_min_delay ) {
723                    $_rss->{last_poll} = $t;
724                    _log rss_fetch_all( $kernel );
725            }
726    }
727    
728    # seed rss seen cache so we won't send out all items on startup
729    _log rss_fetch_all;
730    
731    #
732    # POE handing part
733    #
734    
735  my $SKIPPING = 0;               # if skipping, how many we've done  my $SKIPPING = 0;               # if skipping, how many we've done
736  my $SEND_QUEUE;                 # cache  my $SEND_QUEUE;                 # cache
737    my $ping;                                               # ping stats
738    
739  POE::Component::IRC->new($IRC_ALIAS);  POE::Component::IRC->new($IRC_ALIAS);
740    
741  POE::Session->create  POE::Session->create( inline_states => {
742    (inline_states =>          _start => sub {      
743     {_start => sub {                        $_[KERNEL]->post($IRC_ALIAS => register => 'all');
744        $_[KERNEL]->post($IRC_ALIAS => register => 'all');                  $_[KERNEL]->post($IRC_ALIAS => connect => $CONNECT);
       $_[KERNEL]->post($IRC_ALIAS => connect => $CONNECT);  
745      },      },
746      irc_255 => sub {            # server is done blabbing      irc_255 => sub {    # server is done blabbing
747        $_[KERNEL]->post($IRC_ALIAS => join => $CHANNEL);                  $_[KERNEL]->post($IRC_ALIAS => join => $CHANNEL);
748        $_[KERNEL]->post($IRC_ALIAS => join => '#logger');                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "IDENTIFY $NICK" );
       $_[KERNEL]->yield("heartbeat"); # start heartbeat  
 #      $_[KERNEL]->yield("my_add", $_) for keys %FOLLOWS;  
749      },      },
750      irc_public => sub {      irc_public => sub {
751            my $kernel = $_[KERNEL];                  my $kernel = $_[KERNEL];
752            my $nick = (split /!/, $_[ARG0])[0];                  my $nick = (split /!/, $_[ARG0])[0];
753            my $channel = $_[ARG1]->[0];                  my $channel = $_[ARG1]->[0];
754            my $msg = $_[ARG2];                  my $msg = $_[ARG2];
755    
756            from_to($msg, 'UTF-8', 'ISO-8859-2');                  save_message( channel => $channel, me => 0, nick => $nick, message => $msg);
757                    meta( $nick, $channel, 'last-msg', $msg );
758        },
759        irc_ctcp_action => sub {
760                    my $kernel = $_[KERNEL];
761                    my $nick = (split /!/, $_[ARG0])[0];
762                    my $channel = $_[ARG1]->[0];
763                    my $msg = $_[ARG2];
764    
765                    save_message( channel => $channel, me => 1, nick => $nick, message => $msg);
766    
767                    if ( $use_twitter ) {
768                            if ( my $twitter = meta( $nick, $NICK, 'twitter' ) ) {
769                                    my ($login,$passwd) = split(/\s+/,$twitter,2);
770                                    _log("sending twitter for $nick/$login on $channel ");
771                                    my $bot = Net::Twitter->new( username=>$login, password=>$passwd );
772                                    $bot->update("<${channel}> $msg");
773                            }
774                    }
775    
           print "$channel: <$nick> $msg\n";  
           $sth->execute($channel, $nick, $msg);  
776      },      },
777      (map          irc_ping => sub {
778       {                  _log( "pong ", $_[ARG0] );
779         ;"irc_$_" => sub { }}                  $ping->{ $_[ARG0] }++;
780       qw(join                  rss_check_updates( $_[KERNEL] );
781          ctcp_version          },
782          connected snotice ctcp_action ping notice mode part quit          irc_invite => sub {
783          001 002 003 004 005                  my $kernel = $_[KERNEL];
784          250 251 252 253 254 265 266                  my $nick = (split /!/, $_[ARG0])[0];
785          332 333 353 366 372 375 376                  my $channel = $_[ARG1];
786                  477  
787                  )),                  _log "invited to $channel by $nick";
788    
789                    $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, "how nice of you to invite me to $channel, I'll be right there..." );
790                    $_[KERNEL]->post($IRC_ALIAS => join => $channel);
791    
792            },
793            irc_msg => sub {
794                    my $kernel = $_[KERNEL];
795                    my $nick = (split /!/, $_[ARG0])[0];
796                    my $msg = $_[ARG2];
797                    my $channel = $_[ARG1]->[0];
798    
799                    my $res = "unknown command '$msg', try /msg $NICK help!";
800                    my @out;
801    
802                    _log "<< $msg";
803    
804                    if ($msg =~ m/^help/i) {
805    
806                            $res = "usage: /msg $NICK comand | commands: stat - user/message stat | last - show backtrace | grep foobar - find foobar";
807    
808                    } elsif ($msg =~ m/^msg\s+(\S+)\s+(.*)$/i) {
809    
810                            _log ">> /msg $1 $2";
811                            $_[KERNEL]->post( $IRC_ALIAS => privmsg => $1, $2 );
812                            $res = '';
813    
814                    } elsif ($msg =~ m/^stat.*?\s*(\d*)/i) {
815    
816                            my $nr = $1 || 10;
817    
818                            my $sth = $dbh->prepare(qq{
819                                    select
820                                            trim(both '_' from nick) as nick,
821                                            count(*) as count,
822                                            sum(length(message)) as len
823                                    from log
824                                    group by trim(both '_' from nick)
825                                    order by len desc,count desc
826                                    limit $nr
827                            });
828                            $sth->execute();
829                            $res = "Top $nr users: ";
830                            my @users;
831                            while (my $row = $sth->fetchrow_hashref) {
832                                    push @users,$row->{nick} . ': ' . $row->{count} . '/' . $row->{len} . '=' . sprintf("%.2f", $row->{len}/$row->{count});
833                            }
834                            $res .= join(" | ", @users);
835                    } elsif ($msg =~ m/^last.*?\s*(\d*)/i) {
836    
837                            my $limit = $1 || meta( $nick, $channel, 'last-size' ) || 10;
838    
839                            foreach my $res (get_from_log( limit => $limit )) {
840                                    _log "last: $res";
841                                    $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );
842                            }
843    
844                            $res = '';
845    
846                    } elsif ($msg =~ m/^(search|grep)\s+(.*)\s*$/i) {
847    
848                            my $what = $2;
849    
850                            foreach my $res (get_from_log(
851                                            limit => 20,
852                                            search => $what,
853                                    )) {
854                                    _log "search [$what]: $res";
855                                    $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );
856                            }
857    
858                            $res = '';
859    
860                    } elsif ($msg =~ m/^(?:count|poll)\s+(.*)(?:\s+(\d+))?\s*$/i) {
861    
862                            my ($what,$limit) = ($1,$2);
863                            $limit ||= 100;
864    
865                            my $stat;
866    
867                            foreach my $res (get_from_log(
868                                            limit => $limit,
869                                            search => $what,
870                                            full_rows => 1,
871                                    )) {
872                                    while ($res->{message} =~ s/\Q$what\E(\+|\-)//) {
873                                            $stat->{vote}->{$1}++;
874                                            $stat->{from}->{ $res->{nick} }++;
875                                    }
876                            }
877    
878                            my @nicks;
879                            foreach my $nick (sort { $stat->{from}->{$a} <=> $stat->{from}->{$b} } keys %{ $stat->{from} }) {
880                                    push @nicks, $nick . ( $stat->{from}->{$nick} == 1 ? '' :
881                                            "(" . $stat->{from}->{$nick} . ")"
882                                    );
883                            }
884    
885                            $res =
886                                    "$what ++ " . ( $stat->{vote}->{'+'} || 0 ) .
887                                    " : " . ( $stat->{vote}->{'-'} || 0 ) . " --" .
888                                    " from " . ( join(", ", @nicks) || 'nobody' );
889    
890                            $_[KERNEL]->post( $IRC_ALIAS => notice => $nick, $res );
891    
892                    } elsif ($msg =~ m/^ping/) {
893                            $res = "ping = " . dump( $ping );
894                    } elsif ($msg =~ m/^conf(?:ig)*\s*(last-size|twitter)*\s*(.*)/) {
895                            if ( ! defined( $1 ) ) {
896                                    my $sth = $dbh->prepare(qq{ select name,value,changed from meta where nick = ? and channel = ? });
897                                    $sth->execute( $nick, $channel );
898                                    $res = "config for $nick on $channel";
899                                    while ( my ($n,$v) = $sth->fetchrow_array ) {
900                                            $res .= " | $n = $v";
901                                    }
902                            } elsif ( ! $2 ) {
903                                    my $val = meta( $nick, $channel, $1 );
904                                    $res = "current $1 = " . ( $val ? $val : 'undefined' );
905                            } else {
906                                    my $validate = {
907                                            'last-size' => qr/^\d+/,
908                                            'twitter' => qr/^\w+\s+\w+/,
909                                    };
910    
911                                    my ( $op, $val ) = ( $1, $2 );
912    
913                                    if ( my $regex = $validate->{$op} ) {
914                                            if ( $val =~ $regex ) {
915                                                    meta( $nick, $channel, $op, $val );
916                                                    $res = "saved $op = $val";
917                                            } else {
918                                                    $res = "config option $op = $val doesn't validate against $regex";
919                                            }
920                                    } else {
921                                            $res = "config option $op doesn't exist";
922                                    }
923                            }
924                    } elsif ($msg =~ m/^rss-update/) {
925                            $res = rss_fetch_all( $_[KERNEL] );
926                    } elsif ($msg =~ m/^rss-clean/) {
927                            $_rss = undef;
928                            $res = "OK, cleaned RSS cache";
929                    } elsif ($msg =~ m!^rss-(add|remove|stop|start)\s+(http://\S+)\s*(.*)!) {
930                            my $sql = {
931                                    add             => qq{ insert into feeds (url,name) values (?,?) },
932    #                               remove  => qq{ delete from feeds                                where url = ? and name = ? },
933                                    start   => qq{ update feeds set active = true   where url = ? -- ? },
934                                    stop    => qq{ update feeds set active = false  where url = ? -- ? },
935                                    
936                            };
937                            if (my $q = $sql->{$1} ) {
938                                    my $sth = $dbh->prepare( $q );
939                                    warn "## SQL $q ( $2 | $3 )\n";
940                                    eval { $sth->execute( $2, $3 ) };
941                            }
942    
943                            $res ||= "OK, RSS $1 : $2 - $3";
944                    }
945    
946                    if ($res) {
947                            _log ">> [$nick] $res";
948                            $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );
949                    }
950    
951                    rss_check_updates( $_[KERNEL] );
952            },
953            irc_477 => sub {
954                    _log "# irc_477: ",$_[ARG1];
955                    $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "register $NICK" );
956            },
957            irc_505 => sub {
958                    _log "# irc_505: ",$_[ARG1];
959                    $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "register $NICK" );
960    #               $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "set hide email on" );
961    #               $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "set email dpavlin\@rot13.org" );
962            },
963            irc_registered => sub {
964                    _log "## registrated $NICK";
965                    $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "IDENTIFY $NICK" );
966            },
967            irc_disconnected => sub {
968                    _log "## disconnected, reconnecting again";
969                    $_[KERNEL]->post($IRC_ALIAS => connect => $CONNECT);
970            },
971            irc_socketerr => sub {
972                    _log "## socket error... sleeping for $sleep_on_error seconds and retry";
973                    sleep($sleep_on_error);
974                    $_[KERNEL]->post($IRC_ALIAS => connect => $CONNECT);
975            },
976    #       irc_433 => sub {
977    #               print "# irc_433: ",$_[ARG1], "\n";
978    #               warn "## indetify $NICK\n";
979    #               $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "IDENTIFY $NICK" );
980    #       },
981      _child => sub {},      _child => sub {},
982      _default => sub {      _default => sub {
983        printf "%s: session %s caught an unhandled %s event.\n",                  _log sprintf "sID:%s %s %s",
984          scalar localtime(), $_[SESSION]->ID, $_[ARG0];                          $_[SESSION]->ID, $_[ARG0],
985        print "The $_[ARG0] event was given these parameters: ",                          ref($_[ARG1]) eq "ARRAY"        ?       join(",", map { ref($_) eq "ARRAY" ? join(";", @{$_}) : $_ } @{ $_[ARG1] })     :
986          join(" ", map({"ARRAY" eq ref $_ ? "[@$_]" : "$_"} @{$_[ARG1]})), "\n";                          $_[ARG1]                                        ?       $_[ARG1]                                        :
987                            "";
988        0;                        # false for signals        0;                        # false for signals
989      },      },
     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);  
     }  
990     },     },
991    );    );
992    
993    # http server
994    
995    my $httpd = POE::Component::Server::HTTP->new(
996            Port => $http_port,
997            PreHandler => {
998                    '/' => sub {
999                            $_[0]->header(Connection => 'close')
1000                    }
1001            },
1002            ContentHandler => { '/' => \&root_handler },
1003            Headers        => { Server => 'irc-logger' },
1004    );
1005    
1006    my $style = <<'_END_OF_STYLE_';
1007    p { margin: 0; padding: 0.1em; }
1008    .time, .channel { color: #808080; font-size: 60%; }
1009    .date { float: right; background: #e0e0e0; color: #404040; font-size: 120%; padding: 0.25em; border: 1px dashed #808080; }
1010    .nick { color: #000000; font-size: 80%; padding: 2px; font-family: courier, courier new, monospace ; }
1011    .message { color: #000000; font-size: 100%; }
1012    .search { float: right; }
1013    a:link.tag, a:visited.tag { border: 1px dashed #ccc; backgound: #ccc; text-decoration: none }
1014    a:hover.tag { border: 1px solid #eee }
1015    hr { border: 1px dashed #ccc; height: 1px; clear: both; }
1016    /*
1017    .col-0 { background: #ffff66 }
1018    .col-1 { background: #a0ffff }
1019    .col-2 { background: #99ff99 }
1020    .col-3 { background: #ff9999 }
1021    .col-4 { background: #ff66ff }
1022    */
1023    .calendar { border: 1px solid red; width: 100%; }
1024    .month { border: 0px; width: 100%; }
1025    _END_OF_STYLE_
1026    
1027    $max_color = 0;
1028    
1029    my @cols = qw(
1030            #ffcccc #ccffe6 #ccccff #e6ccff #ffccff #ffcce6 #ff9999 #ffcc99 #ffff99
1031            #ccff99 #99ff99 #99ffcc #99ccff #9999ff #cc99ff #ff6666 #ffb366 #ffff66
1032            #66ff66 #66ffb3 #66b3ff #6666ff #ff3333 #33ff33 #3399ff #3333ff #ff3399
1033            #a0a0a0 #ff0000 #ffff00 #80ff00 #0000ff #8000ff #ff00ff #ff0080 #994d00
1034            #999900 #009900 #cc0066 #c0c0c0 #ccff99 #99ff33 #808080 #660033 #ffffff
1035    );
1036    
1037    foreach my $c (@cols) {
1038            $style .= ".col-${max_color} { background: $c }\n";
1039            $max_color++;
1040    }
1041    warn "defined $max_color colors for users...\n";
1042    
1043    sub root_handler {
1044            my ($request, $response) = @_;
1045            $response->code(RC_OK);
1046    
1047            # this doesn't seem to work, so moved to PreHandler
1048            #$response->header(Connection => 'close');
1049    
1050            return RC_OK if $request->uri =~ m/favicon.ico$/;
1051    
1052            my $q;
1053    
1054            if ( $request->method eq 'POST' ) {
1055                    $q = new CGI::Simple( $request->content );
1056            } elsif ( $request->uri =~ /\?(.+)$/ ) {
1057                    $q = new CGI::Simple( $1 );
1058            } else {
1059                    $q = new CGI::Simple;
1060            }
1061    
1062            my $search = $q->param('search') || $q->param('grep') || '';
1063    
1064            if ($request->url =~ m#/rss(?:/(tags|last-tag|follow.*)\w*(?:=(\d+))?)?#i) {
1065                    my $show = lc($1);
1066                    my $nr = $2;
1067    
1068                    my $type = 'RSS';       # Atom
1069    
1070                    $response->content_type( 'application/' . lc($type) . '+xml' );
1071    
1072                    my $html = '<!-- error -->';
1073                    #warn "create $type feed from ",dump( @last_tags );
1074    
1075                    my $feed = XML::Feed->new( $type );
1076                    $feed->link( $url );
1077    
1078                    if ( $show eq 'tags' ) {
1079                            $nr ||= 50;
1080                            $feed->title( "tags from $CHANNEL" );
1081                            $feed->link( "$url/tags" );
1082                            $feed->description( "tag cloud created from messages on channel $CHANNEL which have tags// in them" );
1083                            my $feed_entry = XML::Feed::Entry->new($type);
1084                            $feed_entry->title( "$nr tags from $CHANNEL" );
1085                            $feed_entry->author( $NICK );
1086                            $feed_entry->link( '/#tags'  );
1087    
1088                            $feed_entry->content(
1089                                    qq{<![CDATA[<style type="text/css">}
1090                                    . $cloud->css
1091                                    . qq{</style>}
1092                                    . $cloud->html( $nr )
1093                                    . qq{]]>}
1094                            );
1095                            $feed->add_entry( $feed_entry );
1096    
1097                    } elsif ( $show eq 'last-tag' ) {
1098    
1099                            $nr ||= $last_x_tags;
1100                            $nr = $last_x_tags if $nr > $last_x_tags;
1101    
1102                            $feed->title( "last $nr tagged messages from $CHANNEL" );
1103                            $feed->description( "collects messages which have tags// in them" );
1104    
1105                            foreach my $m ( @last_tags ) {
1106    #                               warn dump( $m );
1107                                    #my $tags = join(' ', @{$m->{tags}} );
1108                                    my $feed_entry = XML::Feed::Entry->new($type);
1109                                    $feed_entry->title( $m->{nick} . '@' . $m->{time} );
1110                                    $feed_entry->author( $m->{nick} );
1111                                    $feed_entry->link( '/#' . $m->{id}  );
1112                                    $feed_entry->issued( DateTime::Format::Flexible->build( $m->{time} ) );
1113    
1114                                    my $message = $filter->{message}->( $m->{message} );
1115                                    $message .= "<br/>\n" unless $message =~ m!<(/p|br/?)>!;
1116    #                               warn "## message = $message\n";
1117    
1118                                    #$feed_entry->summary(
1119                                    $feed_entry->content(
1120                                            "<![CDATA[$message]]>"
1121                                    );
1122                                    $feed_entry->category( join(', ', @{$m->{tags}}) );
1123                                    $feed->add_entry( $feed_entry );
1124    
1125                                    $nr--;
1126                                    last if $nr <= 0;
1127    
1128                            }
1129    
1130                    } elsif ( $show =~ m/^follow/ ) {
1131    
1132                            $feed->title( "Feeds which this bot follows" );
1133    
1134                            my $sth = $dbh->prepare( qq{ select * from feeds order by last_update desc } );
1135                            $sth->execute;
1136                            while (my $row = $sth->fetchrow_hashref) {
1137                                    my $feed_entry = XML::Feed::Entry->new($type);
1138                                    $feed_entry->title( $row->{name} );
1139                                    $feed_entry->link( $row->{url}  );
1140                                    $feed_entry->issued( DateTime::Format::Flexible->build( $row->{last_update} ) );
1141                                    $feed_entry->content(
1142                                            '<![CDATA[<pre>' . dump( $row ) . '</pre>]]>'
1143                                    );
1144                                    $feed->add_entry( $feed_entry );
1145                            }
1146    
1147                    } else {
1148                            _log "unknown rss request ",$request->url;
1149                            return RC_DENY;
1150                    }
1151    
1152                    $response->content( $feed->as_xml );
1153                    return RC_OK;
1154            }
1155    
1156            if ( $@ ) {
1157                    warn "$@";
1158            }
1159    
1160            $response->content_type("text/html; charset=UTF-8");
1161    
1162            my $html =
1163                    qq{<html><head><title>$NICK</title><style type="text/css">$style}
1164                    . $cloud->css
1165                    . qq{</style></head><body>}
1166                    . qq{
1167                    <form method="post" class="search" action="/">
1168                    <input type="text" name="search" value="$search" size="10">
1169                    <input type="submit" value="search">
1170                    </form>
1171                    }
1172                    . $cloud->html(500)
1173                    . qq{<p>};
1174    
1175            if ($request->url =~ m#/tags?#) {
1176                    # nop
1177            } elsif ($request->url =~ m#/history#) {
1178                    my $sth = $dbh->prepare(qq{
1179                            select date(time) as date,count(*) as nr,sum(length(message)) as len
1180                                    from log
1181                                    group by date(time)
1182                                    order by date(time) desc
1183                    });
1184                    $sth->execute();
1185                    my ($l_yyyy,$l_mm) = (0,0);
1186                    $html .= qq{<table class="calendar"><tr>};
1187                    my $cal;
1188                    my $ord = 0;
1189                    while (my $row = $sth->fetchrow_hashref) {
1190                            # this is probably PostgreSQL specific, expects ISO date
1191                            my ($yyyy,$mm,$dd) = split(/-/, $row->{date});
1192                            if ($yyyy != $l_yyyy || $mm != $l_mm) {
1193                                    if ( $cal ) {
1194                                            $html .= qq{<td valign="top">} . $cal->as_HTML() . qq{</td>};
1195                                            $ord++;
1196                                            $html .= qq{</tr><tr>} if ( $ord % 3 == 0 );
1197                                    }
1198                                    $cal = new HTML::CalendarMonthSimple('month'=>$mm,'year'=>$yyyy);
1199                                    $cal->border(1);
1200                                    $cal->width('30%');
1201                                    $cal->cellheight('5em');
1202                                    $cal->tableclass('month');
1203                                    #$cal->cellclass('day');
1204                                    $cal->sunday('SUN');
1205                                    $cal->saturday('SAT');
1206                                    $cal->weekdays('MON','TUE','WED','THU','FRI');
1207                                    ($l_yyyy,$l_mm) = ($yyyy,$mm);
1208                            }
1209                            $cal->setcontent($dd, qq[
1210                                    <a href="$url?date=$row->{date}">$row->{nr}</a><br/>$row->{len}
1211                            ]) if $cal;
1212                            
1213                    }
1214                    $html .= qq{<td valign="top">} . $cal->as_HTML() . qq{</td></tr></table>};
1215    
1216            } else {
1217                    $html .= join("</p><p>",
1218                            get_from_log(
1219                                    limit => ( $q->param('last') || $q->param('date') ) ? undef : 100,
1220                                    search => $search || undef,
1221                                    tag => $q->param('tag') || undef,
1222                                    date => $q->param('date') || undef,
1223                                    fmt => {
1224                                            date => sub {
1225                                                    my $date = shift || return;
1226                                                    qq{<hr/><div class="date"><a href="$url?date=$date">$date</a></div>};
1227                                            },
1228                                            time => '<span class="time">%s</span> ',
1229                                            time_channel => '<span class="channel">%s %s</span> ',
1230                                            nick => '%s:&nbsp;',
1231                                            me_nick => '***%s&nbsp;',
1232                                            message => '<span class="message">%s</span>',
1233                                    },
1234                                    filter => $filter,
1235                            )
1236                    );
1237            }
1238    
1239            $html .= qq{</p>
1240            <hr/>
1241            <p>See <a href="/history">history</a> of all messages.</p>
1242            </body></html>};
1243    
1244            $response->content( $html );
1245            warn "<< ", $request->method, " ", $request->uri, " created ", length($html), " bytes\n";
1246            return RC_OK;
1247    }
1248    
1249  POE::Kernel->run;  POE::Kernel->run;
Legend:
Removed from v.6  
changed lines
  Added in v.89
  ViewVC Help
Powered by ViewVC 1.1.26