/[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 16 by dpavlin, Mon Mar 13 16:43:18 2006 UTC revision 21 by dpavlin, Sat Mar 18 16:02:32 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';  my $ENCODING = 'ISO-8859-2';
39    
# Line 51  use CGI::Simple; Line 51  use CGI::Simple;
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 67  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  =head2 get_from_log
# Line 86  values (?,?,?) Line 91  values (?,?,?)
91                  time => '{%s} ',                  time => '{%s} ',
92                  time_channel => '{%s %s} ',                  time_channel => '{%s %s} ',
93                  nick => '%s: ',                  nick => '%s: ',
94                    me_nick => '***%s ',
95                  message => '%s',                  message => '%s',
96          },          },
97          message_filter => sub {          filter => {
98                  # modify message content                  message => sub {
99                  return shift;                          # 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  =cut
112    
113  sub get_from_log {  sub get_from_log {
# Line 105  sub get_from_log { Line 119  sub get_from_log {
119                  time => '{%s} ',                  time => '{%s} ',
120                  time_channel => '{%s %s} ',                  time_channel => '{%s %s} ',
121                  nick => '%s: ',                  nick => '%s: ',
122                    me_nick => '***%s ',
123                  message => '%s',                  message => '%s',
124          };          };
125    
126          my $sql = qq{          my $sql_message = qq{
127                  select                  select
128                          time::date as date,                          time::date as date,
129                          time::time as time,                          time::time as time,
130                          channel,                          channel,
131                            me,
132                          nick,                          nick,
133                          message                          message
134                  from log                  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});          $sql .= " where message ilike ? " if ($args->{search});
148          $sql .= " order by log.time desc";          $sql .= " order by log.time desc";
149          $sql .= " limit " . $args->{limit};          $sql .= " limit " . $args->{limit};
150    
151          my $sth = $dbh->prepare( $sql );          my $sth = $dbh->prepare( $sql );
152          if ($args->{search}) {          if (my $search = $args->{search}) {
153                  warn "search for '$args->{search}' returned ", $sth->rows, " results\n";                  $search =~ s/^\s+//;
154                  $sth->execute( '%' . $args->{search} . '%' );                  $search =~ s/\s+$//;
155                    $sth->execute( '%' . $search . '%' );
156                    warn "search for '$search' returned ", $sth->rows, " results ", $context || '', "\n";
157          } else {          } else {
158                  $sth->execute();                  $sth->execute();
159          }          }
# Line 145  sub get_from_log { Line 174  sub get_from_log {
174                  "Showing " . ($#rows + 1) . " messages..."                  "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) {          foreach my $row (@rows) {
202    
203                  $row->{time} =~ s#\.\d+##;                  $row->{time} =~ s#\.\d+##;
# Line 164  sub get_from_log { Line 217  sub get_from_log {
217                  my $append = 1;                  my $append = 1;
218    
219                  if ($last_row->{nick} ne $row->{nick}) {                  if ($last_row->{nick} ne $row->{nick}) {
220                          $msg .= sprintf($args->{fmt}->{nick}, $row->{nick});                          # 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;                          $append = 0;
229                  }                  }
230    
231                  if (ref($args->{message_filter}) eq 'CODE') {                  $args->{fmt}->{message} ||= '%s';
232                    if (ref($args->{filter}->{message}) eq 'CODE') {
233                          $msg .= sprintf($args->{fmt}->{message},                          $msg .= sprintf($args->{fmt}->{message},
234                                  $args->{message_filter}->(                                  $args->{filter}->{message}->(
235                                          $row->{message}                                          $row->{message}
236                                  )                                  )
237                          );                          );
# Line 218  POE::Session->create Line 279  POE::Session->create
279                  from_to($msg, 'UTF-8', $ENCODING);                  from_to($msg, 'UTF-8', $ENCODING);
280    
281                  print "$channel: <$nick> $msg\n";                  print "$channel: <$nick> $msg\n";
282                  $sth->execute($channel, $nick, $msg);                  $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', $ENCODING);
291    
292                    print "$channel ***$nick $msg\n";
293                    $sth->execute($channel, 1, $nick, $msg);
294      },      },
295          irc_msg => sub {          irc_msg => sub {
296                  my $kernel = $_[KERNEL];                  my $kernel = $_[KERNEL];
# Line 265  POE::Session->create Line 337  POE::Session->create
337    
338                          $res = '';                          $res = '';
339    
340                  } elsif ($msg =~ m/^(search|grep)\s+(.*)$/i) {                  } elsif ($msg =~ m/^(search|grep)\s+(.*)\s*$/i) {
341    
342                          my $what = $2;                          my $what = $2;
343    
344                          foreach my $res (get_from_log( limit => 20, search => $what )) {                          foreach my $res (get_from_log(
345                                            limit => 20,
346                                            search => $what,
347                                    )) {
348                                  print "search [$what]: $res\n";                                  print "search [$what]: $res\n";
349                                  from_to($res, $ENCODING, 'UTF-8');                                  from_to($res, $ENCODING, 'UTF-8');
350                                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );                                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );
# Line 402  my $httpd = POE::Component::Server::HTTP Line 477  my $httpd = POE::Component::Server::HTTP
477          Headers        => { Server => 'irc-logger' },          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_';  my $style = <<'_END_OF_STYLE_';
484  p { margin: 0; padding: 0.1em; }  p { margin: 0; padding: 0.1em; }
485  .time, .channel { color: #808080; font-size: 60%; }  .time, .channel { color: #808080; font-size: 60%; }
486  .nick { color: #0000ff; font-size: 80%; }  .nick { color: #000000; font-size: 80%; padding: 2px; font-family: courier, courier new, monospace ; }
487  .message { color: #000000; font-size: 100%; }  .message { color: #000000; font-size: 100%; }
488  .search { float: right; }  .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_  _END_OF_STYLE_
495    
496    my $max_color = 4;
497    
498    my %nick_enumerator;
499    
500  sub root_handler {  sub root_handler {
501          my ($request, $response) = @_;          my ($request, $response) = @_;
502          $response->code(RC_OK);          $response->code(RC_OK);
# Line 442  sub root_handler { Line 529  sub root_handler {
529                                  fmt => {                                  fmt => {
530                                          time => '<span class="time">%s</span> ',                                          time => '<span class="time">%s</span> ',
531                                          time_channel => '<span class="channel">%s %s</span> ',                                          time_channel => '<span class="channel">%s %s</span> ',
532                                          nick => '<span class="nick">%s:</span> ',                                          nick => '%s:&nbsp;',
533                                            me_nick => '***%s&nbsp;',
534                                          message => '<span class="message">%s</span>',                                          message => '<span class="message">%s</span>',
535                                  },                                  },
536                                  message_filter => sub {                                  filter => {
537                                          my $m = shift || return;                                          message => sub {
538                                          $m =~ s#($RE{URI}{HTTP})#<a href="$1">$1</a>#gs;                                                  my $m = shift || return;
539                                          return $m;                                                  $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                  ) .                  ) .

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

  ViewVC Help
Powered by ViewVC 1.1.26