--- trunk/bin/irc-logger.pl 2008/03/06 22:16:27 85 +++ trunk/bin/irc-logger.pl 2008/03/07 00:43:45 89 @@ -55,7 +55,6 @@ my $DSN = 'DBI:Pg:dbname=' . $NICK; -my $ENCODING = 'ISO-8859-2'; my $TIMESTAMP = '%Y-%m-%d %H:%M:%S'; my $sleep_on_error = 5; @@ -76,7 +75,6 @@ use POE qw(Component::IRC Wheel::FollowTail 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; @@ -103,14 +101,14 @@ '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(" ",@_), $/; + print strftime($TIMESTAMP,localtime()) . ' ' . join(" ",@_) . $/; } # LOG following @@ -174,6 +172,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 +205,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 +277,7 @@ -my $sth = $dbh->prepare(qq{ +my $sth_insert_log = $dbh->prepare(qq{ insert into log (channel, me, nick, message, time) values (?,?,?,?,?) @@ -530,7 +529,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 +597,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,13 +649,16 @@ # 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; @@ -676,11 +675,10 @@ $msg .= prefix( ' -- ' , $entry->link ); # $msg .= prefix( ' id ' , $entry->id ); - _log('RSS', $msg); - if ( $args->{kernel} && $send_rss_msgs ) { - warn "# sending to $CHANNEL\n"; $send_rss_msgs--; + _log('RSS', $msg); + $sth_insert_log->execute( $CHANNEL, 1, $NICK, $msg, undef ); $args->{kernel}->post( $IRC_ALIAS => notice => $CHANNEL, $msg ); $updates++; } @@ -689,7 +687,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 +708,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 ( $last_t - $t > $rss_min_delay ) { + $_rss->{last_poll} = $t; _log rss_fetch_all( $kernel ); } } @@ -746,9 +745,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 +795,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 +838,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 +852,6 @@ search => $what, )) { _log "search [$what]: $res"; - from_to($res, $ENCODING, 'UTF-8'); $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res ); } @@ -952,7 +945,6 @@ if ($res) { _log ">> [$nick] $res"; - from_to($res, $ENCODING, 'UTF-8'); $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res ); } @@ -995,67 +987,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 +1114,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 +1157,7 @@ warn "$@"; } - $response->content_type("text/html; charset=$ENCODING"); + $response->content_type("text/html; charset=UTF-8"); my $html = qq{$NICK