/[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 4 by dpavlin, Mon Feb 27 11:54:38 2006 UTC revision 8 by dpavlin, Wed Mar 1 22:42:21 2006 UTC
# Line 2  Line 2 
2  use strict;  use strict;
3  $|++;  $|++;
4    
5    =head1 NAME
6    
7    irc-logger.pl
8    
9    =head1 SYNOPSIS
10    
11    ./irc-logger.pl
12    
13    =head1 DESCRIPTION
14    
15    log all conversation on irc channel
16    
17    =cut
18    
19  ## CONFIG  ## CONFIG
20    
21  my $NICK = 'irc-logger';  my $NICK = 'irc-logger-dev';
22  my $CONNECT =  my $CONNECT =
23    {Server => 'irc.freenode.net',    {Server => 'irc.freenode.net',
24     Nick => $NICK,     Nick => $NICK,
25     Ircname => 'logger: ask dpavlin@rot13.org'     Ircname => "try /msg $NICK help",
26    };    };
27  my $CHANNEL = '#razmjenavjestina';  my $CHANNEL = '#razmjenavjestina';
28  my $IRC_ALIAS = "log";  my $IRC_ALIAS = "log";
# Line 19  my %FOLLOWS = Line 33  my %FOLLOWS =
33     ERROR => "/var/log/apache/error.log",     ERROR => "/var/log/apache/error.log",
34    );    );
35    
36    my $DSN = 'DBI:Pg:dbname=irc-logger';
37    
38  ## END CONFIG  ## END CONFIG
39    
40  my $SKIPPING = 0;               # if skipping, how many we've done  
 my $SEND_QUEUE;                 # cache  
