/[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 109 by dpavlin, Sun Mar 9 21:13:15 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 36  log all conversation on irc channel Line 47  log all conversation on irc channel
47    
48  ## CONFIG  ## CONFIG
49    
50    my $irc_config = {
51            nick => 'irc-logger',
52            server => 'irc.freenode.net',
53            port => 6667,
54            ircname => 'Anna the bot: try /msg irc-logger help',
55    };
56    
57  my $HOSTNAME = `hostname -f`;  my $HOSTNAME = `hostname -f`;
58  chomp($HOSTNAME);  chomp($HOSTNAME);
59    
60  my $NICK = 'irc-logger';  
 $NICK .= '-dev' if ($HOSTNAME =~ m/llin/);  
 my $CONNECT =  
   {Server => 'irc.freenode.net',  
    Nick => $NICK,  
    Ircname => "try /msg $NICK help",  
   };  
61  my $CHANNEL = '#razmjenavjestina';  my $CHANNEL = '#razmjenavjestina';
 $CHANNEL = '#irc-logger' if ($HOSTNAME =~ m/llin/);  
 my $IRC_ALIAS = "log";  
62    
63  # default log to follow and announce messages  if ( $HOSTNAME =~ m/llin/ ) {
64  my $follows_path = 'follows.log';          $irc_config->{nick} = 'irc-logger-dev';
65    #       $irc_config = {
66    #               nick => 'irc-logger-dev',
67    #               server => 'localhost',
68    #               port => 6668,
69    #       };
70            $CHANNEL = '#irc-logger';
71    } elsif ( $HOSTNAME =~ m/lugarin/ ) {
72            $irc_config->{server} = 'irc.carnet.hr';
73            $CHANNEL = '#riss';
74    }
75    
76    my @channels = ( $CHANNEL );
77    
78    warn "# config = ", dump( $irc_config ), $/;
79    
80    my $NICK = $irc_config->{nick} or die "no nick?";
81    
82  my $DSN = 'DBI:Pg:dbname=' . $NICK;  my $DSN = 'DBI:Pg:dbname=' . $NICK;
83    
 # log output encoding  
 my $ENCODING = 'ISO-8859-2';  
84  my $TIMESTAMP = '%Y-%m-%d %H:%M:%S';  my $TIMESTAMP = '%Y-%m-%d %H:%M:%S';
85    
86  my $sleep_on_error = 5;  my $sleep_on_error = 5;
# Line 66  my $last_x_tags = 50; Line 90  my $last_x_tags = 50;
90    
91  # don't pull rss feeds more often than this  # don't pull rss feeds more often than this
92  my $rss_min_delay = 60;  my $rss_min_delay = 60;
 $rss_min_delay = 15;  
93    
94  my $http_port = $NICK =~ m/-dev/ ? 8001 : 8000;  my $http_port = $NICK =~ m/-dev/ ? 8001 : 8000;
95    
# Line 74  my $url = "http://$HOSTNAME:$http_port"; Line 97  my $url = "http://$HOSTNAME:$http_port";
97    
98  ## END CONFIG  ## END CONFIG
99    
 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;  
   
100  my $use_twitter = 1;  my $use_twitter = 1;
101  eval { require Net::Twitter; };  eval { require Net::Twitter; };
102  $use_twitter = 0 if ($@);  $use_twitter = 0 if ($@);
# Line 100  my $import_dircproxy; Line 105  my $import_dircproxy;
105  my $log_path;  my $log_path;
106  GetOptions(  GetOptions(
107          'import-dircproxy:s' => \$import_dircproxy,          'import-dircproxy:s' => \$import_dircproxy,
         'follows:s' => \$follows_path,  
108          'log:s' => \$log_path,          'log:s' => \$log_path,
109  );  );
110    
111  $SIG{__DIE__} = sub {  #$SIG{__DIE__} = sub {
112          confess "fatal error";  #       confess "fatal error";
113  };  #};
114    
115  open(STDOUT, '>', $log_path) || warn "can't redirect log to $log_path: $!";  open(STDOUT, '>', $log_path) || warn "can't redirect log to $log_path: $!";
116    
117  sub _log {  sub _log {
118          my $out = strftime($TIMESTAMP,localtime()) . ' ' . join(" ",@_) . $/;          print strftime($TIMESTAMP,localtime()) . ' ' . join(" ",@_) . $/;
         from_to( $out, 'UTF-8', $ENCODING );  
         print $out;  
 }  
   
 # 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;  
119  }  }
120    
 add_follow_path( $follows_path ) if ( -e $follows_path );  
   
