/[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 86 by dpavlin, Thu Mar 6 22:57:16 2008 UTC revision 108 by dpavlin, Sun Mar 9 20:13:46 2008 UTC
# Line 2  Line 2 
2  use strict;  use strict;
3  $|++;  $|++;
4    
5    use POE qw(Component::IRC Component::Server::HTTP);
6    use HTTP::Status;
7    use DBI;
8    use Regexp::Common qw /URI/;
9    use CGI::Simple;
10    use HTML::TagCloud;
11    use POSIX qw/strftime/;
12    use HTML::CalendarMonthSimple;
13    use Getopt::Long;
14    use DateTime;
15    use URI::Escape;
16    use Data::Dump qw/dump/;
17    use DateTime::Format::ISO8601;
18    use Carp qw/confess/;
19    use XML::Feed;
20    use DateTime::Format::Flexible;
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  
   
 =item --follow=file.log  
   
 Follows new messages in file  
   
40  =back  =back
41    
42  =head1 DESCRIPTION  =head1 DESCRIPTION
# Line 41  chomp($HOSTNAME); Line 52  chomp($HOSTNAME);
52    
53  my $NICK = 'irc-logger';  my $NICK = 'irc-logger';
54  $NICK .= '-dev' if ($HOSTNAME =~ m/llin/);  $NICK .= '-dev' if ($HOSTNAME =~ m/llin/);
55  my $CONNECT =  my $CONNECT = {
56    {Server => 'irc.freenode.net',          Server => 'irc.freenode.net',
57     Nick => $NICK,          Nick => $NICK,
58     Ircname => "try /msg $NICK help",          Ircname => "try /msg $NICK help",
59    };  };
60  my $CHANNEL = '#razmjenavjestina';  my $CHANNEL = '#razmjenavjestina';
61  $CHANNEL = '#irc-logger' if ($HOSTNAME =~ m/llin/);  $CHANNEL = '#irc-logger' if ($HOSTNAME =~ m/llin/);
62  my $IRC_ALIAS = "log";  my $IRC_ALIAS = "log";
63    
64  # default log to follow and announce messages  if ( $HOSTNAME =~ m/lugarin/ ) {
65  my $follows_path = 'follows.log';          $CONNECT->{Server} = 'irc.carnet.hr';
66            $CHANNEL = '#riss';
67    }
68    
69    warn dump( $HOSTNAME, $CONNECT );
70    
71  my $DSN = 'DBI:Pg:dbname=' . $NICK;  my $DSN = 'DBI:Pg:dbname=' . $NICK;
72    
 # log output encoding  
 my $ENCODING = 'ISO-8859-2';  
73  my $TIMESTAMP = '%Y-%m-%d %H:%M:%S';  my $TIMESTAMP = '%Y-%m-%d %H:%M:%S';
74    
75  my $sleep_on_error = 5;  my $sleep_on_error = 5;
# Line 66  my $last_x_tags = 50; Line 79  my $last_x_tags = 50;
79    
80  # don't pull rss feeds more often than this  # don't pull rss feeds more often than this
81  my $rss_min_delay = 60;  my $rss_min_delay = 60;
 $rss_min_delay = 15;  
82    
83  my $http_port = $NICK =~ m/-dev/ ? 8001 : 8000;  my $http_port = $NICK =~ m/-dev/ ? 8001 : 8000;
84    
# Line 74  my $url = "http://$HOSTNAME:$http_port"; Line 86  my $url = "http://$HOSTNAME:$http_port";
86    
87  ## END CONFIG  ## END CONFIG
88    
 use POE qw(Component::IRC Wheel::FollowTail Component::Server::HTTP);  
 use HTTP::Status;  
 use DBI;  
 use Encode qw/from_to is_utf8/;  
 use Regexp::Common qw /URI/;  
 use CGI::Simple;  
 use HTML::TagCloud;  
 use POSIX qw/strftime/;  
 use HTML::CalendarMonthSimple;  
 use Getopt::Long;  
 use DateTime;  
 use URI::Escape;  
 use Data::Dump qw/dump/;  
 use DateTime::Format::ISO8601;  
 use Carp qw/confess/;  
 use XML::Feed;  
 use DateTime::Format::Flexible;  
   
