/[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 114 by dpavlin, Mon Mar 10 21:52:49 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-llin';
65    #       $irc_config = {
66    #               nick => 'irc-logger-llin',
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;  
119  }  }
120    
 # 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 );  
   
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 176  my $filter = { Line 160  my $filter = {
160          },          },
161  };  };
162    
163    # POE IRC
164    my $poe_irc = POE::Component::IRC->spawn( %$irc_config ) or
165            die "can't start ", dump( $irc_config ), ": $!";
166    
167    my $irc = $poe_irc->session_id();
168    _log "IRC session_id $irc";
169    
170  my $dbh = DBI->connect($DSN,"","", { RaiseError => 1, AutoCommit => 1 }) || die $DBI::errstr;  my $dbh = DBI->connect($DSN,"","", { RaiseError => 1, AutoCommit => 1 }) || die $DBI::errstr;
171  $dbh->do( qq{ set client_encoding = 'UTF-8' } );  $dbh->do( qq{ set client_encoding = 'UTF-8' } );
172    
# Line 212  create table feeds ( Line 203  create table feeds (
203          name text,          name text,
204          delay interval not null default '5 min',          delay interval not null default '5 min',
205          active boolean default true,          active boolean default true,
206            channel text not null,
207            nick text not null,
208            private boolean default false,
209          last_update timestamp default 'now()',          last_update timestamp default 'now()',
210          polls int default 0,          polls int default 0,
211          updates int default 0          updates int default 0
212  );  );
213  create unique index feeds_url on feeds(url);  create unique index feeds_url on feeds(url);
214  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');
215          },          },
216  };  };
217    
# Line 261  sub meta { Line 255  sub meta {
255                  if ( $@ || ! $sth->rows ) {                  if ( $@ || ! $sth->rows ) {
256                          $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()) });
257                          $sth->execute( $value, $nick, $channel, $name );                          $sth->execute( $value, $nick, $channel, $name );
258                          _log "created $nick/$channel/$name = $value";                          warn "## created $nick/$channel/$name = $value\n";
259                  } else {                  } else {
260                          _log "updated $nick/$channel/$name = $value ";                          warn "## updated $nick/$channel/$name = $value\n";
261                  }                  }
262    
263                  return $value;                  return $value;
# Line 273  sub meta { Line 267  sub meta {
267                  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 = ? });
268                  $sth->execute( $nick, $channel, $name );                  $sth->execute( $nick, $channel, $name );
269                  my ($v,$c) = $sth->fetchrow_array;                  my ($v,$c) = $sth->fetchrow_array;
270                  _log "fetched $nick/$channel/$name = $v [$c]";                  warn "## fetched $nick/$channel/$name = $v [$c]\n";
271                  return ($v,$c) if wantarray;                  return ($v,$c) if wantarray;
272                  return $v;                  return $v;
273    
# Line 282  sub meta { Line 276  sub meta {
276    
277    
278    
279  my $sth = $dbh->prepare(qq{  my $sth_insert_log = $dbh->prepare(qq{
280  insert into log  insert into log
281          (channel, me, nick, message, time)          (channel, me, nick, message, time)
282  values (?,?,?,?,?)  values (?,?,?,?,?)
# Line 370  sub get_from_log { Line 364  sub get_from_log {
364    
365          my @where;          my @where;
366          my @args;          my @args;
367            my $msg;
368    
369          if (my $search = $args->{search}) {          if (my $search = $args->{search}) {
370                  $search =~ s/^\s+//;                  $search =~ s/^\s+//;
371                  $search =~ s/\s+$//;                  $search =~ s/\s+$//;
372                  push @where, 'message ilike ? or nick ilike ?';                  push @where, 'message ilike ? or nick ilike ?';
373                  push @args, ( ( '%' . $search . '%' ) x 2 );                  push @args, ( ( '%' . $search . '%' ) x 2 );
374                  _log "search for '$search'";                  $msg = "Search for '$search'";
375          }          }
376    
377          if ($args->{tag} && $tags->{ $args->{tag} }) {          if ($args->{tag} && $tags->{ $args->{tag} }) {
378                  push @where, 'id in (' . join(',', @{ $tags->{ $args->{tag} } }) . ')';                  push @where, 'id in (' . join(',', @{ $tags->{ $args->{tag} } }) . ')';
379                  _log "search for tags $args->{tag}";                  $msg = "Search for tags $args->{tag}";
380          }          }
381    
382          if (my $date = $args->{date} ) {          if (my $date = $args->{date} ) {
383                  $date = check_date( $date );                  $date = check_date( $date );
384                  push @where, 'date(time) = ?';                  push @where, 'date(time) = ?';
385                  push @args, $date;                  push @args, $date;
386                  _log "search for date $date";                  $msg = "search for date $date";
387          }          }
388    
389          $sql .= " where " . join(" and ", @where) if @where;          $sql .= " where " . join(" and ", @where) if @where;
# Line 402  sub get_from_log { Line 397  sub get_from_log {
397          eval { $sth->execute( @args ) };          eval { $sth->execute( @args ) };
398          return if $@;          return if $@;
399    
400            my $nr_results = $sth->rows;
401    
402          my $last_row = {          my $last_row = {
403                  date => '',                  date => '',
404                  time => '',                  time => '',
# Line 422  sub get_from_log { Line 419  sub get_from_log {
419    
420          return @rows if ($args->{full_rows});          return @rows if ($args->{full_rows});
421    
422          my @msgs = (          $msg .= ' produced ' . (
423                  "Showing " . ($#rows + 1) . " messages..."                  $nr_results == 0 ? 'no results' :
424                    $nr_results == 0 ? 'one result' :
425                            $nr_results . ' results'
426          );          );
427    
428            my @msgs = ( $msg );
429    
430          if ($context) {          if ($context) {
431                  my @ids = @rows;                  my @ids = @rows;
432                  @rows = ();                  @rows = ();
# Line 482  sub get_from_log { Line 483  sub get_from_log {
483  #                       $row->{nick} = $nick;  #                       $row->{nick} = $nick;
484  #               }  #               }
485    
486                    $append = 0 if $row->{me};
487    
488                  if ($last_row->{nick} ne $nick) {                  if ($last_row->{nick} ne $nick) {
489                          # 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
490                          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 537  sub add_tag {
537          return unless ($arg->{id} && $arg->{message});          return unless ($arg->{id} && $arg->{message});
538    
539          my $m = $arg->{message};          my $m = $arg->{message};
         from_to('UTF-8', 'iso-8859-2', $m) if (is_utf8($m));  
540    
541          my @tags;          my @tags;
542    
# Line 603  sub save_message { Line 605  sub save_message {
605                  $a->{me} ? "***" . $a->{nick} : "<" . $a->{nick} . ">",                  $a->{me} ? "***" . $a->{nick} : "<" . $a->{nick} . ">",
606                  " " . $a->{message};                  " " . $a->{message};
607    
608          $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});
609          add_tag( id => $dbh->last_insert_id(undef,undef,"log",undef), %$a );          add_tag( id => $dbh->last_insert_id(undef,undef,"log",undef), %$a );
610  }  }
611    
# Line 646  if ($import_dircproxy) { Line 648  if ($import_dircproxy) {
648  # RSS follow  # RSS follow
649  #  #
650    
651  my $_rss;  my $_stat;
652    
653    
654  sub rss_fetch {  sub rss_fetch {
# Line 655  sub rss_fetch { Line 657  sub rss_fetch {
657          # 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?
658          my $send_rss_msgs = 1;          my $send_rss_msgs = 1;
659    
660            _log "RSS fetch", $args->{url};
661    
662          my $feed = XML::Feed->parse(URI->new( $args->{url} ));          my $feed = XML::Feed->parse(URI->new( $args->{url} ));
663          if ( ! $feed ) {          if ( ! $feed ) {
664                  _log("can't fetch RSS ", $args->{url});                  _log("can't fetch RSS ", $args->{url});
665                  return;                  return;
666          }          }
667          my $updates = 0;  
668            my ( $total, $updates ) = ( 0, 0 );
669          for my $entry ($feed->entries) {          for my $entry ($feed->entries) {
670                    $total++;
671    
672                  # seen allready?                  # seen allready?
673                  return if $_rss->{$feed->link}->{seen}->{$entry->id}++ > 0;                  next if $_stat->{rss}->{seen}->{$args->{channel}}->{$feed->link}->{$entry->id}++ > 0;
674    
675                  sub prefix {                  sub prefix {
676                          my ($txt,$var) = @_;                          my ($txt,$var) = @_;
677                            $var =~ s/\s+/ /gs;
678                          $var =~ s/^\s+//g;                          $var =~ s/^\s+//g;
679                            $var =~ s/\s+$//g;
680                          return $txt . $var if $var;                          return $txt . $var if $var;
681                  }                  }
682    
683                    # fix absolute and relative links to feed entries
684                    my $link = $entry->link;
685                    if ( $link =~ m!^/! ) {
686                            my $host = $args->{url};
687                            $host =~ s!^(http://[^/]+).*$!$1!;      #!vim
688                            $link = "$host/$link";
689                    } elsif ( $link !~ m!^http! ) {
690                            $link = $args->{url} . $link;
691                    }
692    
693                  my $msg;                  my $msg;
694                  $msg .= prefix( 'From: ' , $feed->title );                  $msg .= prefix( 'From: ' , $args->{name} || $feed->title );
695                  $msg .= prefix( ' by ' , $entry->author );                  $msg .= prefix( ' by ' , $entry->author );
696                  $msg .= prefix( ' -- ' , $entry->link );                  $msg .= prefix( ' | ' , $entry->title );
697                    $msg .= prefix( ' | ' , $link );
698  #               $msg .= prefix( ' id ' , $entry->id );  #               $msg .= prefix( ' id ' , $entry->id );
699                    if ( my $tags = $entry->category ) {
700                            $tags =~ s!^\s+!!;
701                            $tags =~ s!\s*$! !;
702                            $tags =~ s!\s+!// !g;
703                            $msg .= prefix( ' ' , $tags );
704                    }
705    
706                  if ( $args->{kernel} && $send_rss_msgs ) {                  if ( $args->{kernel} && $send_rss_msgs ) {
                         warn "# sending to $CHANNEL\n";  
707                          $send_rss_msgs--;                          $send_rss_msgs--;
708                          $args->{kernel}->post( $IRC_ALIAS => notice => $CHANNEL, $msg );                          if ( ! $args->{private} ) {
709                                    # FIXME bug! should be save_message
710    #                               save_message( channel => $args->{channel}, me => 1, nick => $NICK, message => $msg );
711                                    $sth_insert_log->execute( $args->{channel}, 1, $NICK, $msg, 'now()' );
712                            }
713                            my ( $type, $to ) = ( 'notice', $args->{channel} );
714                            ( $type, $to ) = ( 'privmsg', $args->{nick} ) if $args->{private};
715                            _log(">> $type $to", $msg);
716                            $args->{kernel}->post( $irc => $type => $to, $msg );
717                          $updates++;                          $updates++;
                         save_message( channel => $CHANNEL, me => 1, nick => $NICK, message => $msg );  
                         _log('RSS', $msg);  
718                  }                  }
719          }          }
720    
# Line 693  sub rss_fetch { Line 723  sub rss_fetch {
723          $sql .= qq{where id = } . $args->{id};          $sql .= qq{where id = } . $args->{id};
724          eval { $dbh->do( $sql ) };          eval { $dbh->do( $sql ) };
725    
726            _log "RSS got $total items of which $updates new";
727    
728          return $updates;          return $updates;
729  }  }
730    
731  sub rss_fetch_all {  sub rss_fetch_all {
732          my $kernel = shift;          my $kernel = shift;
733          my $sql = qq{          my $sql = qq{
734                  select id, url, name                  select id, url, name, channel, nick, private
735                  from feeds                  from feeds
736                  where active is true                  where active is true
737          };          };
# Line 710  sub rss_fetch_all { Line 742  sub rss_fetch_all {
742          warn "# ",$sth->rows," active RSS feeds\n";          warn "# ",$sth->rows," active RSS feeds\n";
743          my $count = 0;          my $count = 0;
744          while (my $row = $sth->fetchrow_hashref) {          while (my $row = $sth->fetchrow_hashref) {
                 warn "+++ fetch RSS feed: ",dump( $row );  
745                  $row->{kernel} = $kernel if $kernel;                  $row->{kernel} = $kernel if $kernel;
746                  $count += rss_fetch( $row );                  $count += rss_fetch( $row );
747          }          }
748          return "OK, fetched $count posts from " . $sth->rows . " feeds";          return "OK, fetched $count posts from " . $sth->rows . " feeds";
749  }  }
750    
 my $rss_last_poll = time();  
751    
752  sub rss_check_updates {  sub rss_check_updates {
753          my $kernel = shift;          my $kernel = shift;
754          my $t = time();          $_stat->{rss}->{last_poll} ||= time();
755          if ( $rss_last_poll - $t > $rss_min_delay ) {          my $dt = time() - $_stat->{rss}->{last_poll};
756                  $rss_last_poll = $t;          warn "## rss_check_updates $dt > $rss_min_delay\n";
757            if ( $dt > $rss_min_delay ) {
758                    $_stat->{rss}->{last_poll} = time();
759                  _log rss_fetch_all( $kernel );                  _log rss_fetch_all( $kernel );
760          }          }
761  }  }
# Line 731  sub rss_check_updates { Line 763  sub rss_check_updates {
763  # seed rss seen cache so we won't send out all items on startup  # seed rss seen cache so we won't send out all items on startup
764  _log rss_fetch_all;  _log rss_fetch_all;
765    
 #  
 # POE handing part  
 #  
   
 my $SKIPPING = 0;               # if skipping, how many we've done  
 my $SEND_QUEUE;                 # cache  
 my $ping;                                               # ping stats  
   
 POE::Component::IRC->new($IRC_ALIAS);  
   
766  POE::Session->create( inline_states => {  POE::Session->create( inline_states => {
767          _start => sub {                _start => sub {      
768                  $_[KERNEL]->post($IRC_ALIAS => register => 'all');                  $_[KERNEL]->post( $irc => register => 'all' );
769                  $_[KERNEL]->post($IRC_ALIAS => connect => $CONNECT);                  $_[KERNEL]->post( $irc => connect => {} );
770      },      },
771            irc_001 => sub {
772                    my ($kernel,$sender) = @_[KERNEL,SENDER];
773                    my $poco_object = $sender->get_heap();
774                    _log "connected to",$poco_object->server_name();
775                    $kernel->post( $sender => join => $_ ) for @channels;
776                    undef;
777            },
778      irc_255 => sub {    # server is done blabbing      irc_255 => sub {    # server is done blabbing
779                  $_[KERNEL]->post($IRC_ALIAS => join => $CHANNEL);                  $_[KERNEL]->post( $irc => 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" );  
780      },      },
781      irc_public => sub {      irc_public => sub {
782                  my $kernel = $_[KERNEL];                  my $kernel = $_[KERNEL];
# Line 761  POE::Session->create( inline_states => { Line 786  POE::Session->create( inline_states => {
786    
787                  save_message( channel => $channel, me => 0, nick => $nick, message => $msg);                  save_message( channel => $channel, me => 0, nick => $nick, message => $msg);
788                  meta( $nick, $channel, 'last-msg', $msg );                  meta( $nick, $channel, 'last-msg', $msg );
789                    rss_check_updates( $kernel );
790      },      },
791      irc_ctcp_action => sub {      irc_ctcp_action => sub {
792                  my $kernel = $_[KERNEL];                  my $kernel = $_[KERNEL];
# Line 782  POE::Session->create( inline_states => { Line 808  POE::Session->create( inline_states => {
808      },      },
809          irc_ping => sub {          irc_ping => sub {
810                  _log( "pong ", $_[ARG0] );                  _log( "pong ", $_[ARG0] );
811                  $ping->{ $_[ARG0] }++;                  $_stat->{ping}->{ $_[ARG0] }++;
812                  rss_check_updates( $_[KERNEL] );                  rss_check_updates( $_[KERNEL] );
813          },          },
814          irc_invite => sub {          irc_invite => sub {
# Line 792  POE::Session->create( inline_states => { Line 818  POE::Session->create( inline_states => {
818    
819                  _log "invited to $channel by $nick";                  _log "invited to $channel by $nick";
820    
821                  $_[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..." );
822                  $_[KERNEL]->post($IRC_ALIAS => join => $channel);                  $_[KERNEL]->post( $irc => 'join' => $channel );
823    
824          },          },
825          irc_msg => sub {          irc_msg => sub {
# Line 811  POE::Session->create( inline_states => { Line 837  POE::Session->create( inline_states => {
837    
838                          $res = "usage: /msg $NICK comand | commands: stat - user/message stat | last - show backtrace | grep foobar - find foobar";                          $res = "usage: /msg $NICK comand | commands: stat - user/message stat | last - show backtrace | grep foobar - find foobar";
839    
840                  } elsif ($msg =~ m/^msg\s+(\S+)\s+(.*)$/i) {                  } elsif ($msg =~ m/^(privmsg|notice)\s+(\S+)\s+(.*)$/i) {
841    
842                          _log ">> /msg $1 $2";                          _log ">> /$1 $2 $3";
843                          $_[KERNEL]->post( $IRC_ALIAS => privmsg => $1, $2 );                          $_[KERNEL]->post( $irc => $1 => $2, $3 );
844                          $res = '';                          $res = '';
845    
846                  } elsif ($msg =~ m/^stat.*?\s*(\d*)/i) {                  } elsif ($msg =~ m/^stat.*?\s*(\d*)/i) {
# Line 844  POE::Session->create( inline_states => { Line 870  POE::Session->create( inline_states => {
870    
871                          foreach my $res (get_from_log( limit => $limit )) {                          foreach my $res (get_from_log( limit => $limit )) {
872                                  _log "last: $res";                                  _log "last: $res";
873                                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );                                  $_[KERNEL]->post( $irc => privmsg => $nick, $res );
874                          }                          }
875    
876                          $res = '';                          $res = '';
# Line 858  POE::Session->create( inline_states => { Line 884  POE::Session->create( inline_states => {
884                                          search => $what,                                          search => $what,
885                                  )) {                                  )) {
886                                  _log "search [$what]: $res";                                  _log "search [$what]: $res";
887                                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );                                  $_[KERNEL]->post( $irc => privmsg => $nick, $res );
888                          }                          }
889    
890                          $res = '';                          $res = '';
# Line 893  POE::Session->create( inline_states => { Line 919  POE::Session->create( inline_states => {
919                                  " : " . ( $stat->{vote}->{'-'} || 0 ) . " --" .                                  " : " . ( $stat->{vote}->{'-'} || 0 ) . " --" .
920                                  " from " . ( join(", ", @nicks) || 'nobody' );                                  " from " . ( join(", ", @nicks) || 'nobody' );
921    
922                          $_[KERNEL]->post( $IRC_ALIAS => notice => $nick, $res );                          $_[KERNEL]->post( $irc => notice => $nick, $res );
923    
924                  } elsif ($msg =~ m/^ping/) {                  } elsif ($msg =~ m/^ping/) {
925                          $res = "ping = " . dump( $ping );                          $res = "ping = " . dump( $_stat->{ping} );
926                  } elsif ($msg =~ m/^conf(?:ig)*\s*(last-size|twitter)*\s*(.*)/) {                  } elsif ($msg =~ m/^conf(?:ig)*\s*(last-size|twitter)*\s*(.*)/) {
927                          if ( ! defined( $1 ) ) {                          if ( ! defined( $1 ) ) {
928                                  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 956  POE::Session->create( inline_states => {
956                  } elsif ($msg =~ m/^rss-update/) {                  } elsif ($msg =~ m/^rss-update/) {
957                          $res = rss_fetch_all( $_[KERNEL] );                          $res = rss_fetch_all( $_[KERNEL] );
958                  } elsif ($msg =~ m/^rss-clean/) {                  } elsif ($msg =~ m/^rss-clean/) {
959                          $_rss = undef;                          $_stat->{rss} = undef;
960                            $dbh->do( qq{ update feeds set last_update = now() - delay } );
961                          $res = "OK, cleaned RSS cache";                          $res = "OK, cleaned RSS cache";
962                  } elsif ($msg =~ m!^rss-(add|remove|stop|start)\s+(http://\S+)\s*(.*)!) {                  } elsif ($msg =~ m/^rss-list/) {
963                            my $sth = $dbh->prepare(qq{ select url,name,last_update,active,channel,nick,private from feeds });
964                            $sth->execute;
965                            while (my @row = $sth->fetchrow_array) {
966                                    $_[KERNEL]->post( $irc => privmsg => $nick, join(' | ',@row) );
967                            }
968                            $res = '';
969                    } elsif ($msg =~ m!^rss-(add|remove|stop|start)(?:-(private))?\s+(http://\S+)\s*(.*)!) {
970                            my ( $command, $sub, $url, $arg ) = ( $1,$2,$3,$4 );
971    
972                            my $channel = $1 if ( $arg =~ s/\s*(#\S+)\s*// );
973                            $channel = $nick if $sub eq 'private';
974    
975                          my $sql = {                          my $sql = {
976                                  add             => qq{ insert into feeds (url,name) values (?,?) },                                  add     => qq{ insert into feeds (url,name,channel,nick,private) values (?,?,?,?,?) },
977  #                               remove  => qq{ delete from feeds                                where url = ? and name = ? },  #                               remove  => qq{ delete from feeds                                where url = ? and name = ? },
978                                  start   => qq{ update feeds set active = true   where url = ? -- ? },                                  start   => qq{ update feeds set active = true   where url = ? },
979                                  stop    => qq{ update feeds set active = false  where url = ? -- ? },                                  stop    => qq{ update feeds set active = false  where url = ? },
                                   
980                          };                          };
981                          if (my $q = $sql->{$1} ) {  
982                            if ( $command eq 'add' && ! $channel ) {
983                                    $res = "ERROR: got '$msg' which doesn't have #channel in it, ignoring!";
984                            } elsif (my $q = $sql->{$command} ) {
985                                  my $sth = $dbh->prepare( $q );                                  my $sth = $dbh->prepare( $q );
986                                  warn "## SQL $q ( $2 | $3 )\n";                                  my @data = ( $url );
987                                  eval { $sth->execute( $2, $3 ) };                                  if ( $command eq 'add' ) {
988                                            push @data, ( $arg, $channel, $nick, $sub eq 'private' ? 1 : 0 );
989                                    }
990                                    warn "## $command SQL $q with ",dump( @data ),"\n";
991                                    eval { $sth->execute( @data ) };
992                                    if ($@) {
993                                            $res = "ERROR: $@";
994                                    } else {
995                                            $res = "OK, RSS [$command|$sub|$url|$arg]";
996                                    }
997                            } else {
998                                    $res = "ERROR: don't know what to do with: $msg";
999                          }                          }
   
                         $res ||= "OK, RSS $1 : $2 - $3";  
1000                  }                  }
1001    
1002                  if ($res) {                  if ($res) {
1003                          _log ">> [$nick] $res";                          _log ">> [$nick] $res";
1004                          $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );                          $_[KERNEL]->post( $irc => privmsg => $nick, $res );
1005                  }                  }
1006    
1007                  rss_check_updates( $_[KERNEL] );                  rss_check_updates( $_[KERNEL] );
1008          },          },
1009            irc_372 => sub {
1010                    _log "<< motd",$_[ARG0],$_[ARG1];
1011            },
1012            irc_375 => sub {
1013                    _log "<< motd", $_[ARG0], "start";
1014            },
1015            irc_376 => sub {
1016                    _log "<< motd", $_[ARG0], "end";
1017            },
1018    #       irc_433 => sub {
1019    #               print "# irc_433: ",$_[ARG1], "\n";
1020    #               warn "## indetify $NICK\n";
1021    #               $_[KERNEL]->post( $irc => privmsg => 'nickserv', "IDENTIFY $NICK" );
1022    #       },
1023    #       irc_451 # please register
1024          irc_477 => sub {          irc_477 => sub {
1025                  _log "# irc_477: ",$_[ARG1];                  _log "<< irc_477: ",$_[ARG1];
1026                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "register $NICK" );                  _log ">> IDENTIFY $NICK";
1027                    $_[KERNEL]->post( $irc => privmsg => 'NickServ', "IDENTIFY $NICK" );
1028          },          },
1029          irc_505 => sub {          irc_505 => sub {
1030                  _log "# irc_505: ",$_[ARG1];                  _log "<< irc_505: ",$_[ARG1];
1031                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "register $NICK" );                  _log ">> register $NICK";
1032  #               $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "set hide email on" );                  $_[KERNEL]->post( $irc => privmsg => 'NickServ', "register $NICK" );
1033  #               $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "set email dpavlin\@rot13.org" );  #               $_[KERNEL]->post( $irc => privmsg => 'nickserv', "IDENTIFY $NICK" );
1034    #               $_[KERNEL]->post( $irc => privmsg => 'nickserv', "set hide email on" );
1035    #               $_[KERNEL]->post( $irc => privmsg => 'nickserv', "set email dpavlin\@rot13.org" );
1036          },          },
1037          irc_registered => sub {          irc_registered => sub {
1038                  _log "## registrated $NICK";                  _log "<< registered $NICK";
                 $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "IDENTIFY $NICK" );  
1039          },          },
1040          irc_disconnected => sub {          irc_disconnected => sub {
1041                  _log "## disconnected, reconnecting again";                  _log "## disconnected.. sleeping for $sleep_on_error seconds and reconnecting again";
1042                  $_[KERNEL]->post($IRC_ALIAS => connect => $CONNECT);                  sleep($sleep_on_error);
1043                    $_[KERNEL]->post( $irc => connect => {} );
1044          },          },
1045          irc_socketerr => sub {          irc_socketerr => sub {
1046                  _log "## socket error... sleeping for $sleep_on_error seconds and retry";                  _log "## socket error... sleeping for $sleep_on_error seconds and retry";
1047                  sleep($sleep_on_error);                  sleep($sleep_on_error);
1048                  $_[KERNEL]->post($IRC_ALIAS => connect => $CONNECT);                  $_[KERNEL]->post( $irc => connect => {} );
1049            },
1050            irc_notice => sub {
1051                    _log "<< notice",$_[ARG0],dump($_[ARG1]);
1052                    if ( $_[ARG0] =~ m!/msg\s+NickServ\s+IDENTIFY!i ) {
1053                            _log ">> IDENTIFY";
1054                            $_[KERNEL]->post( $irc => privmsg => 'nickserv', "IDENTIFY $NICK" );
1055                    }
1056            },
1057            irc_snotice => sub {
1058                    _log "<< snotice",$_[ARG0];
1059                    if ( $_[ARG0] =~ m!/(QUOTE)\s+(PASS\s+\d+)!i ) {
1060                            warn ">> $1 | $2\n";
1061                            $_[KERNEL]->post( $irc => lc($1) => $2);
1062                    }
1063          },          },
 #       irc_433 => sub {  
 #               print "# irc_433: ",$_[ARG1], "\n";  
 #               warn "## indetify $NICK\n";  
 #               $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "IDENTIFY $NICK" );  
 #       },  
1064      _child => sub {},      _child => sub {},
1065      _default => sub {      _default => sub {
1066                  _log sprintf "sID:%s %s %s",                  _log sprintf "sID:%s %s %s",
# Line 993  POE::Session->create( inline_states => { Line 1070  POE::Session->create( inline_states => {
1070                          "";                          "";
1071        0;                        # false for signals        0;                        # false for signals
1072      },      },
     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);  
     }  
1073     },     },
1074    );    );
1075    
1076  # http server  # http server
1077    
1078    _log "WEB archive at $url";
1079    
1080  my $httpd = POE::Component::Server::HTTP->new(  my $httpd = POE::Component::Server::HTTP->new(
1081          Port => $http_port,          Port => $http_port,
1082          PreHandler => {          PreHandler => {
# Line 1105  foreach my $c (@cols) { Line 1123  foreach my $c (@cols) {
1123          $style .= ".col-${max_color} { background: $c }\n";          $style .= ".col-${max_color} { background: $c }\n";
1124          $max_color++;          $max_color++;
1125  }  }
1126  warn "defined $max_color colors for users...\n";  _log "WEB defined $max_color colors for users...";
1127    
1128  sub root_handler {  sub root_handler {
1129          my ($request, $response) = @_;          my ($request, $response) = @_;
# Line 1127  sub root_handler { Line 1145  sub root_handler {
1145          }          }
1146    
1147          my $search = $q->param('search') || $q->param('grep') || '';          my $search = $q->param('search') || $q->param('grep') || '';
1148            my $r_url = $request->url;
1149    
1150          if ($request->url =~ m#/rss(?:/(tags|last-tag|follow.*)\w*(?:=(\d+))?)?#i) {          my @commands = qw( tags last-tag follow stat );
1151            my $commands_re = join('|',@commands);
1152    
1153            if ($r_url =~ m#/rss(?:/($commands_re.*)\w*(?:=(\d+))?)?#i) {
1154                  my $show = lc($1);                  my $show = lc($1);
1155                  my $nr = $2;                  my $nr = $2;
1156    
# Line 1142  sub root_handler { Line 1164  sub root_handler {
1164                  my $feed = XML::Feed->new( $type );                  my $feed = XML::Feed->new( $type );
1165                  $feed->link( $url );                  $feed->link( $url );
1166    
1167                    my $rc = RC_OK;
1168    
1169                  if ( $show eq 'tags' ) {                  if ( $show eq 'tags' ) {
1170                          $nr ||= 50;                          $nr ||= 50;
1171                          $feed->title( "tags from $CHANNEL" );                          $feed->title( "tags from $CHANNEL" );
# Line 1211  sub root_handler { Line 1235  sub root_handler {
1235                                  $feed->add_entry( $feed_entry );                                  $feed->add_entry( $feed_entry );
1236                          }                          }
1237    
1238                    } elsif ( $show =~ m/^stat/ ) {
1239    
1240                            my $feed_entry = XML::Feed::Entry->new($type);
1241                            $feed_entry->title( "Internal stats" );
1242                            $feed_entry->content(
1243                                    '<![CDATA[<pre>' . dump( $_stat ) . '</pre>]]>'
1244                            );
1245                            $feed->add_entry( $feed_entry );
1246    
1247                  } else {                  } else {
1248                          _log "unknown rss request ",$request->url;                          _log "WEB unknown rss request $r_url";
1249                          return RC_DENY;                          $feed->title( "unknown $r_url" );
1250                            foreach my $c ( @commands ) {
1251                                    my $feed_entry = XML::Feed::Entry->new($type);
1252                                    $feed_entry->title( "rss/$c" );
1253                                    $feed_entry->link( "$url/rss/$c" );
1254                                    $feed->add_entry( $feed_entry );
1255                            }
1256                            $rc = RC_DENY;
1257                  }                  }
1258    
1259                  $response->content( $feed->as_xml );                  $response->content( $feed->as_xml );
1260                  return RC_OK;                  return $rc;
1261          }          }
1262    
1263          if ( $@ ) {          if ( $@ ) {
# Line 1275  sub root_handler { Line 1315  sub root_handler {
1315                          }                          }
1316                          $cal->setcontent($dd, qq[                          $cal->setcontent($dd, qq[
1317                                  <a href="$url?date=$row->{date}">$row->{nr}</a><br/>$row->{len}                                  <a href="$url?date=$row->{date}">$row->{nr}</a><br/>$row->{len}
1318                          ]);                          ]) if $cal;
1319                                                    
1320                  }                  }
1321                  $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.114
  ViewVC Help
Powered by ViewVC 1.1.26