/[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 84 by dpavlin, Thu Mar 6 18:03:05 2008 UTC revision 89 by dpavlin, Fri Mar 7 00:43:45 2008 UTC
# Line 55  my $follows_path = 'follows.log'; Line 55  my $follows_path = 'follows.log';
55    
56  my $DSN = 'DBI:Pg:dbname=' . $NICK;  my $DSN = 'DBI:Pg:dbname=' . $NICK;
57    
 my $ENCODING = 'ISO-8859-2';  
58  my $TIMESTAMP = '%Y-%m-%d %H:%M:%S';  my $TIMESTAMP = '%Y-%m-%d %H:%M:%S';
59    
60  my $sleep_on_error = 5;  my $sleep_on_error = 5;
# Line 63  my $sleep_on_error = 5; Line 62  my $sleep_on_error = 5;
62  # number of last tags to keep in circular buffer  # number of last tags to keep in circular buffer
63  my $last_x_tags = 50;  my $last_x_tags = 50;
64    
65    # don't pull rss feeds more often than this
66    my $rss_min_delay = 60;
67    $rss_min_delay = 15;
68    
69  my $http_port = $NICK =~ m/-dev/ ? 8001 : 8000;  my $http_port = $NICK =~ m/-dev/ ? 8001 : 8000;
70    
71  my $url = "http://$HOSTNAME:$http_port";  my $url = "http://$HOSTNAME:$http_port";
72    
73  ## END CONFIG  ## END CONFIG
74    
   
   
75  use POE qw(Component::IRC Wheel::FollowTail Component::Server::HTTP);  use POE qw(Component::IRC Wheel::FollowTail Component::Server::HTTP);
76  use HTTP::Status;  use HTTP::Status;
77  use DBI;  use DBI;
 use Encode qw/from_to is_utf8/;  
78  use Regexp::Common qw /URI/;  use Regexp::Common qw /URI/;
79  use CGI::Simple;  use CGI::Simple;
80  use HTML::TagCloud;  use HTML::TagCloud;
# Line 101  GetOptions( Line 101  GetOptions(
101          'log:s' => \$log_path,          'log:s' => \$log_path,
102  );  );
103    
104  $SIG{__DIE__} = sub {  #$SIG{__DIE__} = sub {
105          confess "fatal error";  #       confess "fatal error";
106  };  #};
107    
108  open(STDOUT, '>', $log_path) || warn "can't redirect log to $log_path: $!";  open(STDOUT, '>', $log_path) || warn "can't redirect log to $log_path: $!";
109    
110  sub _log {  sub _log {
111          print strftime($TIMESTAMP,localtime()), ' ', join(" ",@_), $/;          print strftime($TIMESTAMP,localtime()) . ' ' . join(" ",@_) . $/;
112  }  }
113    
114  # LOG following  # LOG following
# Line 172  my $filter = { Line 172  my $filter = {
172  };  };
173    
174  my $dbh = DBI->connect($DSN,"","", { RaiseError => 1, AutoCommit => 1 }) || die $DBI::errstr;  my $dbh = DBI->connect($DSN,"","", { RaiseError => 1, AutoCommit => 1 }) || die $DBI::errstr;
175    $dbh->do( qq{ set client_encoding = 'UTF-8' } );
176    
177  my $sql_schema = {  my $sql_schema = {
178          log => '          log => qq{
179  create table log (  create table log (
180          id serial,          id serial,
181          time timestamp default now(),          time timestamp default now(),
# Line 188  create table log ( Line 189  create table log (
189  create index log_time on log(time);  create index log_time on log(time);
190  create index log_channel on log(channel);  create index log_channel on log(channel);
191  create index log_nick on log(nick);  create index log_nick on log(nick);
192          ',          },
193          meta => '          meta => q{
194  create table meta (  create table meta (
195          nick text not null,          nick text not null,
196          channel text not null,          channel text not null,
197          name text not null,          name text not null,
198          value text,          value text,
199          changed timestamp default now(),          changed timestamp default 'now()',
200          primary key(nick,channel,name)          primary key(nick,channel,name)
201  );  );
202          ',          },
203            feeds => qq{
204    create table feeds (
205            id serial,
206            url text not null,
207            name text,
208            delay interval not null default '5 min',
209            active boolean default true,
210            last_update timestamp default 'now()',
211            polls int default 0,
212            updates int default 0
213    );
214    create unique index feeds_url on feeds(url);
215    insert into feeds (url,name) values ('http://wiki.razmjenavjestina.org/feed/workspace/razmjenavjestina?category=Recent%20Changes','wiki');
216            },
217  };  };
218    
219  foreach my $table ( keys %$sql_schema ) {  foreach my $table ( keys %$sql_schema ) {
# Line 262  sub meta { Line 277  sub meta {
277    
278    
279    
280  my $sth = $dbh->prepare(qq{  my $sth_insert_log = $dbh->prepare(qq{
281  insert into log  insert into log
282          (channel, me, nick, message, time)          (channel, me, nick, message, time)
283  values (?,?,?,?,?)  values (?,?,?,?,?)
# Line 514  sub add_tag { Line 529  sub add_tag {
529          return unless ($arg->{id} && $arg->{message});          return unless ($arg->{id} && $arg->{message});
530    
531          my $m = $arg->{message};          my $m = $arg->{message};
         from_to('UTF-8', 'iso-8859-2', $m) if (is_utf8($m));  
532    
533          my @tags;          my @tags;
534    
# Line 583  sub save_message { Line 597  sub save_message {
597                  $a->{me} ? "***" . $a->{nick} : "<" . $a->{nick} . ">",                  $a->{me} ? "***" . $a->{nick} : "<" . $a->{nick} . ">",
598                  " " . $a->{message};                  " " . $a->{message};
599    
600          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});  
601          add_tag( id => $dbh->last_insert_id(undef,undef,"log",undef), %$a );          add_tag( id => $dbh->last_insert_id(undef,undef,"log",undef), %$a );
602  }  }
603    
# Line 624  if ($import_dircproxy) { Line 636  if ($import_dircproxy) {
636          exit;          exit;
637  }  }
638    
639    #
640    # RSS follow
641    #
642    
643    my $_rss;
644    
645    
646    sub rss_fetch {
647            my ($args) = @_;
648    
649            # how many messages to send out when feed is seen for the first time?
650            my $send_rss_msgs = 1;
651    
652            _log "RSS fetch", $args->{url};
653    
654            my $feed = XML::Feed->parse(URI->new( $args->{url} ));
655            if ( ! $feed ) {
656                    _log("can't fetch RSS ", $args->{url});
657                    return;
658            }
659            my ( $total, $updates ) = ( 0, 0 );
660            for my $entry ($feed->entries) {
661                    $total++;
662    
663                    # seen allready?
664                    return if $_rss->{$feed->link}->{seen}->{$entry->id}++ > 0;
665    
666                    sub prefix {
667                            my ($txt,$var) = @_;
668                            $var =~ s/^\s+//g;
669                            return $txt . $var if $var;
670                    }
671    
672                    my $msg;
673                    $msg .= prefix( 'From: ' , $feed->title );
674                    $msg .= prefix( ' by ' , $entry->author );
675                    $msg .= prefix( ' -- ' , $entry->link );
676    #               $msg .= prefix( ' id ' , $entry->id );
677    
678                    if ( $args->{kernel} && $send_rss_msgs ) {
679                            $send_rss_msgs--;
680                            _log('RSS', $msg);
681                            $sth_insert_log->execute( $CHANNEL, 1, $NICK, $msg, undef );
682                            $args->{kernel}->post( $IRC_ALIAS => notice => $CHANNEL, $msg );
683                            $updates++;
684                    }
685            }
686    
687            my $sql = qq{ update feeds set last_update = now(), polls = polls + 1 };
688            $sql .= qq{, updates = updates + $updates } if $updates;
689            $sql .= qq{where id = } . $args->{id};
690            eval { $dbh->do( $sql ) };
691    
692            _log "RSS got $total items of which $updates new";
693    
694            return $updates;
695    }
696    
697    sub rss_fetch_all {
698            my $kernel = shift;
699            my $sql = qq{
700                    select id, url, name
701                    from feeds
702                    where active is true
703            };
704            # limit to newer feeds only if we are not sending messages out
705            $sql .= qq{     and last_update + delay < now() } if $kernel;
706            my $sth = $dbh->prepare( $sql );
707            $sth->execute();
708            warn "# ",$sth->rows," active RSS feeds\n";
709            my $count = 0;
710            while (my $row = $sth->fetchrow_hashref) {
711                    $row->{kernel} = $kernel if $kernel;
712                    $count += rss_fetch( $row );
713            }
714            return "OK, fetched $count posts from " . $sth->rows . " feeds";
715    }
716    
717    
718    sub rss_check_updates {
719            my $kernel = shift;
720            my $last_t = $_rss->{last_poll} || time();
721            my $t = time();
722            if ( $last_t - $t > $rss_min_delay ) {
723                    $_rss->{last_poll} = $t;
724                    _log rss_fetch_all( $kernel );
725            }
726    }
727    
728    # seed rss seen cache so we won't send out all items on startup
729    _log rss_fetch_all;
730    
731  #  #
732  # POE handing part  # POE handing part
# Line 635  my $ping;                                              # ping stats Line 738  my $ping;                                              # ping stats
738    
739  POE::Component::IRC->new($IRC_ALIAS);  POE::Component::IRC->new($IRC_ALIAS);
740    
741  POE::Session->create( inline_states =>  POE::Session->create( inline_states => {
742     {_start => sub {                _start => sub {      
743                  $_[KERNEL]->post($IRC_ALIAS => register => 'all');                  $_[KERNEL]->post($IRC_ALIAS => register => 'all');
744                  $_[KERNEL]->post($IRC_ALIAS => connect => $CONNECT);                  $_[KERNEL]->post($IRC_ALIAS => connect => $CONNECT);
745      },      },
746      irc_255 => sub {    # server is done blabbing      irc_255 => sub {    # server is done blabbing
747                  $_[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;  
748                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "IDENTIFY $NICK" );                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "IDENTIFY $NICK" );
749      },      },
750      irc_public => sub {      irc_public => sub {
# Line 677  POE::Session->create( inline_states => Line 777  POE::Session->create( inline_states =>
777          irc_ping => sub {          irc_ping => sub {
778                  _log( "pong ", $_[ARG0] );                  _log( "pong ", $_[ARG0] );
779                  $ping->{ $_[ARG0] }++;                  $ping->{ $_[ARG0] }++;
780                    rss_check_updates( $_[KERNEL] );
781          },          },
782          irc_invite => sub {          irc_invite => sub {
783                  my $kernel = $_[KERNEL];                  my $kernel = $_[KERNEL];
784                  my $nick = (split /!/, $_[ARG0])[0];                  my $nick = (split /!/, $_[ARG0])[0];
785                  my $channel = $_[ARG1];                  my $channel = $_[ARG1];
786    
787                  warn "invited to $channel by $nick";                  _log "invited to $channel by $nick";
788    
789                  $_[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..." );
790                  $_[KERNEL]->post($IRC_ALIAS => join => $channel);                  $_[KERNEL]->post($IRC_ALIAS => join => $channel);
# Line 694  POE::Session->create( inline_states => Line 795  POE::Session->create( inline_states =>
795                  my $nick = (split /!/, $_[ARG0])[0];                  my $nick = (split /!/, $_[ARG0])[0];
796                  my $msg = $_[ARG2];                  my $msg = $_[ARG2];
797                  my $channel = $_[ARG1]->[0];                  my $channel = $_[ARG1]->[0];
                 from_to($msg, 'UTF-8', $ENCODING);  
798    
799                  my $res = "unknown command '$msg', try /msg $NICK help!";                  my $res = "unknown command '$msg', try /msg $NICK help!";
800                  my @out;                  my @out;
# Line 738  POE::Session->create( inline_states => Line 838  POE::Session->create( inline_states =>
838    
839                          foreach my $res (get_from_log( limit => $limit )) {                          foreach my $res (get_from_log( limit => $limit )) {
840                                  _log "last: $res";                                  _log "last: $res";
                                 from_to($res, $ENCODING, 'UTF-8');  
841                                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );                                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );
842                          }                          }
843    
# Line 753  POE::Session->create( inline_states => Line 852  POE::Session->create( inline_states =>
852                                          search => $what,                                          search => $what,
853                                  )) {                                  )) {
854                                  _log "search [$what]: $res";                                  _log "search [$what]: $res";
                                 from_to($res, $ENCODING, 'UTF-8');  
855                                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );                                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );
856                          }                          }
857    
# Line 823  POE::Session->create( inline_states => Line 921  POE::Session->create( inline_states =>
921                                          $res = "config option $op doesn't exist";                                          $res = "config option $op doesn't exist";
922                                  }                                  }
923                          }                          }
924                    } elsif ($msg =~ m/^rss-update/) {
925                            $res = rss_fetch_all( $_[KERNEL] );
926                    } elsif ($msg =~ m/^rss-clean/) {
927                            $_rss = undef;
928                            $res = "OK, cleaned RSS cache";
929                    } elsif ($msg =~ m!^rss-(add|remove|stop|start)\s+(http://\S+)\s*(.*)!) {
930                            my $sql = {
931                                    add             => qq{ insert into feeds (url,name) values (?,?) },
932    #                               remove  => qq{ delete from feeds                                where url = ? and name = ? },
933                                    start   => qq{ update feeds set active = true   where url = ? -- ? },
934                                    stop    => qq{ update feeds set active = false  where url = ? -- ? },
935                                    
936                            };
937                            if (my $q = $sql->{$1} ) {
938                                    my $sth = $dbh->prepare( $q );
939                                    warn "## SQL $q ( $2 | $3 )\n";
940                                    eval { $sth->execute( $2, $3 ) };
941                            }
942    
943                            $res ||= "OK, RSS $1 : $2 - $3";
944                  }                  }
945    
946                  if ($res) {                  if ($res) {
947                          _log ">> [$nick] $res";                          _log ">> [$nick] $res";
                         from_to($res, $ENCODING, 'UTF-8');  
948                          $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );                          $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );
949                  }                  }
950    
951                    rss_check_updates( $_[KERNEL] );
952          },          },
953          irc_477 => sub {          irc_477 => sub {
954                  _log "# irc_477: ",$_[ARG1];                  _log "# irc_477: ",$_[ARG1];
# Line 869  POE::Session->create( inline_states => Line 987  POE::Session->create( inline_states =>
987                          "";                          "";
988        0;                        # false for signals        0;                        # false for signals
989      },      },
     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',  
                     );  
                                 warn "+++ following $trailing at $FOLLOWS{$trailing}\n";  
             },  
             got_line => sub {  
                                 warn "+++ $trailing : $_[ARG0]\n";  
                                 $_[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);  
     }  
