/[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 95 by dpavlin, Fri Mar 7 11:16:05 2008 UTC revision 112 by dpavlin, Mon Mar 10 13:02:32 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 30  log all conversation on irc channel Line 47  log all conversation on irc channel
47    
48  ## CONFIG  ## CONFIG
49    
50    my $irc_config = {
51            nick => 'irc-logger',
52            server => 'irc.freenode.net',
53            port => 6667,
54            ircname => 'Anna the bot: try /msg irc-logger help',
55    };
56    
57  my $HOSTNAME = `hostname -f`;  my $HOSTNAME = `hostname -f`;
58  chomp($HOSTNAME);  chomp($HOSTNAME);
59    
60  my $NICK = 'irc-logger';  
 $NICK .= '-dev' if ($HOSTNAME =~ m/llin/);  
 my $CONNECT =  
   {Server => 'irc.freenode.net',  
    Nick => $NICK,  
    Ircname => "try /msg $NICK help",  
   };  
61  my $CHANNEL = '#razmjenavjestina';  my $CHANNEL = '#razmjenavjestina';
62  $CHANNEL = '#irc-logger' if ($HOSTNAME =~ m/llin/);  
63  my $IRC_ALIAS = "log";  if ( $HOSTNAME =~ m/llin/ ) {
64            $irc_config->{nick} = 'irc-logger-dev';
65    #       $irc_config = {
66    #               nick => 'irc-logger-dev',
67    #               server => 'localhost',
68    #               port => 6668,
69    #       };
70            $CHANNEL = '#irc-logger';
71    } elsif ( $HOSTNAME =~ m/lugarin/ ) {
72            $irc_config->{server} = 'irc.carnet.hr';
73            $CHANNEL = '#riss';
74    }
75    
76    my @channels = ( $CHANNEL );
77    
78    warn "# config = ", dump( $irc_config ), $/;
79    
80    my $NICK = $irc_config->{nick} or die "no nick?";
81    
82  my $DSN = 'DBI:Pg:dbname=' . $NICK;  my $DSN = 'DBI:Pg:dbname=' . $NICK;
83    
# Line 62  my $url = "http://$HOSTNAME:$http_port"; Line 97  my $url = "http://$HOSTNAME:$http_port";
97    
98  ## END CONFIG  ## END CONFIG
99    
 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;  
   
100  my $use_twitter = 1;  my $use_twitter = 1;
101  eval { require Net::Twitter; };  eval { require Net::Twitter; };
102  $use_twitter = 0 if ($@);  $use_twitter = 0 if ($@);
# Line 117  my $filter = { Line 135  my $filter = {
135                  # protect HTML from wiki modifications                  # protect HTML from wiki modifications
136                  sub e {                  sub e {
137                          my $t = shift;                          my $t = shift;
138                          return 'uri_unescape{' . uri_escape($t) . '}';                          return 'uri_unescape{' . uri_escape($t, '^a-zA-Z0-9') . '}';
139                  }                  }
140    
141                  $m =~ s/($escape_re)/$escape{$1}/gs;                  $m =~ s/($escape_re)/$escape{$1}/gs;
142                  $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;
143                  $m =~ s#\/(\w+)\/#<i>$1</i>#gs;                  $m =~ s#\/(\w+)\/#<i>$1</i>#gs;
144                  $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;
145                  $m =~ s#\*(\w+)\*#<b>$1</b>#gs;                  $m =~ s#\*(\w+)\*#<b>$1</b>#gs;
# Line 142  my $filter = { Line 160  my $filter = {
160          },          },
161  };  };
162    
163    # POE IRC
164    my $poe_irc = POE::Component::IRC->spawn( %$irc_config ) or
165            die "can't start ", dump( $irc_config ), ": $!";
166    
167    my $irc = $poe_irc->session_id();
168    _log "IRC session_id $irc";
169    
170  my $dbh = DBI->connect($DSN,"","", { RaiseError => 1, AutoCommit => 1 }) || die $DBI::errstr;  my $dbh = DBI->connect($DSN,"","", { RaiseError => 1, AutoCommit => 1 }) || die $DBI::errstr;
171  $dbh->do( qq{ set client_encoding = 'UTF-8' } );  $dbh->do( qq{ set client_encoding = 'UTF-8' } );
172    
# Line 178  create table feeds ( Line 203  create table feeds (
203          name text,          name text,
204          delay interval not null default '5 min',          delay interval not null default '5 min',
205          active boolean default true,          active boolean default true,
206            channel text not null,
207            nick text not null,
208            private boolean default false,
209          last_update timestamp default 'now()',          last_update timestamp default 'now()',
210          polls int default 0,          polls int default 0,
211          updates int default 0          updates int default 0
212  );  );
213  create unique index feeds_url on feeds(url);  create unique index feeds_url on feeds(url);
214  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');
215          },          },
216  };  };
217    
# Line 336  sub get_from_log { Line 364  sub get_from_log {
364    
365          my @where;          my @where;
366          my @args;          my @args;
367            my $msg;
368    
369          if (my $search = $args->{search}) {          if (my $search = $args->{search}) {
370                  $search =~ s/^\s+//;                  $search =~ s/^\s+//;
371                  $search =~ s/\s+$//;                  $search =~ s/\s+$//;
372                  push @where, 'message ilike ? or nick ilike ?';                  push @where, 'message ilike ? or nick ilike ?';
373                  push @args, ( ( '%' . $search . '%' ) x 2 );                  push @args, ( ( '%' . $search . '%' ) x 2 );
374                  _log "search for '$search'";                  $msg = "Search for '$search'";
375          }          }
376    
377          if ($args->{tag} && $tags->{ $args->{tag} }) {          if ($args->{tag} && $tags->{ $args->{tag} }) {
378                  push @where, 'id in (' . join(',', @{ $tags->{ $args->{tag} } }) . ')';                  push @where, 'id in (' . join(',', @{ $tags->{ $args->{tag} } }) . ')';
379                  _log "search for tags $args->{tag}";                  $msg = "Search for tags $args->{tag}";
380          }          }
381    
382          if (my $date = $args->{date} ) {          if (my $date = $args->{date} ) {
383                  $date = check_date( $date );                  $date = check_date( $date );
384                  push @where, 'date(time) = ?';                  push @where, 'date(time) = ?';
385                  push @args, $date;                  push @args, $date;
386                  _log "search for date $date";                  $msg = "search for date $date";
387          }          }
388    
389          $sql .= " where " . join(" and ", @where) if @where;          $sql .= " where " . join(" and ", @where) if @where;
# Line 368  sub get_from_log { Line 397  sub get_from_log {
397          eval { $sth->execute( @args ) };          eval { $sth->execute( @args ) };
398          return if $@;          return if $@;
399    
400            my $nr_results = $sth->rows;
401    
402          my $last_row = {          my $last_row = {
403                  date => '',                  date => '',
404                  time => '',                  time => '',
# Line 388  sub get_from_log { Line 419  sub get_from_log {
419    
420          return @rows if ($args->{full_rows});          return @rows if ($args->{full_rows});
421    
422          my @msgs = (          $msg .= ' produced ' . (
423                  "Showing " . ($#rows + 1) . " messages..."                  $nr_results == 0 ? 'no results' :
424                    $nr_results == 0 ? 'one result' :
425                            $nr_results . ' results'
426          );          );
427    
428            my @msgs = ( $msg );
429    
430          if ($context) {          if ($context) {
431                  my @ids = @rows;                  my @ids = @rows;
432                  @rows = ();                  @rows = ();
# Line 448  sub get_from_log { Line 483  sub get_from_log {
483  #                       $row->{nick} = $nick;  #                       $row->{nick} = $nick;
484  #               }  #               }
485    
486                    $append = 0 if $row->{me};
487    
488                  if ($last_row->{nick} ne $nick) {                  if ($last_row->{nick} ne $nick) {
489                          # 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
490                          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 611  if ($import_dircproxy) { Line 648  if ($import_dircproxy) {
648  # RSS follow  # RSS follow
649  #  #
650    
651  my $_rss;  my $_stat;
652    
653    
654  sub rss_fetch {  sub rss_fetch {
# Line 633  sub rss_fetch { Line 670  sub rss_fetch {
670                  $total++;                  $total++;
671    
672                  # seen allready?                  # seen allready?
673                  next if $_rss->{$feed->link}->{seen}->{$entry->id}++ > 0;                  next if $_stat->{rss}->{seen}->{$args->{channel}}->{$feed->link}->{$entry->id}++ > 0;
674    
675                  sub prefix {                  sub prefix {
676                          my ($txt,$var) = @_;                          my ($txt,$var) = @_;
# Line 652  sub rss_fetch { Line 689  sub rss_fetch {
689                  } elsif ( $link !~ m!^http! ) {                  } elsif ( $link !~ m!^http! ) {
690                          $link = $args->{url} . $link;                          $link = $args->{url} . $link;
691                  }                  }
                 $link =~ s!//+!/!g;  
692    
693                  my $msg;                  my $msg;
694                  $msg .= prefix( 'From: ' , $args->{name} || $feed->title );                  $msg .= prefix( 'From: ' , $args->{name} || $feed->title );
# Line 663  sub rss_fetch { Line 699  sub rss_fetch {
699    
700                  if ( $args->{kernel} && $send_rss_msgs ) {                  if ( $args->{kernel} && $send_rss_msgs ) {
701                          $send_rss_msgs--;                          $send_rss_msgs--;
702                          _log('>>', $msg);                          if ( ! $args->{private} ) {
703                          $sth_insert_log->execute( $CHANNEL, 1, $NICK, $msg, 'now()' );                                  # FIXME bug! should be save_message
704                          $args->{kernel}->post( $IRC_ALIAS => notice => $CHANNEL, $msg );  #                               save_message( channel => $args->{channel}, me => 1, nick => $NICK, message => $msg );
705                                    $sth_insert_log->execute( $args->{channel}, 1, $NICK, $msg, 'now()' );
706                            }
707                            my ( $type, $to ) = ( 'notice', $args->{channel} );
708                            ( $type, $to ) = ( 'privmsg', $args->{nick} ) if $args->{private};
709                            _log(">> $type $to", $msg);
710                            $args->{kernel}->post( $irc => $type => $to, $msg );
711                          $updates++;                          $updates++;
712                  }                  }
713          }          }
# Line 683  sub rss_fetch { Line 725  sub rss_fetch {
725  sub rss_fetch_all {  sub rss_fetch_all {
726          my $kernel = shift;          my $kernel = shift;
727          my $sql = qq{          my $sql = qq{
728                  select id, url, name                  select id, url, name, channel, nick, private
729                  from feeds                  from feeds
730                  where active is true                  where active is true
731          };          };
# Line 703  sub rss_fetch_all { Line 745  sub rss_fetch_all {
745    
746  sub rss_check_updates {  sub rss_check_updates {
747          my $kernel = shift;          my $kernel = shift;
748          $_rss->{last_poll} ||= time();          $_stat->{rss}->{last_poll} ||= time();
749          my $dt = time() - $_rss->{last_poll};          my $dt = time() - $_stat->{rss}->{last_poll};
750          warn "## rss_check_updates $dt > $rss_min_delay\n";          warn "## rss_check_updates $dt > $rss_min_delay\n";
751          if ( $dt > $rss_min_delay ) {          if ( $dt > $rss_min_delay ) {
752                  $_rss->{last_poll} = time();                  $_stat->{rss}->{last_poll} = time();
753                  _log rss_fetch_all( $kernel );                  _log rss_fetch_all( $kernel );
754          }          }
755  }  }
# Line 715  sub rss_check_updates { Line 757  sub rss_check_updates {
757  # seed rss seen cache so we won't send out all items on startup  # seed rss seen cache so we won't send out all items on startup
758  _log rss_fetch_all;  _log rss_fetch_all;
759    
 #  
 # POE handing part  
 #  
   
 my $ping;                                               # ping stats  
   
 POE::Component::IRC->new($IRC_ALIAS);  
   
760  POE::Session->create( inline_states => {  POE::Session->create( inline_states => {
761          _start => sub {                _start => sub {      
762                  $_[KERNEL]->post($IRC_ALIAS => register => 'all');                  $_[KERNEL]->post( $irc => register => 'all' );
763                  $_[KERNEL]->post($IRC_ALIAS => connect => $CONNECT);                  $_[KERNEL]->post( $irc => connect => {} );
764      },      },
765            irc_001 => sub {
766                    my ($kernel,$sender) = @_[KERNEL,SENDER];
767                    my $poco_object = $sender->get_heap();
768                    _log "connected to",$poco_object->server_name();
769                    $kernel->post( $sender => join => $_ ) for @channels;
770                    undef;
771            },
772      irc_255 => sub {    # server is done blabbing      irc_255 => sub {    # server is done blabbing
773                  $_[KERNEL]->post($IRC_ALIAS => join => $CHANNEL);                  $_[KERNEL]->post( $irc => join => $CHANNEL);
                 $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "IDENTIFY $NICK" );  
774      },      },
775      irc_public => sub {      irc_public => sub {
776                  my $kernel = $_[KERNEL];                  my $kernel = $_[KERNEL];
# Line 762  POE::Session->create( inline_states => { Line 802  POE::Session->create( inline_states => {
802      },      },
803          irc_ping => sub {          irc_ping => sub {
804                  _log( "pong ", $_[ARG0] );                  _log( "pong ", $_[ARG0] );
805                  $ping->{ $_[ARG0] }++;                  $_stat->{ping}->{ $_[ARG0] }++;
806                  rss_check_updates( $_[KERNEL] );                  rss_check_updates( $_[KERNEL] );
807          },          },
808          irc_invite => sub {          irc_invite => sub {
# Line 772  POE::Session->create( inline_states => { Line 812  POE::Session->create( inline_states => {
812    
813                  _log "invited to $channel by $nick";                  _log "invited to $channel by $nick";
814    
815                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, "how nice of you to invite me to $channel, I'll be right there..." );                  $_[KERNEL]->post( $irc => privmsg => $nick, "how nice of you to invite me to $channel, I'll be right there..." );
816                  $_[KERNEL]->post($IRC_ALIAS => join => $channel);                  $_[KERNEL]->post( $irc => 'join' => $channel );
817    
818          },          },
819          irc_msg => sub {          irc_msg => sub {
# Line 791  POE::Session->create( inline_states => { Line 831  POE::Session->create( inline_states => {
831    
832                          $res = "usage: /msg $NICK comand | commands: stat - user/message stat | last - show backtrace | grep foobar - find foobar";                          $res = "usage: /msg $NICK comand | commands: stat - user/message stat | last - show backtrace | grep foobar - find foobar";
833    
834                  } elsif ($msg =~ m/^msg\s+(\S+)\s+(.*)$/i) {                  } elsif ($msg =~ m/^(privmsg|notice)\s+(\S+)\s+(.*)$/i) {
835    
836                          _log ">> /msg $1 $2";                          _log ">> /$1 $2 $3";
837                          $_[KERNEL]->post( $IRC_ALIAS => privmsg => $1, $2 );                          $_[KERNEL]->post( $irc => $1 => $2, $3 );
838                          $res = '';                          $res = '';
839    
840                  } elsif ($msg =~ m/^stat.*?\s*(\d*)/i) {                  } elsif ($msg =~ m/^stat.*?\s*(\d*)/i) {
# Line 824  POE::Session->create( inline_states => { Line 864  POE::Session->create( inline_states => {
864    
865                          foreach my $res (get_from_log( limit => $limit )) {                          foreach my $res (get_from_log( limit => $limit )) {
866                                  _log "last: $res";                                  _log "last: $res";
867                                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );                                  $_[KERNEL]->post( $irc => privmsg => $nick, $res );
868                          }                          }
869    
870                          $res = '';                          $res = '';
# Line 838  POE::Session->create( inline_states => { Line 878  POE::Session->create( inline_states => {
878                                          search => $what,                                          search => $what,
879                                  )) {                                  )) {
880                                  _log "search [$what]: $res";                                  _log "search [$what]: $res";
881                                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );                                  $_[KERNEL]->post( $irc => privmsg => $nick, $res );
882                          }                          }
883    
884                          $res = '';                          $res = '';
# Line 873  POE::Session->create( inline_states => { Line 913  POE::Session->create( inline_states => {
913                                  " : " . ( $stat->{vote}->{'-'} || 0 ) . " --" .                                  " : " . ( $stat->{vote}->{'-'} || 0 ) . " --" .
914                                  " from " . ( join(", ", @nicks) || 'nobody' );                                  " from " . ( join(", ", @nicks) || 'nobody' );
915    
916                          $_[KERNEL]->post( $IRC_ALIAS => notice => $nick, $res );                          $_[KERNEL]->post( $irc => notice => $nick, $res );
917    
918                  } elsif ($msg =~ m/^ping/) {                  } elsif ($msg =~ m/^ping/) {
919                          $res = "ping = " . dump( $ping );                          $res = "ping = " . dump( $_stat->{ping} );
920                  } elsif ($msg =~ m/^conf(?:ig)*\s*(last-size|twitter)*\s*(.*)/) {                  } elsif ($msg =~ m/^conf(?:ig)*\s*(last-size|twitter)*\s*(.*)/) {
921                          if ( ! defined( $1 ) ) {                          if ( ! defined( $1 ) ) {
922                                  my $sth = $dbh->prepare(qq{ select name,value,changed from meta where nick = ? and channel = ? });                                  my $sth = $dbh->prepare(qq{ select name,value,changed from meta where nick = ? and channel = ? });
# Line 910  POE::Session->create( inline_states => { Line 950  POE::Session->create( inline_states => {
950                  } elsif ($msg =~ m/^rss-update/) {                  } elsif ($msg =~ m/^rss-update/) {
951                          $res = rss_fetch_all( $_[KERNEL] );                          $res = rss_fetch_all( $_[KERNEL] );
952                  } elsif ($msg =~ m/^rss-clean/) {                  } elsif ($msg =~ m/^rss-clean/) {
953                          $_rss = undef;                          $_stat->{rss} = undef;
954                          $dbh->do( qq{ update feeds set last_update = now() - delay } );                          $dbh->do( qq{ update feeds set last_update = now() - delay } );
955                          $res = "OK, cleaned RSS cache";                          $res = "OK, cleaned RSS cache";
956                  } elsif ($msg =~ m/^rss-list/) {                  } elsif ($msg =~ m/^rss-list/) {
957                          my $sth = $dbh->prepare(qq{ select url,name,last_update,active from feeds });                          my $sth = $dbh->prepare(qq{ select url,name,last_update,active,channel,nick,private from feeds });
958                          $sth->execute;                          $sth->execute;
959                          while (my @row = $sth->fetchrow_array) {                          while (my @row = $sth->fetchrow_array) {
960                                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, join(' | ',@row) );                                  $_[KERNEL]->post( $irc => privmsg => $nick, join(' | ',@row) );
961                          }                          }
962                          $res = '';                          $res = '';
963                  } elsif ($msg =~ m!^rss-(add|remove|stop|start)\s+(http://\S+)\s*(.*)!) {                  } elsif ($msg =~ m!^rss-(add|remove|stop|start)(?:-(private))?\s+(http://\S+)\s*(.*)!) {
964                            my ( $command, $sub, $url, $arg ) = ( $1,$2,$3,$4 );
965    
966                            my $channel = $1 if ( $arg =~ s/\s*(#\S+)\s*// );
967                            $channel = $nick if $sub eq 'private';
968    
969                          my $sql = {                          my $sql = {
970                                  add             => qq{ insert into feeds (url,name) values (?,?) },                                  add     => qq{ insert into feeds (url,name,channel,nick,private) values (?,?,?,?,?) },
971  #                               remove  => qq{ delete from feeds                                where url = ? and name = ? },  #                               remove  => qq{ delete from feeds                                where url = ? and name = ? },
972                                  start   => qq{ update feeds set active = true   where url = ? },                                  start   => qq{ update feeds set active = true   where url = ? },
973                                  stop    => qq{ update feeds set active = false  where url = ? },                                  stop    => qq{ update feeds set active = false  where url = ? },
974                          };                          };
975                          if (my $q = $sql->{$1} ) {  
976                            if ( $command eq 'add' && ! $channel ) {
977                                    $res = "ERROR: got '$msg' which doesn't have #channel in it, ignoring!";
978                            } elsif (my $q = $sql->{$command} ) {
979                                  my $sth = $dbh->prepare( $q );                                  my $sth = $dbh->prepare( $q );
980                                  my @data = ( $2 );                                  my @data = ( $url );
981                                  push @data, $3 if ( $q =~ s/\?//g == 2 );                                  if ( $command eq 'add' ) {
982                                  warn "## $1 SQL $q with ",dump( @data ),"\n";                                          push @data, ( $arg, $channel, $nick, $sub eq 'private' ? 1 : 0 );
983                                    }
984                                    warn "## $command SQL $q with ",dump( @data ),"\n";
985                                  eval { $sth->execute( @data ) };                                  eval { $sth->execute( @data ) };
986                                    if ($@) {
987                                            $res = "ERROR: $@";
988                                    } else {
989                                            $res = "OK, RSS [$command|$sub|$url|$arg]";
990                                    }
991                            } else {
992                                    $res = "ERROR: don't know what to do with: $msg";
993                          }                          }
   
                         $res = "OK, RSS $1 : $2 - $3";  
994                  }                  }
995    
996                  if ($res) {                  if ($res) {
997                          _log ">> [$nick] $res";                          _log ">> [$nick] $res";
998                          $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );                          $_[KERNEL]->post( $irc => privmsg => $nick, $res );
999                  }                  }
1000    
1001                  rss_check_updates( $_[KERNEL] );                  rss_check_updates( $_[KERNEL] );
1002          },          },
1003            irc_372 => sub {
1004                    _log "<< motd",$_[ARG0],$_[ARG1];
1005            },
1006            irc_375 => sub {
1007                    _log "<< motd", $_[ARG0], "start";
1008            },
1009            irc_376 => sub {
1010                    _log "<< motd", $_[ARG0], "end";
1011            },
1012          irc_477 => sub {          irc_477 => sub {
1013                  _log "# irc_477: ",$_[ARG1];                  _log "<< irc_477: ",$_[ARG1];
1014                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "register $NICK" );                  $_[KERNEL]->post( $irc => privmsg => 'nickserv', "register $NICK" );
1015          },          },
1016          irc_505 => sub {          irc_505 => sub {
1017                  _log "# irc_505: ",$_[ARG1];                  _log "<< irc_505: ",$_[ARG1];
1018                  $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "register $NICK" );                  $_[KERNEL]->post( $irc => privmsg => 'nickserv', "register $NICK" );
1019  #               $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "set hide email on" );  #               $_[KERNEL]->post( $irc => privmsg => 'nickserv', "set hide email on" );
1020  #               $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "set email dpavlin\@rot13.org" );  #               $_[KERNEL]->post( $irc => privmsg => 'nickserv', "set email dpavlin\@rot13.org" );
1021          },          },
1022          irc_registered => sub {          irc_registered => sub {
1023                  _log "## registrated $NICK";                  _log "<< registered $NICK";
                 $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "IDENTIFY $NICK" );  
1024          },          },
1025          irc_disconnected => sub {          irc_disconnected => sub {
1026                  _log "## disconnected, reconnecting again";                  _log "## disconnected.. sleeping for $sleep_on_error seconds and reconnecting again";
1027                  $_[KERNEL]->post($IRC_ALIAS => connect => $CONNECT);                  sleep($sleep_on_error);
1028                    $_[KERNEL]->post( $irc => connect => {} );
1029          },          },
1030          irc_socketerr => sub {          irc_socketerr => sub {
1031                  _log "## socket error... sleeping for $sleep_on_error seconds and retry";                  _log "## socket error... sleeping for $sleep_on_error seconds and retry";
1032                  sleep($sleep_on_error);                  sleep($sleep_on_error);
1033                  $_[KERNEL]->post($IRC_ALIAS => connect => $CONNECT);                  $_[KERNEL]->post( $irc => connect => {} );
1034          },          },
1035  #       irc_433 => sub {  #       irc_433 => sub {
1036  #               print "# irc_433: ",$_[ARG1], "\n";  #               print "# irc_433: ",$_[ARG1], "\n";
1037  #               warn "## indetify $NICK\n";  #               warn "## indetify $NICK\n";
1038  #               $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "IDENTIFY $NICK" );  #               $_[KERNEL]->post( $irc => privmsg => 'nickserv', "IDENTIFY $NICK" );
1039  #       },  #       },
1040    #       irc_451 # please register
1041            irc_notice => sub {
1042                    _log "<< notice",$_[ARG0];
1043                    if ( $_[ARG0] =~ m!/msg\s+NickServ\s+IDENTIFY!i ) {
1044                            $_[KERNEL]->post( $irc => privmsg => 'nickserv', "IDENTIFY $NICK" );
1045                    }
1046            },
1047            irc_snotice => sub {
1048                    _log "<< snotice",$_[ARG0];
1049                    if ( $_[ARG0] =~ m!/(QUOTE)\s+(PASS\s+\d+)!i ) {
1050                            warn ">> $1 | $2\n";
1051                            $_[KERNEL]->post( $irc => lc($1) => $2);
1052                    }
1053            },
1054      _child => sub {},      _child => sub {},
1055      _default => sub {      _default => sub {
1056                  _log sprintf "sID:%s %s %s",                  _log sprintf "sID:%s %s %s",
# Line 1055  sub root_handler { Line 1133  sub root_handler {
1133          }          }
1134    
1135          my $search = $q->param('search') || $q->param('grep') || '';          my $search = $q->param('search') || $q->param('grep') || '';
1136            my $r_url = $request->url;
1137    
1138            my @commands = qw( tags last-tag follow stat );
1139            my $commands_re = join('|',@commands);
1140    
1141          if ($request->url =~ m#/rss(?:/(tags|last-tag|follow.*)\w*(?:=(\d+))?)?#i) {          if ($r_url =~ m#/rss(?:/($commands_re.*)\w*(?:=(\d+))?)?#i) {
1142                  my $show = lc($1);                  my $show = lc($1);
1143                  my $nr = $2;                  my $nr = $2;
1144    
# Line 1070  sub root_handler { Line 1152  sub root_handler {
1152                  my $feed = XML::Feed->new( $type );                  my $feed = XML::Feed->new( $type );
1153                  $feed->link( $url );                  $feed->link( $url );
1154    
1155                    my $rc = RC_OK;
1156    
1157                  if ( $show eq 'tags' ) {                  if ( $show eq 'tags' ) {
1158                          $nr ||= 50;                          $nr ||= 50;
1159                          $feed->title( "tags from $CHANNEL" );                          $feed->title( "tags from $CHANNEL" );
# Line 1139  sub root_handler { Line 1223  sub root_handler {
1223                                  $feed->add_entry( $feed_entry );                                  $feed->add_entry( $feed_entry );
1224                          }                          }
1225    
1226                    } elsif ( $show =~ m/^stat/ ) {
1227    
1228                            my $feed_entry = XML::Feed::Entry->new($type);
1229                            $feed_entry->title( "Internal stats" );
1230                            $feed_entry->content(
1231                                    '<![CDATA[<pre>' . dump( $_stat ) . '</pre>]]>'
1232                            );
1233                            $feed->add_entry( $feed_entry );
1234    
1235                  } else {                  } else {
1236                          _log "unknown rss request ",$request->url;                          _log "unknown rss request $r_url";
1237                          return RC_DENY;                          $feed->title( "unknown $r_url" );
1238                            foreach my $c ( @commands ) {
1239                                    my $feed_entry = XML::Feed::Entry->new($type);
1240                                    $feed_entry->title( "rss/$c" );
1241                                    $feed_entry->link( "$url/rss/$c" );
1242                                    $feed->add_entry( $feed_entry );
1243                            }
1244                            $rc = RC_DENY;
1245                  }                  }
1246    
1247                  $response->content( $feed->as_xml );                  $response->content( $feed->as_xml );
1248                  return RC_OK;                  return $rc;
1249          }          }
1250    
1251          if ( $@ ) {          if ( $@ ) {
Legend:
Removed from v.95  
changed lines
  Added in v.112
  ViewVC Help
Powered by ViewVC 1.1.26