/[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 119 by dpavlin, Fri Mar 14 00:17: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    use IPC::DirQueue;
22    use File::Slurp;
23    
24  =head1 NAME  =head1 NAME
25    
26  irc-logger.pl  irc-logger.pl
# Line 20  Import log from C<dircproxy> to C<irc-lo Line 39  Import log from C<dircproxy> to C<irc-lo
39    
40  =item --log=irc-logger.log  =item --log=irc-logger.log
41    
 Name of log file  
   
 =item --follow=file.log  
   
 Follows new messages in file  
   
42  =back  =back
43    
44  =head1 DESCRIPTION  =head1 DESCRIPTION
# Line 36  log all conversation on irc channel Line 49  log all conversation on irc channel
49    
50  ## CONFIG  ## CONFIG
51    
52    my $debug = 0;
53    
54    my $irc_config = {
55            nick => 'irc-logger',
56            server => 'irc.freenode.net',
57            port => 6667,
58            ircname => 'Anna the bot: try /msg irc-logger help',
59    };
60    
61    my $queue_dir = './queue';
62    
63  my $HOSTNAME = `hostname -f`;  my $HOSTNAME = `hostname -f`;
64  chomp($HOSTNAME);  chomp($HOSTNAME);
65    
66  my $NICK = 'irc-logger';  
 $NICK .= '-dev' if ($HOSTNAME =~ m/llin/);  
 my $CONNECT =  
   {Server => 'irc.freenode.net',  
    Nick => $NICK,  
    Ircname => "try /msg $NICK help",  
   };  
67  my $CHANNEL = '#razmjenavjestina';  my $CHANNEL = '#razmjenavjestina';
 $CHANNEL = '#irc-logger' if ($HOSTNAME =~ m/llin/);  
 my $IRC_ALIAS = "log";  
68    
69  # default log to follow and announce messages  if ( $HOSTNAME =~ m/llin/ ) {
70  my $follows_path = 'follows.log';          $irc_config->{nick} = 'irc-logger-llin';
71    #       $irc_config = {
72    #               nick => 'irc-logger-llin',
73    #               server => 'localhost',
74    #               port => 6668,
75    #       };
76            $CHANNEL = '#irc-logger';
77    } elsif ( $HOSTNAME =~ m/lugarin/ ) {
78            $irc_config->{server} = 'irc.carnet.hr';
79            $CHANNEL = '#riss';
80    }
81    
82    my @channels = ( $CHANNEL );
83    
84    warn "# config = ", dump( $irc_config ), $/;
85    
86    my $NICK = $irc_config->{nick} or die "no nick?";
87    
88  my $DSN = 'DBI:Pg:dbname=' . $NICK;  my $DSN = 'DBI:Pg:dbname=' . $NICK;
89    
# Line 64  my $last_x_tags = 50; Line 96  my $last_x_tags = 50;
96    
97  # don't pull rss feeds more often than this  # don't pull rss feeds more often than this
98  my $rss_min_delay = 60;  my $rss_min_delay = 60;
 $rss_min_delay = 15;  
99    
100  my $http_port = $NICK =~ m/-dev/ ? 8001 : 8000;  my $http_port = $NICK =~ m/-dev/ ? 8001 : 8000;
101    
# Line 72  my $url = "http://$HOSTNAME:$http_port"; Line 103  my $url = "http://$HOSTNAME:$http_port";
103    
104  ## END CONFIG  ## END CONFIG
105    
 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;  
   
106  my $use_twitter = 1;  my $use_twitter = 1;
107  eval { require Net::Twitter; };  eval { require Net::Twitter; };
108  $use_twitter = 0 if ($@);  $use_twitter = 0 if ($@);
# Line 97  my $import_dircproxy; Line 111  my $import_dircproxy;
111  my $log_path;  my $log_path;
112  GetOptions(  GetOptions(
113          'import-dircproxy:s' => \$import_dircproxy,          'import-dircproxy:s' => \$import_dircproxy,
         'follows:s' => \$follows_path,  
114          'log:s' => \$log_path,          'log:s' => \$log_path,
115            'queue:s' => \$queue_dir,
116  );  );
117    
118  #$SIG{__DIE__} = sub {  #$SIG{__DIE__} = sub {
119  #       confess "fatal error";  #       confess "fatal error";
120  #};  #};
121    
 open(STDOUT, '>', $log_path) || warn "can't redirect log to $log_path: $!";  
   
122  sub _log {  sub _log {
123          print strftime($TIMESTAMP,localtime()) . ' ' . join(" ",@_) . $/;          print strftime($TIMESTAMP,localtime()) . ' ' . join(" ",map { ref($_) ? dump( $_ ) : $_ } @_) . $/;
124  }  }
125    
126  # LOG following  open(STDOUT, '>', $log_path) && warn "log to $log_path: $!\n";
127    
128  my %FOLLOWS =  # queue
   (  
 #   ACCESS => "/var/log/apache/access.log",  
 #   ERROR => "/var/log/apache/error.log",  
   );  
