--- trunk/bin/irc-logger.pl 2008/03/12 17:21:07 116 +++ trunk/bin/irc-logger.pl 2008/03/14 13:37:45 120 @@ -18,6 +18,8 @@ use Carp qw/confess/; use XML::Feed; use DateTime::Format::Flexible; +use IPC::DirQueue; +use File::Slurp; =head1 NAME @@ -47,6 +49,8 @@ ## CONFIG +my $debug = 0; + my $irc_config = { nick => 'irc-logger', server => 'irc.freenode.net', @@ -54,6 +58,8 @@ ircname => 'Anna the bot: try /msg irc-logger help', }; +my $queue_dir = './queue'; + my $HOSTNAME = `hostname -f`; chomp($HOSTNAME); @@ -106,6 +112,7 @@ GetOptions( 'import-dircproxy:s' => \$import_dircproxy, 'log:s' => \$log_path, + 'queue:s' => \$queue_dir, ); #$SIG{__DIE__} = sub { @@ -118,6 +125,15 @@ open(STDOUT, '>', $log_path) && warn "log to $log_path: $!\n"; +# queue + +if ( ! -d $queue_dir ) { + warn "## creating queue directory $queue_dir"; + mkdir $queue_dir or die "can't create queue directory $queue_dir: $!"; +} + +my $dq = IPC::DirQueue->new({ dir => $queue_dir }); + # HTML formatters my %escape = ('<'=>'<', '>'=>'>', '&'=>'&', '"'=>'"'); @@ -665,12 +681,16 @@ return; } + $_stat->{rss}->{url2link}->{ $args->{url} } = $feed->link; + my ( $total, $updates ) = ( 0, 0 ); for my $entry ($feed->entries) { $total++; + my $seen_times = $_stat->{rss}->{seen}->{$args->{channel}}->{$feed->link}->{$entry->id}++; # seen allready? - next if $_stat->{rss}->{seen}->{$args->{channel}}->{$feed->link}->{$entry->id}++ > 0; + warn "## $seen_times ",$feed->link if $debug; + next if $seen_times > 0; sub prefix { my ($txt,$var) = @_; @@ -699,21 +719,30 @@ if ( my $tags = $entry->category ) { $tags =~ s!^\s+!!; $tags =~ s!\s*$! !; - $tags =~ s!\s+!// !g; + $tags =~ s!,?\s+!// !g; $msg .= prefix( ' ' , $tags ); } - if ( $args->{kernel} && $send_rss_msgs ) { + if ( $seen_times == 0 && $send_rss_msgs ) { $send_rss_msgs--; if ( ! $args->{private} ) { # FIXME bug! should be save_message -# save_message( channel => $args->{channel}, me => 1, nick => $NICK, message => $msg ); - $sth_insert_log->execute( $args->{channel}, 1, $NICK, $msg, 'now()' ); + save_message( channel => $args->{channel}, me => 1, nick => $NICK, message => $msg ); +# $sth_insert_log->execute( $args->{channel}, 1, $NICK, $msg, 'now()' ); } my ( $type, $to ) = ( 'notice', $args->{channel} ); ( $type, $to ) = ( 'privmsg', $args->{nick} ) if $args->{private}; + _log(">> $type $to", $msg); - $args->{kernel}->post( $irc => $type => $to, $msg ); +# $args->{kernel}->post( $irc => $type => $to, $msg ); + # XXX enqueue message to send later + sub enqueue_post { + my $post = dump( @_ ); + warn "## queue_post $post\n" if $debug; + $dq->enqueue_string( $post ); + } + enqueue_post( $type => $to => $msg ); + $updates++; } } @@ -753,15 +782,25 @@ my $kernel = shift; $_stat->{rss}->{last_poll} ||= time(); my $dt = time() - $_stat->{rss}->{last_poll}; - warn "## rss_check_updates $dt > $rss_min_delay\n"; if ( $dt > $rss_min_delay ) { + warn "## rss_check_updates $dt > $rss_min_delay\n"; $_stat->{rss}->{last_poll} = time(); _log rss_fetch_all( $kernel ); } + # XXX send queue messages + while ( my $job = $dq->pickup_queued_job() ) { + my $data = read_file( $job->get_data_path ) || die "can't load ", $job->get_data_path, ": $!"; +# $kernel->post( $irc => $type => $to, $msg ); + my @data = eval $data; + _log ">> post from queue ", $irc, @data; + $kernel->post( $irc => @data ); + $job->finish; + warn "## done queued job: ",dump( @data ) if $debug; + } } # seed rss seen cache so we won't send out all items on startup -_log rss_fetch_all; +_log rss_fetch_all if ! $debug; POE::Session->create( inline_states => { _start => sub { @@ -827,6 +866,7 @@ my $nick = (split /!/, $_[ARG0])[0]; my $msg = $_[ARG2]; my $channel = $_[ARG1]->[0]; + warn "# ARG = ",dump( @_[ARG0,ARG1,ARG2] ) if $debug; my $res = "unknown command '$msg', try /msg $NICK help!"; my @out; @@ -955,10 +995,6 @@ } } elsif ($msg =~ m/^rss-update/) { $res = rss_fetch_all( $_[KERNEL] ); - } elsif ($msg =~ m/^rss-clean/) { - $_stat->{rss} = undef; - $dbh->do( qq{ update feeds set last_update = now() - delay } ); - $res = "OK, cleaned RSS cache"; } elsif ($msg =~ m/^rss-list/) { my $sth = $dbh->prepare(qq{ select url,name,last_update,active,channel,nick,private from feeds }); $sth->execute; @@ -966,7 +1002,7 @@ $_[KERNEL]->post( $irc => privmsg => $nick, join(' | ',@row) ); } $res = ''; - } elsif ($msg =~ m!^rss-(add|remove|stop|start)(?:-(private))?\s+(http://\S+)\s*(.*)!) { + } elsif ($msg =~ m!^rss-(add|remove|stop|start|clean)(?:-(private))?\s+(http://\S+)\s*(.*)!) { my ( $command, $sub, $url, $arg ) = ( $1,$2,$3,$4 ); my $channel = $1 if ( $arg =~ s/\s*(#\S+)\s*// ); @@ -977,6 +1013,7 @@ # remove => qq{ delete from feeds where url = ? and name = ? }, start => qq{ update feeds set active = true where url = ? }, stop => qq{ update feeds set active = false where url = ? }, + clean => qq{ update feeds set last_update = now() - delay where url = ? }, }; if ( $command eq 'add' && ! $channel ) { @@ -992,11 +1029,28 @@ if ($@) { $res = "ERROR: $@"; } else { - $res = "OK, RSS [$command|$sub|$url|$arg]"; + $res = "OK, RSS executed $command " . ( $sub ? "-$sub" : '' ) ."on $channel url $url"; + if ( $command eq 'clean' ) { + my $seen = $_stat->{rss}->{seen} || die "no seen?"; + my $want_link = $_stat->{rss}->{url2link}->{$url} || warn "no url2link($url)"; + foreach my $c ( keys %$seen ) { + my $c_hash = $seen->{$c} || die "no seen->{$c}"; + die "not HASH with rss links but ", dump($c_hash) unless ref($c_hash) eq 'HASH'; + foreach my $link ( keys %$c_hash ) { + next unless $link eq $want_link; + _log "RSS removed seen $c $url $link"; + } + } + } } } else { $res = "ERROR: don't know what to do with: $msg"; } + } elsif ($msg =~ m/^rss-clean/) { + # this makes sense because we didn't catch rss-clean http://... before! + $_stat->{rss} = undef; + $dbh->do( qq{ update feeds set last_update = now() - delay } ); + $res = "OK, cleaned RSS cache"; } if ($res) { @@ -1057,7 +1111,7 @@ _log ">> registreted, so IDENTIFY"; $_[KERNEL]->post( $irc => privmsg => 'nickserv', "IDENTIFY $NICK" ); } else { - warn "## ignore $m\n"; + warn "## ignore $m\n" if $debug; } }, irc_snotice => sub {