/[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 72 by dpavlin, Sun Dec 16 19:03:35 2007 UTC revision 89 by dpavlin, Fri Mar 7 00:43:45 2008 UTC
# Line 22  Import log from C<dircproxy> to C<irc-lo Line 22  Import log from C<dircproxy> to C<irc-lo
22    
23  Name of log file  Name of log file
24    
25    =item --follow=file.log
26    
27    Follows new messages in file
28    
29  =back  =back
30    
31  =head1 DESCRIPTION  =head1 DESCRIPTION
# Line 32  log all conversation on irc channel Line 36  log all conversation on irc channel
36    
37  ## CONFIG  ## CONFIG
38    
39  my $HOSTNAME = `hostname`;  my $HOSTNAME = `hostname -f`;
40    chomp($HOSTNAME);
41    
42  my $NICK = 'irc-logger';  my $NICK = 'irc-logger';
43  $NICK .= '-dev' if ($HOSTNAME =~ m/llin/);  $NICK .= '-dev' if ($HOSTNAME =~ m/llin/);
# Line 45  my $CHANNEL = '#razmjenavjestina'; Line 50  my $CHANNEL = '#razmjenavjestina';
50  $CHANNEL = '#irc-logger' if ($HOSTNAME =~ m/llin/);  $CHANNEL = '#irc-logger' if ($HOSTNAME =~ m/llin/);
51  my $IRC_ALIAS = "log";  my $IRC_ALIAS = "log";
52    
53  my %FOLLOWS =  # default log to follow and announce messages
54    (  my $follows_path = 'follows.log';
    ACCESS => "/var/log/apache/access.log",  
    ERROR => "/var/log/apache/error.log",  
   );  
55    
56  my $DSN = 'DBI:Pg:dbname=' . $NICK;  my $DSN = 'DBI:Pg:dbname=' . $NICK;
57    
 my $ENCODING = 'ISO-8859-2';  
58  my $TIMESTAMP = '%Y-%m-%d %H:%M:%S';  my $TIMESTAMP = '%Y-%m-%d %H:%M:%S';
59    
60  my $sleep_on_error = 5;  my $sleep_on_error = 5;
61    
62  my $http_port = $NICK =~ m/-dev/ ? 8001 : 8000;  # number of last tags to keep in circular buffer
63  my $http_hostname = `hostname`;  my $last_x_tags = 50;
 chomp( $http_hostname );  
64    
65  ## END CONFIG  # don't pull rss feeds more often than this
66    my $rss_min_delay = 60;
67    $rss_min_delay = 15;
68    
69    my $http_port = $NICK =~ m/-dev/ ? 8001 : 8000;
70    
71    my $url = "http://$HOSTNAME:$http_port";
72    
73    ## END CONFIG
74    
75  use POE qw(Component::IRC Wheel::FollowTail Component::Server::HTTP);  use POE qw(Component::IRC Wheel::FollowTail Component::Server::HTTP);
76  use HTTP::Status;  use HTTP::Status;
77  use DBI;  use DBI;
 use Encode qw/from_to is_utf8/;  
78  use Regexp::Common qw /URI/;  use Regexp::Common qw /URI/;
79  use CGI::Simple;  use CGI::Simple;
80  use HTML::TagCloud;  use HTML::TagCloud;
# Line 92  my $import_dircproxy; Line 97  my $import_dircproxy;
97  my $log_path;  my $log_path;
98  GetOptions(  GetOptions(
99          'import-dircproxy:s' => \$import_dircproxy,          'import-dircproxy:s' => \$import_dircproxy,
100            'follows:s' => \$follows_path,
101          'log:s' => \$log_path,          'log:s' => \$log_path,
102  );  );
103    
104  $SIG{__DIE__} = sub {  #$SIG{__DIE__} = sub {
105          confess "fatal error";  #       confess "fatal error";
106  };  #};
107    
108  open(STDOUT, '>', $log_path) || warn "can't redirect log to $log_path: $!";  open(STDOUT, '>', $log_path) || warn "can't redirect log to $log_path: $!";
109    
110  sub _log {  sub _log {
111          print strftime($TIMESTAMP,localtime()), ' ', join(" ",@_), $/;          print strftime($TIMESTAMP,localtime()) . ' ' . join(" ",@_) . $/;
112  }  }
113    
114    # LOG following
115    
116    my %FOLLOWS =
117      (
118    #   ACCESS => "/var/log/apache/access.log",
119    #   ERROR => "/var/log/apache/error.log",
120      );
121    
122    sub add_follow_path {
123            my $path = shift;
124            my $name = $path;
125            $name =~ s/\..*$//;
126            warn "# using $path to announce messages from $name\n";
127            $FOLLOWS{$name} = $path;
128    }
129    
130    add_follow_path( $follows_path ) if ( -e $follows_path );
131    
132  # HTML formatters  # HTML formatters
133    
134  my %escape = ('<'=>'&lt;', '>'=>'&gt;', '&'=>'&amp;', '"'=>'&quot;');  my %escape = ('<'=>'&lt;', '>'=>'&gt;', '&'=>'&amp;', '"'=>'&quot;');
# Line 128  my $filter = { Line 152  my $filter = {
152                  $m =~ s/($escape_re)/$escape{$1}/gs;                  $m =~ s/($escape_re)/$escape{$1}/gs;
153                  $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 ||
154                  $m =~ s#\/(\w+)\/#<i>$1</i>#gs;                  $m =~ s#\/(\w+)\/#<i>$1</i>#gs;
155                  $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;
156                  $m =~ s#\*(\w+)\*#<b>$1</b>#gs;                  $m =~ s#\*(\w+)\*#<b>$1</b>#gs;
157                  $m =~ s#_(\w+)_#<u>$1</u>#gs;                  $m =~ s#_(\w+)_#<u>$1</u>#gs;
158    
# Line 148  my $filter = { Line 172  my $filter = {
172  };  };
173    
174  my $dbh = DBI->connect($DSN,"","", { RaiseError => 1, AutoCommit => 1 }) || die $DBI::errstr;  my $dbh = DBI->connect($DSN,"","", { RaiseError => 1, AutoCommit => 1 }) || die $DBI::errstr;
175    $dbh->do( qq{ set client_encoding = 'UTF-8' } );
176    
177  my $sql_schema = {  my $sql_schema = {
178          log => '          log => qq{
179  create table log (  create table log (
180          id serial,          id serial,
181          time timestamp default now(),          time timestamp default now(),
# Line 164  create table log ( Line 189  create table log (
189  create index log_time on log(time);  create index log_time on log(time);
190  create index log_channel on log(channel);  create index log_channel on log(channel);
191  create index log_nick on log(nick);  create index log_nick on log(nick);
192          ',          },
193          meta => '          meta => q{
194  create table meta (  create table meta (
195          nick text not null,          nick text not null,
196          channel text not null,          channel text not null,
197          name text not null,          name text not null,
198          value text,          value text,
199          changed timestamp default now(),          changed timestamp default 'now()',
200          primary key(nick,channel,name)          primary key(nick,channel,name)
201  );  );
202          ',          },
203            feeds => qq{
204    create table feeds (
205            id serial,
206            url text not null,
207            name text,
208            delay interval not null default '5 min',
209            active boolean default true,
210            last_update timestamp default 'now()',
211            polls int default 0,
212            updates int default 0
213    );
214    create unique index feeds_url on feeds(url);
215    insert into feeds (url,name) values ('http://wiki.razmjenavjestina.org/feed/workspace/razmjenavjestina?category=Recent%20Changes','wiki');
216            },
217  };  };
218    
219  foreach my $table ( keys %$sql_schema ) {  foreach my $table ( keys %$sql_schema ) {
# Line 238  sub meta { Line 277  sub meta {
277    
278    
279    
280  my $sth = $dbh->prepare(qq{  my $sth_insert_log = $dbh->prepare(qq{
281  insert into log  insert into log
282          (channel, me, nick, message, time)          (channel, me, nick, message, time)
283  values (?,?,?,?,?)  values (?,?,?,?,?)
# Line 482  my $cloud = HTML::TagCloud->new; Line 521  my $cloud = HTML::TagCloud->new;
521    
522  =cut  =cut
523    
 my $last_x_tags = 5;  
524  my @last_tags;  my @last_tags;
525    
526  sub add_tag {  sub add_tag {
# Line 491  sub add_tag { Line 529  sub add_tag {
529          return unless ($arg->{id} && $arg->{message});          return unless ($arg->{id} && $arg->{message});
530    
531          my $m = $arg->{message};          my $m = $arg->{message};
         from_to('UTF-8', 'iso-8859-2', $m) if (is_utf8($m));  
532    
533          my @tags;          my @tags;
534    
# Line 500  sub add_tag { Line 537  sub add_tag {
537                  next if (! $tag || $tag =~ m/https?:/i);                  next if (! $tag || $tag =~ m/https?:/i);
538                  push @{ $tags->{$tag} }, $arg->{id};                  push @{ $tags->{$tag} }, $arg->{id};
539                  #warn "+tag $tag: $arg->{id}\n";                  #warn "+tag $tag: $arg->{id}\n";
540                  $cloud->add($tag, "?tag=$tag", scalar @{$tags->{$tag}} + 1);                  $cloud->add($tag, "$url?tag=$tag", scalar @{$tags->{$tag}} + 1);
541                  push @tags, $tag;                  push @tags, $tag;
542    
543          }          }
544    
545          if ( @tags ) {          if ( @tags ) {
546                  shift @last_tags if $#last_tags == $last_x_tags;                  pop @last_tags if $#last_tags == $last_x_tags;
547                  push @last_tags, { tags => [ @tags ], %$arg };                  unshift @last_tags, { tags => [ @tags ], %$arg };
548          }          }
549    
550  }  }
# Line 519  Read all tags from database and create i Line 556  Read all tags from database and create i
556  =cut  =cut
557    
558  sub seed_tags {  sub seed_tags {
559          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 });
560          $sth->execute;          $sth->execute;
561          while (my $row = $sth->fetchrow_hashref) {          while (my $row = $sth->fetchrow_hashref) {
562                  add_tag( %$row );                  add_tag( %$row );
563          }          }
564    
565          foreach my $tag (keys %$tags) {          foreach my $tag (keys %$tags) {
566                  $cloud->add($tag, "?tag=$tag", scalar @{$tags->{$tag}} + 1);                  $cloud->add($tag, "$url?tag=$tag", scalar @{$tags->{$tag}} + 1);
567          }          }
568  }  }
569    
# Line 560  sub save_message { Line 597  sub save_message {
597                  $a->{me} ? "***" . $a->{nick} : "<" . $a->{nick} . ">",                  $a->{me} ? "***" . $a->{nick} : "<" . $a->{nick} . ">",
598                  " " . $a->{message};                  " " . $a->{message};
599    
600          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});  
601          add_tag( id => $dbh->last_insert_id(undef,undef,"log",undef), %$a );          add_tag( id => $dbh->last_insert_id(undef,undef,"log",undef), %$a );
602  }  }
603    
# Line 601  if ($import_dircproxy) { Line 636  if ($import_dircproxy) {
636          exit;          exit;
637  }  }
638    
639    #
640    # RSS follow
641    #
642    
643    my $_rss;
644    
645    
646    sub rss_fetch {
647            my ($args) = @_;
648    
649            # how many messages to send out when feed is seen for the first time?
650            my $send_rss_msgs = 1;
651    
652            _log "RSS fetch", $args->{url};
653    
654            my $feed = XML::Feed->parse(URI->new( $args->{url} ));
655            if ( ! $feed ) {
656                    _log("can't fetch RSS ", $args->{url});
657                    return;
658            }
659            my ( $total, $updates ) = ( 0, 0 );
660            for my $entry ($feed->entries) {
661                    $total++;
662    
663                    # seen allready?
664                    return if $_rss->{$feed->link}->{seen}->{$entry->id}++ > 0;
665    
666                    sub prefix {
667                            my ($txt,$var) = @_;
668                            $var =~ s/^\s+//g;
669                            return $txt . $var if $var;
670                    }
671    
672                    my $msg;
673                    $msg .= prefix( 'From: ' , $feed->title );
674                    $msg .= prefix( ' by ' , $entry->author );
675                    $msg .= prefix( ' -- ' , $entry->link );
676    #               $msg .= prefix( ' id ' , $entry->id );
677    
678                    if ( $args->{kernel} && $send_rss_msgs ) {
679                            $send_rss_msgs--;
680                            _log('RSS', $msg);
681                            $sth_insert_log->execute( $CHANNEL, 1, $NICK, $msg, undef );
682                            $args->{kernel}->post( $IRC_ALIAS => notice => $CHANNEL, $msg );
683                            $updates++;
684                    }
685            }
686    
687            my $sql = qq{ update feeds set last_update = now(), polls = polls + 1 };
688            $sql .= qq{, updates = updates + $updates } if $updates;
689            $sql .= qq{where id = } . $args->{id};
690            eval { $dbh->do( $sql ) };
691    
692            _log "RSS got $total items of which $updates new";
693    
694            return $updates;
695    }
696    
697    sub rss_fetch_all {
698            my $kernel = shift;
699            my $sql = qq{
700                    select id, url, name
701                    from feeds
702                    where active is true
703            };
704            # limit to newer feeds only if we are not sending messages out
705            $sql .= qq{     and last_update + delay < now() } if $kernel;
706            my $sth = $dbh->prepare( $sql );
707            $sth->execute();
708            warn "# ",$sth->rows," active RSS feeds\n";
709            my $count = 0;
710            while (my $row = $sth->fetchrow_hashref) {
711                    $row->{kernel} = $kernel if $kernel;
712                    $count += rss_fetch( $row );
713            }
714            return "OK, fetched $count posts from " . $sth->rows . " feeds";
715    }
716    
717    
718    sub rss_check_updates {
719            my $kernel = shift;
720            my $last_t = $_rss->{last_poll} || time();
721            my $t = time();
722            if ( $last_t - $t > $rss_min_delay ) {
723                    $_rss->{last_poll} = $t;
724                    _log rss_fetch_all( $kernel );
725            }
726    }
727    
728    # seed rss seen cache so we won't send out all items on startup
729    _log rss_fetch_all;
730    
731  #  #
732  # POE handing part  # POE handing part
# Line 612  my $ping;                                              # ping stats Line 738  my $ping;                                              # ping stats
738    
739  POE::Component::IRC->new($IRC_ALIAS);  POE::Component::IRC->new($IRC_ALIAS);
740    
741  POE::Session->create( inline_states =>  POE::Session->create( inline_states => {
742     {_start => sub {                _start => sub {      
743                  $_[KERNEL]->post($IRC_ALIAS => register => 'all');                  $_[KERNEL]->post($IRC_ALIAS => register => 'all');
744                  $_[KERNEL]->post($IRC_ALIAS => connect => $CONNECT);                  $_[KERNEL]->post($IRC_ALIAS => connect => $CONNECT);
745      },      },
746      irc_255 => sub {    # server is done blabbing      irc_255 => sub {    # server is done blabbing
747                  $_[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;  
748                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "IDENTIFY $NICK" );                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "IDENTIFY $NICK" );
749      },      },
750      irc_public => sub {      irc_public => sub {
# Line 652  POE::Session->create( inline_states => Line 775  POE::Session->create( inline_states =>
775    
776      },      },
777          irc_ping => sub {          irc_ping => sub {
778                  warn "pong ", $_[ARG0], $/;                  _log( "pong ", $_[ARG0] );
779                  $ping->{ $_[ARG0] }++;                  $ping->{ $_[ARG0] }++;
780                    rss_check_updates( $_[KERNEL] );
781          },          },
782          irc_invite => sub {          irc_invite => sub {
783                  my $kernel = $_[KERNEL];                  my $kernel = $_[KERNEL];
784                  my $nick = (split /!/, $_[ARG0])[0];                  my $nick = (split /!/, $_[ARG0])[0];
785                  my $channel = $_[ARG1];                  my $channel = $_[ARG1];
786    
787                  warn "invited to $channel by $nick";                  _log "invited to $channel by $nick";
788    
789                  $_[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..." );
790                  $_[KERNEL]->post($IRC_ALIAS => join => $channel);                  $_[KERNEL]->post($IRC_ALIAS => join => $channel);
# Line 671  POE::Session->create( inline_states => Line 795  POE::Session->create( inline_states =>
795                  my $nick = (split /!/, $_[ARG0])[0];                  my $nick = (split /!/, $_[ARG0])[0];
796                  my $msg = $_[ARG2];                  my $msg = $_[ARG2];
797                  my $channel = $_[ARG1]->[0];                  my $channel = $_[ARG1]->[0];
                 from_to($msg, 'UTF-8', $ENCODING);  
798    
799                  my $res = "unknown command '$msg', try /msg $NICK help!";                  my $res = "unknown command '$msg', try /msg $NICK help!";
800                  my @out;                  my @out;
# Line 715  POE::Session->create( inline_states => Line 838  POE::Session->create( inline_states =>
838    
839                          foreach my $res (get_from_log( limit => $limit )) {                          foreach my $res (get_from_log( limit => $limit )) {
840                                  _log "last: $res";                                  _log "last: $res";
                                 from_to($res, $ENCODING, 'UTF-8');  
841                                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );                                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );
842                          }                          }
843    
# Line 730  POE::Session->create( inline_states => Line 852  POE::Session->create( inline_states =>
852                                          search => $what,                                          search => $what,
853                                  )) {                                  )) {
854                                  _log "search [$what]: $res";                                  _log "search [$what]: $res";
                                 from_to($res, $ENCODING, 'UTF-8');  
855                                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );                                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );
856                          }                          }
857    
# Line 800  POE::Session->create( inline_states => Line 921  POE::Session->create( inline_states =>
921                                          $res = "config option $op doesn't exist";                                          $res = "config option $op doesn't exist";
922                                  }                                  }
923                          }                          }
924                    } elsif ($msg =~ m/^rss-update/) {
925                            $res = rss_fetch_all( $_[KERNEL] );
926                    } elsif ($msg =~ m/^rss-clean/) {
927                            $_rss = undef;
928                            $res = "OK, cleaned RSS cache";
929                    } elsif ($msg =~ m!^rss-(add|remove|stop|start)\s+(http://\S+)\s*(.*)!) {
930                            my $sql = {
931                                    add             => qq{ insert into feeds (url,name) values (?,?) },
932    #                               remove  => qq{ delete from feeds                                where url = ? and name = ? },
933                                    start   => qq{ update feeds set active = true   where url = ? -- ? },
934                                    stop    => qq{ update feeds set active = false  where url = ? -- ? },
935                                    
936                            };
937                            if (my $q = $sql->{$1} ) {
938                                    my $sth = $dbh->prepare( $q );
939                                    warn "## SQL $q ( $2 | $3 )\n";
940                                    eval { $sth->execute( $2, $3 ) };
941                            }
942    
943                            $res ||= "OK, RSS $1 : $2 - $3";
944                  }                  }
945    
946                  if ($res) {                  if ($res) {
947                          _log ">> [$nick] $res";                          _log ">> [$nick] $res";
                         from_to($res, $ENCODING, 'UTF-8');  
948                          $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );                          $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );
949                  }                  }
950    
951                    rss_check_updates( $_[KERNEL] );
952          },          },
953          irc_477 => sub {          irc_477 => sub {
954                  _log "# irc_477: ",$_[ARG1];                  _log "# irc_477: ",$_[ARG1];
# Line 846  POE::Session->create( inline_states => Line 987  POE::Session->create( inline_states =>
987                          "";                          "";
988        0;                        # false for signals        0;                        # false for signals
989      },      },
     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);  
     }  
