/[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 81 by dpavlin, Wed Feb 20 20:33:03 2008 UTC revision 103 by dpavlin, Sun Mar 9 00:26: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  
   
40  =back  =back
41    
42  =head1 DESCRIPTION  =head1 DESCRIPTION
# Line 37  chomp($HOSTNAME); Line 52  chomp($HOSTNAME);
52    
53  my $NICK = 'irc-logger';  my $NICK = 'irc-logger';
54  $NICK .= '-dev' if ($HOSTNAME =~ m/llin/);  $NICK .= '-dev' if ($HOSTNAME =~ m/llin/);
55  my $CONNECT =  my $CONNECT = {
56    {Server => 'irc.freenode.net',          Server => 'irc.freenode.net',
57     Nick => $NICK,          Nick => $NICK,
58     Ircname => "try /msg $NICK help",          Ircname => "try /msg $NICK help",
59    };  };
60  my $CHANNEL = '#razmjenavjestina';  my $CHANNEL = '#razmjenavjestina';
61  $CHANNEL = '#irc-logger' if ($HOSTNAME =~ m/llin/);  $CHANNEL = '#irc-logger' if ($HOSTNAME =~ m/llin/);
62  my $IRC_ALIAS = "log";  my $IRC_ALIAS = "log";
63    
64  my %FOLLOWS =  if ( $HOSTNAME =~ m/lugarin/ ) {
65    (          $CONNECT->{Server} = 'irc.carnet.hr';
66     ACCESS => "/var/log/apache/access.log",          $CHANNEL = '#riss';
67     ERROR => "/var/log/apache/error.log",  }
68    );  
69    warn dump( $HOSTNAME, $CONNECT );
70    
71  my $DSN = 'DBI:Pg:dbname=' . $NICK;  my $DSN = 'DBI:Pg:dbname=' . $NICK;
72    
 my $ENCODING = 'ISO-8859-2';  
73  my $TIMESTAMP = '%Y-%m-%d %H:%M:%S';  my $TIMESTAMP = '%Y-%m-%d %H:%M:%S';
74    
75  my $sleep_on_error = 5;  my $sleep_on_error = 5;
# Line 62  my $sleep_on_error = 5; Line 77  my $sleep_on_error = 5;
77  # number of last tags to keep in circular buffer  # number of last tags to keep in circular buffer
78  my $last_x_tags = 50;  my $last_x_tags = 50;
79    
80    # don't pull rss feeds more often than this
81    my $rss_min_delay = 60;
82    
83  my $http_port = $NICK =~ m/-dev/ ? 8001 : 8000;  my $http_port = $NICK =~ m/-dev/ ? 8001 : 8000;
84    
85  my $url = "http://$HOSTNAME:$http_port";  my $url = "http://$HOSTNAME:$http_port";
86    
87  ## END CONFIG  ## END CONFIG
88    
   
   
 use POE qw(Component::IRC Wheel::FollowTail Component::Server::HTTP);  
 use HTTP::Status;  
 use DBI;  
 use Encode qw/from_to is_utf8/;  
 use Regexp::Common qw /URI/;  
 use CGI::Simple;  
 use HTML::TagCloud;  
 use POSIX qw/strftime/;  
 use HTML::CalendarMonthSimple;  
 use Getopt::Long;  
 use DateTime;  
 use URI::Escape;  
 use Data::Dump qw/dump/;  
 use DateTime::Format::ISO8601;  
 use Carp qw/confess/;  
 use XML::Feed;  
 use DateTime::Format::Flexible;  
   
89  my $use_twitter = 1;  my $use_twitter = 1;
90  eval { require Net::Twitter; };  eval { require Net::Twitter; };
91  $use_twitter = 0 if ($@);  $use_twitter = 0 if ($@);
# Line 99  GetOptions( Line 97  GetOptions(
97          'log:s' => \$log_path,          'log:s' => \$log_path,
98  );  );
99    
100  $SIG{__DIE__} = sub {  #$SIG{__DIE__} = sub {
101          confess "fatal error";  #       confess "fatal error";
102  };  #};
103    
104  open(STDOUT, '>', $log_path) || warn "can't redirect log to $log_path: $!";  open(STDOUT, '>', $log_path) || warn "can't redirect log to $log_path: $!";
105    
106  sub _log {  sub _log {
107          print strftime($TIMESTAMP,localtime()), ' ', join(" ",@_), $/;          print strftime($TIMESTAMP,localtime()) . ' ' . join(" ",@_) . $/;
108  }  }
109    
110  # HTML formatters  # HTML formatters
# Line 126  my $filter = { Line 124  my $filter = {
124                  # protect HTML from wiki modifications                  # protect HTML from wiki modifications
125                  sub e {                  sub e {
126                          my $t = shift;                          my $t = shift;
127                          return 'uri_unescape{' . uri_escape($t) . '}';                          return 'uri_unescape{' . uri_escape($t, '^a-zA-Z0-9') . '}';
128                  }                  }
129    
130                  $m =~ s/($escape_re)/$escape{$1}/gs;                  $m =~ s/($escape_re)/$escape{$1}/gs;
131                  $m =~ s#($RE{URI}{HTTP})#e(qq{<a href="$1">$1</a>})#egs ||                  $m =~ s#($RE{URI}{HTTP})#e(qq{<a href="$1">$1</a>})#egs;
132                  $m =~ s#\/(\w+)\/#<i>$1</i>#gs;                  $m =~ s#\/(\w+)\/#<i>$1</i>#gs;
133                  $m =~ s#$tag_regex#e(qq{<a href="$url?tag=$1" class="tag">$1</a>})#egs;                  $m =~ s#$tag_regex#e(qq{<a href="$url?tag=$1" class="tag">$1</a>})#egs;
134                  $m =~ s#\*(\w+)\*#<b>$1</b>#gs;                  $m =~ s#\*(\w+)\*#<b>$1</b>#gs;
# Line 152  my $filter = { Line 150  my $filter = {
150  };  };
151    
152  my $dbh = DBI->connect($DSN,"","", { RaiseError => 1, AutoCommit => 1 }) || die $DBI::errstr;  my $dbh = DBI->connect($DSN,"","", { RaiseError => 1, AutoCommit => 1 }) || die $DBI::errstr;
153    $dbh->do( qq{ set client_encoding = 'UTF-8' } );
154    
155  my $sql_schema = {  my $sql_schema = {
156          log => '          log => qq{
157  create table log (  create table log (
158          id serial,          id serial,
159          time timestamp default now(),          time timestamp default now(),
# Line 168  create table log ( Line 167  create table log (
167  create index log_time on log(time);  create index log_time on log(time);
168  create index log_channel on log(channel);  create index log_channel on log(channel);
169  create index log_nick on log(nick);  create index log_nick on log(nick);
170          ',          },
171          meta => '          meta => q{
172  create table meta (  create table meta (
173          nick text not null,          nick text not null,
174          channel text not null,          channel text not null,
175          name text not null,          name text not null,
176          value text,          value text,
177          changed timestamp default now(),          changed timestamp default 'now()',
178          primary key(nick,channel,name)          primary key(nick,channel,name)
179  );  );
180          ',          },
181            feeds => qq{
182    create table feeds (
183            id serial,
184            url text not null,
185            name text,
186            delay interval not null default '5 min',
187            active boolean default true,
188            channel text not null,
189            nick text not null,
190            private boolean default false,
191            last_update timestamp default 'now()',
192            polls int default 0,
193            updates int default 0
194    );
195    create unique index feeds_url on feeds(url);
196    insert into feeds (url,name,channel,nick) values ('http://wiki.razmjenavjestina.org/feed/workspace/razmjenavjestina?category=Recent%20Changes','wiki','$CHANNEL','dpavlin');
197            },
198  };  };
199    
200  foreach my $table ( keys %$sql_schema ) {  foreach my $table ( keys %$sql_schema ) {
# Line 221  sub meta { Line 237  sub meta {
237                  if ( $@ || ! $sth->rows ) {                  if ( $@ || ! $sth->rows ) {
238                          $sth = $dbh->prepare(qq{ insert into meta (value,nick,channel,name,changed) values (?,?,?,?,now()) });                          $sth = $dbh->prepare(qq{ insert into meta (value,nick,channel,name,changed) values (?,?,?,?,now()) });
239                          $sth->execute( $value, $nick, $channel, $name );                          $sth->execute( $value, $nick, $channel, $name );
240                          _log "created $nick/$channel/$name = $value";                          warn "## created $nick/$channel/$name = $value\n";
241                  } else {                  } else {
242                          _log "updated $nick/$channel/$name = $value ";                          warn "## updated $nick/$channel/$name = $value\n";
243                  }                  }
244    
245                  return $value;                  return $value;
# Line 233  sub meta { Line 249  sub meta {
249                  my $sth = $dbh->prepare(qq{ select value,changed from meta where nick = ? and channel = ? and name = ? });                  my $sth = $dbh->prepare(qq{ select value,changed from meta where nick = ? and channel = ? and name = ? });
250                  $sth->execute( $nick, $channel, $name );                  $sth->execute( $nick, $channel, $name );
251                  my ($v,$c) = $sth->fetchrow_array;                  my ($v,$c) = $sth->fetchrow_array;
252                  _log "fetched $nick/$channel/$name = $v [$c]";                  warn "## fetched $nick/$channel/$name = $v [$c]\n";
253                  return ($v,$c) if wantarray;                  return ($v,$c) if wantarray;
254                  return $v;                  return $v;
255    
# Line 242  sub meta { Line 258  sub meta {
258    
259    
260    
261  my $sth = $dbh->prepare(qq{  my $sth_insert_log = $dbh->prepare(qq{
262  insert into log  insert into log
263          (channel, me, nick, message, time)          (channel, me, nick, message, time)
264  values (?,?,?,?,?)  values (?,?,?,?,?)
# Line 330  sub get_from_log { Line 346  sub get_from_log {
346    
347          my @where;          my @where;
348          my @args;          my @args;
349            my $msg;
350    
351          if (my $search = $args->{search}) {          if (my $search = $args->{search}) {
352                  $search =~ s/^\s+//;                  $search =~ s/^\s+//;
353                  $search =~ s/\s+$//;                  $search =~ s/\s+$//;
354                  push @where, 'message ilike ? or nick ilike ?';                  push @where, 'message ilike ? or nick ilike ?';
355                  push @args, ( ( '%' . $search . '%' ) x 2 );                  push @args, ( ( '%' . $search . '%' ) x 2 );
356                  _log "search for '$search'";                  $msg = "Search for '$search'";
357          }          }
358    
359          if ($args->{tag} && $tags->{ $args->{tag} }) {          if ($args->{tag} && $tags->{ $args->{tag} }) {
360                  push @where, 'id in (' . join(',', @{ $tags->{ $args->{tag} } }) . ')';                  push @where, 'id in (' . join(',', @{ $tags->{ $args->{tag} } }) . ')';
361                  _log "search for tags $args->{tag}";                  $msg = "Search for tags $args->{tag}";
362          }          }
363    
364          if (my $date = $args->{date} ) {          if (my $date = $args->{date} ) {
365                  $date = check_date( $date );                  $date = check_date( $date );
366                  push @where, 'date(time) = ?';                  push @where, 'date(time) = ?';
367                  push @args, $date;                  push @args, $date;
368                  _log "search for date $date";                  $msg = "search for date $date";
369          }          }
370    
371          $sql .= " where " . join(" and ", @where) if @where;          $sql .= " where " . join(" and ", @where) if @where;
# Line 362  sub get_from_log { Line 379  sub get_from_log {
379          eval { $sth->execute( @args ) };          eval { $sth->execute( @args ) };
380          return if $@;          return if $@;
381    
382            my $nr_results = $sth->rows;
383    
384          my $last_row = {          my $last_row = {
385                  date => '',                  date => '',
386                  time => '',                  time => '',
# Line 382  sub get_from_log { Line 401  sub get_from_log {
401    
402          return @rows if ($args->{full_rows});          return @rows if ($args->{full_rows});
403    
404          my @msgs = (          $msg .= ' produced ' . (
405                  "Showing " . ($#rows + 1) . " messages..."                  $nr_results == 0 ? 'no results' :
406                    $nr_results == 0 ? 'one result' :
407                            $nr_results . ' results'
408          );          );
409    
410            my @msgs = ( $msg );
411    
412          if ($context) {          if ($context) {
413                  my @ids = @rows;                  my @ids = @rows;
414                  @rows = ();                  @rows = ();
# Line 494  sub add_tag { Line 517  sub add_tag {
517          return unless ($arg->{id} && $arg->{message});          return unless ($arg->{id} && $arg->{message});
518    
519          my $m = $arg->{message};          my $m = $arg->{message};
         from_to('UTF-8', 'iso-8859-2', $m) if (is_utf8($m));  
520    
521          my @tags;          my @tags;
522    
# Line 563  sub save_message { Line 585  sub save_message {
585                  $a->{me} ? "***" . $a->{nick} : "<" . $a->{nick} . ">",                  $a->{me} ? "***" . $a->{nick} : "<" . $a->{nick} . ">",
586                  " " . $a->{message};                  " " . $a->{message};
587    
588          from_to($a->{message}, 'UTF-8', $ENCODING);          $sth_insert_log->execute($a->{channel}, $a->{me}, $a->{nick}, $a->{message}, $a->{time});
   
         $sth->execute($a->{channel}, $a->{me}, $a->{nick}, $a->{message}, $a->{time});  
589          add_tag( id => $dbh->last_insert_id(undef,undef,"log",undef), %$a );          add_tag( id => $dbh->last_insert_id(undef,undef,"log",undef), %$a );
590  }  }
591    
# Line 604  if ($import_dircproxy) { Line 624  if ($import_dircproxy) {
624          exit;          exit;
625  }  }
626    
627    #
628    # RSS follow
629    #
630    
631    my $_rss;
632    
633    
634    sub rss_fetch {
635            my ($args) = @_;
636    
637            # how many messages to send out when feed is seen for the first time?
638            my $send_rss_msgs = 1;
639    
640            _log "RSS fetch", $args->{url};
641    
642            my $feed = XML::Feed->parse(URI->new( $args->{url} ));
643            if ( ! $feed ) {
644                    _log("can't fetch RSS ", $args->{url});
645                    return;
646            }
647    
648            my ( $total, $updates ) = ( 0, 0 );
649            for my $entry ($feed->entries) {
650                    $total++;
651    
652                    # seen allready?
653                    next if $_rss->{$args->{channel}}->{$feed->link}->{$entry->id}++ > 0;
654    
655                    sub prefix {
656                            my ($txt,$var) = @_;
657                            $var =~ s/\s+/ /gs;
658                            $var =~ s/^\s+//g;
659                            $var =~ s/\s+$//g;
660                            return $txt . $var if $var;
661                    }
662    
663                    # fix absolute and relative links to feed entries
664                    my $link = $entry->link;
665                    if ( $link =~ m!^/! ) {
666                            my $host = $args->{url};
667                            $host =~ s!^(http://[^/]+).*$!$1!;      #!vim
668                            $link = "$host/$link";
669                    } elsif ( $link !~ m!^http! ) {
670                            $link = $args->{url} . $link;
671                    }
672    
673                    my $msg;
674                    $msg .= prefix( 'From: ' , $args->{name} || $feed->title );
675                    $msg .= prefix( ' by ' , $entry->author );
676                    $msg .= prefix( ' | ' , $entry->title );
677                    $msg .= prefix( ' | ' , $link );
678    #               $msg .= prefix( ' id ' , $entry->id );
679    
680                    if ( $args->{kernel} && $send_rss_msgs ) {
681                            $send_rss_msgs--;
682                            $sth_insert_log->execute( $args->{channel}, 1, $NICK, $msg, 'now()' );
683                            my ( $type, $to ) = ( 'notice', $args->{channel} );
684                            ( $type, $to ) = ( 'privmsg', $args->{nick} ) if $args->{private};
685                            _log(">> $type $to |", $msg);
686                            $args->{kernel}->post( $IRC_ALIAS => $type => $to, $msg );
687                            $updates++;
688                    }
689            }
690    
691            my $sql = qq{ update feeds set last_update = now(), polls = polls + 1 };
692            $sql .= qq{, updates = updates + $updates } if $updates;
693            $sql .= qq{where id = } . $args->{id};
694            eval { $dbh->do( $sql ) };
695    
696            _log "RSS got $total items of which $updates new";
697    
698            return $updates;
699    }
700    
701    sub rss_fetch_all {
702            my $kernel = shift;
703            my $sql = qq{
704                    select id, url, name, channel, nick, private
705                    from feeds
706                    where active is true
707            };
708            # limit to newer feeds only if we are not sending messages out
709            $sql .= qq{     and last_update + delay < now() } if $kernel;
710            my $sth = $dbh->prepare( $sql );
711            $sth->execute();
712            warn "# ",$sth->rows," active RSS feeds\n";
713            my $count = 0;
714            while (my $row = $sth->fetchrow_hashref) {
715                    $row->{kernel} = $kernel if $kernel;
716                    $count += rss_fetch( $row );
717            }
718            return "OK, fetched $count posts from " . $sth->rows . " feeds";
719    }
720    
721    
722    sub rss_check_updates {
723            my $kernel = shift;
724            $_rss->{last_poll} ||= time();
725            my $dt = time() - $_rss->{last_poll};
726            warn "## rss_check_updates $dt > $rss_min_delay\n";
727            if ( $dt > $rss_min_delay ) {
728                    $_rss->{last_poll} = time();
729                    _log rss_fetch_all( $kernel );
730            }
731    }
732    
733    # seed rss seen cache so we won't send out all items on startup
734    _log rss_fetch_all;
735    
736  #  #
737  # POE handing part  # POE handing part
738  #  #
739    
 my $SKIPPING = 0;               # if skipping, how many we've done  
 my $SEND_QUEUE;                 # cache  
740  my $ping;                                               # ping stats  my $ping;                                               # ping stats
741    
742  POE::Component::IRC->new($IRC_ALIAS);  POE::Component::IRC->new($IRC_ALIAS);
743    
744  POE::Session->create( inline_states =>  POE::Session->create( inline_states => {
745     {_start => sub {                _start => sub {      
746                  $_[KERNEL]->post($IRC_ALIAS => register => 'all');                  $_[KERNEL]->post($IRC_ALIAS => register => 'all');
747                  $_[KERNEL]->post($IRC_ALIAS => connect => $CONNECT);                  $_[KERNEL]->post($IRC_ALIAS => connect => $CONNECT);
748      },      },
749      irc_255 => sub {    # server is done blabbing      irc_255 => sub {    # server is done blabbing
750                  $_[KERNEL]->post($IRC_ALIAS => join => $CHANNEL);                  $_[KERNEL]->post($IRC_ALIAS => join => $CHANNEL);
                 $_[KERNEL]->post($IRC_ALIAS => join => '#logger');  
                 $_[KERNEL]->yield("heartbeat"); # start heartbeat  
 #               $_[KERNEL]->yield("my_add", $_) for keys %FOLLOWS;  
751                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "IDENTIFY $NICK" );                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "IDENTIFY $NICK" );
752      },      },
753      irc_public => sub {      irc_public => sub {
# Line 635  POE::Session->create( inline_states => Line 758  POE::Session->create( inline_states =>
758    
759                  save_message( channel => $channel, me => 0, nick => $nick, message => $msg);                  save_message( channel => $channel, me => 0, nick => $nick, message => $msg);
760                  meta( $nick, $channel, 'last-msg', $msg );                  meta( $nick, $channel, 'last-msg', $msg );
761                    rss_check_updates( $kernel );
762      },      },
763      irc_ctcp_action => sub {      irc_ctcp_action => sub {
764                  my $kernel = $_[KERNEL];                  my $kernel = $_[KERNEL];
# Line 655  POE::Session->create( inline_states => Line 779  POE::Session->create( inline_states =>
779    
780      },      },
781          irc_ping => sub {          irc_ping => sub {
782                  warn "pong ", $_[ARG0], $/;                  _log( "pong ", $_[ARG0] );
783                  $ping->{ $_[ARG0] }++;                  $ping->{ $_[ARG0] }++;
784                    rss_check_updates( $_[KERNEL] );
785          },          },
786          irc_invite => sub {          irc_invite => sub {
787                  my $kernel = $_[KERNEL];                  my $kernel = $_[KERNEL];
788                  my $nick = (split /!/, $_[ARG0])[0];                  my $nick = (split /!/, $_[ARG0])[0];
789                  my $channel = $_[ARG1];                  my $channel = $_[ARG1];
790    
791                  warn "invited to $channel by $nick";                  _log "invited to $channel by $nick";
792    
793                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, "how nice of you to invite me to $channel, I'll be right there..." );                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, "how nice of you to invite me to $channel, I'll be right there..." );
794                  $_[KERNEL]->post($IRC_ALIAS => join => $channel);                  $_[KERNEL]->post($IRC_ALIAS => join => $channel);
# Line 674  POE::Session->create( inline_states => Line 799  POE::Session->create( inline_states =>
799                  my $nick = (split /!/, $_[ARG0])[0];                  my $nick = (split /!/, $_[ARG0])[0];
800                  my $msg = $_[ARG2];                  my $msg = $_[ARG2];
801                  my $channel = $_[ARG1]->[0];                  my $channel = $_[ARG1]->[0];
                 from_to($msg, 'UTF-8', $ENCODING);  
802    
803                  my $res = "unknown command '$msg', try /msg $NICK help!";                  my $res = "unknown command '$msg', try /msg $NICK help!";
804                  my @out;                  my @out;
# Line 718  POE::Session->create( inline_states => Line 842  POE::Session->create( inline_states =>
842    
843                          foreach my $res (get_from_log( limit => $limit )) {                          foreach my $res (get_from_log( limit => $limit )) {
844                                  _log "last: $res";                                  _log "last: $res";
                                 from_to($res, $ENCODING, 'UTF-8');  
845                                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );                                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );
846                          }                          }
847    
# Line 733  POE::Session->create( inline_states => Line 856  POE::Session->create( inline_states =>
856                                          search => $what,                                          search => $what,
857                                  )) {                                  )) {
858                                  _log "search [$what]: $res";                                  _log "search [$what]: $res";
                                 from_to($res, $ENCODING, 'UTF-8');  
859                                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );                                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );
860                          }                          }
861    
# Line 803  POE::Session->create( inline_states => Line 925  POE::Session->create( inline_states =>
925                                          $res = "config option $op doesn't exist";                                          $res = "config option $op doesn't exist";
926                                  }                                  }
927                          }                          }
928                    } elsif ($msg =~ m/^rss-update/) {
929                            $res = rss_fetch_all( $_[KERNEL] );
930                    } elsif ($msg =~ m/^rss-clean/) {
931                            $_rss = undef;
932                            $dbh->do( qq{ update feeds set last_update = now() - delay } );
933                            $res = "OK, cleaned RSS cache";
934                    } elsif ($msg =~ m/^rss-list/) {
935                            my $sth = $dbh->prepare(qq{ select url,name,last_update,active,channel,nick,private from feeds });
936                            $sth->execute;
937                            while (my @row = $sth->fetchrow_array) {
938                                    $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, join(' | ',@row) );
939                            }
940                            $res = '';
941                    } elsif ($msg =~ m!^rss-(add|remove|stop|start)(?:-(private))?\s+(http://\S+)\s*(.*)!) {
942                            my ( $command, $sub, $url, $arg ) = ( $1,$2,$3,$4 );
943    
944                            my $channel = $1 if ( $arg =~ s/\s*(#\S+)\s*// );
945                            $channel = $nick if $sub eq 'private';
946    
947                            my $sql = {
948                                    add     => qq{ insert into feeds (url,name,channel,nick,private) values (?,?,?,?,?) },
949    #                               remove  => qq{ delete from feeds                                where url = ? and name = ? },
950                                    start   => qq{ update feeds set active = true   where url = ? },
951                                    stop    => qq{ update feeds set active = false  where url = ? },
952                            };
953    
954                            if ( $command eq 'add' && ! $channel ) {
955                                    $res = "ERROR: got '$msg' which doesn't have #channel in it, ignoring!";
956                            } elsif (my $q = $sql->{$command} ) {
957                                    my $sth = $dbh->prepare( $q );
958                                    my @data = ( $url );
959                                    if ( $command eq 'add' ) {
960                                            push @data, ( $arg, $channel, $nick, $sub eq 'private' ? 1 : 0 );
961                                    }
962                                    warn "## $command SQL $q with ",dump( @data ),"\n";
963                                    eval { $sth->execute( @data ) };
964                                    if ($@) {
965                                            $res = "ERROR: $@";
966                                    } else {
967                                            $res = "OK, RSS [$command|$sub|$url|$arg]";
968                                    }
969                            } else {
970                                    $res = "ERROR: don't know what to do with: $msg";
971                            }
972                  }                  }
973    
974                  if ($res) {                  if ($res) {
975                          _log ">> [$nick] $res";                          _log ">> [$nick] $res";
                         from_to($res, $ENCODING, 'UTF-8');  
976                          $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );                          $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );
977                  }                  }
978    
979                    rss_check_updates( $_[KERNEL] );
980          },          },
981          irc_477 => sub {          irc_477 => sub {
982                  _log "# irc_477: ",$_[ARG1];                  _log "<< irc_477: ",$_[ARG1];
983                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "register $NICK" );                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "register $NICK" );
984          },          },
985          irc_505 => sub {          irc_505 => sub {
986                  _log "# irc_505: ",$_[ARG1];                  _log "<< irc_505: ",$_[ARG1];
987                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "register $NICK" );                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "register $NICK" );
988  #               $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "set hide email on" );  #               $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "set hide email on" );
989  #               $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "set email dpavlin\@rot13.org" );  #               $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "set email dpavlin\@rot13.org" );
990          },          },
991          irc_registered => sub {          irc_registered => sub {
992                  _log "## registrated $NICK";                  _log "## registrated $NICK, /msg nickserv IDENTIFY $NICK";
993                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "IDENTIFY $NICK" );                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "IDENTIFY $NICK" );
994          },          },
995          irc_disconnected => sub {          irc_disconnected => sub {
996                  _log "## disconnected, reconnecting again";                  _log "## disconnected.. sleeping for $sleep_on_error seconds and reconnecting again";
997                  $_[KERNEL]->post($IRC_ALIAS => connect => $CONNECT);                  sleep($sleep_on_error);
998                    $_[KERNEL]->post( $IRC_ALIAS => connect => $CONNECT);
999          },          },
1000          irc_socketerr => sub {          irc_socketerr => sub {
1001                  _log "## socket error... sleeping for $sleep_on_error seconds and retry";                  _log "## socket error... sleeping for $sleep_on_error seconds and retry";
1002                  sleep($sleep_on_error);                  sleep($sleep_on_error);
1003                  $_[KERNEL]->post($IRC_ALIAS => connect => $CONNECT);                  $_[KERNEL]->post( $IRC_ALIAS => connect => $CONNECT);
1004          },          },
1005  #       irc_433 => sub {  #       irc_433 => sub {
1006  #               print "# irc_433: ",$_[ARG1], "\n";  #               print "# irc_433: ",$_[ARG1], "\n";
1007  #               warn "## indetify $NICK\n";  #               warn "## indetify $NICK\n";
1008  #               $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "IDENTIFY $NICK" );  #               $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "IDENTIFY $NICK" );
1009  #       },  #       },
1010    #       irc_451 # please register
1011            irc_snotice => sub {
1012                    _log "<< snotice",$_[ARG0];
1013                    if ( $_[ARG0] =~ m!/(QUOTE)\s+(PASS\s+\d+)!i ) {
1014                            warn ">> $1 | $2\n";
1015                            $_[KERNEL]->post( $IRC_ALIAS => lc($1) => $2);
1016                    }
1017            },
1018      _child => sub {},      _child => sub {},
1019      _default => sub {      _default => sub {
1020                  _log sprintf "sID:%s %s %s",                  _log sprintf "sID:%s %s %s",
# Line 849  POE::Session->create( inline_states => Line 1024  POE::Session->create( inline_states =>
1024                          "";                          "";
1025        0;                        # false for signals        0;                        # false for signals
1026      },      },
     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',  
                     );  
             },  
             got_line => sub {  
               $_[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);  
     }  
