/[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 86 by dpavlin, Thu Mar 6 22:57:16 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    
58    # log output encoding
59  my $ENCODING = 'ISO-8859-2';  my $ENCODING = 'ISO-8859-2';
60  my $TIMESTAMP = '%Y-%m-%d %H:%M:%S';  my $TIMESTAMP = '%Y-%m-%d %H:%M:%S';
61    
# Line 62  my $sleep_on_error = 5; Line 64  my $sleep_on_error = 5;
64  # number of last tags to keep in circular buffer  # number of last tags to keep in circular buffer
65  my $last_x_tags = 50;  my $last_x_tags = 50;
66    
67    # don't pull rss feeds more often than this
68    my $rss_min_delay = 60;
69    $rss_min_delay = 15;
70    
71  my $http_port = $NICK =~ m/-dev/ ? 8001 : 8000;  my $http_port = $NICK =~ m/-dev/ ? 8001 : 8000;
72    
73  my $url = "http://$HOSTNAME:$http_port";  my $url = "http://$HOSTNAME:$http_port";
74    
75  ## END CONFIG  ## END CONFIG
76    
   
   
77  use POE qw(Component::IRC Wheel::FollowTail Component::Server::HTTP);  use POE qw(Component::IRC Wheel::FollowTail Component::Server::HTTP);
78  use HTTP::Status;  use HTTP::Status;
79  use DBI;  use DBI;
# Line 96  my $import_dircproxy; Line 100  my $import_dircproxy;
100  my $log_path;  my $log_path;
101  GetOptions(  GetOptions(
102          'import-dircproxy:s' => \$import_dircproxy,          'import-dircproxy:s' => \$import_dircproxy,
103            'follows:s' => \$follows_path,
104          'log:s' => \$log_path,          'log:s' => \$log_path,
105  );  );
106    
# Line 106  $SIG{__DIE__} = sub { Line 111  $SIG{__DIE__} = sub {
111  open(STDOUT, '>', $log_path) || warn "can't redirect log to $log_path: $!";  open(STDOUT, '>', $log_path) || warn "can't redirect log to $log_path: $!";
112    
113  sub _log {  sub _log {
114          print strftime($TIMESTAMP,localtime()), ' ', join(" ",@_), $/;          my $out = strftime($TIMESTAMP,localtime()) . ' ' . join(" ",@_) . $/;
115            from_to( $out, 'UTF-8', $ENCODING );
116            print $out;
117  }  }
118    
119    # LOG following
120    
121    my %FOLLOWS =
122      (
123    #   ACCESS => "/var/log/apache/access.log",
124    #   ERROR => "/var/log/apache/error.log",
125      );
126    
127    sub add_follow_path {
128            my $path = shift;
129            my $name = $path;
130            $name =~ s/\..*$//;
131            warn "# using $path to announce messages from $name\n";
132            $FOLLOWS{$name} = $path;
133    }
134    
135    add_follow_path( $follows_path ) if ( -e $follows_path );
136    
137  # HTML formatters  # HTML formatters
138    
139  my %escape = ('<'=>'&lt;', '>'=>'&gt;', '&'=>'&amp;', '"'=>'&quot;');  my %escape = ('<'=>'&lt;', '>'=>'&gt;', '&'=>'&amp;', '"'=>'&quot;');
# Line 152  my $filter = { Line 177  my $filter = {
177  };  };
178    
179  my $dbh = DBI->connect($DSN,"","", { RaiseError => 1, AutoCommit => 1 }) || die $DBI::errstr;  my $dbh = DBI->connect($DSN,"","", { RaiseError => 1, AutoCommit => 1 }) || die $DBI::errstr;
180    $dbh->do( qq{ set client_encoding = 'UTF-8' } );
181    
182  my $sql_schema = {  my $sql_schema = {
183          log => '          log => qq{
184  create table log (  create table log (
185          id serial,          id serial,
186          time timestamp default now(),          time timestamp default now(),
# Line 168  create table log ( Line 194  create table log (
194  create index log_time on log(time);  create index log_time on log(time);
195  create index log_channel on log(channel);  create index log_channel on log(channel);
196  create index log_nick on log(nick);  create index log_nick on log(nick);
197          ',          },
198          meta => '          meta => q{
199  create table meta (  create table meta (
200          nick text not null,          nick text not null,
201          channel text not null,          channel text not null,
202          name text not null,          name text not null,
203          value text,          value text,
204          changed timestamp default now(),          changed timestamp default 'now()',
205          primary key(nick,channel,name)          primary key(nick,channel,name)
206  );  );
207          ',          },
208            feeds => qq{
209    create table feeds (
210            id serial,
211            url text not null,
212            name text,
213            delay interval not null default '5 min',
214            active boolean default true,
215            last_update timestamp default 'now()',
216            polls int default 0,
217            updates int default 0
218    );
219    create unique index feeds_url on feeds(url);
220    insert into feeds (url,name) values ('http://wiki.razmjenavjestina.org/feed/workspace/razmjenavjestina?category=Recent%20Changes','wiki');
221            },
222  };  };
223    
224  foreach my $table ( keys %$sql_schema ) {  foreach my $table ( keys %$sql_schema ) {
# Line 563  sub save_message { Line 603  sub save_message {
603                  $a->{me} ? "***" . $a->{nick} : "<" . $a->{nick} . ">",                  $a->{me} ? "***" . $a->{nick} : "<" . $a->{nick} . ">",
604                  " " . $a->{message};                  " " . $a->{message};
605    
         from_to($a->{message}, 'UTF-8', $ENCODING);  
   
606          $sth->execute($a->{channel}, $a->{me}, $a->{nick}, $a->{message}, $a->{time});          $sth->execute($a->{channel}, $a->{me}, $a->{nick}, $a->{message}, $a->{time});
607          add_tag( id => $dbh->last_insert_id(undef,undef,"log",undef), %$a );          add_tag( id => $dbh->last_insert_id(undef,undef,"log",undef), %$a );
608  }  }
# Line 604  if ($import_dircproxy) { Line 642  if ($import_dircproxy) {
642          exit;          exit;
643  }  }
644    
645    #
646    # RSS follow
647    #
648    
649    my $_rss;
650    
651    
652    sub rss_fetch {
653            my ($args) = @_;
654    
655            # how many messages to send out when feed is seen for the first time?
656            my $send_rss_msgs = 1;
657    
658            my $feed = XML::Feed->parse(URI->new( $args->{url} ));
659            if ( ! $feed ) {
660                    _log("can't fetch RSS ", $args->{url});
661                    return;
662            }
663            my $updates = 0;
664            for my $entry ($feed->entries) {
665    
666                    # seen allready?
667                    return if $_rss->{$feed->link}->{seen}->{$entry->id}++ > 0;
668    
669                    sub prefix {
670                            my ($txt,$var) = @_;
671                            $var =~ s/^\s+//g;
672                            return $txt . $var if $var;
673                    }
674    
675                    my $msg;
676                    $msg .= prefix( 'From: ' , $feed->title );
677                    $msg .= prefix( ' by ' , $entry->author );
678                    $msg .= prefix( ' -- ' , $entry->link );
679    #               $msg .= prefix( ' id ' , $entry->id );
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                            save_message( channel => $CHANNEL, me => 1, nick => $NICK, message => $msg );
687                            _log('RSS', $msg);
688                    }
689            }
690    
691            my $sql = qq{ update feeds set last_update = now(), polls = polls + 1 };
692            $sql .= qq{, updates = updates + $updates } if $updates;
693            $sql .= qq{where id = } . $args->{id};
694            eval { $dbh->do( $sql ) };
695    
696            return $updates;
697    }
698    
699    sub rss_fetch_all {
700            my $kernel = shift;
701            my $sql = qq{
702                    select id, url, name
703                    from feeds
704                    where active is true
705            };
706            # limit to newer feeds only if we are not sending messages out
707            $sql .= qq{     and last_update + delay < now() } if $kernel;
708            my $sth = $dbh->prepare( $sql );
709            $sth->execute();
710            warn "# ",$sth->rows," active RSS feeds\n";
711            my $count = 0;
712            while (my $row = $sth->fetchrow_hashref) {
713                    warn "+++ fetch RSS feed: ",dump( $row );
714                    $row->{kernel} = $kernel if $kernel;
715                    $count += rss_fetch( $row );
716            }
717            return "OK, fetched $count posts from " . $sth->rows . " feeds";
718    }
719    
720    my $rss_last_poll = time();
721    
722    sub rss_check_updates {
723            my $kernel = shift;
724            my $t = time();
725            if ( $rss_last_poll - $t > $rss_min_delay ) {
726                    $rss_last_poll = $t;
727                    _log rss_fetch_all( $kernel );
728            }
729    }
730    
731    # seed rss seen cache so we won't send out all items on startup
732    _log rss_fetch_all;
733    
734  #  #
735  # POE handing part  # POE handing part
# Line 615  my $ping;                                              # ping stats Line 741  my $ping;                                              # ping stats
741    
742  POE::Component::IRC->new($IRC_ALIAS);  POE::Component::IRC->new($IRC_ALIAS);
743    
744  POE::Session->create( inline_states =>  POE::Session->create( inline_states => {
745     {_start => sub {                _start => sub {      
746                  $_[KERNEL]->post($IRC_ALIAS => register => 'all');                  $_[KERNEL]->post($IRC_ALIAS => register => 'all');
747                  $_[KERNEL]->post($IRC_ALIAS => connect => $CONNECT);                  $_[KERNEL]->post($IRC_ALIAS => connect => $CONNECT);
748      },      },
# Line 624  POE::Session->create( inline_states => Line 750  POE::Session->create( inline_states =>
750                  $_[KERNEL]->post($IRC_ALIAS => join => $CHANNEL);                  $_[KERNEL]->post($IRC_ALIAS => join => $CHANNEL);
751                  $_[KERNEL]->post($IRC_ALIAS => join => '#logger');                  $_[KERNEL]->post($IRC_ALIAS => join => '#logger');
752                  $_[KERNEL]->yield("heartbeat"); # start heartbeat                  $_[KERNEL]->yield("heartbeat"); # start heartbeat
753  #               $_[KERNEL]->yield("my_add", $_) for keys %FOLLOWS;                  $_[KERNEL]->yield("my_add", $_) for keys %FOLLOWS;
754                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "IDENTIFY $NICK" );                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "IDENTIFY $NICK" );
755      },      },
756      irc_public => sub {      irc_public => sub {
# Line 655  POE::Session->create( inline_states => Line 781  POE::Session->create( inline_states =>
781    
782      },      },
783          irc_ping => sub {          irc_ping => sub {
784                  warn "pong ", $_[ARG0], $/;                  _log( "pong ", $_[ARG0] );
785                  $ping->{ $_[ARG0] }++;                  $ping->{ $_[ARG0] }++;
786                    rss_check_updates( $_[KERNEL] );
787          },          },
788          irc_invite => sub {          irc_invite => sub {
789                  my $kernel = $_[KERNEL];                  my $kernel = $_[KERNEL];
790                  my $nick = (split /!/, $_[ARG0])[0];                  my $nick = (split /!/, $_[ARG0])[0];
791                  my $channel = $_[ARG1];                  my $channel = $_[ARG1];
792    
793                  warn "invited to $channel by $nick";                  _log "invited to $channel by $nick";
794    
795                  $_[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..." );
796                  $_[KERNEL]->post($IRC_ALIAS => join => $channel);                  $_[KERNEL]->post($IRC_ALIAS => join => $channel);
# Line 674  POE::Session->create( inline_states => Line 801  POE::Session->create( inline_states =>
801                  my $nick = (split /!/, $_[ARG0])[0];                  my $nick = (split /!/, $_[ARG0])[0];
802                  my $msg = $_[ARG2];                  my $msg = $_[ARG2];
803                  my $channel = $_[ARG1]->[0];                  my $channel = $_[ARG1]->[0];
                 from_to($msg, 'UTF-8', $ENCODING);  
804    
805                  my $res = "unknown command '$msg', try /msg $NICK help!";                  my $res = "unknown command '$msg', try /msg $NICK help!";
806                  my @out;                  my @out;
# Line 718  POE::Session->create( inline_states => Line 844  POE::Session->create( inline_states =>
844    
845                          foreach my $res (get_from_log( limit => $limit )) {                          foreach my $res (get_from_log( limit => $limit )) {
846                                  _log "last: $res";                                  _log "last: $res";
                                 from_to($res, $ENCODING, 'UTF-8');  
847                                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );                                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );
848                          }                          }
849    
# Line 733  POE::Session->create( inline_states => Line 858  POE::Session->create( inline_states =>
858                                          search => $what,                                          search => $what,
859                                  )) {                                  )) {
860                                  _log "search [$what]: $res";                                  _log "search [$what]: $res";
                                 from_to($res, $ENCODING, 'UTF-8');  
861                                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );                                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );
862                          }                          }
863    
# Line 803  POE::Session->create( inline_states => Line 927  POE::Session->create( inline_states =>
927                                          $res = "config option $op doesn't exist";                                          $res = "config option $op doesn't exist";
928                                  }                                  }
929                          }                          }
930                    } elsif ($msg =~ m/^rss-update/) {
931                            $res = rss_fetch_all( $_[KERNEL] );
932                    } elsif ($msg =~ m/^rss-clean/) {
933                            $_rss = undef;
934                            $res = "OK, cleaned RSS cache";
935                    } elsif ($msg =~ m!^rss-(add|remove|stop|start)\s+(http://\S+)\s*(.*)!) {
936                            my $sql = {
937                                    add             => qq{ insert into feeds (url,name) values (?,?) },
938    #                               remove  => qq{ delete from feeds                                where url = ? and name = ? },
939                                    start   => qq{ update feeds set active = true   where url = ? -- ? },
940                                    stop    => qq{ update feeds set active = false  where url = ? -- ? },
941                                    
942                            };
943                            if (my $q = $sql->{$1} ) {
944                                    my $sth = $dbh->prepare( $q );
945                                    warn "## SQL $q ( $2 | $3 )\n";
946                                    eval { $sth->execute( $2, $3 ) };
947                            }
948    
949                            $res ||= "OK, RSS $1 : $2 - $3";
950                  }                  }
951    
952                  if ($res) {                  if ($res) {
953                          _log ">> [$nick] $res";                          _log ">> [$nick] $res";
                         from_to($res, $ENCODING, 'UTF-8');  
954                          $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );                          $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );
955                  }                  }
956    
957                    rss_check_updates( $_[KERNEL] );
958          },          },
959          irc_477 => sub {          irc_477 => sub {
960                  _log "# irc_477: ",$_[ARG1];                  _log "# irc_477: ",$_[ARG1];
# Line 861  POE::Session->create( inline_states => Line 1005  POE::Session->create( inline_states =>
1005                       Filename => $FOLLOWS{$trailing},                       Filename => $FOLLOWS{$trailing},
1006                       InputEvent => 'got_line',                       InputEvent => 'got_line',
1007                      );                      );
1008                                    warn "+++ following $trailing at $FOLLOWS{$trailing}\n";
1009              },              },
1010              got_line => sub {              got_line => sub {
1011                $_[KERNEL]->post($session => my_tailed =>                                  warn "+++ $trailing : $_[ARG0]\n";
1012                                 time, $trailing, $_[ARG0]);                                  $_[KERNEL]->post($session => my_tailed => time, $trailing, $_[ARG0]);
1013              },              },
1014             },             },
1015            );            );
# Line 983  sub root_handler { Line 1128  sub root_handler {
1128    
1129          my $search = $q->param('search') || $q->param('grep') || '';          my $search = $q->param('search') || $q->param('grep') || '';
1130    
1131          if ($request->url =~ m#/rss(?:/(tags|last-tag)\w*(?:=(\d+))?)?#i) {          if ($request->url =~ m#/rss(?:/(tags|last-tag|follow.*)\w*(?:=(\d+))?)?#i) {
1132                  my $show = lc($1);                  my $show = lc($1);
1133                  my $nr = $2;                  my $nr = $2;
1134    
# Line 995  sub root_handler { Line 1140  sub root_handler {
1140                  #warn "create $type feed from ",dump( @last_tags );                  #warn "create $type feed from ",dump( @last_tags );
1141    
1142                  my $feed = XML::Feed->new( $type );                  my $feed = XML::Feed->new( $type );
1143                    $feed->link( $url );
1144    
1145                  if ( $show eq 'tags' ) {                  if ( $show eq 'tags' ) {
1146                          $nr ||= 50;                          $nr ||= 50;
# Line 1021  sub root_handler { Line 1167  sub root_handler {
1167                          $nr = $last_x_tags if $nr > $last_x_tags;                          $nr = $last_x_tags if $nr > $last_x_tags;
1168    
1169                          $feed->title( "last $nr tagged messages from $CHANNEL" );                          $feed->title( "last $nr tagged messages from $CHANNEL" );
                         $feed->link( $url );  
1170                          $feed->description( "collects messages which have tags// in them" );                          $feed->description( "collects messages which have tags// in them" );
1171    
1172                          foreach my $m ( @last_tags ) {                          foreach my $m ( @last_tags ) {
# Line 1036  sub root_handler { Line 1181  sub root_handler {
1181                                  my $message = $filter->{message}->( $m->{message} );                                  my $message = $filter->{message}->( $m->{message} );
1182                                  $message .= "<br/>\n" unless $message =~ m!<(/p|br/?)>!;                                  $message .= "<br/>\n" unless $message =~ m!<(/p|br/?)>!;
1183  #                               warn "## message = $message\n";  #                               warn "## message = $message\n";
                                 from_to( $message, $ENCODING, 'UTF-8' );  
1184    
1185                                  #$feed_entry->summary(                                  #$feed_entry->summary(
1186                                  $feed_entry->content(                                  $feed_entry->content(
# Line 1050  sub root_handler { Line 1194  sub root_handler {
1194    
1195                          }                          }
1196    
1197                    } elsif ( $show =~ m/^follow/ ) {
1198    
1199                            $feed->title( "Feeds which this bot follows" );
1200    
1201                            my $sth = $dbh->prepare( qq{ select * from feeds order by last_update desc } );
1202                            $sth->execute;
1203                            while (my $row = $sth->fetchrow_hashref) {
1204                                    my $feed_entry = XML::Feed::Entry->new($type);
1205                                    $feed_entry->title( $row->{name} );
1206                                    $feed_entry->link( $row->{url}  );
1207                                    $feed_entry->issued( DateTime::Format::Flexible->build( $row->{last_update} ) );
1208                                    $feed_entry->content(
1209                                            '<![CDATA[<pre>' . dump( $row ) . '</pre>]]>'
1210                                    );
1211                                    $feed->add_entry( $feed_entry );
1212                            }
1213    
1214                  } else {                  } else {
1215                          warn "!! unknown rss request for $show\n";                          _log "unknown rss request ",$request->url;
1216                          return RC_DENY;                          return RC_DENY;
1217                  }                  }
1218    
# Line 1063  sub root_handler { Line 1224  sub root_handler {
1224                  warn "$@";                  warn "$@";
1225          }          }
1226    
1227          $response->content_type("text/html; charset=$ENCODING");          $response->content_type("text/html; charset=UTF-8");
1228    
1229          my $html =          my $html =
1230                  qq{<html><head><title>$NICK</title><style type="text/css">$style}                  qq{<html><head><title>$NICK</title><style type="text/css">$style}
Legend:
Removed from v.83  
changed lines
  Added in v.86
  ViewVC Help
Powered by ViewVC 1.1.26