/[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 6 - (show annotations)
Mon Feb 27 12:41:10 2006 UTC (18 years, 1 month ago) by dpavlin
Original Path: trunk/irc-logger.pl
File MIME type: text/plain
File size: 4633 byte(s)
use Encode to convert into ISO-8859-2
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';
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 (map
105 {
106 ;"irc_$_" => sub { }}
107 qw(join
108 ctcp_version
109 connected snotice ctcp_action ping notice mode part quit
110 001 002 003 004 005
111 250 251 252 253 254 265 266
112 332 333 353 366 372 375 376
113 477
114 )),
115 _child => sub {},
116 _default => sub {
117 printf "%s: session %s caught an unhandled %s event.\n",
118 scalar localtime(), $_[SESSION]->ID, $_[ARG0];
119 print "The $_[ARG0] event was given these parameters: ",
120 join(" ", map({"ARRAY" eq ref $_ ? "[@$_]" : "$_"} @{$_[ARG1]})), "\n";
121 0; # false for signals
122 },
123 my_add => sub {
124 my $trailing = $_[ARG0];
125 my $session = $_[SESSION];
126 POE::Session->create
127 (inline_states =>
128 {_start => sub {
129 $_[HEAP]->{wheel} =
130 POE::Wheel::FollowTail->new
131 (
132 Filename => $FOLLOWS{$trailing},
133 InputEvent => 'got_line',
134 );
135 },
136 got_line => sub {
137 $_[KERNEL]->post($session => my_tailed =>
138 time, $trailing, $_[ARG0]);
139 },
140 },
141 );
142
143 },
144 my_tailed => sub {
145 my ($time, $file, $line) = @_[ARG0..ARG2];
146 ## $time will be undef on a probe, or a time value if a real line
147
148 ## PoCo::IRC has throttling built in, but no external visibility
149 ## so this is reaching "under the hood"
150 $SEND_QUEUE ||=
151 $_[KERNEL]->alias_resolve($IRC_ALIAS)->get_heap->{send_queue};
152
153 ## handle "no need to keep skipping" transition
154 if ($SKIPPING and @$SEND_QUEUE < 1) {
155 $_[KERNEL]->post($IRC_ALIAS => privmsg => $CHANNEL =>
156 "[discarded $SKIPPING messages]");
157 $SKIPPING = 0;
158 }
159
160 ## handle potential message display
161 if ($time) {
162 if ($SKIPPING or @$SEND_QUEUE > 3) { # 3 msgs per 10 seconds
163 $SKIPPING++;
164 } else {
165 my @time = localtime $time;
166 $_[KERNEL]->post($IRC_ALIAS => privmsg => $CHANNEL =>
167 sprintf "%02d:%02d:%02d: %s: %s",
168 ($time[2] + 11) % 12 + 1, $time[1], $time[0],
169 $file, $line);
170 }
171 }
172
173 ## handle re-probe/flush if skipping
174 if ($SKIPPING) {
175 $_[KERNEL]->delay($_[STATE] => 0.5); # $time will be undef
176 }
177
178 },
179 my_heartbeat => sub {
180 $_[KERNEL]->yield(my_tailed => time, "heartbeat", "beep");
181 $_[KERNEL]->delay($_[STATE] => 10);
182 }
183 },
184 );
185
186 POE::Kernel->run;

Properties

Name Value
svn:executable *

  ViewVC Help
Powered by ViewVC 1.1.26