/[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 17 by dpavlin, Mon Mar 13 16:50:07 2006 UTC revision 20 by dpavlin, Tue Mar 14 17:17:53 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-dev';  my $NICK = 'irc-logger';
22  my $CONNECT =  my $CONNECT =
23    {Server => 'irc.freenode.net',    {Server => 'irc.freenode.net',
24     Nick => $NICK,     Nick => $NICK,
# 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   );   );
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  =cut
109    
110  sub get_from_log {  sub get_from_log {
# Line 105  sub get_from_log { Line 116  sub get_from_log {
116                  time => '{%s} ',                  time => '{%s} ',
117                  time_channel => '{%s %s} ',                  time_channel => '{%s %s} ',
118                  nick => '%s: ',                  nick => '%s: ',
119                    me_nick => '***%s ',
120                  message => '%s',                  message => '%s',
121          };          };
122    
# Line 113  sub get_from_log { Line 125  sub get_from_log {
125                          time::date as date,                          time::date as date,
126                          time::time as time,                          time::time as time,
127                          channel,                          channel,
128                            me,
129                          nick,                          nick,
130                          message                          message
131                  from log                  from log
# Line 164  sub get_from_log { Line 177  sub get_from_log {
177                  my $append = 1;                  my $append = 1;
178    
179                  if ($last_row->{nick} ne $row->{nick}) {                  if ($last_row->{nick} ne $row->{nick}) {
180                          $msg .= sprintf($args->{fmt}->{nick}, $row->{nick});                          # 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;                          $append = 0;
189                  }                  }
190    
191                  if (ref($args->{message_filter}) eq 'CODE') {                  $args->{fmt}->{message} ||= '%s';
192                    if (ref($args->{filter}->{message}) eq 'CODE') {
193                          $msg .= sprintf($args->{fmt}->{message},                          $msg .= sprintf($args->{fmt}->{message},
194                                  $args->{message_filter}->(                                  $args->{filter}->{message}->(
195                                          $row->{message}                                          $row->{message}
196                                  )                                  )
197                          );                          );
# Line 218  POE::Session->create Line 239  POE::Session->create
239                  from_to($msg, 'UTF-8', $ENCODING);                  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];
# Line 402  my $httpd = POE::Component::Server::HTTP Line 434  my $httpd = POE::Component::Server::HTTP
434          Headers        => { Server => 'irc-logger' },          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_';  my $style = <<'_END_OF_STYLE_';
441  p { margin: 0; padding: 0.1em; }  p { margin: 0; padding: 0.1em; }
442  .time, .channel { color: #808080; font-size: 60%; }  .time, .channel { color: #808080; font-size: 60%; }
443  .nick { color: #0000ff; font-size: 80%; }  .nick { color: #000000; font-size: 80%; padding: 2px; font-family: courier, courier new, monospace ; }
444  .message { color: #000000; font-size: 100%; }  .message { color: #000000; font-size: 100%; }
445  .search { float: right; }  .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_  _END_OF_STYLE_
452    
453    my $max_color = 4;
454    
455    my %nick_enumerator;
456    
457  sub root_handler {  sub root_handler {
458          my ($request, $response) = @_;          my ($request, $response) = @_;
459          $response->code(RC_OK);          $response->code(RC_OK);
# Line 442  sub root_handler { Line 486  sub root_handler {
486                                  fmt => {                                  fmt => {
487                                          time => '<span class="time">%s</span> ',                                          time => '<span class="time">%s</span> ',
488                                          time_channel => '<span class="channel">%s %s</span> ',                                          time_channel => '<span class="channel">%s %s</span> ',
489                                          nick => '<span class="nick">%s:</span> ',                                          nick => '%s:&nbsp;',
490                                            me_nick => '***%s&nbsp;',
491                                          message => '<span class="message">%s</span>',                                          message => '<span class="message">%s</span>',
492                                  },                                  },
493                                  message_filter => sub {                                  filter => {
494                                          my $m = shift || return;                                          message => sub {
495                                          $m =~ s#($RE{URI}{HTTP})#<a href="$1">$1</a>#gs;                                                  my $m = shift || return;
496                                          return $m;                                                  $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                  ) .                  ) .
Legend:
Removed from v.17  
changed lines
  Added in v.20
  ViewVC Help
Powered by ViewVC 1.1.26