--- trunk/bin/irc-logger.pl 2007/02/03 12:50:45 48 +++ trunk/bin/irc-logger.pl 2007/06/08 12:17:35 65 @@ -73,7 +73,13 @@ use HTML::CalendarMonthSimple; use Getopt::Long; use DateTime; +use URI::Escape; use Data::Dump qw/dump/; +use DateTime::Format::ISO8601; + +my $use_twitter = 1; +eval { require Net::Twitter; }; +$use_twitter = 0 if ($@); my $import_dircproxy; my $log_path; @@ -90,14 +96,8 @@ my $dbh = DBI->connect($DSN,"","", { RaiseError => 1, AutoCommit => 1 }) || die $DBI::errstr; -eval { - $dbh->do(qq{ select count(*) from log }); -}; - -if ($@) { - warn "creating database table in $DSN\n"; - $dbh->do(<<'_SQL_SCHEMA_'); - +my $sql_schema = { + log => ' create table log ( id serial, time timestamp default now(), @@ -111,16 +111,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) +); + ', +}; -_SQL_SCHEMA_ +foreach my $table ( keys %$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-_]+)//'; @@ -191,7 +262,15 @@ $sql .= " where message ilike ? or nick ilike ? " if ($args->{search}); $sql .= " where id in (" . join(",", @{ $tags->{ $args->{tag} } }) . ") " if ($args->{tag} && $tags->{ $args->{tag} }); - $sql .= " where date(time) = ? " if ($args->{date}); + if ($args->{date}) { + my $date = eval { DateTime::Format::ISO8601->parse_datetime( $args->{date} )->ymd; }; + if ( $@ ) { + warn "invalid date ", $args->{date}, $/; + $date = DateTime->now->ymd; + } + $sql .= " where date(time) = ? "; + $args->{date} = $date; + } $sql .= " order by log.time desc"; $sql .= " limit " . $args->{limit} if ($args->{limit}); @@ -405,6 +484,7 @@ message => $a->{msg}); } + if ($import_dircproxy) { open(my $l, $import_dircproxy) || die "can't open $import_dircproxy: $!"; warn "importing $import_dircproxy...\n"; @@ -469,6 +549,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]; @@ -477,6 +558,16 @@ my $msg = $_[ARG2]; save_message( channel => $channel, me => 1, nick => $nick, msg => $msg); + + if ( $use_twitter ) { + if ( my $twitter = meta( $nick, $NICK, 'twitter' ) ) { + my ($login,$passwd) = split(/\s+/,$twitter,2); + _log("sending twitter for $nick/$login on $channel "); + my $bot = Net::Twitter->new( username=>$login, password=>$passwd ); + $bot->update("<${channel}> $msg"); + } + } + }, irc_ping => sub { warn "pong ", $_[ARG0], $/; @@ -486,7 +577,6 @@ my $kernel = $_[KERNEL]; my $nick = (split /!/, $_[ARG0])[0]; my $channel = $_[ARG1]; - warn "invited to $channel by $nick"; @@ -498,6 +588,7 @@ 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!"; @@ -521,11 +612,11 @@ my $sth = $dbh->prepare(qq{ select - nick, + trim(both '_' from nick) as nick, count(*) as count, sum(length(message)) as len from log - group by nick + group by trim(both '_' from nick) order by len desc,count desc limit $nr }); @@ -538,7 +629,9 @@ $res .= join(" | ", @users); } elsif ($msg =~ m/^last.*?\s*(\d*)/i) { - foreach my $res (get_from_log( limit => ($1 || 100) )) { + 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 ); @@ -595,6 +688,36 @@ } 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) { @@ -722,18 +845,37 @@ .nick { color: #000000; font-size: 80%; padding: 2px; font-family: courier, courier new, monospace ; } .message { color: #000000; font-size: 100%; } .search { float: right; } +a:link.tag, a:visited.tag { border: 1px dashed #ccc; backgound: #ccc; text-decoration: none } +a:hover.tag { border: 1px solid #eee } +hr { border: 1px dashed #ccc; height: 1px; clear: both; } +/* .col-0 { background: #ffff66 } .col-1 { background: #a0ffff } .col-2 { background: #99ff99 } .col-3 { background: #ff9999 } .col-4 { background: #ff66ff } -a:link.tag, a:visited.tag { border: 1px dashed #ccc; backgound: #ccc; text-decoration: none } -a:hover.tag { border: 1px solid #eee } -hr { border: 1px dashed #ccc; height: 1px; clear: both; } +*/ +.calendar { border: 1px solid red; width: 100%; } +.month { border: 0px; width: 100%; } _END_OF_STYLE_ my $max_color = 4; +my @cols = qw( + #ffcccc #ccffe6 #ccccff #e6ccff #ffccff #ffcce6 #ff9999 #ffcc99 #ffff99 + #ccff99 #99ff99 #99ffcc #99ccff #9999ff #cc99ff #ff6666 #ffb366 #ffff66 + #66ff66 #66ffb3 #66b3ff #6666ff #ff3333 #33ff33 #3399ff #3333ff #ff3399 + #a0a0a0 #ff0000 #ffff00 #80ff00 #0000ff #8000ff #ff00ff #ff0080 #994d00 + #999900 #009900 #cc0066 #c0c0c0 #ccff99 #99ff33 #808080 #660033 #ffffff +); + +$max_color = 0; +foreach my $c (@cols) { + $style .= ".col-${max_color} { background: $c }\n"; + $max_color++; +} +warn "defined $max_color colors for users...\n"; + my %nick_enumerator; sub root_handler { @@ -767,28 +909,42 @@ qq{

}; if ($request->url =~ m#/history#) { my $sth = $dbh->prepare(qq{ - select date(time) as date,count(*) as nr + select date(time) as date,count(*) as nr,sum(length(message)) as len from log group by date(time) order by date(time) desc }); $sth->execute(); my ($l_yyyy,$l_mm) = (0,0); + $html .= qq{}; my $cal; + my $ord = 0; while (my $row = $sth->fetchrow_hashref) { # this is probably PostgreSQL specific, expects ISO date my ($yyyy,$mm,$dd) = split(/-/, $row->{date}); if ($yyyy != $l_yyyy || $mm != $l_mm) { - $html .= $cal->as_HTML() if ($cal); + if ( $cal ) { + $html .= qq{}; + $ord++; + $html .= qq{} if ( $ord % 3 == 0 ); + } $cal = new HTML::CalendarMonthSimple('month'=>$mm,'year'=>$yyyy); - $cal->border(2); + $cal->border(1); + $cal->width('30%'); + $cal->cellheight('5em'); + $cal->tableclass('month'); + #$cal->cellclass('day'); + $cal->sunday('SUN'); + $cal->saturday('SAT'); + $cal->weekdays('MON','TUE','WED','THU','FRI'); ($l_yyyy,$l_mm) = ($yyyy,$mm); } $cal->setcontent($dd, qq{ - $row->{nr} + $row->{nr}
$row->{len} }); + } - $html .= $cal->as_HTML() if ($cal); + $html .= qq{
} . $cal->as_HTML() . qq{
} . $cal->as_HTML() . qq{
}; } else { $html .= join("

", @@ -811,9 +967,21 @@ filter => { message => sub { my $m = shift || return; + + # protect HTML from wiki modifications + sub e { + my $t = shift; + return 'uri_unescape{' . uri_escape($t) . '}'; + } + $m =~ s/($escape_re)/$escape{$1}/gs; - $m =~ s#($RE{URI}{HTTP})#$1#gs; - $m =~ s#$tag_regex#$1#g; + $m =~ s#($RE{URI}{HTTP})#e(qq{$1})#egs; + $m =~ s#$tag_regex#e(qq{$1})#egs; + $m =~ s#\*(\w+)\*#$1#gs; + $m =~ s#_(\w+)_#$1#gs; + $m =~ s#\/(\w+)\/#$1#gs; + + $m =~ s#uri_unescape{([^}]+)}#uri_unescape($1)#egs; return $m; }, nick => sub {