/[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 78 by dpavlin, Wed Feb 20 19:37:34 2008 UTC revision 85 by dpavlin, Thu Mar 6 22:16:27 2008 UTC
# Line 22  Import log from C<dircproxy> to C<irc-lo Line 22  Import log from C<dircproxy> to C<irc-lo
22    
23  Name of log file  Name of log file
24    
25    =item --follow=file.log
26    
27    Follows new messages in file
28    
29  =back  =back
30    
31  =head1 DESCRIPTION  =head1 DESCRIPTION
# Line 46  my $CHANNEL = '#razmjenavjestina'; Line 50  my $CHANNEL = '#razmjenavjestina';
50  $CHANNEL = '#irc-logger' if ($HOSTNAME =~ m/llin/);  $CHANNEL = '#irc-logger' if ($HOSTNAME =~ m/llin/);
51  my $IRC_ALIAS = "log";  my $IRC_ALIAS = "log";
52    
53  my %FOLLOWS =  # default log to follow and announce messages
54    (  my $follows_path = 'follows.log';
    ACCESS => "/var/log/apache/access.log",  
    ERROR => "/var/log/apache/error.log",  
   );  
55    
56  my $DSN = 'DBI:Pg:dbname=' . $NICK;  my $DSN = 'DBI:Pg:dbname=' . $NICK;
57    
# Line 59  my $TIMESTAMP = '%Y-%m-%d %H:%M:%S'; Line 60  my $TIMESTAMP = '%Y-%m-%d %H:%M:%S';
60    
61  my $sleep_on_error = 5;  my $sleep_on_error = 5;
62    
63    # number of last tags to keep in circular buffer
64    my $last_x_tags = 50;
65    
66    # don't pull rss feeds more often than this
67    my $rss_min_delay = 60;
68    $rss_min_delay = 15;
69    
70  my $http_port = $NICK =~ m/-dev/ ? 8001 : 8000;  my $http_port = $NICK =~ m/-dev/ ? 8001 : 8000;
71    
72  my $url = "http://$HOSTNAME:$http_port";  my $url = "http://$HOSTNAME:$http_port";
73    
74  ## END CONFIG  ## END CONFIG
75    
   
   
76  use POE qw(Component::IRC Wheel::FollowTail Component::Server::HTTP);  use POE qw(Component::IRC Wheel::FollowTail Component::Server::HTTP);
77  use HTTP::Status;  use HTTP::Status;
78  use DBI;  use DBI;
# Line 93  my $import_dircproxy; Line 99  my $import_dircproxy;
99  my $log_path;  my $log_path;
100  GetOptions(  GetOptions(
101          'import-dircproxy:s' => \$import_dircproxy,          'import-dircproxy:s' => \$import_dircproxy,
102            'follows:s' => \$follows_path,
103          'log:s' => \$log_path,          'log:s' => \$log_path,
104  );  );
105    
# Line 106  sub _log { Line 113  sub _log {
113          print strftime($TIMESTAMP,localtime()), ' ', join(" ",@_), $/;          print strftime($TIMESTAMP,localtime()), ' ', join(" ",@_), $/;
114  }  }
115    
116    # LOG following
117    
118    my %FOLLOWS =
119      (
120    #   ACCESS => "/var/log/apache/access.log",
121    #   ERROR => "/var/log/apache/error.log",
122      );
123    
124    sub add_follow_path {
125            my $path = shift;
126            my $name = $path;
127            $name =~ s/\..*$//;
128            warn "# using $path to announce messages from $name\n";
129            $FOLLOWS{$name} = $path;
130    }
131    
132    add_follow_path( $follows_path ) if ( -e $follows_path );
133    
134  # HTML formatters  # HTML formatters
135    
136  my %escape = ('<'=>'&lt;', '>'=>'&gt;', '&'=>'&amp;', '"'=>'&quot;');  my %escape = ('<'=>'&lt;', '>'=>'&gt;', '&'=>'&amp;', '"'=>'&quot;');
# Line 151  my $filter = { Line 176  my $filter = {
176  my $dbh = DBI->connect($DSN,"","", { RaiseError => 1, AutoCommit => 1 }) || die $DBI::errstr;  my $dbh = DBI->connect($DSN,"","", { RaiseError => 1, AutoCommit => 1 }) || die $DBI::errstr;
177    
178  my $sql_schema = {  my $sql_schema = {
179          log => '          log => qq{
180  create table log (  create table log (
181          id serial,          id serial,
182          time timestamp default now(),          time timestamp default now(),
# Line 165  create table log ( Line 190  create table log (
190  create index log_time on log(time);  create index log_time on log(time);
191  create index log_channel on log(channel);  create index log_channel on log(channel);
192  create index log_nick on log(nick);  create index log_nick on log(nick);
193          ',          },
194          meta => '          meta => q{
195  create table meta (  create table meta (
196          nick text not null,          nick text not null,
197          channel text not null,          channel text not null,
198          name text not null,          name text not null,
199          value text,          value text,
200          changed timestamp default now(),          changed timestamp default 'now()',
201          primary key(nick,channel,name)          primary key(nick,channel,name)
202  );  );
203          ',          },
204            feeds => qq{
205    create table feeds (
206            id serial,
207            url text not null,
208            name text,
209            delay interval not null default '30 sec', --'5 min',
210            active boolean default true,
211            last_update timestamp default 'now()',
212            polls int default 0,
213            updates int default 0
214    );
215    create unique index feeds_url on feeds(url);
216    insert into feeds (url,name) values ('http://wiki.razmjenavjestina.org/feed/workspace/razmjenavjestina?category=Recent%20Changes','wiki');
217            },
218  };  };
219    
220  foreach my $table ( keys %$sql_schema ) {  foreach my $table ( keys %$sql_schema ) {
# Line 483  my $cloud = HTML::TagCloud->new; Line 522  my $cloud = HTML::TagCloud->new;
522    
523  =cut  =cut
524    
 my $last_x_tags = 5;  
525  my @last_tags;  my @last_tags;
526    
527  sub add_tag {  sub add_tag {
# Line 602  if ($import_dircproxy) { Line 640  if ($import_dircproxy) {
640          exit;          exit;
641  }  }
642    
643    #
644    # RSS follow
645    #
646    
647    my $_rss;
648    
649    
650    sub rss_fetch {
651            my ($args) = @_;
652    
653            # how many messages to send out when feed is seen for the first time?
654            my $send_rss_msgs = 1;
655    
656            my $feed = XML::Feed->parse(URI->new( $args->{url} ));
657            if ( ! $feed ) {
658                    _log("can't fetch RSS ", $args->{url});
659                    return;
660            }
661            my $updates = 0;
662            for my $entry ($feed->entries) {
663    
664                    # seen allready?
665                    return if $_rss->{$feed->link}->{seen}->{$entry->id}++ > 0;
666    
667                    sub prefix {
668                            my ($txt,$var) = @_;
669                            $var =~ s/^\s+//g;
670                            return $txt . $var if $var;
671                    }
672    
673                    my $msg;
674                    $msg .= prefix( 'From: ' , $feed->title );
675                    $msg .= prefix( ' by ' , $entry->author );
676                    $msg .= prefix( ' -- ' , $entry->link );
677    #               $msg .= prefix( ' id ' , $entry->id );
678    
679                    _log('RSS', $msg);
680    
681                    if ( $args->{kernel} && $send_rss_msgs ) {
682                            warn "# sending to $CHANNEL\n";
683                            $send_rss_msgs--;
684                            $args->{kernel}->post( $IRC_ALIAS => notice => $CHANNEL, $msg );
685                            $updates++;
686                    }
687            }
688    
689            my $sql = qq{ update feeds set last_update = now(), polls = polls + 1 };
690            $sql .= qq{, updates = updates + $updates } if $updates;
691            $sql .= qq{where id = } . $args->{id};
692            $dbh->do( $sql );
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                    warn "+++ fetch RSS feed: ",dump( $row );
712                    $row->{kernel} = $kernel if $kernel;
713                    $count += rss_fetch( $row );
714            }
715            return "OK, fetched $count posts from " . $sth->rows . " feeds";
716    }
717    
718    my $rss_last_poll = time();
719    
720    sub rss_check_updates {
721            my $kernel = shift;
722            my $t = time();
723            if ( $rss_last_poll - $t > $rss_min_delay ) {
724                    $rss_last_poll = $t;
725                    _log rss_fetch_all( $kernel );
726            }
727    }
728    
729    # seed rss seen cache so we won't send out all items on startup
730    _log rss_fetch_all;
731    
732  #  #
733  # POE handing part  # POE handing part
# Line 613  my $ping;                                              # ping stats Line 739  my $ping;                                              # ping stats
739    
740  POE::Component::IRC->new($IRC_ALIAS);  POE::Component::IRC->new($IRC_ALIAS);
741    
742  POE::Session->create( inline_states =>  POE::Session->create( inline_states => {
743     {_start => sub {                _start => sub {      
744                  $_[KERNEL]->post($IRC_ALIAS => register => 'all');                  $_[KERNEL]->post($IRC_ALIAS => register => 'all');
745                  $_[KERNEL]->post($IRC_ALIAS => connect => $CONNECT);                  $_[KERNEL]->post($IRC_ALIAS => connect => $CONNECT);
746      },      },
# Line 622  POE::Session->create( inline_states => Line 748  POE::Session->create( inline_states =>
748                  $_[KERNEL]->post($IRC_ALIAS => join => $CHANNEL);                  $_[KERNEL]->post($IRC_ALIAS => join => $CHANNEL);
749                  $_[KERNEL]->post($IRC_ALIAS => join => '#logger');                  $_[KERNEL]->post($IRC_ALIAS => join => '#logger');
750                  $_[KERNEL]->yield("heartbeat"); # start heartbeat                  $_[KERNEL]->yield("heartbeat"); # start heartbeat
751  #               $_[KERNEL]->yield("my_add", $_) for keys %FOLLOWS;                  $_[KERNEL]->yield("my_add", $_) for keys %FOLLOWS;
752                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "IDENTIFY $NICK" );                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "IDENTIFY $NICK" );
753      },      },
754      irc_public => sub {      irc_public => sub {
# Line 653  POE::Session->create( inline_states => Line 779  POE::Session->create( inline_states =>
779    
780      },      },
781          irc_ping => sub {          irc_ping => sub {
782                  warn "pong ", $_[ARG0], $/;                  _log( "pong ", $_[ARG0] );
783                  $ping->{ $_[ARG0] }++;                  $ping->{ $_[ARG0] }++;
784                    rss_check_updates( $_[KERNEL] );
785          },          },
786          irc_invite => sub {          irc_invite => sub {
787                  my $kernel = $_[KERNEL];                  my $kernel = $_[KERNEL];
788                  my $nick = (split /!/, $_[ARG0])[0];                  my $nick = (split /!/, $_[ARG0])[0];
789                  my $channel = $_[ARG1];                  my $channel = $_[ARG1];
790    
791                  warn "invited to $channel by $nick";                  _log "invited to $channel by $nick";
792    
793                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, "how nice of you to invite me to $channel, I'll be right there..." );                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, "how nice of you to invite me to $channel, I'll be right there..." );
794                  $_[KERNEL]->post($IRC_ALIAS => join => $channel);                  $_[KERNEL]->post($IRC_ALIAS => join => $channel);
# Line 801  POE::Session->create( inline_states => Line 928  POE::Session->create( inline_states =>
928                                          $res = "config option $op doesn't exist";                                          $res = "config option $op doesn't exist";
929                                  }                                  }
930                          }                          }
931                    } elsif ($msg =~ m/^rss-update/) {
932                            $res = rss_fetch_all( $_[KERNEL] );
933                    } elsif ($msg =~ m/^rss-clean/) {
934                            $_rss = undef;
935                            $res = "OK, cleaned RSS cache";
936                    } elsif ($msg =~ m!^rss-(add|remove|stop|start)\s+(http://\S+)\s*(.*)!) {
937                            my $sql = {
938                                    add             => qq{ insert into feeds (url,name) values (?,?) },
939    #                               remove  => qq{ delete from feeds                                where url = ? and name = ? },
940                                    start   => qq{ update feeds set active = true   where url = ? -- ? },
941                                    stop    => qq{ update feeds set active = false  where url = ? -- ? },
942                                    
943                            };
944                            if (my $q = $sql->{$1} ) {
945                                    my $sth = $dbh->prepare( $q );
946                                    warn "## SQL $q ( $2 | $3 )\n";
947                                    eval { $sth->execute( $2, $3 ) };
948                            }
949    
950                            $res ||= "OK, RSS $1 : $2 - $3";
951                  }                  }
952    
953                  if ($res) {                  if ($res) {
# Line 809  POE::Session->create( inline_states => Line 956  POE::Session->create( inline_states =>
956                          $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );                          $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );
957                  }                  }
958    
959                    rss_check_updates( $_[KERNEL] );
960          },          },
961          irc_477 => sub {          irc_477 => sub {
962                  _log "# irc_477: ",$_[ARG1];                  _log "# irc_477: ",$_[ARG1];
# Line 859  POE::Session->create( inline_states => Line 1007  POE::Session->create( inline_states =>
1007                       Filename => $FOLLOWS{$trailing},                       Filename => $FOLLOWS{$trailing},
1008                       InputEvent => 'got_line',                       InputEvent => 'got_line',
1009                      );                      );
1010                                    warn "+++ following $trailing at $FOLLOWS{$trailing}\n";
1011              },              },
1012              got_line => sub {              got_line => sub {
1013                $_[KERNEL]->post($session => my_tailed =>                                  warn "+++ $trailing : $_[ARG0]\n";
1014                                 time, $trailing, $_[ARG0]);                                  $_[KERNEL]->post($session => my_tailed => time, $trailing, $_[ARG0]);
1015              },              },
1016             },             },
1017            );            );
# Line 914  POE::Session->create( inline_states => Line 1063  POE::Session->create( inline_states =>
1063    
1064  my $httpd = POE::Component::Server::HTTP->new(  my $httpd = POE::Component::Server::HTTP->new(
1065          Port => $http_port,          Port => $http_port,
1066            PreHandler => {
1067                    '/' => sub {
1068                            $_[0]->header(Connection => 'close')
1069                    }
1070            },
1071          ContentHandler => { '/' => \&root_handler },          ContentHandler => { '/' => \&root_handler },
1072          Headers        => { Server => 'irc-logger' },          Headers        => { Server => 'irc-logger' },
1073  );  );
# Line 959  sub root_handler { Line 1113  sub root_handler {
1113          my ($request, $response) = @_;          my ($request, $response) = @_;
1114          $response->code(RC_OK);          $response->code(RC_OK);
1115    
1116            # this doesn't seem to work, so moved to PreHandler
1117            #$response->header(Connection => 'close');
1118    
1119          return RC_OK if $request->uri =~ m/favicon.ico$/;          return RC_OK if $request->uri =~ m/favicon.ico$/;
1120    
1121          my $q;          my $q;
# Line 973  sub root_handler { Line 1130  sub root_handler {
1130    
1131          my $search = $q->param('search') || $q->param('grep') || '';          my $search = $q->param('search') || $q->param('grep') || '';
1132    
1133          if ($request->url =~ m#/rss(?:/(tags)(?:=(\d+))?)?#i) {          if ($request->url =~ m#/rss(?:/(tags|last-tag|follow.*)\w*(?:=(\d+))?)?#i) {
1134                  my $show = lc($1);                  my $show = lc($1);
1135                  my $arg = $2 || 50;                  my $nr = $2;
1136    
1137                  my $type = 'RSS';       # Atom                  my $type = 'RSS';       # Atom
1138    
# Line 985  sub root_handler { Line 1142  sub root_handler {
1142                  #warn "create $type feed from ",dump( @last_tags );                  #warn "create $type feed from ",dump( @last_tags );
1143    
1144                  my $feed = XML::Feed->new( $type );                  my $feed = XML::Feed->new( $type );
1145                    $feed->link( $url );
1146    
1147                  if ( $show eq 'tags' ) {                  if ( $show eq 'tags' ) {
1148                            $nr ||= 50;
1149                          $feed->title( "tags from $CHANNEL" );                          $feed->title( "tags from $CHANNEL" );
1150                          $feed->link( "$url/tags" );                          $feed->link( "$url/tags" );
1151                          $feed->description( "tag cloud created from messages on channel $CHANNEL which have tags// in them" );                          $feed->description( "tag cloud created from messages on channel $CHANNEL which have tags// in them" );
1152                          my $feed_entry = XML::Feed::Entry->new($type);                          my $feed_entry = XML::Feed::Entry->new($type);
1153                          $feed_entry->title( "$arg tags from $CHANNEL" );                          $feed_entry->title( "$nr tags from $CHANNEL" );
1154                          $feed_entry->author( $NICK );                          $feed_entry->author( $NICK );
1155                          $feed_entry->link( '/#tags'  );                          $feed_entry->link( '/#tags'  );
1156    
# Line 999  sub root_handler { Line 1158  sub root_handler {
1158                                  qq{<![CDATA[<style type="text/css">}                                  qq{<![CDATA[<style type="text/css">}
1159                                  . $cloud->css                                  . $cloud->css
1160                                  . qq{</style>}                                  . qq{</style>}
1161                                  . $cloud->html( $arg )                                  . $cloud->html( $nr )
1162                                  . qq{]]>}                                  . qq{]]>}
1163                          );                          );
1164                          $feed->add_entry( $feed_entry );                          $feed->add_entry( $feed_entry );
1165    
1166                  } else {                  } elsif ( $show eq 'last-tag' ) {
1167    
1168                            $nr ||= $last_x_tags;
1169                            $nr = $last_x_tags if $nr > $last_x_tags;
1170    
1171                          $feed->title( "last $last_x_tags from $CHANNEL" );                          $feed->title( "last $nr tagged messages from $CHANNEL" );
                         $feed->link( $url );  
1172                          $feed->description( "collects messages which have tags// in them" );                          $feed->description( "collects messages which have tags// in them" );
1173    
1174                          foreach my $m ( @last_tags ) {                          foreach my $m ( @last_tags ) {
# Line 1021  sub root_handler { Line 1182  sub root_handler {
1182    
1183                                  my $message = $filter->{message}->( $m->{message} );                                  my $message = $filter->{message}->( $m->{message} );
1184                                  $message .= "<br/>\n" unless $message =~ m!<(/p|br/?)>!;                                  $message .= "<br/>\n" unless $message =~ m!<(/p|br/?)>!;
1185                                  warn "## message = $message\n";  #                               warn "## message = $message\n";
1186                                  from_to( $message, $ENCODING, 'UTF-8' );                                  from_to( $message, $ENCODING, 'UTF-8' );
1187    
1188                                  #$feed_entry->summary(                                  #$feed_entry->summary(
# Line 1030  sub root_handler { Line 1191  sub root_handler {
1191                                  );                                  );
1192                                  $feed_entry->category( join(', ', @{$m->{tags}}) );                                  $feed_entry->category( join(', ', @{$m->{tags}}) );
1193                                  $feed->add_entry( $feed_entry );                                  $feed->add_entry( $feed_entry );
1194    
1195                                    $nr--;
1196                                    last if $nr <= 0;
1197    
1198                          }                          }
1199    
1200                    } elsif ( $show =~ m/^follow/ ) {
1201    
1202                            $feed->title( "Feeds which this bot follows" );
1203    
1204                            my $sth = $dbh->prepare( qq{ select * from feeds order by last_update desc } );
1205                            $sth->execute;
1206                            while (my $row = $sth->fetchrow_hashref) {
1207                                    my $feed_entry = XML::Feed::Entry->new($type);
1208                                    $feed_entry->title( $row->{name} );
1209                                    $feed_entry->link( $row->{url}  );
1210                                    $feed_entry->issued( DateTime::Format::Flexible->build( $row->{last_update} ) );
1211                                    $feed_entry->content(
1212                                            '<![CDATA[<pre>' . dump( $row ) . '</pre>]]>'
1213                                    );
1214                                    $feed->add_entry( $feed_entry );
1215                            }
1216    
1217                    } else {
1218                            _log "unknown rss request ",$request->url;
1219                            return RC_DENY;
1220                  }                  }
1221    
1222                  $response->content( $feed->as_xml );                  $response->content( $feed->as_xml );
# Line 1090  sub root_handler { Line 1276  sub root_handler {
1276                                  $cal->weekdays('MON','TUE','WED','THU','FRI');                                  $cal->weekdays('MON','TUE','WED','THU','FRI');
1277                                  ($l_yyyy,$l_mm) = ($yyyy,$mm);                                  ($l_yyyy,$l_mm) = ($yyyy,$mm);
1278                          }                          }
1279                          $cal->setcontent($dd, qq{                          $cal->setcontent($dd, qq[
1280                                  <a href="$url?date=$row->{date}">$row->{nr}</a><br/>$row->{len}                                  <a href="$url?date=$row->{date}">$row->{nr}</a><br/>$row->{len}
1281                          });                          ]);
1282                                                    
1283                  }                  }
1284                  $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.78  
changed lines
  Added in v.85
  ViewVC Help
Powered by ViewVC 1.1.26