--- trunk/bin/irc-logger.pl 2008/03/07 00:43:45 89 +++ trunk/bin/irc-logger.pl 2008/03/14 17:44:23 129 @@ -2,6 +2,24 @@ use strict; $|++; +use POE qw(Component::IRC Component::Server::HTTP Component::Client::HTTP); +use HTTP::Status; +use DBI; +use Regexp::Common qw /URI/; +use CGI::Simple; +use HTML::TagCloud; +use POSIX qw/strftime/; +use HTML::CalendarMonthSimple; +use Getopt::Long; +use DateTime; +use URI::Escape; +use Data::Dump qw/dump/; +use DateTime::Format::ISO8601; +use Carp qw/confess/; +use XML::Feed; +use DateTime::Format::Flexible; +use Encode; + =head1 NAME irc-logger.pl @@ -20,12 +38,6 @@ =item --log=irc-logger.log -Name of log file - -=item --follow=file.log - -Follows new messages in file - =back =head1 DESCRIPTION @@ -36,22 +48,39 @@ ## CONFIG +my $debug = 0; + +my $irc_config = { + nick => 'irc-logger', + server => 'irc.freenode.net', + port => 6667, + ircname => 'Anna the bot: try /msg irc-logger help', +}; + my $HOSTNAME = `hostname -f`; chomp($HOSTNAME); -my $NICK = 'irc-logger'; -$NICK .= '-dev' if ($HOSTNAME =~ m/llin/); -my $CONNECT = - {Server => 'irc.freenode.net', - Nick => $NICK, - Ircname => "try /msg $NICK help", - }; + my $CHANNEL = '#razmjenavjestina'; -$CHANNEL = '#irc-logger' if ($HOSTNAME =~ m/llin/); -my $IRC_ALIAS = "log"; -# default log to follow and announce messages -my $follows_path = 'follows.log'; +if ( $HOSTNAME =~ m/llin/ ) { + $irc_config->{nick} = 'irc-logger-llin'; +# $irc_config = { +# nick => 'irc-logger-llin', +# server => 'localhost', +# port => 6668, +# }; + $CHANNEL = '#irc-logger'; +} elsif ( $HOSTNAME =~ m/lugarin/ ) { + $irc_config->{server} = 'irc.carnet.hr'; + $CHANNEL = '#riss'; +} + +my @channels = ( $CHANNEL ); + +warn "## config = ", dump( $irc_config ) if $debug; + +my $NICK = $irc_config->{nick} or die "no nick?"; my $DSN = 'DBI:Pg:dbname=' . $NICK; @@ -64,7 +93,6 @@ # don't pull rss feeds more often than this my $rss_min_delay = 60; -$rss_min_delay = 15; my $http_port = $NICK =~ m/-dev/ ? 8001 : 8000; @@ -72,23 +100,6 @@ ## END CONFIG -use POE qw(Component::IRC Wheel::FollowTail Component::Server::HTTP); -use HTTP::Status; -use DBI; -use Regexp::Common qw /URI/; -use CGI::Simple; -use HTML::TagCloud; -use POSIX qw/strftime/; -use HTML::CalendarMonthSimple; -use Getopt::Long; -use DateTime; -use URI::Escape; -use Data::Dump qw/dump/; -use DateTime::Format::ISO8601; -use Carp qw/confess/; -use XML::Feed; -use DateTime::Format::Flexible; - my $use_twitter = 1; eval { require Net::Twitter; }; $use_twitter = 0 if ($@); @@ -97,37 +108,20 @@ my $log_path; GetOptions( 'import-dircproxy:s' => \$import_dircproxy, - 'follows:s' => \$follows_path, 'log:s' => \$log_path, + 'debug!' => \$debug, ); #$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(" ",map { ref($_) ? dump( $_ ) : $_ } @_) . $/; } -# 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; -} +open(STDOUT, '>', $log_path) && warn "log to $log_path: $!\n"; -add_follow_path( $follows_path ) if ( -e $follows_path ); # HTML formatters @@ -146,11 +140,11 @@ # protect HTML from wiki modifications sub e { my $t = shift; - return 'uri_unescape{' . uri_escape($t) . '}'; + return 'uri_unescape{' . uri_escape($t, '^a-zA-Z0-9') . '}'; } $m =~ s/($escape_re)/$escape{$1}/gs; - $m =~ s#($RE{URI}{HTTP})#e(qq{$1})#egs || + $m =~ s#($RE{URI}{HTTP})#e(qq{$1})#egs; $m =~ s#\/(\w+)\/#$1#gs; $m =~ s#$tag_regex#e(qq{$1})#egs; $m =~ s#\*(\w+)\*#$1#gs; @@ -171,6 +165,13 @@ }, }; +# POE IRC +my $poe_irc = POE::Component::IRC->spawn( %$irc_config ) or + die "can't start ", dump( $irc_config ), ": $!"; + +my $irc = $poe_irc->session_id(); +_log "IRC session_id $irc"; + my $dbh = DBI->connect($DSN,"","", { RaiseError => 1, AutoCommit => 1 }) || die $DBI::errstr; $dbh->do( qq{ set client_encoding = 'UTF-8' } ); @@ -207,12 +208,15 @@ name text, delay interval not null default '5 min', active boolean default true, + channel text not null, + nick text not null, + private boolean default false, last_update timestamp default 'now()', polls int default 0, updates int default 0 ); create unique index feeds_url on feeds(url); -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'); }, }; @@ -256,9 +260,9 @@ if ( $@ || ! $sth->rows ) { $sth = $dbh->prepare(qq{ insert into meta (value,nick,channel,name,changed) values (?,?,?,?,now()) }); $sth->execute( $value, $nick, $channel, $name ); - _log "created $nick/$channel/$name = $value"; + warn "## created $nick/$channel/$name = $value\n"; } else { - _log "updated $nick/$channel/$name = $value "; + warn "## updated $nick/$channel/$name = $value\n"; } return $value; @@ -268,7 +272,7 @@ my $sth = $dbh->prepare(qq{ select value,changed from meta where nick = ? and channel = ? and name = ? }); $sth->execute( $nick, $channel, $name ); my ($v,$c) = $sth->fetchrow_array; - _log "fetched $nick/$channel/$name = $v [$c]"; + warn "## fetched $nick/$channel/$name = $v [$c]\n"; return ($v,$c) if wantarray; return $v; @@ -365,25 +369,26 @@ my @where; my @args; + my $msg; if (my $search = $args->{search}) { $search =~ s/^\s+//; $search =~ s/\s+$//; push @where, 'message ilike ? or nick ilike ?'; push @args, ( ( '%' . $search . '%' ) x 2 ); - _log "search for '$search'"; + $msg = "Search for '$search'"; } if ($args->{tag} && $tags->{ $args->{tag} }) { push @where, 'id in (' . join(',', @{ $tags->{ $args->{tag} } }) . ')'; - _log "search for tags $args->{tag}"; + $msg = "Search for tags $args->{tag}"; } if (my $date = $args->{date} ) { $date = check_date( $date ); push @where, 'date(time) = ?'; push @args, $date; - _log "search for date $date"; + $msg = "search for date $date"; } $sql .= " where " . join(" and ", @where) if @where; @@ -397,6 +402,8 @@ eval { $sth->execute( @args ) }; return if $@; + my $nr_results = $sth->rows; + my $last_row = { date => '', time => '', @@ -417,10 +424,14 @@ return @rows if ($args->{full_rows}); - my @msgs = ( - "Showing " . ($#rows + 1) . " messages..." + $msg .= ' produced ' . ( + $nr_results == 0 ? 'no results' : + $nr_results == 0 ? 'one result' : + $nr_results . ' results' ); + my @msgs = ( $msg ); + if ($context) { my @ids = @rows; @rows = (); @@ -477,6 +488,8 @@ # $row->{nick} = $nick; # } + $append = 0 if $row->{me}; + if ($last_row->{nick} ne $nick) { # obfu way to find format for me_nick if needed or fallback to default my $fmt = $row->{me} ? ( $args->{fmt}->{me_nick} || $args->{fmt}->{nick} ) : $args->{fmt}->{nick}; @@ -592,7 +605,7 @@ $a->{me} ||= 0; $a->{time} ||= strftime($TIMESTAMP,localtime()); - _log + _log "ARCHIVE", $a->{channel}, " ", $a->{me} ? "***" . $a->{nick} : "<" . $a->{nick} . ">", " " . $a->{message}; @@ -640,46 +653,94 @@ # RSS follow # -my $_rss; +my $_stat; + +POE::Component::Client::HTTP->spawn( + Alias => 'rss-fetch', + Timeout => 30, +); + +=head2 rss_parse_xml + + rss_parse_xml({ + url => 'http://www.example.com/rss', + send_rss_msgs => 42, + }); + +=cut +sub rss_parse_xml { + my ($kernel,$args) = @_; -sub rss_fetch { - my ($args) = @_; + warn "## rss_parse_xml ",dump( @_ ) if $debug; # how many messages to send out when feed is seen for the first time? - my $send_rss_msgs = 1; + my $send_rss_msgs = $args->{send_rss_msgs}; + $send_rss_msgs = 1 if ! defined $send_rss_msgs; - _log "RSS fetch", $args->{url}; + warn "## RSS fetch first $send_rss_msgs items from", $args->{url} if $debug; - my $feed = XML::Feed->parse(URI->new( $args->{url} )); + my $feed = XML::Feed->parse( \$args->{xml} ); if ( ! $feed ) { - _log("can't fetch RSS ", $args->{url}); + _log "can't fetch RSS ", $args->{url}, XML::Feed->errstr; 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? - return if $_rss->{$feed->link}->{seen}->{$entry->id}++ > 0; + warn "## $seen_times ",$entry->id if $debug; + next if $seen_times > 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; + } + 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 ); + if ( my $tags = $entry->category ) { + $tags =~ s!^\s+!!; + $tags =~ s!\s*$! !; + $tags =~ s!,?\s+!// !g; + $msg .= prefix( ' ' , $tags ); + } - if ( $args->{kernel} && $send_rss_msgs ) { + if ( $seen_times == 0 && $send_rss_msgs ) { $send_rss_msgs--; - _log('RSS', $msg); - $sth_insert_log->execute( $CHANNEL, 1, $NICK, $msg, undef ); - $args->{kernel}->post( $IRC_ALIAS => notice => $CHANNEL, $msg ); + 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()' ); + } + my ( $type, $to ) = ( 'notice', $args->{channel} ); + ( $type, $to ) = ( 'privmsg', $args->{nick} ) if $args->{private}; + + _log(">> RSS $type to $to:", $msg); + $kernel->post( $irc => $type => $to => $msg ); + $updates++; } } @@ -689,64 +750,68 @@ $sql .= qq{where id = } . $args->{id}; eval { $dbh->do( $sql ) }; - _log "RSS got $total items of which $updates new"; + _log "RSS $updates/$total new items from", $args->{url}; return $updates; } sub rss_fetch_all { - my $kernel = shift; + my ( $kernel, $send_rss_msgs ) = @_; + warn "## rss_fetch_all -- send_rss_msgs: $send_rss_msgs\n" if $debug; my $sql = qq{ - select id, url, name + select id, url, name, channel, nick, private from feeds where active is true }; # limit to newer feeds only if we are not sending messages out - $sql .= qq{ and last_update + delay < now() } if $kernel; + $sql .= qq{ and last_update + delay < now() } if defined ( $_stat->{rss}->{fetch} ); my $sth = $dbh->prepare( $sql ); $sth->execute(); warn "# ",$sth->rows," active RSS feeds\n"; my $count = 0; while (my $row = $sth->fetchrow_hashref) { - $row->{kernel} = $kernel if $kernel; - $count += rss_fetch( $row ); + $row->{send_rss_msgs} = $send_rss_msgs if defined $send_rss_msgs; + $_stat->{rss}->{fetch}->{ $row->{url} } = $row; + $kernel->post( + 'rss-fetch', + 'request', + 'rss_response', + HTTP::Request->new( GET => $row->{url} ), + ); + warn "## queued rss-fetch ", dump( $row ) if $debug; } - return "OK, fetched $count posts from " . $sth->rows . " feeds"; + return "OK, scheduled " . $sth->rows . " feeds for refresh"; } sub rss_check_updates { my $kernel = shift; - my $last_t = $_rss->{last_poll} || time(); - my $t = time(); - if ( $last_t - $t > $rss_min_delay ) { - $_rss->{last_poll} = $t; + $_stat->{rss}->{last_poll} ||= time(); + my $dt = time() - $_stat->{rss}->{last_poll}; + if ( $dt > $rss_min_delay ) { + warn "## rss_check_updates $dt > $rss_min_delay\n"; + $_stat->{rss}->{last_poll} = time(); _log rss_fetch_all( $kernel ); } } -# seed rss seen cache so we won't send out all items on startup -_log rss_fetch_all; - -# -# 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); - POE::Session->create( inline_states => { _start => sub { - $_[KERNEL]->post($IRC_ALIAS => register => 'all'); - $_[KERNEL]->post($IRC_ALIAS => connect => $CONNECT); - }, - irc_255 => sub { # server is done blabbing - $_[KERNEL]->post($IRC_ALIAS => join => $CHANNEL); - $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "IDENTIFY $NICK" ); + $_[KERNEL]->post( $irc => register => 'all' ); + $_[KERNEL]->post( $irc => connect => {} ); }, + irc_001 => sub { + my ($kernel,$sender) = @_[KERNEL,SENDER]; + my $poco_object = $sender->get_heap(); + _log "connected to",$poco_object->server_name(); + $kernel->post( $sender => join => $_ ) for @channels; + # seen RSS cache, so don't send out messages + _log rss_fetch_all( $kernel, 0 ); + undef; + }, +# irc_255 => sub { # server is done blabbing +# $_[KERNEL]->post( $irc => join => $CHANNEL); +# }, irc_public => sub { my $kernel = $_[KERNEL]; my $nick = (split /!/, $_[ARG0])[0]; @@ -755,6 +820,7 @@ save_message( channel => $channel, me => 0, nick => $nick, message => $msg); meta( $nick, $channel, 'last-msg', $msg ); + rss_check_updates( $kernel ); }, irc_ctcp_action => sub { my $kernel = $_[KERNEL]; @@ -776,7 +842,7 @@ }, irc_ping => sub { _log( "pong ", $_[ARG0] ); - $ping->{ $_[ARG0] }++; + $_stat->{ping}->{ $_[ARG0] }++; rss_check_updates( $_[KERNEL] ); }, irc_invite => sub { @@ -786,8 +852,8 @@ _log "invited to $channel by $nick"; - $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, "how nice of you to invite me to $channel, I'll be right there..." ); - $_[KERNEL]->post($IRC_ALIAS => join => $channel); + $_[KERNEL]->post( $irc => privmsg => $nick, "how nice of you to invite me to $channel, I'll be right there..." ); + $_[KERNEL]->post( $irc => 'join' => $channel ); }, irc_msg => sub { @@ -795,6 +861,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; @@ -805,10 +872,10 @@ $res = "usage: /msg $NICK comand | commands: stat - user/message stat | last - show backtrace | grep foobar - find foobar"; - } elsif ($msg =~ m/^msg\s+(\S+)\s+(.*)$/i) { + } elsif ($msg =~ m/^(privmsg|notice)\s+(\S+)\s+(.*)$/i) { - _log ">> /msg $1 $2"; - $_[KERNEL]->post( $IRC_ALIAS => privmsg => $1, $2 ); + _log ">> /$1 $2 $3"; + $_[KERNEL]->post( $irc => $1 => $2, $3 ); $res = ''; } elsif ($msg =~ m/^stat.*?\s*(\d*)/i) { @@ -838,7 +905,7 @@ foreach my $res (get_from_log( limit => $limit )) { _log "last: $res"; - $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res ); + $_[KERNEL]->post( $irc => privmsg => $nick, $res ); } $res = ''; @@ -852,7 +919,7 @@ search => $what, )) { _log "search [$what]: $res"; - $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res ); + $_[KERNEL]->post( $irc => privmsg => $nick, $res ); } $res = ''; @@ -887,10 +954,10 @@ " : " . ( $stat->{vote}->{'-'} || 0 ) . " --" . " from " . ( join(", ", @nicks) || 'nobody' ); - $_[KERNEL]->post( $IRC_ALIAS => notice => $nick, $res ); + $_[KERNEL]->post( $irc => notice => $nick, $res ); } elsif ($msg =~ m/^ping/) { - $res = "ping = " . dump( $ping ); + $res = "ping = " . dump( $_stat->{ping} ); } elsif ($msg =~ m/^conf(?:ig)*\s*(last-size|twitter)*\s*(.*)/) { if ( ! defined( $1 ) ) { my $sth = $dbh->prepare(qq{ select name,value,changed from meta where nick = ? and channel = ? }); @@ -923,61 +990,139 @@ } } elsif ($msg =~ m/^rss-update/) { $res = rss_fetch_all( $_[KERNEL] ); - } elsif ($msg =~ m/^rss-clean/) { - $_rss = undef; - $res = "OK, cleaned RSS cache"; - } elsif ($msg =~ m!^rss-(add|remove|stop|start)\s+(http://\S+)\s*(.*)!) { + } elsif ($msg =~ m/^rss-list/) { + my $sth = $dbh->prepare(qq{ select url,name,last_update,active,channel,nick,private from feeds }); + $sth->execute; + while (my @row = $sth->fetchrow_array) { + $_[KERNEL]->post( $irc => privmsg => $nick, join(' | ',@row) ); + } + $res = ''; + } 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*// ); + $channel = $nick if $sub eq 'private'; + 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 = ? -- ? }, - + add => qq{ insert into feeds (url,name,channel,nick,private) values (?,?,?,?,?) }, + remove => qq{ delete from feeds where url = ? and nick = ? }, + 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 (my $q = $sql->{$1} ) { + + if ( $command eq 'add' && ! $channel ) { + $res = "ERROR: got '$msg' which doesn't have #channel in it, ignoring!"; + } elsif (my $q = $sql->{$command} ) { my $sth = $dbh->prepare( $q ); - warn "## SQL $q ( $2 | $3 )\n"; - eval { $sth->execute( $2, $3 ) }; + my @data = ( $url ); + if ( $command eq 'add' ) { + push @data, ( $arg, $channel, $nick, $sub eq 'private' ? 1 : 0 ); + } elsif ( $command eq 'remove' ) { + push @data, $nick; + } + warn "## $command SQL $q with ",dump( @data ),"\n"; + eval { $sth->execute( @data ) }; + if ($@) { + $res = "ERROR: $@"; + } else { + $res = "OK, RSS executed $command" . + ( $sub ? "-$sub " : ' ' ) . + ( $channel ? "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"; + } + } + } elsif ( $command eq 'add' ) { + rss_fetch_all( $_[KERNEL] ); + } + } + } else { + $res = "ERROR: don't know what to do with: $msg"; } - - $res ||= "OK, RSS $1 : $2 - $3"; + } 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 = rss_fetch_all( $_[KERNEL] ); } if ($res) { _log ">> [$nick] $res"; - $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res ); + $_[KERNEL]->post( $irc => privmsg => $nick, $res ); } rss_check_updates( $_[KERNEL] ); }, + irc_372 => sub { + _log "<< motd",$_[ARG0],$_[ARG1]; + }, + irc_375 => sub { + _log "<< motd", $_[ARG0], "start"; + }, + irc_376 => sub { + _log "<< motd", $_[ARG0], "end"; + }, +# irc_433 => sub { +# print "# irc_433: ",$_[ARG1], "\n"; +# warn "## indetify $NICK\n"; +# $_[KERNEL]->post( $irc => privmsg => 'nickserv', "IDENTIFY $NICK" ); +# }, +# irc_451 # please register irc_477 => sub { - _log "# irc_477: ",$_[ARG1]; - $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "register $NICK" ); + _log "<< irc_477: ",$_[ARG1]; + _log ">> IDENTIFY $NICK"; + $_[KERNEL]->post( $irc => privmsg => 'NickServ', "IDENTIFY $NICK" ); }, irc_505 => sub { - _log "# irc_505: ",$_[ARG1]; - $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "register $NICK" ); -# $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "set hide email on" ); -# $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "set email dpavlin\@rot13.org" ); + _log "<< irc_505: ",$_[ARG1]; + _log ">> register $NICK"; + $_[KERNEL]->post( $irc => privmsg => 'NickServ', "register $NICK" ); +# $_[KERNEL]->post( $irc => privmsg => 'nickserv', "IDENTIFY $NICK" ); +# $_[KERNEL]->post( $irc => privmsg => 'nickserv', "set hide email on" ); +# $_[KERNEL]->post( $irc => privmsg => 'nickserv', "set email dpavlin\@rot13.org" ); }, irc_registered => sub { - _log "## registrated $NICK"; - $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "IDENTIFY $NICK" ); + _log "<< registered $NICK"; }, irc_disconnected => sub { - _log "## disconnected, reconnecting again"; - $_[KERNEL]->post($IRC_ALIAS => connect => $CONNECT); + _log "## disconnected.. sleeping for $sleep_on_error seconds and reconnecting again"; + sleep($sleep_on_error); + $_[KERNEL]->post( $irc => connect => {} ); }, irc_socketerr => sub { _log "## socket error... sleeping for $sleep_on_error seconds and retry"; sleep($sleep_on_error); - $_[KERNEL]->post($IRC_ALIAS => connect => $CONNECT); + $_[KERNEL]->post( $irc => connect => {} ); + }, + irc_notice => sub { + _log "<< notice from ", $_[ARG0], $_[ARG1], $_[ARG2]; + my $m = $_[ARG2]; + if ( $m =~ m!/msg.*(NickServ).*(IDENTIFY)!i ) { + _log ">> suggested to $1 $2"; + $_[KERNEL]->post( $irc => privmsg => $1, "$2 $NICK" ); + } elsif ( $m =~ m!\Q$NICK\E.*registered!i ) { + _log ">> registreted, so IDENTIFY"; + $_[KERNEL]->post( $irc => privmsg => 'nickserv', "IDENTIFY $NICK" ); + } else { + warn "## ignore $m\n" if $debug; + } + }, + irc_snotice => sub { + _log "<< snotice", $_[ARG0]; #dump( $_[ARG0],$_[ARG1], $_[ARG2] ); + if ( $_[ARG0] =~ m!/(QUOTE)\s+(PASS\s+\d+)!i ) { + warn ">> $1 | $2\n"; + $_[KERNEL]->post( $irc => lc($1) => $2); + } }, -# irc_433 => sub { -# print "# irc_433: ",$_[ARG1], "\n"; -# warn "## indetify $NICK\n"; -# $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "IDENTIFY $NICK" ); -# }, _child => sub {}, _default => sub { _log sprintf "sID:%s %s %s", @@ -987,11 +1132,26 @@ ""; 0; # false for signals }, + rss_response => sub { + my ($request_packet, $response_packet) = @_[ARG0, ARG1]; + my $request_object = $request_packet->[0]; + my $response_object = $response_packet->[0]; + + my $row = delete( $_stat->{rss}->{fetch}->{ $request_object->uri } ); + if ( $row ) { + $row->{xml} = $response_object->content; + rss_parse_xml( $_[KERNEL], $row ); + } else { + warn "## can't find rss->fetch for ", $request_object->uri; + } + }, }, ); # http server +_log "WEB archive at $url"; + my $httpd = POE::Component::Server::HTTP->new( Port => $http_port, PreHandler => { @@ -1038,7 +1198,7 @@ $style .= ".col-${max_color} { background: $c }\n"; $max_color++; } -warn "defined $max_color colors for users...\n"; +_log "WEB defined $max_color colors for users..."; sub root_handler { my ($request, $response) = @_; @@ -1060,8 +1220,12 @@ } my $search = $q->param('search') || $q->param('grep') || ''; + my $r_url = $request->url; - if ($request->url =~ m#/rss(?:/(tags|last-tag|follow.*)\w*(?:=(\d+))?)?#i) { + my @commands = qw( tags last-tag follow stat ); + my $commands_re = join('|',@commands); + + if ($r_url =~ m#/rss(?:/($commands_re.*)\w*(?:=(\d+))?)?#i) { my $show = lc($1); my $nr = $2; @@ -1075,6 +1239,8 @@ my $feed = XML::Feed->new( $type ); $feed->link( $url ); + my $rc = RC_OK; + if ( $show eq 'tags' ) { $nr ||= 50; $feed->title( "tags from $CHANNEL" ); @@ -1144,13 +1310,29 @@ $feed->add_entry( $feed_entry ); } + } elsif ( $show =~ m/^stat/ ) { + + my $feed_entry = XML::Feed::Entry->new($type); + $feed_entry->title( "Internal stats" ); + $feed_entry->content( + '' . dump( $_stat ) . ']]>' + ); + $feed->add_entry( $feed_entry ); + } else { - _log "unknown rss request ",$request->url; - return RC_DENY; + _log "WEB unknown rss request $r_url"; + $feed->title( "unknown $r_url" ); + foreach my $c ( @commands ) { + my $feed_entry = XML::Feed::Entry->new($type); + $feed_entry->title( "rss/$c" ); + $feed_entry->link( "$url/rss/$c" ); + $feed->add_entry( $feed_entry ); + } + $rc = RC_DENY; } $response->content( $feed->as_xml ); - return RC_OK; + return $rc; } if ( $@ ) { @@ -1241,7 +1423,7 @@

See history of all messages.

}; - $response->content( $html ); + $response->content( decode('utf-8',$html) ); warn "<< ", $request->method, " ", $request->uri, " created ", length($html), " bytes\n"; return RC_OK; }