/[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

Contents of /trunk/bin/irc-logger.pl

Parent Directory Parent Directory | Revision Log Revision Log


Revision 7 - (show annotations)
Wed Mar 1 21:29:14 2006 UTC (14 years, 10 months ago) by dpavlin
Original Path: trunk/irc-logger.pl
File MIME type: text/plain
File size: 5588 byte(s)
implemented trivial irc_505 for freenode.net, implemented /msg stat [number] to get some
statistics about most active users

1 #!/usr/bin/perl -w
2 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
20
21 my $NICK = 'irc-logger-dev';
22 my $CONNECT =
23 {Server => 'irc.freenode.net',
24 Nick => $NICK,
25 Ircname => 'logger: ask dpavlin@rot13.org'
26 };
27 my $CHANNEL = '#razmjenavjestina';
28 my $IRC_ALIAS = "log";
29
30 my %FOLLOWS =
31 (
32 ACCESS => "/var/log/apache/access.log",
33 ERROR => "/var/log/apache/error.log",
34 );
35
36 my $DSN = 'DBI:Pg:dbname=irc-logger';
37
38 ## END CONFIG
39
40
41
42 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);
80
81 POE::Session->create
82 (inline_states =>
83 {_start => sub {
84 $_[KERNEL]->post($IRC_ALIAS => register => 'all');
85 $_[KERNEL]->post($IRC_ALIAS => connect => $CONNECT);
86 },
87 irc_255 => sub { # server is done blabbing
88 $_[KERNEL]->post($IRC_ALIAS => join => $CHANNEL);
89 $_[KERNEL]->post($IRC_ALIAS => join => '#logger');
90 $_[KERNEL]->yield("heartbeat"); # start heartbeat
91 # $_[KERNEL]->yield("my_add", $_) for keys %FOLLOWS;
92 },
93 irc_public => sub {
94 my $kernel = $_[KERNEL];
95 my $nick = (split /!/, $_[ARG0])[0];
96 my $channel = $_[ARG1]->[0];
97 my $msg = $_[ARG2];
98
99 from_to($msg, 'UTF-8', 'ISO-8859-2');
100
101 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;
111
112 print "<< $msg\n";
113
114 if ($msg =~ m/^stat.*\s*(\d*)/) {
115
116 my $nr = $1 || 10;
117
118 my $sth = $dbh->prepare(qq{
119 select nick,count(*) from log group by nick order by count desc limit $nr
120 });
121 $sth->execute();
122 $res = "Top $nr users: ";
123 while (my $row = $sth->fetchrow_hashref) {
124 $res .= $row->{nick} . ': ' . $row->{count} . ", ";
125 }
126 }
127
128 $res =~ s/,\s*$//;
129 print ">> [$nick] $res\n";
130
131 from_to($res, 'ISO-8859-2', 'UTF-8');
132 $_[KERNEL]->post( $IRC_ALIAS => privmsg => $nick, $res );
133
134 },
135 irc_505 => sub {
136 print "# irc_505: ",$_[ARG1], "\n";
137 $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "register $NICK" );
138 warn "## register $NICK\n";
139 $_[KERNEL]->post( $IRC_ALIAS => privmsg => 'nickserv', "IDENTIFY $NICK" );
140 warn "## indetify $NICK\n";
141 },
142 (map
143 {
144 ;"irc_$_" => sub { }}
145 qw(join
146 ctcp_version
147 connected snotice ctcp_action ping notice mode part quit
148 001 002 003 004 005
149 250 251 252 253 254 265 266
150 332 333 353 366 372 375 376
151 477
152 )),
153 _child => sub {},
154 _default => sub {
155 printf "%s: session %s caught an unhandled %s event.\n",
156 scalar localtime(), $_[SESSION]->ID, $_[ARG0];
157 print "The $_[ARG0] event was given these parameters: ",
158 join(" ", map({"ARRAY" eq ref $_ ? "[@$_]" : "$_"} @{$_[ARG1]})), "\n";
159 0; # false for signals
160 },
161 my_add => sub {
162 my $trailing = $_[ARG0];
163 my $session = $_[SESSION];
164 POE::Session->create
165 (inline_states =>
166 {_start => sub {
167 $_[HEAP]->{wheel} =
168 POE::Wheel::FollowTail->new
169 (
170 Filename => $FOLLOWS{$trailing},
171 InputEvent => 'got_line',
172 );
173 },
174 got_line => sub {
175 $_[KERNEL]->post($session => my_tailed =>
176 time, $trailing, $_[ARG0]);
177 },
178 },
179 );
180
181 },
182 my_tailed => sub {
183 my ($time, $file, $line) = @_[ARG0..ARG2];
184 ## $time will be undef on a probe, or a time value if a real line
185
186 ## PoCo::IRC has throttling built in, but no external visibility
187 ## so this is reaching "under the hood"
188 $SEND_QUEUE ||=
189 $_[KERNEL]->alias_resolve($IRC_ALIAS)->get_heap->{send_queue};
190
191 ## handle "no need to keep skipping" transition
192 if ($SKIPPING and @$SEND_QUEUE < 1) {
193 $_[KERNEL]->post($IRC_ALIAS => privmsg => $CHANNEL =>
194 "[discarded $SKIPPING messages]");
195 $SKIPPING = 0;
196 }
197
198 ## handle potential message display
199 if ($time) {
200 if ($SKIPPING or @$SEND_QUEUE > 3) { # 3 msgs per 10 seconds
201 $SKIPPING++;
202 } else {
203 my @time = localtime $time;
204 $_[KERNEL]->post($IRC_ALIAS => privmsg => $CHANNEL =>
205 sprintf "%02d:%02d:%02d: %s: %s",
206 ($time[2] + 11) % 12 + 1, $time[1], $time[0],
207 $file, $line);
208 }
209 }
210
211 ## handle re-probe/flush if skipping
212 if ($SKIPPING) {
213 $_[KERNEL]->delay($_[STATE] => 0.5); # $time will be undef
214 }
215
216 },
217 my_heartbeat => sub {
218 $_[KERNEL]->yield(my_tailed => time, "heartbeat", "beep");
219 $_[KERNEL]->delay($_[STATE] => 10);
220 }
221 },
222 );
223
224 POE::Kernel->run;

Properties

Name Value
svn:executable *

  ViewVC Help
Powered by ViewVC 1.1.26