/[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 71 by dpavlin, Sun Dec 16 18:51:05 2007 UTC revision 94 by dpavlin, Fri Mar 7 10:50:16 2008 UTC
# Line 20  Import log from C<dircproxy> to C<irc-lo Line 20  Import log from C<dircproxy> to C<irc-lo
20    
21  =item --log=irc-logger.log  =item --log=irc-logger.log
22    
 Name of log file  
   
23  =back  =back
24    
25  =head1 DESCRIPTION  =head1 DESCRIPTION
# Line 32  log all conversation on irc channel Line 30  log all conversation on irc channel
30    
31  ## CONFIG  ## CONFIG
32    
33  my $HOSTNAME = `hostname`;  my $HOSTNAME = `hostname -f`;
34    chomp($HOSTNAME);
35    
36  my $NICK = 'irc-logger';  my $NICK = 'irc-logger';
37  $NICK .= '-dev' if ($HOSTNAME =~ m/llin/);  $NICK .= '-dev' if ($HOSTNAME =~ m/llin/);
# Line 45  my $CHANNEL = '#razmjenavjestina'; Line 44  my $CHANNEL = '#razmjenavjestina';
44  $CHANNEL = '#irc-logger' if ($HOSTNAME =~ m/llin/);  $CHANNEL = '#irc-logger' if ($HOSTNAME =~ m/llin/);
45  my $IRC_ALIAS = "log";  my $IRC_ALIAS = "log";
46    
 my %FOLLOWS =  
   (  
    ACCESS => "/var/log/apache/access.log",  
    ERROR => "/var/log/apache/error.log",  
   );  
   
47  my $DSN = 'DBI:Pg:dbname=' . $NICK;  my $DSN = 'DBI:Pg:dbname=' . $NICK;
48    
 my $ENCODING = 'ISO-8859-2';  
49  my $TIMESTAMP = '%Y-%m-%d %H:%M:%S';  my $TIMESTAMP = '%Y-%m-%d %H:%M:%S';
50    
51  my $sleep_on_error = 5;  my $sleep_on_error = 5;
52    
53  my $http_port = $NICK =~ m/-dev/ ? 8001 : 8000;  # number of last tags to keep in circular buffer
54  my $http_hostname = `hostname`;  my $last_x_tags = 50;
 chomp( $http_hostname );  
55    
56  ## END CONFIG  # don't pull rss feeds more often than this
57    my $rss_min_delay = 60;
58    $rss_min_delay = 15;
59    
60    my $http_port = $NICK =~ m/-dev/ ? 8001 : 8000;
61    
62    my $url = "http://$HOSTNAME:$http_port";
63    
64    ## END CONFIG
65    
66  use POE qw(Component::IRC Wheel::FollowTail Component::Server::HTTP);  use POE qw(Component::IRC Component::Server::HTTP);
67  use HTTP::Status;  use HTTP::Status;
68  use DBI;  use DBI;
 use Encode qw/from_to is_utf8/;  
69  use Regexp::Common qw /URI/;  use Regexp::Common qw /URI/;
70  use CGI::Simple;  use CGI::Simple;
71  use HTML::TagCloud;  use HTML::TagCloud;
# Line 95  GetOptions( Line 91  GetOptions(
91          'log:s' => \$log_path,          'log:s' => \$log_path,
92  );  );
93    
94  $SIG{__DIE__} = sub {  #$SIG{__DIE__} = sub {
95          confess "fatal error";  #       confess "fatal error";
96  };  #};
97    
98  open(STDOUT, '>', $log_path) || warn "can't redirect log to $log_path: $!";  open(STDOUT, '>', $log_path) || warn "can't redirect log to $log_path: $!";
99    
100  sub _log {  sub _log {
101          print strftime($TIMESTAMP,localtime()), ' ', join(" ",@_), $/;          print strftime($TIMESTAMP,localtime()) . ' ' . join(" ",@_) . $/;
102  }  }
103    
104  # HTML formatters  # HTML formatters
# Line 128  my $filter = { Line 124  my $filter = {
124                  $m =~ s/($escape_re)/$escape{$1}/gs;                  $m =~ s/($escape_re)/$escape{$1}/gs;
125                  $m =~ s#($RE{URI}{HTTP})#e(qq{<a href="$1">$1</a>})#egs ||                  $m =~ s#($RE{URI}{HTTP})#e(qq{<a href="$1">$1</a>})#egs ||
126                  $m =~ s#\/(\w+)\/#<i>$1</i>#gs;                  $m =~ s#\/(\w+)\/#<i>$1</i>#gs;
127                  $m =~ s#$tag_regex#e(qq{<a href="?tag=$1" class="tag">$1</a>})#egs;                  $m =~ s#$tag_regex#e(qq{<a href="$url?tag=$1" class="tag">$1</a>})#egs;
128                  $m =~ s#\*(\w+)\*#<b>$1</b>#gs;                  $m =~ s#\*(\w+)\*#<b>$1</b>#gs;
129                  $m =~ s#_(\w+)_#<u>$1</u>#gs;                  $m =~ s#_(\w+)_#<u>$1</u>#gs;
130    
# Line 148  my $filter = { Line 144  my $filter = {
144  };  };
145    
146  my $dbh = DBI->connect($DSN,"","", { RaiseError => 1, AutoCommit => 1 }) || die $DBI::errstr;  my $dbh = DBI->connect($DSN,"","", { RaiseError => 1, AutoCommit => 1 }) || die $DBI::errstr;
147    $dbh->do( qq{ set client_encoding = 'UTF-8' } );
148    
149  my $sql_schema = {  my $sql_schema = {
150          log => '          log => qq{
151  create table log (  create table log (
152          id serial,          id serial,
153          time timestamp default now(),          time timestamp default now(),
# Line 164  create table log ( Line 161  create table log (
161  create index log_time on log(time);  create index log_time on log(time);
162  create index log_channel on log(channel);  create index log_channel on log(channel);
163  create index log_nick on log(nick);  create index log_nick on log(nick);
164          ',          },
165          meta => '          meta => q{
166  create table meta (  create table meta (
167          nick text not null,          nick text not null,
168          channel text not null,          channel text not null,
169          name text not null,          name text not null,
170          value text,          value text,
171          changed timestamp default now(),          changed timestamp default 'now()',
172          primary key(nick,channel,name)          primary key(nick,channel,name)
173  );  );
174          ',          },
175            feeds => qq{
176    create table feeds (
177            id serial,
178            url text not null,
179            name text,
180            delay interval not null default '5 min',
181            active boolean default true,
182            last_update timestamp default 'now()',
183            polls int default 0,
184            updates int default 0
185    );
186    create unique index feeds_url on feeds(url);
187    insert into feeds (url,name) values ('http://wiki.razmjenavjestina.org/feed/workspace/razmjenavjestina?category=Recent%20Changes','wiki');
188            },
189  };  };
190    
191  foreach my $table ( keys %$sql_schema ) {  foreach my $table ( keys %$sql_schema ) {
# Line 238  sub meta { Line 249  sub meta {
249    
250    
251    
252  my $sth = $dbh->prepare(qq{  my $sth_insert_log = $dbh->prepare(qq{
253  insert into log  insert into log
254          (channel, me, nick, message, time)          (channel, me, nick, message, time)
255  values (?,?,?,?,?)  values (?,?,?,?,?)
# Line 482  my $cloud = HTML::TagCloud->new; Line 493  my $cloud = HTML::TagCloud->new;
493    
494  =cut  =cut
495    
 my $last_x_tags = 5;  
496  my @last_tags;  my @last_tags;
497    
498  sub add_tag {  sub add_tag {
# Line 491  sub add_tag { Line 501  sub add_tag {
501          return unless ($arg->{id} && $arg->{message});          return unless ($arg->{id} && $arg->{message});
502    
503          my $m = $arg->{message};          my $m = $arg->{message};
         from_to('UTF-8', 'iso-8859-2', $m) if (is_utf8($m));  
504    
505          my @tags;          my @tags;
506    
# Line 500  sub add_tag { Line 509  sub add_tag {
509                  next if (! $tag || $tag =~ m/https?:/i);                  next if (! $tag || $tag =~ m/https?:/i);
510                  push @{ $tags->{$tag} }, $arg->{id};                  push @{ $tags->{$tag} }, $arg->{id};
511                  #warn "+tag $tag: $arg->{id}\n";                  #warn "+tag $tag: $arg->{id}\n";
512                  $cloud->add($tag, "?tag=$tag", scalar @{$tags->{$tag}} + 1);                  $cloud->add($tag, "$url?tag=$tag", scalar @{$tags->{$tag}} + 1);
513                  push @tags, $tag;                  push @tags, $tag;
514    
515          }          }
516    
517          if ( @tags ) {          if ( @tags ) {
518                  shift @last_tags if $#last_tags == $last_x_tags;                  pop @last_tags if $#last_tags == $last_x_tags;
519                  push @last_tags, { tags => [ @tags ], %$arg };                  unshift @last_tags, { tags => [ @tags ], %$arg };
520          }          }
521    
522  }  }
# Line 519  Read all tags from database and create i Line 528  Read all tags from database and create i
528  =cut  =cut
529    
530  sub seed_tags {  sub seed_tags {
531          my $sth = $dbh->prepare(qq{ select id,message,nick,me,time from log where message like '%//%' });          my $sth = $dbh->prepare(qq{ select id,message,nick,me,time from log where message like '%//%' order by time asc });
532          $sth->execute;          $sth->execute;
533          while (my $row = $sth->fetchrow_hashref) {          while (my $row = $sth->fetchrow_hashref) {
534                  add_tag( %$row );                  add_tag( %$row );
535          }          }
536    
537          foreach my $tag (keys %$tags) {          foreach my $tag (keys %$tags) {
538                  $cloud->add($tag, "?tag=$tag", scalar @{$tags->{$tag}} + 1);                  $cloud->add($tag, "$url?tag=$tag", scalar @{$tags->{$tag}} + 1);
539          }          }
540  }  }
541    
# Line 560  sub save_message { Line 569  sub save_message {
569                  $a->{me} ? "***" . $a->{nick} : "<" . $a->{nick} . ">",                  $a->{me} ? "***" . $a->{nick} : "<" . $a->{nick} . ">",
570                  " " . $a->{message};                  " " . $a->{message};
571    
572          from_to($a->{message}, 'UTF-8', $ENCODING);          $sth_insert_log->execute($a->{channel}, $a->{me}, $a->{nick}, $a->{message}, $a->{time});
   
         $sth->execute($a->{channel}, $a->{me}, $a->{nick}, $a->{message}, $a->{time});  
573          add_tag( id => $dbh->last_insert_id(undef,undef,"log",undef), %$a );          add_tag( id => $dbh->last_insert_id(undef,undef,"log",undef), %$a );
574  }  }
575    
# Line 601  if ($import_dircproxy) { Line 608  if ($import_dircproxy) {
608          exit;          exit;
609  }  }
610    
611    #
612    # RSS follow
613    #
614    
615    my $_rss;
616    
617    
618    sub rss_fetch {
619            my ($args) = @_;
620    
621            # how many messages to send out when feed is seen for the first time?
622            my $send_rss_msgs = 1;
623    
624            _log "RSS fetch", $args->{url};
625    
626            my $feed = XML::Feed->parse(URI->new( $args->{url} ));
627            if ( ! $feed ) {
628                    _log("can't fetch RSS ", $args->{url});
629                    return;
630            }
631    
632            my ( $total, $updates ) = ( 0, 0 );
633            for my $entry ($feed->entries) {
634                    $total++;
635    
636                    # seen allready?
637                    next if $_rss->{$feed->link}->{seen}->{$entry->id}++ > 0;
638    
639                    sub prefix {
640                            my ($txt,$var) = @_;
641                            $var =~ s/\s+/ /gs;
642                            $var =~ s/^\s+//g;
643                            $var =~ s/\s+$//g;
644                            return $txt . $var if $var;
645                    }
646    
647                    # fix absolute and relative links to feed entries
648                    my $link = $entry->link;
649                    if ( $link =~ m!^/! ) {
650                            my $host = $args->{url};
651                            $host =~ s!^(http://[^/]+).*$!$1!;      #!vim
652                            $link = "$host/$link";
653                    } elsif ( $link !~ m!^http! ) {
654                            $link = $args->{url} . $link;
655                    }
656                    $link =~ s!//+!/!g;
657    
658                    my $msg;
659                    $msg .= prefix( 'From: ' , $args->{name} || $feed->title );
660                    $msg .= prefix( ' by ' , $entry->author );
661                    $msg .= prefix( ' | ' , $entry->title );
662                    $msg .= prefix( ' | ' , $link );
663    #               $msg .= prefix( ' id ' , $entry->id );
664    
665                    if ( $args->{kernel} && $send_rss_msgs ) {
666                            $send_rss_msgs--;
667                            _log('>>', $msg);
668                            $sth_insert_log->execute( $CHANNEL, 1, $NICK, $msg, 'now()' );
669                            $args->{kernel}->post( $IRC_ALIAS => notice => $CHANNEL, $msg );
670                            $updates++;
671                    }
672            }
673    
674            my $sql = qq{ update feeds set last_update = now(), polls = polls + 1 };
675            $sql .= qq{, updates = updates + $updates } if $updates;
676            $sql .= qq{where id = } . $args->{id};
677            eval { $dbh->do( $sql ) };
678    
679            _log "RSS got $total items of which $updates new";
680    
681            return $updates;
682    }
683    
684    sub rss_fetch_all {
685            my $kernel = shift;
686            my $sql = qq{
687                    select id, url, name
688                    from feeds
689                    where active is true
690            };
691            # limit to newer feeds only if we are not sending messages out
692            $sql .= qq{     and last_update + delay < now() } if $kernel;
693            my $sth = $dbh->prepare( $sql );
694            $sth->execute();
695            warn "# ",$sth->rows," active RSS feeds\n";
696            my $count = 0;
697            while (my $row = $sth->fetchrow_hashref) {
698                    $row->{kernel} = $kernel if $kernel;
699                    $count += rss_fetch( $row );
700            }
701            return "OK, fetched $count posts from " . $sth->rows . " feeds";
702    }
703    
704    
705    sub rss_check_updates {
706            my $kernel = shift;
707            my $last_t = $_rss->{last_poll} || time();
708            my $t = time();
709            if ( $t - $last_t > $rss_min_delay ) {
710                    $_rss->{last_poll} = $t;
711                    _log rss_fetch_all( $kernel );
712            }
713    }
714    
715    # seed rss seen cache so we won't send out all items on startup
716    _log rss_fetch_all;
717    
718  #  #
719  # POE handing part  # POE handing part
720  #  #
721    
 my $SKIPPING = 0;               # if skipping, how many we've done  
 my $SEND_QUEUE;                 # cache  
722  my $ping;                                               # ping stats  my $ping;                                               # ping stats
723    
724  POE::Component::IRC->new($IRC_ALIAS);  POE::Component::IRC->new($IRC_ALIAS);
725    
726  POE::Session->create( inline_states =>  POE::Session->create( inline_states => {
727     {_start => sub {                _start => sub {      
728                  $_[KERNEL]->post($IRC_ALIAS => register => 'all');                  $_[KERNEL]->post($IRC_ALIAS => register => 'all');
729                  $_[KERNEL]->post($IRC_ALIAS => connect => $CONNECT);                  $_[KERNEL]->post($IRC_ALIAS => connect => $CONNECT);
730      },      },
731      irc_255 => sub {    # server is done blabbing      irc_255 => sub {    # server is done blabbing
732                  $_[KERNEL]->post($IRC_ALIAS => join => $CHANNEL);                  $_[KERNEL]->post($IRC_ALIAS => join => $CHANNEL);
                 $_[KERNEL]->post($IRC_ALIAS => join => '#logger');  
                 $_[KERNEL]->yield("heartbeat"); # start heartbeat  
 #               $_[KERNEL]->yield("my_add", $_) for keys %FOLLOWS;  
733                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "IDENTIFY $NICK" );                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "IDENTIFY $NICK" );
734      },      },
735      irc_public => sub {      irc_public => sub {
# Line 652  POE::Session->create( inline_states => Line 760  POE::Session->create( inline_states =>
760    
761      },      },
762          irc_ping => sub {          irc_ping => sub {
763                  warn "pong ", $_[ARG0], $/;                  _log( "pong ", $_[ARG0] );
764                  $ping->{ $_[ARG0] }++;                  $ping->{ $_[ARG0] }++;
765                    rss_check_updates( $_[KERNEL] );
766          },          },
767          irc_invite => sub {          irc_invite => sub {
768                  my $kernel = $_[KERNEL];                  my $kernel = $_[KERNEL];
769                  my $nick = (split /!/, $_[ARG0])[0];                  my $nick = (split /!/, $_[ARG0])[0];
770                  my $channel = $_[ARG1];                  my $channel = $_[ARG1];
771    
772                  warn "invited to $channel by $nick";                  _log "invited to $channel by $nick";
773    
774                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, "how nice of you to invite me to $channel, I'll be right there..." );                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, "how nice of you to invite me to $channel, I'll be right there..." );
775                  $_[KERNEL]->post($IRC_ALIAS => join => $channel);                  $_[KERNEL]->post($IRC_ALIAS => join => $channel);
# Line 671  POE::Session->create( inline_states => Line 780  POE::Session->create( inline_states =>
780                  my $nick = (split /!/, $_[ARG0])[0];                  my $nick = (split /!/, $_[ARG0])[0];
781                  my $msg = $_[ARG2];                  my $msg = $_[ARG2];
782                  my $channel = $_[ARG1]->[0];                  my $channel = $_[ARG1]->[0];
                 from_to($msg, 'UTF-8', $ENCODING);  
783    
784                  my $res = "unknown command '$msg', try /msg $NICK help!";                  my $res = "unknown command '$msg', try /msg $NICK help!";
785                  my @out;                  my @out;
# Line 715  POE::Session->create( inline_states => Line 823  POE::Session->create( inline_states =>
823    
824                          foreach my $res (get_from_log( limit => $limit )) {                          foreach my $res (get_from_log( limit => $limit )) {
825                                  _log "last: $res";                                  _log "last: $res";
                                 from_to($res, $ENCODING, 'UTF-8');  
826                                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );                                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );
827                          }                          }
828    
# Line 730  POE::Session->create( inline_states => Line 837  POE::Session->create( inline_states =>
837                                          search => $what,                                          search => $what,
838                                  )) {                                  )) {
839                                  _log "search [$what]: $res";                                  _log "search [$what]: $res";
                                 from_to($res, $ENCODING, 'UTF-8');  
840                                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );                                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );
841                          }                          }
842    
# Line 800  POE::Session->create( inline_states => Line 906  POE::Session->create( inline_states =>
906                                          $res = "config option $op doesn't exist";                                          $res = "config option $op doesn't exist";
907                                  }                                  }
908                          }                          }
909                    } elsif ($msg =~ m/^rss-update/) {
910                            $res = rss_fetch_all( $_[KERNEL] );
911                    } elsif ($msg =~ m/^rss-clean/) {
912                            $_rss = undef;
913                            $dbh->do( qq{ update feeds set last_update = now() - delay } );
914                            $res = "OK, cleaned RSS cache";
915                    } elsif ($msg =~ m/^rss-list/) {
916                            my $sth = $dbh->prepare(qq{ select url,name,last_update,active from feeds });
917                            $sth->execute;
918                            while (my @row = $sth->fetchrow_array) {
919                                    $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, join(' | ',@row) );
920                            }
921                            $res = '';
922                    } elsif ($msg =~ m!^rss-(add|remove|stop|start)\s+(http://\S+)\s*(.*)!) {
923                            my $sql = {
924                                    add             => qq{ insert into feeds (url,name) values (?,?) },
925    #                               remove  => qq{ delete from feeds                                where url = ? and name = ? },
926                                    start   => qq{ update feeds set active = true   where url = ? },
927                                    stop    => qq{ update feeds set active = false  where url = ? },
928                            };
929                            if (my $q = $sql->{$1} ) {
930                                    my $sth = $dbh->prepare( $q );
931                                    my @data = ( $2 );
932                                    push @data, $3 if ( $q =~ s/\?//g == 2 );
933                                    warn "## $1 SQL $q with ",dump( @data ),"\n";
934                                    eval { $sth->execute( @data ) };
935                            }
936    
937                            $res = "OK, RSS $1 : $2 - $3";
938                  }                  }
939    
940                  if ($res) {                  if ($res) {
941                          _log ">> [$nick] $res";                          _log ">> [$nick] $res";
                         from_to($res, $ENCODING, 'UTF-8');  
942                          $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );                          $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );
943                  }                  }
944    
945                    rss_check_updates( $_[KERNEL] );
946          },          },
947          irc_477 => sub {          irc_477 => sub {
948                  _log "# irc_477: ",$_[ARG1];                  _log "# irc_477: ",$_[ARG1];
# Line 846  POE::Session->create( inline_states => Line 981  POE::Session->create( inline_states =>
981                          "";                          "";
982        0;                        # false for signals        0;                        # false for signals
983      },      },
     my_add => sub {  
       my $trailing = $_[ARG0];  
       my $session = $_[SESSION];  
       POE::Session->create  
           (inline_states =>  
            {_start => sub {  
               $_[HEAP]->{wheel} =  
                 POE::Wheel::FollowTail->new  
                     (  
                      Filename => $FOLLOWS{$trailing},  
                      InputEvent => 'got_line',  
                     );  
             },  
             got_line => sub {  
               $_[KERNEL]->post($session => my_tailed =>  
                                time, $trailing, $_[ARG0]);  
             },  
            },  
           );  
       
     },  
     my_tailed => sub {  
       my ($time, $file, $line) = @_[ARG0..ARG2];  
       ## $time will be undef on a probe, or a time value if a real line  
   
       ## PoCo::IRC has throttling built in, but no external visibility  
       ## so this is reaching "under the hood"  
       $SEND_QUEUE ||=  
         $_[KERNEL]->alias_resolve($IRC_ALIAS)->get_heap->{send_queue};  
   
       ## handle "no need to keep skipping" transition  
       if ($SKIPPING and @$SEND_QUEUE < 1) {  
         $_[KERNEL]->post($IRC_ALIAS => privmsg => $CHANNEL =>  
                          "[discarded $SKIPPING messages]");  
         $SKIPPING = 0;  
       }  
   
       ## handle potential message display  
       if ($time) {  
         if ($SKIPPING or @$SEND_QUEUE > 3) { # 3 msgs per 10 seconds  
           $SKIPPING++;  
         } else {  
           my @time = localtime $time;  
           $_[KERNEL]->post($IRC_ALIAS => privmsg => $CHANNEL =>  
                            sprintf "%02d:%02d:%02d: %s: %s",  
                            ($time[2] + 11) % 12 + 1, $time[1], $time[0],  
                            $file, $line);  
         }  
       }  
   
       ## handle re-probe/flush if skipping  
       if ($SKIPPING) {  
         $_[KERNEL]->delay($_[STATE] => 0.5); # $time will be undef  
       }  
   
     },  
     my_heartbeat => sub {  
       $_[KERNEL]->yield(my_tailed => time, "heartbeat", "beep");  
       $_[KERNEL]->delay($_[STATE] => 10);  
     }  
