/[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 83 by dpavlin, Fri Feb 29 22:11:07 2008 UTC revision 100 by dpavlin, Sat Mar 8 00:14:41 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 46  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;
# Line 62  my $sleep_on_error = 5; Line 53  my $sleep_on_error = 5;
53  # number of last tags to keep in circular buffer  # number of last tags to keep in circular buffer
54  my $last_x_tags = 50;  my $last_x_tags = 50;
55    
56    # 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;  my $http_port = $NICK =~ m/-dev/ ? 8001 : 8000;
60    
61  my $url = "http://$HOSTNAME:$http_port";  my $url = "http://$HOSTNAME:$http_port";
62    
63  ## END CONFIG  ## END CONFIG
64    
65    use POE qw(Component::IRC Component::Server::HTTP);
   
 use POE qw(Component::IRC Wheel::FollowTail 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 99  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 126  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="$url?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;
# Line 152  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 168  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 221  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 233  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 242  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 330  sub get_from_log { Line 339  sub get_from_log {
339    
340          my @where;          my @where;
341          my @args;          my @args;
342            my $msg;
343    
344          if (my $search = $args->{search}) {          if (my $search = $args->{search}) {
345                  $search =~ s/^\s+//;                  $search =~ s/^\s+//;
346                  $search =~ s/\s+$//;                  $search =~ s/\s+$//;
347                  push @where, 'message ilike ? or nick ilike ?';                  push @where, 'message ilike ? or nick ilike ?';
348                  push @args, ( ( '%' . $search . '%' ) x 2 );                  push @args, ( ( '%' . $search . '%' ) x 2 );
349                  _log "search for '$search'";                  $msg = "Search for '$search'";
350          }          }
351    
352          if ($args->{tag} && $tags->{ $args->{tag} }) {          if ($args->{tag} && $tags->{ $args->{tag} }) {
353                  push @where, 'id in (' . join(',', @{ $tags->{ $args->{tag} } }) . ')';                  push @where, 'id in (' . join(',', @{ $tags->{ $args->{tag} } }) . ')';
354                  _log "search for tags $args->{tag}";                  $msg = "Search for tags $args->{tag}";
355          }          }
356    
357          if (my $date = $args->{date} ) {          if (my $date = $args->{date} ) {
358                  $date = check_date( $date );                  $date = check_date( $date );
359                  push @where, 'date(time) = ?';                  push @where, 'date(time) = ?';
360                  push @args, $date;                  push @args, $date;
361                  _log "search for date $date";                  $msg = "search for date $date";
362          }          }
363    
364          $sql .= " where " . join(" and ", @where) if @where;          $sql .= " where " . join(" and ", @where) if @where;
# Line 362  sub get_from_log { Line 372  sub get_from_log {
372          eval { $sth->execute( @args ) };          eval { $sth->execute( @args ) };
373          return if $@;          return if $@;
374    
375            my $nr_results = $sth->rows;
376    
377          my $last_row = {          my $last_row = {
378                  date => '',                  date => '',
379                  time => '',                  time => '',
# Line 382  sub get_from_log { Line 394  sub get_from_log {
394    
395          return @rows if ($args->{full_rows});          return @rows if ($args->{full_rows});
396    
397          my @msgs = (          $msg .= ' produced ' . (
398                  "Showing " . ($#rows + 1) . " messages..."                  $nr_results == 0 ? 'no results' :
399                    $nr_results == 0 ? 'one result' :
400                            $nr_results . ' results'
401          );          );
402    
403            my @msgs = ( $msg );
404    
405          if ($context) {          if ($context) {
406                  my @ids = @rows;                  my @ids = @rows;
407                  @rows = ();                  @rows = ();
# Line 494  sub add_tag { Line 510  sub add_tag {
510          return unless ($arg->{id} && $arg->{message});          return unless ($arg->{id} && $arg->{message});
511    
512          my $m = $arg->{message};          my $m = $arg->{message};
         from_to('UTF-8', 'iso-8859-2', $m) if (is_utf8($m));  
513    
514          my @tags;          my @tags;
515    
# Line 563  sub save_message { Line 578  sub save_message {
578                  $a->{me} ? "***" . $a->{nick} : "<" . $a->{nick} . ">",                  $a->{me} ? "***" . $a->{nick} : "<" . $a->{nick} . ">",
579                  " " . $a->{message};                  " " . $a->{message};
580    
581          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});  
582          add_tag( id => $dbh->last_insert_id(undef,undef,"log",undef), %$a );          add_tag( id => $dbh->last_insert_id(undef,undef,"log",undef), %$a );
583  }  }
584    
# Line 604  if ($import_dircproxy) { Line 617  if ($import_dircproxy) {
617          exit;          exit;
618  }  }
619    
620    #
621    # RSS follow
622    #
623    
624    my $_rss;
625    
626    
627    sub rss_fetch {
628            my ($args) = @_;
629    
630            # how many messages to send out when feed is seen for the first time?
631            my $send_rss_msgs = 1;
632    
633            _log "RSS fetch", $args->{url};
634    
635            my $feed = XML::Feed->parse(URI->new( $args->{url} ));
636            if ( ! $feed ) {
637                    _log("can't fetch RSS ", $args->{url});
638                    return;
639            }
640    
641            my ( $total, $updates ) = ( 0, 0 );
642            for my $entry ($feed->entries) {
643                    $total++;
644    
645                    # seen allready?
646                    next if $_rss->{$args->{channel}}->{$feed->link}->{$entry->id}++ > 0;
647    
648                    sub prefix {
649                            my ($txt,$var) = @_;
650                            $var =~ s/\s+/ /gs;
651                            $var =~ s/^\s+//g;
652                            $var =~ s/\s+$//g;
653                            return $txt . $var if $var;
654                    }
655    
656                    # fix absolute and relative links to feed entries
657                    my $link = $entry->link;
658                    if ( $link =~ m!^/! ) {
659                            my $host = $args->{url};
660                            $host =~ s!^(http://[^/]+).*$!$1!;      #!vim
661                            $link = "$host/$link";
662                    } elsif ( $link !~ m!^http! ) {
663                            $link = $args->{url} . $link;
664                    }
665    
666                    my $msg;
667                    $msg .= prefix( 'From: ' , $args->{name} || $feed->title );
668                    $msg .= prefix( ' by ' , $entry->author );
669                    $msg .= prefix( ' | ' , $entry->title );
670                    $msg .= prefix( ' | ' , $link );
671    #               $msg .= prefix( ' id ' , $entry->id );
672    
673                    if ( $args->{kernel} && $send_rss_msgs ) {
674                            $send_rss_msgs--;
675                            $sth_insert_log->execute( $args->{channel}, 1, $NICK, $msg, 'now()' );
676                            my ( $type, $to ) = ( 'notice', $args->{channel} );
677                            ( $type, $to ) = ( 'privmsg', $args->{nick} ) if $args->{private};
678                            _log(">> $type $to |", $msg);
679                            $args->{kernel}->post( $IRC_ALIAS => $type => $to, $msg );
680                            $updates++;
681                    }
682            }
683    
684            my $sql = qq{ update feeds set last_update = now(), polls = polls + 1 };
685            $sql .= qq{, updates = updates + $updates } if $updates;
686            $sql .= qq{where id = } . $args->{id};
687            eval { $dbh->do( $sql ) };
688    
689            _log "RSS got $total items of which $updates new";
690    
691            return $updates;
692    }
693    
694    sub rss_fetch_all {
695            my $kernel = shift;
696            my $sql = qq{
697                    select id, url, name, channel, nick, private
698                    from feeds
699                    where active is true
700            };
701            # limit to newer feeds only if we are not sending messages out
702            $sql .= qq{     and last_update + delay < now() } if $kernel;
703            my $sth = $dbh->prepare( $sql );
704            $sth->execute();
705            warn "# ",$sth->rows," active RSS feeds\n";
706            my $count = 0;
707            while (my $row = $sth->fetchrow_hashref) {
708                    $row->{kernel} = $kernel if $kernel;
709                    $count += rss_fetch( $row );
710            }
711            return "OK, fetched $count posts from " . $sth->rows . " feeds";
712    }
713    
714    
715    sub rss_check_updates {
716            my $kernel = shift;
717            $_rss->{last_poll} ||= time();
718            my $dt = time() - $_rss->{last_poll};
719            warn "## rss_check_updates $dt > $rss_min_delay\n";
720            if ( $dt > $rss_min_delay ) {
721                    $_rss->{last_poll} = time();
722                    _log rss_fetch_all( $kernel );
723            }
724    }
725    
726    # seed rss seen cache so we won't send out all items on startup
727    _log rss_fetch_all;
728    
729  #  #
730  # POE handing part  # POE handing part
731  #  #
732    
 my $SKIPPING = 0;               # if skipping, how many we've done  
 my $SEND_QUEUE;                 # cache  
733  my $ping;                                               # ping stats  my $ping;                                               # ping stats
734    
735  POE::Component::IRC->new($IRC_ALIAS);  POE::Component::IRC->new($IRC_ALIAS);
736    
737  POE::Session->create( inline_states =>  POE::Session->create( inline_states => {
738     {_start => sub {                _start => sub {      
739                  $_[KERNEL]->post($IRC_ALIAS => register => 'all');                  $_[KERNEL]->post($IRC_ALIAS => register => 'all');
740                  $_[KERNEL]->post($IRC_ALIAS => connect => $CONNECT);                  $_[KERNEL]->post($IRC_ALIAS => connect => $CONNECT);
741      },      },
742      irc_255 => sub {    # server is done blabbing      irc_255 => sub {    # server is done blabbing
743                  $_[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;  
744                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "IDENTIFY $NICK" );                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "IDENTIFY $NICK" );
745      },      },
746      irc_public => sub {      irc_public => sub {
# Line 635  POE::Session->create( inline_states => Line 751  POE::Session->create( inline_states =>
751    
752                  save_message( channel => $channel, me => 0, nick => $nick, message => $msg);                  save_message( channel => $channel, me => 0, nick => $nick, message => $msg);
753                  meta( $nick, $channel, 'last-msg', $msg );                  meta( $nick, $channel, 'last-msg', $msg );
754                    rss_check_updates( $kernel );
755      },      },
756      irc_ctcp_action => sub {      irc_ctcp_action => sub {
757                  my $kernel = $_[KERNEL];                  my $kernel = $_[KERNEL];
# Line 655  POE::Session->create( inline_states => Line 772  POE::Session->create( inline_states =>
772    
773      },      },
774          irc_ping => sub {          irc_ping => sub {
775                  warn "pong ", $_[ARG0], $/;                  _log( "pong ", $_[ARG0] );
776                  $ping->{ $_[ARG0] }++;                  $ping->{ $_[ARG0] }++;
777                    rss_check_updates( $_[KERNEL] );
778          },          },
779          irc_invite => sub {          irc_invite => sub {
780                  my $kernel = $_[KERNEL];                  my $kernel = $_[KERNEL];
781                  my $nick = (split /!/, $_[ARG0])[0];                  my $nick = (split /!/, $_[ARG0])[0];
782                  my $channel = $_[ARG1];                  my $channel = $_[ARG1];
783    
784                  warn "invited to $channel by $nick";                  _log "invited to $channel by $nick";
785    
786                  $_[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..." );
787                  $_[KERNEL]->post($IRC_ALIAS => join => $channel);                  $_[KERNEL]->post($IRC_ALIAS => join => $channel);
# Line 674  POE::Session->create( inline_states => Line 792  POE::Session->create( inline_states =>
792                  my $nick = (split /!/, $_[ARG0])[0];                  my $nick = (split /!/, $_[ARG0])[0];
793                  my $msg = $_[ARG2];                  my $msg = $_[ARG2];
794                  my $channel = $_[ARG1]->[0];                  my $channel = $_[ARG1]->[0];
                 from_to($msg, 'UTF-8', $ENCODING);  
795    
796                  my $res = "unknown command '$msg', try /msg $NICK help!";                  my $res = "unknown command '$msg', try /msg $NICK help!";
797                  my @out;                  my @out;
# Line 718  POE::Session->create( inline_states => Line 835  POE::Session->create( inline_states =>
835    
836                          foreach my $res (get_from_log( limit => $limit )) {                          foreach my $res (get_from_log( limit => $limit )) {
837                                  _log "last: $res";                                  _log "last: $res";
                                 from_to($res, $ENCODING, 'UTF-8');  
838                                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );                                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );
839                          }                          }
840    
# Line 733  POE::Session->create( inline_states => Line 849  POE::Session->create( inline_states =>
849                                          search => $what,                                          search => $what,
850                                  )) {                                  )) {
851                                  _log "search [$what]: $res";                                  _log "search [$what]: $res";
                                 from_to($res, $ENCODING, 'UTF-8');  
852                                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );                                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );
853                          }                          }
854    
# Line 803  POE::Session->create( inline_states => Line 918  POE::Session->create( inline_states =>
918                                          $res = "config option $op doesn't exist";                                          $res = "config option $op doesn't exist";
919                                  }                                  }
920                          }                          }
921                    } elsif ($msg =~ m/^rss-update/) {
922                            $res = rss_fetch_all( $_[KERNEL] );
923                    } elsif ($msg =~ m/^rss-clean/) {
924                            $_rss = undef;
925                            $dbh->do( qq{ update feeds set last_update = now() - delay } );
926                            $res = "OK, cleaned RSS cache";
927                    } elsif ($msg =~ m/^rss-list/) {
928                            my $sth = $dbh->prepare(qq{ select url,name,last_update,active,channel,nick,private from feeds });
929                            $sth->execute;
930                            while (my @row = $sth->fetchrow_array) {
931                                    $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, join(' | ',@row) );
932                            }
933                            $res = '';
934                    } elsif ($msg =~ m!^rss-(add|remove|stop|start)(?:-(private))?\s+(http://\S+)\s*(.*)!) {
935                            my ( $command, $sub, $url, $arg ) = ( $1,$2,$3,$4 );
936    
937                            my $channel = $1 if ( $arg =~ s/\s*(#\S+)\s*// );
938                            $channel = $nick if $sub eq 'private';
939    
940                            my $sql = {
941                                    add             => qq{ insert into feeds (url,name,channel,nick,private) values (?,?,?,?,?) },
942    #                               remove  => qq{ delete from feeds                                where url = ? and name = ? },
943                                    start   => qq{ update feeds set active = true   where url = ? },
944                                    stop    => qq{ update feeds set active = false  where url = ? },
945                            };
946    
947                            if ( $command eq 'add' && ! $channel ) {
948                                    $res = "ERROR: got '$msg' which doesn't have #channel in it, ignoring!";
949                            } elsif (my $q = $sql->{$command} ) {
950                                    my $sth = $dbh->prepare( $q );
951                                    my @data = ( $url );
952                                    if ( $command eq 'add' ) {
953                                            push @data, ( $arg, $channel, $nick, $sub eq 'private' ? 1 : 0 );
954                                    }
955                                    warn "## $command SQL $q with ",dump( @data ),"\n";
956                                    eval { $sth->execute( @data ) };
957                                    if ($@) {
958                                            $res = "ERROR: $@";
959                                    } else {
960                                            $res = "OK, RSS [$command|$sub|$url|$arg]";
961                                    }
962                            } else {
963                                    $res = "ERROR: don't know what to do with: $msg";
964                            }
965                  }                  }
966    
967                  if ($res) {                  if ($res) {
968                          _log ">> [$nick] $res";                          _log ">> [$nick] $res";
                         from_to($res, $ENCODING, 'UTF-8');  
969                          $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );                          $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );
970                  }                  }
971    
972                    rss_check_updates( $_[KERNEL] );
973          },          },
974          irc_477 => sub {          irc_477 => sub {
975                  _log "# irc_477: ",$_[ARG1];                  _log "# irc_477: ",$_[ARG1];
# Line 849  POE::Session->create( inline_states => Line 1008  POE::Session->create( inline_states =>
1008                          "";                          "";
1009        0;                        # false for signals        0;                        # false for signals
1010      },      },
     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);  
     }  
