/[irc-logger]/trunk/bin/irc-logger.pl
This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!
ViewVC logotype

Diff of /trunk/bin/irc-logger.pl

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 132 by dpavlin, Tue Apr 1 19:04:32 2008 UTC revision 133 by dpavlin, Sat Apr 5 21:08:27 2008 UTC
# Line 7  use HTTP::Status; Line 7  use HTTP::Status;
7  use DBI;  use DBI;
8  use Regexp::Common qw /URI/;  use Regexp::Common qw /URI/;
9  use CGI::Simple;  use CGI::Simple;
 use HTML::TagCloud;  
10  use POSIX qw/strftime/;  use POSIX qw/strftime/;
11  use HTML::CalendarMonthSimple;  use HTML::CalendarMonthSimple;
12  use Getopt::Long;  use Getopt::Long;
# Line 128  open(STDOUT, '>', $log_path) && warn "lo Line 127  open(STDOUT, '>', $log_path) && warn "lo
127  my %escape = ('<'=>'&lt;', '>'=>'&gt;', '&'=>'&amp;', '"'=>'&quot;');  my %escape = ('<'=>'&lt;', '>'=>'&gt;', '&'=>'&amp;', '"'=>'&quot;');
128  my $escape_re  = join '|' => keys %escape;  my $escape_re  = join '|' => keys %escape;
129    
130  my $tag_regex = '\b([\w-_]+)//';  my $tag_regex = '\b([\w\-_]+)//';
131    
132  my %nick_enumerator;  my %nick_enumerator;
133  my $max_color = 0;  my $max_color = 0;
# Line 526  sub get_from_log { Line 525  sub get_from_log {
525    
526  # tags support  # tags support
527    
528  my $cloud = HTML::TagCloud->new;  my $cloud = TagCloud->new;
529    $cloud->seed_tags;
 =head2 add_tag  
   
  add_tag( id => 42, message => 'irc message', nick => 'foobar' [, me => 1 ] );  
   
 =cut  
   
 my @last_tags;  
   
 sub add_tag {  
         my $arg = {@_};  
   
         return unless ($arg->{id} && $arg->{message});  
   
         my $m = $arg->{message};  
   
         my @tags;  
   
         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, "$url?tag=$tag", scalar @{$tags->{$tag}} + 1);  
                 push @tags, $tag;  
   
         }  
   
         if ( @tags ) {  
                 pop @last_tags if $#last_tags == $last_x_tags;  
                 unshift @last_tags, { tags => [ @tags ], %$arg };  
         }  
   
 }  
   
 =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,nick,me,time from log where message like '%//%' order by time asc });  
         $sth->execute;  
         while (my $row = $sth->fetchrow_hashref) {  
                 add_tag( %$row );  
         }  
   
         foreach my $tag (keys %$tags) {  
                 $cloud->add($tag, "$url?tag=$tag", scalar @{$tags->{$tag}} + 1);  
         }  
 }  
   
 seed_tags;  
   
