/[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 15 by dpavlin, Mon Mar 13 12:56:26 2006 UTC revision 40 by dpavlin, Tue Oct 24 12:50:41 2006 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  =head1 DESCRIPTION  =head1 DESCRIPTION
22    
23  log all conversation on irc channel  log all conversation on irc channel
# Line 18  log all conversation on irc channel Line 26  log all conversation on irc channel
26    
27  ## CONFIG  ## CONFIG
28    
29    my $HOSTNAME = `hostname`;
30    
31  my $NICK = 'irc-logger';  my $NICK = 'irc-logger';
32    $NICK .= '-dev' if ($HOSTNAME =~ m/llin/);
33  my $CONNECT =  my $CONNECT =
34    {Server => 'irc.freenode.net',    {Server => 'irc.freenode.net',
35     Nick => $NICK,     Nick => $NICK,
36     Ircname => "try /msg $NICK help",     Ircname => "try /msg $NICK help",
37    };    };
38  my $CHANNEL = '#razmjenavjestina';  my $CHANNEL = '#razmjenavjestina';
39    $CHANNEL = '#irc-logger' if ($HOSTNAME =~ m/llin/);
40  my $IRC_ALIAS = "log";  my $IRC_ALIAS = "log";
41    
42  my %FOLLOWS =  my %FOLLOWS =
# Line 33  my %FOLLOWS = Line 45  my %FOLLOWS =
45     ERROR => "/var/log/apache/error.log",     ERROR => "/var/log/apache/error.log",
46    );    );
47    
48  my $DSN = 'DBI:Pg:dbname=irc-logger';  my $DSN = 'DBI:Pg:dbname=' . $NICK;
49    
50  my $ENCODING = 'ISO-8859-2';  my $ENCODING = 'ISO-8859-2';
51    my $TIMESTAMP = '%Y-%m-%d %H:%M:%S';
52    
53  ## END CONFIG  ## END CONFIG
54    
# Line 44  my $ENCODING = 'ISO-8859-2'; Line 57  my $ENCODING = 'ISO-8859-2';
57  use POE qw(Component::IRC Wheel::FollowTail Component::Server::HTTP);  use POE qw(Component::IRC Wheel::FollowTail Component::Server::HTTP);
58  use HTTP::Status;  use HTTP::Status;
59  use DBI;  use DBI;
60  use Encode qw/from_to/;  use Encode qw/from_to is_utf8/;
61  use Regexp::Common qw /URI/;  use Regexp::Common qw /URI/;
62    use CGI::Simple;
63    use HTML::TagCloud;
64    use POSIX qw/strftime/;
65    use HTML::CalendarMonthSimple;
66    use Getopt::Long;
67    use DateTime;
68    
69    my $import_dircproxy;
70    GetOptions(
71            'import-dircproxy:s' => \$import_dircproxy,
72    );
73    
74  my $dbh = DBI->connect($DSN,"","", { RaiseError => 1, AutoCommit => 1 }) || die $DBI::errstr;  my $dbh = DBI->connect($DSN,"","", { RaiseError => 1, AutoCommit => 1 }) || die $DBI::errstr;
75    
76  =for SQL schema  eval {
77            $dbh->do(qq{ select count(*) from log });
78    };
79    
80    if ($@) {
81            warn "creating database table in $DSN\n";
82            $dbh->do(<<'_SQL_SCHEMA_');
83    
 $dbh->do(qq{  
84  create table log (  create table log (
85          id serial,          id serial,
86          time timestamp default now(),          time timestamp default now(),
87          channel text not null,          channel text not null,
88            me boolean default false,
89          nick text not null,          nick text not null,
90          message text not null,          message text not null,
91          primary key(id)          primary key(id)
# Line 66  create index log_time on log(time); Line 95  create index log_time on log(time);
95  create index log_channel on log(channel);  create index log_channel on log(channel);
96  create index log_nick on log(nick);  create index log_nick on log(nick);
97    
98  });  _SQL_SCHEMA_
99    }
 =cut  
100    
101  my $sth = $dbh->prepare(qq{  my $sth = $dbh->prepare(qq{
102  insert into log  insert into log
103          (channel, nick, message)          (channel, me, nick, message, time)
104  values (?,?,?)  values (?,?,?,?,?)
105  });  });
106    
107    my $tags;
108    my $tag_regex = '\b([\w-_]+)//';
109    
110  =head2 get_from_log  =head2 get_from_log
111    
112   my @messages = get_from_log(   my @messages = get_from_log(
# Line 85  values (?,?,?) Line 116  values (?,?,?)
116                  time => '{%s} ',                  time => '{%s} ',
117                  time_channel => '{%s %s} ',                  time_channel => '{%s %s} ',
118                  nick => '%s: ',                  nick => '%s: ',
119                    me_nick => '***%s ',
120                  message => '%s',                  message => '%s',
121          },          },
122          message_filter => sub {          filter => {
123                  # modify message content                  message => sub {
124                  return shift;                          # modify message content
125          }                          return shift;
126                    }
127            },
128            context => 5,
129   );   );
130    
131    Order is important. Fields are first passed through C<filter> (if available) and
132    then throgh C<< sprintf($fmt->{message}, $message >> if available.
133    
134    C<context> defines number of messages around each search hit for display.
135    
136  =cut  =cut
137    
138  sub get_from_log {  sub get_from_log {
139          my $args = {@_};          my $args = {@_};
140    
         $args->{limit} ||= 10;  
   
141          $args->{fmt} ||= {          $args->{fmt} ||= {
142                    date => '[%s] ',
143                  time => '{%s} ',                  time => '{%s} ',
144                  time_channel => '{%s %s} ',                  time_channel => '{%s %s} ',
145                  nick => '%s: ',                  nick => '%s: ',
146                    me_nick => '***%s ',
147                  message => '%s',                  message => '%s',
148          };          };
149    
150          my $sql = qq{          my $sql_message = qq{
151                  select                  select
152                          time::date as date,                          time::date as date,
153                          time::time as time,                          time::time as time,
154                          channel,                          channel,
155                            me,
156                          nick,                          nick,
157                          message                          message
158                  from log                  from log
159          };          };
160          $sql .= " where message ilike ? " if ($args->{search});  
161            my $sql_context = qq{
162                    select
163                            id
164                    from log
165            };
166    
167            my $context = $1 if ($args->{search} && $args->{search} =~ s/\s*\+(\d+)\s*/ /);
168    
169            my $sql = $context ? $sql_context : $sql_message;
170    
171            $sql .= " where message ilike ? or nick ilike ? " if ($args->{search});
172            $sql .= " where id in (" . join(",", @{ $tags->{ $args->{tag} } }) . ") " if ($args->{tag} && $tags->{ $args->{tag} });
173            $sql .= " where date(time) = ? " if ($args->{date});
174          $sql .= " order by log.time desc";          $sql .= " order by log.time desc";
175          $sql .= " limit " . $args->{limit};          $sql .= " limit " . $args->{limit} if ($args->{limit});
176    
177          my $sth = $dbh->prepare( $sql );          my $sth = $dbh->prepare( $sql );
178          if ($args->{search}) {          if (my $search = $args->{search}) {
179                  $sth->execute( $args->{search} );                  $search =~ s/^\s+//;
180                    $search =~ s/\s+$//;
181                    $sth->execute( ( '%' . $search . '%' ) x 2 );
182                    warn "search for '$search' returned ", $sth->rows, " results ", $context || '', "\n";
183            } elsif (my $tag = $args->{tag}) {
184                    $sth->execute();
185                    warn "tag '$tag' returned ", $sth->rows, " results ", $context || '', "\n";
186            } elsif (my $date = $args->{date}) {
187                    $sth->execute($date);
188                    warn "found ", $sth->rows, " messages for date $date ", $context || '', "\n";
189          } else {          } else {
190                  $sth->execute();                  $sth->execute();
191          }          }
# Line 139  sub get_from_log { Line 202  sub get_from_log {
202                  unshift @rows, $row;                  unshift @rows, $row;
203          }          }
204    
205          my @msgs;          my @msgs = (
206                    "Showing " . ($#rows + 1) . " messages..."
207            );
208    
209            if ($context) {
210                    my @ids = @rows;
211                    @rows = ();
212    
213                    my $last_to = 0;
214    
215                    my $sth = $dbh->prepare( $sql_message . qq{ where id >= ? and id < ? } );
216                    foreach my $row_id (sort { $a->{id} <=> $b->{id} } @ids) {
217                            my $id = $row_id->{id} || die "can't find id in row";
218            
219                            my ($from, $to) = ($id - $context, $id + $context);
220                            $from = $last_to if ($from < $last_to);
221                            $last_to = $to;
222                            $sth->execute( $from, $to );
223    
224                            #warn "## id: $id from: $from to: $to returned: ", $sth->rows, "\n";
225    
226                            while (my $row = $sth->fetchrow_hashref) {
227                                    push @rows, $row;
228                            }
229    
230                    }
231            }
232    
233            # sprintf which can take coderef as first parametar
234            sub cr_sprintf {
235                    my $fmt = shift || return;
236                    if (ref($fmt) eq 'CODE') {
237                            $fmt->(@_);
238                    } else {
239                            sprintf($fmt, @_);
240                    }
241            }
242    
243          foreach my $row (@rows) {          foreach my $row (@rows) {
244    
245                  $row->{time} =~ s#\.\d+##;                  $row->{time} =~ s#\.\d+##;
246    
                 my $t;  
                 $t = $row->{date} . ' ' if ($last_row->{date} ne $row->{date});  
                 $t .= $row->{time};  
   
247                  my $msg = '';                  my $msg = '';
248    
249                    $msg = cr_sprintf($args->{fmt}->{date}, $row->{date}) . ' ' if ($last_row->{date} ne $row->{date});
250                    my $t = $row->{time};
251    
252                  if ($last_row->{channel} ne $row->{channel}) {                  if ($last_row->{channel} ne $row->{channel}) {
253                          $msg .= sprintf($args->{fmt}->{time_channel}, $t, $row->{channel});                          $msg .= cr_sprintf($args->{fmt}->{time_channel}, $t, $row->{channel});
254                  } else {                  } else {
255                          $msg .= sprintf($args->{fmt}->{time}, $t);                          $msg .= cr_sprintf($args->{fmt}->{time}, $t);
256                  }                  }
257    
258                  my $append = 1;                  my $append = 1;
259    
260                  if ($last_row->{nick} ne $row->{nick}) {                  my $nick = $row->{nick};
261                          $msg .= sprintf($args->{fmt}->{nick}, $row->{nick});                  if ($nick =~ s/^_*(.*?)_*$/$1/) {
262                            $row->{nick} = $nick;
263                    }
264    
265                    if ($last_row->{nick} ne $nick) {
266                            # obfu way to find format for me_nick if needed or fallback to default
267                            my $fmt = $row->{me} ? ( $args->{fmt}->{me_nick} || $args->{fmt}->{nick} ) : $args->{fmt}->{nick};
268                            $fmt ||= '%s';
269    
270                            $nick = $args->{filter}->{nick}->($nick) if (ref($args->{filter}->{nick}) eq 'CODE');
271    
272                            $msg .= cr_sprintf( $fmt, $nick );
273                          $append = 0;                          $append = 0;
274                  }                  }
275    
276                  if (ref($args->{message_filter}) eq 'CODE') {                  $args->{fmt}->{message} ||= '%s';
277                          $msg .= sprintf($args->{fmt}->{message},                  if (ref($args->{filter}->{message}) eq 'CODE') {
278                                  $args->{message_filter}->(                          $msg .= cr_sprintf($args->{fmt}->{message},
279                                    $args->{filter}->{message}->(
280                                          $row->{message}                                          $row->{message}
281                                  )                                  )
282                          );                          );
283                  } else {                  } else {
284                          $msg .= sprintf($args->{fmt}->{message}, $row->{message});                          $msg .= cr_sprintf($args->{fmt}->{message}, $row->{message});
285                  }                  }
286    
287                  if ($append && @msgs) {                  if ($append && @msgs) {
# Line 186  sub get_from_log { Line 296  sub get_from_log {
296          return @msgs;          return @msgs;
297  }  }
298    
299    # tags support
300    
301    my $cloud = HTML::TagCloud->new;
302    
303    =head2 add_tag
304    
305     add_tag( id => 42, message => 'irc message' );
306    
307    =cut
308    
309    sub add_tag {
310            my $arg = {@_};
311    
312            return unless ($arg->{id} && $arg->{message});
313    
314            my $m = $arg->{message};
315            from_to('UTF-8', 'iso-8859-2', $m) if (is_utf8($m));
316    
317            while ($m =~ s#$tag_regex##s) {
318                    my $tag = $1;
319                    next if (! $tag || $tag =~ m/https?:/i);
320                    push @{ $tags->{$tag} }, $arg->{id};
321                    #warn "+tag $tag: $arg->{id}\n";
322                    $cloud->add($tag, "?tag=$tag", scalar @{$tags->{$tag}} + 1);
323            }
324    }
325    
326    =head2 seed_tags
327    
328    Read all tags from database and create in-memory cache for tags
329    
330    =cut
331    
332    sub seed_tags {
333            my $sth = $dbh->prepare(qq{ select id,message from log where message like '%//%' });
334            $sth->execute;
335            while (my $row = $sth->fetchrow_hashref) {
336                    add_tag( %$row );
337            }
338    
339            foreach my $tag (keys %$tags) {
340                    $cloud->add($tag, "?tag=$tag", scalar @{$tags->{$tag}} + 1);
341            }
342    }
343    
344    seed_tags;
345    
346    
347    =head2 save_message
348    
349      save_message(
350            channel => '#foobar',
351            me => 0,
352            nick => 'dpavlin',
353            msg => 'test message',
354            time => '2006-06-25 18:57:18',
355      );
356    
357    C<time> is optional, it will use C<< now() >> if it's not available.
358    
359    C<me> if not specified will be C<0> (not C</me> message)
360    
361    =cut
362    
363    sub save_message {
364            my $a = {@_};
365            $a->{me} ||= 0;
366            $a->{time} ||= strftime($TIMESTAMP,localtime());
367    
368            print
369                    $a->{time}, " ",
370                    $a->{channel}, " ",
371                    $a->{me} ? "***" . $a->{nick} : "<" . $a->{nick} . ">",
372                    " " . $a->{msg} . "\n";
373    
374            from_to($a->{msg}, 'UTF-8', $ENCODING);
375    
376            $sth->execute($a->{channel}, $a->{me}, $a->{nick}, $a->{msg}, $a->{time});
377            add_tag( id => $dbh->last_insert_id(undef,undef,"log",undef),
378                    message => $a->{msg});
379    }
380    
381    if ($import_dircproxy) {
382            open(my $l, $import_dircproxy) || die "can't open $import_dircproxy: $!";
383            warn "importing $import_dircproxy...\n";
384            my $tz_offset = 2 * 60 * 60;    # TZ GMT+2
385            while(<$l>) {
386                    chomp;
387                    if (/^@(\d+)\s(\S+)\s(.+)$/) {
388                            my ($time, $nick, $msg) = ($1,$2,$3);
389    
390                            my $dt = DateTime->from_epoch( epoch => $time + $tz_offset );
391    
392                            my $me = 0;
393                            $me = 1 if ($nick =~ m/^\[\S+]/);
394                            $nick =~ s/^[\[<]([^!]+).*$/$1/;
395    
396                            $msg =~ s/^ACTION\s+// if ($me);
397    
398                            save_message(
399                                    channel => $CHANNEL,
400                                    me => $me,
401                                    nick => $nick,
402                                    msg => $msg,
403                                    time => $dt->ymd . " " . $dt->hms,
404                            ) if ($nick !~ m/^-/);
405    
406                    } else {
407                            warn "can't parse: $_\n";
408                    }
409            }
410            close($l);
411            warn "import over\n";
412            exit;
413    }
414    
415    
416    #
417    # POE handing part
418    #
419    
420  my $SKIPPING = 0;               # if skipping, how many we've done  my $SKIPPING = 0;               # if skipping, how many we've done
421  my $SEND_QUEUE;                 # cache  my $SEND_QUEUE;                 # cache
422    
423  POE::Component::IRC->new($IRC_ALIAS);  POE::Component::IRC->new($IRC_ALIAS);
424    
425  POE::Session->create  POE::Session->create( inline_states =>
   (inline_states =>  
426     {_start => sub {           {_start => sub {      
427                  $_[KERNEL]->post($IRC_ALIAS => register => 'all');                  $_[KERNEL]->post($IRC_ALIAS => register => 'all');
428                  $_[KERNEL]->post($IRC_ALIAS => connect => $CONNECT);                  $_[KERNEL]->post($IRC_ALIAS => connect => $CONNECT);
# Line 211  POE::Session->create Line 440  POE::Session->create
440                  my $channel = $_[ARG1]->[0];                  my $channel = $_[ARG1]->[0];
441                  my $msg = $_[ARG2];                  my $msg = $_[ARG2];
442    
443                  from_to($msg, 'UTF-8', $ENCODING);                  save_message( channel => $channel, me => 0, nick => $nick, msg => $msg);
444        },
445        irc_ctcp_action => sub {
446                    my $kernel = $_[KERNEL];
447                    my $nick = (split /!/, $_[ARG0])[0];
448                    my $channel = $_[ARG1]->[0];
449                    my $msg = $_[ARG2];
450    
451                  print "$channel: <$nick> $msg\n";                  save_message( channel => $channel, me => 1, nick => $nick, msg => $msg);
                 $sth->execute($channel, $nick, $msg);  
452      },      },
453          irc_msg => sub {          irc_msg => sub {
454                  my $kernel = $_[KERNEL];                  my $kernel = $_[KERNEL];
# Line 242  POE::Session->create Line 476  POE::Session->create
476                          my $nr = $1 || 10;                          my $nr = $1 || 10;
477    
478                          my $sth = $dbh->prepare(qq{                          my $sth = $dbh->prepare(qq{
479                                  select nick,count(*) from log group by nick order by count desc limit $nr                                  select
480                                            nick,
481                                            count(*) as count,
482                                            sum(length(message)) as len
483                                    from log
484                                    group by nick
485                                    order by len desc,count desc
486                                    limit $nr
487                          });                          });
488                          $sth->execute();                          $sth->execute();
489                          $res = "Top $nr users: ";                          $res = "Top $nr users: ";
490                          my @users;                          my @users;
491                          while (my $row = $sth->fetchrow_hashref) {                          while (my $row = $sth->fetchrow_hashref) {
492                                  push @users,$row->{nick} . ': ' . $row->{count};                                  push @users,$row->{nick} . ': ' . $row->{count} . '/' . $row->{len} . '=' . sprintf("%.2f", $row->{len}/$row->{count});
493                          }                          }
494                          $res .= join(" | ", @users);                          $res .= join(" | ", @users);
495                  } elsif ($msg =~ m/^last.*?\s*(\d*)/i) {                  } elsif ($msg =~ m/^last.*?\s*(\d*)/i) {
496    
497                          foreach my $res (get_from_log( limit => $1 )) {                          foreach my $res (get_from_log( limit => ($1 || 100) )) {
498                                  print "last: $res\n";                                  print "last: $res\n";
499                                  from_to($res, $ENCODING, 'UTF-8');                                  from_to($res, $ENCODING, 'UTF-8');
500                                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );                                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );
# Line 261  POE::Session->create Line 502  POE::Session->create
502    
503                          $res = '';                          $res = '';
504    
505                  } elsif ($msg =~ m/^(search|grep)\s+(.*)$/i) {                  } elsif ($msg =~ m/^(search|grep)\s+(.*)\s*$/i) {
506    
507                          my $what = $2;                          my $what = $2;
508    
509                          foreach my $res (get_from_log( limit => 20, search => "%${what}%" )) {                          foreach my $res (get_from_log(
510                                            limit => 20,
511                                            search => $what,
512                                    )) {
513                                  print "search [$what]: $res\n";                                  print "search [$what]: $res\n";
514                                  from_to($res, $ENCODING, 'UTF-8');                                  from_to($res, $ENCODING, 'UTF-8');
515                                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );                                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );
# Line 301  POE::Session->create Line 545  POE::Session->create
545  #               warn "## indetify $NICK\n";  #               warn "## indetify $NICK\n";
546  #               $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "IDENTIFY $NICK" );  #               $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "IDENTIFY $NICK" );
547  #       },  #       },
         irc_372 => sub {  
                 print "MOTD: ", $_[ARG1], "\n";  
         },  
         irc_snotice => sub {  
                 print "(server notice): ", $_[ARG0], "\n";  
         },  
     (map  
      {  
        ;"irc_$_" => sub { }}  
      qw(  
                 )),  
 #       join  
 #       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  
548      _child => sub {},      _child => sub {},
549      _default => sub {      _default => sub {
550        printf "%s: session %s caught an unhandled %s event.\n",                  printf "%s #%s %s %s\n",
551          scalar localtime(), $_[SESSION]->ID, $_[ARG0];                          strftime($TIMESTAMP,localtime()), $_[SESSION]->ID, $_[ARG0],
552        print "The $_[ARG0] event was given these parameters: ",                          ref($_[ARG1]) eq "ARRAY"        ?       join(",", map { ref($_) eq "ARRAY" ? join(";", @{$_}) : $_ } @{ $_[ARG1] })     :
553          join(" ", map({"ARRAY" eq ref $_ ? "[@$_]" : "$_"} @{$_[ARG1]})), "\n";                          $_[ARG1]                                        ?       $_[ARG1]                                        :
554                            "";
555        0;                        # false for signals        0;                        # false for signals
556      },      },
557      my_add => sub {      my_add => sub {
# Line 398  my $httpd = POE::Component::Server::HTTP Line 625  my $httpd = POE::Component::Server::HTTP
625          Headers        => { Server => 'irc-logger' },          Headers        => { Server => 'irc-logger' },
626  );  );
627    
628    my %escape = ('<'=>'&lt;', '>'=>'&gt;', '&'=>'&amp;', '"'=>'&quot;');
629    my $escape_re  = join '|' => keys %escape;
630    
631  my $style = <<'_END_OF_STYLE_';  my $style = <<'_END_OF_STYLE_';
632    p { margin: 0; padding: 0.1em; }
633  .time, .channel { color: #808080; font-size: 60%; }  .time, .channel { color: #808080; font-size: 60%; }
634  .nick { color: #0000ff; font-size: 80%; }  .date { float: right; background: #e0e0e0; color: #404040; font-size: 120%; padding: 0.25em; border: 1px dashed #808080; }
635    .nick { color: #000000; font-size: 80%; padding: 2px; font-family: courier, courier new, monospace ; }
636  .message { color: #000000; font-size: 100%; }  .message { color: #000000; font-size: 100%; }
637    .search { float: right; }
638    .col-0 { background: #ffff66 }
639    .col-1 { background: #a0ffff }
640    .col-2 { background: #99ff99 }
641    .col-3 { background: #ff9999 }
642    .col-4 { background: #ff66ff }
643    a:link.tag, a:visited.tag { border: 1px dashed #ccc; backgound: #ccc; text-decoration: none }
644    a:hover.tag { border: 1px solid #eee }
645    hr { border: 1px dashed #ccc; height: 1px; clear: both; }
646  _END_OF_STYLE_  _END_OF_STYLE_
647    
648    my $max_color = 4;
649    
650    my %nick_enumerator;
651    
652  sub root_handler {  sub root_handler {
653          my ($request, $response) = @_;          my ($request, $response) = @_;
654          $response->code(RC_OK);          $response->code(RC_OK);
655          $response->content_type("text/html; charset=$ENCODING");          $response->content_type("text/html; charset=$ENCODING");
656          $response->content(  
657                  qq{<html><head><title>$NICK</title><style type="text/css">$style</style></head><body>} .          my $q;
658                  "irc-logger url: " . $request->uri . '<br/>' .  
659                  join("<br/>",          if ( $request->method eq 'POST' ) {
660                    $q = new CGI::Simple( $request->content );
661            } elsif ( $request->uri =~ /\?(.+)$/ ) {
662                    $q = new CGI::Simple( $1 );
663            } else {
664                    $q = new CGI::Simple;
665            }
666    
667            my $search = $q->param('search') || $q->param('grep') || '';
668    
669            my $html =
670                    qq{<html><head><title>$NICK</title><style type="text/css">$style} .
671                    $cloud->css .
672                    qq{</style></head><body>} .
673                    qq{
674                    <form method="post" class="search" action="/">
675                    <input type="text" name="search" value="$search" size="10">
676                    <input type="submit" value="search">
677                    </form>
678                    } .
679                    $cloud->html(500) .
680                    qq{<p>};
681            if ($request->url =~ m#/history#) {
682                    my $sth = $dbh->prepare(qq{
683                            select date(time) as date,count(*) as nr
684                                    from log
685                                    group by date(time)
686                                    order by date(time) desc
687                    });
688                    $sth->execute();
689                    my ($l_yyyy,$l_mm) = (0,0);
690                    my $cal;
691                    while (my $row = $sth->fetchrow_hashref) {
692                            # this is probably PostgreSQL specific, expects ISO date
693                            my ($yyyy,$mm,$dd) = split(/-/, $row->{date});
694                            if ($yyyy != $l_yyyy || $mm != $l_mm) {
695                                    $html .= $cal->as_HTML() if ($cal);
696                                    $cal = new HTML::CalendarMonthSimple('month'=>$mm,'year'=>$yyyy);
697                                    $cal->border(2);
698                                    ($l_yyyy,$l_mm) = ($yyyy,$mm);
699                            }
700                            $cal->setcontent($dd, qq{
701                                    <a href="/?date=$row->{date}">$row->{nr}</a>
702                            });
703                    }
704                    $html .= $cal->as_HTML() if ($cal);
705    
706            } else {
707                    $html .= join("</p><p>",
708                          get_from_log(                          get_from_log(
709                                  limit => 100,                                  limit => $q->param('last') || $q->param('date') ? undef : 100,
710                                    search => $search || undef,
711                                    tag => $q->param('tag') || undef,
712                                    date => $q->param('date') || undef,
713                                  fmt => {                                  fmt => {
714                                            date => sub {
715                                                    my $date = shift || return;
716                                                    qq{<hr/><div class="date"><a href="/?date=$date">$date</a></div>};
717                                            },
718                                          time => '<span class="time">%s</span> ',                                          time => '<span class="time">%s</span> ',
719                                          time_channel => '<span class="channel">%s %s</span> ',                                          time_channel => '<span class="channel">%s %s</span> ',
720                                          nick => '<span class="nick">%s:</span> ',                                          nick => '%s:&nbsp;',
721                                            me_nick => '***%s&nbsp;',
722                                          message => '<span class="message">%s</span>',                                          message => '<span class="message">%s</span>',
723                                  },                                  },
724                                  message_filter => sub {                                  filter => {
725                                          my $m = shift || return;                                          message => sub {
726                                          $m =~ s#($RE{URI}{HTTP})#<a href="$1">$1</a>#gs;                                                  my $m = shift || return;
727                                          return $m;                                                  $m =~ s/($escape_re)/$escape{$1}/gs;
728                                                    $m =~ s#($RE{URI}{HTTP})#<a href="$1">$1</a>#gs;
729                                                    $m =~ s#$tag_regex#<a href="?tag=$1" class="tag">$1</a>#g;
730                                                    return $m;
731                                            },
732                                            nick => sub {
733                                                    my $n = shift || return;
734                                                    if (! $nick_enumerator{$n})  {
735                                                            my $max = scalar keys %nick_enumerator;
736                                                            $nick_enumerator{$n} = $max + 1;
737                                                    }
738                                                    return '<span class="nick col-' .
739                                                            ( $nick_enumerator{$n} % $max_color ) .
740                                                            '">' . $n . '</span>';
741                                            },
742                                  },                                  },
743                          )                          )
744                  ) .                  );
745                  qq{</body></html>}          }
746          );  
747            $html .= qq{</p>
748            <hr/>
749            <p>See <a href="/history">history</a> of all messages.</p>
750            </body></html>};
751    
752            $response->content( $html );
753          return RC_OK;          return RC_OK;
754  }  }
755    

Legend:
Removed from v.15  
changed lines
  Added in v.40

  ViewVC Help
Powered by ViewVC 1.1.26