/[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 90 by dpavlin, Fri Mar 7 09:50:53 2008 UTC revision 105 by dpavlin, Sun Mar 9 19:13:16 2008 UTC
# Line 2  Line 2 
2  use strict;  use strict;
3  $|++;  $|++;
4    
5    use POE qw(Component::IRC Component::Server::HTTP);
6    use HTTP::Status;
7    use DBI;
8    use Regexp::Common qw /URI/;
9    use CGI::Simple;
10    use HTML::TagCloud;
11    use POSIX qw/strftime/;
12    use HTML::CalendarMonthSimple;
13    use Getopt::Long;
14    use DateTime;
15    use URI::Escape;
16    use Data::Dump qw/dump/;
17    use DateTime::Format::ISO8601;
18    use Carp qw/confess/;
19    use XML::Feed;
20    use DateTime::Format::Flexible;
21    
22  =head1 NAME  =head1 NAME
23    
24  irc-logger.pl  irc-logger.pl
# Line 35  chomp($HOSTNAME); Line 52  chomp($HOSTNAME);
52    
53  my $NICK = 'irc-logger';  my $NICK = 'irc-logger';
54  $NICK .= '-dev' if ($HOSTNAME =~ m/llin/);  $NICK .= '-dev' if ($HOSTNAME =~ m/llin/);
55  my $CONNECT =  my $CONNECT = {
56    {Server => 'irc.freenode.net',          Server => 'irc.freenode.net',
57     Nick => $NICK,          Nick => $NICK,
58     Ircname => "try /msg $NICK help",          Ircname => "try /msg $NICK help",
59    };  };
60  my $CHANNEL = '#razmjenavjestina';  my $CHANNEL = '#razmjenavjestina';
61  $CHANNEL = '#irc-logger' if ($HOSTNAME =~ m/llin/);  $CHANNEL = '#irc-logger' if ($HOSTNAME =~ m/llin/);
62  my $IRC_ALIAS = "log";  my $IRC_ALIAS = "log";
63    
64    if ( $HOSTNAME =~ m/lugarin/ ) {
65            $CONNECT->{Server} = 'irc.carnet.hr';
66            $CHANNEL = '#riss';
67    }
68    
69    warn dump( $HOSTNAME, $CONNECT );
70    
71  my $DSN = 'DBI:Pg:dbname=' . $NICK;  my $DSN = 'DBI:Pg:dbname=' . $NICK;
72    
73  my $TIMESTAMP = '%Y-%m-%d %H:%M:%S';  my $TIMESTAMP = '%Y-%m-%d %H:%M:%S';
# Line 55  my $last_x_tags = 50; Line 79  my $last_x_tags = 50;
79    
80  # don't pull rss feeds more often than this  # don't pull rss feeds more often than this
81  my $rss_min_delay = 60;  my $rss_min_delay = 60;
 $rss_min_delay = 15;  
82    
83  my $http_port = $NICK =~ m/-dev/ ? 8001 : 8000;  my $http_port = $NICK =~ m/-dev/ ? 8001 : 8000;
84    
# Line 63  my $url = "http://$HOSTNAME:$http_port"; Line 86  my $url = "http://$HOSTNAME:$http_port";
86    
87  ## END CONFIG  ## END CONFIG
88    
 use POE qw(Component::IRC Component::Server::HTTP);  
 use HTTP::Status;  
 use DBI;  
 use Regexp::Common qw /URI/;  
 use CGI::Simple;  
 use HTML::TagCloud;  
 use POSIX qw/strftime/;  
 use HTML::CalendarMonthSimple;  
 use Getopt::Long;  
 use DateTime;  
 use URI::Escape;  
 use Data::Dump qw/dump/;  
 use DateTime::Format::ISO8601;  
 use Carp qw/confess/;  
 use XML::Feed;  
 use DateTime::Format::Flexible;  
   
89  my $use_twitter = 1;  my $use_twitter = 1;
90  eval { require Net::Twitter; };  eval { require Net::Twitter; };
91  $use_twitter = 0 if ($@);  $use_twitter = 0 if ($@);
# Line 118  my $filter = { Line 124  my $filter = {
124                  # protect HTML from wiki modifications                  # protect HTML from wiki modifications
125                  sub e {                  sub e {
126                          my $t = shift;                          my $t = shift;
127                          return 'uri_unescape{' . uri_escape($t) . '}';                          return 'uri_unescape{' . uri_escape($t, '^a-zA-Z0-9') . '}';
128                  }                  }
129    
130                  $m =~ s/($escape_re)/$escape{$1}/gs;                  $m =~ s/($escape_re)/$escape{$1}/gs;
131                  $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;
132                  $m =~ s#\/(\w+)\/#<i>$1</i>#gs;                  $m =~ s#\/(\w+)\/#<i>$1</i>#gs;
133                  $m =~ s#$tag_regex#e(qq{<a href="$url?tag=$1" class="tag">$1</a>})#egs;                  $m =~ s#$tag_regex#e(qq{<a href="$url?tag=$1" class="tag">$1</a>})#egs;
134                  $m =~ s#\*(\w+)\*#<b>$1</b>#gs;                  $m =~ s#\*(\w+)\*#<b>$1</b>#gs;
# Line 179  create table feeds ( Line 185  create table feeds (
185          name text,          name text,
186          delay interval not null default '5 min',          delay interval not null default '5 min',
187          active boolean default true,          active boolean default true,
188            channel text not null,
189            nick text not null,
190            private boolean default false,
191          last_update timestamp default 'now()',          last_update timestamp default 'now()',
192          polls int default 0,          polls int default 0,
193          updates int default 0          updates int default 0
194  );  );
195  create unique index feeds_url on feeds(url);  create unique index feeds_url on feeds(url);
196  insert into feeds (url,name) values ('http://wiki.razmjenavjestina.org/feed/workspace/razmjenavjestina?category=Recent%20Changes','wiki');  insert into feeds (url,name,channel,nick) values ('http://wiki.razmjenavjestina.org/feed/workspace/razmjenavjestina?category=Recent%20Changes','wiki','$CHANNEL','dpavlin');
197          },          },
198  };  };
199    
# Line 228  sub meta { Line 237  sub meta {
237                  if ( $@ || ! $sth->rows ) {                  if ( $@ || ! $sth->rows ) {
238                          $sth = $dbh->prepare(qq{ insert into meta (value,nick,channel,name,changed) values (?,?,?,?,now()) });                          $sth = $dbh->prepare(qq{ insert into meta (value,nick,channel,name,changed) values (?,?,?,?,now()) });
239                          $sth->execute( $value, $nick, $channel, $name );                          $sth->execute( $value, $nick, $channel, $name );
240                          _log "created $nick/$channel/$name = $value";                          warn "## created $nick/$channel/$name = $value\n";
241                  } else {                  } else {
242                          _log "updated $nick/$channel/$name = $value ";                          warn "## updated $nick/$channel/$name = $value\n";
243                  }                  }
244    
245                  return $value;                  return $value;
# Line 240  sub meta { Line 249  sub meta {
249                  my $sth = $dbh->prepare(qq{ select value,changed from meta where nick = ? and channel = ? and name = ? });                  my $sth = $dbh->prepare(qq{ select value,changed from meta where nick = ? and channel = ? and name = ? });
250                  $sth->execute( $nick, $channel, $name );                  $sth->execute( $nick, $channel, $name );
251                  my ($v,$c) = $sth->fetchrow_array;                  my ($v,$c) = $sth->fetchrow_array;
252                  _log "fetched $nick/$channel/$name = $v [$c]";                  warn "## fetched $nick/$channel/$name = $v [$c]\n";
253                  return ($v,$c) if wantarray;                  return ($v,$c) if wantarray;
254                  return $v;                  return $v;
255    
# Line 337  sub get_from_log { Line 346  sub get_from_log {
346    
347          my @where;          my @where;
348          my @args;          my @args;
349            my $msg;
350    
351          if (my $search = $args->{search}) {          if (my $search = $args->{search}) {
352                  $search =~ s/^\s+//;                  $search =~ s/^\s+//;
353                  $search =~ s/\s+$//;                  $search =~ s/\s+$//;
354                  push @where, 'message ilike ? or nick ilike ?';                  push @where, 'message ilike ? or nick ilike ?';
355                  push @args, ( ( '%' . $search . '%' ) x 2 );                  push @args, ( ( '%' . $search . '%' ) x 2 );
356                  _log "search for '$search'";                  $msg = "Search for '$search'";
357          }          }
358    
359          if ($args->{tag} && $tags->{ $args->{tag} }) {          if ($args->{tag} && $tags->{ $args->{tag} }) {
360                  push @where, 'id in (' . join(',', @{ $tags->{ $args->{tag} } }) . ')';                  push @where, 'id in (' . join(',', @{ $tags->{ $args->{tag} } }) . ')';
361                  _log "search for tags $args->{tag}";                  $msg = "Search for tags $args->{tag}";
362          }          }
363    
364          if (my $date = $args->{date} ) {          if (my $date = $args->{date} ) {
365                  $date = check_date( $date );                  $date = check_date( $date );
366                  push @where, 'date(time) = ?';                  push @where, 'date(time) = ?';
367                  push @args, $date;                  push @args, $date;
368                  _log "search for date $date";                  $msg = "search for date $date";
369          }          }
370    
371          $sql .= " where " . join(" and ", @where) if @where;          $sql .= " where " . join(" and ", @where) if @where;
# Line 369  sub get_from_log { Line 379  sub get_from_log {
379          eval { $sth->execute( @args ) };          eval { $sth->execute( @args ) };
380          return if $@;          return if $@;
381    
382            my $nr_results = $sth->rows;
383    
384          my $last_row = {          my $last_row = {
385                  date => '',                  date => '',
386                  time => '',                  time => '',
# Line 389  sub get_from_log { Line 401  sub get_from_log {
401    
402          return @rows if ($args->{full_rows});          return @rows if ($args->{full_rows});
403    
404          my @msgs = (          $msg .= ' produced ' . (
405                  "Showing " . ($#rows + 1) . " messages..."                  $nr_results == 0 ? 'no results' :
406                    $nr_results == 0 ? 'one result' :
407                            $nr_results . ' results'
408          );          );
409    
410            my @msgs = ( $msg );
411    
412          if ($context) {          if ($context) {
413                  my @ids = @rows;                  my @ids = @rows;
414                  @rows = ();                  @rows = ();
# Line 449  sub get_from_log { Line 465  sub get_from_log {
465  #                       $row->{nick} = $nick;  #                       $row->{nick} = $nick;
466  #               }  #               }
467    
468                    $append = 0 if $row->{me};
469    
470                  if ($last_row->{nick} ne $nick) {                  if ($last_row->{nick} ne $nick) {
471                          # obfu way to find format for me_nick if needed or fallback to default                          # obfu way to find format for me_nick if needed or fallback to default
472                          my $fmt = $row->{me} ? ( $args->{fmt}->{me_nick} || $args->{fmt}->{nick} ) : $args->{fmt}->{nick};                          my $fmt = $row->{me} ? ( $args->{fmt}->{me_nick} || $args->{fmt}->{nick} ) : $args->{fmt}->{nick};
# Line 628  sub rss_fetch { Line 646  sub rss_fetch {
646                  _log("can't fetch RSS ", $args->{url});                  _log("can't fetch RSS ", $args->{url});
647                  return;                  return;
648          }          }
649    
650          my ( $total, $updates ) = ( 0, 0 );          my ( $total, $updates ) = ( 0, 0 );
651          for my $entry ($feed->entries) {          for my $entry ($feed->entries) {
652                  $total++;                  $total++;
653    
654                  # seen allready?                  # seen allready?
655                  return if $_rss->{$feed->link}->{seen}->{$entry->id}++ > 0;                  next if $_rss->{$args->{channel}}->{$feed->link}->{$entry->id}++ > 0;
656    
657                  sub prefix {                  sub prefix {
658                          my ($txt,$var) = @_;                          my ($txt,$var) = @_;
659                            $var =~ s/\s+/ /gs;
660                          $var =~ s/^\s+//g;                          $var =~ s/^\s+//g;
661                            $var =~ s/\s+$//g;
662                          return $txt . $var if $var;                          return $txt . $var if $var;
663                  }                  }
664    
665                    # fix absolute and relative links to feed entries
666                    my $link = $entry->link;
667                    if ( $link =~ m!^/! ) {
668                            my $host = $args->{url};
669                            $host =~ s!^(http://[^/]+).*$!$1!;      #!vim
670                            $link = "$host/$link";
671                    } elsif ( $link !~ m!^http! ) {
672                            $link = $args->{url} . $link;
673                    }
674    
675                  my $msg;                  my $msg;
676                  $msg .= prefix( 'From: ' , $args->{name} || $feed->title );                  $msg .= prefix( 'From: ' , $args->{name} || $feed->title );
677                  $msg .= prefix( ' by ' , $entry->author );                  $msg .= prefix( ' by ' , $entry->author );
678                  $msg .= prefix( ' -- ' , $entry->link );                  $msg .= prefix( ' | ' , $entry->title );
679                    $msg .= prefix( ' | ' , $link );
680  #               $msg .= prefix( ' id ' , $entry->id );  #               $msg .= prefix( ' id ' , $entry->id );
681    
682                  if ( $args->{kernel} && $send_rss_msgs ) {                  if ( $args->{kernel} && $send_rss_msgs ) {
683                          $send_rss_msgs--;                          $send_rss_msgs--;
684                          _log('RSS', $msg);                          # FIXME bug! should be save_message
685                          $sth_insert_log->execute( $CHANNEL, 1, $NICK, $msg, undef );  #                       save_message( channel => $args->{channel}, me => 1, nick => $NICK, message => $msg );
686                          $args->{kernel}->post( $IRC_ALIAS => notice => $CHANNEL, $msg );                          $sth_insert_log->execute( $args->{channel}, 1, $NICK, $msg, 'now()' );
687                            my ( $type, $to ) = ( 'notice', $args->{channel} );
688                            ( $type, $to ) = ( 'privmsg', $args->{nick} ) if $args->{private};
689                            _log(">> $type $to |", $msg);
690                            $args->{kernel}->post( $IRC_ALIAS => $type => $to, $msg );
691                          $updates++;                          $updates++;
692                  }                  }
693          }          }
# Line 669  sub rss_fetch { Line 705  sub rss_fetch {
705  sub rss_fetch_all {  sub rss_fetch_all {
706          my $kernel = shift;          my $kernel = shift;
707          my $sql = qq{          my $sql = qq{
708                  select id, url, name                  select id, url, name, channel, nick, private
709                  from feeds                  from feeds
710                  where active is true                  where active is true
711          };          };
# Line 689  sub rss_fetch_all { Line 725  sub rss_fetch_all {
725    
726  sub rss_check_updates {  sub rss_check_updates {
727          my $kernel = shift;          my $kernel = shift;
728          my $last_t = $_rss->{last_poll} || time();          $_rss->{last_poll} ||= time();
729          my $t = time();          my $dt = time() - $_rss->{last_poll};
730          if ( $t - $last_t > $rss_min_delay ) {          warn "## rss_check_updates $dt > $rss_min_delay\n";
731                  $_rss->{last_poll} = $t;          if ( $dt > $rss_min_delay ) {
732                    $_rss->{last_poll} = time();
733                  _log rss_fetch_all( $kernel );                  _log rss_fetch_all( $kernel );
734          }          }
735  }  }
# Line 725  POE::Session->create( inline_states => { Line 762  POE::Session->create( inline_states => {
762    
763                  save_message( channel => $channel, me => 0, nick => $nick, message => $msg);                  save_message( channel => $channel, me => 0, nick => $nick, message => $msg);
764                  meta( $nick, $channel, 'last-msg', $msg );                  meta( $nick, $channel, 'last-msg', $msg );
765                    rss_check_updates( $kernel );
766      },      },
767      irc_ctcp_action => sub {      irc_ctcp_action => sub {
768                  my $kernel = $_[KERNEL];                  my $kernel = $_[KERNEL];
# Line 897  POE::Session->create( inline_states => { Line 935  POE::Session->create( inline_states => {
935                          $_rss = undef;                          $_rss = undef;
936                          $dbh->do( qq{ update feeds set last_update = now() - delay } );                          $dbh->do( qq{ update feeds set last_update = now() - delay } );
937                          $res = "OK, cleaned RSS cache";                          $res = "OK, cleaned RSS cache";
938                  } elsif ($msg =~ m!^rss-(add|remove|stop|start)\s+(http://\S+)\s*(.*)!) {                  } elsif ($msg =~ m/^rss-list/) {
939                            my $sth = $dbh->prepare(qq{ select url,name,last_update,active,channel,nick,private from feeds });
940                            $sth->execute;
941                            while (my @row = $sth->fetchrow_array) {
942                                    $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, join(' | ',@row) );
943                            }
944                            $res = '';
945                    } elsif ($msg =~ m!^rss-(add|remove|stop|start)(?:-(private))?\s+(http://\S+)\s*(.*)!) {
946                            my ( $command, $sub, $url, $arg ) = ( $1,$2,$3,$4 );
947    
948                            my $channel = $1 if ( $arg =~ s/\s*(#\S+)\s*// );
949                            $channel = $nick if $sub eq 'private';
950    
951                          my $sql = {                          my $sql = {
952                                  add             => qq{ insert into feeds (url,name) values (?,?) },                                  add     => qq{ insert into feeds (url,name,channel,nick,private) values (?,?,?,?,?) },
953  #                               remove  => qq{ delete from feeds                                where url = ? and name = ? },  #                               remove  => qq{ delete from feeds                                where url = ? and name = ? },
954                                  start   => qq{ update feeds set active = true   where url = ? -- ? },                                  start   => qq{ update feeds set active = true   where url = ? },
955                                  stop    => qq{ update feeds set active = false  where url = ? -- ? },                                  stop    => qq{ update feeds set active = false  where url = ? },
                                   
956                          };                          };
957                          if (my $q = $sql->{$1} ) {  
958                            if ( $command eq 'add' && ! $channel ) {
959                                    $res = "ERROR: got '$msg' which doesn't have #channel in it, ignoring!";
960                            } elsif (my $q = $sql->{$command} ) {
961                                  my $sth = $dbh->prepare( $q );                                  my $sth = $dbh->prepare( $q );
962                                  warn "## SQL $q ( $2 | $3 )\n";                                  my @data = ( $url );
963                                  eval { $sth->execute( $2, $3 ) };                                  if ( $command eq 'add' ) {
964                                            push @data, ( $arg, $channel, $nick, $sub eq 'private' ? 1 : 0 );
965                                    }
966                                    warn "## $command SQL $q with ",dump( @data ),"\n";
967                                    eval { $sth->execute( @data ) };
968                                    if ($@) {
969                                            $res = "ERROR: $@";
970                                    } else {
971                                            $res = "OK, RSS [$command|$sub|$url|$arg]";
972                                    }
973                            } else {
974                                    $res = "ERROR: don't know what to do with: $msg";
975                          }                          }
   
                         $res = "OK, RSS $1 : $2 - $3";  
976                  }                  }
977    
978                  if ($res) {                  if ($res) {
# Line 922  POE::Session->create( inline_states => { Line 983  POE::Session->create( inline_states => {
983                  rss_check_updates( $_[KERNEL] );                  rss_check_updates( $_[KERNEL] );
984          },          },
985          irc_477 => sub {          irc_477 => sub {
986                  _log "# irc_477: ",$_[ARG1];                  _log "<< irc_477: ",$_[ARG1];
987                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "register $NICK" );                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "register $NICK" );
988          },          },
989          irc_505 => sub {          irc_505 => sub {
990                  _log "# irc_505: ",$_[ARG1];                  _log "<< irc_505: ",$_[ARG1];
991                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "register $NICK" );                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "register $NICK" );
992  #               $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "set hide email on" );  #               $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "set hide email on" );
993  #               $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "set email dpavlin\@rot13.org" );  #               $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "set email dpavlin\@rot13.org" );
994          },          },
995          irc_registered => sub {          irc_registered => sub {
996                  _log "## registrated $NICK";                  _log "## registrated $NICK, /msg nickserv IDENTIFY $NICK";
997                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "IDENTIFY $NICK" );                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "IDENTIFY $NICK" );
998          },          },
999          irc_disconnected => sub {          irc_disconnected => sub {
1000                  _log "## disconnected, reconnecting again";                  _log "## disconnected.. sleeping for $sleep_on_error seconds and reconnecting again";
1001                  $_[KERNEL]->post($IRC_ALIAS => connect => $CONNECT);                  sleep($sleep_on_error);
1002                    $_[KERNEL]->post( $IRC_ALIAS => connect => $CONNECT);
1003          },          },
1004          irc_socketerr => sub {          irc_socketerr => sub {
1005                  _log "## socket error... sleeping for $sleep_on_error seconds and retry";                  _log "## socket error... sleeping for $sleep_on_error seconds and retry";
1006                  sleep($sleep_on_error);                  sleep($sleep_on_error);
1007                  $_[KERNEL]->post($IRC_ALIAS => connect => $CONNECT);                  $_[KERNEL]->post( $IRC_ALIAS => connect => $CONNECT);
1008          },          },
1009  #       irc_433 => sub {  #       irc_433 => sub {
1010  #               print "# irc_433: ",$_[ARG1], "\n";  #               print "# irc_433: ",$_[ARG1], "\n";
1011  #               warn "## indetify $NICK\n";  #               warn "## indetify $NICK\n";
1012  #               $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "IDENTIFY $NICK" );  #               $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "IDENTIFY $NICK" );
1013  #       },  #       },
1014    #       irc_451 # please register
1015            irc_snotice => sub {
1016                    _log "<< snotice",$_[ARG0];
1017                    if ( $_[ARG0] =~ m!/(QUOTE)\s+(PASS\s+\d+)!i ) {
1018                            warn ">> $1 | $2\n";
1019                            $_[KERNEL]->post( $IRC_ALIAS => lc($1) => $2);
1020                    }
1021            },
1022      _child => sub {},      _child => sub {},
1023      _default => sub {      _default => sub {
1024                  _log sprintf "sID:%s %s %s",                  _log sprintf "sID:%s %s %s",
# Line 1115  sub root_handler { Line 1185  sub root_handler {
1185                                  $feed->add_entry( $feed_entry );                                  $feed->add_entry( $feed_entry );
1186                          }                          }
1187    
1188                            my $feed_entry = XML::Feed::Entry->new($type);
1189                            $feed_entry->title( "Internal stats" );
1190                            $feed_entry->content(
1191                                    '<![CDATA[<pre>' . dump( $_rss ) . '</pre>]]>'
1192                            );
1193                            $feed->add_entry( $feed_entry );
1194    
1195                  } else {                  } else {
1196                          _log "unknown rss request ",$request->url;                          _log "unknown rss request ",$request->url;
1197                          return RC_DENY;                          return RC_DENY;
Legend:
Removed from v.90  
changed lines
  Added in v.105
  ViewVC Help
Powered by ViewVC 1.1.26