--- trunk/bin/irc-logger.pl 2008/03/06 22:57:16 86 +++ trunk/bin/irc-logger.pl 2008/03/07 10:30:57 92 @@ -20,12 +20,6 @@ =item --log=irc-logger.log -Name of log file - -=item --follow=file.log - -Follows new messages in file - =back =head1 DESCRIPTION @@ -50,13 +44,8 @@ $CHANNEL = '#irc-logger' if ($HOSTNAME =~ m/llin/); my $IRC_ALIAS = "log"; -# default log to follow and announce messages -my $follows_path = 'follows.log'; - my $DSN = 'DBI:Pg:dbname=' . $NICK; -# log output encoding -my $ENCODING = 'ISO-8859-2'; my $TIMESTAMP = '%Y-%m-%d %H:%M:%S'; my $sleep_on_error = 5; @@ -74,10 +63,9 @@ ## END CONFIG -use POE qw(Component::IRC Wheel::FollowTail Component::Server::HTTP); +use POE qw(Component::IRC Component::Server::HTTP); use HTTP::Status; use DBI; -use Encode qw/from_to is_utf8/; use Regexp::Common qw /URI/; use CGI::Simple; use HTML::TagCloud; @@ -100,40 +88,19 @@ my $log_path; GetOptions( 'import-dircproxy:s' => \$import_dircproxy, - 'follows:s' => \$follows_path, 'log:s' => \$log_path, ); -$SIG{__DIE__} = sub { - confess "fatal error"; -}; +#$SIG{__DIE__} = sub { +# confess "fatal error"; +#}; open(STDOUT, '>', $log_path) || warn "can't redirect log to $log_path: $!"; sub _log { - my $out = strftime($TIMESTAMP,localtime()) . ' ' . join(" ",@_) . $/; - from_to( $out, 'UTF-8', $ENCODING ); - print $out; -} - -# LOG following - -my %FOLLOWS = - ( -# ACCESS => "/var/log/apache/access.log", -# ERROR => "/var/log/apache/error.log", - ); - -sub add_follow_path { - my $path = shift; - my $name = $path; - $name =~ s/\..*$//; - warn "# using $path to announce messages from $name\n"; - $FOLLOWS{$name} = $path; + print strftime($TIMESTAMP,localtime()) . ' ' . join(" ",@_) . $/; } -add_follow_path( $follows_path ) if ( -e $follows_path ); - # HTML formatters my %escape = ('<'=>'<', '>'=>'>', '&'=>'&', '"'=>'"'); @@ -282,7 +249,7 @@ -my $sth = $dbh->prepare(qq{ +my $sth_insert_log = $dbh->prepare(qq{ insert into log (channel, me, nick, message, time) values (?,?,?,?,?) @@ -534,7 +501,6 @@ return unless ($arg->{id} && $arg->{message}); my $m = $arg->{message}; - from_to('UTF-8', 'iso-8859-2', $m) if (is_utf8($m)); my @tags; @@ -603,7 +569,7 @@ $a->{me} ? "***" . $a->{nick} : "<" . $a->{nick} . ">", " " . $a->{message}; - $sth->execute($a->{channel}, $a->{me}, $a->{nick}, $a->{message}, $a->{time}); + $sth_insert_log->execute($a->{channel}, $a->{me}, $a->{nick}, $a->{message}, $a->{time}); add_tag( id => $dbh->last_insert_id(undef,undef,"log",undef), %$a ); } @@ -655,16 +621,20 @@ # how many messages to send out when feed is seen for the first time? my $send_rss_msgs = 1; + _log "RSS fetch", $args->{url}; + my $feed = XML::Feed->parse(URI->new( $args->{url} )); if ( ! $feed ) { _log("can't fetch RSS ", $args->{url}); return; } - my $updates = 0; + + my ( $total, $updates ) = ( 0, 0 ); for my $entry ($feed->entries) { + $total++; # seen allready? - return if $_rss->{$feed->link}->{seen}->{$entry->id}++ > 0; + next if $_rss->{$feed->link}->{seen}->{$entry->id}++ > 0; sub prefix { my ($txt,$var) = @_; @@ -673,18 +643,18 @@ } my $msg; - $msg .= prefix( 'From: ' , $feed->title ); + $msg .= prefix( 'From: ' , $args->{name} || $feed->title ); $msg .= prefix( ' by ' , $entry->author ); - $msg .= prefix( ' -- ' , $entry->link ); + $msg .= prefix( ' | ' , $entry->title ); + $msg .= prefix( ' | ' , $entry->link ); # $msg .= prefix( ' id ' , $entry->id ); if ( $args->{kernel} && $send_rss_msgs ) { - warn "# sending to $CHANNEL\n"; $send_rss_msgs--; + _log('>>', $msg); + $sth_insert_log->execute( $CHANNEL, 1, $NICK, $msg, 'now()' ); $args->{kernel}->post( $IRC_ALIAS => notice => $CHANNEL, $msg ); $updates++; - save_message( channel => $CHANNEL, me => 1, nick => $NICK, message => $msg ); - _log('RSS', $msg); } } @@ -693,6 +663,8 @@ $sql .= qq{where id = } . $args->{id}; eval { $dbh->do( $sql ) }; + _log "RSS got $total items of which $updates new"; + return $updates; } @@ -710,20 +682,19 @@ warn "# ",$sth->rows," active RSS feeds\n"; my $count = 0; while (my $row = $sth->fetchrow_hashref) { - warn "+++ fetch RSS feed: ",dump( $row ); $row->{kernel} = $kernel if $kernel; $count += rss_fetch( $row ); } return "OK, fetched $count posts from " . $sth->rows . " feeds"; } -my $rss_last_poll = time(); sub rss_check_updates { my $kernel = shift; + my $last_t = $_rss->{last_poll} || time(); my $t = time(); - if ( $rss_last_poll - $t > $rss_min_delay ) { - $rss_last_poll = $t; + if ( $t - $last_t > $rss_min_delay ) { + $_rss->{last_poll} = $t; _log rss_fetch_all( $kernel ); } } @@ -735,8 +706,6 @@ # POE handing part # -my $SKIPPING = 0; # if skipping, how many we've done -my $SEND_QUEUE; # cache my $ping; # ping stats POE::Component::IRC->new($IRC_ALIAS); @@ -748,9 +717,6 @@ }, irc_255 => sub { # server is done blabbing $_[KERNEL]->post($IRC_ALIAS => join => $CHANNEL); - $_[KERNEL]->post($IRC_ALIAS => join => '#logger'); - $_[KERNEL]->yield("heartbeat"); # start heartbeat - $_[KERNEL]->yield("my_add", $_) for keys %FOLLOWS; $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "IDENTIFY $NICK" ); }, irc_public => sub { @@ -931,22 +897,32 @@ $res = rss_fetch_all( $_[KERNEL] ); } elsif ($msg =~ m/^rss-clean/) { $_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 from feeds }); + $sth->execute; + while (my @row = $sth->fetchrow_array) { + $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, join(' | ',@row) ); + } + $res = ''; } elsif ($msg =~ m!^rss-(add|remove|stop|start)\s+(http://\S+)\s*(.*)!) { my $sql = { add => qq{ insert into feeds (url,name) values (?,?) }, # 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 = ? -- ? }, + start => qq{ update feeds set active = true where url = ? }, + stop => qq{ update feeds set active = false where url = ? }, }; if (my $q = $sql->{$1} ) { my $sth = $dbh->prepare( $q ); - warn "## SQL $q ( $2 | $3 )\n"; - eval { $sth->execute( $2, $3 ) }; + my @data = ( $2 ); + push @data, $3 if ( $q =~ s/\?//g == 2 ); + warn "## $1 SQL $q with ",dump( @data ),"\n"; + eval { $sth->execute( @data ) }; } - $res ||= "OK, RSS $1 : $2 - $3"; + $res = "OK, RSS $1 : $2 - $3"; } if ($res) { @@ -993,67 +969,6 @@ ""; 0; # false for signals }, - 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', - ); - warn "+++ following $trailing at $FOLLOWS{$trailing}\n"; - }, - got_line => sub { - warn "+++ $trailing : $_[ARG0]\n"; - $_[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); - } }, ); @@ -1275,7 +1190,7 @@ } $cal->setcontent($dd, qq[ $row->{nr}
$row->{len} - ]); + ]) if $cal; } $html .= qq{} . $cal->as_HTML() . qq{};