/[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 9 by dpavlin, Wed Mar 1 23:35:56 2006 UTC revision 35 by dpavlin, Sun Jun 25 00:10:13 2006 UTC
# Line 18  log all conversation on irc channel Line 18  log all conversation on irc channel
18    
19  ## CONFIG  ## CONFIG
20    
21  my $NICK = 'irc-logger-dev';  my $HOSTNAME = `hostname`;
22    
23    my $NICK = 'irc-logger';
24    $NICK .= '-dev' if ($HOSTNAME =~ m/llin/);
25  my $CONNECT =  my $CONNECT =
26    {Server => 'irc.freenode.net',    {Server => 'irc.freenode.net',
27     Nick => $NICK,     Nick => $NICK,
28     Ircname => "try /msg $NICK help",     Ircname => "try /msg $NICK help",
29    };    };
30  my $CHANNEL = '#razmjenavjestina';  my $CHANNEL = '#razmjenavjestina';
31    $CHANNEL = '#irc-logger' if ($HOSTNAME =~ m/llin/);
32  my $IRC_ALIAS = "log";  my $IRC_ALIAS = "log";
33    
34  my %FOLLOWS =  my %FOLLOWS =
# Line 33  my %FOLLOWS = Line 37  my %FOLLOWS =
37     ERROR => "/var/log/apache/error.log",     ERROR => "/var/log/apache/error.log",
38    );    );
39    
40  my $DSN = 'DBI:Pg:dbname=irc-logger';  my $DSN = 'DBI:Pg:dbname=' . $NICK;
41    
42    my $ENCODING = 'ISO-8859-2';
43    my $TIMESTAMP = '%Y-%m-%d %H:%M:%S';
44    
45  ## END CONFIG  ## END CONFIG
46    
47    
48    
49  use POE qw(Component::IRC Wheel::FollowTail);  use POE qw(Component::IRC Wheel::FollowTail Component::Server::HTTP);
50    use HTTP::Status;
51  use DBI;  use DBI;
52  use Encode qw/from_to/;  use Encode qw/from_to is_utf8/;
53    use Regexp::Common qw /URI/;
54    use CGI::Simple;
55    use HTML::TagCloud;
56    use POSIX qw/strftime/;
57    use HTML::CalendarMonthSimple;
58    
59  my $dbh = DBI->connect($DSN,"","", { RaiseError => 1, AutoCommit => 1 }) || die $DBI::errstr;  my $dbh = DBI->connect($DSN,"","", { RaiseError => 1, AutoCommit => 1 }) || die $DBI::errstr;
60    
61  =for SQL schema  eval {
62            $dbh->do(qq{ select count(*) from log });
63    };
64    
65    if ($@) {
66            warn "creating database table in $DSN\n";
67            $dbh->do(<<'_SQL_SCHEMA_');
68    
 $dbh->do(qq{  
69  create table log (  create table log (
70          id serial,          id serial,
71          time timestamp default now(),          time timestamp default now(),
72          channel text not null,          channel text not null,
73            me boolean default false,
74          nick text not null,          nick text not null,
75          message text not null,          message text not null,
76          primary key(id)          primary key(id)
# Line 62  create index log_time on log(time); Line 80  create index log_time on log(time);
80  create index log_channel on log(channel);  create index log_channel on log(channel);
81  create index log_nick on log(nick);  create index log_nick on log(nick);
82    
83  });  _SQL_SCHEMA_
84    }
 =cut  
85    
86  my $sth = $dbh->prepare(qq{  my $sth = $dbh->prepare(qq{
87  insert into log  insert into log
88          (channel, nick, message)          (channel, me, nick, message)
89  values (?,?,?)  values (?,?,?,?)
90  });  });
91    
92    my $tags;
93    my $tag_regex = '\b([\w-_]+)//';
94    
95    =head2 get_from_log
96    
97     my @messages = get_from_log(
98            limit => 42,
99            search => '%what to stuff in ilike%',
100            fmt => {
101                    time => '{%s} ',
102                    time_channel => '{%s %s} ',
103                    nick => '%s: ',
104                    me_nick => '***%s ',
105                    message => '%s',
106            },
107            filter => {
108                    message => sub {
109                            # modify message content
110                            return shift;
111                    }
112            },
113            context => 5,
114     );
115    
116    Order is important. Fields are first passed through C<filter> (if available) and
117    then throgh C<< sprintf($fmt->{message}, $message >> if available.
118    
119    C<context> defines number of messages around each search hit for display.
120    
121    =cut
122    
123    sub get_from_log {
124            my $args = {@_};
125    
126            $args->{fmt} ||= {
127                    date => '[%s] ',
128                    time => '{%s} ',
129                    time_channel => '{%s %s} ',
130                    nick => '%s: ',
131                    me_nick => '***%s ',
132                    message => '%s',
133            };
134    
135            my $sql_message = qq{
136                    select
137                            time::date as date,
138                            time::time as time,
139                            channel,
140                            me,
141                            nick,
142                            message
143                    from log
144            };
145    
146            my $sql_context = qq{
147                    select
148                            id
149                    from log
150            };
151    
152            my $context = $1 if ($args->{search} && $args->{search} =~ s/\s*\+(\d+)\s*/ /);
153    
154            my $sql = $context ? $sql_context : $sql_message;
155    
156            $sql .= " where message ilike ? or nick ilike ? " if ($args->{search});
157            $sql .= " where id in (" . join(",", @{ $tags->{ $args->{tag} } }) . ") " if ($args->{tag} && $tags->{ $args->{tag} });
158            $sql .= " where date(time) = ? " if ($args->{date});
159            $sql .= " order by log.time desc";
160            $sql .= " limit " . $args->{limit} if ($args->{limit});
161    
162            my $sth = $dbh->prepare( $sql );
163            if (my $search = $args->{search}) {
164                    $search =~ s/^\s+//;
165                    $search =~ s/\s+$//;
166                    $sth->execute( ( '%' . $search . '%' ) x 2 );
167                    warn "search for '$search' returned ", $sth->rows, " results ", $context || '', "\n";
168            } elsif (my $tag = $args->{tag}) {
169                    $sth->execute();
170                    warn "tag '$tag' returned ", $sth->rows, " results ", $context || '', "\n";
171            } elsif (my $date = $args->{date}) {
172                    $sth->execute($date);
173                    warn "found ", $sth->rows, " messages for date $date ", $context || '', "\n";
174            } else {
175                    $sth->execute();
176            }
177            my $last_row = {
178                    date => '',
179                    time => '',
180                    channel => '',
181                    nick => '',
182            };
183    
184            my @rows;
185    
186            while (my $row = $sth->fetchrow_hashref) {
187                    unshift @rows, $row;
188            }
189    
190            my @msgs = (
191                    "Showing " . ($#rows + 1) . " messages..."
192            );
193    
194            if ($context) {
195                    my @ids = @rows;
196                    @rows = ();
197    
198                    my $last_to = 0;
199    
200                    my $sth = $dbh->prepare( $sql_message . qq{ where id >= ? and id < ? } );
201                    foreach my $row_id (sort { $a->{id} <=> $b->{id} } @ids) {
202                            my $id = $row_id->{id} || die "can't find id in row";
203            
204                            my ($from, $to) = ($id - $context, $id + $context);
205                            $from = $last_to if ($from < $last_to);
206                            $last_to = $to;
207                            $sth->execute( $from, $to );
208    
209                            #warn "## id: $id from: $from to: $to returned: ", $sth->rows, "\n";
210    
211                            while (my $row = $sth->fetchrow_hashref) {
212                                    push @rows, $row;
213                            }
214    
215                    }
216            }
217    
218            # sprintf which can take coderef as first parametar
219            sub cr_sprintf {
220                    my $fmt = shift || return;
221                    if (ref($fmt) eq 'CODE') {
222                            $fmt->(@_);
223                    } else {
224                            sprintf($fmt, @_);
225                    }
226            }
227    
228            foreach my $row (@rows) {
229    
230                    $row->{time} =~ s#\.\d+##;
231    
232                    my $msg = '';
233    
234                    $msg = cr_sprintf($args->{fmt}->{date}, $row->{date}) . ' ' if ($last_row->{date} ne $row->{date});
235                    my $t = $row->{time};
236    
237                    if ($last_row->{channel} ne $row->{channel}) {
238                            $msg .= cr_sprintf($args->{fmt}->{time_channel}, $t, $row->{channel});
239                    } else {
240                            $msg .= cr_sprintf($args->{fmt}->{time}, $t);
241                    }
242    
243                    my $append = 1;
244    
245                    my $nick = $row->{nick};
246                    if ($nick =~ s/^_*(.*?)_*$/$1/) {
247                            $row->{nick} = $nick;
248                    }
249    
250                    if ($last_row->{nick} ne $nick) {
251                            # obfu way to find format for me_nick if needed or fallback to default
252                            my $fmt = $row->{me} ? ( $args->{fmt}->{me_nick} || $args->{fmt}->{nick} ) : $args->{fmt}->{nick};
253                            $fmt ||= '%s';
254    
255                            $nick = $args->{filter}->{nick}->($nick) if (ref($args->{filter}->{nick}) eq 'CODE');
256    
257                            $msg .= cr_sprintf( $fmt, $nick );
258                            $append = 0;
259                    }
260    
261                    $args->{fmt}->{message} ||= '%s';
262                    if (ref($args->{filter}->{message}) eq 'CODE') {
263                            $msg .= cr_sprintf($args->{fmt}->{message},
264                                    $args->{filter}->{message}->(
265                                            $row->{message}
266                                    )
267                            );
268                    } else {
269                            $msg .= cr_sprintf($args->{fmt}->{message}, $row->{message});
270                    }
271    
272                    if ($append && @msgs) {
273                            $msgs[$#msgs] .= " " . $msg;
274                    } else {
275                            push @msgs, $msg;
276                    }
277    
278                    $last_row = $row;
279            }
280    
281            return @msgs;
282    }
283    
284    
285  my $SKIPPING = 0;               # if skipping, how many we've done  my $SKIPPING = 0;               # if skipping, how many we've done
286  my $SEND_QUEUE;                 # cache  my $SEND_QUEUE;                 # cache
287    
288  POE::Component::IRC->new($IRC_ALIAS);  POE::Component::IRC->new($IRC_ALIAS);
289    
290  POE::Session->create  POE::Session->create( inline_states =>
   (inline_states =>  
291     {_start => sub {           {_start => sub {      
292                  $_[KERNEL]->post($IRC_ALIAS => register => 'all');                  $_[KERNEL]->post($IRC_ALIAS => register => 'all');
293                  $_[KERNEL]->post($IRC_ALIAS => connect => $CONNECT);                  $_[KERNEL]->post($IRC_ALIAS => connect => $CONNECT);
# Line 89  POE::Session->create Line 297  POE::Session->create
297                  $_[KERNEL]->post($IRC_ALIAS => join => '#logger');                  $_[KERNEL]->post($IRC_ALIAS => join => '#logger');
298                  $_[KERNEL]->yield("heartbeat"); # start heartbeat                  $_[KERNEL]->yield("heartbeat"); # start heartbeat
299  #               $_[KERNEL]->yield("my_add", $_) for keys %FOLLOWS;  #               $_[KERNEL]->yield("my_add", $_) for keys %FOLLOWS;
300                    $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "IDENTIFY $NICK" );
301      },      },
302      irc_public => sub {      irc_public => sub {
303                  my $kernel = $_[KERNEL];                  my $kernel = $_[KERNEL];
# Line 96  POE::Session->create Line 305  POE::Session->create
305                  my $channel = $_[ARG1]->[0];                  my $channel = $_[ARG1]->[0];
306                  my $msg = $_[ARG2];                  my $msg = $_[ARG2];
307    
308                  from_to($msg, 'UTF-8', 'ISO-8859-2');                  from_to($msg, 'UTF-8', $ENCODING);
309    
310                  print "$channel: <$nick> $msg\n";                  print "$channel: <$nick> $msg\n";
311                  $sth->execute($channel, $nick, $msg);                  $sth->execute($channel, 0, $nick, $msg);
312                    add_tag( id => $dbh->last_insert_id(undef,undef,"log",undef),
313                            message => $msg);
314        },
315        irc_ctcp_action => sub {
316                    my $kernel = $_[KERNEL];
317                    my $nick = (split /!/, $_[ARG0])[0];
318                    my $channel = $_[ARG1]->[0];
319                    my $msg = $_[ARG2];
320    
321                    from_to($msg, 'UTF-8', $ENCODING);
322    
323                    print "$channel ***$nick $msg\n";
324                    $sth->execute($channel, 1, $nick, $msg);
325                    add_tag( id => $dbh->last_insert_id(undef,undef,"log",undef),
326                            message => $msg);
327      },      },
328          irc_msg => sub {          irc_msg => sub {
329                  my $kernel = $_[KERNEL];                  my $kernel = $_[KERNEL];
330                  my $nick = (split /!/, $_[ARG0])[0];                  my $nick = (split /!/, $_[ARG0])[0];
331                  my $msg = $_[ARG2];                  my $msg = $_[ARG2];
332                  from_to($msg, 'UTF-8', 'ISO-8859-2');                  from_to($msg, 'UTF-8', $ENCODING);
333    
334                  my $res = "unknown command '$msg', try /msg $NICK help!";                  my $res = "unknown command '$msg', try /msg $NICK help!";
335                    my @out;
336    
337                  print "<< $msg\n";                  print "<< $msg\n";
338    
339                  if ($msg =~ m/^help/i) {                  if ($msg =~ m/^help/i) {
340    
341                          $res = "usage: /msg $NICK stat - shows user statistics | /msg $NICK last - show backtrace of conversations";                          $res = "usage: /msg $NICK comand | commands: stat - user/message stat | last - show backtrace | grep foobar - find foobar";
342    
343                    } elsif ($msg =~ m/^msg\s+(\S+)\s+(.*)$/i) {
344    
345                            print ">> /msg $1 $2\n";
346                            $_[KERNEL]->post( $IRC_ALIAS => privmsg => $1, $2 );
347                            $res = '';
348    
349                  } elsif ($msg =~ m/^stat.*?\s*(\d*)/i) {                  } elsif ($msg =~ m/^stat.*?\s*(\d*)/i) {
350    
# Line 131  POE::Session->create Line 362  POE::Session->create
362                          $res .= join(" | ", @users);                          $res .= join(" | ", @users);
363                  } elsif ($msg =~ m/^last.*?\s*(\d*)/i) {                  } elsif ($msg =~ m/^last.*?\s*(\d*)/i) {
364    
365                          my $nr = $1 || 10;                          foreach my $res (get_from_log( limit => $1 )) {
366                                    print "last: $res\n";
367                          my $sth = $dbh->prepare(qq{                                  from_to($res, $ENCODING, 'UTF-8');
368                                  select                                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );
                                         time::date as date,  
                                         time::time as time,  
                                         channel,  
                                         nick,  
                                         message  
                                 from log order by log.time desc limit $nr  
                         });  
                         $sth->execute();  
                         $res = "Last $nr messages: ";  
                         my $last_row = {  
                                 date => '',  
                                 time => '',  
                                 channel => '',  
                                 nick => '',  
                         };  
   
                         my @rows;  
   
                         while (my $row = $sth->fetchrow_hashref) {  
                                 unshift @rows, $row;  
369                          }                          }
370    
371                          my @msgs;                          $res = '';
   
                         foreach my $row (@rows) {  
   
                                 $row->{time} =~ s#\.\d+##;  
   
                                 my $t;  
                                 $t = $row->{date} . ' ' if ($last_row->{date} ne $row->{date});  
                                 $t .= $row->{time};  
   
                                 my $msg = '';  
   
                                 $msg .= "($t";  
                                 $msg .= ' ' . $row->{channel} if ($last_row->{channel} ne $row->{channel});  
                                 $msg .= ") ";  
   
                                 $msg .= $row->{nick} . ': '  if ($last_row->{nick} ne $row->{nick});  
   
                                 $msg .= $row->{message};  
372    
373                                  push @msgs, $msg;                  } elsif ($msg =~ m/^(search|grep)\s+(.*)\s*$/i) {
374    
375                                  $last_row = $row;                          my $what = $2;
                         }  
376    
377                          foreach my $res (@msgs) {                          foreach my $res (get_from_log(
378                                  print "last: $res\n";                                          limit => 20,
379                                  from_to($res, 'ISO-8859-2', 'UTF-8');                                          search => $what,
380                                    )) {
381                                    print "search [$what]: $res\n";
382                                    from_to($res, $ENCODING, 'UTF-8');
383                                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );                                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );
384                          }                          }
385    
386                          $res = '';                          $res = '';
387    
388                  }                  }
389    
390                  if ($res) {                  if ($res) {
391                          print ">> [$nick] $res\n";                          print ">> [$nick] $res\n";
392                          from_to($res, 'ISO-8859-2', 'UTF-8');                          from_to($res, $ENCODING, 'UTF-8');
393                          $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );                          $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );
394                  }                  }
395    
396          },          },
397            irc_477 => sub {
398                    print "# irc_477: ",$_[ARG1], "\n";
399                    $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "register $NICK" );
400            },
401          irc_505 => sub {          irc_505 => sub {
402          print "# irc_505: ",$_[ARG1], "\n";                  print "# irc_505: ",$_[ARG1], "\n";
403                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "register $NICK" );                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "register $NICK" );
404                  warn "## register $NICK\n";  #               $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "set hide email on" );
405    #               $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "set email dpavlin\@rot13.org" );
406          },          },
407          irc_registered => sub {          irc_registered => sub {
                 $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "IDENTIFY $NICK" );  
408                  warn "## indetify $NICK\n";                  warn "## indetify $NICK\n";
409                    $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "IDENTIFY $NICK" );
410          },          },
411      (map  #       irc_433 => sub {
412       {  #               print "# irc_433: ",$_[ARG1], "\n";
413         ;"irc_$_" => sub { }}  #               warn "## indetify $NICK\n";
414       qw(join  #               $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "IDENTIFY $NICK" );
415          ctcp_version  #       },
         connected snotice ctcp_action ping notice mode part quit  
         001 002 003 004 005  
         250 251 252 253 254 265 266  
         332 333 353 366 372 375 376  
                 477  
                 )),  
