/[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 8 by dpavlin, Wed Mar 1 22:42:21 2006 UTC revision 23 by dpavlin, Sun Mar 26 01:01:10 2006 UTC
# Line 33  my %FOLLOWS = Line 33  my %FOLLOWS =
33     ERROR => "/var/log/apache/error.log",     ERROR => "/var/log/apache/error.log",
34    );    );
35    
36  my $DSN = 'DBI:Pg:dbname=irc-logger';  my $DSN = 'DBI:Pg:dbname=' . $NICK;
37    
38    my $ENCODING = 'ISO-8859-2';
39    
40  ## END CONFIG  ## END CONFIG
41    
42    
43    
44  use POE qw(Component::IRC Wheel::FollowTail);  use POE qw(Component::IRC Wheel::FollowTail Component::Server::HTTP);
45    use HTTP::Status;
46  use DBI;  use DBI;
47  use Encode qw/from_to/;  use Encode qw/from_to/;
48    use Regexp::Common qw /URI/;
49    use CGI::Simple;
50    
51    
52  my $dbh = DBI->connect($DSN,"","", { RaiseError => 1, AutoCommit => 1 }) || die $DBI::errstr;  my $dbh = DBI->connect($DSN,"","", { RaiseError => 1, AutoCommit => 1 }) || die $DBI::errstr;
53    
54  =for SQL schema  eval {
55            $dbh->do(qq{ select count(*) from log });
56    };
57    
58    if ($@) {
59            warn "creating database table in $DSN\n";
60            $dbh->do(<<'_SQL_SCHEMA_');
61    
 $dbh->do(qq{  
62  create table log (  create table log (
63          id serial,          id serial,
64          time timestamp default now(),          time timestamp default now(),
65          channel text not null,          channel text not null,
66            me boolean default false,
67          nick text not null,          nick text not null,
68          message text not null,          message text not null,
69          primary key(id)          primary key(id)
# Line 62  create index log_time on log(time); Line 73  create index log_time on log(time);
73  create index log_channel on log(channel);  create index log_channel on log(channel);
74  create index log_nick on log(nick);  create index log_nick on log(nick);
75    
76  });  _SQL_SCHEMA_
77    }
 =cut  
78    
79  my $sth = $dbh->prepare(qq{  my $sth = $dbh->prepare(qq{
80  insert into log  insert into log
81          (channel, nick, message)          (channel, me, nick, message)
82  values (?,?,?)  values (?,?,?,?)
83  });  });
84    
85    =head2 get_from_log
86    
87     my @messages = get_from_log(
88            limit => 42,
89            search => '%what to stuff in ilike%',
90            fmt => {
91                    time => '{%s} ',
92                    time_channel => '{%s %s} ',
93                    nick => '%s: ',
94                    me_nick => '***%s ',
95                    message => '%s',
96            },
97            filter => {
98                    message => sub {
99                            # modify message content
100                            return shift;
101                    }
102            },
103            context => 5,
104     );
105    
106    Order is important. Fields are first passed through C<filter> (if available) and
107    then throgh C<< sprintf($fmt->{message}, $message >> if available.
108    
109    C<context> defines number of messages around each search hit for display.
110    
111    =cut
112    
113    sub get_from_log {
114            my $args = {@_};
115    
116            $args->{limit} ||= 10;
117    
118            $args->{fmt} ||= {
119                    time => '{%s} ',
120                    time_channel => '{%s %s} ',
121                    nick => '%s: ',
122                    me_nick => '***%s ',
123                    message => '%s',
124            };
125    
126            my $sql_message = qq{
127                    select
128                            time::date as date,
129                            time::time as time,
130                            channel,
131                            me,
132                            nick,
133                            message
134                    from log
135            };
136    
137            my $sql_context = qq{
138                    select
139                            id
140                    from log
141            };
142    
143            my $context = $1 if ($args->{search} && $args->{search} =~ s/\s*\+(\d+)\s*/ /);
144    
145            my $sql = $context ? $sql_context : $sql_message;
146    
147            $sql .= " where message ilike ? " if ($args->{search});
148            $sql .= " order by log.time desc";
149            $sql .= " limit " . $args->{limit};
150    
151            my $sth = $dbh->prepare( $sql );
152            if (my $search = $args->{search}) {
153                    $search =~ s/^\s+//;
154                    $search =~ s/\s+$//;
155                    $sth->execute( '%' . $search . '%' );
156                    warn "search for '$search' returned ", $sth->rows, " results ", $context || '', "\n";
157            } else {
158                    $sth->execute();
159            }
160            my $last_row = {
161                    date => '',
162                    time => '',
163                    channel => '',
164                    nick => '',
165            };
166    
167            my @rows;
168    
169            while (my $row = $sth->fetchrow_hashref) {
170                    unshift @rows, $row;
171            }
172    
173            my @msgs = (
174                    "Showing " . ($#rows + 1) . " messages..."
175            );
176    
177            if ($context) {
178                    my @ids = @rows;
179                    @rows = ();
180    
181                    my $last_to = 0;
182    
183                    my $sth = $dbh->prepare( $sql_message . qq{ where id >= ? and id < ? } );
184                    foreach my $row_id (sort { $a->{id} <=> $b->{id} } @ids) {
185                            my $id = $row_id->{id} || die "can't find id in row";
186            
187                            my ($from, $to) = ($id - $context, $id + $context);
188                            $from = $last_to if ($from < $last_to);
189                            $last_to = $to;
190                            $sth->execute( $from, $to );
191    
192                            #warn "## id: $id from: $from to: $to returned: ", $sth->rows, "\n";
193    
194                            while (my $row = $sth->fetchrow_hashref) {
195                                    push @rows, $row;
196                            }
197    
198                    }
199            }
200    
201            foreach my $row (@rows) {
202    
203                    $row->{time} =~ s#\.\d+##;
204    
205                    my $t;
206                    $t = $row->{date} . ' ' if ($last_row->{date} ne $row->{date});
207                    $t .= $row->{time};
208    
209                    my $msg = '';
210    
211                    if ($last_row->{channel} ne $row->{channel}) {
212                            $msg .= sprintf($args->{fmt}->{time_channel}, $t, $row->{channel});
213                    } else {
214                            $msg .= sprintf($args->{fmt}->{time}, $t);
215                    }
216    
217                    my $append = 1;
218    
219                    my $nick = $row->{nick};
220                    $nick =~ s/^_*(.*?)_*$/$1/;
221            
222                    if ($last_row->{nick} ne $nick) {
223                            # obfu way to find format for me_nick if needed or fallback to default
224                            my $fmt = $row->{me} ? ( $args->{fmt}->{me_nick} || $args->{fmt}->{nick} ) : $args->{fmt}->{nick};
225                            $fmt ||= '%s';
226    
227                            $nick = $args->{filter}->{nick}->($nick) if (ref($args->{filter}->{nick}) eq 'CODE');
228    
229                            $msg .= sprintf( $fmt, $nick );
230                            $append = 0;
231                    }
232    
233                    $args->{fmt}->{message} ||= '%s';
234                    if (ref($args->{filter}->{message}) eq 'CODE') {
235                            $msg .= sprintf($args->{fmt}->{message},
236                                    $args->{filter}->{message}->(
237                                            $row->{message}
238                                    )
239                            );
240                    } else {
241                            $msg .= sprintf($args->{fmt}->{message}, $row->{message});
242                    }
243    
244                    if ($append && @msgs) {
245                            $msgs[$#msgs] .= " " . $msg;
246                    } else {
247                            push @msgs, $msg;
248                    }
249    
250                    $last_row = $row;
251            }
252    
253            return @msgs;
254    }
255    
256    
257  my $SKIPPING = 0;               # if skipping, how many we've done  my $SKIPPING = 0;               # if skipping, how many we've done
258  my $SEND_QUEUE;                 # cache  my $SEND_QUEUE;                 # cache
# Line 84  POE::Session->create Line 265  POE::Session->create
265                  $_[KERNEL]->post($IRC_ALIAS => register => 'all');                  $_[KERNEL]->post($IRC_ALIAS => register => 'all');
266                  $_[KERNEL]->post($IRC_ALIAS => connect => $CONNECT);                  $_[KERNEL]->post($IRC_ALIAS => connect => $CONNECT);
267      },      },
268      irc_255 => sub {            # server is done blabbing      irc_255 => sub {    # server is done blabbing
269                  $_[KERNEL]->post($IRC_ALIAS => join => $CHANNEL);                  $_[KERNEL]->post($IRC_ALIAS => join => $CHANNEL);
270                  $_[KERNEL]->post($IRC_ALIAS => join => '#logger');                  $_[KERNEL]->post($IRC_ALIAS => join => '#logger');
271                  $_[KERNEL]->yield("heartbeat"); # start heartbeat                  $_[KERNEL]->yield("heartbeat"); # start heartbeat
272  #               $_[KERNEL]->yield("my_add", $_) for keys %FOLLOWS;  #               $_[KERNEL]->yield("my_add", $_) for keys %FOLLOWS;
273                    $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "IDENTIFY $NICK" );
274      },      },
275      irc_public => sub {      irc_public => sub {
276                  my $kernel = $_[KERNEL];                  my $kernel = $_[KERNEL];
# Line 96  POE::Session->create Line 278  POE::Session->create
278                  my $channel = $_[ARG1]->[0];                  my $channel = $_[ARG1]->[0];
279                  my $msg = $_[ARG2];                  my $msg = $_[ARG2];
280    
281                  from_to($msg, 'UTF-8', 'ISO-8859-2');                  from_to($msg, 'UTF-8', $ENCODING);
282    
283                  print "$channel: <$nick> $msg\n";                  print "$channel: <$nick> $msg\n";
284                  $sth->execute($channel, $nick, $msg);                  $sth->execute($channel, 0, $nick, $msg);
285        },
286        irc_ctcp_action => sub {
287                    my $kernel = $_[KERNEL];
288                    my $nick = (split /!/, $_[ARG0])[0];
289                    my $channel = $_[ARG1]->[0];
290                    my $msg = $_[ARG2];
291    
292                    from_to($msg, 'UTF-8', $ENCODING);
293    
294                    print "$channel ***$nick $msg\n";
295                    $sth->execute($channel, 1, $nick, $msg);
296      },      },
297          irc_msg => sub {          irc_msg => sub {
298                  my $kernel = $_[KERNEL];                  my $kernel = $_[KERNEL];
299                  my $nick = (split /!/, $_[ARG0])[0];                  my $nick = (split /!/, $_[ARG0])[0];
300                  my $msg = $_[ARG2];                  my $msg = $_[ARG2];
301                  from_to($msg, 'UTF-8', 'ISO-8859-2');                  from_to($msg, 'UTF-8', $ENCODING);
302    
303                  my $res = "unknown command '$msg', try /msg $NICK help!";                  my $res = "unknown command '$msg', try /msg $NICK help!";
304                    my @out;
305    
306                  print "<< $msg\n";                  print "<< $msg\n";
307    
308                  if ($msg =~ m/^help/i) {                  if ($msg =~ m/^help/i) {
309    
310                          $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";
311    
312                    } elsif ($msg =~ m/^msg\s+(\S+)\s+(.*)$/i) {
313    
314                            print ">> /msg $1 $2\n";
315                            $_[KERNEL]->post( $IRC_ALIAS => privmsg => $1, $2 );
316                            $res = '';
317    
318                  } elsif ($msg =~ m/^stat.*?\s*(\d*)/i) {                  } elsif ($msg =~ m/^stat.*?\s*(\d*)/i) {
319    
# Line 131  POE::Session->create Line 331  POE::Session->create
331                          $res .= join(" | ", @users);                          $res .= join(" | ", @users);
332                  } elsif ($msg =~ m/^last.*?\s*(\d*)/i) {                  } elsif ($msg =~ m/^last.*?\s*(\d*)/i) {
333    
334                          my $nr = $1 || 10;                          foreach my $res (get_from_log( limit => $1 )) {
335                                    print "last: $res\n";
336                          my $sth = $dbh->prepare(qq{                                  from_to($res, $ENCODING, 'UTF-8');
337                                  select                                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );
                                         time::date as date,  
                                         time::time as time,  
                                         channel,  
                                         nick,  
                                         message  
                                 from log order by 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;  
338                          }                          }
339    
340                          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};  
341    
342                                  push @msgs, $msg;                  } elsif ($msg =~ m/^(search|grep)\s+(.*)\s*$/i) {
343    
344                                  $last_row = $row;                          my $what = $2;
                         }  
345    
346                          foreach my $res (@msgs) {                          foreach my $res (get_from_log(
347                                  print "last: $res\n";                                          limit => 20,
348                                  from_to($res, 'ISO-8859-2', 'UTF-8');                                          search => $what,
349                                    )) {
350                                    print "search [$what]: $res\n";
351                                    from_to($res, $ENCODING, 'UTF-8');
352                                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );                                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );
353                          }                          }
354    
355                          $res = '';                          $res = '';
356    
357                  }                  }
358    
359                  if ($res) {                  if ($res) {
360                          print ">> [$nick] $res\n";                          print ">> [$nick] $res\n";
361                          from_to($res, 'ISO-8859-2', 'UTF-8');                          from_to($res, $ENCODING, 'UTF-8');
362                          $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );                          $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );
363                  }                  }
364    
365          },          },
366            irc_477 => sub {
367                    print "# irc_477: ",$_[ARG1], "\n";
368                    $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "register $NICK" );
369            },
370          irc_505 => sub {          irc_505 => sub {
371          print "# irc_505: ",$_[ARG1], "\n";                  print "# irc_505: ",$_[ARG1], "\n";
372                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "register $NICK" );                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "register $NICK" );
373                  warn "## register $NICK\n";  #               $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "set hide email on" );
374    #               $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "set email dpavlin\@rot13.org" );
375          },          },
376          irc_registered => sub {          irc_registered => sub {
                 $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "IDENTIFY $NICK" );  
377                  warn "## indetify $NICK\n";                  warn "## indetify $NICK\n";
378                    $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "IDENTIFY $NICK" );
379            },
380    #       irc_433 => sub {
381    #               print "# irc_433: ",$_[ARG1], "\n";
382    #               warn "## indetify $NICK\n";
383    #               $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "IDENTIFY $NICK" );
384    #       },
385            irc_372 => sub {
386                    print "MOTD: ", $_[ARG1], "\n";
387            },
388            irc_snotice => sub {
389                    print "(server notice): ", $_[ARG0], "\n";
390          },          },
391      (map      (map
392       {       {
393         ;"irc_$_" => sub { }}         ;"irc_$_" => sub { }}
394       qw(join       qw(
         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  
395                  )),                  )),
396    #       join
397    #       ctcp_version
398    #       connected snotice ctcp_action ping notice mode part quit
399    #       001 002 003 004 005
400    #       250 251 252 253 254 265 266
401    #       332 333 353 366 372 375 376
402    #       477
403      _child => sub {},      _child => sub {},
404      _default => sub {      _default => sub {
405        printf "%s: session %s caught an unhandled %s event.\n",        printf "%s: session %s caught an unhandled %s event.\n",
# Line 289  POE::Session->create Line 471  POE::Session->create
471     },     },
472    );    );
473    
474    # http server
475    
476    my $httpd = POE::Component::Server::HTTP->new(
477            Port => $NICK =~ m/-dev/ ? 8001 : 8000,
478            ContentHandler => { '/' => \&root_handler },
479            Headers        => { Server => 'irc-logger' },
480    );
481    
482    my %escape = ('<'=>'&lt;', '>'=>'&gt;', '&'=>'&amp;', '"'=>'&quot;');
483    my $escape_re  = join '|' => keys %escape;
484    
485    my $style = <<'_END_OF_STYLE_';
486    p { margin: 0; padding: 0.1em; }
487    .time, .channel { color: #808080; font-size: 60%; }
488    .nick { color: #000000; font-size: 80%; padding: 2px; font-family: courier, courier new, monospace ; }
489    .message { color: #000000; font-size: 100%; }
490    .search { float: right; }
491    .col-0 { background: #ffff66 }
492    .col-1 { background: #a0ffff }
493    .col-2 { background: #99ff99 }
494    .col-3 { background: #ff9999 }
495    .col-4 { background: #ff66ff }
496    _END_OF_STYLE_
497    
498    my $max_color = 4;
499    
500    my %nick_enumerator;
501    
502    sub root_handler {
503            my ($request, $response) = @_;
504            $response->code(RC_OK);
505            $response->content_type("text/html; charset=$ENCODING");
506    
507            my $q;
508    
509            if ( $request->method eq 'POST' ) {
510                    $q = new CGI::Simple( $request->content );
511            } elsif ( $request->uri =~ /\?(.+)$/ ) {
512                    $q = new CGI::Simple( $1 );
513            } else {
514                    $q = new CGI::Simple;
515            }
516    
517            my $search = $q->param('search') || $q->param('grep') || '';
518    
519            $response->content(
520                    qq{<html><head><title>$NICK</title><style type="text/css">$style</style></head><body>
521                    <form method="post" class="search">
522                    <input type="text" name="search" value="$search" size="10">
523                    <input type="submit" value="search">
524                    </form>
525                    <p>
526                    } .
527                    join("</p><p>",
528                            get_from_log(
529                                    limit => $q->param('last') || 100,
530                                    search => $q->param('search') || $q->param('grep') || undef,
531                                    fmt => {
532                                            time => '<span class="time">%s</span> ',
533                                            time_channel => '<span class="channel">%s %s</span> ',
534                                            nick => '%s:&nbsp;',
535                                            me_nick => '***%s&nbsp;',
536                                            message => '<span class="message">%s</span>',
537                                    },
538                                    filter => {
539                                            message => sub {
540                                                    my $m = shift || return;
541                                                    $m =~ s/($escape_re)/$escape{$1}/gs;
542                                                    $m =~ s#($RE{URI}{HTTP})#<a href="$1">$1</a>#gs;
543                                                    return $m;
544                                            },
545                                            nick => sub {
546                                                    my $n = shift || return;
547                                                    if (! $nick_enumerator{$n})  {
548                                                            my $max = scalar keys %nick_enumerator;
549                                                            $nick_enumerator{$n} = $max + 1;
550                                                    }
551                                                    return '<span class="nick col-' .
552                                                            ( $nick_enumerator{$n} % $max_color ) .
553                                                            '">' . $n . '</span>';
554                                            },
555                                    },
556                            )
557                    ) .
558                    qq{</p></body></html>}
559            );
560            return RC_OK;
561    }
562    
563  POE::Kernel->run;  POE::Kernel->run;

Legend:
Removed from v.8  
changed lines
  Added in v.23

  ViewVC Help
Powered by ViewVC 1.1.26