121  # HTML formatters  # HTML formatters
122    
123  my %escape = ('<'=>'&lt;', '>'=>'&gt;', '&'=>'&amp;', '"'=>'&quot;');  my %escape = ('<'=>'&lt;', '>'=>'&gt;', '&'=>'&amp;', '"'=>'&quot;');
# Line 151  my $filter = { Line 135  my $filter = {
135                  # protect HTML from wiki modifications                  # protect HTML from wiki modifications
136                  sub e {                  sub e {
137                          my $t = shift;                          my $t = shift;
138                          return 'uri_unescape{' . uri_escape($t) . '}';                          return 'uri_unescape{' . uri_escape($t, '^a-zA-Z0-9') . '}';
139                  }                  }
140    
141                  $m =~ s/($escape_re)/$escape{$1}/gs;                  $m =~ s/($escape_re)/$escape{$1}/gs;
142                  $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;
143                  $m =~ s#\/(\w+)\/#<i>$1</i>#gs;                  $m =~ s#\/(\w+)\/#<i>$1</i>#gs;
144                  $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;
145                  $m =~ s#\*(\w+)\*#<b>$1</b>#gs;                  $m =~ s#\*(\w+)\*#<b>$1</b>#gs;
# Line 212  create table feeds ( Line 196  create table feeds (
196          name text,          name text,
197          delay interval not null default '5 min',          delay interval not null default '5 min',
198          active boolean default true,          active boolean default true,
199            channel text not null,
200            nick text not null,
201            private boolean default false,
202          last_update timestamp default 'now()',          last_update timestamp default 'now()',
203          polls int default 0,          polls int default 0,
204          updates int default 0          updates int default 0
205  );  );
206  create unique index feeds_url on feeds(url);  create unique index feeds_url on feeds(url);
207  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');
208          },          },
209  };  };
210    
# Line 261  sub meta { Line 248  sub meta {
248                  if ( $@ || ! $sth->rows ) {                  if ( $@ || ! $sth->rows ) {
249                          $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()) });
250                          $sth->execute( $value, $nick, $channel, $name );                          $sth->execute( $value, $nick, $channel, $name );
251                          _log "created $nick/$channel/$name = $value";                          warn "## created $nick/$channel/$name = $value\n";
252                  } else {                  } else {
253                          _log "updated $nick/$channel/$name = $value ";                          warn "## updated $nick/$channel/$name = $value\n";
254                  }                  }
255    
256                  return $value;                  return $value;
# Line 273  sub meta { Line 260  sub meta {
260                  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 = ? });
261                  $sth->execute( $nick, $channel, $name );                  $sth->execute( $nick, $channel, $name );
262                  my ($v,$c) = $sth->fetchrow_array;                  my ($v,$c) = $sth->fetchrow_array;
263                  _log "fetched $nick/$channel/$name = $v [$c]";                  warn "## fetched $nick/$channel/$name = $v [$c]\n";
264                  return ($v,$c) if wantarray;                  return ($v,$c) if wantarray;
265                  return $v;                  return $v;
266    
# Line 282  sub meta { Line 269  sub meta {
269    
270    
271    
272  my $sth = $dbh->prepare(qq{  my $sth_insert_log = $dbh->prepare(qq{
273  insert into log  insert into log
274          (channel, me, nick, message, time)          (channel, me, nick, message, time)
275  values (?,?,?,?,?)  values (?,?,?,?,?)
# Line 370  sub get_from_log { Line 357  sub get_from_log {
357    
358          my @where;          my @where;
359          my @args;          my @args;
360            my $msg;
361    
362          if (my $search = $args->{search}) {          if (my $search = $args->{search}) {
363                  $search =~ s/^\s+//;                  $search =~ s/^\s+//;
364                  $search =~ s/\s+$//;                  $search =~ s/\s+$//;
365                  push @where, 'message ilike ? or nick ilike ?';                  push @where, 'message ilike ? or nick ilike ?';
366                  push @args, ( ( '%' . $search . '%' ) x 2 );                  push @args, ( ( '%' . $search . '%' ) x 2 );
367                  _log "search for '$search'";                  $msg = "Search for '$search'";
368          }          }
369    
370          if ($args->{tag} && $tags->{ $args->{tag} }) {          if ($args->{tag} && $tags->{ $args->{tag} }) {
371                  push @where, 'id in (' . join(',', @{ $tags->{ $args->{tag} } }) . ')';                  push @where, 'id in (' . join(',', @{ $tags->{ $args->{tag} } }) . ')';
372                  _log "search for tags $args->{tag}";                  $msg = "Search for tags $args->{tag}";
373          }          }
374    
375          if (my $date = $args->{date} ) {          if (my $date = $args->{date} ) {
376                  $date = check_date( $date );                  $date = check_date( $date );
377                  push @where, 'date(time) = ?';                  push @where, 'date(time) = ?';
378                  push @args, $date;                  push @args, $date;
379                  _log "search for date $date";                  $msg = "search for date $date";
380          }          }
381    
382          $sql .= " where " . join(" and ", @where) if @where;          $sql .= " where " . join(" and ", @where) if @where;
# Line 402  sub get_from_log { Line 390  sub get_from_log {
390          eval { $sth->execute( @args ) };          eval { $sth->execute( @args ) };
391          return if $@;          return if $@;
392    
393            my $nr_results = $sth->rows;
394    
395          my $last_row = {          my $last_row = {
396                  date => '',                  date => '',
397                  time => '',                  time => '',
# Line 422  sub get_from_log { Line 412  sub get_from_log {
412    
413          return @rows if ($args->{full_rows});          return @rows if ($args->{full_rows});
414    
415          my @msgs = (          $msg .= ' produced ' . (
416                  "Showing " . ($#rows + 1) . " messages..."                  $nr_results == 0 ? 'no results' :
417                    $nr_results == 0 ? 'one result' :
418                            $nr_results . ' results'
419          );          );
420    
421            my @msgs = ( $msg );
422    
423          if ($context) {          if ($context) {
424                  my @ids = @rows;                  my @ids = @rows;
425                  @rows = ();                  @rows = ();
# Line 482  sub get_from_log { Line 476  sub get_from_log {
476  #                       $row->{nick} = $nick;  #                       $row->{nick} = $nick;
477  #               }  #               }
478    
479                    $append = 0 if $row->{me};
480    
481                  if ($last_row->{nick} ne $nick) {                  if ($last_row->{nick} ne $nick) {
482                          # 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
483                          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 530  sub add_tag {
530          return unless ($arg->{id} && $arg->{message});          return unless ($arg->{id} && $arg->{message});
531    
532          my $m = $arg->{message};          my $m = $arg->{message};
         from_to('UTF-8', 'iso-8859-2', $m) if (is_utf8($m));  
533    
534          my @tags;          my @tags;
535    
# Line 603  sub save_message { Line 598  sub save_message {
598                  $a->{me} ? "***" . $a->{nick} : "<" . $a->{nick} . ">",                  $a->{me} ? "***" . $a->{nick} : "<" . $a->{nick} . ">",
599                  " " . $a->{message};                  " " . $a->{message};
600    
601          $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});
602          add_tag( id => $dbh->last_insert_id(undef,undef,"log",undef), %$a );          add_tag( id => $dbh->last_insert_id(undef,undef,"log",undef), %$a );
603  }  }
604    
# Line 646  if ($import_dircproxy) { Line 641  if ($import_dircproxy) {
641  # RSS follow  # RSS follow
642  #  #
643    
644  my $_rss;  my $_stat;
645    
646    
647  sub rss_fetch {  sub rss_fetch {
# Line 655  sub rss_fetch { Line 650  sub rss_fetch {
650          # 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?
651          my $send_rss_msgs = 1;          my $send_rss_msgs = 1;
652    
653            _log "RSS fetch", $args->{url};
654    
655          my $feed = XML::Feed->parse(URI->new( $args->{url} ));          my $feed = XML::Feed->parse(URI->new( $args->{url} ));
656          if ( ! $feed ) {          if ( ! $feed ) {
657                  _log("can't fetch RSS ", $args->{url});                  _log("can't fetch RSS ", $args->{url});
658                  return;                  return;
659          }          }
660          my $updates = 0;  
661            my ( $total, $updates ) = ( 0, 0 );
662          for my $entry ($feed->entries) {          for my $entry ($feed->entries) {
663                    $total++;
664    
665                  # seen allready?                  # seen allready?
666                  return if $_rss->{$feed->link}->{seen}->{$entry->id}++ > 0;                  next if $_stat->{rss}->{seen}->{$args->{channel}}->{$feed->link}->{$entry->id}++ > 0;
667    
668                  sub prefix {                  sub prefix {
669                          my ($txt,$var) = @_;                          my ($txt,$var) = @_;
670                            $var =~ s/\s+/ /gs;
671                          $var =~ s/^\s+//g;                          $var =~ s/^\s+//g;
672                            $var =~ s/\s+$//g;
673                          return $txt . $var if $var;                          return $txt . $var if $var;
674                  }                  }
675    
676                    # fix absolute and relative links to feed entries
677                    my $link = $entry->link;
678                    if ( $link =~ m!^/! ) {
679                            my $host = $args->{url};
680                            $host =~ s!^(http://[^/]+).*$!$1!;      #!vim
681                            $link = "$host/$link";
682                    } elsif ( $link !~ m!^http! ) {
683                            $link = $args->{url} . $link;
684                    }
685    
686                  my $msg;                  my $msg;
687                  $msg .= prefix( 'From: ' , $feed->title );                  $msg .= prefix( 'From: ' , $args->{name} || $feed->title );
688                  $msg .= prefix( ' by ' , $entry->author );                  $msg .= prefix( ' by ' , $entry->author );
689                  $msg .= prefix( ' -- ' , $entry->link );                  $msg .= prefix( ' | ' , $entry->title );
690                    $msg .= prefix( ' | ' , $link );
691  #               $msg .= prefix( ' id ' , $entry->id );  #               $msg .= prefix( ' id ' , $entry->id );
692    
693                  if ( $args->{kernel} && $send_rss_msgs ) {                  if ( $args->{kernel} && $send_rss_msgs ) {
                         warn "# sending to $CHANNEL\n";  
694                          $send_rss_msgs--;                          $send_rss_msgs--;
695                          $args->{kernel}->post( $IRC_ALIAS => notice => $CHANNEL, $msg );                          if ( ! $args->{private} ) {
696                                    # FIXME bug! should be save_message
697    #                               save_message( channel => $args->{channel}, me => 1, nick => $NICK, message => $msg );
698                                    $sth_insert_log->execute( $args->{channel}, 1, $NICK, $msg, 'now()' );
699                            }
700                            my ( $type, $to ) = ( 'notice', $args->{channel} );
701                            ( $type, $to ) = ( 'privmsg', $args->{nick} ) if $args->{private};
702                            _log(">> $type $to |", $msg);
703                            $args->{kernel}->post( irc => $type => $to, $msg );
704                          $updates++;                          $updates++;
                         save_message( channel => $CHANNEL, me => 1, nick => $NICK, message => $msg );  
                         _log('RSS', $msg);  
705                  }                  }
706          }          }
707    
# Line 693  sub rss_fetch { Line 710  sub rss_fetch {
710          $sql .= qq{where id = } . $args->{id};          $sql .= qq{where id = } . $args->{id};
711          eval { $dbh->do( $sql ) };          eval { $dbh->do( $sql ) };
712    
713            _log "RSS got $total items of which $updates new";
714    
715          return $updates;          return $updates;
716  }  }
717    
718  sub rss_fetch_all {  sub rss_fetch_all {
719          my $kernel = shift;          my $kernel = shift;
720          my $sql = qq{          my $sql = qq{
721                  select id, url, name                  select id, url, name, channel, nick, private
722                  from feeds                  from feeds
723                  where active is true                  where active is true
724          };          };
# Line 710  sub rss_fetch_all { Line 729  sub rss_fetch_all {
729          warn "# ",$sth->rows," active RSS feeds\n";          warn "# ",$sth->rows," active RSS feeds\n";
730          my $count = 0;          my $count = 0;
731          while (my $row = $sth->fetchrow_hashref) {          while (my $row = $sth->fetchrow_hashref) {
                 warn "+++ fetch RSS feed: ",dump( $row );  
732                  $row->{kernel} = $kernel if $kernel;                  $row->{kernel} = $kernel if $kernel;
733                  $count += rss_fetch( $row );                  $count += rss_fetch( $row );
734          }          }
735          return "OK, fetched $count posts from " . $sth->rows . " feeds";          return "OK, fetched $count posts from " . $sth->rows . " feeds";
736  }  }
737    
 my $rss_last_poll = time();  
738    
739  sub rss_check_updates {  sub rss_check_updates {
740          my $kernel = shift;          my $kernel = shift;
741          my $t = time();          $_stat->{rss}->{last_poll} ||= time();
742          if ( $rss_last_poll - $t > $rss_min_delay ) {          my $dt = time() - $_stat->{rss}->{last_poll};
743                  $rss_last_poll = $t;          warn "## rss_check_updates $dt > $rss_min_delay\n";
744            if ( $dt > $rss_min_delay ) {
745                    $_stat->{rss}->{last_poll} = time();
746                  _log rss_fetch_all( $kernel );                  _log rss_fetch_all( $kernel );
747          }          }
748  }  }
# Line 735  _log rss_fetch_all; Line 754  _log rss_fetch_all;
754  # POE handing part  # POE handing part
755  #  #
756    
757  my $SKIPPING = 0;               # if skipping, how many we've done  my $poe_irc = POE::Component::IRC->spawn( %$irc_config ) or
758  my $SEND_QUEUE;                 # cache          die "can't start ", dump( $irc_config ), ": $!";
 my $ping;                                               # ping stats  
759    
760  POE::Component::IRC->new($IRC_ALIAS);  my $irc = $poe_irc->session_id();
761    _log "session_id $irc";
762    
763  POE::Session->create( inline_states => {  POE::Session->create( inline_states => {
764          _start => sub {                _start => sub {      
765                  $_[KERNEL]->post($IRC_ALIAS => register => 'all');                  $_[KERNEL]->post( $irc => register => 'all' );
766                  $_[KERNEL]->post($IRC_ALIAS => connect => $CONNECT);                  $_[KERNEL]->post( $irc => connect => {} );
767      },      },
768            irc_001 => sub {
769                    my ($kernel,$sender) = @_[KERNEL,SENDER];
770                    my $poco_object = $sender->get_heap();
771                    _log "connected to",$poco_object->server_name();
772                    $kernel->post( $sender => join => $_ ) for @channels;
773                    undef;
774            },
775      irc_255 => sub {    # server is done blabbing      irc_255 => sub {    # server is done blabbing
776                  $_[KERNEL]->post($IRC_ALIAS => join => $CHANNEL);                  $_[KERNEL]->post( $irc => join => $CHANNEL);
777                  $_[KERNEL]->post($IRC_ALIAS => join => '#logger');                  $_[KERNEL]->post( $irc => privmsg => 'nickserv', "IDENTIFY $NICK" );
                 $_[KERNEL]->yield("heartbeat"); # start heartbeat  
                 $_[KERNEL]->yield("my_add", $_) for keys %FOLLOWS;  
                 $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "IDENTIFY $NICK" );  
778      },      },
779      irc_public => sub {      irc_public => sub {
780                  my $kernel = $_[KERNEL];                  my $kernel = $_[KERNEL];
# Line 761  POE::Session->create( inline_states => { Line 784  POE::Session->create( inline_states => {
784    
785                  save_message( channel => $channel, me => 0, nick => $nick, message => $msg);                  save_message( channel => $channel, me => 0, nick => $nick, message => $msg);
786                  meta( $nick, $channel, 'last-msg', $msg );                  meta( $nick, $channel, 'last-msg', $msg );
787                    rss_check_updates( $kernel );
788      },      },
789      irc_ctcp_action => sub {      irc_ctcp_action => sub {
790                  my $kernel = $_[KERNEL];                  my $kernel = $_[KERNEL];
# Line 782  POE::Session->create( inline_states => { Line 806  POE::Session->create( inline_states => {
806      },      },
807          irc_ping => sub {          irc_ping => sub {
808                  _log( "pong ", $_[ARG0] );                  _log( "pong ", $_[ARG0] );
809                  $ping->{ $_[ARG0] }++;                  $_stat->{ping}->{ $_[ARG0] }++;
810                  rss_check_updates( $_[KERNEL] );                  rss_check_updates( $_[KERNEL] );
811          },          },
812          irc_invite => sub {          irc_invite => sub {
# Line 792  POE::Session->create( inline_states => { Line 816  POE::Session->create( inline_states => {
816    
817                  _log "invited to $channel by $nick";                  _log "invited to $channel by $nick";
818    
819                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, "how nice of you to invite me to $channel, I'll be right there..." );                  $_[KERNEL]->post( $irc => privmsg => $nick, "how nice of you to invite me to $channel, I'll be right there..." );
820                  $_[KERNEL]->post($IRC_ALIAS => join => $channel);                  $_[KERNEL]->post( $irc => 'join' => $channel );
821    
822          },          },
823          irc_msg => sub {          irc_msg => sub {
# Line 814  POE::Session->create( inline_states => { Line 838  POE::Session->create( inline_states => {
838                  } elsif ($msg =~ m/^msg\s+(\S+)\s+(.*)$/i) {                  } elsif ($msg =~ m/^msg\s+(\S+)\s+(.*)$/i) {
839    
840                          _log ">> /msg $1 $2";                          _log ">> /msg $1 $2";
841                          $_[KERNEL]->post( $IRC_ALIAS => privmsg => $1, $2 );                          $_[KERNEL]->post( $irc => privmsg => $1, $2 );
842                          $res = '';                          $res = '';
843    
844                  } elsif ($msg =~ m/^stat.*?\s*(\d*)/i) {                  } elsif ($msg =~ m/^stat.*?\s*(\d*)/i) {
# Line 844  POE::Session->create( inline_states => { Line 868  POE::Session->create( inline_states => {
868    
869                          foreach my $res (get_from_log( limit => $limit )) {                          foreach my $res (get_from_log( limit => $limit )) {
870                                  _log "last: $res";                                  _log "last: $res";
871                                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );                                  $_[KERNEL]->post( $irc => privmsg => $nick, $res );
872                          }                          }
873    
874                          $res = '';                          $res = '';
# Line 858  POE::Session->create( inline_states => { Line 882  POE::Session->create( inline_states => {
882                                          search => $what,                                          search => $what,
883                                  )) {                                  )) {
884                                  _log "search [$what]: $res";                                  _log "search [$what]: $res";
885                                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );                                  $_[KERNEL]->post( $irc => privmsg => $nick, $res );
886                          }                          }
887    
888                          $res = '';                          $res = '';
# Line 893  POE::Session->create( inline_states => { Line 917  POE::Session->create( inline_states => {
917                                  " : " . ( $stat->{vote}->{'-'} || 0 ) . " --" .                                  " : " . ( $stat->{vote}->{'-'} || 0 ) . " --" .
918                                  " from " . ( join(", ", @nicks) || 'nobody' );                                  " from " . ( join(", ", @nicks) || 'nobody' );
919    
920                          $_[KERNEL]->post( $IRC_ALIAS => notice => $nick, $res );                          $_[KERNEL]->post( $irc => notice => $nick, $res );
921    
922                  } elsif ($msg =~ m/^ping/) {                  } elsif ($msg =~ m/^ping/) {
923                          $res = "ping = " . dump( $ping );                          $res = "ping = " . dump( $_stat->{ping} );
924                  } elsif ($msg =~ m/^conf(?:ig)*\s*(last-size|twitter)*\s*(.*)/) {                  } elsif ($msg =~ m/^conf(?:ig)*\s*(last-size|twitter)*\s*(.*)/) {
925                          if ( ! defined( $1 ) ) {                          if ( ! defined( $1 ) ) {
926                                  my $sth = $dbh->prepare(qq{ select name,value,changed from meta where nick = ? and channel = ? });                                  my $sth = $dbh->prepare(qq{ select name,value,changed from meta where nick = ? and channel = ? });
# Line 930  POE::Session->create( inline_states => { Line 954  POE::Session->create( inline_states => {
954                  } elsif ($msg =~ m/^rss-update/) {                  } elsif ($msg =~ m/^rss-update/) {
955                          $res = rss_fetch_all( $_[KERNEL] );                          $res = rss_fetch_all( $_[KERNEL] );
956                  } elsif ($msg =~ m/^rss-clean/) {                  } elsif ($msg =~ m/^rss-clean/) {
957                          $_rss = undef;                          $_stat->{rss} = undef;
958                            $dbh->do( qq{ update feeds set last_update = now() - delay } );
959                          $res = "OK, cleaned RSS cache";                          $res = "OK, cleaned RSS cache";
960                  } elsif ($msg =~ m!^rss-(add|remove|stop|start)\s+(http://\S+)\s*(.*)!) {                  } elsif ($msg =~ m/^rss-list/) {
961                            my $sth = $dbh->prepare(qq{ select url,name,last_update,active,channel,nick,private from feeds });
962                            $sth->execute;
963                            while (my @row = $sth->fetchrow_array) {
964                                    $_[KERNEL]->post( $irc => privmsg => $nick, join(' | ',@row) );
965                            }
966                            $res = '';
967                    } elsif ($msg =~ m!^rss-(add|remove|stop|start)(?:-(private))?\s+(http://\S+)\s*(.*)!) {
968                            my ( $command, $sub, $url, $arg ) = ( $1,$2,$3,$4 );
969    
970                            my $channel = $1 if ( $arg =~ s/\s*(#\S+)\s*// );
971                            $channel = $nick if $sub eq 'private';
972    
973                          my $sql = {                          my $sql = {
974                                  add             => qq{ insert into feeds (url,name) values (?,?) },                                  add     => qq{ insert into feeds (url,name,channel,nick,private) values (?,?,?,?,?) },
975  #                               remove  => qq{ delete from feeds                                where url = ? and name = ? },  #                               remove  => qq{ delete from feeds                                where url = ? and name = ? },
976                                  start   => qq{ update feeds set active = true   where url = ? -- ? },                                  start   => qq{ update feeds set active = true   where url = ? },
977                                  stop    => qq{ update feeds set active = false  where url = ? -- ? },                                  stop    => qq{ update feeds set active = false  where url = ? },
                                   
978                          };                          };
979                          if (my $q = $sql->{$1} ) {  
980                            if ( $command eq 'add' && ! $channel ) {
981                                    $res = "ERROR: got '$msg' which doesn't have #channel in it, ignoring!";
982                            } elsif (my $q = $sql->{$command} ) {
983                                  my $sth = $dbh->prepare( $q );                                  my $sth = $dbh->prepare( $q );
984                                  warn "## SQL $q ( $2 | $3 )\n";                                  my @data = ( $url );
985                                  eval { $sth->execute( $2, $3 ) };                                  if ( $command eq 'add' ) {
986                                            push @data, ( $arg, $channel, $nick, $sub eq 'private' ? 1 : 0 );
987                                    }
988                                    warn "## $command SQL $q with ",dump( @data ),"\n";
989                                    eval { $sth->execute( @data ) };
990                                    if ($@) {
991                                            $res = "ERROR: $@";
992                                    } else {
993                                            $res = "OK, RSS [$command|$sub|$url|$arg]";
994                                    }
995                            } else {
996                                    $res = "ERROR: don't know what to do with: $msg";
997                          }                          }
   
                         $res ||= "OK, RSS $1 : $2 - $3";  
998                  }                  }
999    
1000                  if ($res) {                  if ($res) {
1001                          _log ">> [$nick] $res";                          _log ">> [$nick] $res";
1002                          $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );                          $_[KERNEL]->post( $irc => privmsg => $nick, $res );
1003                  }                  }
1004    
1005                  rss_check_updates( $_[KERNEL] );                  rss_check_updates( $_[KERNEL] );
1006          },          },
1007            irc_372 => sub {
1008                    _log "<< motd",$_[ARG0],$_[ARG1];
1009            },
1010            irc_375 => sub {
1011                    _log "<< motd", $_[ARG0], "start";
1012            },
1013            irc_376 => sub {
1014                    _log "<< motd", $_[ARG0], "end";
1015            },
1016          irc_477 => sub {          irc_477 => sub {
1017                  _log "# irc_477: ",$_[ARG1];                  _log "<< irc_477: ",$_[ARG1];
1018                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "register $NICK" );                  $_[KERNEL]->post( $irc => privmsg => 'nickserv', "register $NICK" );
1019          },          },
1020          irc_505 => sub {          irc_505 => sub {
1021                  _log "# irc_505: ",$_[ARG1];                  _log "<< irc_505: ",$_[ARG1];
1022                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "register $NICK" );                  $_[KERNEL]->post( $irc => privmsg => 'nickserv', "register $NICK" );
1023  #               $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "set hide email on" );  #               $_[KERNEL]->post( $irc => privmsg => 'nickserv', "set hide email on" );
1024  #               $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "set email dpavlin\@rot13.org" );  #               $_[KERNEL]->post( $irc => privmsg => 'nickserv', "set email dpavlin\@rot13.org" );
1025          },          },
1026          irc_registered => sub {          irc_registered => sub {
1027                  _log "## registrated $NICK";                  _log "<< registered $NICK";
                 $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "IDENTIFY $NICK" );  
1028          },          },
1029          irc_disconnected => sub {          irc_disconnected => sub {
1030                  _log "## disconnected, reconnecting again";                  _log "## disconnected.. sleeping for $sleep_on_error seconds and reconnecting again";
1031                  $_[KERNEL]->post($IRC_ALIAS => connect => $CONNECT);                  sleep($sleep_on_error);
1032                    $_[KERNEL]->post( $irc => connect => {} );
1033          },          },
1034          irc_socketerr => sub {          irc_socketerr => sub {
1035                  _log "## socket error... sleeping for $sleep_on_error seconds and retry";                  _log "## socket error... sleeping for $sleep_on_error seconds and retry";
1036                  sleep($sleep_on_error);                  sleep($sleep_on_error);
1037                  $_[KERNEL]->post($IRC_ALIAS => connect => $CONNECT);                  $_[KERNEL]->post( $irc => connect => {} );
1038          },          },
1039  #       irc_433 => sub {  #       irc_433 => sub {
1040  #               print "# irc_433: ",$_[ARG1], "\n";  #               print "# irc_433: ",$_[ARG1], "\n";
1041  #               warn "## indetify $NICK\n";  #               warn "## indetify $NICK\n";
1042  #               $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "IDENTIFY $NICK" );  #               $_[KERNEL]->post( $irc => privmsg => 'nickserv', "IDENTIFY $NICK" );
1043  #       },  #       },
1044    #       irc_451 # please register
1045            irc_notice => sub {
1046                    _log "<< notice",$_[ARG0];
1047                    if ( $_[ARG0] =~ m!/msg\s+NickServ\s+IDENTIFY!i ) {
1048                            $_[KERNEL]->post( $irc => privmsg => 'nickserv', "IDENTIFY $NICK" );
1049                    }
1050            },
1051            irc_snotice => sub {
1052                    _log "<< snotice",$_[ARG0];
1053                    if ( $_[ARG0] =~ m!/(QUOTE)\s+(PASS\s+\d+)!i ) {
1054                            warn ">> $1 | $2\n";
1055                            $_[KERNEL]->post( $irc => lc($1) => $2);
1056                    }
1057            },
1058      _child => sub {},      _child => sub {},
1059      _default => sub {      _default => sub {
1060                  _log sprintf "sID:%s %s %s",                  _log sprintf "sID:%s %s %s",
# Line 993  POE::Session->create( inline_states => { Line 1064  POE::Session->create( inline_states => {
1064                          "";                          "";
1065        0;                        # false for signals        0;                        # false for signals
1066      },      },
     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);  
     }  
1067     },     },
1068    );    );
1069    
# Line 1127  sub root_handler { Line 1137  sub root_handler {
1137          }          }
1138    
1139          my $search = $q->param('search') || $q->param('grep') || '';          my $search = $q->param('search') || $q->param('grep') || '';
1140            my $r_url = $request->url;
1141    
1142          if ($request->url =~ m#/rss(?:/(tags|last-tag|follow.*)\w*(?:=(\d+))?)?#i) {          my @commands = qw( tags last-tag follow stat );
1143            my $commands_re = join('|',@commands);
1144    
1145            if ($r_url =~ m#/rss(?:/($commands_re.*)\w*(?:=(\d+))?)?#i) {
1146                  my $show = lc($1);                  my $show = lc($1);
1147                  my $nr = $2;                  my $nr = $2;
1148    
# Line 1142  sub root_handler { Line 1156  sub root_handler {
1156                  my $feed = XML::Feed->new( $type );                  my $feed = XML::Feed->new( $type );
1157                  $feed->link( $url );                  $feed->link( $url );
1158    
1159                    my $rc = RC_OK;
1160    
1161                  if ( $show eq 'tags' ) {                  if ( $show eq 'tags' ) {
1162                          $nr ||= 50;                          $nr ||= 50;
1163                          $feed->title( "tags from $CHANNEL" );                          $feed->title( "tags from $CHANNEL" );
# Line 1211  sub root_handler { Line 1227  sub root_handler {
1227                                  $feed->add_entry( $feed_entry );                                  $feed->add_entry( $feed_entry );
1228                          }                          }
1229    
1230                    } elsif ( $show =~ m/^stat/ ) {
1231    
1232                            my $feed_entry = XML::Feed::Entry->new($type);
1233                            $feed_entry->title( "Internal stats" );
1234                            $feed_entry->content(
1235                                    '<![CDATA[<pre>' . dump( $_stat ) . '</pre>]]>'
1236                            );
1237                            $feed->add_entry( $feed_entry );
1238    
1239                  } else {                  } else {
1240                          _log "unknown rss request ",$request->url;                          _log "unknown rss request $r_url";
1241                          return RC_DENY;                          $feed->title( "unknown $r_url" );
1242                            foreach my $c ( @commands ) {
1243                                    my $feed_entry = XML::Feed::Entry->new($type);
1244                                    $feed_entry->title( "rss/$c" );
1245                                    $feed_entry->link( "$url/rss/$c" );
1246                                    $feed->add_entry( $feed_entry );
1247                            }
1248                            $rc = RC_DENY;
1249                  }                  }
1250    
1251                  $response->content( $feed->as_xml );                  $response->content( $feed->as_xml );
1252                  return RC_OK;                  return $rc;
1253          }          }
1254    
1255          if ( $@ ) {          if ( $@ ) {
# Line 1275  sub root_handler { Line 1307  sub root_handler {
1307                          }                          }
1308                          $cal->setcontent($dd, qq[                          $cal->setcontent($dd, qq[
1309                                  <a href="$url?date=$row->{date}">$row->{nr}</a><br/>$row->{len}                                  <a href="$url?date=$row->{date}">$row->{nr}</a><br/>$row->{len}
1310                          ]);                          ]) if $cal;
1311                                                    
1312                  }                  }
1313                  $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.109
  ViewVC Help
Powered by ViewVC 1.1.26