416      _child => sub {},      _child => sub {},
417      _default => sub {      _default => sub {
418        printf "%s: session %s caught an unhandled %s event.\n",                  printf "%s #%s %s %s\n",
419          scalar localtime(), $_[SESSION]->ID, $_[ARG0];                          strftime($TIMESTAMP,localtime()), $_[SESSION]->ID, $_[ARG0],
420        print "The $_[ARG0] event was given these parameters: ",                          ref($_[ARG1]) eq "ARRAY"        ?       join(",", map { ref($_) eq "ARRAY" ? join(";", @{$_}) : $_ } @{ $_[ARG1] })     :
421          join(" ", map({"ARRAY" eq ref $_ ? "[@$_]" : "$_"} @{$_[ARG1]})), "\n";                          $_[ARG1]                                        ?       $_[ARG1]                                        :
422                            "";
423        0;                        # false for signals        0;                        # false for signals
424      },      },
425      my_add => sub {      my_add => sub {
# Line 289  POE::Session->create Line 485  POE::Session->create
485     },     },
486    );    );
487    
488    # tags support
489    
490    my $cloud = HTML::TagCloud->new;
491    
492    =head2 add_tag
493    
494     add_tag( id => 42, message => 'irc message' );
495    
496    =cut
497    
498    sub add_tag {
499            my $arg = {@_};
500    
501            return unless ($arg->{id} && $arg->{message});
502    
503            my $m = $arg->{message};
504            from_to('UTF-8', 'iso-8859-2', $m) if (is_utf8($m));
505    
506            while ($m =~ s#$tag_regex##s) {
507                    my $tag = $1;
508                    next if (! $tag || $tag =~ m/https?:/i);
509                    push @{ $tags->{$tag} }, $arg->{id};
510                    #warn "+tag $tag: $arg->{id}\n";
511                    $cloud->add($tag, "?tag=$tag", scalar @{$tags->{$tag}} + 1);
512            }
513    }
514    
515    =head2 seed_tags
516    
517    Read all tags from database and create in-memory cache for tags
518    
519    =cut
520    
521    sub seed_tags {
522            my $sth = $dbh->prepare(qq{ select id,message from log where message like '%//%' });
523            $sth->execute;
524            while (my $row = $sth->fetchrow_hashref) {
525                    add_tag( %$row );
526            }
527    
528            foreach my $tag (keys %$tags) {
529                    $cloud->add($tag, "?tag=$tag", scalar @{$tags->{$tag}} + 1);
530            }
531    }
532    
533    seed_tags;
534    
535    # http server
536    
537    my $httpd = POE::Component::Server::HTTP->new(
538            Port => $NICK =~ m/-dev/ ? 8001 : 8000,
539            ContentHandler => { '/' => \&root_handler },
540            Headers        => { Server => 'irc-logger' },
541    );
542    
543    my %escape = ('<'=>'&lt;', '>'=>'&gt;', '&'=>'&amp;', '"'=>'&quot;');
544    my $escape_re  = join '|' => keys %escape;
545    
546    my $style = <<'_END_OF_STYLE_';
547    p { margin: 0; padding: 0.1em; }
548    .time, .channel { color: #808080; font-size: 60%; }
549    .date { float: right; background: #e0e0e0; color: #404040; font-size: 120%; padding: 0.25em; border: 1px dashed #808080; }
550    .nick { color: #000000; font-size: 80%; padding: 2px; font-family: courier, courier new, monospace ; }
551    .message { color: #000000; font-size: 100%; }
552    .search { float: right; }
553    .col-0 { background: #ffff66 }
554    .col-1 { background: #a0ffff }
555    .col-2 { background: #99ff99 }
556    .col-3 { background: #ff9999 }
557    .col-4 { background: #ff66ff }
558    a:link.tag, a:visited.tag { border: 1px dashed #ccc; backgound: #ccc; text-decoration: none }
559    a:hover.tag { border: 1px solid #eee }
560    hr { border: 1px dashed #ccc; height: 1px; clear: both; }
561    _END_OF_STYLE_
562    
563    my $max_color = 4;
564    
565    my %nick_enumerator;
566    
567    sub root_handler {
568            my ($request, $response) = @_;
569            $response->code(RC_OK);
570            $response->content_type("text/html; charset=$ENCODING");
571    
572            my $q;
573    
574            if ( $request->method eq 'POST' ) {
575                    $q = new CGI::Simple( $request->content );
576            } elsif ( $request->uri =~ /\?(.+)$/ ) {
577                    $q = new CGI::Simple( $1 );
578            } else {
579                    $q = new CGI::Simple;
580            }
581    
582            my $search = $q->param('search') || $q->param('grep') || '';
583    
584            my $html =
585                    qq{<html><head><title>$NICK</title><style type="text/css">$style} .
586                    $cloud->css .
587                    qq{</style></head><body>} .
588                    qq{
589                    <form method="post" class="search" action="/">
590                    <input type="text" name="search" value="$search" size="10">
591                    <input type="submit" value="search">
592                    </form>
593                    } .
594                    $cloud->html(500) .
595                    qq{<p>};
596            if ($request->url =~ m#/history#) {
597                    my $sth = $dbh->prepare(qq{
598                            select date(time) as date,count(*) as nr
599                                    from log
600                                    group by date(time)
601                                    order by date(time) desc
602                    });
603                    $sth->execute();
604                    my ($l_yyyy,$l_mm) = (0,0);
605                    my $cal;
606                    while (my $row = $sth->fetchrow_hashref) {
607                            # this is probably PostgreSQL specific, expects ISO date
608                            my ($yyyy,$mm,$dd) = split(/-/, $row->{date});
609                            if ($yyyy != $l_yyyy || $mm != $l_mm) {
610                                    $html .= $cal->as_HTML() if ($cal);
611                                    $cal = new HTML::CalendarMonthSimple('month'=>$mm,'year'=>$yyyy);
612                                    $cal->border(2);
613                                    ($l_yyyy,$l_mm) = ($yyyy,$mm);
614                            }
615                            $cal->setcontent($dd, qq{
616                                    <a href="/?date=$row->{date}">$row->{nr}</a>
617                            });
618                    }
619                    $html .= $cal->as_HTML() if ($cal);
620    
621            } else {
622                    $html .= join("</p><p>",
623                            get_from_log(
624                                    limit => $q->param('last') || $q->param('date') ? undef : 100,
625                                    search => $search || undef,
626                                    tag => $q->param('tag') || undef,
627                                    date => $q->param('date') || undef,
628                                    fmt => {
629                                            date => sub {
630                                                    my $date = shift || return;
631                                                    qq{<hr/><div class="date"><a href="/?date=$date">$date</a></div> '};
632                                            },
633                                            time => '<span class="time">%s</span> ',
634                                            time_channel => '<span class="channel">%s %s</span> ',
635                                            nick => '%s:&nbsp;',
636                                            me_nick => '***%s&nbsp;',
637                                            message => '<span class="message">%s</span>',
638                                    },
639                                    filter => {
640                                            message => sub {
641                                                    my $m = shift || return;
642                                                    $m =~ s/($escape_re)/$escape{$1}/gs;
643                                                    $m =~ s#($RE{URI}{HTTP})#<a href="$1">$1</a>#gs;
644                                                    $m =~ s#$tag_regex#<a href="?tag=$1" class="tag">$1</a>#g;
645                                                    return $m;
646                                            },
647                                            nick => sub {
648                                                    my $n = shift || return;
649                                                    if (! $nick_enumerator{$n})  {
650                                                            my $max = scalar keys %nick_enumerator;
651                                                            $nick_enumerator{$n} = $max + 1;
652                                                    }
653                                                    return '<span class="nick col-' .
654                                                            ( $nick_enumerator{$n} % $max_color ) .
655                                                            '">' . $n . '</span>';
656                                            },
657                                    },
658                            )
659                    );
660            }
661    
662            $html .= qq{</p>
663            <hr/>
664            <p>See <a href="/history">history</a> of all messages.</p>
665            </body></html>};
666    
667            $response->content( $html );
668            return RC_OK;
669    }
670    
671  POE::Kernel->run;  POE::Kernel->run;

Legend:
Removed from v.9  
changed lines
  Added in v.35

  ViewVC Help
Powered by ViewVC 1.1.26