/[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 92 by dpavlin, Fri Mar 7 10:30:57 2008 UTC revision 99 by dpavlin, Fri Mar 7 17:13:30 2008 UTC
# Line 55  my $last_x_tags = 50; Line 55  my $last_x_tags = 50;
55    
56  # don't pull rss feeds more often than this  # don't pull rss feeds more often than this
57  my $rss_min_delay = 60;  my $rss_min_delay = 60;
 $rss_min_delay = 15;  
58    
59  my $http_port = $NICK =~ m/-dev/ ? 8001 : 8000;  my $http_port = $NICK =~ m/-dev/ ? 8001 : 8000;
60    
# Line 118  my $filter = { Line 117  my $filter = {
117                  # protect HTML from wiki modifications                  # protect HTML from wiki modifications
118                  sub e {                  sub e {
119                          my $t = shift;                          my $t = shift;
120                          return 'uri_unescape{' . uri_escape($t) . '}';                          return 'uri_unescape{' . uri_escape($t, '^a-zA-Z0-9') . '}';
121                  }                  }
122    
123                  $m =~ s/($escape_re)/$escape{$1}/gs;                  $m =~ s/($escape_re)/$escape{$1}/gs;
124                  $m =~ s#($RE{URI}{HTTP})#e(qq{<a href="$1">$1</a>})#egs ||                  $m =~ s#($RE{URI}{HTTP})#e(qq{<a href="$1">$1</a>})#egs;
125                  $m =~ s#\/(\w+)\/#<i>$1</i>#gs;                  $m =~ s#\/(\w+)\/#<i>$1</i>#gs;
126                  $m =~ s#$tag_regex#e(qq{<a href="$url?tag=$1" class="tag">$1</a>})#egs;                  $m =~ s#$tag_regex#e(qq{<a href="$url?tag=$1" class="tag">$1</a>})#egs;
127                  $m =~ s#\*(\w+)\*#<b>$1</b>#gs;                  $m =~ s#\*(\w+)\*#<b>$1</b>#gs;
# Line 179  create table feeds ( Line 178  create table feeds (
178          name text,          name text,
179          delay interval not null default '5 min',          delay interval not null default '5 min',
180          active boolean default true,          active boolean default true,
181            channel text not null,
182            nick text not null,
183            private boolean default false,
184          last_update timestamp default 'now()',          last_update timestamp default 'now()',
185          polls int default 0,          polls int default 0,
186          updates int default 0          updates int default 0
187  );  );
188  create unique index feeds_url on feeds(url);  create unique index feeds_url on feeds(url);
189  insert into feeds (url,name) values ('http://wiki.razmjenavjestina.org/feed/workspace/razmjenavjestina?category=Recent%20Changes','wiki');  insert into feeds (url,name,channel,nick) values ('http://wiki.razmjenavjestina.org/feed/workspace/razmjenavjestina?category=Recent%20Changes','wiki','$CHANNEL','dpavlin');
190          },          },
191  };  };
192    
# Line 228  sub meta { Line 230  sub meta {
230                  if ( $@ || ! $sth->rows ) {                  if ( $@ || ! $sth->rows ) {
231                          $sth = $dbh->prepare(qq{ insert into meta (value,nick,channel,name,changed) values (?,?,?,?,now()) });                          $sth = $dbh->prepare(qq{ insert into meta (value,nick,channel,name,changed) values (?,?,?,?,now()) });
232                          $sth->execute( $value, $nick, $channel, $name );                          $sth->execute( $value, $nick, $channel, $name );
233                          _log "created $nick/$channel/$name = $value";                          warn "## created $nick/$channel/$name = $value\n";
234                  } else {                  } else {
235                          _log "updated $nick/$channel/$name = $value ";                          warn "## updated $nick/$channel/$name = $value\n";
236                  }                  }
237    
238                  return $value;                  return $value;
# Line 240  sub meta { Line 242  sub meta {
242                  my $sth = $dbh->prepare(qq{ select value,changed from meta where nick = ? and channel = ? and name = ? });                  my $sth = $dbh->prepare(qq{ select value,changed from meta where nick = ? and channel = ? and name = ? });
243                  $sth->execute( $nick, $channel, $name );                  $sth->execute( $nick, $channel, $name );
244                  my ($v,$c) = $sth->fetchrow_array;                  my ($v,$c) = $sth->fetchrow_array;
245                  _log "fetched $nick/$channel/$name = $v [$c]";                  warn "## fetched $nick/$channel/$name = $v [$c]\n";
246                  return ($v,$c) if wantarray;                  return ($v,$c) if wantarray;
247                  return $v;                  return $v;
248    
# Line 634  sub rss_fetch { Line 636  sub rss_fetch {
636                  $total++;                  $total++;
637    
638                  # seen allready?                  # seen allready?
639                  next if $_rss->{$feed->link}->{seen}->{$entry->id}++ > 0;                  next if $_rss->{$args->{channel}}->{$feed->link}->{$entry->id}++ > 0;
640    
641                  sub prefix {                  sub prefix {
642                          my ($txt,$var) = @_;                          my ($txt,$var) = @_;
643                            $var =~ s/\s+/ /gs;
644                          $var =~ s/^\s+//g;                          $var =~ s/^\s+//g;
645                            $var =~ s/\s+$//g;
646                          return $txt . $var if $var;                          return $txt . $var if $var;
647                  }                  }
648    
649                    # fix absolute and relative links to feed entries
650                    my $link = $entry->link;
651                    if ( $link =~ m!^/! ) {
652                            my $host = $args->{url};
653                            $host =~ s!^(http://[^/]+).*$!$1!;      #!vim
654                            $link = "$host/$link";
655                    } elsif ( $link !~ m!^http! ) {
656                            $link = $args->{url} . $link;
657                    }
658                    $link =~ s!//+!/!g;
659    
660                  my $msg;                  my $msg;
661                  $msg .= prefix( 'From: ' , $args->{name} || $feed->title );                  $msg .= prefix( 'From: ' , $args->{name} || $feed->title );
662                  $msg .= prefix( ' by ' , $entry->author );                  $msg .= prefix( ' by ' , $entry->author );
663                  $msg .= prefix( ' | ' , $entry->title );                  $msg .= prefix( ' | ' , $entry->title );
664                  $msg .= prefix( ' | ' , $entry->link );                  $msg .= prefix( ' | ' , $link );
665  #               $msg .= prefix( ' id ' , $entry->id );  #               $msg .= prefix( ' id ' , $entry->id );
666    
667                  if ( $args->{kernel} && $send_rss_msgs ) {                  if ( $args->{kernel} && $send_rss_msgs ) {
668                          $send_rss_msgs--;                          $send_rss_msgs--;
669                          _log('>>', $msg);                          $sth_insert_log->execute( $args->{channel}, 1, $NICK, $msg, 'now()' );
670                          $sth_insert_log->execute( $CHANNEL, 1, $NICK, $msg, 'now()' );                          my ( $type, $to ) = ( 'notice', $args->{channel} );
671                          $args->{kernel}->post( $IRC_ALIAS => notice => $CHANNEL, $msg );                          ( $type, $to ) = ( 'privmsg', $args->{nick} ) if $args->{private};
672                            _log(">> $type $to |", $msg);
673                            $args->{kernel}->post( $IRC_ALIAS => $type => $to, $msg );
674                          $updates++;                          $updates++;
675                  }                  }
676          }          }
# Line 671  sub rss_fetch { Line 688  sub rss_fetch {
688  sub rss_fetch_all {  sub rss_fetch_all {
689          my $kernel = shift;          my $kernel = shift;
690          my $sql = qq{          my $sql = qq{
691                  select id, url, name                  select id, url, name, channel, nick, private
692                  from feeds                  from feeds
693                  where active is true                  where active is true
694          };          };
# Line 691  sub rss_fetch_all { Line 708  sub rss_fetch_all {
708    
709  sub rss_check_updates {  sub rss_check_updates {
710          my $kernel = shift;          my $kernel = shift;
711          my $last_t = $_rss->{last_poll} || time();          $_rss->{last_poll} ||= time();
712          my $t = time();          my $dt = time() - $_rss->{last_poll};
713          if ( $t - $last_t > $rss_min_delay ) {          warn "## rss_check_updates $dt > $rss_min_delay\n";
714                  $_rss->{last_poll} = $t;          if ( $dt > $rss_min_delay ) {
715                    $_rss->{last_poll} = time();
716                  _log rss_fetch_all( $kernel );                  _log rss_fetch_all( $kernel );
717          }          }
718  }  }
# Line 727  POE::Session->create( inline_states => { Line 745  POE::Session->create( inline_states => {
745    
746                  save_message( channel => $channel, me => 0, nick => $nick, message => $msg);                  save_message( channel => $channel, me => 0, nick => $nick, message => $msg);
747                  meta( $nick, $channel, 'last-msg', $msg );                  meta( $nick, $channel, 'last-msg', $msg );
748                    rss_check_updates( $kernel );
749      },      },
750      irc_ctcp_action => sub {      irc_ctcp_action => sub {
751                  my $kernel = $_[KERNEL];                  my $kernel = $_[KERNEL];
# Line 900  POE::Session->create( inline_states => { Line 919  POE::Session->create( inline_states => {
919                          $dbh->do( qq{ update feeds set last_update = now() - delay } );                          $dbh->do( qq{ update feeds set last_update = now() - delay } );
920                          $res = "OK, cleaned RSS cache";                          $res = "OK, cleaned RSS cache";
921                  } elsif ($msg =~ m/^rss-list/) {                  } elsif ($msg =~ m/^rss-list/) {
922                          my $sth = $dbh->prepare(qq{ select url,name,last_update,active from feeds });                          my $sth = $dbh->prepare(qq{ select url,name,last_update,active,channel,nick,private from feeds });
923                          $sth->execute;                          $sth->execute;
924                          while (my @row = $sth->fetchrow_array) {                          while (my @row = $sth->fetchrow_array) {
925                                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, join(' | ',@row) );                                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, join(' | ',@row) );
926                          }                          }
927                          $res = '';                          $res = '';
928                  } elsif ($msg =~ m!^rss-(add|remove|stop|start)\s+(http://\S+)\s*(.*)!) {                  } elsif ($msg =~ m!^rss-(add|remove|stop|start)(?:-(private))?\s+(http://\S+)\s*(.*)!) {
929                            my ( $command, $sub, $url, $arg ) = ( $1,$2,$3,$4 );
930    
931                            my $channel = $1 if ( $arg =~ s/\s*(#\S+)\s*// );
932                            $channel = $nick if $sub eq 'private';
933    
934                          my $sql = {                          my $sql = {
935                                  add             => qq{ insert into feeds (url,name) values (?,?) },                                  add             => qq{ insert into feeds (url,name,channel,nick,private) values (?,?,?,?,?) },
936  #                               remove  => qq{ delete from feeds                                where url = ? and name = ? },  #                               remove  => qq{ delete from feeds                                where url = ? and name = ? },
937                                  start   => qq{ update feeds set active = true   where url = ? },                                  start   => qq{ update feeds set active = true   where url = ? },
938                                  stop    => qq{ update feeds set active = false  where url = ? },                                  stop    => qq{ update feeds set active = false  where url = ? },
                                   
939                          };                          };
940                          if (my $q = $sql->{$1} ) {  
941                            if ( $command eq 'add' && ! $channel ) {
942                                    $res = "ERROR: got '$msg' which doesn't have #channel in it, ignoring!";
943                            } elsif (my $q = $sql->{$command} ) {
944                                  my $sth = $dbh->prepare( $q );                                  my $sth = $dbh->prepare( $q );
945                                  my @data = ( $2 );                                  my @data = ( $url );
946                                  push @data, $3 if ( $q =~ s/\?//g == 2 );                                  if ( $command eq 'add' ) {
947                                  warn "## $1 SQL $q with ",dump( @data ),"\n";                                          push @data, ( $arg, $channel, $nick, $sub eq 'private' ? 1 : 0 );
948                                    }
949                                    warn "## $command SQL $q with ",dump( @data ),"\n";
950                                  eval { $sth->execute( @data ) };                                  eval { $sth->execute( @data ) };
951                                    if ($@) {
952                                            $res = "ERROR: $@";
953                                    } else {
954                                            $res = "OK, RSS [$command|$sub|$url|$arg]";
955                                    }
956                            } else {
957                                    $res = "ERROR: don't know what to do with: $msg";
958                          }                          }
   
                         $res = "OK, RSS $1 : $2 - $3";  
959                  }                  }
960    
961                  if ($res) {                  if ($res) {
# Line 1126  sub root_handler { Line 1159  sub root_handler {
1159                                  $feed->add_entry( $feed_entry );                                  $feed->add_entry( $feed_entry );
1160                          }                          }
1161    
1162                            my $feed_entry = XML::Feed::Entry->new($type);
1163                            $feed_entry->title( "Internal stats" );
1164                            $feed_entry->content(
1165                                    '<![CDATA[<pre>' . dump( $_rss ) . '</pre>]]>'
1166                            );
1167                            $feed->add_entry( $feed_entry );
1168    
1169                  } else {                  } else {
1170                          _log "unknown rss request ",$request->url;                          _log "unknown rss request ",$request->url;
1171                          return RC_DENY;                          return RC_DENY;
Legend:
Removed from v.92  
changed lines
  Added in v.99
  ViewVC Help
Powered by ViewVC 1.1.26