/[irc-logger]/trunk/bin/irc-logger.pl
This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!
ViewVC logotype

Diff of /trunk/bin/irc-logger.pl

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 84 by dpavlin, Thu Mar 6 18:03:05 2008 UTC revision 85 by dpavlin, Thu Mar 6 22:16:27 2008 UTC
# Line 63  my $sleep_on_error = 5; Line 63  my $sleep_on_error = 5;
63  # number of last tags to keep in circular buffer  # number of last tags to keep in circular buffer
64  my $last_x_tags = 50;  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 174  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 188  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 624  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 635  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 677  POE::Session->create( inline_states => Line 781  POE::Session->create( inline_states =>
781          irc_ping => sub {          irc_ping => sub {
782                  _log( "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 823  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 831  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 1004  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|last-tag)\w*(?:=(\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 $nr = $2;                  my $nr = $2;
1136    
# Line 1016  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;                          $nr ||= 50;
# Line 1042  sub root_handler { Line 1169  sub root_handler {
1169                          $nr = $last_x_tags if $nr > $last_x_tags;                          $nr = $last_x_tags if $nr > $last_x_tags;
1170    
1171                          $feed->title( "last $nr tagged messages 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 1071  sub root_handler { Line 1197  sub root_handler {
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 {                  } else {
1218                          warn "!! unknown rss request for $show\n";                          _log "unknown rss request ",$request->url;
1219                          return RC_DENY;                          return RC_DENY;
1220                  }                  }
1221    

Legend:
Removed from v.84  
changed lines
  Added in v.85

  ViewVC Help
Powered by ViewVC 1.1.26