--- trunk/irc-logger.pl 2006/05/20 10:30:45 26
+++ trunk/irc-logger.pl 2006/06/25 17:40:59 37
@@ -10,6 +10,14 @@
./irc-logger.pl
+=head2 Options
+
+=over 4
+
+=item --import-dircproxy=filename
+
+Import log from C to C database
+
=head1 DESCRIPTION
log all conversation on irc channel
@@ -18,13 +26,17 @@
## CONFIG
+my $HOSTNAME = `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";
my %FOLLOWS =
@@ -36,6 +48,7 @@
my $DSN = 'DBI:Pg:dbname=' . $NICK;
my $ENCODING = 'ISO-8859-2';
+my $TIMESTAMP = '%Y-%m-%d %H:%M:%S';
## END CONFIG
@@ -44,10 +57,19 @@
use POE qw(Component::IRC Wheel::FollowTail Component::Server::HTTP);
use HTTP::Status;
use DBI;
-use Encode qw/from_to/;
+use Encode qw/from_to is_utf8/;
use Regexp::Common qw /URI/;
use CGI::Simple;
-
+use HTML::TagCloud;
+use POSIX qw/strftime/;
+use HTML::CalendarMonthSimple;
+use Getopt::Long;
+use DateTime;
+
+my $import_dircproxy;
+GetOptions(
+ 'import-dircproxy:s' => \$import_dircproxy,
+);
my $dbh = DBI->connect($DSN,"","", { RaiseError => 1, AutoCommit => 1 }) || die $DBI::errstr;
@@ -78,10 +100,13 @@
my $sth = $dbh->prepare(qq{
insert into log
- (channel, me, nick, message)
-values (?,?,?,?)
+ (channel, me, nick, message, time)
+values (?,?,?,?,?)
});
+my $tags;
+my $tag_regex = '\b([\w-_]+)//';
+
=head2 get_from_log
my @messages = get_from_log(
@@ -113,8 +138,6 @@
sub get_from_log {
my $args = {@_};
- $args->{limit} ||= 10;
-
$args->{fmt} ||= {
date => '[%s] ',
time => '{%s} ',
@@ -146,8 +169,10 @@
my $sql = $context ? $sql_context : $sql_message;
$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});
$sql .= " order by log.time desc";
- $sql .= " limit " . $args->{limit};
+ $sql .= " limit " . $args->{limit} if ($args->{limit});
my $sth = $dbh->prepare( $sql );
if (my $search = $args->{search}) {
@@ -155,6 +180,12 @@
$search =~ s/\s+$//;
$sth->execute( ( '%' . $search . '%' ) x 2 );
warn "search for '$search' returned ", $sth->rows, " results ", $context || '', "\n";
+ } elsif (my $tag = $args->{tag}) {
+ $sth->execute();
+ warn "tag '$tag' returned ", $sth->rows, " results ", $context || '', "\n";
+ } elsif (my $date = $args->{date}) {
+ $sth->execute($date);
+ warn "found ", $sth->rows, " messages for date $date ", $context || '', "\n";
} else {
$sth->execute();
}
@@ -199,19 +230,29 @@
}
}
+ # sprintf which can take coderef as first parametar
+ sub cr_sprintf {
+ my $fmt = shift || return;
+ if (ref($fmt) eq 'CODE') {
+ $fmt->(@_);
+ } else {
+ sprintf($fmt, @_);
+ }
+ }
+
foreach my $row (@rows) {
$row->{time} =~ s#\.\d+##;
my $msg = '';
- $msg = sprintf($args->{fmt}->{date}, $row->{date}) . ' ' if ($last_row->{date} ne $row->{date});
+ $msg = cr_sprintf($args->{fmt}->{date}, $row->{date}) . ' ' if ($last_row->{date} ne $row->{date});
my $t = $row->{time};
if ($last_row->{channel} ne $row->{channel}) {
- $msg .= sprintf($args->{fmt}->{time_channel}, $t, $row->{channel});
+ $msg .= cr_sprintf($args->{fmt}->{time_channel}, $t, $row->{channel});
} else {
- $msg .= sprintf($args->{fmt}->{time}, $t);
+ $msg .= cr_sprintf($args->{fmt}->{time}, $t);
}
my $append = 1;
@@ -228,19 +269,19 @@
$nick = $args->{filter}->{nick}->($nick) if (ref($args->{filter}->{nick}) eq 'CODE');
- $msg .= sprintf( $fmt, $nick );
+ $msg .= cr_sprintf( $fmt, $nick );
$append = 0;
}
$args->{fmt}->{message} ||= '%s';
if (ref($args->{filter}->{message}) eq 'CODE') {
- $msg .= sprintf($args->{fmt}->{message},
+ $msg .= cr_sprintf($args->{fmt}->{message},
$args->{filter}->{message}->(
$row->{message}
)
);
} else {
- $msg .= sprintf($args->{fmt}->{message}, $row->{message});
+ $msg .= cr_sprintf($args->{fmt}->{message}, $row->{message});
}
if ($append && @msgs) {
@@ -255,14 +296,132 @@
return @msgs;
}
+# tags support
+
+my $cloud = HTML::TagCloud->new;
+
+=head2 add_tag
+
+ add_tag( id => 42, message => 'irc message' );
+
+=cut
+
+sub add_tag {
+ my $arg = {@_};
+
+ return unless ($arg->{id} && $arg->{message});
+
+ my $m = $arg->{message};
+ from_to('UTF-8', 'iso-8859-2', $m) if (is_utf8($m));
+
+ while ($m =~ s#$tag_regex##s) {
+ my $tag = $1;
+ next if (! $tag || $tag =~ m/https?:/i);
+ push @{ $tags->{$tag} }, $arg->{id};
+ #warn "+tag $tag: $arg->{id}\n";
+ $cloud->add($tag, "?tag=$tag", scalar @{$tags->{$tag}} + 1);
+ }
+}
+
+=head2 seed_tags
+
+Read all tags from database and create in-memory cache for tags
+
+=cut
+
+sub seed_tags {
+ my $sth = $dbh->prepare(qq{ select id,message from log where message like '%//%' });
+ $sth->execute;
+ while (my $row = $sth->fetchrow_hashref) {
+ add_tag( %$row );
+ }
+
+ foreach my $tag (keys %$tags) {
+ $cloud->add($tag, "?tag=$tag", scalar @{$tags->{$tag}} + 1);
+ }
+}
+
+seed_tags;
+
+
+=head2 save_message
+
+ save_message(
+ channel => '#foobar',
+ me => 0,
+ nick => 'dpavlin',
+ msg => 'test message',
+ time => '2006-06-25 18:57:18',
+ );
+
+C
}
- );
+ );
+ }
+
+ $html .= qq{
+
+ See history of all messages.
+ };
+
+ $response->content( $html );
return RC_OK;
}