/[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 87 by dpavlin, Fri Mar 7 00:18:02 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    
107  $SIG{__DIE__} = sub {  #$SIG{__DIE__} = sub {
108          confess "fatal error";  #       confess "fatal error";
109  };  #};
110    
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 154  my $filter = { Line 179  my $filter = {
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    
181  my $sql_schema = {  my $sql_schema = {
182          log => '          log => qq{
183  create table log (  create table log (
184          id serial,          id serial,
185          time timestamp default now(),          time timestamp default now(),
# Line 168  create table log ( Line 193  create table log (
193  create index log_time on log(time);  create index log_time on log(time);
194  create index log_channel on log(channel);  create index log_channel on log(channel);
195  create index log_nick on log(nick);  create index log_nick on log(nick);
196          ',          },
197          meta => '          meta => q{
198  create table meta (  create table meta (
199          nick text not null,          nick text not null,
200          channel text not null,          channel text not null,
201          name text not null,          name text not null,
202          value text,          value text,
203          changed timestamp default now(),          changed timestamp default 'now()',
204          primary key(nick,channel,name)          primary key(nick,channel,name)
205  );  );
206          ',          },
207            feeds => qq{
208    create table feeds (
209            id serial,
210            url text not null,
211            name text,
212            delay interval not null default '5 min',
213            active boolean default true,
214            last_update timestamp default 'now()',
215            polls int default 0,
216            updates int default 0
217    );
218    create unique index feeds_url on feeds(url);
219    insert into feeds (url,name) values ('http://wiki.razmjenavjestina.org/feed/workspace/razmjenavjestina?category=Recent%20Changes','wiki');
220            },
221  };  };
222    
223  foreach my $table ( keys %$sql_schema ) {  foreach my $table ( keys %$sql_schema ) {
# Line 242  sub meta { Line 281  sub meta {
281    
282    
283    
284  my $sth = $dbh->prepare(qq{  my $sth_insert_log = $dbh->prepare(qq{
285  insert into log  insert into log
286          (channel, me, nick, message, time)          (channel, me, nick, message, time)
287  values (?,?,?,?,?)  values (?,?,?,?,?)
# Line 563  sub save_message { Line 602  sub save_message {
602                  $a->{me} ? "***" . $a->{nick} : "<" . $a->{nick} . ">",                  $a->{me} ? "***" . $a->{nick} : "<" . $a->{nick} . ">",
603                  " " . $a->{message};                  " " . $a->{message};
604    
605          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});  
606          add_tag( id => $dbh->last_insert_id(undef,undef,"log",undef), %$a );          add_tag( id => $dbh->last_insert_id(undef,undef,"log",undef), %$a );
607  }  }
608    
# Line 604  if ($import_dircproxy) { Line 641  if ($import_dircproxy) {
641          exit;          exit;
642  }  }
643    
644    #
645    # RSS follow
646    #
647    
648    my $_rss;
649    
650    
651    sub rss_fetch {
652            my ($args) = @_;
653    
654            # how many messages to send out when feed is seen for the first time?
655            my $send_rss_msgs = 1;
656    
657            _log "RSS fetch", $args->{url};
658    
659            my $feed = XML::Feed->parse(URI->new( $args->{url} ));
660            if ( ! $feed ) {
661                    _log("can't fetch RSS ", $args->{url});
662                    return;
663            }
664            my ( $total, $updates ) = ( 0, 0 );
665            for my $entry ($feed->entries) {
666                    $total++;
667    
668                    # seen allready?
669                    return if $_rss->{$feed->link}->{seen}->{$entry->id}++ > 0;
670    
671                    sub prefix {
672                            my ($txt,$var) = @_;
673                            $var =~ s/^\s+//g;
674                            return $txt . $var if $var;
675                    }
676    
677                    my $msg;
678                    $msg .= prefix( 'From: ' , $feed->title );
679                    $msg .= prefix( ' by ' , $entry->author );
680                    $msg .= prefix( ' -- ' , $entry->link );
681    #               $msg .= prefix( ' id ' , $entry->id );
682    
683                    if ( $args->{kernel} && $send_rss_msgs ) {
684                            warn "# sending to $CHANNEL\n";
685                            $send_rss_msgs--;
686                            $args->{kernel}->post( $IRC_ALIAS => notice => $CHANNEL, $msg );
687                            $updates++;
688                            #$sth_insert_log->execute( $CHANNEL, 1, $NICK, $msg, undef );
689                            _log('RSS', $msg);
690                    }
691            }
692    
693            my $sql = qq{ update feeds set last_update = now(), polls = polls + 1 };
694            $sql .= qq{, updates = updates + $updates } if $updates;
695            $sql .= qq{where id = } . $args->{id};
696            eval { $dbh->do( $sql ) };
697    
698            _log "RSS got $total items of which $updates new";
699    
700            return $updates;
701    }
702    
703    sub rss_fetch_all {
704            my $kernel = shift;
705            my $sql = qq{
706                    select id, url, name
707                    from feeds
708                    where active is true
709            };
710            # limit to newer feeds only if we are not sending messages out
711            $sql .= qq{     and last_update + delay < now() } if $kernel;
712            my $sth = $dbh->prepare( $sql );
713            $sth->execute();
714            warn "# ",$sth->rows," active RSS feeds\n";
715            my $count = 0;
716            while (my $row = $sth->fetchrow_hashref) {
717                    $row->{kernel} = $kernel if $kernel;
718                    $count += rss_fetch( $row );
719            }
720            return "OK, fetched $count posts from " . $sth->rows . " feeds";
721    }
722    
723    
724    sub rss_check_updates {
725            my $kernel = shift;
726            my $last_t = $_rss->{last_poll} || time();
727            my $t = time();
728            if ( $last_t - $t > $rss_min_delay ) {
729                    $_rss->{last_poll} = $t;
730                    _log rss_fetch_all( $kernel );
731            }
732    }
733    
734    # seed rss seen cache so we won't send out all items on startup
735    _log rss_fetch_all;
736    
737  #  #
738  # POE handing part  # POE handing part
# Line 615  my $ping;                                              # ping stats Line 744  my $ping;                                              # ping stats
744    
745  POE::Component::IRC->new($IRC_ALIAS);  POE::Component::IRC->new($IRC_ALIAS);
746    
747  POE::Session->create( inline_states =>  POE::Session->create( inline_states => {
748     {_start => sub {                _start => sub {      
749                  $_[KERNEL]->post($IRC_ALIAS => register => 'all');                  $_[KERNEL]->post($IRC_ALIAS => register => 'all');
750                  $_[KERNEL]->post($IRC_ALIAS => connect => $CONNECT);                  $_[KERNEL]->post($IRC_ALIAS => connect => $CONNECT);
751      },      },
752      irc_255 => sub {    # server is done blabbing      irc_255 => sub {    # server is done blabbing
753                  $_[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;  
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 849  POE::Session->create( inline_states => Line 993  POE::Session->create( inline_states =>
993                          "";                          "";
994        0;                        # false for signals        0;                        # false for signals
995      },      },
     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);  
     }  
996     },     },
997    );    );
998    
# Line 983  sub root_handler { Line 1067  sub root_handler {
1067    
1068          my $search = $q->param('search') || $q->param('grep') || '';          my $search = $q->param('search') || $q->param('grep') || '';
1069    
1070          if ($request->url =~ m#/rss(?:/(tags|last-tag)\w*(?:=(\d+))?)?#i) {          if ($request->url =~ m#/rss(?:/(tags|last-tag|follow.*)\w*(?:=(\d+))?)?#i) {
1071                  my $show = lc($1);                  my $show = lc($1);
1072                  my $nr = $2;                  my $nr = $2;
1073    
# Line 995  sub root_handler { Line 1079  sub root_handler {
1079                  #warn "create $type feed from ",dump( @last_tags );                  #warn "create $type feed from ",dump( @last_tags );
1080    
1081                  my $feed = XML::Feed->new( $type );                  my $feed = XML::Feed->new( $type );
1082                    $feed->link( $url );
1083    
1084                  if ( $show eq 'tags' ) {                  if ( $show eq 'tags' ) {
1085                          $nr ||= 50;                          $nr ||= 50;
# Line 1021  sub root_handler { Line 1106  sub root_handler {
1106                          $nr = $last_x_tags if $nr > $last_x_tags;                          $nr = $last_x_tags if $nr > $last_x_tags;
1107    
1108                          $feed->title( "last $nr tagged messages from $CHANNEL" );                          $feed->title( "last $nr tagged messages from $CHANNEL" );
                         $feed->link( $url );  
1109                          $feed->description( "collects messages which have tags// in them" );                          $feed->description( "collects messages which have tags// in them" );
1110    
1111                          foreach my $m ( @last_tags ) {                          foreach my $m ( @last_tags ) {
# Line 1036  sub root_handler { Line 1120  sub root_handler {
1120                                  my $message = $filter->{message}->( $m->{message} );                                  my $message = $filter->{message}->( $m->{message} );
1121                                  $message .= "<br/>\n" unless $message =~ m!<(/p|br/?)>!;                                  $message .= "<br/>\n" unless $message =~ m!<(/p|br/?)>!;
1122  #                               warn "## message = $message\n";  #                               warn "## message = $message\n";
                                 from_to( $message, $ENCODING, 'UTF-8' );  
1123    
1124                                  #$feed_entry->summary(                                  #$feed_entry->summary(
1125                                  $feed_entry->content(                                  $feed_entry->content(
# Line 1050  sub root_handler { Line 1133  sub root_handler {
1133    
1134                          }                          }
1135    
1136                    } elsif ( $show =~ m/^follow/ ) {
1137    
1138                            $feed->title( "Feeds which this bot follows" );
1139    
1140                            my $sth = $dbh->prepare( qq{ select * from feeds order by last_update desc } );
1141                            $sth->execute;
1142                            while (my $row = $sth->fetchrow_hashref) {
1143                                    my $feed_entry = XML::Feed::Entry->new($type);
1144                                    $feed_entry->title( $row->{name} );
1145                                    $feed_entry->link( $row->{url}  );
1146                                    $feed_entry->issued( DateTime::Format::Flexible->build( $row->{last_update} ) );
1147                                    $feed_entry->content(
1148                                            '<![CDATA[<pre>' . dump( $row ) . '</pre>]]>'
1149                                    );
1150                                    $feed->add_entry( $feed_entry );
1151                            }
1152    
1153                  } else {                  } else {
1154                          warn "!! unknown rss request for $show\n";                          _log "unknown rss request ",$request->url;
1155                          return RC_DENY;                          return RC_DENY;
1156                  }                  }
1157    
# Line 1063  sub root_handler { Line 1163  sub root_handler {
1163                  warn "$@";                  warn "$@";
1164          }          }
1165    
1166          $response->content_type("text/html; charset=$ENCODING");          $response->content_type("text/html; charset=UTF-8");
1167    
1168          my $html =          my $html =
1169                  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.87
  ViewVC Help
Powered by ViewVC 1.1.26