/[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 70 by dpavlin, Sun Dec 16 18:37:04 2007 UTC revision 98 by dpavlin, Fri Mar 7 16:02:27 2008 UTC
# Line 20  Import log from C<dircproxy> to C<irc-lo Line 20  Import log from C<dircproxy> to C<irc-lo
20    
21  =item --log=irc-logger.log  =item --log=irc-logger.log
22    
 Name of log file  
   
23  =back  =back
24    
25  =head1 DESCRIPTION  =head1 DESCRIPTION
# Line 32  log all conversation on irc channel Line 30  log all conversation on irc channel
30    
31  ## CONFIG  ## CONFIG
32    
33  my $HOSTNAME = `hostname`;  my $HOSTNAME = `hostname -f`;
34    chomp($HOSTNAME);
35    
36  my $NICK = 'irc-logger';  my $NICK = 'irc-logger';
37  $NICK .= '-dev' if ($HOSTNAME =~ m/llin/);  $NICK .= '-dev' if ($HOSTNAME =~ m/llin/);
# Line 45  my $CHANNEL = '#razmjenavjestina'; Line 44  my $CHANNEL = '#razmjenavjestina';
44  $CHANNEL = '#irc-logger' if ($HOSTNAME =~ m/llin/);  $CHANNEL = '#irc-logger' if ($HOSTNAME =~ m/llin/);
45  my $IRC_ALIAS = "log";  my $IRC_ALIAS = "log";
46    
 my %FOLLOWS =  
   (  
    ACCESS => "/var/log/apache/access.log",  
    ERROR => "/var/log/apache/error.log",  
   );  
   
47  my $DSN = 'DBI:Pg:dbname=' . $NICK;  my $DSN = 'DBI:Pg:dbname=' . $NICK;
48    
 my $ENCODING = 'ISO-8859-2';  
49  my $TIMESTAMP = '%Y-%m-%d %H:%M:%S';  my $TIMESTAMP = '%Y-%m-%d %H:%M:%S';
50    
51  my $sleep_on_error = 5;  my $sleep_on_error = 5;
52    
53  my $http_port = $NICK =~ m/-dev/ ? 8001 : 8000;  # number of last tags to keep in circular buffer
54  my $http_hostname = `hostname`;  my $last_x_tags = 50;
 chomp( $http_hostname );  
55    
56  ## END CONFIG  # don't pull rss feeds more often than this
57    my $rss_min_delay = 60;
58    
59    my $http_port = $NICK =~ m/-dev/ ? 8001 : 8000;
60    
61    my $url = "http://$HOSTNAME:$http_port";
62    
63    ## END CONFIG
64    
65  use POE qw(Component::IRC Wheel::FollowTail Component::Server::HTTP);  use POE qw(Component::IRC Component::Server::HTTP);
66  use HTTP::Status;  use HTTP::Status;
67  use DBI;  use DBI;
 use Encode qw/from_to is_utf8/;  
68  use Regexp::Common qw /URI/;  use Regexp::Common qw /URI/;
69  use CGI::Simple;  use CGI::Simple;
70  use HTML::TagCloud;  use HTML::TagCloud;
# Line 95  GetOptions( Line 90  GetOptions(
90          'log:s' => \$log_path,          'log:s' => \$log_path,
91  );  );
92    
93  $SIG{__DIE__} = sub {  #$SIG{__DIE__} = sub {
94          confess "fatal error";  #       confess "fatal error";
95  };  #};
96    
97  open(STDOUT, '>', $log_path) || warn "can't redirect log to $log_path: $!";  open(STDOUT, '>', $log_path) || warn "can't redirect log to $log_path: $!";
98    
99  sub _log {  sub _log {
100          print strftime($TIMESTAMP,localtime()), ' ', join(" ",@_), $/;          print strftime($TIMESTAMP,localtime()) . ' ' . join(" ",@_) . $/;
101  }  }
102    
103  # HTML formatters  # HTML formatters
# Line 122  my $filter = { Line 117  my $filter = {
117                  # protect HTML from wiki modifications                  # protect HTML from wiki modifications
118                  sub e {                  sub e {
119                          my $t = shift;                          my $t = shift;
120                          return 'uri_unescape{' . uri_escape($t) . '}';                          return 'uri_unescape{' . uri_escape($t, '^a-zA-Z0-9') . '}';
121                  }                  }
122    
123                  $m =~ s/($escape_re)/$escape{$1}/gs;                  $m =~ s/($escape_re)/$escape{$1}/gs;
124                  $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;
125                  $m =~ s#\/(\w+)\/#<i>$1</i>#gs;                  $m =~ s#\/(\w+)\/#<i>$1</i>#gs;
126                  $m =~ s#$tag_regex#e(qq{<a href="?tag=$1" class="tag">$1</a>})#egs;                  $m =~ s#$tag_regex#e(qq{<a href="$url?tag=$1" class="tag">$1</a>})#egs;
127                  $m =~ s#\*(\w+)\*#<b>$1</b>#gs;                  $m =~ s#\*(\w+)\*#<b>$1</b>#gs;
128                  $m =~ s#_(\w+)_#<u>$1</u>#gs;                  $m =~ s#_(\w+)_#<u>$1</u>#gs;
129    
# Line 148  my $filter = { Line 143  my $filter = {
143  };  };
144    
145  my $dbh = DBI->connect($DSN,"","", { RaiseError => 1, AutoCommit => 1 }) || die $DBI::errstr;  my $dbh = DBI->connect($DSN,"","", { RaiseError => 1, AutoCommit => 1 }) || die $DBI::errstr;
146    $dbh->do( qq{ set client_encoding = 'UTF-8' } );
147    
148  my $sql_schema = {  my $sql_schema = {
149          log => '          log => qq{
150  create table log (  create table log (
151          id serial,          id serial,
152          time timestamp default now(),          time timestamp default now(),
# Line 164  create table log ( Line 160  create table log (
160  create index log_time on log(time);  create index log_time on log(time);
161  create index log_channel on log(channel);  create index log_channel on log(channel);
162  create index log_nick on log(nick);  create index log_nick on log(nick);
163          ',          },
164          meta => '          meta => q{
165  create table meta (  create table meta (
166          nick text not null,          nick text not null,
167          channel text not null,          channel text not null,
168          name text not null,          name text not null,
169          value text,          value text,
170          changed timestamp default now(),          changed timestamp default 'now()',
171          primary key(nick,channel,name)          primary key(nick,channel,name)
172  );  );
173          ',          },
174            feeds => qq{
175    create table feeds (
176            id serial,
177            url text not null,
178            name text,
179            delay interval not null default '5 min',
180            active boolean default true,
181            channel text not null,
182            nick text not null,
183            private boolean default false,
184            last_update timestamp default 'now()',
185            polls int default 0,
186            updates int default 0
187    );
188    create unique index feeds_url on feeds(url);
189    insert into feeds (url,name,channel,nick) values ('http://wiki.razmjenavjestina.org/feed/workspace/razmjenavjestina?category=Recent%20Changes','wiki','$CHANNEL','dpavlin');
190            },
191  };  };
192    
193  foreach my $table ( keys %$sql_schema ) {  foreach my $table ( keys %$sql_schema ) {
# Line 217  sub meta { Line 230  sub meta {
230                  if ( $@ || ! $sth->rows ) {                  if ( $@ || ! $sth->rows ) {
231                          $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()) });
232                          $sth->execute( $value, $nick, $channel, $name );                          $sth->execute( $value, $nick, $channel, $name );
233                          _log "created $nick/$channel/$name = $value";                          warn "## created $nick/$channel/$name = $value\n";
234                  } else {                  } else {
235                          _log "updated $nick/$channel/$name = $value ";                          warn "## updated $nick/$channel/$name = $value\n";
236                  }                  }
237    
238                  return $value;                  return $value;
# Line 229  sub meta { Line 242  sub meta {
242                  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 = ? });
243                  $sth->execute( $nick, $channel, $name );                  $sth->execute( $nick, $channel, $name );
244                  my ($v,$c) = $sth->fetchrow_array;                  my ($v,$c) = $sth->fetchrow_array;
245                  _log "fetched $nick/$channel/$name = $v [$c]";                  warn "## fetched $nick/$channel/$name = $v [$c]\n";
246                  return ($v,$c) if wantarray;                  return ($v,$c) if wantarray;
247                  return $v;                  return $v;
248    
# Line 238  sub meta { Line 251  sub meta {
251    
252    
253    
254  my $sth = $dbh->prepare(qq{  my $sth_insert_log = $dbh->prepare(qq{
255  insert into log  insert into log
256          (channel, me, nick, message, time)          (channel, me, nick, message, time)
257  values (?,?,?,?,?)  values (?,?,?,?,?)
# Line 482  my $cloud = HTML::TagCloud->new; Line 495  my $cloud = HTML::TagCloud->new;
495    
496  =cut  =cut
497    
 my $last_x_tags = 5;  
498  my @last_tags;  my @last_tags;
499    
500  sub add_tag {  sub add_tag {
# Line 491  sub add_tag { Line 503  sub add_tag {
503          return unless ($arg->{id} && $arg->{message});          return unless ($arg->{id} && $arg->{message});
504    
505          my $m = $arg->{message};          my $m = $arg->{message};
         from_to('UTF-8', 'iso-8859-2', $m) if (is_utf8($m));  
506    
507          my @tags;          my @tags;
508    
# Line 500  sub add_tag { Line 511  sub add_tag {
511                  next if (! $tag || $tag =~ m/https?:/i);                  next if (! $tag || $tag =~ m/https?:/i);
512                  push @{ $tags->{$tag} }, $arg->{id};                  push @{ $tags->{$tag} }, $arg->{id};
513                  #warn "+tag $tag: $arg->{id}\n";                  #warn "+tag $tag: $arg->{id}\n";
514                  $cloud->add($tag, "?tag=$tag", scalar @{$tags->{$tag}} + 1);                  $cloud->add($tag, "$url?tag=$tag", scalar @{$tags->{$tag}} + 1);
515                  push @tags, $tag;                  push @tags, $tag;
516    
517          }          }
518    
519          if ( @tags ) {          if ( @tags ) {
520                  shift @last_tags if $#last_tags == $last_x_tags;                  pop @last_tags if $#last_tags == $last_x_tags;
521                  push @last_tags, { tags => [ @tags ], %$arg };                  unshift @last_tags, { tags => [ @tags ], %$arg };
522          }          }
523    
524  }  }
# Line 519  Read all tags from database and create i Line 530  Read all tags from database and create i
530  =cut  =cut
531    
532  sub seed_tags {  sub seed_tags {
533          my $sth = $dbh->prepare(qq{ select id,message,nick,me,time from log where message like '%//%' });          my $sth = $dbh->prepare(qq{ select id,message,nick,me,time from log where message like '%//%' order by time asc });
534          $sth->execute;          $sth->execute;
535          while (my $row = $sth->fetchrow_hashref) {          while (my $row = $sth->fetchrow_hashref) {
536                  add_tag( %$row );                  add_tag( %$row );
537          }          }
538    
539          foreach my $tag (keys %$tags) {          foreach my $tag (keys %$tags) {
540                  $cloud->add($tag, "?tag=$tag", scalar @{$tags->{$tag}} + 1);                  $cloud->add($tag, "$url?tag=$tag", scalar @{$tags->{$tag}} + 1);
541          }          }
542  }  }
543    
# Line 560  sub save_message { Line 571  sub save_message {
571                  $a->{me} ? "***" . $a->{nick} : "<" . $a->{nick} . ">",                  $a->{me} ? "***" . $a->{nick} : "<" . $a->{nick} . ">",
572                  " " . $a->{message};                  " " . $a->{message};
573    
574          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});  
575          add_tag( id => $dbh->last_insert_id(undef,undef,"log",undef), %$a );          add_tag( id => $dbh->last_insert_id(undef,undef,"log",undef), %$a );
576  }  }
577    
# Line 601  if ($import_dircproxy) { Line 610  if ($import_dircproxy) {
610          exit;          exit;
611  }  }
612    
613    #
614    # RSS follow
615    #
616    
617    my $_rss;
618    
619    
620    sub rss_fetch {
621            my ($args) = @_;
622    
623            # how many messages to send out when feed is seen for the first time?
624            my $send_rss_msgs = 1;
625    
626            _log "RSS fetch", $args->{url};
627    
628            my $feed = XML::Feed->parse(URI->new( $args->{url} ));
629            if ( ! $feed ) {
630                    _log("can't fetch RSS ", $args->{url});
631                    return;
632            }
633    
634            my ( $total, $updates ) = ( 0, 0 );
635            for my $entry ($feed->entries) {
636                    $total++;
637    
638                    # seen allready?
639                    next if $_rss->{$args->{channel}}->{$feed->link}->{$entry->id}++ > 0;
640    
641                    sub prefix {
642                            my ($txt,$var) = @_;
643                            $var =~ s/\s+/ /gs;
644                            $var =~ s/^\s+//g;
645                            $var =~ s/\s+$//g;
646                            return $txt . $var if $var;
647                    }
648    
649                    # fix absolute and relative links to feed entries
650                    my $link = $entry->link;
651                    if ( $link =~ m!^/! ) {
652                            my $host = $args->{url};
653                            $host =~ s!^(http://[^/]+).*$!$1!;      #!vim
654                            $link = "$host/$link";
655                    } elsif ( $link !~ m!^http! ) {
656                            $link = $args->{url} . $link;
657                    }
658                    $link =~ s!//+!/!g;
659    
660                    my $msg;
661                    $msg .= prefix( 'From: ' , $args->{name} || $feed->title );
662                    $msg .= prefix( ' by ' , $entry->author );
663                    $msg .= prefix( ' | ' , $entry->title );
664                    $msg .= prefix( ' | ' , $link );
665    #               $msg .= prefix( ' id ' , $entry->id );
666    
667                    if ( $args->{kernel} && $send_rss_msgs ) {
668                            $send_rss_msgs--;
669                            $sth_insert_log->execute( $args->{channel}, 1, $NICK, $msg, 'now()' );
670                            my ( $type, $to ) = ( 'notice', $args->{channel} );
671                            ( $type, $to ) = ( 'privmsg', $args->{nick} ) if $args->{private};
672                            _log(">> $type $to |", $msg);
673                            $args->{kernel}->post( $IRC_ALIAS => $type => $to, $msg );
674                            $updates++;
675                    }
676            }
677    
678            my $sql = qq{ update feeds set last_update = now(), polls = polls + 1 };
679            $sql .= qq{, updates = updates + $updates } if $updates;
680            $sql .= qq{where id = } . $args->{id};
681            eval { $dbh->do( $sql ) };
682    
683            _log "RSS got $total items of which $updates new";
684    
685            return $updates;
686    }
687    
688    sub rss_fetch_all {
689            my $kernel = shift;
690            my $sql = qq{
691                    select id, url, name, channel, nick, private
692                    from feeds
693                    where active is true
694            };
695            # limit to newer feeds only if we are not sending messages out
696            $sql .= qq{     and last_update + delay < now() } if $kernel;
697            my $sth = $dbh->prepare( $sql );
698            $sth->execute();
699            warn "# ",$sth->rows," active RSS feeds\n";
700            my $count = 0;
701            while (my $row = $sth->fetchrow_hashref) {
702                    $row->{kernel} = $kernel if $kernel;
703                    $count += rss_fetch( $row );
704            }
705            return "OK, fetched $count posts from " . $sth->rows . " feeds";
706    }
707    
708    
709    sub rss_check_updates {
710            my $kernel = shift;
711            $_rss->{last_poll} ||= time();
712            my $dt = time() - $_rss->{last_poll};
713            warn "## rss_check_updates $dt > $rss_min_delay\n";
714            if ( $dt > $rss_min_delay ) {
715                    $_rss->{last_poll} = time();
716                    _log rss_fetch_all( $kernel );
717            }
718    }
719    
720    # seed rss seen cache so we won't send out all items on startup
721    _log rss_fetch_all;
722    
723  #  #
724  # POE handing part  # POE handing part
725  #  #
726    
 my $SKIPPING = 0;               # if skipping, how many we've done  
 my $SEND_QUEUE;                 # cache  
727  my $ping;                                               # ping stats  my $ping;                                               # ping stats
728    
729  POE::Component::IRC->new($IRC_ALIAS);  POE::Component::IRC->new($IRC_ALIAS);
730    
731  POE::Session->create( inline_states =>  POE::Session->create( inline_states => {
732     {_start => sub {                _start => sub {      
733                  $_[KERNEL]->post($IRC_ALIAS => register => 'all');                  $_[KERNEL]->post($IRC_ALIAS => register => 'all');
734                  $_[KERNEL]->post($IRC_ALIAS => connect => $CONNECT);                  $_[KERNEL]->post($IRC_ALIAS => connect => $CONNECT);
735      },      },
736      irc_255 => sub {    # server is done blabbing      irc_255 => sub {    # server is done blabbing
737                  $_[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;  
738                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "IDENTIFY $NICK" );                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "IDENTIFY $NICK" );
739      },      },
740      irc_public => sub {      irc_public => sub {
# Line 632  POE::Session->create( inline_states => Line 745  POE::Session->create( inline_states =>
745    
746                  save_message( channel => $channel, me => 0, nick => $nick, message => $msg);                  save_message( channel => $channel, me => 0, nick => $nick, message => $msg);
747                  meta( $nick, $channel, 'last-msg', $msg );                  meta( $nick, $channel, 'last-msg', $msg );
748                    rss_check_updates( $kernel );
749      },      },
750      irc_ctcp_action => sub {      irc_ctcp_action => sub {
751                  my $kernel = $_[KERNEL];                  my $kernel = $_[KERNEL];
# Line 652  POE::Session->create( inline_states => Line 766  POE::Session->create( inline_states =>
766    
767      },      },
768          irc_ping => sub {          irc_ping => sub {
769                  warn "pong ", $_[ARG0], $/;                  _log( "pong ", $_[ARG0] );
770                  $ping->{ $_[ARG0] }++;                  $ping->{ $_[ARG0] }++;
771                    rss_check_updates( $_[KERNEL] );
772          },          },
773          irc_invite => sub {          irc_invite => sub {
774                  my $kernel = $_[KERNEL];                  my $kernel = $_[KERNEL];
775                  my $nick = (split /!/, $_[ARG0])[0];                  my $nick = (split /!/, $_[ARG0])[0];
776                  my $channel = $_[ARG1];                  my $channel = $_[ARG1];
777    
778                  warn "invited to $channel by $nick";                  _log "invited to $channel by $nick";
779    
780                  $_[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..." );
781                  $_[KERNEL]->post($IRC_ALIAS => join => $channel);                  $_[KERNEL]->post($IRC_ALIAS => join => $channel);
# Line 671  POE::Session->create( inline_states => Line 786  POE::Session->create( inline_states =>
786                  my $nick = (split /!/, $_[ARG0])[0];                  my $nick = (split /!/, $_[ARG0])[0];
787                  my $msg = $_[ARG2];                  my $msg = $_[ARG2];
788                  my $channel = $_[ARG1]->[0];                  my $channel = $_[ARG1]->[0];
                 from_to($msg, 'UTF-8', $ENCODING);  
789    
790                  my $res = "unknown command '$msg', try /msg $NICK help!";                  my $res = "unknown command '$msg', try /msg $NICK help!";
791                  my @out;                  my @out;
# Line 715  POE::Session->create( inline_states => Line 829  POE::Session->create( inline_states =>
829    
830                          foreach my $res (get_from_log( limit => $limit )) {                          foreach my $res (get_from_log( limit => $limit )) {
831                                  _log "last: $res";                                  _log "last: $res";
                                 from_to($res, $ENCODING, 'UTF-8');  
832                                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );                                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );
833                          }                          }
834    
# Line 730  POE::Session->create( inline_states => Line 843  POE::Session->create( inline_states =>
843                                          search => $what,                                          search => $what,
844                                  )) {                                  )) {
845                                  _log "search [$what]: $res";                                  _log "search [$what]: $res";
                                 from_to($res, $ENCODING, 'UTF-8');  
846                                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );                                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );
847                          }                          }
848    
# Line 800  POE::Session->create( inline_states => Line 912  POE::Session->create( inline_states =>
912                                          $res = "config option $op doesn't exist";                                          $res = "config option $op doesn't exist";
913                                  }                                  }
914                          }                          }
915                    } elsif ($msg =~ m/^rss-update/) {
916                            $res = rss_fetch_all( $_[KERNEL] );
917                    } elsif ($msg =~ m/^rss-clean/) {
918                            $_rss = undef;
919                            $dbh->do( qq{ update feeds set last_update = now() - delay } );
920                            $res = "OK, cleaned RSS cache";
921                    } elsif ($msg =~ m/^rss-list/) {
922                            my $sth = $dbh->prepare(qq{ select url,name,last_update,active,channel,nick,private from feeds });
923                            $sth->execute;
924                            while (my @row = $sth->fetchrow_array) {
925                                    $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, join(' | ',@row) );
926                            }
927                            $res = '';
928                    } elsif ($msg =~ m!^rss-(add|remove|stop|start)(?:-(private))?\s+(http://\S+)\s*(.*)!) {
929                            my ( $command, $sub, $url, $arg ) = ( $1,$2,$3,$4 );
930    
931                            my $channel = $1 if ( $arg =~ s/\s*(#\S+)\s*// );
932                            $channel = $nick if $sub eq 'private';
933    
934                            my $sql = {
935                                    add             => qq{ insert into feeds (url,name,channel,nick,private) values (?,?,?,?,?) },
936    #                               remove  => qq{ delete from feeds                                where url = ? and name = ? },
937                                    start   => qq{ update feeds set active = true   where url = ? },
938                                    stop    => qq{ update feeds set active = false  where url = ? },
939                            };
940    
941                            if (my $q = $sql->{$command} ) {
942                                    my $sth = $dbh->prepare( $q );
943                                    my @data = ( $url );
944                                    if ( $command eq 'add' ) {
945                                            push @data, ( $arg, $channel, $nick, $sub eq 'private' ? 1 : 0 );
946                                    }
947                                    warn "## $command SQL $q with ",dump( @data ),"\n";
948                                    eval { $sth->execute( @data ) };
949                                    if ($@) {
950                                            $res = "ERROR: $@";
951                                    } else {
952                                            $res = "OK, RSS [$command|$sub|$url|$arg]";
953                                    }
954                            } else {
955                                    $res = "ERROR: don't know what to do with: $msg";
956                            }
957    
958                  }                  }
959    
960                  if ($res) {                  if ($res) {
961                          _log ">> [$nick] $res";                          _log ">> [$nick] $res";
                         from_to($res, $ENCODING, 'UTF-8');  
962                          $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );                          $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );
963                  }                  }
964    
965                    rss_check_updates( $_[KERNEL] );
966          },          },
967          irc_477 => sub {          irc_477 => sub {
968                  _log "# irc_477: ",$_[ARG1];                  _log "# irc_477: ",$_[ARG1];
# Line 846  POE::Session->create( inline_states => Line 1001  POE::Session->create( inline_states =>
1001                          "";                          "";
1002        0;                        # false for signals        0;                        # false for signals
1003      },      },
     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);  
     }  
