/[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 89 by dpavlin, Fri Mar 7 00:43:45 2008 UTC revision 117 by dpavlin, Wed Mar 12 18:14:57 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    
# Line 64  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 72  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 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 97  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    
# Line 105  GetOptions( Line 112  GetOptions(
112  #       confess "fatal error";  #       confess "fatal error";
113  #};  #};
114    
 open(STDOUT, '>', $log_path) || warn "can't redirect log to $log_path: $!";  
   
115  sub _log {  sub _log {
116          print strftime($TIMESTAMP,localtime()) . ' ' . join(" ",@_) . $/;          print strftime($TIMESTAMP,localtime()) . ' ' . join(" ",map { ref($_) ? dump( $_ ) : $_ } @_) . $/;
117  }  }
118    
119  # LOG following  open(STDOUT, '>', $log_path) && warn "log to $log_path: $!\n";
   
 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 );  
120    
121  # HTML formatters  # HTML formatters
122    
# Line 146  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 171  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 207  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 256  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 268  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 365  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 397  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 417  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 477  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 640  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 656  sub rss_fetch { Line 664  sub rss_fetch {
664                  _log("can't fetch RSS ", $args->{url});                  _log("can't fetch RSS ", $args->{url});
665                  return;                  return;
666          }          }
667    
668            $_stat->{rss}->{url2link}->{ $args->{url} } = $feed->link;
669    
670          my ( $total, $updates ) = ( 0, 0 );          my ( $total, $updates ) = ( 0, 0 );
671          for my $entry ($feed->entries) {          for my $entry ($feed->entries) {
672                  $total++;                  $total++;
673    
674                  # seen allready?                  # seen allready?
675                  return if $_rss->{$feed->link}->{seen}->{$entry->id}++ > 0;                  next if $_stat->{rss}->{seen}->{$args->{channel}}->{$feed->link}->{$entry->id}++ > 0;
676    
677                  sub prefix {                  sub prefix {
678                          my ($txt,$var) = @_;                          my ($txt,$var) = @_;
679                            $var =~ s/\s+/ /gs;
680                          $var =~ s/^\s+//g;                          $var =~ s/^\s+//g;
681                            $var =~ s/\s+$//g;
682                          return $txt . $var if $var;                          return $txt . $var if $var;
683                  }                  }
684    
685                    # fix absolute and relative links to feed entries
686                    my $link = $entry->link;
687                    if ( $link =~ m!^/! ) {
688                            my $host = $args->{url};
689                            $host =~ s!^(http://[^/]+).*$!$1!;      #!vim
690                            $link = "$host/$link";
691                    } elsif ( $link !~ m!^http! ) {
692                            $link = $args->{url} . $link;
693                    }
694    
695                  my $msg;                  my $msg;
696                  $msg .= prefix( 'From: ' , $feed->title );                  $msg .= prefix( 'From: ' , $args->{name} || $feed->title );
697                  $msg .= prefix( ' by ' , $entry->author );                  $msg .= prefix( ' by ' , $entry->author );
698                  $msg .= prefix( ' -- ' , $entry->link );                  $msg .= prefix( ' | ' , $entry->title );
699                    $msg .= prefix( ' | ' , $link );
700  #               $msg .= prefix( ' id ' , $entry->id );  #               $msg .= prefix( ' id ' , $entry->id );
701                    if ( my $tags = $entry->category ) {
702                            $tags =~ s!^\s+!!;
703                            $tags =~ s!\s*$! !;
704                            $tags =~ s!\s+!// !g;
705                            $msg .= prefix( ' ' , $tags );
706                    }
707    
708                  if ( $args->{kernel} && $send_rss_msgs ) {                  if ( $args->{kernel} && $send_rss_msgs ) {
709                          $send_rss_msgs--;                          $send_rss_msgs--;
710                          _log('RSS', $msg);                          if ( ! $args->{private} ) {
711                          $sth_insert_log->execute( $CHANNEL, 1, $NICK, $msg, undef );                                  # FIXME bug! should be save_message
712                          $args->{kernel}->post( $IRC_ALIAS => notice => $CHANNEL, $msg );  #                               save_message( channel => $args->{channel}, me => 1, nick => $NICK, message => $msg );
713                                    $sth_insert_log->execute( $args->{channel}, 1, $NICK, $msg, 'now()' );
714                            }
715                            my ( $type, $to ) = ( 'notice', $args->{channel} );
716                            ( $type, $to ) = ( 'privmsg', $args->{nick} ) if $args->{private};
717                            _log(">> $type $to", $msg);
718                            $args->{kernel}->post( $irc => $type => $to, $msg );
719                          $updates++;                          $updates++;
720                  }                  }
721          }          }
# Line 697  sub rss_fetch { Line 733  sub rss_fetch {
733  sub rss_fetch_all {  sub rss_fetch_all {
734          my $kernel = shift;          my $kernel = shift;
735          my $sql = qq{          my $sql = qq{
736                  select id, url, name                  select id, url, name, channel, nick, private
737                  from feeds                  from feeds
738                  where active is true                  where active is true
739          };          };
# Line 717  sub rss_fetch_all { Line 753  sub rss_fetch_all {
753    
754  sub rss_check_updates {  sub rss_check_updates {
755          my $kernel = shift;          my $kernel = shift;
756          my $last_t = $_rss->{last_poll} || time();          $_stat->{rss}->{last_poll} ||= time();
757          my $t = time();          my $dt = time() - $_stat->{rss}->{last_poll};
758          if ( $last_t - $t > $rss_min_delay ) {          warn "## rss_check_updates $dt > $rss_min_delay\n";
759                  $_rss->{last_poll} = $t;          if ( $dt > $rss_min_delay ) {
760                    $_stat->{rss}->{last_poll} = time();
761                  _log rss_fetch_all( $kernel );                  _log rss_fetch_all( $kernel );
762          }          }
763  }  }
# Line 728  sub rss_check_updates { Line 765  sub rss_check_updates {
765  # 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
766  _log rss_fetch_all;  _log rss_fetch_all;
767    
 #  
 # 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);  
   
768  POE::Session->create( inline_states => {  POE::Session->create( inline_states => {
769          _start => sub {                _start => sub {      
770                  $_[KERNEL]->post($IRC_ALIAS => register => 'all');                  $_[KERNEL]->post( $irc => register => 'all' );
771                  $_[KERNEL]->post($IRC_ALIAS => connect => $CONNECT);                  $_[KERNEL]->post( $irc => connect => {} );
772      },      },
773            irc_001 => sub {
774                    my ($kernel,$sender) = @_[KERNEL,SENDER];
775                    my $poco_object = $sender->get_heap();
776                    _log "connected to",$poco_object->server_name();
777                    $kernel->post( $sender => join => $_ ) for @channels;
778                    undef;
779            },
780      irc_255 => sub {    # server is done blabbing      irc_255 => sub {    # server is done blabbing
781                  $_[KERNEL]->post($IRC_ALIAS => join => $CHANNEL);                  $_[KERNEL]->post( $irc => join => $CHANNEL);
                 $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "IDENTIFY $NICK" );  
782      },      },
783      irc_public => sub {      irc_public => sub {
784                  my $kernel = $_[KERNEL];                  my $kernel = $_[KERNEL];
# Line 755  POE::Session->create( inline_states => { Line 788  POE::Session->create( inline_states => {
788    
789                  save_message( channel => $channel, me => 0, nick => $nick, message => $msg);                  save_message( channel => $channel, me => 0, nick => $nick, message => $msg);
790                  meta( $nick, $channel, 'last-msg', $msg );                  meta( $nick, $channel, 'last-msg', $msg );
791                    rss_check_updates( $kernel );
792      },      },
793      irc_ctcp_action => sub {      irc_ctcp_action => sub {
794                  my $kernel = $_[KERNEL];                  my $kernel = $_[KERNEL];
# Line 776  POE::Session->create( inline_states => { Line 810  POE::Session->create( inline_states => {
810      },      },
811          irc_ping => sub {          irc_ping => sub {
812                  _log( "pong ", $_[ARG0] );                  _log( "pong ", $_[ARG0] );
813                  $ping->{ $_[ARG0] }++;                  $_stat->{ping}->{ $_[ARG0] }++;
814                  rss_check_updates( $_[KERNEL] );                  rss_check_updates( $_[KERNEL] );
815          },          },
816          irc_invite => sub {          irc_invite => sub {
# Line 786  POE::Session->create( inline_states => { Line 820  POE::Session->create( inline_states => {
820    
821                  _log "invited to $channel by $nick";                  _log "invited to $channel by $nick";
822    
823                  $_[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..." );
824                  $_[KERNEL]->post($IRC_ALIAS => join => $channel);                  $_[KERNEL]->post( $irc => 'join' => $channel );
825    
826          },          },
827          irc_msg => sub {          irc_msg => sub {
# Line 805  POE::Session->create( inline_states => { Line 839  POE::Session->create( inline_states => {
839    
840                          $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";
841    
842                  } elsif ($msg =~ m/^msg\s+(\S+)\s+(.*)$/i) {                  } elsif ($msg =~ m/^(privmsg|notice)\s+(\S+)\s+(.*)$/i) {
843    
844                          _log ">> /msg $1 $2";                          _log ">> /$1 $2 $3";
845                          $_[KERNEL]->post( $IRC_ALIAS => privmsg => $1, $2 );                          $_[KERNEL]->post( $irc => $1 => $2, $3 );
846                          $res = '';                          $res = '';
847    
848                  } elsif ($msg =~ m/^stat.*?\s*(\d*)/i) {                  } elsif ($msg =~ m/^stat.*?\s*(\d*)/i) {
# Line 838  POE::Session->create( inline_states => { Line 872  POE::Session->create( inline_states => {
872    
873                          foreach my $res (get_from_log( limit => $limit )) {                          foreach my $res (get_from_log( limit => $limit )) {
874                                  _log "last: $res";                                  _log "last: $res";
875                                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );                                  $_[KERNEL]->post( $irc => privmsg => $nick, $res );
876                          }                          }
877    
878                          $res = '';                          $res = '';
# Line 852  POE::Session->create( inline_states => { Line 886  POE::Session->create( inline_states => {
886                                          search => $what,                                          search => $what,
887                                  )) {                                  )) {
888                                  _log "search [$what]: $res";                                  _log "search [$what]: $res";
889                                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );                                  $_[KERNEL]->post( $irc => privmsg => $nick, $res );
890                          }                          }
891    
892                          $res = '';                          $res = '';
# Line 887  POE::Session->create( inline_states => { Line 921  POE::Session->create( inline_states => {
921                                  " : " . ( $stat->{vote}->{'-'} || 0 ) . " --" .                                  " : " . ( $stat->{vote}->{'-'} || 0 ) . " --" .
922                                  " from " . ( join(", ", @nicks) || 'nobody' );                                  " from " . ( join(", ", @nicks) || 'nobody' );
923    
924                          $_[KERNEL]->post( $IRC_ALIAS => notice => $nick, $res );                          $_[KERNEL]->post( $irc => notice => $nick, $res );
925    
926                  } elsif ($msg =~ m/^ping/) {                  } elsif ($msg =~ m/^ping/) {
927                          $res = "ping = " . dump( $ping );                          $res = "ping = " . dump( $_stat->{ping} );
928                  } elsif ($msg =~ m/^conf(?:ig)*\s*(last-size|twitter)*\s*(.*)/) {                  } elsif ($msg =~ m/^conf(?:ig)*\s*(last-size|twitter)*\s*(.*)/) {
929                          if ( ! defined( $1 ) ) {                          if ( ! defined( $1 ) ) {
930                                  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 923  POE::Session->create( inline_states => { Line 957  POE::Session->create( inline_states => {
957                          }                          }
958                  } elsif ($msg =~ m/^rss-update/) {                  } elsif ($msg =~ m/^rss-update/) {
959                          $res = rss_fetch_all( $_[KERNEL] );                          $res = rss_fetch_all( $_[KERNEL] );
960                  } elsif ($msg =~ m/^rss-clean/) {                  } elsif ($msg =~ m/^rss-list/) {
961                          $_rss = undef;                          my $sth = $dbh->prepare(qq{ select url,name,last_update,active,channel,nick,private from feeds });
962                          $res = "OK, cleaned RSS cache";                          $sth->execute;
963                  } elsif ($msg =~ m!^rss-(add|remove|stop|start)\s+(http://\S+)\s*(.*)!) {                          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|clean)(?:-(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                                                                    clean   => qq{ update feeds set last_update = now() - delay where url = ? },
979                          };                          };
980                          if (my $q = $sql->{$1} ) {  
981                            if ( $command eq 'add' && ! $channel ) {
982                                    $res = "ERROR: got '$msg' which doesn't have #channel in it, ignoring!";
983                            } elsif (my $q = $sql->{$command} ) {
984                                  my $sth = $dbh->prepare( $q );                                  my $sth = $dbh->prepare( $q );
985                                  warn "## SQL $q ( $2 | $3 )\n";                                  my @data = ( $url );
986                                  eval { $sth->execute( $2, $3 ) };                                  if ( $command eq 'add' ) {
987                                            push @data, ( $arg, $channel, $nick, $sub eq 'private' ? 1 : 0 );
988                                    }
989                                    warn "## $command SQL $q with ",dump( @data ),"\n";
990                                    eval { $sth->execute( @data ) };
991                                    if ($@) {
992                                            $res = "ERROR: $@";
993                                    } else {
994                                            $res = "OK, RSS executed $command " . ( $sub ? "-$sub" : '' ) ."on $channel url $url";
995                                            if ( $command eq 'clean' ) {
996                                                    my $seen = $_stat->{rss}->{seen} || die "no seen?";
997                                                    my $want_link = $_stat->{rss}->{url2link}->{$url} || warn "no url2link($url)";
998                                                    foreach my $c ( keys %$seen ) {
999                                                            my $c_hash = $seen->{$c} || die "no seen->{$c}";
1000                                                            die "not HASH with rss links but ", dump($c_hash) unless ref($c_hash) eq 'HASH';
1001                                                            foreach my $link ( keys %$c_hash ) {
1002                                                                    next unless $link eq $want_link;
1003                                                                    _log "RSS removed seen $c $url $link";
1004                                                            }
1005                                                    }
1006                                            }
1007                                    }
1008                            } else {
1009                                    $res = "ERROR: don't know what to do with: $msg";
1010                          }                          }
1011                    } elsif ($msg =~ m/^rss-clean/) {
1012                          $res ||= "OK, RSS $1 : $2 - $3";                          # this makes sense because we didn't catch rss-clean http://... before!
1013                            $_stat->{rss} = undef;
1014                            $dbh->do( qq{ update feeds set last_update = now() - delay } );
1015                            $res = "OK, cleaned RSS cache";
1016                  }                  }
1017    
1018                  if ($res) {                  if ($res) {
1019                          _log ">> [$nick] $res";                          _log ">> [$nick] $res";
1020                          $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );                          $_[KERNEL]->post( $irc => privmsg => $nick, $res );
1021                  }                  }
1022    
1023                  rss_check_updates( $_[KERNEL] );                  rss_check_updates( $_[KERNEL] );
1024          },          },
1025            irc_372 => sub {
1026                    _log "<< motd",$_[ARG0],$_[ARG1];
1027            },
1028            irc_375 => sub {
1029                    _log "<< motd", $_[ARG0], "start";
1030            },
1031            irc_376 => sub {
1032                    _log "<< motd", $_[ARG0], "end";
1033            },
1034    #       irc_433 => sub {
1035    #               print "# irc_433: ",$_[ARG1], "\n";
1036    #               warn "## indetify $NICK\n";
1037    #               $_[KERNEL]->post( $irc => privmsg => 'nickserv', "IDENTIFY $NICK" );
1038    #       },
1039    #       irc_451 # please register
1040          irc_477 => sub {          irc_477 => sub {
1041                  _log "# irc_477: ",$_[ARG1];                  _log "<< irc_477: ",$_[ARG1];
1042                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "register $NICK" );                  _log ">> IDENTIFY $NICK";
1043                    $_[KERNEL]->post( $irc => privmsg => 'NickServ', "IDENTIFY $NICK" );
1044          },          },
1045          irc_505 => sub {          irc_505 => sub {
1046                  _log "# irc_505: ",$_[ARG1];                  _log "<< irc_505: ",$_[ARG1];
1047                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "register $NICK" );                  _log ">> register $NICK";
1048  #               $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "set hide email on" );                  $_[KERNEL]->post( $irc => privmsg => 'NickServ', "register $NICK" );
1049  #               $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "set email dpavlin\@rot13.org" );  #               $_[KERNEL]->post( $irc => privmsg => 'nickserv', "IDENTIFY $NICK" );
1050    #               $_[KERNEL]->post( $irc => privmsg => 'nickserv', "set hide email on" );
1051    #               $_[KERNEL]->post( $irc => privmsg => 'nickserv', "set email dpavlin\@rot13.org" );
1052          },          },
1053          irc_registered => sub {          irc_registered => sub {
1054                  _log "## registrated $NICK";                  _log "<< registered $NICK";
                 $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "IDENTIFY $NICK" );  
1055          },          },
1056          irc_disconnected => sub {          irc_disconnected => sub {
1057                  _log "## disconnected, reconnecting again";                  _log "## disconnected.. sleeping for $sleep_on_error seconds and reconnecting again";
1058                  $_[KERNEL]->post($IRC_ALIAS => connect => $CONNECT);                  sleep($sleep_on_error);
1059                    $_[KERNEL]->post( $irc => connect => {} );
1060          },          },
1061          irc_socketerr => sub {          irc_socketerr => sub {
1062                  _log "## socket error... sleeping for $sleep_on_error seconds and retry";                  _log "## socket error... sleeping for $sleep_on_error seconds and retry";
1063                  sleep($sleep_on_error);                  sleep($sleep_on_error);
1064                  $_[KERNEL]->post($IRC_ALIAS => connect => $CONNECT);                  $_[KERNEL]->post( $irc => connect => {} );
1065            },
1066            irc_notice => sub {
1067                    _log "<< notice from ", $_[ARG0], $_[ARG1], $_[ARG2];
1068                    my $m = $_[ARG2];
1069                    if ( $m =~ m!/msg.*(NickServ).*(IDENTIFY)!i ) {
1070                            _log ">> suggested to $1 $2";
1071                            $_[KERNEL]->post( $irc => privmsg => $1, "$2 $NICK" );
1072                    } elsif ( $m =~ m!\Q$NICK\E.*registered!i ) {
1073                            _log ">> registreted, so IDENTIFY";
1074                            $_[KERNEL]->post( $irc => privmsg => 'nickserv', "IDENTIFY $NICK" );
1075                    } else {
1076                            warn "## ignore $m\n";
1077                    }
1078            },
1079            irc_snotice => sub {
1080                    _log "<< snotice", $_[ARG0]; #dump( $_[ARG0],$_[ARG1], $_[ARG2] );
1081                    if ( $_[ARG0] =~ m!/(QUOTE)\s+(PASS\s+\d+)!i ) {
1082                            warn ">> $1 | $2\n";
1083                            $_[KERNEL]->post( $irc => lc($1) => $2);
1084                    }
1085          },          },
 #       irc_433 => sub {  
 #               print "# irc_433: ",$_[ARG1], "\n";  
 #               warn "## indetify $NICK\n";  
 #               $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "IDENTIFY $NICK" );  
 #       },  