984     },     },
985    );    );
986    
# Line 913  POE::Session->create( inline_states => Line 988  POE::Session->create( inline_states =>
988    
989  my $httpd = POE::Component::Server::HTTP->new(  my $httpd = POE::Component::Server::HTTP->new(
990          Port => $http_port,          Port => $http_port,
991            PreHandler => {
992                    '/' => sub {
993                            $_[0]->header(Connection => 'close')
994                    }
995            },
996          ContentHandler => { '/' => \&root_handler },          ContentHandler => { '/' => \&root_handler },
997          Headers        => { Server => 'irc-logger' },          Headers        => { Server => 'irc-logger' },
998  );  );
# Line 958  sub root_handler { Line 1038  sub root_handler {
1038          my ($request, $response) = @_;          my ($request, $response) = @_;
1039          $response->code(RC_OK);          $response->code(RC_OK);
1040    
1041            # this doesn't seem to work, so moved to PreHandler
1042            #$response->header(Connection => 'close');
1043    
1044            return RC_OK if $request->uri =~ m/favicon.ico$/;
1045    
1046          my $q;          my $q;
1047    
1048          if ( $request->method eq 'POST' ) {          if ( $request->method eq 'POST' ) {
# Line 970  sub root_handler { Line 1055  sub root_handler {
1055    
1056          my $search = $q->param('search') || $q->param('grep') || '';          my $search = $q->param('search') || $q->param('grep') || '';
1057    
1058          if ($request->url =~ m#/rss#i) {          if ($request->url =~ m#/rss(?:/(tags|last-tag|follow.*)\w*(?:=(\d+))?)?#i) {
1059                    my $show = lc($1);
1060                    my $nr = $2;
1061    
1062                  my $type = 'RSS';       # Atom                  my $type = 'RSS';       # Atom
                 my $url = "http://$http_hostname:$http_port";  
1063    
1064                  $response->content_type("application/$type+xml");                  $response->content_type( 'application/' . lc($type) . '+xml' );
1065    
1066                  my $html = '<!-- error -->';                  my $html = '<!-- error -->';
1067                  warn "create $type feed from ",dump( @last_tags );                  #warn "create $type feed from ",dump( @last_tags );
1068    
1069                  my $feed = XML::Feed->new( $type );                  my $feed = XML::Feed->new( $type );
1070                    $feed->link( $url );
1071    
1072                  $feed->title( "last $last_x_tags from $CHANNEL" );                  if ( $show eq 'tags' ) {
1073                  $feed->link( "http://$http_hostname:$http_port" );                          $nr ||= 50;
1074                  $feed->description( "collects messages which have tags// in them" );                          $feed->title( "tags from $CHANNEL" );
1075                            $feed->link( "$url/tags" );
1076                  foreach my $m ( @last_tags ) {                          $feed->description( "tag cloud created from messages on channel $CHANNEL which have tags// in them" );
                         warn dump( $m );  
                         #my $tags = join(' ', @{$m->{tags}} );  
1077                          my $feed_entry = XML::Feed::Entry->new($type);                          my $feed_entry = XML::Feed::Entry->new($type);
1078                          $feed_entry->title( $m->{nick} . '@' . $m->{time} );                          $feed_entry->title( "$nr tags from $CHANNEL" );
1079                          $feed_entry->author( $m->{nick} );                          $feed_entry->author( $NICK );
1080  #                       $feed_entry->link(  );                          $feed_entry->link( '/#tags'  );
1081                          $feed_entry->issued( DateTime::Format::Flexible->build( $m->{time} ) );  
1082                          $feed_entry->summary(                          $feed_entry->content(
1083                                  '<![CDATA[' .                                  qq{<![CDATA[<style type="text/css">}
1084  #                               $filter->{nick}->( $m->{nick} ) .                                  . $cloud->css
1085  #                               '<tt>' . $m->{nick} . '</tt> ' .                                  . qq{</style>}
1086                                  $filter->{message}->( $m->{message} ) .                                  . $cloud->html( $nr )
1087                                  ']]>'                                  . qq{]]>}
1088                          );                          );
                         $feed_entry->category( join(', ', @{$m->{tags}}) );  
1089                          $feed->add_entry( $feed_entry );                          $feed->add_entry( $feed_entry );
1090    
1091                    } elsif ( $show eq 'last-tag' ) {
1092    
1093                            $nr ||= $last_x_tags;
1094                            $nr = $last_x_tags if $nr > $last_x_tags;
1095    
1096                            $feed->title( "last $nr tagged messages from $CHANNEL" );
1097                            $feed->description( "collects messages which have tags// in them" );
1098    
1099                            foreach my $m ( @last_tags ) {
1100    #                               warn dump( $m );
1101                                    #my $tags = join(' ', @{$m->{tags}} );
1102                                    my $feed_entry = XML::Feed::Entry->new($type);
1103                                    $feed_entry->title( $m->{nick} . '@' . $m->{time} );
1104                                    $feed_entry->author( $m->{nick} );
1105                                    $feed_entry->link( '/#' . $m->{id}  );
1106                                    $feed_entry->issued( DateTime::Format::Flexible->build( $m->{time} ) );
1107    
1108                                    my $message = $filter->{message}->( $m->{message} );
1109                                    $message .= "<br/>\n" unless $message =~ m!<(/p|br/?)>!;
1110    #                               warn "## message = $message\n";
1111    
1112                                    #$feed_entry->summary(
1113                                    $feed_entry->content(
1114                                            "<![CDATA[$message]]>"
1115                                    );
1116                                    $feed_entry->category( join(', ', @{$m->{tags}}) );
1117                                    $feed->add_entry( $feed_entry );
1118    
1119                                    $nr--;
1120                                    last if $nr <= 0;
1121    
1122                            }
1123    
1124                    } elsif ( $show =~ m/^follow/ ) {
1125    
1126                            $feed->title( "Feeds which this bot follows" );
1127    
1128                            my $sth = $dbh->prepare( qq{ select * from feeds order by last_update desc } );
1129                            $sth->execute;
1130                            while (my $row = $sth->fetchrow_hashref) {
1131                                    my $feed_entry = XML::Feed::Entry->new($type);
1132                                    $feed_entry->title( $row->{name} );
1133                                    $feed_entry->link( $row->{url}  );
1134                                    $feed_entry->issued( DateTime::Format::Flexible->build( $row->{last_update} ) );
1135                                    $feed_entry->content(
1136                                            '<![CDATA[<pre>' . dump( $row ) . '</pre>]]>'
1137                                    );
1138                                    $feed->add_entry( $feed_entry );
1139                            }
1140    
1141                    } else {
1142                            _log "unknown rss request ",$request->url;
1143                            return RC_DENY;
1144                  }                  }
1145    
1146                  $response->content( $feed->as_xml );                  $response->content( $feed->as_xml );
# Line 1012  sub root_handler { Line 1151  sub root_handler {
1151                  warn "$@";                  warn "$@";
1152          }          }
1153    
1154          $response->content_type("text/html; charset=$ENCODING");          $response->content_type("text/html; charset=UTF-8");
1155    
1156          my $html =          my $html =
1157                  qq{<html><head><title>$NICK</title><style type="text/css">$style} .                  qq{<html><head><title>$NICK</title><style type="text/css">$style}
1158                  $cloud->css .                  . $cloud->css
1159                  qq{</style></head><body>} .                  . qq{</style></head><body>}
1160                  qq{                  . qq{
1161                  <form method="post" class="search" action="/">                  <form method="post" class="search" action="/">
1162                  <input type="text" name="search" value="$search" size="10">                  <input type="text" name="search" value="$search" size="10">
1163                  <input type="submit" value="search">                  <input type="submit" value="search">
1164                  </form>                  </form>
1165                  } .                  }
1166                  $cloud->html(500) .                  . $cloud->html(500)
1167                  qq{<p>};                  . qq{<p>};
1168          if ($request->url =~ m#/history#) {  
1169            if ($request->url =~ m#/tags?#) {
1170                    # nop
1171            } elsif ($request->url =~ m#/history#) {
1172                  my $sth = $dbh->prepare(qq{                  my $sth = $dbh->prepare(qq{
1173                          select date(time) as date,count(*) as nr,sum(length(message)) as len                          select date(time) as date,count(*) as nr,sum(length(message)) as len
1174                                  from log                                  from log
# Line 1058  sub root_handler { Line 1200  sub root_handler {
1200                                  $cal->weekdays('MON','TUE','WED','THU','FRI');                                  $cal->weekdays('MON','TUE','WED','THU','FRI');
1201                                  ($l_yyyy,$l_mm) = ($yyyy,$mm);                                  ($l_yyyy,$l_mm) = ($yyyy,$mm);
1202                          }                          }
1203                          $cal->setcontent($dd, qq{                          $cal->setcontent($dd, qq[
1204                                  <a href="/?date=$row->{date}">$row->{nr}</a><br/>$row->{len}                                  <a href="$url?date=$row->{date}">$row->{nr}</a><br/>$row->{len}
1205                          });                          ]) if $cal;
1206                                                    
1207                  }                  }
1208                  $html .= qq{<td valign="top">} . $cal->as_HTML() . qq{</td></tr></table>};                  $html .= qq{<td valign="top">} . $cal->as_HTML() . qq{</td></tr></table>};
# Line 1075  sub root_handler { Line 1217  sub root_handler {
1217                                  fmt => {                                  fmt => {
1218                                          date => sub {                                          date => sub {
1219                                                  my $date = shift || return;                                                  my $date = shift || return;
1220                                                  qq{<hr/><div class="date"><a href="/?date=$date">$date</a></div>};                                                  qq{<hr/><div class="date"><a href="$url?date=$date">$date</a></div>};
1221                                          },                                          },
1222                                          time => '<span class="time">%s</span> ',                                          time => '<span class="time">%s</span> ',
1223                                          time_channel => '<span class="channel">%s %s</span> ',                                          time_channel => '<span class="channel">%s %s</span> ',
# Line 1094  sub root_handler { Line 1236  sub root_handler {
1236          </body></html>};          </body></html>};
1237    
1238          $response->content( $html );          $response->content( $html );
1239            warn "<< ", $request->method, " ", $request->uri, " created ", length($html), " bytes\n";
1240          return RC_OK;          return RC_OK;
1241  }  }
1242    
Legend:
Removed from v.71  
changed lines
  Added in v.94
  ViewVC Help
Powered by ViewVC 1.1.26