--- trunk/bin/irc-logger.pl 2008/03/06 22:16:27 85 +++ trunk/bin/irc-logger.pl 2008/03/07 10:50:16 94 @@ -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,12 +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; -my $ENCODING = 'ISO-8859-2'; my $TIMESTAMP = '%Y-%m-%d %H:%M:%S'; my $sleep_on_error = 5; @@ -73,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; @@ -99,38 +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 { - print strftime($TIMESTAMP,localtime()), ' ', join(" ",@_), $/; -} - -# 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 = ('<'=>'<', '>'=>'>', '&'=>'&', '"'=>'"'); @@ -174,6 +144,7 @@ }; my $dbh = DBI->connect($DSN,"","", { RaiseError => 1, AutoCommit => 1 }) || die $DBI::errstr; +$dbh->do( qq{ set client_encoding = 'UTF-8' } ); my $sql_schema = { log => qq{ @@ -206,7 +177,7 @@ id serial, url text not null, name text, - delay interval not null default '30 sec', --'5 min', + delay interval not null default '5 min', active boolean default true, last_update timestamp default 'now()', polls int default 0, @@ -278,7 +249,7 @@ -my $sth = $dbh->prepare(qq{ +my $sth_insert_log = $dbh->prepare(qq{ insert into log (channel, me, nick, message, time) values (?,?,?,?,?) @@ -530,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; @@ -599,9 +569,7 @@ $a->{me} ? "***" . $a->{nick} : "<" . $a->{nick} . ">", " " . $a->{message}; - from_to($a->{message}, 'UTF-8', $ENCODING); - - $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 ); } @@ -653,34 +621,51 @@ # 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) = @_; + $var =~ s/\s+/ /gs; $var =~ s/^\s+//g; + $var =~ s/\s+$//g; return $txt . $var if $var; } + # fix absolute and relative links to feed entries + my $link = $entry->link; + if ( $link =~ m!^/! ) { + my $host = $args->{url}; + $host =~ s!^(http://[^/]+).*$!$1!; #!vim + $link = "$host/$link"; + } elsif ( $link !~ m!^http! ) { + $link = $args->{url} . $link; + } + $link =~ s!//+!/!g; + 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( ' | ' , $link ); # $msg .= prefix( ' id ' , $entry->id ); - _log('RSS', $msg); - 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++; } @@ -689,7 +674,9 @@ my $sql = qq{ update feeds set last_update = now(), polls = polls + 1 }; $sql .= qq{, updates = updates + $updates } if $updates; $sql .= qq{where id = } . $args->{id}; - $dbh->do( $sql ); + eval { $dbh->do( $sql ) }; + + _log "RSS got $total items of which $updates new"; return $updates; } @@ -708,20 +695,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 ); } } @@ -733,8 +719,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); @@ -746,9 +730,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 { @@ -799,7 +780,6 @@ my $nick = (split /!/, $_[ARG0])[0]; my $msg = $_[ARG2]; my $channel = $_[ARG1]->[0]; - from_to($msg, 'UTF-8', $ENCODING); my $res = "unknown command '$msg', try /msg $NICK help!"; my @out; @@ -843,7 +823,6 @@ foreach my $res (get_from_log( limit => $limit )) { _log "last: $res"; - from_to($res, $ENCODING, 'UTF-8'); $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res ); } @@ -858,7 +837,6 @@ search => $what, )) { _log "search [$what]: $res"; - from_to($res, $ENCODING, 'UTF-8'); $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res ); } @@ -932,27 +910,35 @@ $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) { _log ">> [$nick] $res"; - from_to($res, $ENCODING, 'UTF-8'); $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res ); } @@ -995,67 +981,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); - } }, ); @@ -1183,7 +1108,6 @@ my $message = $filter->{message}->( $m->{message} ); $message .= "
\n" unless $message =~ m!<(/p|br/?)>!; # warn "## message = $message\n"; - from_to( $message, $ENCODING, 'UTF-8' ); #$feed_entry->summary( $feed_entry->content( @@ -1227,7 +1151,7 @@ warn "$@"; } - $response->content_type("text/html; charset=$ENCODING"); + $response->content_type("text/html; charset=UTF-8"); my $html = qq{$NICK