990     },     },
991    );    );
992    
# Line 1004  sub root_handler { Line 1061  sub root_handler {
1061    
1062          my $search = $q->param('search') || $q->param('grep') || '';          my $search = $q->param('search') || $q->param('grep') || '';
1063    
1064          if ($request->url =~ m#/rss(?:/(tags|last-tag)\w*(?:=(\d+))?)?#i) {          if ($request->url =~ m#/rss(?:/(tags|last-tag|follow.*)\w*(?:=(\d+))?)?#i) {
1065                  my $show = lc($1);                  my $show = lc($1);
1066                  my $nr = $2;                  my $nr = $2;
1067    
# Line 1016  sub root_handler { Line 1073  sub root_handler {
1073                  #warn "create $type feed from ",dump( @last_tags );                  #warn "create $type feed from ",dump( @last_tags );
1074    
1075                  my $feed = XML::Feed->new( $type );                  my $feed = XML::Feed->new( $type );
1076                    $feed->link( $url );
1077    
1078                  if ( $show eq 'tags' ) {                  if ( $show eq 'tags' ) {
1079                          $nr ||= 50;                          $nr ||= 50;
# Line 1042  sub root_handler { Line 1100  sub root_handler {
1100                          $nr = $last_x_tags if $nr > $last_x_tags;                          $nr = $last_x_tags if $nr > $last_x_tags;
1101    
1102                          $feed->title( "last $nr tagged messages from $CHANNEL" );                          $feed->title( "last $nr tagged messages from $CHANNEL" );
                         $feed->link( $url );  
1103                          $feed->description( "collects messages which have tags// in them" );                          $feed->description( "collects messages which have tags// in them" );
1104    
1105                          foreach my $m ( @last_tags ) {                          foreach my $m ( @last_tags ) {
# Line 1057  sub root_handler { Line 1114  sub root_handler {
1114                                  my $message = $filter->{message}->( $m->{message} );                                  my $message = $filter->{message}->( $m->{message} );
1115                                  $message .= "<br/>\n" unless $message =~ m!<(/p|br/?)>!;                                  $message .= "<br/>\n" unless $message =~ m!<(/p|br/?)>!;
1116  #                               warn "## message = $message\n";  #                               warn "## message = $message\n";
                                 from_to( $message, $ENCODING, 'UTF-8' );  
1117    
1118                                  #$feed_entry->summary(                                  #$feed_entry->summary(
1119                                  $feed_entry->content(                                  $feed_entry->content(
# Line 1071  sub root_handler { Line 1127  sub root_handler {
1127    
1128                          }                          }
1129    
1130                    } elsif ( $show =~ m/^follow/ ) {
1131    
1132                            $feed->title( "Feeds which this bot follows" );
1133    
1134                            my $sth = $dbh->prepare( qq{ select * from feeds order by last_update desc } );
1135                            $sth->execute;
1136                            while (my $row = $sth->fetchrow_hashref) {
1137                                    my $feed_entry = XML::Feed::Entry->new($type);
1138                                    $feed_entry->title( $row->{name} );
1139                                    $feed_entry->link( $row->{url}  );
1140                                    $feed_entry->issued( DateTime::Format::Flexible->build( $row->{last_update} ) );
1141                                    $feed_entry->content(
1142                                            '<![CDATA[<pre>' . dump( $row ) . '</pre>]]>'
1143                                    );
1144                                    $feed->add_entry( $feed_entry );
1145                            }
1146    
1147                  } else {                  } else {
1148                          warn "!! unknown rss request for $show\n";                          _log "unknown rss request ",$request->url;
1149                          return RC_DENY;                          return RC_DENY;
1150                  }                  }
1151    
# Line 1084  sub root_handler { Line 1157  sub root_handler {
1157                  warn "$@";                  warn "$@";
1158          }          }
1159    
1160          $response->content_type("text/html; charset=$ENCODING");          $response->content_type("text/html; charset=UTF-8");
1161    
1162          my $html =          my $html =
1163                  qq{<html><head><title>$NICK</title><style type="text/css">$style}                  qq{<html><head><title>$NICK</title><style type="text/css">$style}
# Line 1135  sub root_handler { Line 1208  sub root_handler {
1208                          }                          }
1209                          $cal->setcontent($dd, qq[                          $cal->setcontent($dd, qq[
1210                                  <a href="$url?date=$row->{date}">$row->{nr}</a><br/>$row->{len}                                  <a href="$url?date=$row->{date}">$row->{nr}</a><br/>$row->{len}
1211                          ]);                          ]) if $cal;
1212                                                    
1213                  }                  }
1214                  $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.84  
changed lines
  Added in v.89
  ViewVC Help
Powered by ViewVC 1.1.26