/[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 77 by dpavlin, Thu Feb 7 17:48:51 2008 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 46  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    # number of last tags to keep in circular buffer
63    my $last_x_tags = 50;
64    
65    # 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;  my $http_port = $NICK =~ m/-dev/ ? 8001 : 8000;
70    
71  my $url = "http://$HOSTNAME:$http_port";  my $url = "http://$HOSTNAME:$http_port";
72    
73  ## END CONFIG  ## 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 93  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 149  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 165  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 239  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 483  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 492  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 561  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 602  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 613  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 653  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 672  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 716  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 731  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 801  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 847  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 914  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 959  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$/;          return RC_OK if $request->uri =~ m/favicon.ico$/;
1051    
1052          my $q;          my $q;
# Line 973  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(?:/(tags)(?:=(\d+))?)#i) {          if ($request->url =~ m#/rss(?:/(tags|last-tag|follow.*)\w*(?:=(\d+))?)?#i) {
1065                  my $show = lc($1);                  my $show = lc($1);
1066                  my $arg = $2 || 50;                  my $nr = $2;
1067    
1068                  my $type = 'RSS';       # Atom                  my $type = 'RSS';       # Atom
1069    
# Line 985  sub root_handler { Line 1073  sub root_handler {
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                  if ( $show eq 'tags' ) {                  if ( $show eq 'tags' ) {
1079                            $nr ||= 50;
1080                          $feed->title( "tags from $CHANNEL" );                          $feed->title( "tags from $CHANNEL" );
1081                          $feed->link( "$url/tags" );                          $feed->link( "$url/tags" );
1082                          $feed->description( "tag cloud created from messages on channel $CHANNEL which have tags// in them" );                          $feed->description( "tag cloud created from messages on channel $CHANNEL which have tags// in them" );
1083                          my $feed_entry = XML::Feed::Entry->new($type);                          my $feed_entry = XML::Feed::Entry->new($type);
1084                          $feed_entry->title( "$arg tags from $CHANNEL" );                          $feed_entry->title( "$nr tags from $CHANNEL" );
1085                          $feed_entry->author( $NICK );                          $feed_entry->author( $NICK );
1086                          $feed_entry->link( '/#tags'  );                          $feed_entry->link( '/#tags'  );
1087    
# Line 999  sub root_handler { Line 1089  sub root_handler {
1089                                  qq{<![CDATA[<style type="text/css">}                                  qq{<![CDATA[<style type="text/css">}
1090                                  . $cloud->css                                  . $cloud->css
1091                                  . qq{</style>}                                  . qq{</style>}
1092                                  . $cloud->html( $arg )                                  . $cloud->html( $nr )
1093                                  . qq{]]>}                                  . qq{]]>}
1094                          );                          );
1095                          $feed->add_entry( $feed_entry );                          $feed->add_entry( $feed_entry );
1096    
1097                  } else {                  } 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 $last_x_tags from $CHANNEL" );                          $feed->title( "last $nr tagged messages from $CHANNEL" );
                         $feed->link( $url );  
1103                          $feed->description( "collects messages which have tags// in them" );                          $feed->description( "collects messages which have tags// in them" );
1104    
1105                          foreach my $m ( @last_tags ) {                          foreach my $m ( @last_tags ) {
# Line 1021  sub root_handler { Line 1113  sub root_handler {
1113    
1114                                  my $message = $filter->{message}->( $m->{message} );                                  my $message = $filter->{message}->( $m->{message} );
1115                                  $message .= "<br/>\n" unless $message =~ m!<(/p|br/?)>!;                                  $message .= "<br/>\n" unless $message =~ m!<(/p|br/?)>!;
1116                                  warn "## message = $message\n";  #                               warn "## message = $message\n";
                                 from_to( $message, $ENCODING, 'UTF-8' );  
1117    
1118                                  #$feed_entry->summary(                                  #$feed_entry->summary(
1119                                  $feed_entry->content(                                  $feed_entry->content(
# Line 1030  sub root_handler { Line 1121  sub root_handler {
1121                                  );                                  );
1122                                  $feed_entry->category( join(', ', @{$m->{tags}}) );                                  $feed_entry->category( join(', ', @{$m->{tags}}) );
1123                                  $feed->add_entry( $feed_entry );                                  $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 1041  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}
# Line 1090  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="$url?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>};
Legend:
Removed from v.77  
changed lines
  Added in v.89
  ViewVC Help
Powered by ViewVC 1.1.26