source: perl/modules/IRC/lib/BarnOwl/Module/IRC/Connection.pm @ 32620ac

debianrelease-1.4release-1.5release-1.6release-1.7release-1.8release-1.9
Last change on this file since 32620ac was 32620ac, checked in by Nelson Elhage <nelhage@mit.edu>, 12 years ago
IRC: Don't beep on messages matching your nick. Having this feature in there and not customizable is extremely poor form, and we already have the 'personalbell' variable to enable this feature if needed.
  • Property mode set to 100644
File size: 9.8 KB
RevLine 
[b38b0b2]1use strict;
2use warnings;
3
4package BarnOwl::Module::IRC::Connection;
5
6=head1 NAME
7
8BarnOwl::Module::IRC::Connection
9
10=head1 DESCRIPTION
11
[ba2ca66]12This module is a wrapper around Net::IRC::Connection for BarnOwl's IRC
[b38b0b2]13support
14
15=cut
16
[ba2ca66]17use Net::IRC::Connection;
18
19use base qw(Class::Accessor Exporter);
[38cfdb5d]20__PACKAGE__->mk_accessors(qw(conn alias channels connected motd names_tmp whois_tmp));
[2c40dc0]21our @EXPORT_OK = qw(&is_private);
[b38b0b2]22
23use BarnOwl;
24
[ba2ca66]25BEGIN {
26    no strict 'refs';
27    my @delegate = qw(nick server);
28    for my $meth (@delegate) {
29        *{"BarnOwl::Module::IRC::Connection::$meth"} = sub {
30            shift->conn->$meth(@_);
31        }
32    }
33};
34
[b38b0b2]35sub new {
36    my $class = shift;
37    my $irc = shift;
38    my $alias = shift;
39    my %args = (@_);
[ba2ca66]40    my $conn = Net::IRC::Connection->new($irc, %args);
41    my $self = bless({}, $class);
42    $self->conn($conn);
[b38b0b2]43    $self->alias($alias);
44    $self->channels([]);
[ba2ca66]45    $self->motd("");
46    $self->connected(0);
[d264c6d]47    $self->names_tmp(0);
[38cfdb5d]48    $self->whois_tmp("");
[ba2ca66]49
[5ff830a]50    $self->conn->add_handler(376 => sub { shift; $self->on_connect(@_) });
[ba2ca66]51    $self->conn->add_default_handler(sub { shift; $self->on_event(@_) });
52    $self->conn->add_handler(['msg', 'notice', 'public', 'caction'],
53            sub { shift; $self->on_msg(@_) });
54    $self->conn->add_handler(['welcome', 'yourhost', 'created',
[661d2eb]55                              'luserclient', 'luserop', 'luserchannels', 'luserme',
56                              'error'],
[ba2ca66]57            sub { shift; $self->on_admin_msg(@_) });
58    $self->conn->add_handler(['myinfo', 'map', 'n_local', 'n_global',
[bc0d7bc]59            'luserconns'],
60            sub { });
[ba2ca66]61    $self->conn->add_handler(motdstart => sub { shift; $self->on_motdstart(@_) });
62    $self->conn->add_handler(motd      => sub { shift; $self->on_motd(@_) });
63    $self->conn->add_handler(endofmotd => sub { shift; $self->on_endofmotd(@_) });
64    $self->conn->add_handler(join      => sub { shift; $self->on_join(@_) });
65    $self->conn->add_handler(part      => sub { shift; $self->on_part(@_) });
[4789b17]66    $self->conn->add_handler(quit      => sub { shift; $self->on_quit(@_) });
[ba2ca66]67    $self->conn->add_handler(disconnect => sub { shift; $self->on_disconnect(@_) });
68    $self->conn->add_handler(nicknameinuse => sub { shift; $self->on_nickinuse(@_) });
69    $self->conn->add_handler(cping     => sub { shift; $self->on_ping(@_) });
[3ad15ff]70    $self->conn->add_handler(topic     => sub { shift; $self->on_topic(@_) });
71    $self->conn->add_handler(topicinfo => sub { shift; $self->on_topicinfo(@_) });
[38cfdb5d]72    $self->conn->add_handler(namreply  => sub { shift; $self->on_namreply(@_) });
73    $self->conn->add_handler(endofnames=> sub { shift; $self->on_endofnames(@_) });
[d264c6d]74    $self->conn->add_handler(endofwhois=> sub { shift; $self->on_endofwhois(@_) });
[4df2568]75    $self->conn->add_handler(mode      => sub { shift; $self->on_mode(@_) });
[b38b0b2]76
[330c55a]77    # * nosuchchannel
78    # *
79
[b38b0b2]80    return $self;
81}
82
[9c7a701]83sub getSocket
84{
85    my $self = shift;
86    return $self->conn->socket;
87}
88
[b38b0b2]89################################################################################
90############################### IRC callbacks ##################################
91################################################################################
92
[47b6a5f]93sub new_message {
94    my $self = shift;
95    my $evt = shift;
96    return BarnOwl::Message->new(
97        type        => 'IRC',
98        server      => $self->server,
99        network     => $self->alias,
100        sender      => $evt->nick,
101        hostname    => $evt->host,
102        from        => $evt->from,
103        @_
104       );
105}
106
[b38b0b2]107sub on_msg {
108    my ($self, $evt) = @_;
[2c40dc0]109    my ($recipient) = $evt->to;
110    my $body = strip_irc_formatting([$evt->args]->[0]);
[bc0d7bc]111    my $nick = $self->nick;
[3048f1f]112    $body = '* '.$evt->nick.' '.$body if $evt->type eq 'caction';
[47b6a5f]113    my $msg = $self->new_message($evt,
[b38b0b2]114        direction   => 'in',
[2c40dc0]115        recipient   => $recipient,
[47b6a5f]116        body => $body,
[2c40dc0]117        $evt->type eq 'notice' ?
118          (notice     => 'true') : (),
119        is_private($recipient) ?
[0e52069]120          (isprivate  => 'true') : (channel => $recipient),
[3c5fe43]121        replycmd    => 'irc-msg -a ' . $self->alias . ' ' .
[2c40dc0]122            (is_private($recipient) ? $evt->nick : $recipient),
[3c5fe43]123        replysendercmd => 'irc-msg -a ' . $self->alias . ' ' . $evt->nick
[b38b0b2]124       );
[47b6a5f]125
[b38b0b2]126    BarnOwl::queue_message($msg);
127}
128
[2c40dc0]129sub on_ping {
130    my ($self, $evt) = @_;
[ba2ca66]131    $self->conn->ctcp_reply($evt->nick, join (' ', ($evt->args)));
[2c40dc0]132}
133
[bc0d7bc]134sub on_admin_msg {
135    my ($self, $evt) = @_;
136    BarnOwl::admin_message("IRC",
137            BarnOwl::Style::boldify('IRC ' . $evt->type . ' message from '
[1951db8]138                . $self->alias) . "\n"
[d264c6d]139            . strip_irc_formatting(join ' ', cdr($evt->args)));
[bc0d7bc]140}
141
142sub on_motdstart {
143    my ($self, $evt) = @_;
[1af21e8]144    $self->motd(join "\n", cdr($evt->args));
[bc0d7bc]145}
146
147sub on_motd {
148    my ($self, $evt) = @_;
[1af21e8]149    $self->motd(join "\n", $self->motd, cdr($evt->args));
[bc0d7bc]150}
151
152sub on_endofmotd {
153    my ($self, $evt) = @_;
[1af21e8]154    $self->motd(join "\n", $self->motd, cdr($evt->args));
[ba2ca66]155    if(!$self->connected) {
[3baf77f]156        BarnOwl::admin_message("IRC", "Connected to " .
157                               $self->server . " (" . $self->alias . ")");
[ba2ca66]158        $self->connected(1);
[3baf77f]159       
160    }
[bc0d7bc]161    BarnOwl::admin_message("IRC",
[3baf77f]162            BarnOwl::Style::boldify('MOTD for ' . $self->alias) . "\n"
[ba2ca66]163            . strip_irc_formatting($self->motd));
[bc0d7bc]164}
165
[47b6a5f]166sub on_join {
167    my ($self, $evt) = @_;
168    my $msg = $self->new_message($evt,
169        loginout   => 'login',
[4789b17]170        action     => 'join',
[47b6a5f]171        channel    => $evt->to,
[d264c6d]172        replycmd => 'irc-msg -a ' . $self->alias . ' ' . join(' ', $evt->to),
[3c5fe43]173        replysendercmd => 'irc-msg -a ' . $self->alias . ' ' . $evt->nick
[47b6a5f]174        );
175    BarnOwl::queue_message($msg);
176}
177
178sub on_part {
179    my ($self, $evt) = @_;
180    my $msg = $self->new_message($evt,
181        loginout   => 'logout',
[4789b17]182        action     => 'part',
[47b6a5f]183        channel    => $evt->to,
[d264c6d]184        replycmd => 'irc-msg -a ' . $self->alias . ' ' . join(' ', $evt->to),
[3c5fe43]185        replysendercmd => 'irc-msg -a ' . $self->alias . ' ' . $evt->nick
[47b6a5f]186        );
187    BarnOwl::queue_message($msg);
188}
189
[4789b17]190sub on_quit {
191    my ($self, $evt) = @_;
192    my $msg = $self->new_message($evt,
193        loginout   => 'logout',
194        action     => 'quit',
195        from       => $evt->to,
196        reason     => [$evt->args]->[0],
197        replycmd => 'irc-msg -a ' . $self->alias . ' ' . $evt->nick,
198        replysendercmd => 'irc-msg -a ' . $self->alias . ' ' . $evt->nick
199        );
200    BarnOwl::queue_message($msg);
201}
202
[9e02bb7]203sub on_disconnect {
204    my $self = shift;
205    delete $BarnOwl::Module::IRC::ircnets{$self->alias};
[9c7a701]206    BarnOwl::remove_dispatch($self->{FD});
[9e02bb7]207    BarnOwl::admin_message('IRC',
208                           "[" . $self->alias . "] Disconnected from server");
209}
210
211sub on_nickinuse {
212    my ($self, $evt) = @_;
213    BarnOwl::admin_message("IRC",
214                           "[" . $self->alias . "] " .
215                           [$evt->args]->[1] . ": Nick already in use");
[ba2ca66]216    unless($self->connected) {
217        $self->conn->disconnect;
[eab7a4c]218    }
[9e02bb7]219}
220
[3ad15ff]221sub on_topic {
222    my ($self, $evt) = @_;
223    my @args = $evt->args;
224    if (scalar @args > 1) {
225        BarnOwl::admin_message("IRC",
226                "Topic for $args[1] on " . $self->alias . " is $args[2]");
227    } else {
228        BarnOwl::admin_message("IRC",
229                "Topic changed to $args[0]");
230    }
231}
232
233sub on_topicinfo {
234    my ($self, $evt) = @_;
235    my @args = $evt->args;
236    BarnOwl::admin_message("IRC",
237        "Topic for $args[1] set by $args[2] at " . localtime($args[3]));
238}
239
[38cfdb5d]240# IRC gives us a bunch of namreply messages, followed by an endofnames.
241# We need to collect them from the namreply and wait for the endofnames message.
242# After this happens, the names_tmp variable is cleared.
243
244sub on_namreply {
245    my ($self, $evt) = @_;
[d264c6d]246    return unless $self->names_tmp;
[38cfdb5d]247    $self->names_tmp([@{$self->names_tmp}, split(' ', [$evt->args]->[3])]);
248}
249
250sub on_endofnames {
251    my ($self, $evt) = @_;
[d264c6d]252    return unless $self->names_tmp;
[38cfdb5d]253    my $names = BarnOwl::Style::boldify("Members of " . [$evt->args]->[1] . ":\n");
254    for my $name (@{$self->names_tmp}) {
255        $names .= "  $name\n";
256    }
257    BarnOwl::popless_ztext($names);
[d264c6d]258    $self->names_tmp(0);
259}
260
261sub on_whois {
262    my ($self, $evt) = @_;
263    $self->whois_tmp(
264      $self->whois_tmp . "\n" . $evt->type . ":\n  " .
265      join("\n  ", cdr(cdr($evt->args))) . "\n"
266    );
267}
268
269sub on_endofwhois {
270    my ($self, $evt) = @_;
271    BarnOwl::popless_ztext(
272        BarnOwl::Style::boldify("/whois for " . [$evt->args]->[1] . ":\n") .
273        $self->whois_tmp
274    );
275    $self->whois_tmp([]);
276}
277
[4df2568]278sub on_mode {
279    my ($self, $evt) = @_;
280    BarnOwl::admin_message("IRC",
281                           "[" . $self->alias . "] User " . ($evt->nick) . + " set mode " .
282                           join(" ", $evt->args) . "on " . $evt->to->[0]
283                          );
284}
285
[d264c6d]286sub on_event {
287    my ($self, $evt) = @_;
288    return on_whois(@_) if ($evt->type =~ /^whois/);
289    BarnOwl::admin_message("IRC",
290            "[" . $self->alias . "] Unhandled IRC event of type " . $evt->type . ":\n"
291            . strip_irc_formatting(join("\n", $evt->args)))
292        if BarnOwl::getvar('irc:spew') eq 'on';
[38cfdb5d]293}
[9e02bb7]294
[b38b0b2]295################################################################################
296########################### Utilities/Helpers ##################################
297################################################################################
298
299sub strip_irc_formatting {
300    my $body = shift;
[214b790]301    # Strip mIRC colors. If someone wants to write code to convert
302    # these to zephyr colors, be my guest.
303    $body =~ s/\cC\d+(?:,\d+)?//g;
304    $body =~ s/\cO//g;
305   
306    my @pieces = split /\cB/, $body;
[3835ae8]307    my $out = '';
[b38b0b2]308    while(@pieces) {
309        $out .= shift @pieces;
310        $out .= BarnOwl::Style::boldify(shift @pieces) if @pieces;
311    }
312    return $out;
313}
314
[2c40dc0]315# Determines if the given message recipient is a username, as opposed to
316# a channel that starts with # or &.
317sub is_private {
318    return shift !~ /^[\#\&]/;
319}
[b38b0b2]320
[bc0d7bc]321sub cdr {
322    shift;
323    return @_;
324}
325
[b38b0b2]3261;
Note: See TracBrowser for help on using the repository browser.