source: perl/modules/IRC/lib/BarnOwl/Module/IRC/Connection.pm @ 618a980

release-1.10release-1.5release-1.6release-1.7release-1.8release-1.9
Last change on this file since 618a980 was 618a980, checked in by Nelson Elhage <nelhage@mit.edu>, 15 years ago
irc-disconnect on a pending reconnect should cancel the reconnect
  • Property mode set to 100644
File size: 11.7 KB
Line 
1use strict;
2use warnings;
3
4package BarnOwl::Module::IRC::Connection;
5use BarnOwl::Timer;
6
7=head1 NAME
8
9BarnOwl::Module::IRC::Connection
10
11=head1 DESCRIPTION
12
13This module is a wrapper around Net::IRC::Connection for BarnOwl's IRC
14support
15
16=cut
17
18use Net::IRC::Connection;
19
20use base qw(Class::Accessor Exporter);
21__PACKAGE__->mk_accessors(qw(conn alias channels motd names_tmp whois_tmp));
22our @EXPORT_OK = qw(&is_private);
23
24use BarnOwl;
25
26BEGIN {
27    no strict 'refs';
28    my @delegate = qw(nick server);
29    for my $meth (@delegate) {
30        *{"BarnOwl::Module::IRC::Connection::$meth"} = sub {
31            shift->conn->$meth(@_);
32        }
33    }
34};
35
36sub new {
37    my $class = shift;
38    my $irc = shift;
39    my $alias = shift;
40    my %args = (@_);
41    my $conn = Net::IRC::Connection->new($irc, %args);
42    my $self = bless({}, $class);
43    $self->conn($conn);
44    $self->alias($alias);
45    $self->channels([]);
46    $self->motd("");
47    $self->names_tmp(0);
48    $self->whois_tmp("");
49
50    $self->conn->add_default_handler(sub { shift; $self->on_event(@_) });
51    $self->conn->add_handler(['msg', 'notice', 'public', 'caction'],
52            sub { shift; $self->on_msg(@_) });
53    $self->conn->add_handler(['welcome', 'yourhost', 'created',
54                              'luserclient', 'luserop', 'luserchannels', 'luserme',
55                              'error'],
56            sub { shift; $self->on_admin_msg(@_) });
57    $self->conn->add_handler(['myinfo', 'map', 'n_local', 'n_global',
58            'luserconns'],
59            sub { });
60    $self->conn->add_handler(motdstart => sub { shift; $self->on_motdstart(@_) });
61    $self->conn->add_handler(motd      => sub { shift; $self->on_motd(@_) });
62    $self->conn->add_handler(endofmotd => sub { shift; $self->on_endofmotd(@_) });
63    $self->conn->add_handler(join      => sub { shift; $self->on_join(@_) });
64    $self->conn->add_handler(part      => sub { shift; $self->on_part(@_) });
65    $self->conn->add_handler(quit      => sub { shift; $self->on_quit(@_) });
66    $self->conn->add_handler(disconnect => sub { shift; $self->on_disconnect(@_) });
67    $self->conn->add_handler(nicknameinuse => sub { shift; $self->on_nickinuse(@_) });
68    $self->conn->add_handler(cping     => sub { shift; $self->on_ping(@_) });
69    $self->conn->add_handler(topic     => sub { shift; $self->on_topic(@_) });
70    $self->conn->add_handler(topicinfo => sub { shift; $self->on_topicinfo(@_) });
71    $self->conn->add_handler(namreply  => sub { shift; $self->on_namreply(@_) });
72    $self->conn->add_handler(endofnames=> sub { shift; $self->on_endofnames(@_) });
73    $self->conn->add_handler(endofwhois=> sub { shift; $self->on_endofwhois(@_) });
74    $self->conn->add_handler(mode      => sub { shift; $self->on_mode(@_) });
75    $self->conn->add_handler(nosuchchannel => sub { shift; $self->on_nosuchchannel(@_) });
76
77    return $self;
78}
79
80sub getSocket
81{
82    my $self = shift;
83    return $self->conn->socket;
84}
85
86################################################################################
87############################### IRC callbacks ##################################
88################################################################################
89
90sub new_message {
91    my $self = shift;
92    my $evt = shift;
93    return BarnOwl::Message->new(
94        type        => 'IRC',
95        server      => $self->server,
96        network     => $self->alias,
97        sender      => $evt->nick,
98        hostname    => $evt->host,
99        from        => $evt->from,
100        @_
101       );
102}
103
104sub on_msg {
105    my ($self, $evt) = @_;
106    my ($recipient) = $evt->to;
107    my $body = strip_irc_formatting([$evt->args]->[0]);
108    my $nick = $self->nick;
109    $body = '* '.$evt->nick.' '.$body if $evt->type eq 'caction';
110    my $msg = $self->new_message($evt,
111        direction   => 'in',
112        recipient   => $recipient,
113        body => $body,
114        $evt->type eq 'notice' ?
115          (notice     => 'true') : (),
116        is_private($recipient) ?
117          (private  => 'true') : (channel => $recipient),
118        replycmd    => BarnOwl::quote('irc-msg', '-a', $self->alias,
119          (is_private($recipient) ? $evt->nick : $recipient)),
120        replysendercmd => BarnOwl::quote('irc-msg', '-a', $self->alias, $evt->nick),
121       );
122
123    BarnOwl::queue_message($msg);
124}
125
126sub on_ping {
127    my ($self, $evt) = @_;
128    $self->conn->ctcp_reply($evt->nick, join (' ', ($evt->args)));
129}
130
131sub on_admin_msg {
132    my ($self, $evt) = @_;
133    return if BarnOwl::Module::IRC->skip_msg($evt->type);
134    BarnOwl::admin_message("IRC",
135            BarnOwl::Style::boldify('IRC ' . $evt->type . ' message from '
136                . $self->alias) . "\n"
137            . strip_irc_formatting(join ' ', cdr($evt->args)));
138}
139
140sub on_motdstart {
141    my ($self, $evt) = @_;
142    $self->motd(join "\n", cdr($evt->args));
143}
144
145sub on_motd {
146    my ($self, $evt) = @_;
147    $self->motd(join "\n", $self->motd, cdr($evt->args));
148}
149
150sub on_endofmotd {
151    my ($self, $evt) = @_;
152    $self->motd(join "\n", $self->motd, cdr($evt->args));
153    BarnOwl::admin_message("IRC",
154            BarnOwl::Style::boldify('MOTD for ' . $self->alias) . "\n"
155            . strip_irc_formatting($self->motd));
156}
157
158sub on_join {
159    my ($self, $evt) = @_;
160    my $msg = $self->new_message($evt,
161        loginout   => 'login',
162        action     => 'join',
163        channel    => $evt->to,
164        replycmd   => BarnOwl::quote('irc-msg', '-a', $self->alias, $evt->to),
165        replysendercmd => BarnOwl::quote('irc-msg', '-a', $self->alias, $evt->nick),
166        );
167    BarnOwl::queue_message($msg);
168    push @{$self->channels}, $evt->to;
169}
170
171sub on_part {
172    my ($self, $evt) = @_;
173    my $msg = $self->new_message($evt,
174        loginout   => 'logout',
175        action     => 'part',
176        channel    => $evt->to,
177        replycmd   => BarnOwl::quote('irc-msg', '-a', $self->alias, $evt->to),
178        replysendercmd => BarnOwl::quote('irc-msg', '-a', $self->alias, $evt->nick),
179        );
180    BarnOwl::queue_message($msg);
181    $self->channels([ grep {$_ ne $evt->to} @{$self->channels}]);
182}
183
184sub on_quit {
185    my ($self, $evt) = @_;
186    my $msg = $self->new_message($evt,
187        loginout   => 'logout',
188        action     => 'quit',
189        from       => $evt->to,
190        reason     => [$evt->args]->[0],
191        replycmd   => BarnOwl::quote('irc-msg', '-a', $self->alias, $evt->nick),
192        replysendercmd => BarnOwl::quote('irc-msg', '-a', $self->alias, $evt->nick),
193        );
194    BarnOwl::queue_message($msg);
195}
196
197sub disconnect {
198    my $self = shift;
199    delete $BarnOwl::Module::IRC::ircnets{$self->alias};
200    for my $k (keys %BarnOwl::Module::IRC::channels) {
201        my @conns = grep {$_ ne $self} @{$BarnOwl::Module::IRC::channels{$k}};
202        if(@conns) {
203            $BarnOwl::Module::IRC::channels{$k} = \@conns;
204        } else {
205            delete $BarnOwl::Module::IRC::channels{$k};
206        }
207    }
208    BarnOwl::remove_io_dispatch($self->{FD});
209    $self->motd("");
210}
211
212sub on_disconnect {
213    my ($self, $evt) = @_;
214    $self->disconnect;
215    BarnOwl::admin_message('IRC',
216                           "[" . $self->alias . "] Disconnected from server");
217    if ($evt->format and $evt->format eq "error") {
218        $self->schedule_reconnect;
219    } else {
220        $self->channels([]);
221    }
222}
223
224sub on_nickinuse {
225    my ($self, $evt) = @_;
226    BarnOwl::admin_message("IRC",
227                           "[" . $self->alias . "] " .
228                           [$evt->args]->[1] . ": Nick already in use");
229    $self->disconnect unless $self->motd;
230}
231
232sub on_topic {
233    my ($self, $evt) = @_;
234    my @args = $evt->args;
235    if (scalar @args > 1) {
236        BarnOwl::admin_message("IRC",
237                "Topic for $args[1] on " . $self->alias . " is $args[2]");
238    } else {
239        BarnOwl::admin_message("IRC",
240                "Topic changed to $args[0]");
241    }
242}
243
244sub on_topicinfo {
245    my ($self, $evt) = @_;
246    my @args = $evt->args;
247    BarnOwl::admin_message("IRC",
248        "Topic for $args[1] set by $args[2] at " . localtime($args[3]));
249}
250
251# IRC gives us a bunch of namreply messages, followed by an endofnames.
252# We need to collect them from the namreply and wait for the endofnames message.
253# After this happens, the names_tmp variable is cleared.
254
255sub on_namreply {
256    my ($self, $evt) = @_;
257    return unless $self->names_tmp;
258    $self->names_tmp([@{$self->names_tmp}, split(' ', [$evt->args]->[3])]);
259}
260
261sub on_endofnames {
262    my ($self, $evt) = @_;
263    return unless $self->names_tmp;
264    my $names = BarnOwl::Style::boldify("Members of " . [$evt->args]->[1] . ":\n");
265    for my $name (@{$self->names_tmp}) {
266        $names .= "  $name\n";
267    }
268    BarnOwl::popless_ztext($names);
269    $self->names_tmp(0);
270}
271
272sub on_whois {
273    my ($self, $evt) = @_;
274    $self->whois_tmp(
275      $self->whois_tmp . "\n" . $evt->type . ":\n  " .
276      join("\n  ", cdr(cdr($evt->args))) . "\n"
277    );
278}
279
280sub on_endofwhois {
281    my ($self, $evt) = @_;
282    BarnOwl::popless_ztext(
283        BarnOwl::Style::boldify("/whois for " . [$evt->args]->[1] . ":\n") .
284        $self->whois_tmp
285    );
286    $self->whois_tmp('');
287}
288
289sub on_mode {
290    my ($self, $evt) = @_;
291    BarnOwl::admin_message("IRC",
292                           "[" . $self->alias . "] User " . ($evt->nick) . + " set mode " .
293                           join(" ", $evt->args) . "on " . $evt->to->[0]
294                          );
295}
296
297sub on_nosuchchannel {
298    my ($self, $evt) = @_;
299    BarnOwl::admin_message("IRC",
300                           "[" . $self->alias . "] " .
301                           "No such channel: " . [$evt->args]->[1])
302}
303
304sub on_event {
305    my ($self, $evt) = @_;
306    return on_whois(@_) if ($evt->type =~ /^whois/);
307    BarnOwl::admin_message("IRC",
308            "[" . $self->alias . "] Unhandled IRC event of type " . $evt->type . ":\n"
309            . strip_irc_formatting(join("\n", $evt->args)))
310        if BarnOwl::getvar('irc:spew') eq 'on';
311}
312
313sub schedule_reconnect {
314    my $self = shift;
315    my $interval = shift || 5;
316    delete $BarnOwl::Module::IRC::ircnets{$self->alias};
317    $BarnOwl::Module::IRC::reconnect{$self->alias} =
318        BarnOwl::Timer->new( {
319            after => $interval,
320            cb    => sub {
321                $self->reconnect( $interval );
322            },
323        } );
324    $BarnOwl::Module::IRC::reconnect{$self->alias}{conn} = $self;
325}
326
327sub connected {
328    my $self = shift;
329    my $msg = shift;
330    BarnOwl::admin_message("IRC", $msg);
331    delete $BarnOwl::Module::IRC::reconnect{$self->alias};
332    $BarnOwl::Module::IRC::ircnets{$self->alias} = $self;
333    my $fd = $self->getSocket()->fileno();
334    BarnOwl::add_io_dispatch($fd, 'r', \&BarnOwl::Module::IRC::OwlProcess);
335    $self->{FD} = $fd;
336}
337
338sub reconnect {
339    my $self = shift;
340    my $backoff = shift;
341
342    $self->conn->connect;
343    if ($self->conn->connected) {
344        $self->connected("Reconnected to ".$self->alias);
345        my @channels = @{$self->channels};
346        $self->channels([]);
347        $self->conn->join($_) for @channels;
348        return;
349    }
350
351    $backoff *= 2;
352    $backoff = 60*5 if $backoff > 60*5;
353    $self->schedule_reconnect( $backoff );
354}
355
356################################################################################
357########################### Utilities/Helpers ##################################
358################################################################################
359
360sub strip_irc_formatting {
361    my $body = shift;
362    # Strip mIRC colors. If someone wants to write code to convert
363    # these to zephyr colors, be my guest.
364    $body =~ s/\cC\d+(?:,\d+)?//g;
365    $body =~ s/\cO//g;
366   
367    my @pieces = split /\cB/, $body;
368    my $out = '';
369    while(@pieces) {
370        $out .= shift @pieces;
371        $out .= BarnOwl::Style::boldify(shift @pieces) if @pieces;
372    }
373    return $out;
374}
375
376# Determines if the given message recipient is a username, as opposed to
377# a channel that starts with # or &.
378sub is_private {
379    return shift !~ /^[\#\&]/;
380}
381
382sub cdr {
383    shift;
384    return @_;
385}
386
3871;
Note: See TracBrowser for help on using the repository browser.