530    
531  =head2 save_message  =head2 save_message
532    
# Line 612  sub save_message { Line 557  sub save_message {
557    
558          eval { $sth_insert_log->execute($a->{channel}, $a->{me}, $a->{nick}, $a->{message}, $a->{time}); };          eval { $sth_insert_log->execute($a->{channel}, $a->{me}, $a->{nick}, $a->{message}, $a->{time}); };
559          _log "ERROR: can't archive ", $a->{message} if $@;          _log "ERROR: can't archive ", $a->{message} if $@;
560          add_tag( id => $dbh->last_insert_id(undef,undef,"log",undef), %$a );          $cloud->add_tag( id => $dbh->last_insert_id(undef,undef,"log",undef), %$a );
561  }  }
562    
563    
# Line 1241  sub root_handler { Line 1186  sub root_handler {
1186                  $response->content_type( 'application/' . lc($type) . '+xml' );                  $response->content_type( 'application/' . lc($type) . '+xml' );
1187    
1188                  my $html = '<!-- error -->';                  my $html = '<!-- error -->';
1189                  #warn "create $type feed from ",dump( @last_tags );                  #warn "create $type feed from ",dump( $cloud->last_tags );
1190    
1191                  my $feed = XML::Feed->new( $type );                  my $feed = XML::Feed->new( $type );
1192                  $feed->link( $url );                  $feed->link( $url );
# Line 1275  sub root_handler { Line 1220  sub root_handler {
1220                          $feed->title( "last $nr tagged messages from $CHANNEL" );                          $feed->title( "last $nr tagged messages from $CHANNEL" );
1221                          $feed->description( "collects messages which have tags// in them" );                          $feed->description( "collects messages which have tags// in them" );
1222    
1223                          foreach my $m ( @last_tags ) {                          foreach my $m ( $cloud->last_tags ) {
1224  #                               warn dump( $m );  #                               warn dump( $m );
1225                                  #my $tags = join(' ', @{$m->{tags}} );                                  #my $tags = join(' ', @{$m->{tags}} );
1226                                  my $feed_entry = XML::Feed::Entry->new($type);                                  my $feed_entry = XML::Feed::Entry->new($type);
# Line 1436  sub root_handler { Line 1381  sub root_handler {
1381  }  }
1382    
1383  POE::Kernel->run;  POE::Kernel->run;
1384    
1385    =head1 TagCloud
1386    
1387    Extended L<HTML::TagCloud>
1388    
1389    =cut
1390    
1391    package TagCloud;
1392    use warnings;
1393    use strict;
1394    use HTML::TagCloud;
1395    use base 'HTML::TagCloud';
1396    use Data::Dump qw/dump/;
1397    
1398    =head2 html
1399    
1400    Generate html with number of tags in title of link
1401    
1402    =cut
1403    
1404    sub html {
1405            my($self, $limit) = @_;
1406            my @tags=$self->tags($limit);
1407    
1408            my $ntags = scalar(@tags);
1409            if ($ntags == 0) {
1410                    return "";
1411    #       } elsif ($ntags == 1) {
1412    #               my $tag = $tags[0];
1413    #               return qq{<div id="htmltagcloud"><span class="tagcloud1"><a href="}.
1414    #               $tag->{url}.qq{">}.$tag->{name}.qq{</a></span></div>\n};
1415            }
1416    
1417      my $html = qq{<div id="htmltagcloud">};
1418      foreach my $tag (@tags) {
1419        $html .=  sprintf(qq{<span class="tag tagcloud%d"><a href="%s" title="%s">%s</a></span>\n},
1420                    $tag->{level}, $tag->{url}, $tag->{count}, $tag->{name}
1421            );
1422      }
1423      $html .= qq{</div>};
1424      return $html;
1425    }
1426    
1427    =head2 last_tags
1428    
1429      my @tags = $cloud->last_tags;
1430    
1431    =cut
1432    
1433    my @last_tags;
1434    sub last_tags {
1435            return @last_tags;
1436    }
1437    
1438    =head2 add_tag
1439    
1440     $cloud->add_tag( id => 42, message => 'irc message', nick => 'foobar' [, me => 1 ] );
1441    
1442    =cut
1443    
1444    
1445    sub add_tag {
1446            my $self = shift;
1447            my $arg = {@_};
1448    
1449            return unless ($arg->{id} && $arg->{message});
1450    
1451            my $m = $arg->{message};
1452    
1453            my @tags;
1454    
1455            while ($m =~ s#$tag_regex##s) {
1456                    my $tag = $1;
1457                    next if (! $tag || $tag =~ m/https?:/i);
1458                    push @{ $tags->{$tag} }, $arg->{id};
1459                    #warn "+tag $tag: $arg->{id}\n";
1460                    $self->add($tag, "$url?tag=$tag", scalar @{$tags->{$tag}});
1461                    push @tags, $tag;
1462    
1463            }
1464    
1465            if ( @tags ) {
1466                    pop @last_tags if $#last_tags == $last_x_tags;
1467                    unshift @last_tags, { tags => [ @tags ], %$arg };
1468            }
1469    
1470    }
1471    
1472    =head2 seed_tags
1473    
1474    Read all tags from database and create in-memory cache for tags
1475    
1476    =cut
1477    
1478    sub seed_tags {
1479            my $self = shift;
1480            my $sth = $dbh->prepare(qq{ select id,message,nick,me,time from log where message like '%//%' order by time asc });
1481            $sth->execute;
1482            while (my $row = $sth->fetchrow_hashref) {
1483                    $self->add_tag( %$row );
1484            }
1485    
1486            foreach my $tag (keys %$tags) {
1487                    $self->add($tag, "$url?tag=$tag", scalar @{$tags->{$tag}});
1488            }
1489    }
1490    

Legend:
Removed from v.132  
changed lines
  Added in v.133

  ViewVC Help
Powered by ViewVC 1.1.26