/[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 87 by dpavlin, Fri Mar 7 00:18:02 2008 UTC revision 91 by dpavlin, Fri Mar 7 10:13:45 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  
   
 =item --follow=file.log  
   
 Follows new messages in file  
   
23  =back  =back
24    
25  =head1 DESCRIPTION  =head1 DESCRIPTION
# Line 50  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    
 # default log to follow and announce messages  
 my $follows_path = 'follows.log';  
   
47  my $DSN = 'DBI:Pg:dbname=' . $NICK;  my $DSN = 'DBI:Pg:dbname=' . $NICK;
48    
 # log output encoding  
 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;
# Line 74  my $url = "http://$HOSTNAME:$http_port"; Line 63  my $url = "http://$HOSTNAME:$http_port";
63    
64  ## END CONFIG  ## 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 100  my $import_dircproxy; Line 88  my $import_dircproxy;
88  my $log_path;  my $log_path;
89  GetOptions(  GetOptions(
90          'import-dircproxy:s' => \$import_dircproxy,          'import-dircproxy:s' => \$import_dircproxy,
         'follows:s' => \$follows_path,  
91          'log:s' => \$log_path,          'log:s' => \$log_path,
92  );  );
93    
# Line 111  GetOptions( Line 98  GetOptions(
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          my $out = strftime($TIMESTAMP,localtime()) . ' ' . join(" ",@_) . $/;          print strftime($TIMESTAMP,localtime()) . ' ' . join(" ",@_) . $/;
         from_to( $out, 'UTF-8', $ENCODING );  
         print $out;  
102  }  }
103    
 # LOG following  
   
 my %FOLLOWS =  
   (  
 #   ACCESS => "/var/log/apache/access.log",  
 #   ERROR => "/var/log/apache/error.log",  
   );  
   
 sub add_follow_path {  
         my $path = shift;  
         my $name = $path;  
         $name =~ s/\..*$//;  
         warn "# using $path to announce messages from $name\n";  
         $FOLLOWS{$name} = $path;  
 }  
   
 add_follow_path( $follows_path ) if ( -e $follows_path );  
   
104  # HTML formatters  # HTML formatters
105    
106  my %escape = ('<'=>'&lt;', '>'=>'&gt;', '&'=>'&amp;', '"'=>'&quot;');  my %escape = ('<'=>'&lt;', '>'=>'&gt;', '&'=>'&amp;', '"'=>'&quot;');
# Line 177  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 => qq{          log => qq{
# Line 533  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 675  sub rss_fetch { Line 642  sub rss_fetch {
642                  }                  }
643    
644                  my $msg;                  my $msg;
645                  $msg .= prefix( 'From: ' , $feed->title );                  $msg .= prefix( 'From: ' , $args->{name} || $feed->title );
646                  $msg .= prefix( ' by ' , $entry->author );                  $msg .= prefix( ' by ' , $entry->author );
647                  $msg .= prefix( ' -- ' , $entry->link );                  $msg .= prefix( ' -- ' , $entry->link );
648  #               $msg .= prefix( ' id ' , $entry->id );  #               $msg .= prefix( ' id ' , $entry->id );
649    
650                  if ( $args->{kernel} && $send_rss_msgs ) {                  if ( $args->{kernel} && $send_rss_msgs ) {
                         warn "# sending to $CHANNEL\n";  
651                          $send_rss_msgs--;                          $send_rss_msgs--;
652                            _log('RSS', $msg);
653                            $sth_insert_log->execute( $CHANNEL, 1, $NICK, $msg, undef );
654                          $args->{kernel}->post( $IRC_ALIAS => notice => $CHANNEL, $msg );                          $args->{kernel}->post( $IRC_ALIAS => notice => $CHANNEL, $msg );
655                          $updates++;                          $updates++;
                         #$sth_insert_log->execute( $CHANNEL, 1, $NICK, $msg, undef );  
                         _log('RSS', $msg);  
656                  }                  }
657          }          }
658    
# Line 725  sub rss_check_updates { Line 691  sub rss_check_updates {
691          my $kernel = shift;          my $kernel = shift;
692          my $last_t = $_rss->{last_poll} || time();          my $last_t = $_rss->{last_poll} || time();
693          my $t = time();          my $t = time();
694          if ( $last_t - $t > $rss_min_delay ) {          if ( $t - $last_t > $rss_min_delay ) {
695                  $_rss->{last_poll} = $t;                  $_rss->{last_poll} = $t;
696                  _log rss_fetch_all( $kernel );                  _log rss_fetch_all( $kernel );
697          }          }
# Line 738  _log rss_fetch_all; Line 704  _log rss_fetch_all;
704  # POE handing part  # POE handing part
705  #  #
706    
 my $SKIPPING = 0;               # if skipping, how many we've done  
 my $SEND_QUEUE;                 # cache  