1011     },     },
1012    );    );
1013    
# Line 983  sub root_handler { Line 1082  sub root_handler {
1082    
1083          my $search = $q->param('search') || $q->param('grep') || '';          my $search = $q->param('search') || $q->param('grep') || '';
1084    
1085          if ($request->url =~ m#/rss(?:/(tags|last-tag)\w*(?:=(\d+))?)?#i) {          if ($request->url =~ m#/rss(?:/(tags|last-tag|follow.*)\w*(?:=(\d+))?)?#i) {
1086                  my $show = lc($1);                  my $show = lc($1);
1087                  my $nr = $2;                  my $nr = $2;
1088    
# Line 995  sub root_handler { Line 1094  sub root_handler {
1094                  #warn "create $type feed from ",dump( @last_tags );                  #warn "create $type feed from ",dump( @last_tags );
1095    
1096                  my $feed = XML::Feed->new( $type );                  my $feed = XML::Feed->new( $type );
1097                    $feed->link( $url );
1098    
1099                  if ( $show eq 'tags' ) {                  if ( $show eq 'tags' ) {
1100                          $nr ||= 50;                          $nr ||= 50;
# Line 1021  sub root_handler { Line 1121  sub root_handler {
1121                          $nr = $last_x_tags if $nr > $last_x_tags;                          $nr = $last_x_tags if $nr > $last_x_tags;
1122    
1123                          $feed->title( "last $nr tagged messages from $CHANNEL" );                          $feed->title( "last $nr tagged messages from $CHANNEL" );
                         $feed->link( $url );  
1124                          $feed->description( "collects messages which have tags// in them" );                          $feed->description( "collects messages which have tags// in them" );
1125    
1126                          foreach my $m ( @last_tags ) {                          foreach my $m ( @last_tags ) {
# Line 1036  sub root_handler { Line 1135  sub root_handler {
1135                                  my $message = $filter->{message}->( $m->{message} );                                  my $message = $filter->{message}->( $m->{message} );
1136                                  $message .= "<br/>\n" unless $message =~ m!<(/p|br/?)>!;                                  $message .= "<br/>\n" unless $message =~ m!<(/p|br/?)>!;
1137  #                               warn "## message = $message\n";  #                               warn "## message = $message\n";
                                 from_to( $message, $ENCODING, 'UTF-8' );  
1138    
1139                                  #$feed_entry->summary(                                  #$feed_entry->summary(
1140                                  $feed_entry->content(                                  $feed_entry->content(
# Line 1050  sub root_handler { Line 1148  sub root_handler {
1148    
1149                          }                          }
1150    
1151                    } elsif ( $show =~ m/^follow/ ) {
1152    
1153                            $feed->title( "Feeds which this bot follows" );
1154    
1155                            my $sth = $dbh->prepare( qq{ select * from feeds order by last_update desc } );
1156                            $sth->execute;
1157                            while (my $row = $sth->fetchrow_hashref) {
1158                                    my $feed_entry = XML::Feed::Entry->new($type);
1159                                    $feed_entry->title( $row->{name} );
1160                                    $feed_entry->link( $row->{url}  );
1161                                    $feed_entry->issued( DateTime::Format::Flexible->build( $row->{last_update} ) );
1162                                    $feed_entry->content(
1163                                            '<![CDATA[<pre>' . dump( $row ) . '</pre>]]>'
1164                                    );
1165                                    $feed->add_entry( $feed_entry );
1166                            }
1167    
1168                            my $feed_entry = XML::Feed::Entry->new($type);
1169                            $feed_entry->title( "Internal stats" );
1170                            $feed_entry->content(
1171                                    '<![CDATA[<pre>' . dump( $_rss ) . '</pre>]]>'
1172                            );
1173                            $feed->add_entry( $feed_entry );
1174    
1175                  } else {                  } else {
1176                          warn "!! unknown rss request for $show\n";                          _log "unknown rss request ",$request->url;
1177                          return RC_DENY;                          return RC_DENY;
1178                  }                  }
1179    
# Line 1063  sub root_handler { Line 1185  sub root_handler {
1185                  warn "$@";                  warn "$@";
1186          }          }
1187    
1188          $response->content_type("text/html; charset=$ENCODING");          $response->content_type("text/html; charset=UTF-8");
1189    
1190          my $html =          my $html =
1191                  qq{<html><head><title>$NICK</title><style type="text/css">$style}                  qq{<html><head><title>$NICK</title><style type="text/css">$style}
# Line 1114  sub root_handler { Line 1236  sub root_handler {
1236                          }                          }
1237                          $cal->setcontent($dd, qq[                          $cal->setcontent($dd, qq[
1238                                  <a href="$url?date=$row->{date}">$row->{nr}</a><br/>$row->{len}                                  <a href="$url?date=$row->{date}">$row->{nr}</a><br/>$row->{len}
1239                          ]);                          ]) if $cal;
1240                                                    
1241                  }                  }
1242                  $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.83  
changed lines
  Added in v.100
  ViewVC Help
Powered by ViewVC 1.1.26