1004     },     },
1005    );    );
1006    
# Line 913  POE::Session->create( inline_states => Line 1008  POE::Session->create( inline_states =>
1008    
1009  my $httpd = POE::Component::Server::HTTP->new(  my $httpd = POE::Component::Server::HTTP->new(
1010          Port => $http_port,          Port => $http_port,
1011            PreHandler => {
1012                    '/' => sub {
1013                            $_[0]->header(Connection => 'close')
1014                    }
1015            },
1016          ContentHandler => { '/' => \&root_handler },          ContentHandler => { '/' => \&root_handler },
1017          Headers        => { Server => 'irc-logger' },          Headers        => { Server => 'irc-logger' },
1018  );  );
# Line 958  sub root_handler { Line 1058  sub root_handler {
1058          my ($request, $response) = @_;          my ($request, $response) = @_;
1059          $response->code(RC_OK);          $response->code(RC_OK);
1060    
1061            # this doesn't seem to work, so moved to PreHandler
1062            #$response->header(Connection => 'close');
1063    
1064            return RC_OK if $request->uri =~ m/favicon.ico$/;
1065    
1066          my $q;          my $q;
1067    
1068          if ( $request->method eq 'POST' ) {          if ( $request->method eq 'POST' ) {
# Line 970  sub root_handler { Line 1075  sub root_handler {
1075    
1076          my $search = $q->param('search') || $q->param('grep') || '';          my $search = $q->param('search') || $q->param('grep') || '';
1077    
1078          if ($request->url =~ m#/(rss|atom)#) {          if ($request->url =~ m#/rss(?:/(tags|last-tag|follow.*)\w*(?:=(\d+))?)?#i) {
1079                  my $type = uc($1);                  my $show = lc($1);
1080                  my $url = "http://$http_hostname:$http_port";                  my $nr = $2;
1081    
1082                  $response->content_type("application/$type+xml");                  my $type = 'RSS';       # Atom
1083    
1084                    $response->content_type( 'application/' . lc($type) . '+xml' );
1085    
1086                  my $html = '<!-- error -->';                  my $html = '<!-- error -->';
1087                  warn "create $type feed from ",dump( @last_tags );                  #warn "create $type feed from ",dump( @last_tags );
1088    
1089                  my $feed = XML::Feed->new( $type );                  my $feed = XML::Feed->new( $type );
1090                    $feed->link( $url );
1091    
1092                    if ( $show eq 'tags' ) {
1093                            $nr ||= 50;
1094                            $feed->title( "tags from $CHANNEL" );
1095                            $feed->link( "$url/tags" );
1096                            $feed->description( "tag cloud created from messages on channel $CHANNEL which have tags// in them" );
1097                            my $feed_entry = XML::Feed::Entry->new($type);
1098                            $feed_entry->title( "$nr tags from $CHANNEL" );
1099                            $feed_entry->author( $NICK );
1100                            $feed_entry->link( '/#tags'  );
1101    
1102                            $feed_entry->content(
1103                                    qq{<![CDATA[<style type="text/css">}
1104                                    . $cloud->css
1105                                    . qq{</style>}
1106                                    . $cloud->html( $nr )
1107                                    . qq{]]>}
1108                            );
1109                            $feed->add_entry( $feed_entry );
1110    
1111                    } elsif ( $show eq 'last-tag' ) {
1112    
1113                            $nr ||= $last_x_tags;
1114                            $nr = $last_x_tags if $nr > $last_x_tags;
1115    
1116                            $feed->title( "last $nr tagged messages from $CHANNEL" );
1117                            $feed->description( "collects messages which have tags// in them" );
1118    
1119                            foreach my $m ( @last_tags ) {
1120    #                               warn dump( $m );
1121                                    #my $tags = join(' ', @{$m->{tags}} );
1122                                    my $feed_entry = XML::Feed::Entry->new($type);
1123                                    $feed_entry->title( $m->{nick} . '@' . $m->{time} );
1124                                    $feed_entry->author( $m->{nick} );
1125                                    $feed_entry->link( '/#' . $m->{id}  );
1126                                    $feed_entry->issued( DateTime::Format::Flexible->build( $m->{time} ) );
1127    
1128                                    my $message = $filter->{message}->( $m->{message} );
1129                                    $message .= "<br/>\n" unless $message =~ m!<(/p|br/?)>!;
1130    #                               warn "## message = $message\n";
1131    
1132                                    #$feed_entry->summary(
1133                                    $feed_entry->content(
1134                                            "<![CDATA[$message]]>"
1135                                    );
1136                                    $feed_entry->category( join(', ', @{$m->{tags}}) );
1137                                    $feed->add_entry( $feed_entry );
1138    
1139                                    $nr--;
1140                                    last if $nr <= 0;
1141    
1142                            }
1143    
1144                    } elsif ( $show =~ m/^follow/ ) {
1145    
1146                            $feed->title( "Feeds which this bot follows" );
1147    
1148                            my $sth = $dbh->prepare( qq{ select * from feeds order by last_update desc } );
1149                            $sth->execute;
1150                            while (my $row = $sth->fetchrow_hashref) {
1151                                    my $feed_entry = XML::Feed::Entry->new($type);
1152                                    $feed_entry->title( $row->{name} );
1153                                    $feed_entry->link( $row->{url}  );
1154                                    $feed_entry->issued( DateTime::Format::Flexible->build( $row->{last_update} ) );
1155                                    $feed_entry->content(
1156                                            '<![CDATA[<pre>' . dump( $row ) . '</pre>]]>'
1157                                    );
1158                                    $feed->add_entry( $feed_entry );
1159                            }
1160    
                 $feed->title( "last $last_x_tags from $CHANNEL" );  
                 $feed->link( "http://$http_hostname:$http_port" );  
                 $feed->description( "collects messages which have tags// in them" );  
   
                 foreach my $m ( @last_tags ) {  
                         warn dump( $m );  
                         #my $tags = join(' ', @{$m->{tags}} );  
1161                          my $feed_entry = XML::Feed::Entry->new($type);                          my $feed_entry = XML::Feed::Entry->new($type);
1162                          $feed_entry->title( $m->{nick} . '@' . $m->{time} );                          $feed_entry->title( "Internal stats" );
1163                          $feed_entry->author( $m->{nick} );                          $feed_entry->content(
1164  #                       $feed_entry->link(  );                                  '<![CDATA[<pre>' . dump( $_rss ) . '</pre>]]>'
                         $feed_entry->issued( DateTime::Format::Flexible->build( $m->{time} ) );  
                         $feed_entry->summary(  
 #                               $filter->{nick}->( $m->{nick} ) .  
 #                               '<tt>' . $m->{nick} . '</tt> ' .  
                                 $filter->{message}->( $m->{message} )  
1165                          );                          );
1166                          $feed->add_entry( $feed_entry );                          $feed->add_entry( $feed_entry );
1167    
1168                    } else {
1169                            _log "unknown rss request ",$request->url;
1170                            return RC_DENY;
1171                  }                  }
1172    
1173                  $response->content( $feed->as_xml );                  $response->content( $feed->as_xml );
# Line 1009  sub root_handler { Line 1178  sub root_handler {
1178                  warn "$@";                  warn "$@";
1179          }          }
1180    
1181          $response->content_type("text/html; charset=$ENCODING");          $response->content_type("text/html; charset=UTF-8");
1182    
1183          my $html =          my $html =
1184                  qq{<html><head><title>$NICK</title><style type="text/css">$style} .                  qq{<html><head><title>$NICK</title><style type="text/css">$style}
1185                  $cloud->css .                  . $cloud->css
1186                  qq{</style></head><body>} .                  . qq{</style></head><body>}
1187                  qq{                  . qq{
1188                  <form method="post" class="search" action="/">                  <form method="post" class="search" action="/">
1189                  <input type="text" name="search" value="$search" size="10">                  <input type="text" name="search" value="$search" size="10">
1190                  <input type="submit" value="search">                  <input type="submit" value="search">
1191                  </form>                  </form>
1192                  } .                  }
1193                  $cloud->html(500) .                  . $cloud->html(500)
1194                  qq{<p>};                  . qq{<p>};
1195          if ($request->url =~ m#/history#) {  
1196            if ($request->url =~ m#/tags?#) {
1197                    # nop
1198            } elsif ($request->url =~ m#/history#) {
1199                  my $sth = $dbh->prepare(qq{                  my $sth = $dbh->prepare(qq{
1200                          select date(time) as date,count(*) as nr,sum(length(message)) as len                          select date(time) as date,count(*) as nr,sum(length(message)) as len
1201                                  from log                                  from log
# Line 1055  sub root_handler { Line 1227  sub root_handler {
1227                                  $cal->weekdays('MON','TUE','WED','THU','FRI');                                  $cal->weekdays('MON','TUE','WED','THU','FRI');
1228                                  ($l_yyyy,$l_mm) = ($yyyy,$mm);                                  ($l_yyyy,$l_mm) = ($yyyy,$mm);
1229                          }                          }
1230                          $cal->setcontent($dd, qq{                          $cal->setcontent($dd, qq[
1231                                  <a href="/?date=$row->{date}">$row->{nr}</a><br/>$row->{len}                                  <a href="$url?date=$row->{date}">$row->{nr}</a><br/>$row->{len}
1232                          });                          ]) if $cal;
1233                                                    
1234                  }                  }
1235                  $html .= qq{<td valign="top">} . $cal->as_HTML() . qq{</td></tr></table>};                  $html .= qq{<td valign="top">} . $cal->as_HTML() . qq{</td></tr></table>};
# Line 1072  sub root_handler { Line 1244  sub root_handler {
1244                                  fmt => {                                  fmt => {
1245                                          date => sub {                                          date => sub {
1246                                                  my $date = shift || return;                                                  my $date = shift || return;
1247                                                  qq{<hr/><div class="date"><a href="/?date=$date">$date</a></div>};                                                  qq{<hr/><div class="date"><a href="$url?date=$date">$date</a></div>};
1248                                          },                                          },
1249                                          time => '<span class="time">%s</span> ',                                          time => '<span class="time">%s</span> ',
1250                                          time_channel => '<span class="channel">%s %s</span> ',                                          time_channel => '<span class="channel">%s %s</span> ',
# Line 1091  sub root_handler { Line 1263  sub root_handler {
1263          </body></html>};          </body></html>};
1264    
1265          $response->content( $html );          $response->content( $html );
1266            warn "<< ", $request->method, " ", $request->uri, " created ", length($html), " bytes\n";
1267          return RC_OK;          return RC_OK;
1268  }  }
1269    
Legend:
Removed from v.70  
changed lines
  Added in v.98
  ViewVC Help
Powered by ViewVC 1.1.26