/[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 5 by dpavlin, Mon Feb 27 12:10:07 2006 UTC revision 19 by dpavlin, Mon Mar 13 21:02:16 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/;
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 61  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                    message => '%s',
95            },
96            message_filter => sub {
97                    # modify message content
98                    return shift;
99            }
100     );
101    
102    =cut
103    
104    sub get_from_log {
105            my $args = {@_};
106    
107            $args->{limit} ||= 10;
108    
109            $args->{fmt} ||= {
110                    time => '{%s} ',
111                    time_channel => '{%s %s} ',
112                    nick => '%s: ',
113                    message => '%s',
114            };
115    
116            my $sql = qq{
117                    select
118                            time::date as date,
119                            time::time as time,
120                            channel,
121                            nick,
122                            message
123                    from log
124            };
125            $sql .= " where message ilike ? " if ($args->{search});
126            $sql .= " order by log.time desc";
127            $sql .= " limit " . $args->{limit};
128    
129            my $sth = $dbh->prepare( $sql );
130            if ($args->{search}) {
131                    $sth->execute( '%' . $args->{search} . '%' );
132                    warn "search for '$args->{search}' returned ", $sth->rows, " results\n";
133            } else {
134                    $sth->execute();
135            }
136            my $last_row = {
137                    date => '',
138                    time => '',
139                    channel => '',
140                    nick => '',
141            };
142    
143            my @rows;
144    
145            while (my $row = $sth->fetchrow_hashref) {
146                    unshift @rows, $row;
147            }
148    
149            my @msgs = (
150                    "Showing " . ($#rows + 1) . " messages..."
151            );
152    
153            foreach my $row (@rows) {
154    
155                    $row->{time} =~ s#\.\d+##;
156    
157                    my $t;
158                    $t = $row->{date} . ' ' if ($last_row->{date} ne $row->{date});
159                    $t .= $row->{time};
160    
161                    my $msg = '';
162    
163                    if ($last_row->{channel} ne $row->{channel}) {
164                            $msg .= sprintf($args->{fmt}->{time_channel}, $t, $row->{channel});
165                    } else {
166                            $msg .= sprintf($args->{fmt}->{time}, $t);
167                    }
168    
169                    my $append = 1;
170    
171                    if ($last_row->{nick} ne $row->{nick}) {
172                            $msg .= sprintf($args->{fmt}->{nick}, $row->{nick});
173                            $append = 0;
174                    }
175    
176                    if (ref($args->{message_filter}) eq 'CODE') {
177                            $msg .= sprintf($args->{fmt}->{message},
178                                    $args->{message_filter}->(
179                                            $row->{message}
180                                    )
181                            );
182                    } else {
183                            $msg .= sprintf($args->{fmt}->{message}, $row->{message});
184                    }
185    
186                    if ($append && @msgs) {
187                            $msgs[$#msgs] .= " " . $msg;
188                    } else {
189                            push @msgs, $msg;
190                    }
191    
192                    $last_row = $row;
193            }
194    
195            return @msgs;
196    }
197    
198    
199  my $SKIPPING = 0;               # if skipping, how many we've done  my $SKIPPING = 0;               # if skipping, how many we've done
200  my $SEND_QUEUE;                 # cache  my $SEND_QUEUE;                 # cache
# Line 80  POE::Component::IRC->new($IRC_ALIAS); Line 204  POE::Component::IRC->new($IRC_ALIAS);
204  POE::Session->create  POE::Session->create
205    (inline_states =>    (inline_states =>
206     {_start => sub {           {_start => sub {      
207        $_[KERNEL]->post($IRC_ALIAS => register => 'all');                  $_[KERNEL]->post($IRC_ALIAS => register => 'all');
208        $_[KERNEL]->post($IRC_ALIAS => connect => $CONNECT);                  $_[KERNEL]->post($IRC_ALIAS => connect => $CONNECT);
209      },      },
210      irc_255 => sub {            # server is done blabbing      irc_255 => sub {    # server is done blabbing
211        $_[KERNEL]->post($IRC_ALIAS => join => $CHANNEL);                  $_[KERNEL]->post($IRC_ALIAS => join => $CHANNEL);
212        $_[KERNEL]->post($IRC_ALIAS => join => '#logger');                  $_[KERNEL]->post($IRC_ALIAS => join => '#logger');
213        $_[KERNEL]->yield("heartbeat"); # start heartbeat                  $_[KERNEL]->yield("heartbeat"); # start heartbeat
214  #      $_[KERNEL]->yield("my_add", $_) for keys %FOLLOWS;  #               $_[KERNEL]->yield("my_add", $_) for keys %FOLLOWS;
215                    $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "IDENTIFY $NICK" );
216      },      },
217      irc_public => sub {      irc_public => sub {
218            my $kernel = $_[KERNEL];                  my $kernel = $_[KERNEL];
219            my $nick = (split /!/, $_[ARG0])[0];                  my $nick = (split /!/, $_[ARG0])[0];
220            my $channel = $_[ARG1]->[0];                  my $channel = $_[ARG1]->[0];
221            my $msg = $_[ARG2];                  my $msg = $_[ARG2];
222    
223                    from_to($msg, 'UTF-8', $ENCODING);
224    
225                    print "$channel: <$nick> $msg\n";
226                    $sth->execute($channel, 0, $nick, $msg);
227        },
228        irc_ctcp_action => sub {
229                    my $kernel = $_[KERNEL];
230                    my $nick = (split /!/, $_[ARG0])[0];
231                    my $channel = $_[ARG1]->[0];
232                    my $msg = $_[ARG2];
233    
234                    from_to($msg, 'UTF-8', $ENCODING);
235    
236            print "$channel: <$nick> $msg\n";                  print "$channel ***$nick $msg\n";
237            $sth->execute($channel, $nick, $msg);                  $sth->execute($channel, 1, $nick, $msg);
238      },      },
239            irc_msg => sub {
240                    my $kernel = $_[KERNEL];
241                    my $nick = (split /!/, $_[ARG0])[0];
242                    my $msg = $_[ARG2];
243                    from_to($msg, 'UTF-8', $ENCODING);
244    
245                    my $res = "unknown command '$msg', try /msg $NICK help!";
246                    my @out;
247    
248                    print "<< $msg\n";
249    
250                    if ($msg =~ m/^help/i) {
251    
252                            $res = "usage: /msg $NICK comand | commands: stat - user/message stat | last - show backtrace | grep foobar - find foobar";
253    
254                    } elsif ($msg =~ m/^msg\s+(\S+)\s+(.*)$/i) {
255    
256                            print ">> /msg $1 $2\n";
257                            $_[KERNEL]->post( $IRC_ALIAS => privmsg => $1, $2 );
258                            $res = '';
259    
260                    } elsif ($msg =~ m/^stat.*?\s*(\d*)/i) {
261    
262                            my $nr = $1 || 10;
263    
264                            my $sth = $dbh->prepare(qq{
265                                    select nick,count(*) from log group by nick order by count desc limit $nr
266                            });
267                            $sth->execute();
268                            $res = "Top $nr users: ";
269                            my @users;
270                            while (my $row = $sth->fetchrow_hashref) {
271                                    push @users,$row->{nick} . ': ' . $row->{count};
272                            }
273                            $res .= join(" | ", @users);
274                    } elsif ($msg =~ m/^last.*?\s*(\d*)/i) {
275    
276                            foreach my $res (get_from_log( limit => $1 )) {
277                                    print "last: $res\n";
278                                    from_to($res, $ENCODING, 'UTF-8');
279                                    $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );
280                            }
281    
282                            $res = '';
283    
284                    } elsif ($msg =~ m/^(search|grep)\s+(.*)$/i) {
285    
286                            my $what = $2;
287    
288                            foreach my $res (get_from_log( limit => 20, search => $what )) {
289                                    print "search [$what]: $res\n";
290                                    from_to($res, $ENCODING, 'UTF-8');
291                                    $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );
292                            }
293    
294                            $res = '';
295    
296                    }
297    
298                    if ($res) {
299                            print ">> [$nick] $res\n";
300                            from_to($res, $ENCODING, 'UTF-8');
301                            $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );
302                    }
303    
304            },
305            irc_477 => sub {
306                    print "# irc_477: ",$_[ARG1], "\n";
307                    $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "register $NICK" );
308            },
309            irc_505 => sub {
310                    print "# irc_505: ",$_[ARG1], "\n";
311                    $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "register $NICK" );
312    #               $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "set hide email on" );
313    #               $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "set email dpavlin\@rot13.org" );
314            },
315            irc_registered => sub {
316                    warn "## indetify $NICK\n";
317                    $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "IDENTIFY $NICK" );
318            },
319    #       irc_433 => sub {
320    #               print "# irc_433: ",$_[ARG1], "\n";
321    #               warn "## indetify $NICK\n";
322    #               $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "IDENTIFY $NICK" );
323    #       },
324            irc_372 => sub {
325                    print "MOTD: ", $_[ARG1], "\n";
326            },
327            irc_snotice => sub {
328                    print "(server notice): ", $_[ARG0], "\n";
329            },
330      (map      (map
331       {       {
332         ;"irc_$_" => sub { }}         ;"irc_$_" => sub { }}
333       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  
334                  )),                  )),
335    #       join
336    #       ctcp_version
337    #       connected snotice ctcp_action ping notice mode part quit
338    #       001 002 003 004 005
339    #       250 251 252 253 254 265 266
340    #       332 333 353 366 372 375 376
341    #       477
342      _child => sub {},      _child => sub {},
343      _default => sub {      _default => sub {
344        printf "%s: session %s caught an unhandled %s event.\n",        printf "%s: session %s caught an unhandled %s event.\n",
# Line 180  POE::Session->create Line 410  POE::Session->create
410     },     },
411    );    );
412    
413    # http server
414    
415    my $httpd = POE::Component::Server::HTTP->new(
416            Port => $NICK =~ m/-dev/ ? 8001 : 8000,
417            ContentHandler => { '/' => \&root_handler },
418            Headers        => { Server => 'irc-logger' },
419    );
420    
421    my %escape = ('<'=>'&lt;', '>'=>'&gt;', '&'=>'&amp;', '"'=>'&quot;');
422    my $escape_re  = join '|' => keys %escape;
423    
424    my $style = <<'_END_OF_STYLE_';
425    p { margin: 0; padding: 0.1em; }
426    .time, .channel { color: #808080; font-size: 60%; }
427    .nick { color: #0000ff; font-size: 80%; }
428    .message { color: #000000; font-size: 100%; }
429    .search { float: right; }
430    _END_OF_STYLE_
431    
432    sub root_handler {
433            my ($request, $response) = @_;
434            $response->code(RC_OK);
435            $response->content_type("text/html; charset=$ENCODING");
436    
437            my $q;
438    
439            if ( $request->method eq 'POST' ) {
440                    $q = new CGI::Simple( $request->content );
441            } elsif ( $request->uri =~ /\?(.+)$/ ) {
442                    $q = new CGI::Simple( $1 );
443            } else {
444                    $q = new CGI::Simple;
445            }
446    
447            my $search = $q->param('search') || $q->param('grep') || '';
448    
449            $response->content(
450                    qq{<html><head><title>$NICK</title><style type="text/css">$style</style></head><body>
451                    <form method="post" class="search">
452                    <input type="text" name="search" value="$search" size="10">
453                    <input type="submit" value="search">
454                    </form>
455                    <p>
456                    } .
457                    join("</p><p>",
458                            get_from_log(
459                                    limit => $q->param('limit') || 100,
460                                    search => $q->param('search') || $q->param('grep') || undef,
461                                    fmt => {
462                                            time => '<span class="time">%s</span> ',
463                                            time_channel => '<span class="channel">%s %s</span> ',
464                                            nick => '<span class="nick">%s:</span> ',
465                                            message => '<span class="message">%s</span>',
466                                    },
467                                    message_filter => sub {
468                                            my $m = shift || return;
469                                            $m =~ s/($escape_re)/$escape{$1}/gs;
470                                            $m =~ s#($RE{URI}{HTTP})#<a href="$1">$1</a>#gs;
471                                            return $m;
472                                    },
473                            )
474                    ) .
475                    qq{</p></body></html>}
476            );
477            return RC_OK;
478    }
479    
480  POE::Kernel->run;  POE::Kernel->run;
Legend:
Removed from v.5  
changed lines
  Added in v.19
  ViewVC Help
Powered by ViewVC 1.1.26