/[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 93 by dpavlin, Fri Mar 7 10:35:04 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    $rss_min_delay = 15;
59    
60  my $http_port = $NICK =~ m/-dev/ ? 8001 : 8000;  my $http_port = $NICK =~ m/-dev/ ? 8001 : 8000;
61    
62  my $url = "http://$HOSTNAME:$http_port";  my $url = "http://$HOSTNAME:$http_port";
63    
64  ## END CONFIG  ## END CONFIG
65    
66    use POE qw(Component::IRC Component::Server::HTTP);
   
 use POE qw(Component::IRC Wheel::FollowTail Component::Server::HTTP);  
67  use HTTP::Status;  use HTTP::Status;
68  use DBI;  use DBI;
 use Encode qw/from_to is_utf8/;  
69  use Regexp::Common qw /URI/;  use Regexp::Common qw /URI/;
70  use CGI::Simple;  use CGI::Simple;
71  use HTML::TagCloud;  use HTML::TagCloud;
# Line 99  GetOptions( Line 91  GetOptions(
91          'log:s' => \$log_path,          'log:s' => \$log_path,
92  );  );
93    
94  $SIG{__DIE__} = sub {  #$SIG{__DIE__} = sub {
95          confess "fatal error";  #       confess "fatal error";
96  };  #};
97    
98  open(STDOUT, '>', $log_path) || warn "can't redirect log to $log_path: $!";  open(STDOUT, '>', $log_path) || warn "can't redirect log to $log_path: $!";
99    
100  sub _log {  sub _log {
101          print strftime($TIMESTAMP,localtime()), ' ', join(" ",@_), $/;          print strftime($TIMESTAMP,localtime()) . ' ' . join(" ",@_) . $/;
102  }  }
103    
104  # HTML formatters  # HTML formatters
# Line 152  my $filter = { Line 144  my $filter = {
144  };  };
145    
146  my $dbh = DBI->connect($DSN,"","", { RaiseError => 1, AutoCommit => 1 }) || die $DBI::errstr;  my $dbh = DBI->connect($DSN,"","", { RaiseError => 1, AutoCommit => 1 }) || die $DBI::errstr;
147    $dbh->do( qq{ set client_encoding = 'UTF-8' } );
148    
149  my $sql_schema = {  my $sql_schema = {
150          log => '          log => qq{
151  create table log (  create table log (
152          id serial,          id serial,
153          time timestamp default now(),          time timestamp default now(),
# Line 168  create table log ( Line 161  create table log (
161  create index log_time on log(time);  create index log_time on log(time);
162  create index log_channel on log(channel);  create index log_channel on log(channel);
163  create index log_nick on log(nick);  create index log_nick on log(nick);
164          ',          },
165          meta => '          meta => q{
166  create table meta (  create table meta (
167          nick text not null,          nick text not null,
168          channel text not null,          channel text not null,
169          name text not null,          name text not null,
170          value text,          value text,
171          changed timestamp default now(),          changed timestamp default 'now()',
172          primary key(nick,channel,name)          primary key(nick,channel,name)
173  );  );
174          ',          },
175            feeds => qq{
176    create table feeds (
177            id serial,
178            url text not null,
179            name text,
180            delay interval not null default '5 min',
181            active boolean default true,
182            last_update timestamp default 'now()',
183            polls int default 0,
184            updates int default 0
185    );
186    create unique index feeds_url on feeds(url);
187    insert into feeds (url,name) values ('http://wiki.razmjenavjestina.org/feed/workspace/razmjenavjestina?category=Recent%20Changes','wiki');
188            },
189  };  };
190    
191  foreach my $table ( keys %$sql_schema ) {  foreach my $table ( keys %$sql_schema ) {
# Line 242  sub meta { Line 249  sub meta {
249    
250    
251    
252  my $sth = $dbh->prepare(qq{  my $sth_insert_log = $dbh->prepare(qq{
253  insert into log  insert into log
254          (channel, me, nick, message, time)          (channel, me, nick, message, time)
255  values (?,?,?,?,?)  values (?,?,?,?,?)
# Line 494  sub add_tag { Line 501  sub add_tag {
501          return unless ($arg->{id} && $arg->{message});          return unless ($arg->{id} && $arg->{message});
502    
503          my $m = $arg->{message};          my $m = $arg->{message};
         from_to('UTF-8', 'iso-8859-2', $m) if (is_utf8($m));  
504    
505          my @tags;          my @tags;
506    
# Line 563  sub save_message { Line 569  sub save_message {
569                  $a->{me} ? "***" . $a->{nick} : "<" . $a->{nick} . ">",                  $a->{me} ? "***" . $a->{nick} : "<" . $a->{nick} . ">",
570                  " " . $a->{message};                  " " . $a->{message};
571    
572          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});  
573          add_tag( id => $dbh->last_insert_id(undef,undef,"log",undef), %$a );          add_tag( id => $dbh->last_insert_id(undef,undef,"log",undef), %$a );
574  }  }
575    
# Line 604  if ($import_dircproxy) { Line 608  if ($import_dircproxy) {
608          exit;          exit;
609  }  }
610    
611    #
612    # RSS follow
613    #
614    
615    my $_rss;
616    
617    
618    sub rss_fetch {
619            my ($args) = @_;
620    
621            # how many messages to send out when feed is seen for the first time?
622            my $send_rss_msgs = 1;
623    
624            _log "RSS fetch", $args->{url};
625    
626            my $feed = XML::Feed->parse(URI->new( $args->{url} ));
627            if ( ! $feed ) {
628                    _log("can't fetch RSS ", $args->{url});
629                    return;
630            }
631    
632            my ( $total, $updates ) = ( 0, 0 );
633            for my $entry ($feed->entries) {
634                    $total++;
635    
636                    # seen allready?
637                    next if $_rss->{$feed->link}->{seen}->{$entry->id}++ > 0;
638    
639                    sub prefix {
640                            my ($txt,$var) = @_;
641                            $var =~ s/\s+/ /gs;
642                            $var =~ s/^\s+//g;
643                            $var =~ s/\s+$//g;
644                            return $txt . $var if $var;
645                    }
646    
647                    my $msg;
648                    $msg .= prefix( 'From: ' , $args->{name} || $feed->title );
649                    $msg .= prefix( ' by ' , $entry->author );
650                    $msg .= prefix( ' | ' , $entry->title );
651                    $msg .= prefix( ' | ' , $entry->link );
652    #               $msg .= prefix( ' id ' , $entry->id );
653    
654                    if ( $args->{kernel} && $send_rss_msgs ) {
655                            $send_rss_msgs--;
656                            _log('>>', $msg);
657                            $sth_insert_log->execute( $CHANNEL, 1, $NICK, $msg, 'now()' );
658                            $args->{kernel}->post( $IRC_ALIAS => notice => $CHANNEL, $msg );
659                            $updates++;
660                    }
661            }
662    
663            my $sql = qq{ update feeds set last_update = now(), polls = polls + 1 };
664            $sql .= qq{, updates = updates + $updates } if $updates;
665            $sql .= qq{where id = } . $args->{id};
666            eval { $dbh->do( $sql ) };
667    
668            _log "RSS got $total items of which $updates new";
669    
670            return $updates;
671    }
672    
673    sub rss_fetch_all {
674            my $kernel = shift;
675            my $sql = qq{
676                    select id, url, name
677                    from feeds
678                    where active is true
679            };
680            # limit to newer feeds only if we are not sending messages out
681            $sql .= qq{     and last_update + delay < now() } if $kernel;
682            my $sth = $dbh->prepare( $sql );
683            $sth->execute();
684            warn "# ",$sth->rows," active RSS feeds\n";
685            my $count = 0;
686            while (my $row = $sth->fetchrow_hashref) {
687                    $row->{kernel} = $kernel if $kernel;
688                    $count += rss_fetch( $row );
689            }
690            return "OK, fetched $count posts from " . $sth->rows . " feeds";
691    }
692    
693    
694    sub rss_check_updates {
695            my $kernel = shift;
696            my $last_t = $_rss->{last_poll} || time();
697            my $t = time();
698            if ( $t - $last_t > $rss_min_delay ) {
699                    $_rss->{last_poll} = $t;
700                    _log rss_fetch_all( $kernel );
701            }
702    }
703    
704    # seed rss seen cache so we won't send out all items on startup
705    _log rss_fetch_all;
706    
707  #  #
708  # POE handing part  # POE handing part
709  #  #
710    
 my $SKIPPING = 0;               # if skipping, how many we've done  
 my $SEND_QUEUE;                 # cache  
711  my $ping;                                               # ping stats  my $ping;                                               # ping stats
712    
713  POE::Component::IRC->new($IRC_ALIAS);  POE::Component::IRC->new($IRC_ALIAS);
714    
715  POE::Session->create( inline_states =>  POE::Session->create( inline_states => {
716     {_start => sub {                _start => sub {      
717                  $_[KERNEL]->post($IRC_ALIAS => register => 'all');                  $_[KERNEL]->post($IRC_ALIAS => register => 'all');
718                  $_[KERNEL]->post($IRC_ALIAS => connect => $CONNECT);                  $_[KERNEL]->post($IRC_ALIAS => connect => $CONNECT);
719      },      },
720      irc_255 => sub {    # server is done blabbing      irc_255 => sub {    # server is done blabbing
721                  $_[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;  
722                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "IDENTIFY $NICK" );                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "IDENTIFY $NICK" );
723      },      },
724      irc_public => sub {      irc_public => sub {
# Line 655  POE::Session->create( inline_states => Line 749  POE::Session->create( inline_states =>
749    
750      },      },
751          irc_ping => sub {          irc_ping => sub {
752                  warn "pong ", $_[ARG0], $/;                  _log( "pong ", $_[ARG0] );
753                  $ping->{ $_[ARG0] }++;                  $ping->{ $_[ARG0] }++;
754                    rss_check_updates( $_[KERNEL] );
755          },          },
756          irc_invite => sub {          irc_invite => sub {
757                  my $kernel = $_[KERNEL];                  my $kernel = $_[KERNEL];
758                  my $nick = (split /!/, $_[ARG0])[0];                  my $nick = (split /!/, $_[ARG0])[0];
759                  my $channel = $_[ARG1];                  my $channel = $_[ARG1];
760    
761                  warn "invited to $channel by $nick";                  _log "invited to $channel by $nick";
762    
763                  $_[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..." );
764                  $_[KERNEL]->post($IRC_ALIAS => join => $channel);                  $_[KERNEL]->post($IRC_ALIAS => join => $channel);
# Line 674  POE::Session->create( inline_states => Line 769  POE::Session->create( inline_states =>
769                  my $nick = (split /!/, $_[ARG0])[0];                  my $nick = (split /!/, $_[ARG0])[0];
770                  my $msg = $_[ARG2];                  my $msg = $_[ARG2];
771                  my $channel = $_[ARG1]->[0];                  my $channel = $_[ARG1]->[0];
                 from_to($msg, 'UTF-8', $ENCODING);  
772    
773                  my $res = "unknown command '$msg', try /msg $NICK help!";                  my $res = "unknown command '$msg', try /msg $NICK help!";
774                  my @out;                  my @out;
# Line 718  POE::Session->create( inline_states => Line 812  POE::Session->create( inline_states =>
812    
813                          foreach my $res (get_from_log( limit => $limit )) {                          foreach my $res (get_from_log( limit => $limit )) {
814                                  _log "last: $res";                                  _log "last: $res";
                                 from_to($res, $ENCODING, 'UTF-8');  
815                                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );                                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );
816                          }                          }
817    
# Line 733  POE::Session->create( inline_states => Line 826  POE::Session->create( inline_states =>
826                                          search => $what,                                          search => $what,
827                                  )) {                                  )) {
828                                  _log "search [$what]: $res";                                  _log "search [$what]: $res";
                                 from_to($res, $ENCODING, 'UTF-8');  
829                                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );                                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );
830                          }                          }
831    
# Line 803  POE::Session->create( inline_states => Line 895  POE::Session->create( inline_states =>
895                                          $res = "config option $op doesn't exist";                                          $res = "config option $op doesn't exist";
896                                  }                                  }
897                          }                          }
898                    } elsif ($msg =~ m/^rss-update/) {
899                            $res = rss_fetch_all( $_[KERNEL] );
900                    } elsif ($msg =~ m/^rss-clean/) {
901                            $_rss = undef;
902                            $dbh->do( qq{ update feeds set last_update = now() - delay } );
903                            $res = "OK, cleaned RSS cache";
904                    } elsif ($msg =~ m/^rss-list/) {
905                            my $sth = $dbh->prepare(qq{ select url,name,last_update,active from feeds });
906                            $sth->execute;
907                            while (my @row = $sth->fetchrow_array) {
908                                    $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, join(' | ',@row) );
909                            }
910                            $res = '';
911                    } elsif ($msg =~ m!^rss-(add|remove|stop|start)\s+(http://\S+)\s*(.*)!) {
912                            my $sql = {
913                                    add             => qq{ insert into feeds (url,name) values (?,?) },
914    #                               remove  => qq{ delete from feeds                                where url = ? and name = ? },
915                                    start   => qq{ update feeds set active = true   where url = ? },
916                                    stop    => qq{ update feeds set active = false  where url = ? },
917                                    
918                            };
919                            if (my $q = $sql->{$1} ) {
920                                    my $sth = $dbh->prepare( $q );
921                                    my @data = ( $2 );
922                                    push @data, $3 if ( $q =~ s/\?//g == 2 );
923                                    warn "## $1 SQL $q with ",dump( @data ),"\n";
924                                    eval { $sth->execute( @data ) };
925                            }
926    
927                            $res = "OK, RSS $1 : $2 - $3";
928                  }                  }
929    
930                  if ($res) {                  if ($res) {
931                          _log ">> [$nick] $res";                          _log ">> [$nick] $res";
                         from_to($res, $ENCODING, 'UTF-8');  
932                          $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );                          $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );
933                  }                  }
934    
935                    rss_check_updates( $_[KERNEL] );
936          },          },
937          irc_477 => sub {          irc_477 => sub {
938                  _log "# irc_477: ",$_[ARG1];                  _log "# irc_477: ",$_[ARG1];
# Line 849  POE::Session->create( inline_states => Line 971  POE::Session->create( inline_states =>
971                          "";                          "";
972        0;                        # false for signals        0;                        # false for signals
973      },      },
     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);  
     }  
