/[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 20 by dpavlin, Tue Mar 14 17:17:53 2006 UTC
# Line 22  my $NICK = 'irc-logger'; Line 22  my $NICK = 'irc-logger';
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     );
104    
105    Order is important. Fields are first passed through C<filter> (if available) and
106    then throgh C<< sprintf($fmt->{message}, $message >> if available.
107    
108    =cut
109    
110    sub get_from_log {
111            my $args = {@_};
112    
113            $args->{limit} ||= 10;
114    
115            $args->{fmt} ||= {
116                    time => '{%s} ',
117                    time_channel => '{%s %s} ',
118                    nick => '%s: ',
119                    me_nick => '***%s ',
120                    message => '%s',
121            };
122    
123            my $sql = qq{
124                    select
125                            time::date as date,
126                            time::time as time,
127                            channel,
128                            me,
129                            nick,
130                            message
131                    from log
132            };
133            $sql .= " where message ilike ? " if ($args->{search});
134            $sql .= " order by log.time desc";
135            $sql .= " limit " . $args->{limit};
136    
137            my $sth = $dbh->prepare( $sql );
138            if ($args->{search}) {
139                    $sth->execute( '%' . $args->{search} . '%' );
140                    warn "search for '$args->{search}' returned ", $sth->rows, " results\n";
141            } else {
142                    $sth->execute();
143            }
144            my $last_row = {
145                    date => '',
146                    time => '',
147                    channel => '',
148                    nick => '',
149            };
150    
151            my @rows;
152    
153            while (my $row = $sth->fetchrow_hashref) {
154                    unshift @rows, $row;
155            }
156    
157            my @msgs = (
158                    "Showing " . ($#rows + 1) . " messages..."
159            );
160    
161            foreach my $row (@rows) {
162    
163                    $row->{time} =~ s#\.\d+##;
164    
165                    my $t;
166                    $t = $row->{date} . ' ' if ($last_row->{date} ne $row->{date});
167                    $t .= $row->{time};
168    
169                    my $msg = '';
170    
171                    if ($last_row->{channel} ne $row->{channel}) {
172                            $msg .= sprintf($args->{fmt}->{time_channel}, $t, $row->{channel});
173                    } else {
174                            $msg .= sprintf($args->{fmt}->{time}, $t);
175                    }
176    
177                    my $append = 1;
178    
179                    if ($last_row->{nick} ne $row->{nick}) {
180                            # obfu way to find format for me_nick if needed or fallback to default
181                            my $fmt = $row->{me} ? ( $args->{fmt}->{me_nick} || $args->{fmt}->{nick} ) : $args->{fmt}->{nick};
182                            $fmt ||= '%s';
183    
184                            my $nick = $row->{nick};
185                            $nick = $args->{filter}->{nick}->($nick) if (ref($args->{filter}->{nick}) eq 'CODE');
186    
187                            $msg .= sprintf( $fmt, $nick );
188                            $append = 0;
189                    }
190    
191                    $args->{fmt}->{message} ||= '%s';
192                    if (ref($args->{filter}->{message}) eq 'CODE') {
193                            $msg .= sprintf($args->{fmt}->{message},
194                                    $args->{filter}->{message}->(
195                                            $row->{message}
196                                    )
197                            );
198                    } else {
199                            $msg .= sprintf($args->{fmt}->{message}, $row->{message});
200                    }
201    
202                    if ($append && @msgs) {
203                            $msgs[$#msgs] .= " " . $msg;
204                    } else {
205                            push @msgs, $msg;
206                    }
207    
208                    $last_row = $row;
209            }
210    
211            return @msgs;
212    }
213    
214    
215  my $SKIPPING = 0;               # if skipping, how many we've done  my $SKIPPING = 0;               # if skipping, how many we've done
216  my $SEND_QUEUE;                 # cache  my $SEND_QUEUE;                 # cache
# Line 81  POE::Component::IRC->new($IRC_ALIAS); Line 220  POE::Component::IRC->new($IRC_ALIAS);
220  POE::Session->create  POE::Session->create
221    (inline_states =>    (inline_states =>
222     {_start => sub {           {_start => sub {      
223        $_[KERNEL]->post($IRC_ALIAS => register => 'all');                  $_[KERNEL]->post($IRC_ALIAS => register => 'all');
224        $_[KERNEL]->post($IRC_ALIAS => connect => $CONNECT);                  $_[KERNEL]->post($IRC_ALIAS => connect => $CONNECT);
225      },      },
226      irc_255 => sub {            # server is done blabbing      irc_255 => sub {    # server is done blabbing
227        $_[KERNEL]->post($IRC_ALIAS => join => $CHANNEL);                  $_[KERNEL]->post($IRC_ALIAS => join => $CHANNEL);
228        $_[KERNEL]->post($IRC_ALIAS => join => '#logger');                  $_[KERNEL]->post($IRC_ALIAS => join => '#logger');
229        $_[KERNEL]->yield("heartbeat"); # start heartbeat                  $_[KERNEL]->yield("heartbeat"); # start heartbeat
230  #      $_[KERNEL]->yield("my_add", $_) for keys %FOLLOWS;  #               $_[KERNEL]->yield("my_add", $_) for keys %FOLLOWS;
231                    $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "IDENTIFY $NICK" );
232      },      },
233      irc_public => sub {      irc_public => sub {
234            my $kernel = $_[KERNEL];                  my $kernel = $_[KERNEL];
235            my $nick = (split /!/, $_[ARG0])[0];                  my $nick = (split /!/, $_[ARG0])[0];
236            my $channel = $_[ARG1]->[0];                  my $channel = $_[ARG1]->[0];
237            my $msg = $_[ARG2];                  my $msg = $_[ARG2];
238    
239                    from_to($msg, 'UTF-8', $ENCODING);
240    
241                    print "$channel: <$nick> $msg\n";
242                    $sth->execute($channel, 0, $nick, $msg);
243        },
244        irc_ctcp_action => sub {
245                    my $kernel = $_[KERNEL];
246                    my $nick = (split /!/, $_[ARG0])[0];
247                    my $channel = $_[ARG1]->[0];
248                    my $msg = $_[ARG2];
249    
250            from_to($msg, 'UTF-8', 'ISO-8859-2');                  from_to($msg, 'UTF-8', $ENCODING);
251    
252            print "$channel: <$nick> $msg\n";                  print "$channel ***$nick $msg\n";
253            $sth->execute($channel, $nick, $msg);                  $sth->execute($channel, 1, $nick, $msg);
254      },      },
255            irc_msg => sub {
256                    my $kernel = $_[KERNEL];
257                    my $nick = (split /!/, $_[ARG0])[0];
258                    my $msg = $_[ARG2];
259                    from_to($msg, 'UTF-8', $ENCODING);
260    
261                    my $res = "unknown command '$msg', try /msg $NICK help!";
262                    my @out;
263    
264                    print "<< $msg\n";
265    
266                    if ($msg =~ m/^help/i) {
267    
268                            $res = "usage: /msg $NICK comand | commands: stat - user/message stat | last - show backtrace | grep foobar - find foobar";
269    
270                    } elsif ($msg =~ m/^msg\s+(\S+)\s+(.*)$/i) {
271    
272                            print ">> /msg $1 $2\n";
273                            $_[KERNEL]->post( $IRC_ALIAS => privmsg => $1, $2 );
274                            $res = '';
275    
276                    } elsif ($msg =~ m/^stat.*?\s*(\d*)/i) {
277    
278                            my $nr = $1 || 10;
279    
280                            my $sth = $dbh->prepare(qq{
281                                    select nick,count(*) from log group by nick order by count desc limit $nr
282                            });
283                            $sth->execute();
284                            $res = "Top $nr users: ";
285                            my @users;
286                            while (my $row = $sth->fetchrow_hashref) {
287                                    push @users,$row->{nick} . ': ' . $row->{count};
288                            }
289                            $res .= join(" | ", @users);
290                    } elsif ($msg =~ m/^last.*?\s*(\d*)/i) {
291    
292                            foreach my $res (get_from_log( limit => $1 )) {
293                                    print "last: $res\n";
294                                    from_to($res, $ENCODING, 'UTF-8');
295                                    $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );
296                            }
297    
298                            $res = '';
299    
300                    } elsif ($msg =~ m/^(search|grep)\s+(.*)$/i) {
301    
302                            my $what = $2;
303    
304                            foreach my $res (get_from_log( limit => 20, search => $what )) {
305                                    print "search [$what]: $res\n";
306                                    from_to($res, $ENCODING, 'UTF-8');
307                                    $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );
308                            }
309    
310                            $res = '';
311    
312                    }
313    
314                    if ($res) {
315                            print ">> [$nick] $res\n";
316                            from_to($res, $ENCODING, 'UTF-8');
317                            $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );
318                    }
319    
320            },
321            irc_477 => sub {
322                    print "# irc_477: ",$_[ARG1], "\n";
323                    $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "register $NICK" );
324            },
325            irc_505 => sub {
326                    print "# irc_505: ",$_[ARG1], "\n";
327                    $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "register $NICK" );
328    #               $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "set hide email on" );
329    #               $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "set email dpavlin\@rot13.org" );
330            },
331            irc_registered => sub {
332                    warn "## indetify $NICK\n";
333                    $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "IDENTIFY $NICK" );
334            },
335    #       irc_433 => sub {
336    #               print "# irc_433: ",$_[ARG1], "\n";
337    #               warn "## indetify $NICK\n";
338    #               $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "IDENTIFY $NICK" );
339    #       },
340            irc_372 => sub {
341                    print "MOTD: ", $_[ARG1], "\n";
342            },
343            irc_snotice => sub {
344                    print "(server notice): ", $_[ARG0], "\n";
345            },
346      (map      (map
347       {       {
348         ;"irc_$_" => sub { }}         ;"irc_$_" => sub { }}
349       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  
350                  )),                  )),
351    #       join
352    #       ctcp_version
353    #       connected snotice ctcp_action ping notice mode part quit
354    #       001 002 003 004 005
355    #       250 251 252 253 254 265 266
356    #       332 333 353 366 372 375 376
357    #       477
358      _child => sub {},      _child => sub {},
359      _default => sub {      _default => sub {
360        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 426  POE::Session->create
426     },     },
427    );    );
428    
429    # http server
430    
431    my $httpd = POE::Component::Server::HTTP->new(
432            Port => $NICK =~ m/-dev/ ? 8001 : 8000,
433            ContentHandler => { '/' => \&root_handler },
434            Headers        => { Server => 'irc-logger' },
435    );
436    
437    my %escape = ('<'=>'&lt;', '>'=>'&gt;', '&'=>'&amp;', '"'=>'&quot;');
438    my $escape_re  = join '|' => keys %escape;
439    
440    my $style = <<'_END_OF_STYLE_';
441    p { margin: 0; padding: 0.1em; }
442    .time, .channel { color: #808080; font-size: 60%; }
443    .nick { color: #000000; font-size: 80%; padding: 2px; font-family: courier, courier new, monospace ; }
444    .message { color: #000000; font-size: 100%; }
445    .search { float: right; }
446    .col-0 { background: #ffff66 }
447    .col-1 { background: #a0ffff }
448    .col-2 { background: #99ff99 }
449    .col-3 { background: #ff9999 }
450    .col-4 { background: #ff66ff }
451    _END_OF_STYLE_
452    
453    my $max_color = 4;
454    
455    my %nick_enumerator;
456    
457    sub root_handler {
458            my ($request, $response) = @_;
459            $response->code(RC_OK);
460            $response->content_type("text/html; charset=$ENCODING");
461    
462            my $q;
463    
464            if ( $request->method eq 'POST' ) {
465                    $q = new CGI::Simple( $request->content );
466            } elsif ( $request->uri =~ /\?(.+)$/ ) {
467                    $q = new CGI::Simple( $1 );
468            } else {
469                    $q = new CGI::Simple;
470            }
471    
472            my $search = $q->param('search') || $q->param('grep') || '';
473    
474            $response->content(
475                    qq{<html><head><title>$NICK</title><style type="text/css">$style</style></head><body>
476                    <form method="post" class="search">
477                    <input type="text" name="search" value="$search" size="10">
478                    <input type="submit" value="search">
479                    </form>
480                    <p>
481                    } .
482                    join("</p><p>",
483                            get_from_log(
484                                    limit => $q->param('limit') || 100,
485                                    search => $q->param('search') || $q->param('grep') || undef,
486                                    fmt => {
487                                            time => '<span class="time">%s</span> ',
488                                            time_channel => '<span class="channel">%s %s</span> ',
489                                            nick => '%s:&nbsp;',
490                                            me_nick => '***%s&nbsp;',
491                                            message => '<span class="message">%s</span>',
492                                    },
493                                    filter => {
494                                            message => sub {
495                                                    my $m = shift || return;
496                                                    $m =~ s/($escape_re)/$escape{$1}/gs;
497                                                    $m =~ s#($RE{URI}{HTTP})#<a href="$1">$1</a>#gs;
498                                                    return $m;
499                                            },
500                                            nick => sub {
501                                                    my $n = shift || return;
502                                                    if (! $nick_enumerator{$n})  {
503                                                            my $max = scalar keys %nick_enumerator;
504                                                            $nick_enumerator{$n} = $max + 1;
505                                                    }
506                                                    return '<span class="nick col-' .
507                                                            ( $nick_enumerator{$n} % $max_color ) .
508                                                            '">' . $n . '</span>';
509                                            },
510                                    },
511                            )
512                    ) .
513                    qq{</p></body></html>}
514            );
515            return RC_OK;
516    }
517    
518  POE::Kernel->run;  POE::Kernel->run;

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

  ViewVC Help
Powered by ViewVC 1.1.26