1086      _child => sub {},      _child => sub {},
1087      _default => sub {      _default => sub {
1088                  _log sprintf "sID:%s %s %s",                  _log sprintf "sID:%s %s %s",
# Line 992  POE::Session->create( inline_states => { Line 1097  POE::Session->create( inline_states => {
1097    
1098  # http server  # http server
1099    
1100    _log "WEB archive at $url";
1101    
1102  my $httpd = POE::Component::Server::HTTP->new(  my $httpd = POE::Component::Server::HTTP->new(
1103          Port => $http_port,          Port => $http_port,
1104          PreHandler => {          PreHandler => {
# Line 1038  foreach my $c (@cols) { Line 1145  foreach my $c (@cols) {
1145          $style .= ".col-${max_color} { background: $c }\n";          $style .= ".col-${max_color} { background: $c }\n";
1146          $max_color++;          $max_color++;
1147  }  }
1148  warn "defined $max_color colors for users...\n";  _log "WEB defined $max_color colors for users...";
1149    
1150  sub root_handler {  sub root_handler {
1151          my ($request, $response) = @_;          my ($request, $response) = @_;
# Line 1060  sub root_handler { Line 1167  sub root_handler {
1167          }          }
1168    
1169          my $search = $q->param('search') || $q->param('grep') || '';          my $search = $q->param('search') || $q->param('grep') || '';
1170            my $r_url = $request->url;
1171    
1172            my @commands = qw( tags last-tag follow stat );
1173            my $commands_re = join('|',@commands);
1174    
1175          if ($request->url =~ m#/rss(?:/(tags|last-tag|follow.*)\w*(?:=(\d+))?)?#i) {          if ($r_url =~ m#/rss(?:/($commands_re.*)\w*(?:=(\d+))?)?#i) {
1176                  my $show = lc($1);                  my $show = lc($1);
1177                  my $nr = $2;                  my $nr = $2;
1178    
# Line 1075  sub root_handler { Line 1186  sub root_handler {
1186                  my $feed = XML::Feed->new( $type );                  my $feed = XML::Feed->new( $type );
1187                  $feed->link( $url );                  $feed->link( $url );
1188    
1189                    my $rc = RC_OK;
1190    
1191                  if ( $show eq 'tags' ) {                  if ( $show eq 'tags' ) {
1192                          $nr ||= 50;                          $nr ||= 50;
1193                          $feed->title( "tags from $CHANNEL" );                          $feed->title( "tags from $CHANNEL" );
# Line 1144  sub root_handler { Line 1257  sub root_handler {
1257                                  $feed->add_entry( $feed_entry );                                  $feed->add_entry( $feed_entry );
1258                          }                          }
1259    
1260                    } elsif ( $show =~ m/^stat/ ) {
1261    
1262                            my $feed_entry = XML::Feed::Entry->new($type);
1263                            $feed_entry->title( "Internal stats" );
1264                            $feed_entry->content(
1265                                    '<![CDATA[<pre>' . dump( $_stat ) . '</pre>]]>'
1266                            );
1267                            $feed->add_entry( $feed_entry );
1268    
1269                  } else {                  } else {
1270                          _log "unknown rss request ",$request->url;                          _log "WEB unknown rss request $r_url";
1271                          return RC_DENY;                          $feed->title( "unknown $r_url" );
1272                            foreach my $c ( @commands ) {
1273                                    my $feed_entry = XML::Feed::Entry->new($type);
1274                                    $feed_entry->title( "rss/$c" );
1275                                    $feed_entry->link( "$url/rss/$c" );
1276                                    $feed->add_entry( $feed_entry );
1277                            }
1278                            $rc = RC_DENY;
1279                  }                  }
1280    
1281                  $response->content( $feed->as_xml );                  $response->content( $feed->as_xml );
1282                  return RC_OK;                  return $rc;
1283          }          }
1284    
1285          if ( $@ ) {          if ( $@ ) {
Legend:
Removed from v.89  
changed lines
  Added in v.117
  ViewVC Help
Powered by ViewVC 1.1.26