41    
42  use POE qw(Component::IRC Wheel::FollowTail);  use POE qw(Component::IRC Wheel::FollowTail);
43    use DBI;
44    use Encode qw/from_to/;
45    
46    
47    my $dbh = DBI->connect($DSN,"","", { RaiseError => 1, AutoCommit => 1 }) || die $DBI::errstr;
48    
49    =for SQL schema
50    
51    $dbh->do(qq{
52    create table log (
53            id serial,
54            time timestamp default now(),
55            channel text not null,
56            nick text not null,
57            message text not null,
58            primary key(id)
59    );
60    
61    create index log_time on log(time);
62    create index log_channel on log(channel);
63    create index log_nick on log(nick);
64    
65    });
66    
67    =cut
68    
69    my $sth = $dbh->prepare(qq{
70    insert into log
71            (channel, nick, message)
72    values (?,?,?)
73    });
74    
75    
76    my $SKIPPING = 0;               # if skipping, how many we've done
77    my $SEND_QUEUE;                 # cache
78    
79  POE::Component::IRC->new($IRC_ALIAS);  POE::Component::IRC->new($IRC_ALIAS);
80    
81  POE::Session->create  POE::Session->create
82    (inline_states =>    (inline_states =>
83     {_start => sub {           {_start => sub {      
84        $_[KERNEL]->post($IRC_ALIAS => register => 'all');                  $_[KERNEL]->post($IRC_ALIAS => register => 'all');
85        $_[KERNEL]->post($IRC_ALIAS => connect => $CONNECT);                  $_[KERNEL]->post($IRC_ALIAS => connect => $CONNECT);
86      },      },
87      irc_255 => sub {            # server is done blabbing      irc_255 => sub {            # server is done blabbing
88        $_[KERNEL]->post($IRC_ALIAS => join => $CHANNEL);                  $_[KERNEL]->post($IRC_ALIAS => join => $CHANNEL);
89        $_[KERNEL]->post($IRC_ALIAS => join => '#logger');                  $_[KERNEL]->post($IRC_ALIAS => join => '#logger');
90        $_[KERNEL]->yield("heartbeat"); # start heartbeat                  $_[KERNEL]->yield("heartbeat"); # start heartbeat
91  #      $_[KERNEL]->yield("my_add", $_) for keys %FOLLOWS;  #               $_[KERNEL]->yield("my_add", $_) for keys %FOLLOWS;
92      },      },
93      irc_public => sub {      irc_public => sub {
94            my $kernel = $_[KERNEL];                  my $kernel = $_[KERNEL];
95            my $nick = (split /!/, $_[ARG0])[0];                  my $nick = (split /!/, $_[ARG0])[0];
96            my $channel = $_[ARG1]->[0];                  my $channel = $_[ARG1]->[0];
97            my $msg = $_[ARG2];                  my $msg = $_[ARG2];
98    
99                    from_to($msg, 'UTF-8', 'ISO-8859-2');
100    
101            print "$channel: <$nick> $msg\n";                  print "$channel: <$nick> $msg\n";
102                    $sth->execute($channel, $nick, $msg);
103      },      },
104            irc_msg => sub {
105                    my $kernel = $_[KERNEL];
106                    my $nick = (split /!/, $_[ARG0])[0];
107                    my $msg = $_[ARG2];
108                    from_to($msg, 'UTF-8', 'ISO-8859-2');
109    
110                    my $res = "unknown command '$msg', try /msg $NICK help!";
111    
112                    print "<< $msg\n";
113    
114                    if ($msg =~ m/^help/i) {
115    
116                            $res = "usage: /msg $NICK stat - shows user statistics | /msg $NICK last - show backtrace of conversations";
117    
118                    } elsif ($msg =~ m/^stat.*?\s*(\d*)/i) {
119    
120                            my $nr = $1 || 10;
121    
122                            my $sth = $dbh->prepare(qq{
123                                    select nick,count(*) from log group by nick order by count desc limit $nr
124                            });
125                            $sth->execute();
126                            $res = "Top $nr users: ";
127                            my @users;
128                            while (my $row = $sth->fetchrow_hashref) {
129                                    push @users,$row->{nick} . ': ' . $row->{count};
130                            }
131                            $res .= join(" | ", @users);
132                    } elsif ($msg =~ m/^last.*?\s*(\d*)/i) {
133    
134                            my $nr = $1 || 10;
135    
136                            my $sth = $dbh->prepare(qq{
137                                    select
138                                            time::date as date,
139                                            time::time as time,
140                                            channel,
141                                            nick,
142                                            message
143                                    from log order by time desc limit $nr
144                            });
145                            $sth->execute();
146                            $res = "Last $nr messages: ";
147                            my $last_row = {
148                                    date => '',
149                                    time => '',
150                                    channel => '',
151                                    nick => '',
152                            };
153    
154                            my @rows;
155    
156                            while (my $row = $sth->fetchrow_hashref) {
157                                    unshift @rows, $row;
158                            }
159    
160                            my @msgs;
161    
162                            foreach my $row (@rows) {
163    
164                                    $row->{time} =~ s#\.\d+##;
165    
166                                    my $t;
167                                    $t = $row->{date} . ' ' if ($last_row->{date} ne $row->{date});
168                                    $t .= $row->{time};
169    
170                                    my $msg = '';
171    
172                                    $msg .= "($t";
173                                    $msg .= ' ' . $row->{channel} if ($last_row->{channel} ne $row->{channel});
174                                    $msg .= ") ";
175    
176                                    $msg .= $row->{nick} . ': '  if ($last_row->{nick} ne $row->{nick});
177    
178                                    $msg .= $row->{message};
179    
180                                    push @msgs, $msg;
181    
182                                    $last_row = $row;
183                            }
184    
185                            foreach my $res (@msgs) {
186                                    print "last: $res\n";
187                                    from_to($res, 'ISO-8859-2', 'UTF-8');
188                                    $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );
189                            }
190    
191                            $res = '';
192                    }
193    
194                    if ($res) {
195                            print ">> [$nick] $res\n";
196                            from_to($res, 'ISO-8859-2', 'UTF-8');
197                            $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );
198                    }
199    
200            },
201            irc_505 => sub {
202            print "# irc_505: ",$_[ARG1], "\n";
203                    $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "register $NICK" );
204                    warn "## register $NICK\n";
205            },
206            irc_registered => sub {
207                    $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "IDENTIFY $NICK" );
208                    warn "## indetify $NICK\n";
209            },
210      (map      (map
211       {       {
212         ;"irc_$_" => sub { }}         ;"irc_$_" => sub { }}
# Line 56  POE::Session->create Line 215  POE::Session->create
215          connected snotice ctcp_action ping notice mode part quit          connected snotice ctcp_action ping notice mode part quit
216          001 002 003 004 005          001 002 003 004 005
217          250 251 252 253 254 265 266          250 251 252 253 254 265 266
218          332 333 353 366 372 375 376)),          332 333 353 366 372 375 376
219                    477
220                    )),
221      _child => sub {},      _child => sub {},
222      _default => sub {      _default => sub {
223        printf "%s: session %s caught an unhandled %s event.\n",        printf "%s: session %s caught an unhandled %s event.\n",
Legend:
Removed from v.4  
changed lines
  Added in v.8
  ViewVC Help
Powered by ViewVC 1.1.26