/[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 10 by dpavlin, Thu Mar 2 00:19:12 2006 UTC revision 20 by dpavlin, Tue Mar 14 17:17:53 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     );
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 89  POE::Session->create Line 228  POE::Session->create
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];
# Line 96  POE::Session->create Line 236  POE::Session->create
236                  my $channel = $_[ARG1]->[0];                  my $channel = $_[ARG1]->[0];
237                  my $msg = $_[ARG2];                  my $msg = $_[ARG2];
238    
239                  from_to($msg, 'UTF-8', 'ISO-8859-2');                  from_to($msg, 'UTF-8', $ENCODING);
240    
241                  print "$channel: <$nick> $msg\n";                  print "$channel: <$nick> $msg\n";
242                  $sth->execute($channel, $nick, $msg);                  $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', $ENCODING);
251    
252                    print "$channel ***$nick $msg\n";
253                    $sth->execute($channel, 1, $nick, $msg);
254      },      },
255          irc_msg => sub {          irc_msg => sub {
256                  my $kernel = $_[KERNEL];                  my $kernel = $_[KERNEL];
257                  my $nick = (split /!/, $_[ARG0])[0];                  my $nick = (split /!/, $_[ARG0])[0];
258                  my $msg = $_[ARG2];                  my $msg = $_[ARG2];
259                  from_to($msg, 'UTF-8', 'ISO-8859-2');                  from_to($msg, 'UTF-8', $ENCODING);
260    
261                  my $res = "unknown command '$msg', try /msg $NICK help!";                  my $res = "unknown command '$msg', try /msg $NICK help!";
262                    my @out;
263    
264                  print "<< $msg\n";                  print "<< $msg\n";
265    
266                  if ($msg =~ m/^help/i) {                  if ($msg =~ m/^help/i) {
267    
268                          $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";
269    
270                  } elsif ($msg =~ m/^msg\s+(\S+)\s+(.*)$/i) {                  } elsif ($msg =~ m/^msg\s+(\S+)\s+(.*)$/i) {
271    
# Line 137  POE::Session->create Line 289  POE::Session->create
289                          $res .= join(" | ", @users);                          $res .= join(" | ", @users);
290                  } elsif ($msg =~ m/^last.*?\s*(\d*)/i) {                  } elsif ($msg =~ m/^last.*?\s*(\d*)/i) {
291    
292                          my $nr = $1 || 10;                          foreach my $res (get_from_log( limit => $1 )) {
293                                    print "last: $res\n";
294                          my $sth = $dbh->prepare(qq{                                  from_to($res, $ENCODING, 'UTF-8');
295                                  select                                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );
                                         time::date as date,  
                                         time::time as time,  
                                         channel,  
                                         nick,  
                                         message  
                                 from log order by log.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;  
296                          }                          }
297    
298                          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};  
299    
300                                  push @msgs, $msg;                  } elsif ($msg =~ m/^(search|grep)\s+(.*)$/i) {
301    
302                                  $last_row = $row;                          my $what = $2;
                         }  
303    
304                          foreach my $res (@msgs) {                          foreach my $res (get_from_log( limit => 20, search => $what )) {
305                                  print "last: $res\n";                                  print "search [$what]: $res\n";
306                                  from_to($res, 'ISO-8859-2', 'UTF-8');                                  from_to($res, $ENCODING, 'UTF-8');
307                                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );                                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );
308                          }                          }
309    
310                          $res = '';                          $res = '';
311    
312                  }                  }
313    
314                  if ($res) {                  if ($res) {
315                          print ">> [$nick] $res\n";                          print ">> [$nick] $res\n";
316                          from_to($res, 'ISO-8859-2', 'UTF-8');                          from_to($res, $ENCODING, 'UTF-8');
317                          $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );                          $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );
318                  }                  }
319    
# Line 218  POE::Session->create Line 332  POE::Session->create
332                  warn "## indetify $NICK\n";                  warn "## indetify $NICK\n";
333                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "IDENTIFY $NICK" );                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "IDENTIFY $NICK" );
334          },          },
335          irc_433 => sub {  #       irc_433 => sub {
336                  print "# irc_433: ",$_[ARG1], "\n";  #               print "# irc_433: ",$_[ARG1], "\n";
337                  warn "## indetify $NICK\n";  #               warn "## indetify $NICK\n";
338                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "IDENTIFY $NICK" );  #               $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "IDENTIFY $NICK" );
339          },  #       },
340          irc_372 => sub {          irc_372 => sub {
341                  print "MOTD: ", $_[ARG1], "\n";                  print "MOTD: ", $_[ARG1], "\n";
342          },          },
# Line 312  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.10  
changed lines
  Added in v.20

  ViewVC Help
Powered by ViewVC 1.1.26