1027     },     },
1028    );    );
1029    
# Line 916  POE::Session->create( inline_states => Line 1031  POE::Session->create( inline_states =>
1031    
1032  my $httpd = POE::Component::Server::HTTP->new(  my $httpd = POE::Component::Server::HTTP->new(
1033          Port => $http_port,          Port => $http_port,
1034            PreHandler => {
1035                    '/' => sub {
1036                            $_[0]->header(Connection => 'close')
1037                    }
1038            },
1039          ContentHandler => { '/' => \&root_handler },          ContentHandler => { '/' => \&root_handler },
1040          Headers        => { Server => 'irc-logger' },          Headers        => { Server => 'irc-logger' },
1041  );  );
# Line 961  sub root_handler { Line 1081  sub root_handler {
1081          my ($request, $response) = @_;          my ($request, $response) = @_;
1082          $response->code(RC_OK);          $response->code(RC_OK);
1083    
1084            # this doesn't seem to work, so moved to PreHandler
1085            #$response->header(Connection => 'close');
1086    
1087          return RC_OK if $request->uri =~ m/favicon.ico$/;          return RC_OK if $request->uri =~ m/favicon.ico$/;
1088    
1089          my $q;          my $q;
# Line 975  sub root_handler { Line 1098  sub root_handler {
1098    
1099          my $search = $q->param('search') || $q->param('grep') || '';          my $search = $q->param('search') || $q->param('grep') || '';
1100    
1101          if ($request->url =~ m#/rss(?:/(tags|last-tag)\w*(?:=(\d+))?)?#i) {          if ($request->url =~ m#/rss(?:/(tags|last-tag|follow.*)\w*(?:=(\d+))?)?#i) {
1102                  my $show = lc($1);                  my $show = lc($1);
1103                  my $nr = $2;                  my $nr = $2;
1104    
# Line 987  sub root_handler { Line 1110  sub root_handler {
1110                  #warn "create $type feed from ",dump( @last_tags );                  #warn "create $type feed from ",dump( @last_tags );
1111    
1112                  my $feed = XML::Feed->new( $type );                  my $feed = XML::Feed->new( $type );
1113                    $feed->link( $url );
1114    
1115                  if ( $show eq 'tags' ) {                  if ( $show eq 'tags' ) {
1116                          $nr ||= 50;                          $nr ||= 50;
# Line 1013  sub root_handler { Line 1137  sub root_handler {
1137                          $nr = $last_x_tags if $nr > $last_x_tags;                          $nr = $last_x_tags if $nr > $last_x_tags;
1138    
1139                          $feed->title( "last $nr tagged messages from $CHANNEL" );                          $feed->title( "last $nr tagged messages from $CHANNEL" );
                         $feed->link( $url );  
1140                          $feed->description( "collects messages which have tags// in them" );                          $feed->description( "collects messages which have tags// in them" );
1141    
1142                          foreach my $m ( @last_tags ) {                          foreach my $m ( @last_tags ) {
# Line 1028  sub root_handler { Line 1151  sub root_handler {
1151                                  my $message = $filter->{message}->( $m->{message} );                                  my $message = $filter->{message}->( $m->{message} );
1152                                  $message .= "<br/>\n" unless $message =~ m!<(/p|br/?)>!;                                  $message .= "<br/>\n" unless $message =~ m!<(/p|br/?)>!;
1153  #                               warn "## message = $message\n";  #                               warn "## message = $message\n";
                                 from_to( $message, $ENCODING, 'UTF-8' );  
1154    
1155                                  #$feed_entry->summary(                                  #$feed_entry->summary(
1156                                  $feed_entry->content(                                  $feed_entry->content(
# Line 1042  sub root_handler { Line 1164  sub root_handler {
1164    
1165                          }                          }
1166    
1167                    } elsif ( $show =~ m/^follow/ ) {
1168    
1169                            $feed->title( "Feeds which this bot follows" );
1170    
1171                            my $sth = $dbh->prepare( qq{ select * from feeds order by last_update desc } );
1172                            $sth->execute;
1173                            while (my $row = $sth->fetchrow_hashref) {
1174                                    my $feed_entry = XML::Feed::Entry->new($type);
1175                                    $feed_entry->title( $row->{name} );
1176                                    $feed_entry->link( $row->{url}  );
1177                                    $feed_entry->issued( DateTime::Format::Flexible->build( $row->{last_update} ) );
1178                                    $feed_entry->content(
1179                                            '<![CDATA[<pre>' . dump( $row ) . '</pre>]]>'
1180                                    );
1181                                    $feed->add_entry( $feed_entry );
1182                            }
1183    
1184                            my $feed_entry = XML::Feed::Entry->new($type);
1185                            $feed_entry->title( "Internal stats" );
1186                            $feed_entry->content(
1187                                    '<![CDATA[<pre>' . dump( $_rss ) . '</pre>]]>'
1188                            );
1189                            $feed->add_entry( $feed_entry );
1190    
1191                  } else {                  } else {
1192                          warn "!! unknown rss request for $show\n";                          _log "unknown rss request ",$request->url;
1193                          return RC_DENY;                          return RC_DENY;
1194                  }                  }
1195    
# Line 1055  sub root_handler { Line 1201  sub root_handler {
1201                  warn "$@";                  warn "$@";
1202          }          }
1203    
1204          $response->content_type("text/html; charset=$ENCODING");          $response->content_type("text/html; charset=UTF-8");
1205    
1206          my $html =          my $html =
1207                  qq{<html><head><title>$NICK</title><style type="text/css">$style}                  qq{<html><head><title>$NICK</title><style type="text/css">$style}
# Line 1106  sub root_handler { Line 1252  sub root_handler {
1252                          }                          }
1253                          $cal->setcontent($dd, qq[                          $cal->setcontent($dd, qq[
1254                                  <a href="$url?date=$row->{date}">$row->{nr}</a><br/>$row->{len}                                  <a href="$url?date=$row->{date}">$row->{nr}</a><br/>$row->{len}
1255                          ]);                          ]) if $cal;
1256                                                    
1257                  }                  }
1258                  $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.81  
changed lines
  Added in v.103
  ViewVC Help
Powered by ViewVC 1.1.26