129    
130  sub add_follow_path {  if ( ! -d $queue_dir ) {
131          my $path = shift;          warn "## creating queue directory $queue_dir";
132          my $name = $path;          mkdir $queue_dir or die "can't create queue directory $queue_dir: $!";
         $name =~ s/\..*$//;  
         warn "# using $path to announce messages from $name\n";  
         $FOLLOWS{$name} = $path;  
133  }  }
134    
135  add_follow_path( $follows_path ) if ( -e $follows_path );  my $dq = IPC::DirQueue->new({ dir => $queue_dir });
136    
137  # HTML formatters  # HTML formatters
138    
# Line 146  my $filter = { Line 151  my $filter = {
151                  # protect HTML from wiki modifications                  # protect HTML from wiki modifications
152                  sub e {                  sub e {
153                          my $t = shift;                          my $t = shift;
154                          return 'uri_unescape{' . uri_escape($t) . '}';                          return 'uri_unescape{' . uri_escape($t, '^a-zA-Z0-9') . '}';
155                  }                  }
156    
157                  $m =~ s/($escape_re)/$escape{$1}/gs;                  $m =~ s/($escape_re)/$escape{$1}/gs;
158                  $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;
159                  $m =~ s#\/(\w+)\/#<i>$1</i>#gs;                  $m =~ s#\/(\w+)\/#<i>$1</i>#gs;
160                  $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;
161                  $m =~ s#\*(\w+)\*#<b>$1</b>#gs;                  $m =~ s#\*(\w+)\*#<b>$1</b>#gs;
# Line 171  my $filter = { Line 176  my $filter = {
176          },          },
177  };  };
178    
179    # POE IRC
180    my $poe_irc = POE::Component::IRC->spawn( %$irc_config ) or
181            die "can't start ", dump( $irc_config ), ": $!";
182    
183    my $irc = $poe_irc->session_id();
184    _log "IRC session_id $irc";
185    
186  my $dbh = DBI->connect($DSN,"","", { RaiseError => 1, AutoCommit => 1 }) || die $DBI::errstr;  my $dbh = DBI->connect($DSN,"","", { RaiseError => 1, AutoCommit => 1 }) || die $DBI::errstr;
187  $dbh->do( qq{ set client_encoding = 'UTF-8' } );  $dbh->do( qq{ set client_encoding = 'UTF-8' } );
188    
# Line 207  create table feeds ( Line 219  create table feeds (
219          name text,          name text,
220          delay interval not null default '5 min',          delay interval not null default '5 min',
221          active boolean default true,          active boolean default true,
222            channel text not null,
223            nick text not null,
224            private boolean default false,
225          last_update timestamp default 'now()',          last_update timestamp default 'now()',
226          polls int default 0,          polls int default 0,
227          updates int default 0          updates int default 0
228  );  );
229  create unique index feeds_url on feeds(url);  create unique index feeds_url on feeds(url);
230  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');
231          },          },
232  };  };
233    
# Line 256  sub meta { Line 271  sub meta {
271                  if ( $@ || ! $sth->rows ) {                  if ( $@ || ! $sth->rows ) {
272                          $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()) });
273                          $sth->execute( $value, $nick, $channel, $name );                          $sth->execute( $value, $nick, $channel, $name );
274                          _log "created $nick/$channel/$name = $value";                          warn "## created $nick/$channel/$name = $value\n";
275                  } else {                  } else {
276                          _log "updated $nick/$channel/$name = $value ";                          warn "## updated $nick/$channel/$name = $value\n";
277                  }                  }
278    
279                  return $value;                  return $value;
# Line 268  sub meta { Line 283  sub meta {
283                  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 = ? });
284                  $sth->execute( $nick, $channel, $name );                  $sth->execute( $nick, $channel, $name );
285                  my ($v,$c) = $sth->fetchrow_array;                  my ($v,$c) = $sth->fetchrow_array;
286                  _log "fetched $nick/$channel/$name = $v [$c]";                  warn "## fetched $nick/$channel/$name = $v [$c]\n";
287                  return ($v,$c) if wantarray;                  return ($v,$c) if wantarray;
288                  return $v;                  return $v;
289    
# Line 365  sub get_from_log { Line 380  sub get_from_log {
380    
381          my @where;          my @where;
382          my @args;          my @args;
383            my $msg;
384    
385          if (my $search = $args->{search}) {          if (my $search = $args->{search}) {
386                  $search =~ s/^\s+//;                  $search =~ s/^\s+//;
387                  $search =~ s/\s+$//;                  $search =~ s/\s+$//;
388                  push @where, 'message ilike ? or nick ilike ?';                  push @where, 'message ilike ? or nick ilike ?';
389                  push @args, ( ( '%' . $search . '%' ) x 2 );                  push @args, ( ( '%' . $search . '%' ) x 2 );
390                  _log "search for '$search'";                  $msg = "Search for '$search'";
391          }          }
392    
393          if ($args->{tag} && $tags->{ $args->{tag} }) {          if ($args->{tag} && $tags->{ $args->{tag} }) {
394                  push @where, 'id in (' . join(',', @{ $tags->{ $args->{tag} } }) . ')';                  push @where, 'id in (' . join(',', @{ $tags->{ $args->{tag} } }) . ')';
395                  _log "search for tags $args->{tag}";                  $msg = "Search for tags $args->{tag}";
396          }          }
397    
398          if (my $date = $args->{date} ) {          if (my $date = $args->{date} ) {
399                  $date = check_date( $date );                  $date = check_date( $date );
400                  push @where, 'date(time) = ?';                  push @where, 'date(time) = ?';
401                  push @args, $date;                  push @args, $date;
402                  _log "search for date $date";                  $msg = "search for date $date";
403          }          }
404    
405          $sql .= " where " . join(" and ", @where) if @where;          $sql .= " where " . join(" and ", @where) if @where;
# Line 397  sub get_from_log { Line 413  sub get_from_log {
413          eval { $sth->execute( @args ) };          eval { $sth->execute( @args ) };
414          return if $@;          return if $@;
415    
416            my $nr_results = $sth->rows;
417    
418          my $last_row = {          my $last_row = {
419                  date => '',                  date => '',
420                  time => '',                  time => '',
# Line 417  sub get_from_log { Line 435  sub get_from_log {
435    
436          return @rows if ($args->{full_rows});          return @rows if ($args->{full_rows});
437    
438          my @msgs = (          $msg .= ' produced ' . (
439                  "Showing " . ($#rows + 1) . " messages..."                  $nr_results == 0 ? 'no results' :
440                    $nr_results == 0 ? 'one result' :
441                            $nr_results . ' results'
442          );          );
443    
444            my @msgs = ( $msg );
445    
446          if ($context) {          if ($context) {
447                  my @ids = @rows;                  my @ids = @rows;
448                  @rows = ();                  @rows = ();
# Line 477  sub get_from_log { Line 499  sub get_from_log {
499  #                       $row->{nick} = $nick;  #                       $row->{nick} = $nick;
500  #               }  #               }
501    
502                    $append = 0 if $row->{me};
503    
504                  if ($last_row->{nick} ne $nick) {                  if ($last_row->{nick} ne $nick) {
505                          # 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
506                          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 664  if ($import_dircproxy) {
664  # RSS follow  # RSS follow
665  #  #
666    
667  my $_rss;  my $_stat;
668    
669    
670  sub rss_fetch {  sub rss_fetch {
671          my ($args) = @_;          my ($args) = @_;
672    
673    
674          # 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?
675          my $send_rss_msgs = 1;          my $send_rss_msgs = 1;
676    
# Line 656  sub rss_fetch { Line 681  sub rss_fetch {
681                  _log("can't fetch RSS ", $args->{url});                  _log("can't fetch RSS ", $args->{url});
682                  return;                  return;
683          }          }
684    
685            $_stat->{rss}->{url2link}->{ $args->{url} } = $feed->link;
686    
687          my ( $total, $updates ) = ( 0, 0 );          my ( $total, $updates ) = ( 0, 0 );
688          for my $entry ($feed->entries) {          for my $entry ($feed->entries) {
689                  $total++;                  $total++;
690    
691                  # seen allready?                  # seen allready?
692                  return if $_rss->{$feed->link}->{seen}->{$entry->id}++ > 0;                  next if $_stat->{rss}->{seen}->{$args->{channel}}->{$feed->link}->{$entry->id}++ > 0;
693    
694                  sub prefix {                  sub prefix {
695                          my ($txt,$var) = @_;                          my ($txt,$var) = @_;
696                            $var =~ s/\s+/ /gs;
697                          $var =~ s/^\s+//g;                          $var =~ s/^\s+//g;
698                            $var =~ s/\s+$//g;
699                          return $txt . $var if $var;                          return $txt . $var if $var;
700                  }                  }
701    
702                    # fix absolute and relative links to feed entries
703                    my $link = $entry->link;
704                    if ( $link =~ m!^/! ) {
705                            my $host = $args->{url};
706                            $host =~ s!^(http://[^/]+).*$!$1!;      #!vim
707                            $link = "$host/$link";
708                    } elsif ( $link !~ m!^http! ) {
709                            $link = $args->{url} . $link;
710                    }
711    
712                  my $msg;                  my $msg;
713                  $msg .= prefix( 'From: ' , $feed->title );                  $msg .= prefix( 'From: ' , $args->{name} || $feed->title );
714                  $msg .= prefix( ' by ' , $entry->author );                  $msg .= prefix( ' by ' , $entry->author );
715                  $msg .= prefix( ' -- ' , $entry->link );                  $msg .= prefix( ' | ' , $entry->title );
716                    $msg .= prefix( ' | ' , $link );
717  #               $msg .= prefix( ' id ' , $entry->id );  #               $msg .= prefix( ' id ' , $entry->id );
718                    if ( my $tags = $entry->category ) {
719                            $tags =~ s!^\s+!!;
720                            $tags =~ s!\s*$! !;
721                            $tags =~ s!,?\s+!// !g;
722                            $msg .= prefix( ' ' , $tags );
723                    }
724    
725                  if ( $args->{kernel} && $send_rss_msgs ) {                  if ( $args->{kernel} && $send_rss_msgs ) {
726                          $send_rss_msgs--;                          $send_rss_msgs--;
727                          _log('RSS', $msg);                          if ( ! $args->{private} ) {
728                          $sth_insert_log->execute( $CHANNEL, 1, $NICK, $msg, undef );                                  # FIXME bug! should be save_message
729                          $args->{kernel}->post( $IRC_ALIAS => notice => $CHANNEL, $msg );                                  save_message( channel => $args->{channel}, me => 1, nick => $NICK, message => $msg );
730    #                               $sth_insert_log->execute( $args->{channel}, 1, $NICK, $msg, 'now()' );
731                            }
732                            my ( $type, $to ) = ( 'notice', $args->{channel} );
733                            ( $type, $to ) = ( 'privmsg', $args->{nick} ) if $args->{private};
734    
735                            _log(">> $type $to", $msg);
736    #                       $args->{kernel}->post( $irc => $type => $to, $msg );
737                            # XXX enqueue message to send later
738                            sub enqueue_post {
739                                    my $post = dump( @_ );
740                                    warn "## queue_post $post\n" if $debug;
741                                    $dq->enqueue_string( $post );
742                            }
743                            enqueue_post( $type => $to => $msg );
744    
745                          $updates++;                          $updates++;
746                  }                  }
747          }          }
# Line 697  sub rss_fetch { Line 759  sub rss_fetch {
759  sub rss_fetch_all {  sub rss_fetch_all {
760          my $kernel = shift;          my $kernel = shift;
761          my $sql = qq{          my $sql = qq{
762                  select id, url, name                  select id, url, name, channel, nick, private
763                  from feeds                  from feeds
764                  where active is true                  where active is true
765          };          };
# Line 717  sub rss_fetch_all { Line 779  sub rss_fetch_all {
779    
780  sub rss_check_updates {  sub rss_check_updates {
781          my $kernel = shift;          my $kernel = shift;
782          my $last_t = $_rss->{last_poll} || time();          $_stat->{rss}->{last_poll} ||= time();
783          my $t = time();          my $dt = time() - $_stat->{rss}->{last_poll};
784          if ( $last_t - $t > $rss_min_delay ) {          if ( $dt > $rss_min_delay ) {
785                  $_rss->{last_poll} = $t;                  warn "## rss_check_updates $dt > $rss_min_delay\n";
786                    $_stat->{rss}->{last_poll} = time();
787                  _log rss_fetch_all( $kernel );                  _log rss_fetch_all( $kernel );
788          }          }
789            # XXX send queue messages
790            while ( my $job = $dq->pickup_queued_job() ) {
791                    my $data = read_file( $job->get_data_path ) || die "can't load ", $job->get_data_path, ": $!";
792    #               $kernel->post( $irc => $type => $to, $msg );
793                    my @data = eval $data;
794                    _log ">> post from queue ", $irc, @data;
795                    $kernel->post( $irc => @data );
796                    $job->finish;
797                    warn "## done queued job: ",dump( @data ) if $debug;
798            }
799  }  }
800    
801  # 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
802  _log rss_fetch_all;  _log rss_fetch_all if ! $debug;
   
 #  
 # 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);  
803    
804  POE::Session->create( inline_states => {  POE::Session->create( inline_states => {
805          _start => sub {                _start => sub {      
806                  $_[KERNEL]->post($IRC_ALIAS => register => 'all');                  $_[KERNEL]->post( $irc => register => 'all' );
807                  $_[KERNEL]->post($IRC_ALIAS => connect => $CONNECT);                  $_[KERNEL]->post( $irc => connect => {} );
808      },      },
809            irc_001 => sub {
810                    my ($kernel,$sender) = @_[KERNEL,SENDER];
811                    my $poco_object = $sender->get_heap();
812                    _log "connected to",$poco_object->server_name();
813                    $kernel->post( $sender => join => $_ ) for @channels;
814                    undef;
815            },
816      irc_255 => sub {    # server is done blabbing      irc_255 => sub {    # server is done blabbing
817                  $_[KERNEL]->post($IRC_ALIAS => join => $CHANNEL);                  $_[KERNEL]->post( $irc => join => $CHANNEL);
                 $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "IDENTIFY $NICK" );  
818      },      },
819      irc_public => sub {      irc_public => sub {
820                  my $kernel = $_[KERNEL];                  my $kernel = $_[KERNEL];
# Line 755  POE::Session->create( inline_states => { Line 824  POE::Session->create( inline_states => {
824    
825                  save_message( channel => $channel, me => 0, nick => $nick, message => $msg);                  save_message( channel => $channel, me => 0, nick => $nick, message => $msg);
826                  meta( $nick, $channel, 'last-msg', $msg );                  meta( $nick, $channel, 'last-msg', $msg );
827                    rss_check_updates( $kernel );
828      },      },
829      irc_ctcp_action => sub {      irc_ctcp_action => sub {
830                  my $kernel = $_[KERNEL];                  my $kernel = $_[KERNEL];
# Line 776  POE::Session->create( inline_states => { Line 846  POE::Session->create( inline_states => {
846      },      },
847          irc_ping => sub {          irc_ping => sub {
848                  _log( "pong ", $_[ARG0] );                  _log( "pong ", $_[ARG0] );
849                  $ping->{ $_[ARG0] }++;                  $_stat->{ping}->{ $_[ARG0] }++;
850                  rss_check_updates( $_[KERNEL] );                  rss_check_updates( $_[KERNEL] );
851          },          },
852          irc_invite => sub {          irc_invite => sub {
# Line 786  POE::Session->create( inline_states => { Line 856  POE::Session->create( inline_states => {
856    
857                  _log "invited to $channel by $nick";                  _log "invited to $channel by $nick";
858    
859                  $_[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..." );
860                  $_[KERNEL]->post($IRC_ALIAS => join => $channel);                  $_[KERNEL]->post( $irc => 'join' => $channel );
861    
862          },          },
863          irc_msg => sub {          irc_msg => sub {
# Line 795  POE::Session->create( inline_states => { Line 865  POE::Session->create( inline_states => {
865                  my $nick = (split /!/, $_[ARG0])[0];                  my $nick = (split /!/, $_[ARG0])[0];
866                  my $msg = $_[ARG2];                  my $msg = $_[ARG2];
867                  my $channel = $_[ARG1]->[0];                  my $channel = $_[ARG1]->[0];
868                    warn "# ARG = ",dump( @_[ARG0,ARG1,ARG2] ) if $debug;
869    
870                  my $res = "unknown command '$msg', try /msg $NICK help!";                  my $res = "unknown command '$msg', try /msg $NICK help!";
871                  my @out;                  my @out;
# Line 805  POE::Session->create( inline_states => { Line 876  POE::Session->create( inline_states => {
876    
877                          $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";
878    
879                  } elsif ($msg =~ m/^msg\s+(\S+)\s+(.*)$/i) {                  } elsif ($msg =~ m/^(privmsg|notice)\s+(\S+)\s+(.*)$/i) {
880    
881                          _log ">> /msg $1 $2";                          _log ">> /$1 $2 $3";
882                          $_[KERNEL]->post( $IRC_ALIAS => privmsg => $1, $2 );                          $_[KERNEL]->post( $irc => $1 => $2, $3 );
883                          $res = '';                          $res = '';
884    
885                  } elsif ($msg =~ m/^stat.*?\s*(\d*)/i) {                  } elsif ($msg =~ m/^stat.*?\s*(\d*)/i) {
# Line 838  POE::Session->create( inline_states => { Line 909  POE::Session->create( inline_states => {
909    
910                          foreach my $res (get_from_log( limit => $limit )) {                          foreach my $res (get_from_log( limit => $limit )) {
911                                  _log "last: $res";                                  _log "last: $res";
912                                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );                                  $_[KERNEL]->post( $irc => privmsg => $nick, $res );
913                          }                          }
914    
915                          $res = '';                          $res = '';
# Line 852  POE::Session->create( inline_states => { Line 923  POE::Session->create( inline_states => {
923                                          search => $what,                                          search => $what,
924                                  )) {                                  )) {
925                                  _log "search [$what]: $res";                                  _log "search [$what]: $res";
926                                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );                                  $_[KERNEL]->post( $irc => privmsg => $nick, $res );
927                          }                          }
928    
929                          $res = '';                          $res = '';
# Line 887  POE::Session->create( inline_states => { Line 958  POE::Session->create( inline_states => {
958                                  " : " . ( $stat->{vote}->{'-'} || 0 ) . " --" .                                  " : " . ( $stat->{vote}->{'-'} || 0 ) . " --" .
959                                  " from " . ( join(", ", @nicks) || 'nobody' );                                  " from " . ( join(", ", @nicks) || 'nobody' );
960    
961                          $_[KERNEL]->post( $IRC_ALIAS => notice => $nick, $res );                          $_[KERNEL]->post( $irc => notice => $nick, $res );
962    
963                  } elsif ($msg =~ m/^ping/) {                  } elsif ($msg =~ m/^ping/) {
964                          $res = "ping = " . dump( $ping );                          $res = "ping = " . dump( $_stat->{ping} );
965                  } elsif ($msg =~ m/^conf(?:ig)*\s*(last-size|twitter)*\s*(.*)/) {                  } elsif ($msg =~ m/^conf(?:ig)*\s*(last-size|twitter)*\s*(.*)/) {
966                          if ( ! defined( $1 ) ) {                          if ( ! defined( $1 ) ) {
967                                  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 994  POE::Session->create( inline_states => {
994                          }                          }
995                  } elsif ($msg =~ m/^rss-update/) {                  } elsif ($msg =~ m/^rss-update/) {
996                          $res = rss_fetch_all( $_[KERNEL] );                          $res = rss_fetch_all( $_[KERNEL] );
997                  } elsif ($msg =~ m/^rss-clean/) {                  } elsif ($msg =~ m/^rss-list/) {
998                          $_rss = undef;                          my $sth = $dbh->prepare(qq{ select url,name,last_update,active,channel,nick,private from feeds });
999                          $res = "OK, cleaned RSS cache";                          $sth->execute;
1000                  } elsif ($msg =~ m!^rss-(add|remove|stop|start)\s+(http://\S+)\s*(.*)!) {                          while (my @row = $sth->fetchrow_array) {
1001                                    $_[KERNEL]->post( $irc => privmsg => $nick, join(' | ',@row) );
1002                            }
1003                            $res = '';
1004                    } elsif ($msg =~ m!^rss-(add|remove|stop|start|clean)(?:-(private))?\s+(http://\S+)\s*(.*)!) {
1005                            my ( $command, $sub, $url, $arg ) = ( $1,$2,$3,$4 );
1006    
1007                            my $channel = $1 if ( $arg =~ s/\s*(#\S+)\s*// );
1008                            $channel = $nick if $sub eq 'private';
1009    
1010                          my $sql = {                          my $sql = {
1011                                  add             => qq{ insert into feeds (url,name) values (?,?) },                                  add     => qq{ insert into feeds (url,name,channel,nick,private) values (?,?,?,?,?) },
1012  #                               remove  => qq{ delete from feeds                                where url = ? and name = ? },  #                               remove  => qq{ delete from feeds                                where url = ? and name = ? },
1013                                  start   => qq{ update feeds set active = true   where url = ? -- ? },                                  start   => qq{ update feeds set active = true   where url = ? },
1014                                  stop    => qq{ update feeds set active = false  where url = ? -- ? },                                  stop    => qq{ update feeds set active = false  where url = ? },
1015                                                                    clean   => qq{ update feeds set last_update = now() - delay where url = ? },
1016                          };                          };
1017                          if (my $q = $sql->{$1} ) {  
1018                            if ( $command eq 'add' && ! $channel ) {
1019                                    $res = "ERROR: got '$msg' which doesn't have #channel in it, ignoring!";
1020                            } elsif (my $q = $sql->{$command} ) {
1021                                  my $sth = $dbh->prepare( $q );                                  my $sth = $dbh->prepare( $q );
1022                                  warn "## SQL $q ( $2 | $3 )\n";                                  my @data = ( $url );
1023                                  eval { $sth->execute( $2, $3 ) };                                  if ( $command eq 'add' ) {
1024                                            push @data, ( $arg, $channel, $nick, $sub eq 'private' ? 1 : 0 );
1025                                    }
1026                                    warn "## $command SQL $q with ",dump( @data ),"\n";
1027                                    eval { $sth->execute( @data ) };
1028                                    if ($@) {
1029                                            $res = "ERROR: $@";
1030                                    } else {
1031                                            $res = "OK, RSS executed $command " . ( $sub ? "-$sub" : '' ) ."on $channel url $url";
1032                                            if ( $command eq 'clean' ) {
1033                                                    my $seen = $_stat->{rss}->{seen} || die "no seen?";
1034                                                    my $want_link = $_stat->{rss}->{url2link}->{$url} || warn "no url2link($url)";
1035                                                    foreach my $c ( keys %$seen ) {
1036                                                            my $c_hash = $seen->{$c} || die "no seen->{$c}";
1037                                                            die "not HASH with rss links but ", dump($c_hash) unless ref($c_hash) eq 'HASH';
1038                                                            foreach my $link ( keys %$c_hash ) {
1039                                                                    next unless $link eq $want_link;
1040                                                                    _log "RSS removed seen $c $url $link";
1041                                                            }
1042                                                    }
1043                                            }
1044                                    }
1045                            } else {
1046                                    $res = "ERROR: don't know what to do with: $msg";
1047                          }                          }
1048                    } elsif ($msg =~ m/^rss-clean/) {
1049                          $res ||= "OK, RSS $1 : $2 - $3";                          # this makes sense because we didn't catch rss-clean http://... before!
1050                            $_stat->{rss} = undef;
1051                            $dbh->do( qq{ update feeds set last_update = now() - delay } );
1052                            $res = "OK, cleaned RSS cache";
1053                  }                  }
1054    
1055                  if ($res) {                  if ($res) {
1056                          _log ">> [$nick] $res";                          _log ">> [$nick] $res";
1057                          $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );                          $_[KERNEL]->post( $irc => privmsg => $nick, $res );
1058                  }                  }
1059    
1060                  rss_check_updates( $_[KERNEL] );                  rss_check_updates( $_[KERNEL] );
1061          },          },
1062            irc_372 => sub {
1063                    _log "<< motd",$_[ARG0],$_[ARG1];
1064            },
1065            irc_375 => sub {
1066                    _log "<< motd", $_[ARG0], "start";
1067            },
1068            irc_376 => sub {
1069                    _log "<< motd", $_[ARG0], "end";
1070            },
1071    #       irc_433 => sub {
1072    #               print "# irc_433: ",$_[ARG1], "\n";
1073    #               warn "## indetify $NICK\n";
1074    #               $_[KERNEL]->post( $irc => privmsg => 'nickserv', "IDENTIFY $NICK" );
1075    #       },
1076    #       irc_451 # please register
1077          irc_477 => sub {          irc_477 => sub {
1078                  _log "# irc_477: ",$_[ARG1];                  _log "<< irc_477: ",$_[ARG1];
1079                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "register $NICK" );                  _log ">> IDENTIFY $NICK";
1080                    $_[KERNEL]->post( $irc => privmsg => 'NickServ', "IDENTIFY $NICK" );
1081          },          },
1082          irc_505 => sub {          irc_505 => sub {
1083                  _log "# irc_505: ",$_[ARG1];                  _log "<< irc_505: ",$_[ARG1];
1084                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "register $NICK" );                  _log ">> register $NICK";
1085  #               $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "set hide email on" );                  $_[KERNEL]->post( $irc => privmsg => 'NickServ', "register $NICK" );
1086  #               $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "set email dpavlin\@rot13.org" );  #               $_[KERNEL]->post( $irc => privmsg => 'nickserv', "IDENTIFY $NICK" );
1087    #               $_[KERNEL]->post( $irc => privmsg => 'nickserv', "set hide email on" );
1088    #               $_[KERNEL]->post( $irc => privmsg => 'nickserv', "set email dpavlin\@rot13.org" );
1089          },          },
1090          irc_registered => sub {          irc_registered => sub {
1091                  _log "## registrated $NICK";                  _log "<< registered $NICK";
                 $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "IDENTIFY $NICK" );  
1092          },          },
1093          irc_disconnected => sub {          irc_disconnected => sub {
1094                  _log "## disconnected, reconnecting again";                  _log "## disconnected.. sleeping for $sleep_on_error seconds and reconnecting again";
1095                  $_[KERNEL]->post($IRC_ALIAS => connect => $CONNECT);                  sleep($sleep_on_error);
1096                    $_[KERNEL]->post( $irc => connect => {} );
1097          },          },
1098          irc_socketerr => sub {          irc_socketerr => sub {
1099                  _log "## socket error... sleeping for $sleep_on_error seconds and retry";                  _log "## socket error... sleeping for $sleep_on_error seconds and retry";
1100                  sleep($sleep_on_error);                  sleep($sleep_on_error);
1101                  $_[KERNEL]->post($IRC_ALIAS => connect => $CONNECT);                  $_[KERNEL]->post( $irc => connect => {} );
1102            },
1103            irc_notice => sub {
1104                    _log "<< notice from ", $_[ARG0], $_[ARG1], $_[ARG2];
1105                    my $m = $_[ARG2];
1106                    if ( $m =~ m!/msg.*(NickServ).*(IDENTIFY)!i ) {
1107                            _log ">> suggested to $1 $2";
1108                            $_[KERNEL]->post( $irc => privmsg => $1, "$2 $NICK" );
1109                    } elsif ( $m =~ m!\Q$NICK\E.*registered!i ) {
1110                            _log ">> registreted, so IDENTIFY";
1111                            $_[KERNEL]->post( $irc => privmsg => 'nickserv', "IDENTIFY $NICK" );
1112                    } else {
1113                            warn "## ignore $m\n" if $debug;
1114                    }
1115            },
1116            irc_snotice => sub {
1117                    _log "<< snotice", $_[ARG0]; #dump( $_[ARG0],$_[ARG1], $_[ARG2] );
1118                    if ( $_[ARG0] =~ m!/(QUOTE)\s+(PASS\s+\d+)!i ) {
1119                            warn ">> $1 | $2\n";
1120                            $_[KERNEL]->post( $irc => lc($1) => $2);
1121                    }
1122          },          },
 #       irc_433 => sub {  
 #               print "# irc_433: ",$_[ARG1], "\n";  
 #               warn "## indetify $NICK\n";  
 #               $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "IDENTIFY $NICK" );  
 #       },  
1123      _child => sub {},      _child => sub {},
1124      _default => sub {      _default => sub {
1125                  _log sprintf "sID:%s %s %s",                  _log sprintf "sID:%s %s %s",
# Line 992  POE::Session->create( inline_states => { Line 1134  POE::Session->create( inline_states => {
1134    
1135  # http server  # http server
1136    
1137    _log "WEB archive at $url";
1138    
1139  my $httpd = POE::Component::Server::HTTP->new(  my $httpd = POE::Component::Server::HTTP->new(
1140          Port => $http_port,          Port => $http_port,
1141          PreHandler => {          PreHandler => {
# Line 1038  foreach my $c (@cols) { Line 1182  foreach my $c (@cols) {
1182          $style .= ".col-${max_color} { background: $c }\n";          $style .= ".col-${max_color} { background: $c }\n";
1183          $max_color++;          $max_color++;
1184  }  }
1185  warn "defined $max_color colors for users...\n";  _log "WEB defined $max_color colors for users...";
1186    
1187  sub root_handler {  sub root_handler {
1188          my ($request, $response) = @_;          my ($request, $response) = @_;
# Line 1060  sub root_handler { Line 1204  sub root_handler {
1204          }          }
1205    
1206          my $search = $q->param('search') || $q->param('grep') || '';          my $search = $q->param('search') || $q->param('grep') || '';
1207            my $r_url = $request->url;
1208    
1209            my @commands = qw( tags last-tag follow stat );
1210            my $commands_re = join('|',@commands);
1211    
1212          if ($request->url =~ m#/rss(?:/(tags|last-tag|follow.*)\w*(?:=(\d+))?)?#i) {          if ($r_url =~ m#/rss(?:/($commands_re.*)\w*(?:=(\d+))?)?#i) {
1213                  my $show = lc($1);                  my $show = lc($1);
1214                  my $nr = $2;                  my $nr = $2;
1215    
# Line 1075  sub root_handler { Line 1223  sub root_handler {
1223                  my $feed = XML::Feed->new( $type );                  my $feed = XML::Feed->new( $type );
1224                  $feed->link( $url );                  $feed->link( $url );
1225    
1226                    my $rc = RC_OK;
1227    
1228                  if ( $show eq 'tags' ) {                  if ( $show eq 'tags' ) {
1229                          $nr ||= 50;                          $nr ||= 50;
1230                          $feed->title( "tags from $CHANNEL" );                          $feed->title( "tags from $CHANNEL" );
# Line 1144  sub root_handler { Line 1294  sub root_handler {
1294                                  $feed->add_entry( $feed_entry );                                  $feed->add_entry( $feed_entry );
1295                          }                          }
1296    
1297                    } elsif ( $show =~ m/^stat/ ) {
1298    
1299                            my $feed_entry = XML::Feed::Entry->new($type);
1300                            $feed_entry->title( "Internal stats" );
1301                            $feed_entry->content(
1302                                    '<![CDATA[<pre>' . dump( $_stat ) . '</pre>]]>'
1303                            );
1304                            $feed->add_entry( $feed_entry );
1305    
1306                  } else {                  } else {
1307                          _log "unknown rss request ",$request->url;                          _log "WEB unknown rss request $r_url";
1308                          return RC_DENY;                          $feed->title( "unknown $r_url" );
1309                            foreach my $c ( @commands ) {
1310                                    my $feed_entry = XML::Feed::Entry->new($type);
1311                                    $feed_entry->title( "rss/$c" );
1312                                    $feed_entry->link( "$url/rss/$c" );
1313                                    $feed->add_entry( $feed_entry );
1314                            }
1315                            $rc = RC_DENY;
1316                  }                  }
1317    
1318                  $response->content( $feed->as_xml );                  $response->content( $feed->as_xml );
1319                  return RC_OK;                  return $rc;
1320          }          }
1321    
1322          if ( $@ ) {          if ( $@ ) {
Legend:
Removed from v.89  
changed lines
  Added in v.119
  ViewVC Help
Powered by ViewVC 1.1.26