/[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 6 by dpavlin, Mon Feb 27 12:41:10 2006 UTC revision 21 by dpavlin, Sat Mar 18 16:02:32 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';  my $NICK = 'irc-logger-dev';
22  my $CONNECT =  my $CONNECT =
23    {Server => 'irc.freenode.net',    {Server => 'irc.freenode.net',
24     Nick => $NICK,     Nick => $NICK,
25     Ircname => 'logger: ask dpavlin@rot13.org'     Ircname => "try /msg $NICK help",
26    };    };
27  my $CHANNEL = '#razmjenavjestina';  my $CHANNEL = '#razmjenavjestina';
28  my $IRC_ALIAS = "log";  my $IRC_ALIAS = "log";
# 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                    if ($last_row->{nick} ne $row->{nick}) {
220                            # obfu way to find format for me_nick if needed or fallback to default
221                            my $fmt = $row->{me} ? ( $args->{fmt}->{me_nick} || $args->{fmt}->{nick} ) : $args->{fmt}->{nick};
222                            $fmt ||= '%s';
223    
224                            my $nick = $row->{nick};
225                            $nick = $args->{filter}->{nick}->($nick) if (ref($args->{filter}->{nick}) eq 'CODE');
226    
227                            $msg .= sprintf( $fmt, $nick );
228                            $append = 0;
229                    }
230    
231                    $args->{fmt}->{message} ||= '%s';
232                    if (ref($args->{filter}->{message}) eq 'CODE') {
233                            $msg .= sprintf($args->{fmt}->{message},
234                                    $args->{filter}->{message}->(
235                                            $row->{message}
236                                    )
237                            );
238                    } else {
239                            $msg .= sprintf($args->{fmt}->{message}, $row->{message});
240                    }
241    
242                    if ($append && @msgs) {
243                            $msgs[$#msgs] .= " " . $msg;
244                    } else {
245                            push @msgs, $msg;
246                    }
247    
248                    $last_row = $row;
249            }
250    
251            return @msgs;
252    }
253    
254    
255  my $SKIPPING = 0;               # if skipping, how many we've done  my $SKIPPING = 0;               # if skipping, how many we've done
256  my $SEND_QUEUE;                 # cache  my $SEND_QUEUE;                 # cache
# Line 81  POE::Component::IRC->new($IRC_ALIAS); Line 260  POE::Component::IRC->new($IRC_ALIAS);
260  POE::Session->create  POE::Session->create
261    (inline_states =>    (inline_states =>
262     {_start => sub {           {_start => sub {      
263        $_[KERNEL]->post($IRC_ALIAS => register => 'all');                  $_[KERNEL]->post($IRC_ALIAS => register => 'all');
264        $_[KERNEL]->post($IRC_ALIAS => connect => $CONNECT);                  $_[KERNEL]->post($IRC_ALIAS => connect => $CONNECT);
265      },      },
266      irc_255 => sub {            # server is done blabbing      irc_255 => sub {    # server is done blabbing
267        $_[KERNEL]->post($IRC_ALIAS => join => $CHANNEL);                  $_[KERNEL]->post($IRC_ALIAS => join => $CHANNEL);
268        $_[KERNEL]->post($IRC_ALIAS => join => '#logger');                  $_[KERNEL]->post($IRC_ALIAS => join => '#logger');
269        $_[KERNEL]->yield("heartbeat"); # start heartbeat                  $_[KERNEL]->yield("heartbeat"); # start heartbeat
270  #      $_[KERNEL]->yield("my_add", $_) for keys %FOLLOWS;  #               $_[KERNEL]->yield("my_add", $_) for keys %FOLLOWS;
271                    $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "IDENTIFY $NICK" );
272      },      },
273      irc_public => sub {      irc_public => sub {
274            my $kernel = $_[KERNEL];                  my $kernel = $_[KERNEL];
275            my $nick = (split /!/, $_[ARG0])[0];                  my $nick = (split /!/, $_[ARG0])[0];
276            my $channel = $_[ARG1]->[0];                  my $channel = $_[ARG1]->[0];
277            my $msg = $_[ARG2];                  my $msg = $_[ARG2];
278    
279                    from_to($msg, 'UTF-8', $ENCODING);
280    
281                    print "$channel: <$nick> $msg\n";
282                    $sth->execute($channel, 0, $nick, $msg);
283        },
284        irc_ctcp_action => sub {
285                    my $kernel = $_[KERNEL];
286                    my $nick = (split /!/, $_[ARG0])[0];
287                    my $channel = $_[ARG1]->[0];
288                    my $msg = $_[ARG2];
289    
290            from_to($msg, 'UTF-8', 'ISO-8859-2');                  from_to($msg, 'UTF-8', $ENCODING);
291    
292            print "$channel: <$nick> $msg\n";                  print "$channel ***$nick $msg\n";
293            $sth->execute($channel, $nick, $msg);                  $sth->execute($channel, 1, $nick, $msg);
294      },      },
295            irc_msg => sub {
296                    my $kernel = $_[KERNEL];
297                    my $nick = (split /!/, $_[ARG0])[0];
298                    my $msg = $_[ARG2];
299                    from_to($msg, 'UTF-8', $ENCODING);
300    
301                    my $res = "unknown command '$msg', try /msg $NICK help!";
302                    my @out;
303    
304                    print "<< $msg\n";
305    
306                    if ($msg =~ m/^help/i) {
307    
308                            $res = "usage: /msg $NICK comand | commands: stat - user/message stat | last - show backtrace | grep foobar - find foobar";
309    
310                    } elsif ($msg =~ m/^msg\s+(\S+)\s+(.*)$/i) {
311    
312                            print ">> /msg $1 $2\n";
313                            $_[KERNEL]->post( $IRC_ALIAS => privmsg => $1, $2 );
314                            $res = '';
315    
316                    } elsif ($msg =~ m/^stat.*?\s*(\d*)/i) {
317    
318                            my $nr = $1 || 10;
319    
320                            my $sth = $dbh->prepare(qq{
321                                    select nick,count(*) from log group by nick order by count desc limit $nr
322                            });
323                            $sth->execute();
324                            $res = "Top $nr users: ";
325                            my @users;
326                            while (my $row = $sth->fetchrow_hashref) {
327                                    push @users,$row->{nick} . ': ' . $row->{count};
328                            }
329                            $res .= join(" | ", @users);
330                    } elsif ($msg =~ m/^last.*?\s*(\d*)/i) {
331    
332                            foreach my $res (get_from_log( limit => $1 )) {
333                                    print "last: $res\n";
334                                    from_to($res, $ENCODING, 'UTF-8');
335                                    $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );
336                            }
337    
338                            $res = '';
339    
340                    } elsif ($msg =~ m/^(search|grep)\s+(.*)\s*$/i) {
341    
342                            my $what = $2;
343    
344                            foreach my $res (get_from_log(
345                                            limit => 20,
346                                            search => $what,
347                                    )) {
348                                    print "search [$what]: $res\n";
349                                    from_to($res, $ENCODING, 'UTF-8');
350                                    $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );
351                            }
352    
353                            $res = '';
354    
355                    }
356    
357                    if ($res) {
358                            print ">> [$nick] $res\n";
359                            from_to($res, $ENCODING, 'UTF-8');
360                            $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );
361                    }
362    
363            },
364            irc_477 => sub {
365                    print "# irc_477: ",$_[ARG1], "\n";
366                    $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "register $NICK" );
367            },
368            irc_505 => sub {
369                    print "# irc_505: ",$_[ARG1], "\n";
370                    $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "register $NICK" );
371    #               $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "set hide email on" );
372    #               $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "set email dpavlin\@rot13.org" );
373            },
374            irc_registered => sub {
375                    warn "## indetify $NICK\n";
376                    $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "IDENTIFY $NICK" );
377            },
378    #       irc_433 => sub {
379    #               print "# irc_433: ",$_[ARG1], "\n";
380    #               warn "## indetify $NICK\n";
381    #               $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "IDENTIFY $NICK" );
382    #       },
383            irc_372 => sub {
384                    print "MOTD: ", $_[ARG1], "\n";
385            },
386            irc_snotice => sub {
387                    print "(server notice): ", $_[ARG0], "\n";
388            },
389      (map      (map
390       {       {
391         ;"irc_$_" => sub { }}         ;"irc_$_" => sub { }}
392       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  
393                  )),                  )),
394    #       join
395    #       ctcp_version
396    #       connected snotice ctcp_action ping notice mode part quit
397    #       001 002 003 004 005
398    #       250 251 252 253 254 265 266
399    #       332 333 353 366 372 375 376
400    #       477
401      _child => sub {},      _child => sub {},
402      _default => sub {      _default => sub {
403        printf "%s: session %s caught an unhandled %s event.\n",        printf "%s: session %s caught an unhandled %s event.\n",
# Line 183  POE::Session->create Line 469  POE::Session->create
469     },     },
470    );    );
471    
472    # http server
473    
474    my $httpd = POE::Component::Server::HTTP->new(
475            Port => $NICK =~ m/-dev/ ? 8001 : 8000,
476            ContentHandler => { '/' => \&root_handler },
477            Headers        => { Server => 'irc-logger' },
478    );
479    
480    my %escape = ('<'=>'&lt;', '>'=>'&gt;', '&'=>'&amp;', '"'=>'&quot;');
481    my $escape_re  = join '|' => keys %escape;
482    
483    my $style = <<'_END_OF_STYLE_';
484    p { margin: 0; padding: 0.1em; }
485    .time, .channel { color: #808080; font-size: 60%; }
486    .nick { color: #000000; font-size: 80%; padding: 2px; font-family: courier, courier new, monospace ; }
487    .message { color: #000000; font-size: 100%; }
488    .search { float: right; }
489    .col-0 { background: #ffff66 }
490    .col-1 { background: #a0ffff }
491    .col-2 { background: #99ff99 }
492    .col-3 { background: #ff9999 }
493    .col-4 { background: #ff66ff }
494    _END_OF_STYLE_
495    
496    my $max_color = 4;
497    
498    my %nick_enumerator;
499    
500    sub root_handler {
501            my ($request, $response) = @_;
502            $response->code(RC_OK);
503            $response->content_type("text/html; charset=$ENCODING");
504    
505            my $q;
506    
507            if ( $request->method eq 'POST' ) {
508                    $q = new CGI::Simple( $request->content );
509            } elsif ( $request->uri =~ /\?(.+)$/ ) {
510                    $q = new CGI::Simple( $1 );
511            } else {
512                    $q = new CGI::Simple;
513            }
514    
515            my $search = $q->param('search') || $q->param('grep') || '';
516    
517            $response->content(
518                    qq{<html><head><title>$NICK</title><style type="text/css">$style</style></head><body>
519                    <form method="post" class="search">
520                    <input type="text" name="search" value="$search" size="10">
521                    <input type="submit" value="search">
522                    </form>
523                    <p>
524                    } .
525                    join("</p><p>",
526                            get_from_log(
527                                    limit => $q->param('limit') || 100,
528                                    search => $q->param('search') || $q->param('grep') || undef,
529                                    fmt => {
530                                            time => '<span class="time">%s</span> ',
531                                            time_channel => '<span class="channel">%s %s</span> ',
532                                            nick => '%s:&nbsp;',
533                                            me_nick => '***%s&nbsp;',
534                                            message => '<span class="message">%s</span>',
535                                    },
536                                    filter => {
537                                            message => sub {
538                                                    my $m = shift || return;
539                                                    $m =~ s/($escape_re)/$escape{$1}/gs;
540                                                    $m =~ s#($RE{URI}{HTTP})#<a href="$1">$1</a>#gs;
541                                                    return $m;
542                                            },
543                                            nick => sub {
544                                                    my $n = shift || return;
545                                                    if (! $nick_enumerator{$n})  {
546                                                            my $max = scalar keys %nick_enumerator;
547                                                            $nick_enumerator{$n} = $max + 1;
548                                                    }
549                                                    return '<span class="nick col-' .
550                                                            ( $nick_enumerator{$n} % $max_color ) .
551                                                            '">' . $n . '</span>';
552                                            },
553                                    },
554                            )
555                    ) .
556                    qq{</p></body></html>}
557            );
558            return RC_OK;
559    }
560    
561  POE::Kernel->run;  POE::Kernel->run;

Legend:
Removed from v.6  
changed lines
  Added in v.21

  ViewVC Help
Powered by ViewVC 1.1.26