/[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 99 by dpavlin, Fri Mar 7 17:13:30 2008 UTC revision 106 by dpavlin, Sun Mar 9 19:22: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 62  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 339  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 371  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 391  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 451  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 655  sub rss_fetch { Line 671  sub rss_fetch {
671                  } elsif ( $link !~ m!^http! ) {                  } elsif ( $link !~ m!^http! ) {
672                          $link = $args->{url} . $link;                          $link = $args->{url} . $link;
673                  }                  }
                 $link =~ s!//+!/!g;  
674    
675                  my $msg;                  my $msg;
676                  $msg .= prefix( 'From: ' , $args->{name} || $feed->title );                  $msg .= prefix( 'From: ' , $args->{name} || $feed->title );
# Line 666  sub rss_fetch { Line 681  sub rss_fetch {
681    
682                  if ( $args->{kernel} && $send_rss_msgs ) {                  if ( $args->{kernel} && $send_rss_msgs ) {
683                          $send_rss_msgs--;                          $send_rss_msgs--;
684                          $sth_insert_log->execute( $args->{channel}, 1, $NICK, $msg, 'now()' );                          if ( ! $args->{private} ) {
685                                    # FIXME bug! should be save_message
686    #                               save_message( channel => $args->{channel}, me => 1, nick => $NICK, message => $msg );
687                                    $sth_insert_log->execute( $args->{channel}, 1, $NICK, $msg, 'now()' );
688                            }
689                          my ( $type, $to ) = ( 'notice', $args->{channel} );                          my ( $type, $to ) = ( 'notice', $args->{channel} );
690                          ( $type, $to ) = ( 'privmsg', $args->{nick} ) if $args->{private};                          ( $type, $to ) = ( 'privmsg', $args->{nick} ) if $args->{private};
691                          _log(">> $type $to |", $msg);                          _log(">> $type $to |", $msg);
# Line 932  POE::Session->create( inline_states => { Line 951  POE::Session->create( inline_states => {
951                          $channel = $nick if $sub eq 'private';                          $channel = $nick if $sub eq 'private';
952    
953                          my $sql = {                          my $sql = {
954                                  add             => qq{ insert into feeds (url,name,channel,nick,private) values (?,?,?,?,?) },                                  add     => qq{ insert into feeds (url,name,channel,nick,private) values (?,?,?,?,?) },
955  #                               remove  => qq{ delete from feeds                                where url = ? and name = ? },  #                               remove  => qq{ delete from feeds                                where url = ? and name = ? },
956                                  start   => qq{ update feeds set active = true   where url = ? },                                  start   => qq{ update feeds set active = true   where url = ? },
957                                  stop    => qq{ update feeds set active = false  where url = ? },                                  stop    => qq{ update feeds set active = false  where url = ? },
# Line 966  POE::Session->create( inline_states => { Line 985  POE::Session->create( inline_states => {
985                  rss_check_updates( $_[KERNEL] );                  rss_check_updates( $_[KERNEL] );
986          },          },
987          irc_477 => sub {          irc_477 => sub {
988                  _log "# irc_477: ",$_[ARG1];                  _log "<< irc_477: ",$_[ARG1];
989                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "register $NICK" );                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "register $NICK" );
990          },          },
991          irc_505 => sub {          irc_505 => sub {
992                  _log "# irc_505: ",$_[ARG1];                  _log "<< irc_505: ",$_[ARG1];
993                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "register $NICK" );                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "register $NICK" );
994  #               $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "set hide email on" );  #               $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "set hide email on" );
995  #               $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "set email dpavlin\@rot13.org" );  #               $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "set email dpavlin\@rot13.org" );
996          },          },
997          irc_registered => sub {          irc_registered => sub {
998                  _log "## registrated $NICK";                  _log "## registrated $NICK, /msg nickserv IDENTIFY $NICK";
999                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "IDENTIFY $NICK" );                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "IDENTIFY $NICK" );
1000          },          },
1001          irc_disconnected => sub {          irc_disconnected => sub {
1002                  _log "## disconnected, reconnecting again";                  _log "## disconnected.. sleeping for $sleep_on_error seconds and reconnecting again";
1003                  $_[KERNEL]->post($IRC_ALIAS => connect => $CONNECT);                  sleep($sleep_on_error);
1004                    $_[KERNEL]->post( $IRC_ALIAS => connect => $CONNECT);
1005          },          },
1006          irc_socketerr => sub {          irc_socketerr => sub {
1007                  _log "## socket error... sleeping for $sleep_on_error seconds and retry";                  _log "## socket error... sleeping for $sleep_on_error seconds and retry";
1008                  sleep($sleep_on_error);                  sleep($sleep_on_error);
1009                  $_[KERNEL]->post($IRC_ALIAS => connect => $CONNECT);                  $_[KERNEL]->post( $IRC_ALIAS => connect => $CONNECT);
1010          },          },
1011  #       irc_433 => sub {  #       irc_433 => sub {
1012  #               print "# irc_433: ",$_[ARG1], "\n";  #               print "# irc_433: ",$_[ARG1], "\n";
1013  #               warn "## indetify $NICK\n";  #               warn "## indetify $NICK\n";
1014  #               $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "IDENTIFY $NICK" );  #               $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "IDENTIFY $NICK" );
1015  #       },  #       },
1016    #       irc_451 # please register
1017            irc_snotice => sub {
1018                    _log "<< snotice",$_[ARG0];
1019                    if ( $_[ARG0] =~ m!/(QUOTE)\s+(PASS\s+\d+)!i ) {
1020                            warn ">> $1 | $2\n";
1021                            $_[KERNEL]->post( $IRC_ALIAS => lc($1) => $2);
1022                    }
1023            },
1024      _child => sub {},      _child => sub {},
1025      _default => sub {      _default => sub {
1026                  _log sprintf "sID:%s %s %s",                  _log sprintf "sID:%s %s %s",
Legend:
Removed from v.99  
changed lines
  Added in v.106
  ViewVC Help
Powered by ViewVC 1.1.26