--- trunk/irc-logger.pl 2006/03/18 16:02:32 21
+++ trunk/irc-logger.pl 2006/06/24 22:15:47 33
@@ -18,13 +18,17 @@
## CONFIG
-my $NICK = 'irc-logger-dev';
+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 =
@@ -44,10 +48,10 @@
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;
my $dbh = DBI->connect($DSN,"","", { RaiseError => 1, AutoCommit => 1 }) || die $DBI::errstr;
@@ -82,6 +86,9 @@
values (?,?,?,?)
});
+my $tags;
+my $tag_regex = '\b([\w-_]+)//';
+
=head2 get_from_log
my @messages = get_from_log(
@@ -116,6 +123,7 @@
$args->{limit} ||= 10;
$args->{fmt} ||= {
+ date => '[%s] ',
time => '{%s} ',
time_channel => '{%s %s} ',
nick => '%s: ',
@@ -144,7 +152,8 @@
my $sql = $context ? $sql_context : $sql_message;
- $sql .= " where message ilike ? " if ($args->{search});
+ $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 .= " order by log.time desc";
$sql .= " limit " . $args->{limit};
@@ -152,8 +161,11 @@
if (my $search = $args->{search}) {
$search =~ s/^\s+//;
$search =~ s/\s+$//;
- $sth->execute( '%' . $search . '%' );
+ $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";
} else {
$sth->execute();
}
@@ -202,12 +214,11 @@
$row->{time} =~ s#\.\d+##;
- my $t;
- $t = $row->{date} . ' ' if ($last_row->{date} ne $row->{date});
- $t .= $row->{time};
-
my $msg = '';
+ $msg = 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});
} else {
@@ -216,12 +227,16 @@
my $append = 1;
- if ($last_row->{nick} ne $row->{nick}) {
+ my $nick = $row->{nick};
+ if ($nick =~ s/^_*(.*?)_*$/$1/) {
+ $row->{nick} = $nick;
+ }
+
+ 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};
$fmt ||= '%s';
- my $nick = $row->{nick};
$nick = $args->{filter}->{nick}->($nick) if (ref($args->{filter}->{nick}) eq 'CODE');
$msg .= sprintf( $fmt, $nick );
@@ -280,6 +295,8 @@
print "$channel: <$nick> $msg\n";
$sth->execute($channel, 0, $nick, $msg);
+ add_tag( id => $dbh->last_insert_id(undef,undef,"log",undef),
+ message => $msg);
},
irc_ctcp_action => sub {
my $kernel = $_[KERNEL];
@@ -291,6 +308,8 @@
print "$channel ***$nick $msg\n";
$sth->execute($channel, 1, $nick, $msg);
+ add_tag( id => $dbh->last_insert_id(undef,undef,"log",undef),
+ message => $msg);
},
irc_msg => sub {
my $kernel = $_[KERNEL];
@@ -469,6 +488,53 @@
},
);
+# 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;
+
# http server
my $httpd = POE::Component::Server::HTTP->new(
@@ -483,6 +549,7 @@
my $style = <<'_END_OF_STYLE_';
p { margin: 0; padding: 0.1em; }
.time, .channel { color: #808080; font-size: 60%; }
+.date { float: right; background: #e0e0e0; color: #404040; font-size: 120%; padding: 0.25em; border: 1px dashed #808080; }
.nick { color: #000000; font-size: 80%; padding: 2px; font-family: courier, courier new, monospace ; }
.message { color: #000000; font-size: 100%; }
.search { float: right; }
@@ -491,6 +558,8 @@
.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 }
_END_OF_STYLE_
my $max_color = 4;
@@ -515,18 +584,24 @@
my $search = $q->param('search') || $q->param('grep') || '';
$response->content(
- qq{$NICK
-
-
} .
+ $cloud->html(500) .
+ qq{
} .
join("
",
get_from_log(
- limit => $q->param('limit') || 100,
- search => $q->param('search') || $q->param('grep') || undef,
+ limit => $q->param('last') || 100,
+ search => $search || undef,
+ tag => $q->param('tag') || undef,
fmt => {
+ date => '
%s
',
time => '%s ',
time_channel => '%s %s ',
nick => '%s: ',
@@ -538,6 +613,7 @@
my $m = shift || return;
$m =~ s/($escape_re)/$escape{$1}/gs;
$m =~ s#($RE{URI}{HTTP})#$1#gs;
+ $m =~ s#$tag_regex#$1#g;
return $m;
},
nick => sub {