89  my $use_twitter = 1;  my $use_twitter = 1;
90  eval { require Net::Twitter; };  eval { require Net::Twitter; };
91  $use_twitter = 0 if ($@);  $use_twitter = 0 if ($@);
# Line 100  my $import_dircproxy; Line 94  my $import_dircproxy;
94  my $log_path;  my $log_path;
95  GetOptions(  GetOptions(
96          'import-dircproxy:s' => \$import_dircproxy,          'import-dircproxy:s' => \$import_dircproxy,
         'follows:s' => \$follows_path,  
97          'log:s' => \$log_path,          'log:s' => \$log_path,
98  );  );
99    
100  $SIG{__DIE__} = sub {  #$SIG{__DIE__} = sub {
101          confess "fatal error";  #       confess "fatal error";
102  };  #};
103    
104  open(STDOUT, '>', $log_path) || warn "can't redirect log to $log_path: $!";  open(STDOUT, '>', $log_path) || warn "can't redirect log to $log_path: $!";
105    
106  sub _log {  sub _log {
107          my $out = strftime($TIMESTAMP,localtime()) . ' ' . join(" ",@_) . $/;          print strftime($TIMESTAMP,localtime()) . ' ' . join(" ",@_) . $/;
         from_to( $out, 'UTF-8', $ENCODING );  
         print $out;  
108  }  }
109    
 # LOG following  
   
 my %FOLLOWS =  
   (  
 #   ACCESS => "/var/log/apache/access.log",  
 #   ERROR => "/var/log/apache/error.log",  
   );  
   
 sub add_follow_path {  
         my $path = shift;  
         my $name = $path;  
         $name =~ s/\..*$//;  
         warn "# using $path to announce messages from $name\n";  
         $FOLLOWS{$name} = $path;  
 }  
   
 add_follow_path( $follows_path ) if ( -e $follows_path );  
   
