--- trunk/irc-logger.pl 2007/02/02 22:27:36 43 +++ trunk/bin/irc-logger.pl 2007/03/18 16:45:18 52 @@ -18,6 +18,12 @@ Import log from C to C database +=item --log=irc-logger.log + +Name of log file + +=back + =head1 DESCRIPTION log all conversation on irc channel @@ -70,20 +76,22 @@ use Data::Dump qw/dump/; my $import_dircproxy; +my $log_path; GetOptions( 'import-dircproxy:s' => \$import_dircproxy, + 'log:s' => \$log_path, ); -my $dbh = DBI->connect($DSN,"","", { RaiseError => 1, AutoCommit => 1 }) || die $DBI::errstr; +open(STDOUT, '>', $log_path) || warn "can't redirect log to $log_path: $!"; -eval { - $dbh->do(qq{ select count(*) from log }); -}; +sub _log { + print strftime($TIMESTAMP,localtime()), ' ', join(" ",@_), $/; +} -if ($@) { - warn "creating database table in $DSN\n"; - $dbh->do(<<'_SQL_SCHEMA_'); +my $dbh = DBI->connect($DSN,"","", { RaiseError => 1, AutoCommit => 1 }) || die $DBI::errstr; +my $sql_schema = { + log => ' create table log ( id serial, time timestamp default now(), @@ -97,16 +105,87 @@ create index log_time on log(time); create index log_channel on log(channel); create index log_nick on log(nick); + ', + meta => ' +create table meta ( + nick text not null, + channel text not null, + name text not null, + value text, + changed timestamp default now(), + primary key(nick,channel,name) +); + ', +}; + +foreach my $table ( keys %$sql_schema ) { -_SQL_SCHEMA_ + eval { + $dbh->do(qq{ select count(*) from $table }); + }; + + if ($@) { + warn "creating database table $table in $DSN\n"; + $dbh->do( $sql_schema->{ $table } ); + } } + +=head2 meta + +Set or get some meta data into database + + meta('nick','channel','var_name', $var_value ); + + $var_value = meta('nick','channel','var_name'); + ( $var_value, $changed ) = meta('nick','channel','var_name'); + +=cut + +sub meta { + my ($nick,$channel,$name,$value) = @_; + + # normalize channel name + $channel =~ s/^#//; + + if (defined($value)) { + + my $sth = $dbh->prepare(qq{ update meta set value = ?, changed = now() where nick = ? and channel = ? and name = ? }); + + eval { $sth->execute( $value, $nick, $channel, $name ) }; + + # error or no result + 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"; + } else { + _log "updated $nick/$channel/$name = $value "; + } + + return $value; + + } else { + + 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]"; + return ($v,$c) if wantarray; + return $v; + + } +} + + + my $sth = $dbh->prepare(qq{ insert into log (channel, me, nick, message, time) values (?,?,?,?,?) }); + my $tags; my $tag_regex = '\b([\w-_]+)//'; @@ -186,13 +265,13 @@ $search =~ s/^\s+//; $search =~ s/\s+$//; $sth->execute( ( '%' . $search . '%' ) x 2 ); - warn "search for '$search' returned ", $sth->rows, " results ", $context || '', "\n"; + _log "search for '$search' returned ", $sth->rows, " results ", $context || ''; } elsif (my $tag = $args->{tag}) { $sth->execute(); - warn "tag '$tag' returned ", $sth->rows, " results ", $context || '', "\n"; + _log "tag '$tag' returned ", $sth->rows, " results ", $context || ''; } elsif (my $date = $args->{date}) { $sth->execute($date); - warn "found ", $sth->rows, " messages for date $date ", $context || '', "\n"; + _log "found ", $sth->rows, " messages for date $date ", $context || ''; } else { $sth->execute(); } @@ -379,11 +458,10 @@ $a->{me} ||= 0; $a->{time} ||= strftime($TIMESTAMP,localtime()); - print - $a->{time}, " ", + _log $a->{channel}, " ", $a->{me} ? "***" . $a->{nick} : "<" . $a->{nick} . ">", - " " . $a->{msg} . "\n"; + " " . $a->{msg}; from_to($a->{msg}, 'UTF-8', $ENCODING); @@ -392,6 +470,7 @@ message => $a->{msg}); } + if ($import_dircproxy) { open(my $l, $import_dircproxy) || die "can't open $import_dircproxy: $!"; warn "importing $import_dircproxy...\n"; @@ -418,7 +497,7 @@ ) if ($nick !~ m/^-/); } else { - warn "can't parse: $_\n"; + _log "can't parse: $_"; } } close($l); @@ -456,6 +535,7 @@ my $msg = $_[ARG2]; save_message( channel => $channel, me => 0, nick => $nick, msg => $msg); + meta( $nick, $channel, 'last-msg', $msg ); }, irc_ctcp_action => sub { my $kernel = $_[KERNEL]; @@ -464,16 +544,20 @@ my $msg = $_[ARG2]; save_message( channel => $channel, me => 1, nick => $nick, msg => $msg); + + if ( my $twitter = ( $nick, $channel, 'twitter' ) ) { + _log("FIXME: send twitter for $nick on $channel [$twitter]"); + } + }, irc_ping => sub { warn "pong ", $_[ARG0], $/; - $ping->{$_[ARG0]++}; + $ping->{ $_[ARG0] }++; }, irc_invite => sub { my $kernel = $_[KERNEL]; my $nick = (split /!/, $_[ARG0])[0]; my $channel = $_[ARG1]; - warn "invited to $channel by $nick"; @@ -485,12 +569,13 @@ my $kernel = $_[KERNEL]; 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; - print "<< $msg\n"; + _log "<< $msg"; if ($msg =~ m/^help/i) { @@ -498,7 +583,7 @@ } elsif ($msg =~ m/^msg\s+(\S+)\s+(.*)$/i) { - print ">> /msg $1 $2\n"; + _log ">> /msg $1 $2"; $_[KERNEL]->post( $IRC_ALIAS => privmsg => $1, $2 ); $res = ''; @@ -525,8 +610,10 @@ $res .= join(" | ", @users); } elsif ($msg =~ m/^last.*?\s*(\d*)/i) { - foreach my $res (get_from_log( limit => ($1 || 100) )) { - print "last: $res\n"; + my $limit = $1 || meta( $nick, $channel, 'last-size' ) || 10; + + foreach my $res (get_from_log( limit => $limit )) { + _log "last: $res"; from_to($res, $ENCODING, 'UTF-8'); $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res ); } @@ -541,7 +628,7 @@ limit => 20, search => $what, )) { - print "search [$what]: $res\n"; + _log "search [$what]: $res"; from_to($res, $ENCODING, 'UTF-8'); $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res ); } @@ -582,35 +669,65 @@ } elsif ($msg =~ m/^ping/) { $res = "ping = " . dump( $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 = ? }); + $sth->execute( $nick, $channel ); + $res = "config for $nick on $channel"; + while ( my ($n,$v) = $sth->fetchrow_array ) { + $res .= " | $n = $v"; + } + } elsif ( ! $2 ) { + my $val = meta( $nick, $channel, $1 ); + $res = "current $1 = " . ( $val ? $val : 'undefined' ); + } else { + my $validate = { + 'last-size' => qr/^\d+/, + 'twitter' => qr/^\w+\s+\w+/, + }; + + my ( $op, $val ) = ( $1, $2 ); + + if ( my $regex = $validate->{$op} ) { + if ( $val =~ $regex ) { + meta( $nick, $channel, $op, $val ); + $res = "saved $op = $val"; + } else { + $res = "config option $op = $val doesn't validate against $regex"; + } + } else { + $res = "config option $op doesn't exist"; + } + } } if ($res) { - print ">> [$nick] $res\n"; + _log ">> [$nick] $res"; from_to($res, $ENCODING, 'UTF-8'); $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res ); } }, irc_477 => sub { - print "# irc_477: ",$_[ARG1], "\n"; + _log "# irc_477: ",$_[ARG1]; $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "register $NICK" ); }, irc_505 => sub { - print "# irc_505: ",$_[ARG1], "\n"; + _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" ); }, irc_registered => sub { - warn "## indetify $NICK\n"; + _log "## registrated $NICK"; $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "IDENTIFY $NICK" ); }, irc_disconnected => sub { - warn "## disconnected, reconnecting again\n"; + _log "## disconnected, reconnecting again"; $_[KERNEL]->post($IRC_ALIAS => connect => $CONNECT); }, irc_socketerr => sub { - warn "## socket error... sleeping for $sleep_on_error seconds and retry"; + _log "## socket error... sleeping for $sleep_on_error seconds and retry"; sleep($sleep_on_error); $_[KERNEL]->post($IRC_ALIAS => connect => $CONNECT); }, @@ -621,8 +738,8 @@ # }, _child => sub {}, _default => sub { - printf "%s #%s %s %s\n", - strftime($TIMESTAMP,localtime()), $_[SESSION]->ID, $_[ARG0], + _log sprintf "sID:%s %s %s", + $_[SESSION]->ID, $_[ARG0], ref($_[ARG1]) eq "ARRAY" ? join(",", map { ref($_) eq "ARRAY" ? join(";", @{$_}) : $_ } @{ $_[ARG1] }) : $_[ARG1] ? $_[ARG1] : "";