707  my $ping;                                               # ping stats  my $ping;                                               # ping stats
708    
709  POE::Component::IRC->new($IRC_ALIAS);  POE::Component::IRC->new($IRC_ALIAS);
# Line 931  POE::Session->create( inline_states => { Line 895  POE::Session->create( inline_states => {
895                          $res = rss_fetch_all( $_[KERNEL] );                          $res = rss_fetch_all( $_[KERNEL] );
896                  } elsif ($msg =~ m/^rss-clean/) {                  } elsif ($msg =~ m/^rss-clean/) {
897                          $_rss = undef;                          $_rss = undef;
898                            $dbh->do( qq{ update feeds set last_update = now() - delay } );
899                          $res = "OK, cleaned RSS cache";                          $res = "OK, cleaned RSS cache";
900                    } elsif ($msg =~ m/^rss-list/) {
901                            my $sth = $dbh->prepare(qq{ select url,name,last_update,active from feeds });
902                            $sth->execute;
903                            while (my @row = $sth->fetchrow_array) {
904                                    $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, join(' | ',@row) );
905                            }
906                            $res = '';
907                  } elsif ($msg =~ m!^rss-(add|remove|stop|start)\s+(http://\S+)\s*(.*)!) {                  } elsif ($msg =~ m!^rss-(add|remove|stop|start)\s+(http://\S+)\s*(.*)!) {
908                          my $sql = {                          my $sql = {
909                                  add             => qq{ insert into feeds (url,name) values (?,?) },                                  add             => qq{ insert into feeds (url,name) values (?,?) },
910  #                               remove  => qq{ delete from feeds                                where url = ? and name = ? },  #                               remove  => qq{ delete from feeds                                where url = ? and name = ? },
911                                  start   => qq{ update feeds set active = true   where url = ? -- ? },                                  start   => qq{ update feeds set active = true   where url = ? },
912                                  stop    => qq{ update feeds set active = false  where url = ? -- ? },                                  stop    => qq{ update feeds set active = false  where url = ? },
913                                                                    
914                          };                          };
915                          if (my $q = $sql->{$1} ) {                          if (my $q = $sql->{$1} ) {
916                                  my $sth = $dbh->prepare( $q );                                  my $sth = $dbh->prepare( $q );
917                                  warn "## SQL $q ( $2 | $3 )\n";                                  my @data = ( $2 );
918                                  eval { $sth->execute( $2, $3 ) };                                  push @data, $3 if ( $q =~ s/\?//g == 2 );
919                                    warn "## $1 SQL $q with ",dump( @data ),"\n";
920                                    eval { $sth->execute( @data ) };
921                          }                          }
922    
923                          $res ||= "OK, RSS $1 : $2 - $3";                          $res = "OK, RSS $1 : $2 - $3";
924                  }                  }
925    
926                  if ($res) {                  if ($res) {
# Line 1214  sub root_handler { Line 1188  sub root_handler {
1188                          }                          }
1189                          $cal->setcontent($dd, qq[                          $cal->setcontent($dd, qq[
1190                                  <a href="$url?date=$row->{date}">$row->{nr}</a><br/>$row->{len}                                  <a href="$url?date=$row->{date}">$row->{nr}</a><br/>$row->{len}
1191                          ]);                          ]) if $cal;
1192                                                    
1193                  }                  }
1194                  $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.87  
changed lines
  Added in v.91
  ViewVC Help
Powered by ViewVC 1.1.26