110  # HTML formatters  # HTML formatters
111    
112  my %escape = ('<'=>'&lt;', '>'=>'&gt;', '&'=>'&amp;', '"'=>'&quot;');  my %escape = ('<'=>'&lt;', '>'=>'&gt;', '&'=>'&amp;', '"'=>'&quot;');
# Line 151  my $filter = { Line 124  my $filter = {
124                  # protect HTML from wiki modifications                  # protect HTML from wiki modifications
125                  sub e {                  sub e {
126                          my $t = shift;                          my $t = shift;
127                          return 'uri_unescape{' . uri_escape($t) . '}';                          return 'uri_unescape{' . uri_escape($t, '^a-zA-Z0-9') . '}';
128                  }                  }
129    
130                  $m =~ s/($escape_re)/$escape{$1}/gs;                  $m =~ s/($escape_re)/$escape{$1}/gs;
131                  $m =~ s#($RE{URI}{HTTP})#e(qq{<a href="$1">$1</a>})#egs ||                  $m =~ s#($RE{URI}{HTTP})#e(qq{<a href="$1">$1</a>})#egs;
132                  $m =~ s#\/(\w+)\/#<i>$1</i>#gs;                  $m =~ s#\/(\w+)\/#<i>$1</i>#gs;
133                  $m =~ s#$tag_regex#e(qq{<a href="$url?tag=$1" class="tag">$1</a>})#egs;                  $m =~ s#$tag_regex#e(qq{<a href="$url?tag=$1" class="tag">$1</a>})#egs;
134                  $m =~ s#\*(\w+)\*#<b>$1</b>#gs;                  $m =~ s#\*(\w+)\*#<b>$1</b>#gs;
# Line 212  create table feeds ( Line 185  create table feeds (
185          name text,          name text,
186          delay interval not null default '5 min',          delay interval not null default '5 min',
187          active boolean default true,          active boolean default true,
188            channel text not null,
189            nick text not null,
190            private boolean default false,
191          last_update timestamp default 'now()',          last_update timestamp default 'now()',
192          polls int default 0,          polls int default 0,
193          updates int default 0          updates int default 0
194  );  );
195  create unique index feeds_url on feeds(url);  create unique index feeds_url on feeds(url);
196  insert into feeds (url,name) values ('http://wiki.razmjenavjestina.org/feed/workspace/razmjenavjestina?category=Recent%20Changes','wiki');  insert into feeds (url,name,channel,nick) values ('http://wiki.razmjenavjestina.org/feed/workspace/razmjenavjestina?category=Recent%20Changes','wiki','$CHANNEL','dpavlin');
197          },          },
198  };  };
199    
# Line 261  sub meta { Line 237  sub meta {
237                  if ( $@ || ! $sth->rows ) {                  if ( $@ || ! $sth->rows ) {
238                          $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()) });
239                          $sth->execute( $value, $nick, $channel, $name );                          $sth->execute( $value, $nick, $channel, $name );
240                          _log "created $nick/$channel/$name = $value";                          warn "## created $nick/$channel/$name = $value\n";
241                  } else {                  } else {
242                          _log "updated $nick/$channel/$name = $value ";                          warn "## updated $nick/$channel/$name = $value\n";
243                  }                  }
244    
245                  return $value;                  return $value;
# Line 273  sub meta { Line 249  sub meta {
249                  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 = ? });
250                  $sth->execute( $nick, $channel, $name );                  $sth->execute( $nick, $channel, $name );
251                  my ($v,$c) = $sth->fetchrow_array;                  my ($v,$c) = $sth->fetchrow_array;
252                  _log "fetched $nick/$channel/$name = $v [$c]";                  warn "## fetched $nick/$channel/$name = $v [$c]\n";
253                  return ($v,$c) if wantarray;                  return ($v,$c) if wantarray;
254                  return $v;                  return $v;
255    
# Line 282  sub meta { Line 258  sub meta {
258    
259    
260    
261  my $sth = $dbh->prepare(qq{  my $sth_insert_log = $dbh->prepare(qq{
262  insert into log  insert into log
263          (channel, me, nick, message, time)          (channel, me, nick, message, time)
264  values (?,?,?,?,?)  values (?,?,?,?,?)
# Line 370  sub get_from_log { Line 346  sub get_from_log {
346    
347          my @where;          my @where;
348          my @args;          my @args;
349            my $msg;
350    
351          if (my $search = $args->{search}) {          if (my $search = $args->{search}) {
352                  $search =~ s/^\s+//;                  $search =~ s/^\s+//;
353                  $search =~ s/\s+$//;                  $search =~ s/\s+$//;
354                  push @where, 'message ilike ? or nick ilike ?';                  push @where, 'message ilike ? or nick ilike ?';
355                  push @args, ( ( '%' . $search . '%' ) x 2 );                  push @args, ( ( '%' . $search . '%' ) x 2 );
356                  _log "search for '$search'";                  $msg = "Search for '$search'";
357          }          }
358    
359          if ($args->{tag} && $tags->{ $args->{tag} }) {          if ($args->{tag} && $tags->{ $args->{tag} }) {
360                  push @where, 'id in (' . join(',', @{ $tags->{ $args->{tag} } }) . ')';                  push @where, 'id in (' . join(',', @{ $tags->{ $args->{tag} } }) . ')';
361                  _log "search for tags $args->{tag}";                  $msg = "Search for tags $args->{tag}";
362          }          }
363    
364          if (my $date = $args->{date} ) {          if (my $date = $args->{date} ) {
365                  $date = check_date( $date );                  $date = check_date( $date );
366                  push @where, 'date(time) = ?';                  push @where, 'date(time) = ?';
367                  push @args, $date;                  push @args, $date;
368                  _log "search for date $date";                  $msg = "search for date $date";
369          }          }
370    
371          $sql .= " where " . join(" and ", @where) if @where;          $sql .= " where " . join(" and ", @where) if @where;
# Line 402  sub get_from_log { Line 379  sub get_from_log {
379          eval { $sth->execute( @args ) };          eval { $sth->execute( @args ) };
380          return if $@;          return if $@;
381    
382            my $nr_results = $sth->rows;
383    
384          my $last_row = {          my $last_row = {
385                  date => '',                  date => '',
386                  time => '',                  time => '',
# Line 422  sub get_from_log { Line 401  sub get_from_log {
401    
402          return @rows if ($args->{full_rows});          return @rows if ($args->{full_rows});
403    
404          my @msgs = (          $msg .= ' produced ' . (
405                  "Showing " . ($#rows + 1) . " messages..."                  $nr_results == 0 ? 'no results' :
406                    $nr_results == 0 ? 'one result' :
407                            $nr_results . ' results'
408          );          );
409    
410            my @msgs = ( $msg );
411    
412          if ($context) {          if ($context) {
413                  my @ids = @rows;                  my @ids = @rows;
414                  @rows = ();                  @rows = ();
# Line 482  sub get_from_log { Line 465  sub get_from_log {
465  #                       $row->{nick} = $nick;  #                       $row->{nick} = $nick;
466  #               }  #               }
467    
468                    $append = 0 if $row->{me};
469    
470                  if ($last_row->{nick} ne $nick) {                  if ($last_row->{nick} ne $nick) {
471                          # 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
472                          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 534  sub add_tag { Line 519  sub add_tag {
519          return unless ($arg->{id} && $arg->{message});          return unless ($arg->{id} && $arg->{message});
520    
521          my $m = $arg->{message};          my $m = $arg->{message};
         from_to('UTF-8', 'iso-8859-2', $m) if (is_utf8($m));  
522    
523          my @tags;          my @tags;
524    
# Line 603  sub save_message { Line 587  sub save_message {
587                  $a->{me} ? "***" . $a->{nick} : "<" . $a->{nick} . ">",                  $a->{me} ? "***" . $a->{nick} : "<" . $a->{nick} . ">",
588                  " " . $a->{message};                  " " . $a->{message};
589    
590          $sth->execute($a->{channel}, $a->{me}, $a->{nick}, $a->{message}, $a->{time});          $sth_insert_log->execute($a->{channel}, $a->{me}, $a->{nick}, $a->{message}, $a->{time});
591          add_tag( id => $dbh->last_insert_id(undef,undef,"log",undef), %$a );          add_tag( id => $dbh->last_insert_id(undef,undef,"log",undef), %$a );
592  }  }
593    
# Line 646  if ($import_dircproxy) { Line 630  if ($import_dircproxy) {
630  # RSS follow  # RSS follow
631  #  #
632    
633  my $_rss;  my $_stat;
634    
635    
636  sub rss_fetch {  sub rss_fetch {
# Line 655  sub rss_fetch { Line 639  sub rss_fetch {
639          # how many messages to send out when feed is seen for the first time?          # how many messages to send out when feed is seen for the first time?
640          my $send_rss_msgs = 1;          my $send_rss_msgs = 1;
641    
642            _log "RSS fetch", $args->{url};
643    
644          my $feed = XML::Feed->parse(URI->new( $args->{url} ));          my $feed = XML::Feed->parse(URI->new( $args->{url} ));
645          if ( ! $feed ) {          if ( ! $feed ) {
646                  _log("can't fetch RSS ", $args->{url});                  _log("can't fetch RSS ", $args->{url});
647                  return;                  return;
648          }          }
649          my $updates = 0;  
650            my ( $total, $updates ) = ( 0, 0 );
651          for my $entry ($feed->entries) {          for my $entry ($feed->entries) {
652                    $total++;
653    
654                  # seen allready?                  # seen allready?
655                  return if $_rss->{$feed->link}->{seen}->{$entry->id}++ > 0;                  next if $_stat->{rss}->{seen}->{$args->{channel}}->{$feed->link}->{$entry->id}++ > 0;
656    
657                  sub prefix {                  sub prefix {
658                          my ($txt,$var) = @_;                          my ($txt,$var) = @_;
659                            $var =~ s/\s+/ /gs;
660                          $var =~ s/^\s+//g;                          $var =~ s/^\s+//g;
661                            $var =~ s/\s+$//g;
662                          return $txt . $var if $var;                          return $txt . $var if $var;
663                  }                  }
664    
665                    # fix absolute and relative links to feed entries
666                    my $link = $entry->link;
667                    if ( $link =~ m!^/! ) {
668                            my $host = $args->{url};
669                            $host =~ s!^(http://[^/]+).*$!$1!;      #!vim
670                            $link = "$host/$link";
671                    } elsif ( $link !~ m!^http! ) {
672                            $link = $args->{url} . $link;
673                    }
674    
675                  my $msg;                  my $msg;
676                  $msg .= prefix( 'From: ' , $feed->title );                  $msg .= prefix( 'From: ' , $args->{name} || $feed->title );
677                  $msg .= prefix( ' by ' , $entry->author );                  $msg .= prefix( ' by ' , $entry->author );
678                  $msg .= prefix( ' -- ' , $entry->link );                  $msg .= prefix( ' | ' , $entry->title );
679                    $msg .= prefix( ' | ' , $link );
680  #               $msg .= prefix( ' id ' , $entry->id );  #               $msg .= prefix( ' id ' , $entry->id );
681    
682                  if ( $args->{kernel} && $send_rss_msgs ) {                  if ( $args->{kernel} && $send_rss_msgs ) {
                         warn "# sending to $CHANNEL\n";  
683                          $send_rss_msgs--;                          $send_rss_msgs--;
684                          $args->{kernel}->post( $IRC_ALIAS => notice => $CHANNEL, $msg );                          if ( ! $args->{private} ) {
685                                    # FIXME bug! should be save_message
686    #                               save_message( channel => $args->{channel}, me => 1, nick => $NICK, message => $msg );
687                                    $sth_insert_log->execute( $args->{channel}, 1, $NICK, $msg, 'now()' );
688                            }
689                            my ( $type, $to ) = ( 'notice', $args->{channel} );
690                            ( $type, $to ) = ( 'privmsg', $args->{nick} ) if $args->{private};
691                            _log(">> $type $to |", $msg);
692                            $args->{kernel}->post( $IRC_ALIAS => $type => $to, $msg );
693                          $updates++;                          $updates++;
                         save_message( channel => $CHANNEL, me => 1, nick => $NICK, message => $msg );  
                         _log('RSS', $msg);  
694                  }                  }
695          }          }
696    
# Line 693  sub rss_fetch { Line 699  sub rss_fetch {
699          $sql .= qq{where id = } . $args->{id};          $sql .= qq{where id = } . $args->{id};
700          eval { $dbh->do( $sql ) };          eval { $dbh->do( $sql ) };
701    
702            _log "RSS got $total items of which $updates new";
703    
704          return $updates;          return $updates;
705  }  }
706    
707  sub rss_fetch_all {  sub rss_fetch_all {
708          my $kernel = shift;          my $kernel = shift;
709          my $sql = qq{          my $sql = qq{
710                  select id, url, name                  select id, url, name, channel, nick, private
711                  from feeds                  from feeds
712                  where active is true                  where active is true
713          };          };
# Line 710  sub rss_fetch_all { Line 718  sub rss_fetch_all {
718          warn "# ",$sth->rows," active RSS feeds\n";          warn "# ",$sth->rows," active RSS feeds\n";
719          my $count = 0;          my $count = 0;
720          while (my $row = $sth->fetchrow_hashref) {          while (my $row = $sth->fetchrow_hashref) {
                 warn "+++ fetch RSS feed: ",dump( $row );  
721                  $row->{kernel} = $kernel if $kernel;                  $row->{kernel} = $kernel if $kernel;
722                  $count += rss_fetch( $row );                  $count += rss_fetch( $row );
723          }          }
724          return "OK, fetched $count posts from " . $sth->rows . " feeds";          return "OK, fetched $count posts from " . $sth->rows . " feeds";
725  }  }
726    
 my $rss_last_poll = time();  
727    
728  sub rss_check_updates {  sub rss_check_updates {
729          my $kernel = shift;          my $kernel = shift;
730          my $t = time();          $_stat->{rss}->{last_poll} ||= time();
731          if ( $rss_last_poll - $t > $rss_min_delay ) {          my $dt = time() - $_stat->{rss}->{last_poll};
732                  $rss_last_poll = $t;          warn "## rss_check_updates $dt > $rss_min_delay\n";
733            if ( $dt > $rss_min_delay ) {
734                    $_stat->{rss}->{last_poll} = time();
735                  _log rss_fetch_all( $kernel );                  _log rss_fetch_all( $kernel );
736          }          }
737  }  }
# Line 735  _log rss_fetch_all; Line 743  _log rss_fetch_all;
743  # POE handing part  # POE handing part
744  #  #
745    
 my $SKIPPING = 0;               # if skipping, how many we've done  
 my $SEND_QUEUE;                 # cache  
746  my $ping;                                               # ping stats  my $ping;                                               # ping stats
747    
748  POE::Component::IRC->new($IRC_ALIAS);  POE::Component::IRC->new($IRC_ALIAS);
# Line 748  POE::Session->create( inline_states => { Line 754  POE::Session->create( inline_states => {
754      },      },
755      irc_255 => sub {    # server is done blabbing      irc_255 => sub {    # server is done blabbing
756                  $_[KERNEL]->post($IRC_ALIAS => join => $CHANNEL);                  $_[KERNEL]->post($IRC_ALIAS => join => $CHANNEL);
                 $_[KERNEL]->post($IRC_ALIAS => join => '#logger');  
                 $_[KERNEL]->yield("heartbeat"); # start heartbeat  
                 $_[KERNEL]->yield("my_add", $_) for keys %FOLLOWS;  
757                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "IDENTIFY $NICK" );                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "IDENTIFY $NICK" );
758      },      },
759      irc_public => sub {      irc_public => sub {
# Line 761  POE::Session->create( inline_states => { Line 764  POE::Session->create( inline_states => {
764    
765                  save_message( channel => $channel, me => 0, nick => $nick, message => $msg);                  save_message( channel => $channel, me => 0, nick => $nick, message => $msg);
766                  meta( $nick, $channel, 'last-msg', $msg );                  meta( $nick, $channel, 'last-msg', $msg );
767                    rss_check_updates( $kernel );
768      },      },
769      irc_ctcp_action => sub {      irc_ctcp_action => sub {
770                  my $kernel = $_[KERNEL];                  my $kernel = $_[KERNEL];
# Line 930  POE::Session->create( inline_states => { Line 934  POE::Session->create( inline_states => {
934                  } elsif ($msg =~ m/^rss-update/) {                  } elsif ($msg =~ m/^rss-update/) {
935                          $res = rss_fetch_all( $_[KERNEL] );                          $res = rss_fetch_all( $_[KERNEL] );
936                  } elsif ($msg =~ m/^rss-clean/) {                  } elsif ($msg =~ m/^rss-clean/) {
937                          $_rss = undef;                          $_stat->{rss} = undef;
938                            $dbh->do( qq{ update feeds set last_update = now() - delay } );
939                          $res = "OK, cleaned RSS cache";                          $res = "OK, cleaned RSS cache";
940                  } elsif ($msg =~ m!^rss-(add|remove|stop|start)\s+(http://\S+)\s*(.*)!) {                  } elsif ($msg =~ m/^rss-list/) {
941                            my $sth = $dbh->prepare(qq{ select url,name,last_update,active,channel,nick,private from feeds });
942                            $sth->execute;
943                            while (my @row = $sth->fetchrow_array) {
944                                    $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, join(' | ',@row) );
945                            }
946                            $res = '';
947                    } elsif ($msg =~ m!^rss-(add|remove|stop|start)(?:-(private))?\s+(http://\S+)\s*(.*)!) {
948                            my ( $command, $sub, $url, $arg ) = ( $1,$2,$3,$4 );
949    
950                            my $channel = $1 if ( $arg =~ s/\s*(#\S+)\s*// );
951                            $channel = $nick if $sub eq 'private';
952    
953                          my $sql = {                          my $sql = {
954                                  add             => qq{ insert into feeds (url,name) values (?,?) },                                  add     => qq{ insert into feeds (url,name,channel,nick,private) values (?,?,?,?,?) },
955  #                               remove  => qq{ delete from feeds                                where url = ? and name = ? },  #                               remove  => qq{ delete from feeds                                where url = ? and name = ? },
956                                  start   => qq{ update feeds set active = true   where url = ? -- ? },                                  start   => qq{ update feeds set active = true   where url = ? },
957                                  stop    => qq{ update feeds set active = false  where url = ? -- ? },                                  stop    => qq{ update feeds set active = false  where url = ? },
                                   
958                          };                          };
959                          if (my $q = $sql->{$1} ) {  
960                            if ( $command eq 'add' && ! $channel ) {
961                                    $res = "ERROR: got '$msg' which doesn't have #channel in it, ignoring!";
962                            } elsif (my $q = $sql->{$command} ) {
963                                  my $sth = $dbh->prepare( $q );                                  my $sth = $dbh->prepare( $q );
964                                  warn "## SQL $q ( $2 | $3 )\n";                                  my @data = ( $url );
965                                  eval { $sth->execute( $2, $3 ) };                                  if ( $command eq 'add' ) {
966                                            push @data, ( $arg, $channel, $nick, $sub eq 'private' ? 1 : 0 );
967                                    }
968                                    warn "## $command SQL $q with ",dump( @data ),"\n";
969                                    eval { $sth->execute( @data ) };
970                                    if ($@) {
971                                            $res = "ERROR: $@";
972                                    } else {
973                                            $res = "OK, RSS [$command|$sub|$url|$arg]";
974                                    }
975                            } else {
976                                    $res = "ERROR: don't know what to do with: $msg";
977                          }                          }
   
                         $res ||= "OK, RSS $1 : $2 - $3";  
978                  }                  }
979    
980                  if ($res) {                  if ($res) {
# Line 956  POE::Session->create( inline_states => { Line 984  POE::Session->create( inline_states => {
984    
985                  rss_check_updates( $_[KERNEL] );                  rss_check_updates( $_[KERNEL] );
986          },          },
987            irc_372 => sub {
988                    _log "<< motd",$_[ARG0],$_[ARG1];
989            },
990            irc_375 => sub {
991                    _log "<< motd", $_[ARG0], "start";
992            },
993            irc_376 => sub {
994                    _log "<< motd", $_[ARG0], "end";
995            },
996          irc_477 => sub {          irc_477 => sub {
997                  _log "# irc_477: ",$_[ARG1];                  _log "<< irc_477: ",$_[ARG1];
998                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "register $NICK" );                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "register $NICK" );
999          },          },
1000          irc_505 => sub {          irc_505 => sub {
1001                  _log "# irc_505: ",$_[ARG1];                  _log "<< irc_505: ",$_[ARG1];
1002                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "register $NICK" );                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "register $NICK" );
1003  #               $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "set hide email on" );  #               $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "set hide email on" );
1004  #               $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "set email dpavlin\@rot13.org" );  #               $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "set email dpavlin\@rot13.org" );
1005          },          },
1006          irc_registered => sub {          irc_registered => sub {
1007                  _log "## registrated $NICK";                  _log "## registrated $NICK, /msg nickserv IDENTIFY $NICK";
1008                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "IDENTIFY $NICK" );                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "IDENTIFY $NICK" );
1009          },          },
1010          irc_disconnected => sub {          irc_disconnected => sub {
1011                  _log "## disconnected, reconnecting again";                  _log "## disconnected.. sleeping for $sleep_on_error seconds and reconnecting again";
1012                  $_[KERNEL]->post($IRC_ALIAS => connect => $CONNECT);                  sleep($sleep_on_error);
1013                    $_[KERNEL]->post( $IRC_ALIAS => connect => $CONNECT);
1014          },          },
1015          irc_socketerr => sub {          irc_socketerr => sub {
1016                  _log "## socket error... sleeping for $sleep_on_error seconds and retry";                  _log "## socket error... sleeping for $sleep_on_error seconds and retry";
1017                  sleep($sleep_on_error);                  sleep($sleep_on_error);
1018                  $_[KERNEL]->post($IRC_ALIAS => connect => $CONNECT);                  $_[KERNEL]->post( $IRC_ALIAS => connect => $CONNECT);
1019          },          },
1020  #       irc_433 => sub {  #       irc_433 => sub {
1021  #               print "# irc_433: ",$_[ARG1], "\n";  #               print "# irc_433: ",$_[ARG1], "\n";
1022  #               warn "## indetify $NICK\n";  #               warn "## indetify $NICK\n";
1023  #               $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "IDENTIFY $NICK" );  #               $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "IDENTIFY $NICK" );
1024  #       },  #       },
1025    #       irc_451 # please register
1026            irc_snotice => sub {
1027                    _log "<< snotice",$_[ARG0];
1028                    if ( $_[ARG0] =~ m!/(QUOTE)\s+(PASS\s+\d+)!i ) {
1029                            warn ">> $1 | $2\n";
1030                            $_[KERNEL]->post( $IRC_ALIAS => lc($1) => $2);
1031                    }
1032            },
1033      _child => sub {},      _child => sub {},
1034      _default => sub {      _default => sub {
1035                  _log sprintf "sID:%s %s %s",                  _log sprintf "sID:%s %s %s",
# Line 993  POE::Session->create( inline_states => { Line 1039  POE::Session->create( inline_states => {
1039                          "";                          "";
1040        0;                        # false for signals        0;                        # false for signals
1041      },      },
     my_add => sub {  
       my $trailing = $_[ARG0];  
       my $session = $_[SESSION];  
       POE::Session->create  
           (inline_states =>  
            {_start => sub {  
               $_[HEAP]->{wheel} =  
                 POE::Wheel::FollowTail->new  
                     (  
                      Filename => $FOLLOWS{$trailing},  
                      InputEvent => 'got_line',  
                     );  
                                 warn "+++ following $trailing at $FOLLOWS{$trailing}\n";  
             },  
             got_line => sub {  
                                 warn "+++ $trailing : $_[ARG0]\n";  
                                 $_[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);  
     }  
1042     },     },
1043    );    );
1044    
# Line 1127  sub root_handler { Line 1112  sub root_handler {
1112          }          }
1113    
1114          my $search = $q->param('search') || $q->param('grep') || '';          my $search = $q->param('search') || $q->param('grep') || '';
1115            my $r_url = $request->url;
1116    
1117          if ($request->url =~ m#/rss(?:/(tags|last-tag|follow.*)\w*(?:=(\d+))?)?#i) {          my @commands = qw( tags last-tag follow stat );
1118            my $commands_re = join('|',@commands);
1119    
1120            if ($r_url =~ m#/rss(?:/($commands_re.*)\w*(?:=(\d+))?)?#i) {
1121                  my $show = lc($1);                  my $show = lc($1);
1122                  my $nr = $2;                  my $nr = $2;
1123    
# Line 1142  sub root_handler { Line 1131  sub root_handler {
1131                  my $feed = XML::Feed->new( $type );                  my $feed = XML::Feed->new( $type );
1132                  $feed->link( $url );                  $feed->link( $url );
1133    
1134                    my $rc = RC_OK;
1135    
1136                  if ( $show eq 'tags' ) {                  if ( $show eq 'tags' ) {
1137                          $nr ||= 50;                          $nr ||= 50;
1138                          $feed->title( "tags from $CHANNEL" );                          $feed->title( "tags from $CHANNEL" );
# Line 1211  sub root_handler { Line 1202  sub root_handler {
1202                                  $feed->add_entry( $feed_entry );                                  $feed->add_entry( $feed_entry );
1203                          }                          }
1204    
1205                    } elsif ( $show =~ m/^stat/ ) {
1206    
1207                            my $feed_entry = XML::Feed::Entry->new($type);
1208                            $feed_entry->title( "Internal stats" );
1209                            $feed_entry->content(
1210                                    '<![CDATA[<pre>' . dump( $_stat ) . '</pre>]]>'
1211                            );
1212                            $feed->add_entry( $feed_entry );
1213    
1214                  } else {                  } else {
1215                          _log "unknown rss request ",$request->url;                          _log "unknown rss request $r_url";
1216                          return RC_DENY;                          $feed->title( "unknown $r_url" );
1217                            foreach my $c ( @commands ) {
1218                                    my $feed_entry = XML::Feed::Entry->new($type);
1219                                    $feed_entry->title( "rss/$c" );
1220                                    $feed_entry->link( "$url/rss/$c" );
1221                                    $feed->add_entry( $feed_entry );
1222                            }
1223                            $rc = RC_DENY;
1224                  }                  }
1225    
1226                  $response->content( $feed->as_xml );                  $response->content( $feed->as_xml );
1227                  return RC_OK;                  return $rc;
1228          }          }
1229    
1230          if ( $@ ) {          if ( $@ ) {
# Line 1275  sub root_handler { Line 1282  sub root_handler {
1282                          }                          }
1283                          $cal->setcontent($dd, qq[                          $cal->setcontent($dd, qq[
1284                                  <a href="$url?date=$row->{date}">$row->{nr}</a><br/>$row->{len}                                  <a href="$url?date=$row->{date}">$row->{nr}</a><br/>$row->{len}
1285                          ]);                          ]) if $cal;
1286                                                    
1287                  }                  }
1288                  $html .= qq{<td valign="top">} . $cal->as_HTML() . qq{</td></tr></table>};                  $html .= qq{<td valign="top">} . $cal->as_HTML() . qq{</td></tr></table>};
Legend:
Removed from v.86  
changed lines
  Added in v.108
  ViewVC Help
Powered by ViewVC 1.1.26