--- trunk/irc-logger.pl 2006/06/16 21:28:46 30
+++ trunk/irc-logger.pl 2006/06/24 22:57:26 34
@@ -18,13 +18,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 +40,7 @@
my $DSN = 'DBI:Pg:dbname=' . $NICK;
my $ENCODING = 'ISO-8859-2';
+my $TIMESTAMP = '%Y-%m-%d %H:%M:%S';
## END CONFIG
@@ -48,6 +53,7 @@
use Regexp::Common qw /URI/;
use CGI::Simple;
use HTML::TagCloud;
+use POSIX qw/strftime/;
my $dbh = DBI->connect($DSN,"","", { RaiseError => 1, AutoCommit => 1 }) || die $DBI::errstr;
@@ -83,6 +89,7 @@
});
my $tags;
+my $tag_regex = '\b([\w-_]+)//';
=head2 get_from_log
@@ -267,8 +274,7 @@
POE::Component::IRC->new($IRC_ALIAS);
-POE::Session->create
- (inline_states =>
+POE::Session->create( inline_states =>
{_start => sub {
$_[KERNEL]->post($IRC_ALIAS => register => 'all');
$_[KERNEL]->post($IRC_ALIAS => connect => $CONNECT);
@@ -394,30 +400,13 @@
# warn "## indetify $NICK\n";
# $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "IDENTIFY $NICK" );
# },
- irc_372 => sub {
- print "MOTD: ", $_[ARG1], "\n";
- },
- irc_snotice => sub {
- print "(server notice): ", $_[ARG0], "\n";
- },
- (map
- {
- ;"irc_$_" => sub { }}
- qw(
- )),
-# join
-# ctcp_version
-# connected snotice ctcp_action ping notice mode part quit
-# 001 002 003 004 005
-# 250 251 252 253 254 265 266
-# 332 333 353 366 372 375 376
-# 477
_child => sub {},
_default => sub {
- printf "%s: session %s caught an unhandled %s event.\n",
- scalar localtime(), $_[SESSION]->ID, $_[ARG0];
- print "The $_[ARG0] event was given these parameters: ",
- join(" ", map({"ARRAY" eq ref $_ ? "[@$_]" : "$_"} @{$_[ARG1]})), "\n";
+ printf "%s #%s %s %s\n",
+ strftime($TIMESTAMP,localtime()), $_[SESSION]->ID, $_[ARG0],
+ ref($_[ARG1]) eq "ARRAY" ? join(",", map { ref($_) eq "ARRAY" ? join(";", @{$_}) : $_ } @{ $_[ARG1] }) :
+ $_[ARG1] ? $_[ARG1] :
+ "";
0; # false for signals
},
my_add => sub {
@@ -501,10 +490,12 @@
my $m = $arg->{message};
from_to('UTF-8', 'iso-8859-2', $m) if (is_utf8($m));
- while ($m =~ s#\b([\w-_]+)//##s) {
+ 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);
}
}
@@ -551,6 +542,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;
@@ -579,12 +572,12 @@
$cloud->css .
qq{} .
qq{
-
} .
- qq{} . $cloud->html(500) . qq{
} .
+ $cloud->html(500) .
qq{} .
join("
",
get_from_log(
@@ -604,6 +597,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 {