/[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 50 by dpavlin, Sun Mar 18 15:37:05 2007 UTC revision 141 by dpavlin, Fri Feb 6 14:12:00 2009 UTC
# Line 2  Line 2 
2  use strict;  use strict;
3  $|++;  $|++;
4    
5    use POE qw(Component::IRC Component::Server::HTTP Component::Client::HTTP);
6    use HTTP::Status;
7    use DBI;
8    use Regexp::Common qw /URI/;
9    use CGI::Simple;
10    use POSIX qw/strftime/;
11    use HTML::CalendarMonthSimple;
12    use Getopt::Long;
13    use DateTime;
14    use URI::Escape;
15    use Data::Dump qw/dump/;
16    use DateTime::Format::ISO8601;
17    use Carp qw/confess/;
18    use XML::Feed;
19    use DateTime::Format::Flexible;
20    use Encode;
21    
22  =head1 NAME  =head1 NAME
23    
24  irc-logger.pl  irc-logger.pl
# Line 20  Import log from C<dircproxy> to C<irc-lo Line 37  Import log from C<dircproxy> to C<irc-lo
37    
38  =item --log=irc-logger.log  =item --log=irc-logger.log
39    
 Name of log file  
   
40  =back  =back
41    
42  =head1 DESCRIPTION  =head1 DESCRIPTION
# Line 32  log all conversation on irc channel Line 47  log all conversation on irc channel
47    
48  ## CONFIG  ## CONFIG
49    
50  my $HOSTNAME = `hostname`;  my $debug = 0;
51    
52    my $irc_config = {
53            nick => 'irc-logger',
54            server => 'irc.freenode.net',
55            port => 6667,
56            ircname => 'Anna the bot: try /msg irc-logger help',
57    };
58    
59    my $HOSTNAME = `hostname -f`;
60    chomp($HOSTNAME);
61    
62    
 my $NICK = 'irc-logger';  
 $NICK .= '-dev' if ($HOSTNAME =~ m/llin/);  
 my $CONNECT =  
   {Server => 'irc.freenode.net',  
    Nick => $NICK,  
    Ircname => "try /msg $NICK help",  
   };  
63  my $CHANNEL = '#razmjenavjestina';  my $CHANNEL = '#razmjenavjestina';
 $CHANNEL = '#irc-logger' if ($HOSTNAME =~ m/llin/);  
 my $IRC_ALIAS = "log";  
64    
65  my %FOLLOWS =  if ( $HOSTNAME =~ m/llin/ ) {
66    (          $irc_config->{nick} = 'irc-logger-llin';
67     ACCESS => "/var/log/apache/access.log",  #       $irc_config = {
68     ERROR => "/var/log/apache/error.log",  #               nick => 'irc-logger-llin',
69    );  #               server => 'localhost',
70    #               port => 6668,
71    #       };
72            $CHANNEL = '#irc-logger';
73    } elsif ( $HOSTNAME =~ m/lugarin/ ) {
74            $irc_config->{server} = 'irc.carnet.hr';
75            $CHANNEL = '#riss';
76    }
77    
78    my @channels = ( $CHANNEL );
79    
80    warn "## config = ", dump( $irc_config ) if $debug;
81    
82    my $NICK = $irc_config->{nick} or die "no nick?";
83    
84  my $DSN = 'DBI:Pg:dbname=' . $NICK;  my $DSN = 'DBI:Pg:dbname=' . $NICK;
85    
 my $ENCODING = 'ISO-8859-2';  
86  my $TIMESTAMP = '%Y-%m-%d %H:%M:%S';  my $TIMESTAMP = '%Y-%m-%d %H:%M:%S';
87    
88  my $sleep_on_error = 5;  my $sleep_on_error = 5;
89    
90  ## END CONFIG  # number of last tags to keep in circular buffer
91    my $last_x_tags = 50;
92    
93    # don't pull rss feeds more often than this
94    my $rss_min_delay = 60;
95    
96    my $http_port = $NICK =~ m/-dev/ ? 8001 : 8000;
97    
98  use POE qw(Component::IRC Wheel::FollowTail Component::Server::HTTP);  my $url = "http://$HOSTNAME:$http_port";
99  use HTTP::Status;  
100  use DBI;  ## END CONFIG
101  use Encode qw/from_to is_utf8/;  
102  use Regexp::Common qw /URI/;  my $use_twitter = 1;
103  use CGI::Simple;  eval { require Net::Twitter; };
104  use HTML::TagCloud;  $use_twitter = 0 if ($@);
 use POSIX qw/strftime/;  
 use HTML::CalendarMonthSimple;  
 use Getopt::Long;  
 use DateTime;  
 use Data::Dump qw/dump/;  
105    
106  my $import_dircproxy;  my $import_dircproxy;
107  my $log_path;  my $log_path;
108  GetOptions(  GetOptions(
109          'import-dircproxy:s' => \$import_dircproxy,          'import-dircproxy:s' => \$import_dircproxy,
110          'log:s' => \$log_path,          'log:s' => \$log_path,
111            'debug!' => \$debug,
112  );  );
113    
114  open(STDOUT, '>', $log_path) || warn "can't redirect log to $log_path: $!";  #$SIG{__DIE__} = sub {
115    #       confess "fatal error";
116    #};
117    
118  sub _log {  sub _log {
119          print strftime($TIMESTAMP,localtime()), ' ', join(" ",@_), $/;          print strftime($TIMESTAMP,localtime()) . ' ' . join(" ",map { ref($_) ? dump( $_ ) : $_ } @_) . $/;
120  }  }
121    
122    open(STDOUT, '>', $log_path) && warn "log to $log_path: $!\n";
123    
124    
125    # HTML formatters
126    
127    my %escape = ('<'=>'&lt;', '>'=>'&gt;', '&'=>'&amp;', '"'=>'&quot;');
128    my $escape_re  = join '|' => keys %escape;
129    
130    my $tag_regex = '\b([\w\-_]+)//';
131    
132    my %nick_enumerator;
133    my $max_color = 0;
134    
135    my $filter = {
136            message => sub {
137                    my $m = shift || return;
138    
139                    # protect HTML from wiki modifications
140                    sub e {
141                            my $t = shift;
142                            eval { $t = 'uri_unescape{' . uri_escape($t, '^a-zA-Z0-9') . '}'; };
143                            return $t;
144                    }
145    
146                    $m =~ s/($escape_re)/$escape{$1}/gs;
147                    $m =~ s#($RE{URI}{HTTP})#e(qq{<a href="$1">$1</a>})#egs;
148                    $m =~ s#\/(\w+)\/#<i>$1</i>#gs;
149                    $m =~ s#$tag_regex#e(qq{<a href="$url?tag=$1" class="tag">$1</a>})#egs;
150                    $m =~ s#\*(\w+)\*#<b>$1</b>#gs;
151                    $m =~ s#_(\w+)_#<u>$1</u>#gs;
152    
153                    $m =~ s#uri_unescape{([^}]+)}#uri_unescape($1)#egs;
154                    return $m;
155            },
156            nick => sub {
157                    my $n = shift || return;
158                    if (! $nick_enumerator{$n})  {
159                            my $max = scalar keys %nick_enumerator;
160                            $nick_enumerator{$n} = $max + 1;
161                    }
162                    return '<span class="nick col-' .
163                            ( $nick_enumerator{$n} % $max_color ) .
164                            '">' . $n . '</span>';
165            },
166    };
167    
168    # POE IRC
169    my $poe_irc = POE::Component::IRC->spawn( %$irc_config ) or
170            die "can't start ", dump( $irc_config ), ": $!";
171    
172    my $irc = $poe_irc->session_id();
173    _log "IRC session_id $irc";
174    
175  my $dbh = DBI->connect($DSN,"","", { RaiseError => 1, AutoCommit => 1 }) || die $DBI::errstr;  my $dbh = DBI->connect($DSN,"","", { RaiseError => 1, AutoCommit => 1 }) || die $DBI::errstr;
176    $dbh->do( qq{ set client_encoding = 'UTF-8' } );
177    
178  my $sql_schema = {  my $sql_schema = {
179          log => '          log => qq{
180  create table log (  create table log (
181          id serial,          id serial,
182          time timestamp default now(),          time timestamp default now(),
# Line 105  create table log ( Line 190  create table log (
190  create index log_time on log(time);  create index log_time on log(time);
191  create index log_channel on log(channel);  create index log_channel on log(channel);
192  create index log_nick on log(nick);  create index log_nick on log(nick);
193          ',          },
194          meta => '          meta => q{
195  create table meta (  create table meta (
196          nick text not null,          nick text not null,
197          channel text not null,          channel text not null,
198          name text not null,          name text not null,
199          value text,          value text,
200          changed timestamp default now(),          changed timestamp default 'now()',
201          primary key(nick,channel,name)          primary key(nick,channel,name)
202  );  );
203          ',          },
204            feeds => qq{
205    create table feeds (
206            id serial,
207            url text not null,
208            name text,
209            delay interval not null default '5 min',
210            active boolean default true,
211            channel text not null,
212            nick text not null,
213            private boolean default false,
214            last_update timestamp default 'now()',
215            polls int default 0,
216            updates int default 0
217    );
218    create unique index feeds_url on feeds(url);
219    insert into feeds (url,name,channel,nick) values ('http://wiki.razmjenavjestina.org/feed/workspace/razmjenavjestina?category=Recent%20Changes','wiki','$CHANNEL','dpavlin');
220            },
221  };  };
222    
223  foreach my $table ( keys %$sql_schema ) {  foreach my $table ( keys %$sql_schema ) {
# Line 154  sub meta { Line 256  sub meta {
256    
257                  eval { $sth->execute( $value, $nick, $channel, $name ) };                  eval { $sth->execute( $value, $nick, $channel, $name ) };
258    
259                  # error or no result                  if ( $@ ) {
260                  if ( $@ || ! $sth->rows ) {                          # error
261                            _log("META ERROR: $@");
262                    } elsif ( ! $sth->rows ) {
263                            # no result -> add new
264                          $sth = $dbh->prepare(qq{ insert into meta (value,nick,channel,name,changed) values (?,?,?,?,now()) });                          $sth = $dbh->prepare(qq{ insert into meta (value,nick,channel,name,changed) values (?,?,?,?,now()) });
265                          $sth->execute( $value, $nick, $channel, $name );                          eval { $sth->execute( $value, $nick, $channel, $name ); };
266                          _log "created $nick/$channel/$name = $value";                          if ( $@ ) {
267                                    _log "META ERROR: $@";
268                            } else {
269                                    _log "META: created $nick/$channel/$name = $value\n";
270                            }
271                  } else {                  } else {
272                          _log "updated $nick/$channel/$name = $value ";                          _log "META: updated $nick/$channel/$name = $value\n";
273                  }                  }
274    
275                  return $value;                  return $value;
# Line 170  sub meta { Line 279  sub meta {
279                  my $sth = $dbh->prepare(qq{ select value,changed from meta where nick = ? and channel = ? and name = ? });                  my $sth = $dbh->prepare(qq{ select value,changed from meta where nick = ? and channel = ? and name = ? });
280                  $sth->execute( $nick, $channel, $name );                  $sth->execute( $nick, $channel, $name );
281                  my ($v,$c) = $sth->fetchrow_array;                  my ($v,$c) = $sth->fetchrow_array;
282                  _log "fetched $nick/$channel/$name = $v [$c]";                  warn "## fetched $nick/$channel/$name = $v [$c]\n";
283                  return ($v,$c) if wantarray;                  return ($v,$c) if wantarray;
284                  return $v;                  return $v;
285    
# Line 179  sub meta { Line 288  sub meta {
288    
289    
290    
291  my $sth = $dbh->prepare(qq{  my $sth_insert_log = $dbh->prepare(qq{
292  insert into log  insert into log
293          (channel, me, nick, message, time)          (channel, me, nick, message, time)
294  values (?,?,?,?,?)  values (?,?,?,?,?)
# Line 187  values (?,?,?,?,?) Line 296  values (?,?,?,?,?)
296    
297    
298  my $tags;  my $tags;
 my $tag_regex = '\b([\w-_]+)//';  
299    
300  =head2 get_from_log  =head2 get_from_log
301    
# Line 224  C<me>, C<nick> and C<message> keys. Line 332  C<me>, C<nick> and C<message> keys.
332  sub get_from_log {  sub get_from_log {
333          my $args = {@_};          my $args = {@_};
334    
335          $args->{fmt} ||= {          if ( ! $args->{fmt} ) {
336                  date => '[%s] ',                  $args->{fmt} = {
337                  time => '{%s} ',                          date => '[%s] ',
338                  time_channel => '{%s %s} ',                          time => '{%s} ',
339                  nick => '%s: ',                          time_channel => '{%s %s} ',
340                  me_nick => '***%s ',                          nick => '%s: ',
341                  message => '%s',                          me_nick => '***%s ',
342          };                          message => '%s',
343                    };
344            }
345    
346          my $sql_message = qq{          my $sql_message = qq{
347                  select                  select
# Line 254  sub get_from_log { Line 364  sub get_from_log {
364    
365          my $sql = $context ? $sql_context : $sql_message;          my $sql = $context ? $sql_context : $sql_message;
366    
367          $sql .= " where message ilike ? or nick ilike ? " if ($args->{search});          sub check_date {
368          $sql .= " where id in (" . join(",", @{ $tags->{ $args->{tag} } }) . ") " if ($args->{tag} && $tags->{ $args->{tag} });                  my $date = shift || return;
369          $sql .= " where date(time) = ? " if ($args->{date});                  my $new_date = eval { DateTime::Format::ISO8601->parse_datetime( $date )->ymd; };
370          $sql .= " order by log.time desc";                  if ( $@ ) {
371          $sql .= " limit " . $args->{limit} if ($args->{limit});                          warn "invalid date $date\n";
372                            $new_date = DateTime->now->ymd;
373                    }
374                    return $new_date;
375            }
376    
377            my @where;
378            my @args;
379            my $msg;
380    
         my $sth = $dbh->prepare( $sql );  
381          if (my $search = $args->{search}) {          if (my $search = $args->{search}) {
382                  $search =~ s/^\s+//;                  $search =~ s/^\s+//;
383                  $search =~ s/\s+$//;                  $search =~ s/\s+$//;
384                  $sth->execute( ( '%' . $search . '%' ) x 2 );                  push @where, 'message ilike ? or nick ilike ?';
385                  _log "search for '$search' returned ", $sth->rows, " results ", $context || '';                  push @args, ( ( '%' . $search . '%' ) x 2 );
386          } elsif (my $tag = $args->{tag}) {                  $msg = "Search for '$search'";
387                  $sth->execute();          }
388                  _log "tag '$tag' returned ", $sth->rows, " results ", $context || '';  
389          } elsif (my $date = $args->{date}) {          if ($args->{tag} && $tags->{ $args->{tag} }) {
390                  $sth->execute($date);                  push @where, 'id in (' . join(',', @{ $tags->{ $args->{tag} } }) . ')';
391                  _log "found ", $sth->rows, " messages for date $date ", $context || '';                  $msg = "Search for tags $args->{tag}";
         } else {  
                 $sth->execute();  
392          }          }
393    
394            if (my $date = $args->{date} ) {
395                    $date = check_date( $date );
396                    push @where, 'date(time) = ?';
397                    push @args, $date;
398                    $msg = "search for date $date";
399            }
400    
401            $sql .= " where " . join(" and ", @where) if @where;
402    
403            $sql .= " order by log.time desc";
404            $sql .= " limit " . $args->{limit} if ($args->{limit});
405    
406            #warn "### sql: $sql ", dump( @args );
407    
408            my $sth = $dbh->prepare( $sql );
409            eval { $sth->execute( @args ) };
410            return if $@;
411    
412            my $nr_results = $sth->rows;
413    
414          my $last_row = {          my $last_row = {
415                  date => '',                  date => '',
416                  time => '',                  time => '',
# Line 295  sub get_from_log { Line 431  sub get_from_log {
431    
432          return @rows if ($args->{full_rows});          return @rows if ($args->{full_rows});
433    
434          my @msgs = (          $msg .= ' produced ' . (
435                  "Showing " . ($#rows + 1) . " messages..."                  $nr_results == 0 ? 'no results' :
436                    $nr_results == 0 ? 'one result' :
437                            $nr_results . ' results'
438          );          );
439    
440            my @msgs = ( $msg );
441    
442          if ($context) {          if ($context) {
443                  my @ids = @rows;                  my @ids = @rows;
444                  @rows = ();                  @rows = ();
# Line 355  sub get_from_log { Line 495  sub get_from_log {
495  #                       $row->{nick} = $nick;  #                       $row->{nick} = $nick;
496  #               }  #               }
497    
498                    $append = 0 if $row->{me};
499    
500                  if ($last_row->{nick} ne $nick) {                  if ($last_row->{nick} ne $nick) {
501                          # obfu way to find format for me_nick if needed or fallback to default                          # obfu way to find format for me_nick if needed or fallback to default
502                          my $fmt = $row->{me} ? ( $args->{fmt}->{me_nick} || $args->{fmt}->{nick} ) : $args->{fmt}->{nick};                          my $fmt = $row->{me} ? ( $args->{fmt}->{me_nick} || $args->{fmt}->{nick} ) : $args->{fmt}->{nick};
# Line 391  sub get_from_log { Line 533  sub get_from_log {
533    
534  # tags support  # tags support
535    
536  my $cloud = HTML::TagCloud->new;  my $cloud = TagCloud->new;
537    $cloud->seed_tags;
 =head2 add_tag  
   
  add_tag( id => 42, message => 'irc message' );  
   
 =cut  
   
 sub add_tag {  
         my $arg = {@_};  
   
         return unless ($arg->{id} && $arg->{message});  
   
         my $m = $arg->{message};  
         from_to('UTF-8', 'iso-8859-2', $m) if (is_utf8($m));  
   
         while ($m =~ s#$tag_regex##s) {  
                 my $tag = $1;  
                 next if (! $tag || $tag =~ m/https?:/i);  
                 push @{ $tags->{$tag} }, $arg->{id};  
                 #warn "+tag $tag: $arg->{id}\n";  
                 $cloud->add($tag, "?tag=$tag", scalar @{$tags->{$tag}} + 1);  
         }  
 }  
   
 =head2 seed_tags  
   
 Read all tags from database and create in-memory cache for tags  
   
 =cut  
   
 sub seed_tags {  
         my $sth = $dbh->prepare(qq{ select id,message from log where message like '%//%' });  
         $sth->execute;  
         while (my $row = $sth->fetchrow_hashref) {  
                 add_tag( %$row );  
         }  
   
         foreach my $tag (keys %$tags) {  
                 $cloud->add($tag, "?tag=$tag", scalar @{$tags->{$tag}} + 1);  
         }  
 }  
   
 seed_tags;  
   
538    
539  =head2 save_message  =head2 save_message
540    
# Line 443  seed_tags; Line 542  seed_tags;
542          channel => '#foobar',          channel => '#foobar',
543          me => 0,          me => 0,
544          nick => 'dpavlin',          nick => 'dpavlin',
545          msg => 'test message',          message => 'test message',
546          time => '2006-06-25 18:57:18',          time => '2006-06-25 18:57:18',
547    );    );
548    
# Line 455  C<me> if not specified will be C<0> (not Line 554  C<me> if not specified will be C<0> (not
554    
555  sub save_message {  sub save_message {
556          my $a = {@_};          my $a = {@_};
557            confess "have msg" if $a->{msg};
558          $a->{me} ||= 0;          $a->{me} ||= 0;
559          $a->{time} ||= strftime($TIMESTAMP,localtime());          $a->{time} ||= strftime($TIMESTAMP,localtime());
560    
561          _log          _log "ARCHIVE",
562                  $a->{channel}, " ",                  $a->{channel}, " ",
563                  $a->{me} ? "***" . $a->{nick} : "<" . $a->{nick} . ">",                  $a->{me} ? "***" . $a->{nick} : "<" . $a->{nick} . ">",
564                  " " . $a->{msg};                  " " . $a->{message};
565    
566          from_to($a->{msg}, 'UTF-8', $ENCODING);          eval { $sth_insert_log->execute($a->{channel}, $a->{me}, $a->{nick}, $a->{message}, $a->{time}); };
567            if ( $@ ) {
568          $sth->execute($a->{channel}, $a->{me}, $a->{nick}, $a->{msg}, $a->{time});                  _log "ERROR: can't archive ", $a->{message};
569          add_tag( id => $dbh->last_insert_id(undef,undef,"log",undef),          } else {
570                  message => $a->{msg});                  $cloud->add_tag( id => $dbh->last_insert_id(undef,undef,"log",undef), %$a );
571            }
572  }  }
573    
574    
575  if ($import_dircproxy) {  if ($import_dircproxy) {
576          open(my $l, $import_dircproxy) || die "can't open $import_dircproxy: $!";          open(my $l, $import_dircproxy) || die "can't open $import_dircproxy: $!";
577          warn "importing $import_dircproxy...\n";          warn "importing $import_dircproxy...\n";
578          my $tz_offset = 2 * 60 * 60;    # TZ GMT+2          my $tz_offset = 1 * 60 * 60;    # TZ GMT+2
579          while(<$l>) {          while(<$l>) {
580                  chomp;                  chomp;
581                  if (/^@(\d+)\s(\S+)\s(.+)$/) {                  if (/^@(\d+)\s(\S+)\s(.+)$/) {
# Line 492  if ($import_dircproxy) { Line 593  if ($import_dircproxy) {
593                                  channel => $CHANNEL,                                  channel => $CHANNEL,
594                                  me => $me,                                  me => $me,
595                                  nick => $nick,                                  nick => $nick,
596                                  msg => $msg,                                  message => $msg,
597                                  time => $dt->ymd . " " . $dt->hms,                                  time => $dt->ymd . " " . $dt->hms,
598                          ) if ($nick !~ m/^-/);                          ) if ($nick !~ m/^-/);
599    
# Line 505  if ($import_dircproxy) { Line 606  if ($import_dircproxy) {
606          exit;          exit;
607  }  }
608    
   
609  #  #
610  # POE handing part  # RSS follow
611  #  #
612    
613  my $SKIPPING = 0;               # if skipping, how many we've done  my $_stat;
 my $SEND_QUEUE;                 # cache  
 my $ping;                                               # ping stats  
   
 POE::Component::IRC->new($IRC_ALIAS);  
   
 POE::Session->create( inline_states =>  
    {_start => sub {        
                 $_[KERNEL]->post($IRC_ALIAS => register => 'all');  
                 $_[KERNEL]->post($IRC_ALIAS => connect => $CONNECT);  
     },  
     irc_255 => sub {    # server is done blabbing  
                 $_[KERNEL]->post($IRC_ALIAS => join => $CHANNEL);  
                 $_[KERNEL]->post($IRC_ALIAS => join => '#logger');  
                 $_[KERNEL]->yield("heartbeat"); # start heartbeat  
 #               $_[KERNEL]->yield("my_add", $_) for keys %FOLLOWS;  
                 $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "IDENTIFY $NICK" );  
     },  
     irc_public => sub {  
                 my $kernel = $_[KERNEL];  
                 my $nick = (split /!/, $_[ARG0])[0];  
                 my $channel = $_[ARG1]->[0];  
                 my $msg = $_[ARG2];  
614    
615                  save_message( channel => $channel, me => 0, nick => $nick, msg => $msg);  POE::Component::Client::HTTP->spawn(
616                  meta( $nick, $channel, 'last-msg', $msg );          Alias   => 'rss-fetch',
617      },          Timeout => 30,
618      irc_ctcp_action => sub {  );
619                  my $kernel = $_[KERNEL];  
620                  my $nick = (split /!/, $_[ARG0])[0];  =head2 rss_parse_xml
621                  my $channel = $_[ARG1]->[0];  
622                  my $msg = $_[ARG2];    rss_parse_xml({
623            url => 'http://www.example.com/rss',
624            send_rss_msgs => 42,
625      });
626    
627    =cut
628    
629                  save_message( channel => $channel, me => 1, nick => $nick, msg => $msg);  sub rss_parse_xml {
630            my ($kernel,$args) = @_;
631    
632                  if ( my $twitter = ( $nick, $channel, 'twitter' ) ) {          warn "## rss_parse_xml ",dump( $args ) if $debug;
633                          _log("FIXME: send twitter for $nick on $channel [$twitter]");  
634            # how many messages to send out when feed is seen for the first time?
635            my $send_rss_msgs = $args->{send_rss_msgs};
636            $send_rss_msgs = 1 if ! defined $send_rss_msgs;
637    
638            warn "## RSS fetch first $send_rss_msgs items from", $args->{url} if $debug;
639    
640            my $feed;
641            eval { $feed = XML::Feed->parse( \$args->{xml} ) };
642            if ( ! $feed ) {
643                    _log "can't fetch RSS ", $args->{url}, XML::Feed->errstr;
644                    return;
645            }
646    
647            $_stat->{rss}->{url2link}->{ $args->{url} } = $feed->link;
648    
649            my ( $total, $updates ) = ( 0, 0 );
650            for my $entry ($feed->entries) {
651                    $total++;
652    
653                    my $seen_times = $_stat->{rss}->{seen}->{$args->{channel}}->{$feed->link}->{$entry->id}++;
654                    # seen allready?
655                    warn "## $seen_times ",$entry->id if $debug;
656                    next if $seen_times > 0;
657    
658                    sub prefix {
659                            my ($txt,$var) = @_;
660                            $var =~ s/\s+/ /gs;
661                            $var =~ s/^\s+//g;
662                            $var =~ s/\s+$//g;
663                            return $txt . $var if $var;
664                  }                  }
665    
666      },                  # fix absolute and relative links to feed entries
667          irc_ping => sub {                  my $link = $entry->link;
668                  warn "pong ", $_[ARG0], $/;                  if ( $link =~ m!^/! ) {
669                  $ping->{ $_[ARG0] }++;                          my $host = $args->{url};
670          },                          $host =~ s!^(http://[^/]+).*$!$1!;      #!vim
671          irc_invite => sub {                          $link = "$host/$link";
672                  my $kernel = $_[KERNEL];                  } elsif ( $link !~ m!^http! ) {
673                  my $nick = (split /!/, $_[ARG0])[0];                          $link = $args->{url} . $link;
674                  my $channel = $_[ARG1];                  }
675    
676                  warn "invited to $channel by $nick";                  my $msg;
677                    $msg .= prefix( 'From: ' , $args->{name} || $feed->title );
678                    $msg .= prefix( ' by ' , $entry->author );
679                    $msg .= prefix( ' | ' , $entry->title );
680                    $msg .= prefix( ' | ' , $link );
681    #               $msg .= prefix( ' id ' , $entry->id );
682                    my @categories = $entry->category;
683                    warn "## category = ", dump( @categories ) if $debug;
684                    if ( my $tags = $entry->category ) {
685                            $tags = join(' ', @$tags) if ref($tags) eq 'ARRAY';
686                            $tags =~ s!^\s+!!;
687                            $tags =~ s!\s*$! !;
688                            $tags =~ s!,?\s+!// !g;
689                            $msg .= prefix( ' ' , $tags );
690                    }
691    
692                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, "how nice of you to invite me to $channel, I'll be right there..." );                  if ( $seen_times == 0 && $send_rss_msgs ) {
693                  $_[KERNEL]->post($IRC_ALIAS => join => $channel);                          $send_rss_msgs--;
694                            if ( ! $args->{private} ) {
695                                    # FIXME bug! should be save_message
696                                    save_message( channel => $args->{channel}, me => 1, nick => $NICK, message => $msg );
697    #                               $sth_insert_log->execute( $args->{channel}, 1, $NICK, $msg, 'now()' );
698                            }
699                            my ( $type, $to ) = ( 'notice', $args->{channel} );
700                            ( $type, $to ) = ( 'privmsg', $args->{nick} ) if $args->{private};
701    
702          },                          _log(">> RSS $type to $to:", $msg);
703          irc_msg => sub {                          $kernel->post( $irc => $type => $to => $msg );
704                  my $kernel = $_[KERNEL];  
705                  my $nick = (split /!/, $_[ARG0])[0];                          $updates++;
706                  my $msg = $_[ARG2];                  }
707                  my $channel = $_[ARG1]->[0];          }
                 from_to($msg, 'UTF-8', $ENCODING);  
708    
709                  my $res = "unknown command '$msg', try /msg $NICK help!";          my $sql = qq{ update feeds set last_update = now(), polls = polls + 1 };
710                  my @out;          $sql .= qq{, updates = updates + $updates } if $updates;
711            $sql .= qq{where id = } . $args->{id};
712            eval { $dbh->do( $sql ) };
713    
714                  _log "<< $msg";          _log "RSS $updates/$total new items from", $args->{url};
715    
716            return $updates;
717    }
718    
719                  if ($msg =~ m/^help/i) {  sub rss_fetch_all {
720            my ( $kernel, $send_rss_msgs )  = @_;
721            warn "## rss_fetch_all -- send_rss_msgs: $send_rss_msgs\n" if $debug;
722            my $sql = qq{
723                    select id, url, name, channel, nick, private
724                    from feeds
725                    where active is true
726            };
727            # limit to newer feeds only if we are not sending messages out
728            $sql .= qq{     and last_update + delay < now() } if defined ( $_stat->{rss}->{fetch} );
729            my $sth = $dbh->prepare( $sql );
730            $sth->execute();
731            warn "# ",$sth->rows," active RSS feeds\n";
732            my $count = 0;
733            while (my $row = $sth->fetchrow_hashref) {
734                    $row->{send_rss_msgs} = $send_rss_msgs if defined $send_rss_msgs;
735                    $_stat->{rss}->{fetch}->{ $row->{url} } = $row;
736                    $kernel->post(
737                            'rss-fetch',
738                            'request',
739                            'rss_response',
740                            HTTP::Request->new( GET => $row->{url} ),
741                    );
742                    warn "## queued rss-fetch ", dump( $row ) if $debug;
743            }
744            return "OK, scheduled " . $sth->rows . " feeds for refresh";
745    }
746    
                         $res = "usage: /msg $NICK comand | commands: stat - user/message stat | last - show backtrace | grep foobar - find foobar";  
747    
748                  } elsif ($msg =~ m/^msg\s+(\S+)\s+(.*)$/i) {  sub rss_check_updates {
749            my $kernel = shift;
750            $_stat->{rss}->{last_poll} ||= time();
751            my $dt = time() - $_stat->{rss}->{last_poll};
752            if ( $dt > $rss_min_delay ) {
753                    warn "## rss_check_updates $dt > $rss_min_delay\n";
754                    $_stat->{rss}->{last_poll} = time();
755                    _log rss_fetch_all( $kernel );
756            }
757    }
758    
759                          _log ">> /msg $1 $2";  sub process_command {
760                          $_[KERNEL]->post( $IRC_ALIAS => privmsg => $1, $2 );          my ( $kernel, $nick, $channel, $msg ) = @_;
                         $res = '';  
761    
762                  } elsif ($msg =~ m/^stat.*?\s*(\d*)/i) {          my $res = "unknown command '$msg', try /msg $NICK help!";
763    
764                          my $nr = $1 || 10;          if ($msg =~ m/^help/i) {
765    
766                          my $sth = $dbh->prepare(qq{                  $res = "usage: /msg $NICK comand | commands: stat - user/message stat | last - show backtrace | grep foobar - find foobar";
                                 select  
                                         nick,  
                                         count(*) as count,  
                                         sum(length(message)) as len  
                                 from log  
                                 group by nick  
                                 order by len desc,count desc  
                                 limit $nr  
                         });  
                         $sth->execute();  
                         $res = "Top $nr users: ";  
                         my @users;  
                         while (my $row = $sth->fetchrow_hashref) {  
                                 push @users,$row->{nick} . ': ' . $row->{count} . '/' . $row->{len} . '=' . sprintf("%.2f", $row->{len}/$row->{count});  
                         }  
                         $res .= join(" | ", @users);  
                 } elsif ($msg =~ m/^last.*?\s*(\d*)/i) {  
767    
768                          my $limit = $1 || meta( $nick, $channel, 'last-size' ) || 10;          } elsif ($msg =~ m/^(privmsg|notice)\s+(\S+)\s+(.*)$/i) {
769    
770                          foreach my $res (get_from_log( limit => $limit )) {                  _log ">> /$1 $2 $3";
771                                  _log "last: $res";                  $kernel->post( $irc => $1 => $2, $3 );
772                                  from_to($res, $ENCODING, 'UTF-8');                  $res = '';
                                 $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );  
                         }  
773    
774                          $res = '';          } elsif ($msg =~ m/^stat.*?\s*(\d*)/i) {
775    
776                  } elsif ($msg =~ m/^(search|grep)\s+(.*)\s*$/i) {                  my $nr = $1 || 10;
777    
778                          my $what = $2;                  my $sth = $dbh->prepare(qq{
779                            select
780                                    trim(both '_' from nick) as nick,
781                                    count(*) as count,
782                                    sum(length(message)) as len
783                            from log
784                            group by trim(both '_' from nick)
785                            order by len desc,count desc
786                            limit $nr
787                    });
788                    $sth->execute();
789                    $res = "Top $nr users: ";
790                    my @users;
791                    while (my $row = $sth->fetchrow_hashref) {
792                            push @users,$row->{nick} . ': ' . $row->{count} . '/' . $row->{len} . '=' . sprintf("%.2f", $row->{len}/$row->{count});
793                    }
794                    $res .= join(" | ", @users);
795            } elsif ($msg =~ m/^last.*?\s*(\d*)/i) {
796    
797                          foreach my $res (get_from_log(                  my $limit = $1 || meta( $nick, $channel, 'last-size' ) || 10;
                                         limit => 20,  
                                         search => $what,  
                                 )) {  
                                 _log "search [$what]: $res";  
                                 from_to($res, $ENCODING, 'UTF-8');  
                                 $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );  
                         }  
798    
799                          $res = '';                  foreach my $res (get_from_log( limit => $limit )) {
800                            _log "last: $res";
801                            $kernel->post( $irc => privmsg => $nick, $res );
802                    }
803    
804                  } elsif ($msg =~ m/^(?:count|poll)\s+(.*)(?:\s+(\d+))?\s*$/i) {                  $res = '';
805    
806                          my ($what,$limit) = ($1,$2);          } elsif ($msg =~ m/^(search|grep)\s+(.*)\s*$/i) {
                         $limit ||= 100;  
807    
808                          my $stat;                  my $what = $2;
809    
810                          foreach my $res (get_from_log(                  foreach my $res (get_from_log(
811                                          limit => $limit,                                  limit => 20,
812                                          search => $what,                                  search => $what,
813                                          full_rows => 1,                          )) {
814                                  )) {                          _log "search [$what]: $res";
815                                  while ($res->{message} =~ s/\Q$what\E(\+|\-)//) {                          $kernel->post( $irc => privmsg => $nick, $res );
816                                          $stat->{vote}->{$1}++;                  }
                                         $stat->{from}->{ $res->{nick} }++;  
                                 }  
                         }  
817    
818                          my @nicks;                  $res = '';
819                          foreach my $nick (sort { $stat->{from}->{$a} <=> $stat->{from}->{$b} } keys %{ $stat->{from} }) {  
820                                  push @nicks, $nick . ( $stat->{from}->{$nick} == 1 ? '' :          } elsif ($msg =~ m/^(?:count|poll)\s+(.*)(?:\s+(\d+))?\s*$/i) {
821                                          "(" . $stat->{from}->{$nick} . ")"  
822                                  );                  my ($what,$limit) = ($1,$2);
823                    $limit ||= 100;
824    
825                    my $stat;
826    
827                    foreach my $res (get_from_log(
828                                    limit => $limit,
829                                    search => $what,
830                                    full_rows => 1,
831                            )) {
832                            while ($res->{message} =~ s/\Q$what\E(\+|\-)//) {
833                                    $stat->{vote}->{$1}++;
834                                    $stat->{from}->{ $res->{nick} }++;
835                          }                          }
836                    }
837    
838                          $res =                  my @nicks;
839                                  "$what ++ " . ( $stat->{vote}->{'+'} || 0 ) .                  foreach my $nick (sort { $stat->{from}->{$a} <=> $stat->{from}->{$b} } keys %{ $stat->{from} }) {
840                                  " : " . ( $stat->{vote}->{'-'} || 0 ) . " --" .                          push @nicks, $nick . ( $stat->{from}->{$nick} == 1 ? '' :
841                                  " from " . ( join(", ", @nicks) || 'nobody' );                                  "(" . $stat->{from}->{$nick} . ")"
842                            );
843                          $_[KERNEL]->post( $IRC_ALIAS => notice => $nick, $res );                  }
844    
845                  } elsif ($msg =~ m/^ping/) {                  $res =
846                          $res = "ping = " . dump( $ping );                          "$what ++ " . ( $stat->{vote}->{'+'} || 0 ) .
847                  } elsif ($msg =~ m/^(?:twitter)\s+(\S+)\s+(.*?)/) {                          " : " . ( $stat->{vote}->{'-'} || 0 ) . " --" .
848                          if ( defined( $2 ) ) {                          " from " . ( join(", ", @nicks) || 'nobody' );
849                                  meta($nick, $channel, 'twitter', "$1\t$2");  
850                                  $res = "saved twitter auth for $1 -- /me on $channel will auto-update twitter status";                  $kernel->post( $irc => notice => $nick, $res );
851                          } else {  
852                                  meta($nick, $channel, 'twitter', '' );          } elsif ($msg =~ m/^ping/) {
853                                  $res = "removed twitter status update for /me on $channel";                  $res = "ping = " . dump( $_stat->{ping} );
854            } elsif ($msg =~ m/^conf(?:ig)*\s*(last-size|twitter)*\s*(.*)/) {
855                    if ( ! defined( $1 ) ) {
856                            my $sth = $dbh->prepare(qq{ select name,value,changed from meta where nick = ? and channel = ? });
857                            $sth->execute( $nick, $channel );
858                            $res = "config for $nick on $channel";
859                            while ( my ($n,$v) = $sth->fetchrow_array ) {
860                                    $res .= " | $n = $v";
861                          }                          }
862                  } elsif ($msg =~ m/^conf(?:ig)*\s*(last-size)*\s*(\d*)/) {                  } elsif ( ! $2 ) {
863                          if ( ! defined( $1 ) ) {                          my $val = meta( $nick, $channel, $1 );
864                                  my $sth = $dbh->prepare(qq{ select name,value,changed from meta where nick = ? and channel = ? });                          $res = "current $1 = " . ( $val ? $val : 'undefined' );
865                                  $sth->execute( $nick, $channel );                  } else {
866                                  $res = "config for $nick ";                          my $validate = {
867                                  while ( my ($n,$v) = $sth->fetchrow_array ) {                                  'last-size' => qr/^\d+/,
868                                          $res .= "| $n = $v";                                  'twitter' => qr/^\w+\s+\w+/,
869                            };
870    
871                            my ( $op, $val ) = ( $1, $2 );
872    
873                            if ( my $regex = $validate->{$op} ) {
874                                    if ( $val =~ $regex ) {
875                                            meta( $nick, $channel, $op, $val );
876                                            $res = "saved $op = $val";
877                                    } else {
878                                            $res = "config option $op = $val doesn't validate against $regex";
879                                  }                                  }
                         } elsif ( defined( $2 ) ) {  
                                 meta( $nick, $channel, $1, $2 );  
                                 $res = "saved $1 = $2";  
880                          } else {                          } else {
881                                  my $val = meta( $nick, $channel, $1 );                                  $res = "config option $op doesn't exist";
882                                  $res = "current $1 = " . ( $val ? $val : 'undefined' );                          }
883                    }
884            } elsif ($msg =~ m/^rss-update/) {
885                    $res = rss_fetch_all( $kernel );
886            } elsif ($msg =~ m/^rss-list/) {
887                    my $sth = $dbh->prepare(qq{ select url,name,last_update,active,channel,nick,private from feeds });
888                    $sth->execute;
889                    while (my @row = $sth->fetchrow_array) {
890                            $kernel->post( $irc => privmsg => $nick, join(' | ',@row) );
891                    }
892                    $res = '';
893            } elsif ($msg =~ m!^rss-(add|remove|stop|start|clean)(?:-(private))?\s+(http://\S+)\s*(.*)!) {
894                    my ( $command, $sub, $url, $arg ) = ( $1,$2,$3,$4 );
895    
896                    my $channel = $1 if ( $arg =~ s/\s*(#\S+)\s*// );
897                    $channel = $nick if $sub eq 'private';
898    
899                    my $sql = {
900                            add     => qq{ insert into feeds (url,name,channel,nick,private) values (?,?,?,?,?) },
901                            remove  => qq{ delete from feeds                                where url = ? and nick = ? },
902                            start   => qq{ update feeds set active = true   where url = ? },
903                            stop    => qq{ update feeds set active = false  where url = ? },
904                            clean   => qq{ update feeds set last_update = now() - delay where url = ? },
905                    };
906    
907                    if ( $command eq 'add' && ! $channel ) {
908                            $res = "ERROR: got '$msg' which doesn't have #channel in it, ignoring!";
909                    } elsif (my $q = $sql->{$command} ) {
910                            my $sth = $dbh->prepare( $q );
911                            my @data = ( $url );
912                            if ( $command eq 'add' ) {
913                                    push @data, ( $arg, $channel, $nick, $sub eq 'private' ? 1 : 0 );
914                            } elsif ( $command eq 'remove' ) {
915                                    push @data, $nick;
916                            }
917                            warn "## $command SQL $q with ",dump( @data ),"\n";
918                            eval { $sth->execute( @data ) };
919                            if ($@) {
920                                    $res = "ERROR: $@";
921                            } else {
922                                    $res = "OK, RSS executed $command" .
923                                            ( $sub ? "-$sub " : ' ' ) .
924                                            ( $channel ? "on $channel " : '' ) .
925                                            "url $url";
926                                    if ( $command eq 'clean' ) {
927                                            my $seen = $_stat->{rss}->{seen} || die "no seen?";
928                                            my $want_link = $_stat->{rss}->{url2link}->{$url} || warn "no url2link($url)";
929                                            foreach my $c ( keys %$seen ) {
930                                                    my $c_hash = $seen->{$c} || die "no seen->{$c}";
931                                                    die "not HASH with rss links but ", dump($c_hash) unless ref($c_hash) eq 'HASH';
932                                                    foreach my $link ( keys %$c_hash ) {
933                                                            next unless $link eq $want_link;
934                                                            _log "RSS removed seen $c $url $link";
935                                                    }
936                                            }
937                                    } elsif ( $command eq 'add' ) {
938                                            rss_fetch_all( $kernel );
939                                    }
940                          }                          }
941                    } else {
942                            $res = "ERROR: don't know what to do with: $msg";
943                  }                  }
944            } elsif ($msg =~ m/^rss-clean/) {
945                    # this makes sense because we didn't catch rss-clean http://... before!
946                    $_stat->{rss} = undef;
947                    $dbh->do( qq{ update feeds set last_update = now() - delay } );
948                    $res = rss_fetch_all( $kernel );
949            }
950    
951            return $res;
952    }
953    
954    POE::Session->create( inline_states => {
955            _start => sub {      
956                    $_[KERNEL]->post( $irc => register => 'all' );
957                    $_[KERNEL]->post( $irc => connect => {} );
958        },
959            irc_001 => sub {
960                    my ($kernel,$sender) = @_[KERNEL,SENDER];
961                    my $poco_object = $sender->get_heap();
962                    _log "connected to",$poco_object->server_name();
963                    $kernel->post( $sender => join => $_ ) for @channels;
964                    # seen RSS cache, so don't send out messages
965                    _log rss_fetch_all( $kernel, 0 );
966                    undef;
967            },
968    #       irc_255 => sub {        # server is done blabbing
969    #               $_[KERNEL]->post( $irc => join => $CHANNEL);
970    #       },
971        irc_public => sub {
972                    my $kernel = $_[KERNEL];
973                    my $nick = (split /!/, $_[ARG0])[0];
974                    my $channel = $_[ARG1]->[0];
975                    my $msg = $_[ARG2];
976    
977                    save_message( channel => $channel, me => 0, nick => $nick, message => $msg);
978                    meta( $nick, $channel, 'last-msg', $msg );
979                    rss_check_updates( $kernel );
980        },
981        irc_ctcp_action => sub {
982                    my $kernel = $_[KERNEL];
983                    my $nick = (split /!/, $_[ARG0])[0];
984                    my $channel = $_[ARG1]->[0];
985                    my $msg = $_[ARG2];
986    
987                    save_message( channel => $channel, me => 1, nick => $nick, message => $msg);
988    
989                    if ( $use_twitter ) {
990                            if ( my $twitter = meta( $nick, $NICK, 'twitter' ) ) {
991                                    my ($login,$passwd) = split(/\s+/,$twitter,2);
992                                    _log("sending twitter for $nick/$login on $channel ");
993                                    my $bot = Net::Twitter->new( username=>$login, password=>$passwd );
994                                    $bot->update("<${channel}> $msg");
995                            }
996                    }
997    
998        },
999            irc_ping => sub {
1000                    _log( "pong ", $_[ARG0] );
1001                    $_stat->{ping}->{ $_[ARG0] }++;
1002                    rss_check_updates( $_[KERNEL] );
1003            },
1004            irc_invite => sub {
1005                    my $kernel = $_[KERNEL];
1006                    my $nick = (split /!/, $_[ARG0])[0];
1007                    my $channel = $_[ARG1];
1008    
1009                    _log "invited to $channel by $nick";
1010    
1011                    $_[KERNEL]->post( $irc => privmsg => $nick, "how nice of you to invite me to $channel, I'll be right there..." );
1012                    $_[KERNEL]->post( $irc => 'join' => $channel );
1013    
1014            },
1015            irc_msg => sub {
1016                    my $kernel = $_[KERNEL];
1017                    my $nick = (split /!/, $_[ARG0])[0];
1018                    my $channel = $_[ARG1]->[0];
1019                    my $msg = $_[ARG2];
1020                    warn "# ARG = ",dump( @_[ARG0,ARG1,ARG2] ) if $debug;
1021    
1022                    _log "<< $msg";
1023    
1024                    my $res = process_command( $_[KERNEL], $nick, $channel, $msg );
1025    
1026                  if ($res) {                  if ($res) {
1027                          _log ">> [$nick] $res";                          _log ">> [$nick] $res";
1028                          from_to($res, $ENCODING, 'UTF-8');                          $_[KERNEL]->post( $irc => privmsg => $nick, $res );
                         $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );  
1029                  }                  }
1030    
1031                    rss_check_updates( $_[KERNEL] );
1032            },
1033            irc_372 => sub {
1034                    _log "<< motd",$_[ARG0],$_[ARG1];
1035            },
1036            irc_375 => sub {
1037                    _log "<< motd", $_[ARG0], "start";
1038            },
1039            irc_376 => sub {
1040                    _log "<< motd", $_[ARG0], "end";
1041          },          },
1042    #       irc_433 => sub {
1043    #               print "# irc_433: ",$_[ARG1], "\n";
1044    #               warn "## indetify $NICK\n";
1045    #               $_[KERNEL]->post( $irc => privmsg => 'nickserv', "IDENTIFY $NICK" );
1046    #       },
1047    #       irc_451 # please register
1048          irc_477 => sub {          irc_477 => sub {
1049                  _log "# irc_477: ",$_[ARG1];                  _log "<< irc_477: ",$_[ARG1];
1050                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "register $NICK" );                  _log ">> IDENTIFY $NICK";
1051                    $_[KERNEL]->post( $irc => privmsg => 'NickServ', "IDENTIFY $NICK" );
1052          },          },
1053          irc_505 => sub {          irc_505 => sub {
1054                  _log "# irc_505: ",$_[ARG1];                  _log "<< irc_505: ",$_[ARG1];
1055                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "register $NICK" );                  _log ">> register $NICK";
1056  #               $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "set hide email on" );                  $_[KERNEL]->post( $irc => privmsg => 'NickServ', "register $NICK" );
1057  #               $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "set email dpavlin\@rot13.org" );  #               $_[KERNEL]->post( $irc => privmsg => 'nickserv', "IDENTIFY $NICK" );
1058    #               $_[KERNEL]->post( $irc => privmsg => 'nickserv', "set hide email on" );
1059    #               $_[KERNEL]->post( $irc => privmsg => 'nickserv', "set email dpavlin\@rot13.org" );
1060          },          },
1061          irc_registered => sub {          irc_registered => sub {
1062                  _log "## registrated $NICK";                  _log "<< registered $NICK";
                 $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "IDENTIFY $NICK" );  
1063          },          },
1064          irc_disconnected => sub {          irc_disconnected => sub {
1065                  _log "## disconnected, reconnecting again";                  _log "## disconnected.. sleeping for $sleep_on_error seconds and reconnecting again";
1066                  $_[KERNEL]->post($IRC_ALIAS => connect => $CONNECT);                  sleep($sleep_on_error);
1067                    $_[KERNEL]->post( $irc => connect => {} );
1068          },          },
1069          irc_socketerr => sub {          irc_socketerr => sub {
1070                  _log "## socket error... sleeping for $sleep_on_error seconds and retry";                  _log "## socket error... sleeping for $sleep_on_error seconds and retry";
1071                  sleep($sleep_on_error);                  sleep($sleep_on_error);
1072                  $_[KERNEL]->post($IRC_ALIAS => connect => $CONNECT);                  $_[KERNEL]->post( $irc => connect => {} );
1073            },
1074            irc_notice => sub {
1075                    _log "<< notice from ", $_[ARG0], $_[ARG1], $_[ARG2];
1076                    my $m = $_[ARG2];
1077                    if ( $m =~ m!/msg.*(NickServ).*(IDENTIFY)!i ) {
1078                            _log ">> suggested to $1 $2";
1079                            $_[KERNEL]->post( $irc => privmsg => $1, "$2 $NICK" );
1080                    } elsif ( $m =~ m!\Q$NICK\E.*registered!i ) {
1081                            _log ">> registreted, so IDENTIFY";
1082                            $_[KERNEL]->post( $irc => privmsg => 'nickserv', "IDENTIFY $NICK" );
1083                    } else {
1084                            warn "## ignore $m\n" if $debug;
1085                    }
1086            },
1087            irc_snotice => sub {
1088                    _log "<< snotice", $_[ARG0]; #dump( $_[ARG0],$_[ARG1], $_[ARG2] );
1089                    if ( $_[ARG0] =~ m!/(QUOTE)\s+(PASS\s+\d+)!i ) {
1090                            warn ">> $1 | $2\n";
1091                            $_[KERNEL]->post( $irc => lc($1) => $2);
1092                    }
1093          },          },
 #       irc_433 => sub {  
 #               print "# irc_433: ",$_[ARG1], "\n";  
 #               warn "## indetify $NICK\n";  
 #               $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "IDENTIFY $NICK" );  
 #       },  
1094      _child => sub {},      _child => sub {},
1095      _default => sub {      _default => sub {
1096                  _log sprintf "sID:%s %s %s",                  _log '_default SID:', $_[SESSION]->ID, $_[ARG0], dump( $_[ARG1] );
1097                          $_[SESSION]->ID, $_[ARG0],                  0; # false for signals
                         ref($_[ARG1]) eq "ARRAY"        ?       join(",", map { ref($_) eq "ARRAY" ? join(";", @{$_}) : $_ } @{ $_[ARG1] })     :  
                         $_[ARG1]                                        ?       $_[ARG1]                                        :  
                         "";  
       0;                        # false for signals  
1098      },      },
1099      my_add => sub {          rss_response => sub {
1100        my $trailing = $_[ARG0];                  my ($request_packet, $response_packet) = @_[ARG0, ARG1];
1101        my $session = $_[SESSION];                  my $request_object  = $request_packet->[0];
1102        POE::Session->create                  my $response_object = $response_packet->[0];
1103            (inline_states =>  
1104             {_start => sub {                  my $row = delete( $_stat->{rss}->{fetch}->{ $request_object->uri } );
1105                $_[HEAP]->{wheel} =                  if ( $row ) {
1106                  POE::Wheel::FollowTail->new                          $row->{xml} = $response_object->content;
1107                      (                          rss_parse_xml( $_[KERNEL], $row );
1108                       Filename => $FOLLOWS{$trailing},                  } else {
1109                       InputEvent => 'got_line',                          warn "## can't find rss->fetch for ", $request_object->uri;
1110                      );                  }
1111              },          },
             got_line => sub {  
               $_[KERNEL]->post($session => my_tailed =>  
                                time, $trailing, $_[ARG0]);  
             },  
            },  
           );  
       
     },  
     my_tailed => sub {  
       my ($time, $file, $line) = @_[ARG0..ARG2];  
       ## $time will be undef on a probe, or a time value if a real line  
   
       ## PoCo::IRC has throttling built in, but no external visibility  
       ## so this is reaching "under the hood"  
       $SEND_QUEUE ||=  
         $_[KERNEL]->alias_resolve($IRC_ALIAS)->get_heap->{send_queue};  
   
       ## handle "no need to keep skipping" transition  
       if ($SKIPPING and @$SEND_QUEUE < 1) {  
         $_[KERNEL]->post($IRC_ALIAS => privmsg => $CHANNEL =>  
                          "[discarded $SKIPPING messages]");  
         $SKIPPING = 0;  
       }  
   
       ## handle potential message display  
       if ($time) {  
         if ($SKIPPING or @$SEND_QUEUE > 3) { # 3 msgs per 10 seconds  
           $SKIPPING++;  
         } else {  
           my @time = localtime $time;  
           $_[KERNEL]->post($IRC_ALIAS => privmsg => $CHANNEL =>  
                            sprintf "%02d:%02d:%02d: %s: %s",  
                            ($time[2] + 11) % 12 + 1, $time[1], $time[0],  
                            $file, $line);  
         }  
       }  
   
       ## handle re-probe/flush if skipping  
       if ($SKIPPING) {  
         $_[KERNEL]->delay($_[STATE] => 0.5); # $time will be undef  
       }  
   
     },  
     my_heartbeat => sub {  
       $_[KERNEL]->yield(my_tailed => time, "heartbeat", "beep");  
       $_[KERNEL]->delay($_[STATE] => 10);  
     }  
1112     },     },
1113    );    );
1114    
1115  # http server  # http server
1116    
1117    _log "WEB archive at $url";
1118    
1119  my $httpd = POE::Component::Server::HTTP->new(  my $httpd = POE::Component::Server::HTTP->new(
1120          Port => $NICK =~ m/-dev/ ? 8001 : 8000,          Port => $http_port,
1121            PreHandler => {
1122                    '/' => sub {
1123                            $_[0]->header(Connection => 'close')
1124                    }
1125            },
1126          ContentHandler => { '/' => \&root_handler },          ContentHandler => { '/' => \&root_handler },
1127          Headers        => { Server => 'irc-logger' },          Headers        => { Server => 'irc-logger' },
1128  );  );
1129    
 my %escape = ('<'=>'&lt;', '>'=>'&gt;', '&'=>'&amp;', '"'=>'&quot;');  
 my $escape_re  = join '|' => keys %escape;  
   
1130  my $style = <<'_END_OF_STYLE_';  my $style = <<'_END_OF_STYLE_';
1131  p { margin: 0; padding: 0.1em; }  p { margin: 0; padding: 0.1em; }
1132  .time, .channel { color: #808080; font-size: 60%; }  .time, .channel { color: #808080; font-size: 60%; }
# Line 819  p { margin: 0; padding: 0.1em; } Line 1134  p { margin: 0; padding: 0.1em; }
1134  .nick { color: #000000; font-size: 80%; padding: 2px; font-family: courier, courier new, monospace ; }  .nick { color: #000000; font-size: 80%; padding: 2px; font-family: courier, courier new, monospace ; }
1135  .message { color: #000000; font-size: 100%; }  .message { color: #000000; font-size: 100%; }
1136  .search { float: right; }  .search { float: right; }
1137    a:link.tag, a:visited.tag { border: 1px dashed #ccc; backgound: #ccc; text-decoration: none }
1138    a:hover.tag { border: 1px solid #eee }
1139    hr { border: 1px dashed #ccc; height: 1px; clear: both; }
1140    /*
1141  .col-0 { background: #ffff66 }  .col-0 { background: #ffff66 }
1142  .col-1 { background: #a0ffff }  .col-1 { background: #a0ffff }
1143  .col-2 { background: #99ff99 }  .col-2 { background: #99ff99 }
1144  .col-3 { background: #ff9999 }  .col-3 { background: #ff9999 }
1145  .col-4 { background: #ff66ff }  .col-4 { background: #ff66ff }
1146  a:link.tag, a:visited.tag { border: 1px dashed #ccc; backgound: #ccc; text-decoration: none }  */
1147  a:hover.tag { border: 1px solid #eee }  .calendar { border: 1px solid red; width: 100%; }
1148  hr { border: 1px dashed #ccc; height: 1px; clear: both; }  .month { border: 0px; width: 100%; }
1149  _END_OF_STYLE_  _END_OF_STYLE_
1150    
1151  my $max_color = 4;  $max_color = 0;
1152    
1153  my %nick_enumerator;  my @cols = qw(
1154            #ffcccc #ccffe6 #ccccff #e6ccff #ffccff #ffcce6 #ff9999 #ffcc99 #ffff99
1155            #ccff99 #99ff99 #99ffcc #99ccff #9999ff #cc99ff #ff6666 #ffb366 #ffff66
1156            #66ff66 #66ffb3 #66b3ff #6666ff #ff3333 #33ff33 #3399ff #3333ff #ff3399
1157            #a0a0a0 #ff0000 #ffff00 #80ff00 #0000ff #8000ff #ff00ff #ff0080 #994d00
1158            #999900 #009900 #cc0066 #c0c0c0 #ccff99 #99ff33 #808080 #660033 #ffffff
1159    );
1160    
1161    foreach my $c (@cols) {
1162            $style .= ".col-${max_color} { background: $c }\n";
1163            $max_color++;
1164    }
1165    _log "WEB defined $max_color colors for users...";
1166    
1167  sub root_handler {  sub root_handler {
1168          my ($request, $response) = @_;          my ($request, $response) = @_;
1169          $response->code(RC_OK);          $response->code(RC_OK);
1170          $response->content_type("text/html; charset=$ENCODING");  
1171            # this doesn't seem to work, so moved to PreHandler
1172            #$response->header(Connection => 'close');
1173    
1174            return RC_OK if $request->uri =~ m/favicon.ico$/;
1175    
1176          my $q;          my $q;
1177    
# Line 849  sub root_handler { Line 1184  sub root_handler {
1184          }          }
1185    
1186          my $search = $q->param('search') || $q->param('grep') || '';          my $search = $q->param('search') || $q->param('grep') || '';
1187            my $r_url = $request->url;
1188    
1189            my @commands = qw( tags last-tag follow stat );
1190            my $commands_re = join('|',@commands);
1191    
1192            if ($r_url =~ m#/rss(?:/($commands_re.*)\w*(?:=(\d+))?)?#i) {
1193                    my $show = lc($1);
1194                    my $nr = $2;
1195    
1196                    my $type = 'RSS';       # Atom
1197    
1198                    $response->content_type( 'application/' . lc($type) . '+xml' );
1199    
1200                    my $html = '<!-- error -->';
1201                    #warn "create $type feed from ",dump( $cloud->last_tags );
1202    
1203                    my $feed = XML::Feed->new( $type );
1204                    $feed->link( $url );
1205    
1206                    my $rc = RC_OK;
1207    
1208                    if ( $show eq 'tags' ) {
1209                            $nr ||= 50;
1210                            $feed->title( "tags from $CHANNEL" );
1211                            $feed->link( "$url/tags" );
1212                            $feed->description( "tag cloud created from messages on channel $CHANNEL which have tags// in them" );
1213                            my $feed_entry = XML::Feed::Entry->new($type);
1214                            $feed_entry->title( "$nr tags from $CHANNEL" );
1215                            $feed_entry->author( $NICK );
1216                            $feed_entry->link( '/#tags'  );
1217    
1218                            $feed_entry->content(
1219                                    qq{<![CDATA[<style type="text/css">}
1220                                    . $cloud->css
1221                                    . qq{</style>}
1222                                    . $cloud->html( $nr )
1223                                    . qq{]]>}
1224                            );
1225                            $feed->add_entry( $feed_entry );
1226    
1227                    } elsif ( $show eq 'last-tag' ) {
1228    
1229                            $nr ||= $last_x_tags;
1230                            $nr = $last_x_tags if $nr > $last_x_tags;
1231    
1232                            $feed->title( "last $nr tagged messages from $CHANNEL" );
1233                            $feed->description( "collects messages which have tags// in them" );
1234    
1235                            foreach my $m ( $cloud->last_tags ) {
1236    #                               warn dump( $m );
1237                                    #my $tags = join(' ', @{$m->{tags}} );
1238                                    my $feed_entry = XML::Feed::Entry->new($type);
1239                                    $feed_entry->title( $m->{nick} . '@' . $m->{time} );
1240                                    $feed_entry->author( $m->{nick} );
1241                                    $feed_entry->link( '/#' . $m->{id}  );
1242                                    $feed_entry->issued( DateTime::Format::Flexible->build( $m->{time} ) );
1243    
1244                                    my $message = $filter->{message}->( $m->{message} );
1245                                    $message .= "<br/>\n" unless $message =~ m!<(/p|br/?)>!;
1246    #                               warn "## message = $message\n";
1247    
1248                                    #$feed_entry->summary(
1249                                    $feed_entry->content(
1250                                            "<![CDATA[$message]]>"
1251                                    );
1252                                    $feed_entry->category( join(', ', @{$m->{tags}}) );
1253                                    $feed->add_entry( $feed_entry );
1254    
1255                                    $nr--;
1256                                    last if $nr <= 0;
1257    
1258                            }
1259    
1260                    } elsif ( $show =~ m/^follow/ ) {
1261    
1262                            $feed->title( "Feeds which this bot follows" );
1263    
1264                            my $sth = $dbh->prepare( qq{ select * from feeds order by last_update desc } );
1265                            $sth->execute;
1266                            while (my $row = $sth->fetchrow_hashref) {
1267                                    my $feed_entry = XML::Feed::Entry->new($type);
1268                                    $feed_entry->title( $row->{name} );
1269                                    $feed_entry->link( $row->{url}  );
1270                                    $feed_entry->issued( DateTime::Format::Flexible->build( $row->{last_update} ) );
1271                                    $feed_entry->content(
1272                                            '<![CDATA[<pre>' . dump( $row ) . '</pre>]]>'
1273                                    );
1274                                    $feed->add_entry( $feed_entry );
1275                            }
1276    
1277                    } elsif ( $show =~ m/^stat/ ) {
1278    
1279                            my $feed_entry = XML::Feed::Entry->new($type);
1280                            $feed_entry->title( "Internal stats" );
1281                            $feed_entry->content(
1282                                    '<![CDATA[<pre>' . dump( $_stat ) . '</pre>]]>'
1283                            );
1284                            $feed->add_entry( $feed_entry );
1285    
1286                    } else {
1287                            _log "WEB unknown rss request $r_url";
1288                            $feed->title( "unknown $r_url" );
1289                            foreach my $c ( @commands ) {
1290                                    my $feed_entry = XML::Feed::Entry->new($type);
1291                                    $feed_entry->title( "rss/$c" );
1292                                    $feed_entry->link( "$url/rss/$c" );
1293                                    $feed->add_entry( $feed_entry );
1294                            }
1295                            $rc = RC_DENY;
1296                    }
1297    
1298                    eval { $response->content( $feed->as_xml ); };
1299                    $rc = RC_INTERNAL_SERVER_ERROR if $@;
1300                    return $rc;
1301            }
1302    
1303            if ( $@ ) {
1304                    warn "$@";
1305            }
1306    
1307            $response->content_type("text/html; charset=UTF-8");
1308    
1309          my $html =          my $html =
1310                  qq{<html><head><title>$NICK</title><style type="text/css">$style} .                  qq{<html><head><title>$NICK</title><style type="text/css">$style}
1311                  $cloud->css .                  . $cloud->css
1312                  qq{</style></head><body>} .                  . qq{</style></head><body>}
1313                  qq{                  . qq{
1314                  <form method="post" class="search" action="/">                  <form method="post" class="search" action="/">
1315                  <input type="text" name="search" value="$search" size="10">                  <input type="text" name="search" value="$search" size="10">
1316                  <input type="submit" value="search">                  <input type="submit" value="search">
1317                  </form>                  </form>
1318                  } .                  }
1319                  $cloud->html(500) .                  . $cloud->html(500)
1320                  qq{<p>};                  . qq{<p>};
1321          if ($request->url =~ m#/history#) {  
1322            if ($request->url =~ m#/tags?#) {
1323                    # nop
1324            } elsif ($request->url =~ m#/history#) {
1325                  my $sth = $dbh->prepare(qq{                  my $sth = $dbh->prepare(qq{
1326                          select date(time) as date,count(*) as nr                          select date(time) as date,count(*) as nr,sum(length(message)) as len
1327                                  from log                                  from log
1328                                  group by date(time)                                  group by date(time)
1329                                  order by date(time) desc                                  order by date(time) desc
1330                  });                  });
1331                  $sth->execute();                  $sth->execute();
1332                  my ($l_yyyy,$l_mm) = (0,0);                  my ($l_yyyy,$l_mm) = (0,0);
1333                    $html .= qq{<table class="calendar"><tr>};
1334                  my $cal;                  my $cal;
1335                    my $ord = 0;
1336                  while (my $row = $sth->fetchrow_hashref) {                  while (my $row = $sth->fetchrow_hashref) {
1337                          # this is probably PostgreSQL specific, expects ISO date                          # this is probably PostgreSQL specific, expects ISO date
1338                          my ($yyyy,$mm,$dd) = split(/-/, $row->{date});                          my ($yyyy,$mm,$dd) = split(/-/, $row->{date});
1339                          if ($yyyy != $l_yyyy || $mm != $l_mm) {                          if ($yyyy != $l_yyyy || $mm != $l_mm) {
1340                                  $html .= $cal->as_HTML() if ($cal);                                  if ( $cal ) {
1341                                            $html .= qq{<td valign="top">} . $cal->as_HTML() . qq{</td>};
1342                                            $ord++;
1343                                            $html .= qq{</tr><tr>} if ( $ord % 3 == 0 );
1344                                    }
1345                                  $cal = new HTML::CalendarMonthSimple('month'=>$mm,'year'=>$yyyy);                                  $cal = new HTML::CalendarMonthSimple('month'=>$mm,'year'=>$yyyy);
1346                                  $cal->border(2);                                  $cal->border(1);
1347                                    $cal->width('30%');
1348                                    $cal->cellheight('5em');
1349                                    $cal->tableclass('month');
1350                                    #$cal->cellclass('day');
1351                                    $cal->sunday('SUN');
1352                                    $cal->saturday('SAT');
1353                                    $cal->weekdays('MON','TUE','WED','THU','FRI');
1354                                  ($l_yyyy,$l_mm) = ($yyyy,$mm);                                  ($l_yyyy,$l_mm) = ($yyyy,$mm);
1355                          }                          }
1356                          $cal->setcontent($dd, qq{                          $cal->setcontent($dd, qq[
1357                                  <a href="/?date=$row->{date}">$row->{nr}</a>                                  <a href="$url?date=$row->{date}">$row->{nr}</a><br/>$row->{len}
1358                          });                          ]) if $cal;
1359                            
1360                  }                  }
1361                  $html .= $cal->as_HTML() if ($cal);                  $html .= qq{<td valign="top">} . $cal->as_HTML() . qq{</td></tr></table>};
1362    
1363          } else {          } else {
1364                  $html .= join("</p><p>",                  $html .= join("</p><p>",
1365                          get_from_log(                          get_from_log(
1366                                  limit => $q->param('last') || $q->param('date') ? undef : 100,                                  limit => ( $q->param('date') ? undef : $q->param('last') || 100 ),
1367                                  search => $search || undef,                                  search => $search || undef,
1368                                  tag => $q->param('tag') || undef,                                  tag => $q->param('tag') || undef,
1369                                  date => $q->param('date') || undef,                                  date => $q->param('date') || undef,
1370                                  fmt => {                                  fmt => {
1371                                          date => sub {                                          date => sub {
1372                                                  my $date = shift || return;                                                  my $date = shift || return;
1373                                                  qq{<hr/><div class="date"><a href="/?date=$date">$date</a></div>};                                                  qq{<hr/><div class="date"><a href="$url?date=$date">$date</a></div>};
1374                                          },                                          },
1375                                          time => '<span class="time">%s</span> ',                                          time => '<span class="time">%s</span> ',
1376                                          time_channel => '<span class="channel">%s %s</span> ',                                          time_channel => '<span class="channel">%s %s</span> ',
# Line 905  sub root_handler { Line 1378  sub root_handler {
1378                                          me_nick => '***%s&nbsp;',                                          me_nick => '***%s&nbsp;',
1379                                          message => '<span class="message">%s</span>',                                          message => '<span class="message">%s</span>',
1380                                  },                                  },
1381                                  filter => {                                  filter => $filter,
                                         message => sub {  
                                                 my $m = shift || return;  
                                                 $m =~ s/($escape_re)/$escape{$1}/gs;  
                                                 $m =~ s#($RE{URI}{HTTP})#<a href="$1">$1</a>#gs;  
                                                 $m =~ s#$tag_regex#<a href="?tag=$1" class="tag">$1</a>#g;  
                                                 return $m;  
                                         },  
                                         nick => sub {  
                                                 my $n = shift || return;  
                                                 if (! $nick_enumerator{$n})  {  
                                                         my $max = scalar keys %nick_enumerator;  
                                                         $nick_enumerator{$n} = $max + 1;  
                                                 }  
                                                 return '<span class="nick col-' .  
                                                         ( $nick_enumerator{$n} % $max_color ) .  
                                                         '">' . $n . '</span>';  
                                         },  
                                 },  
1382                          )                          )
1383                  );                  );
1384          }          }
# Line 934  sub root_handler { Line 1389  sub root_handler {
1389          </body></html>};          </body></html>};
1390    
1391          $response->content( $html );          $response->content( $html );
1392            warn "<< ", $request->method, " ", $request->uri, " created ", length($html), " bytes\n";
1393          return RC_OK;          return RC_OK;
1394  }  }
1395    
1396  POE::Kernel->run;  POE::Kernel->run;
1397    
1398    =head1 TagCloud
1399    
1400    Extended L<HTML::TagCloud>
1401    
1402    =cut
1403    
1404    package TagCloud;
1405    use warnings;
1406    use strict;
1407    use HTML::TagCloud;
1408    use base 'HTML::TagCloud';
1409    use Data::Dump qw/dump/;
1410    
1411    =head2 html
1412    
1413    Generate html with number of tags in title of link
1414    
1415    =cut
1416    
1417    sub html {
1418            my($self, $limit) = @_;
1419            my @tags=$self->tags($limit);
1420    
1421            my $ntags = scalar(@tags);
1422            if ($ntags == 0) {
1423                    return "";
1424    #       } elsif ($ntags == 1) {
1425    #               my $tag = $tags[0];
1426    #               return qq{<div id="htmltagcloud"><span class="tagcloud1"><a href="}.
1427    #               $tag->{url}.qq{">}.$tag->{name}.qq{</a></span></div>\n};
1428            }
1429    
1430      my $html = qq{<div id="htmltagcloud">};
1431      foreach my $tag ( sort { lc($a->{name}) cmp lc($b->{name}) } @tags) {
1432        $html .=  sprintf(qq{<span class="tag tagcloud%d"><a href="%s" title="%s">%s</a></span>\n},
1433                    $tag->{level}, $tag->{url}, $tag->{count}, $tag->{name}
1434            );
1435      }
1436      $html .= qq{</div>};
1437      return $html;
1438    }
1439    
1440    =head2 last_tags
1441    
1442      my @tags = $cloud->last_tags;
1443    
1444    =cut
1445    
1446    my @last_tags;
1447    sub last_tags {
1448            return @last_tags;
1449    }
1450    
1451    =head2 add_tag
1452    
1453     $cloud->add_tag( id => 42, message => 'irc message', nick => 'foobar' [, me => 1 ] );
1454    
1455    =cut
1456    
1457    
1458    sub add_tag {
1459            my $self = shift;
1460            my $arg = {@_};
1461    
1462            return unless ($arg->{id} && $arg->{message});
1463    
1464            my $m = $arg->{message};
1465    
1466            my @tags;
1467    
1468            while ($m =~ s#$tag_regex##s) {
1469                    my $tag = $1;
1470                    next if (! $tag || $tag =~ m/https?:/i);
1471                    push @{ $tags->{$tag} }, $arg->{id};
1472                    #warn "+tag $tag: $arg->{id}\n";
1473                    $self->add($tag, "$url?tag=$tag", scalar @{$tags->{$tag}});
1474                    push @tags, $tag;
1475    
1476            }
1477    
1478            if ( @tags ) {
1479                    pop @last_tags if $#last_tags == $last_x_tags;
1480                    unshift @last_tags, { tags => [ @tags ], %$arg };
1481            }
1482    
1483    }
1484    
1485    =head2 seed_tags
1486    
1487    Read all tags from database and create in-memory cache for tags
1488    
1489    =cut
1490    
1491    sub seed_tags {
1492            my $self = shift;
1493            my $sth = $dbh->prepare(qq{ select id,message,nick,me,time from log where message like '%//%' order by time asc });
1494            $sth->execute;
1495            while (my $row = $sth->fetchrow_hashref) {
1496                    $self->add_tag( %$row );
1497            }
1498    
1499            foreach my $tag (keys %$tags) {
1500                    $self->add($tag, "$url?tag=$tag", scalar @{$tags->{$tag}});
1501            }
1502    }
1503    
Legend:
Removed from v.50  
changed lines
  Added in v.141
  ViewVC Help
Powered by ViewVC 1.1.26