990     },     },
991    );    );
992    
# Line 913  POE::Session->create( inline_states => Line 994  POE::Session->create( inline_states =>
994    
995  my $httpd = POE::Component::Server::HTTP->new(  my $httpd = POE::Component::Server::HTTP->new(
996          Port => $http_port,          Port => $http_port,
997            PreHandler => {
998                    '/' => sub {
999                            $_[0]->header(Connection => 'close')
1000                    }
1001            },
1002          ContentHandler => { '/' => \&root_handler },          ContentHandler => { '/' => \&root_handler },
1003          Headers        => { Server => 'irc-logger' },          Headers        => { Server => 'irc-logger' },
1004  );  );
# Line 958  sub root_handler { Line 1044  sub root_handler {
1044          my ($request, $response) = @_;          my ($request, $response) = @_;
1045          $response->code(RC_OK);          $response->code(RC_OK);
1046    
1047            # this doesn't seem to work, so moved to PreHandler
1048            #$response->header(Connection => 'close');
1049    
1050            return RC_OK if $request->uri =~ m/favicon.ico$/;
1051    
1052          my $q;          my $q;
1053    
1054          if ( $request->method eq 'POST' ) {          if ( $request->method eq 'POST' ) {
# Line 970  sub root_handler { Line 1061  sub root_handler {
1061    
1062          my $search = $q->param('search') || $q->param('grep') || '';          my $search = $q->param('search') || $q->param('grep') || '';
1063    
1064          if ($request->url =~ m#/rss#i) {          if ($request->url =~ m#/rss(?:/(tags|last-tag|follow.*)\w*(?:=(\d+))?)?#i) {
1065                    my $show = lc($1);
1066                    my $nr = $2;
1067    
1068                  my $type = 'RSS';       # Atom                  my $type = 'RSS';       # Atom
1069    
1070                  $response->content_type( 'application/' . lc($type) . '+xml' );                  $response->content_type( 'application/' . lc($type) . '+xml' );
1071    
1072                  my $html = '<!-- error -->';                  my $html = '<!-- error -->';
1073                  warn "create $type feed from ",dump( @last_tags );                  #warn "create $type feed from ",dump( @last_tags );
1074    
1075                  my $feed = XML::Feed->new( $type );                  my $feed = XML::Feed->new( $type );
1076                    $feed->link( $url );
1077    
1078                  $feed->title( "last $last_x_tags from $CHANNEL" );                  if ( $show eq 'tags' ) {
1079  #               $feed->link( "http://$http_hostname:$http_port" );                          $nr ||= 50;
1080                  $feed->description( "collects messages which have tags// in them" );                          $feed->title( "tags from $CHANNEL" );
1081                            $feed->link( "$url/tags" );
1082                  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}} );  
1083                          my $feed_entry = XML::Feed::Entry->new($type);                          my $feed_entry = XML::Feed::Entry->new($type);
1084                          $feed_entry->title( $m->{nick} . '@' . $m->{time} );                          $feed_entry->title( "$nr tags from $CHANNEL" );
1085                          $feed_entry->author( $m->{nick} );                          $feed_entry->author( $NICK );
1086  #                       $feed_entry->link(  );                          $feed_entry->link( '/#tags'  );
1087                          $feed_entry->issued( DateTime::Format::Flexible->build( $m->{time} ) );  
1088                          $feed_entry->summary(                          $feed_entry->content(
1089                                  '<![CDATA[' .                                  qq{<![CDATA[<style type="text/css">}
1090  #                               $filter->{nick}->( $m->{nick} ) .                                  . $cloud->css
1091  #                               '<tt>' . $m->{nick} . '</tt> ' .                                  . qq{</style>}
1092                                  $filter->{message}->( $m->{message} ) .                                  . $cloud->html( $nr )
1093                                  ']]>'                                  . qq{]]>}
1094                          );                          );
                         $feed_entry->category( join(', ', @{$m->{tags}}) );  
1095                          $feed->add_entry( $feed_entry );                          $feed->add_entry( $feed_entry );
1096    
1097                    } elsif ( $show eq 'last-tag' ) {
1098    
1099                            $nr ||= $last_x_tags;
1100                            $nr = $last_x_tags if $nr > $last_x_tags;
1101    
1102                            $feed->title( "last $nr tagged messages from $CHANNEL" );
1103                            $feed->description( "collects messages which have tags// in them" );
1104    
1105                            foreach my $m ( @last_tags ) {
1106    #                               warn dump( $m );
1107                                    #my $tags = join(' ', @{$m->{tags}} );
1108                                    my $feed_entry = XML::Feed::Entry->new($type);
1109                                    $feed_entry->title( $m->{nick} . '@' . $m->{time} );
1110                                    $feed_entry->author( $m->{nick} );
1111                                    $feed_entry->link( '/#' . $m->{id}  );
1112                                    $feed_entry->issued( DateTime::Format::Flexible->build( $m->{time} ) );
1113    
1114                                    my $message = $filter->{message}->( $m->{message} );
1115                                    $message .= "<br/>\n" unless $message =~ m!<(/p|br/?)>!;
1116    #                               warn "## message = $message\n";
1117    
1118                                    #$feed_entry->summary(
1119                                    $feed_entry->content(
1120                                            "<![CDATA[$message]]>"
1121                                    );
1122                                    $feed_entry->category( join(', ', @{$m->{tags}}) );
1123                                    $feed->add_entry( $feed_entry );
1124    
1125                                    $nr--;
1126                                    last if $nr <= 0;
1127    
1128                            }
1129    
1130                    } elsif ( $show =~ m/^follow/ ) {
1131    
1132                            $feed->title( "Feeds which this bot follows" );
1133    
1134                            my $sth = $dbh->prepare( qq{ select * from feeds order by last_update desc } );
1135                            $sth->execute;
1136                            while (my $row = $sth->fetchrow_hashref) {
1137                                    my $feed_entry = XML::Feed::Entry->new($type);
1138                                    $feed_entry->title( $row->{name} );
1139                                    $feed_entry->link( $row->{url}  );
1140                                    $feed_entry->issued( DateTime::Format::Flexible->build( $row->{last_update} ) );
1141                                    $feed_entry->content(
1142                                            '<![CDATA[<pre>' . dump( $row ) . '</pre>]]>'
1143                                    );
1144                                    $feed->add_entry( $feed_entry );
1145                            }
1146    
1147                    } else {
1148                            _log "unknown rss request ",$request->url;
1149                            return RC_DENY;
1150                  }                  }
1151    
1152                  $response->content( $feed->as_xml );                  $response->content( $feed->as_xml );
# Line 1011  sub root_handler { Line 1157  sub root_handler {
1157                  warn "$@";                  warn "$@";
1158          }          }
1159    
1160          $response->content_type("text/html; charset=$ENCODING");          $response->content_type("text/html; charset=UTF-8");
1161    
1162          my $html =          my $html =
1163                  qq{<html><head><title>$NICK</title><style type="text/css">$style} .                  qq{<html><head><title>$NICK</title><style type="text/css">$style}
1164                  $cloud->css .                  . $cloud->css
1165                  qq{</style></head><body>} .                  . qq{</style></head><body>}
1166                  qq{                  . qq{
1167                  <form method="post" class="search" action="/">                  <form method="post" class="search" action="/">
1168                  <input type="text" name="search" value="$search" size="10">                  <input type="text" name="search" value="$search" size="10">
1169                  <input type="submit" value="search">                  <input type="submit" value="search">
1170                  </form>                  </form>
1171                  } .                  }
1172                  $cloud->html(500) .                  . $cloud->html(500)
1173                  qq{<p>};                  . qq{<p>};
1174          if ($request->url =~ m#/history#) {  
1175            if ($request->url =~ m#/tags?#) {
1176                    # nop
1177            } elsif ($request->url =~ m#/history#) {
1178                  my $sth = $dbh->prepare(qq{                  my $sth = $dbh->prepare(qq{
1179                          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
1180                                  from log                                  from log
# Line 1057  sub root_handler { Line 1206  sub root_handler {
1206                                  $cal->weekdays('MON','TUE','WED','THU','FRI');                                  $cal->weekdays('MON','TUE','WED','THU','FRI');
1207                                  ($l_yyyy,$l_mm) = ($yyyy,$mm);                                  ($l_yyyy,$l_mm) = ($yyyy,$mm);
1208                          }                          }
1209                          $cal->setcontent($dd, qq{                          $cal->setcontent($dd, qq[
1210                                  <a href="/?date=$row->{date}">$row->{nr}</a><br/>$row->{len}                                  <a href="$url?date=$row->{date}">$row->{nr}</a><br/>$row->{len}
1211                          });                          ]) if $cal;
1212                                                    
1213                  }                  }
1214                  $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 1074  sub root_handler { Line 1223  sub root_handler {
1223                                  fmt => {                                  fmt => {
1224                                          date => sub {                                          date => sub {
1225                                                  my $date = shift || return;                                                  my $date = shift || return;
1226                                                  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>};
1227                                          },                                          },
1228                                          time => '<span class="time">%s</span> ',                                          time => '<span class="time">%s</span> ',
1229                                          time_channel => '<span class="channel">%s %s</span> ',                                          time_channel => '<span class="channel">%s %s</span> ',
# Line 1093  sub root_handler { Line 1242  sub root_handler {
1242          </body></html>};          </body></html>};
1243    
1244          $response->content( $html );          $response->content( $html );
1245            warn "<< ", $request->method, " ", $request->uri, " created ", length($html), " bytes\n";
1246          return RC_OK;          return RC_OK;
1247  }  }
1248    
Legend:
Removed from v.72  
changed lines
  Added in v.89
  ViewVC Help
Powered by ViewVC 1.1.26