974     },     },
975    );    );
976    
# Line 983  sub root_handler { Line 1045  sub root_handler {
1045    
1046          my $search = $q->param('search') || $q->param('grep') || '';          my $search = $q->param('search') || $q->param('grep') || '';
1047    
1048          if ($request->url =~ m#/rss(?:/(tags|last-tag)\w*(?:=(\d+))?)?#i) {          if ($request->url =~ m#/rss(?:/(tags|last-tag|follow.*)\w*(?:=(\d+))?)?#i) {
1049                  my $show = lc($1);                  my $show = lc($1);
1050                  my $nr = $2;                  my $nr = $2;
1051    
# Line 995  sub root_handler { Line 1057  sub root_handler {
1057                  #warn "create $type feed from ",dump( @last_tags );                  #warn "create $type feed from ",dump( @last_tags );
1058    
1059                  my $feed = XML::Feed->new( $type );                  my $feed = XML::Feed->new( $type );
1060                    $feed->link( $url );
1061    
1062                  if ( $show eq 'tags' ) {                  if ( $show eq 'tags' ) {
1063                          $nr ||= 50;                          $nr ||= 50;
# Line 1021  sub root_handler { Line 1084  sub root_handler {
1084                          $nr = $last_x_tags if $nr > $last_x_tags;                          $nr = $last_x_tags if $nr > $last_x_tags;
1085    
1086                          $feed->title( "last $nr tagged messages from $CHANNEL" );                          $feed->title( "last $nr tagged messages from $CHANNEL" );
                         $feed->link( $url );  
1087                          $feed->description( "collects messages which have tags// in them" );                          $feed->description( "collects messages which have tags// in them" );
1088    
1089                          foreach my $m ( @last_tags ) {                          foreach my $m ( @last_tags ) {
# Line 1036  sub root_handler { Line 1098  sub root_handler {
1098                                  my $message = $filter->{message}->( $m->{message} );                                  my $message = $filter->{message}->( $m->{message} );
1099                                  $message .= "<br/>\n" unless $message =~ m!<(/p|br/?)>!;                                  $message .= "<br/>\n" unless $message =~ m!<(/p|br/?)>!;
1100  #                               warn "## message = $message\n";  #                               warn "## message = $message\n";
                                 from_to( $message, $ENCODING, 'UTF-8' );  
1101    
1102                                  #$feed_entry->summary(                                  #$feed_entry->summary(
1103                                  $feed_entry->content(                                  $feed_entry->content(
# Line 1050  sub root_handler { Line 1111  sub root_handler {
1111    
1112                          }                          }
1113    
1114                    } elsif ( $show =~ m/^follow/ ) {
1115    
1116                            $feed->title( "Feeds which this bot follows" );
1117    
1118                            my $sth = $dbh->prepare( qq{ select * from feeds order by last_update desc } );
1119                            $sth->execute;
1120                            while (my $row = $sth->fetchrow_hashref) {
1121                                    my $feed_entry = XML::Feed::Entry->new($type);
1122                                    $feed_entry->title( $row->{name} );
1123                                    $feed_entry->link( $row->{url}  );
1124                                    $feed_entry->issued( DateTime::Format::Flexible->build( $row->{last_update} ) );
1125                                    $feed_entry->content(
1126                                            '<![CDATA[<pre>' . dump( $row ) . '</pre>]]>'
1127                                    );
1128                                    $feed->add_entry( $feed_entry );
1129                            }
1130    
1131                  } else {                  } else {
1132                          warn "!! unknown rss request for $show\n";                          _log "unknown rss request ",$request->url;
1133                          return RC_DENY;                          return RC_DENY;
1134                  }                  }
1135    
# Line 1063  sub root_handler { Line 1141  sub root_handler {
1141                  warn "$@";                  warn "$@";
1142          }          }
1143    
1144          $response->content_type("text/html; charset=$ENCODING");          $response->content_type("text/html; charset=UTF-8");
1145    
1146          my $html =          my $html =
1147                  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 1192  sub root_handler {
1192                          }                          }
1193                          $cal->setcontent($dd, qq[                          $cal->setcontent($dd, qq[
1194                                  <a href="$url?date=$row->{date}">$row->{nr}</a><br/>$row->{len}                                  <a href="$url?date=$row->{date}">$row->{nr}</a><br/>$row->{len}
1195                          ]);                          ]) if $cal;
1196                                                    
1197                  }                  }
1198                  $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.93
  ViewVC Help
Powered by ViewVC 1.1.26