source: perl/modules/IRC/lib/BarnOwl/Module/IRC.pm @ 919535f

barnowl_perlaimdebianrelease-1.10release-1.4release-1.5release-1.6release-1.7release-1.8release-1.9
Last change on this file since 919535f was 919535f, checked in by Geoffrey Thomas <geofft@mit.edu>, 16 years ago
Implement /me for outgoing IRC messages
  • Property mode set to 100644
File size: 8.7 KB
Line 
1use strict;
2use warnings;
3
4package BarnOwl::Module::IRC;
5
6=head1 NAME
7
8BarnOwl::Module::IRC
9
10=head1 DESCRIPTION
11
12This module implements IRC support for barnowl.
13
14=cut
15
16use BarnOwl;
17use BarnOwl::Hooks;
18use BarnOwl::Message::IRC;
19use BarnOwl::Module::IRC::Connection qw(is_private);
20
21use Net::IRC;
22use Getopt::Long;
23
24our $VERSION = 0.02;
25
26our $irc;
27
28# Hash alias -> BarnOwl::Module::IRC::Connection object
29our %ircnets;
30our %channels;
31
32sub startup {
33    BarnOwl::new_variable_string('irc:nick', {
34        default     => $ENV{USER},
35        summary     => 'The default IRC nickname',
36        description => 'By default, irc-connect will use this nick '  .
37        'when connecting to a new server. See :help irc-connect for ' .
38        'more information.'
39       });
40
41    BarnOwl::new_variable_string('irc:user', {
42        default => $ENV{USER},
43        summary => 'The IRC "username" field'
44       });
45        BarnOwl::new_variable_string('irc:name', {
46        default => "",
47        summary     => 'A short name field for IRC',
48        description => 'A short (maybe 60 or so chars) piece of text, ' .
49        'originally intended to display your real name, which people '  .
50        'often use for pithy quotes and URLs.'
51       });
52   
53    BarnOwl::new_variable_bool('irc:spew', {
54        default     => 0,
55        summary     => 'Show unhandled IRC events',
56        description => 'If set, display all unrecognized IRC events as ' .
57        'admin messages. Intended for debugging and development use only '
58       });
59   
60    register_commands();
61    register_handlers();
62    BarnOwl::filter('irc type ^IRC$');
63}
64
65sub shutdown {
66    for my $conn (values %ircnets) {
67        $conn->conn->disconnect();
68    }
69}
70
71#sub mainloop_hook {
72#    return unless defined $irc;
73#    eval {
74#        $irc->do_one_loop();
75#    };
76#    return;
77#}
78
79sub OwlProcess {
80    return unless defined $irc;
81    eval {
82        $irc->do_one_loop();
83    };
84    return;
85}
86
87
88sub register_handlers {
89    if(!$irc) {
90        $irc = Net::IRC->new;
91        $irc->timeout(0);
92    }
93}
94
95sub register_commands {
96    BarnOwl::new_command('irc-connect' => \&cmd_connect,
97                       {
98                           summary      => 'Connect to an IRC server',
99                           usage        => 'irc-connect [-a ALIAS ] [-s] [-p PASSWORD] [-n NICK] SERVER [port]',
100                           description  =>
101
102                           "Connect to an IRC server. Supported options are\n\n" .
103                           "-a <alias>          Define an alias for this server\n" .
104                           "-s                  Use SSL\n" .
105                           "-p <password>       Specify the password to use\n" .
106                           "-n <nick>           Use a non-default nick"
107                       });
108    BarnOwl::new_command('irc-disconnect' => \&cmd_disconnect);
109    BarnOwl::new_command('irc-msg'        => \&cmd_msg);
110    BarnOwl::new_command('irc-join'       => \&cmd_join);
111    BarnOwl::new_command('irc-part'       => \&cmd_part);
112    BarnOwl::new_command('irc-nick'       => \&cmd_nick);
113    BarnOwl::new_command('irc-names'      => \&cmd_names);
114    BarnOwl::new_command('irc-whois'      => \&cmd_whois);
115    BarnOwl::new_command('irc-motd'       => \&cmd_motd);
116}
117
118$BarnOwl::Hooks::startup->add(\&startup);
119$BarnOwl::Hooks::shutdown->add(\&shutdown);
120#$BarnOwl::Hooks::mainLoop->add(\&mainloop_hook);
121
122################################################################################
123######################## Owl command handlers ##################################
124################################################################################
125
126sub cmd_connect {
127    my $cmd = shift;
128
129    my $nick = BarnOwl::getvar('irc:nick');
130    my $username = BarnOwl::getvar('irc:user');
131    my $ircname = BarnOwl::getvar('irc:name');
132    my $host;
133    my $port;
134    my $alias;
135    my $ssl;
136    my $password = undef;
137
138    {
139        local @ARGV = @_;
140        GetOptions(
141            "alias=s"    => \$alias,
142            "ssl"        => \$ssl,
143            "password=s" => \$password,
144            "nick=s"     => \$nick,
145        );
146        $host = shift @ARGV or die("Usage: $cmd HOST\n");
147        if(!$alias) {
148            if($host =~ /^(?:irc[.])?(\w+)[.]\w+$/) {
149                $alias = $1;
150            } else {
151                $alias = $host;
152            }
153        }
154        $port = shift @ARGV || 6667;
155        $ssl ||= 0;
156    }
157
158    if(exists $ircnets{$alias}) {
159        die("Already connected to a server with alias '$alias'. Either disconnect or specify an alias with -a.\n");
160    }
161
162    my $conn = BarnOwl::Module::IRC::Connection->new($irc, $alias,
163        Nick      => $nick,
164        Server    => $host,
165        Port      => $port,
166        Username  => $username,
167        Ircname   => $ircname,
168        Port      => $port,
169        Password  => $password,
170        SSL       => $ssl
171       );
172
173    if ($conn->conn->connected) {
174        BarnOwl::admin_message("IRC", "Connected to $alias as $nick");
175        $ircnets{$alias} = $conn;
176        my $fd = $conn->getSocket()->fileno();
177        BarnOwl::add_dispatch($fd, \&OwlProcess);
178        $conn->{FD} = $fd;
179    } else {
180        die("IRC::Connection->connect failed: $!");
181    }
182
183    return;
184}
185
186sub cmd_disconnect {
187    my $cmd = shift;
188    my $conn = get_connection(\@_);
189    $conn->conn->disconnect;
190    delete $ircnets{$conn->alias};
191}
192
193sub cmd_msg {
194    my $cmd = shift;
195    my $conn = get_connection(\@_);
196    my $to = shift or die("Usage: $cmd NICK\n");
197    # handle multiple recipients?
198    if(@_) {
199        process_msg($conn, $to, join(" ", @_));
200    } else {
201        BarnOwl::start_edit_win("/msg -a " . $conn->alias . " $to", sub {process_msg($conn, $to, @_)});
202    }
203}
204
205sub process_msg {
206    my $conn = shift;
207    my $to = shift;
208    my $body = shift;
209    # Strip whitespace. In the future -- send one message/line?
210    $body =~ tr/\n\r/  /;
211    if ($body =~ /^\/me (.*)/) {
212        $conn->conn->me($to, $1);
213        $body = BarnOwl::Style::boldify($conn->nick.' '.$1);
214    } else {
215        $conn->conn->privmsg($to, $body);
216    }
217    my $msg = BarnOwl::Message->new(
218        type        => 'IRC',
219        direction   => is_private($to) ? 'out' : 'in',
220        server      => $conn->server,
221        network     => $conn->alias,
222        recipient   => $to,
223        body        => $body,
224        sender      => $conn->nick,
225        is_private($to) ?
226          (isprivate  => 'true') : (channel => $to),
227        replycmd    => "irc-msg -a " . $conn->alias . " $to",
228        replysendercmd => "irc-msg -a " . $conn->alias . " $to"
229       );
230    BarnOwl::queue_message($msg);
231}
232
233sub cmd_join {
234    my $cmd = shift;
235    my $conn = get_connection(\@_);
236    my $chan = shift or die("Usage: $cmd channel\n");
237    $channels{$chan} ||= [];
238    push @{$channels{$chan}}, $conn;
239    $conn->conn->join($chan);
240}
241
242sub cmd_part {
243    my $cmd = shift;
244    my $conn = get_connection(\@_);
245    my $chan = get_channel(\@_) || die("Usage: $cmd <channel>\n");
246    $channels{$chan} = [grep {$_ ne $conn} @{$channels{$chan} || []}];
247    $conn->conn->part($chan);
248}
249
250sub cmd_nick {
251    my $cmd = shift;
252    my $conn = get_connection(\@_);
253    my $nick = shift or die("Usage: $cmd <new nick>\n");
254    $conn->conn->nick($nick);
255}
256
257sub cmd_names {
258    my $cmd = shift;
259    my $conn = get_connection(\@_);
260    my $chan = get_channel(\@_) || die("Usage: $cmd <channel>\n");
261    $conn->conn->names($chan);
262}
263
264sub cmd_whois {
265    my $cmd = shift;
266    my $conn = get_connection(\@_);
267    my $who = shift || die("Usage: $cmd <user>\n");
268    $conn->conn->whois($who);
269}
270
271sub cmd_motd {
272    my $cmd = shift;
273    my $conn = get_connection(\@_);
274    $conn->conn->motd;
275}
276
277################################################################################
278########################### Utilities/Helpers ##################################
279################################################################################
280
281sub get_connection {
282    my $args = shift;
283    if(scalar @$args >= 2 && $args->[0] eq '-a') {
284        shift @$args;
285        return get_connection_by_alias(shift @$args);
286    }
287    my $channel = $args->[-1];
288    if (defined($channel) && $channel =~ /^#/
289        and $channels{$channel} and @{$channels{$channel}} == 1) {
290        return $channels{$channel}[0];
291    }
292    my $m = BarnOwl::getcurmsg();
293    if($m && $m->type eq 'IRC') {
294        return get_connection_by_alias($m->network);
295    }
296    if(scalar keys %ircnets == 1) {
297        return [values(%ircnets)]->[0];
298    }
299    die("You must specify a network with -a\n");
300}
301
302sub get_channel {
303    my $args = shift;
304    if(scalar @$args) {
305        return shift @$args;
306    }
307    my $m = BarnOwl::getcurmsg();
308    if($m && $m->type eq 'IRC') {
309        return $m->channel if !$m->is_private;
310    }
311    return undef;
312}
313
314sub get_connection_by_alias {
315    my $key = shift;
316    die("No such ircnet: $key\n") unless exists $ircnets{$key};
317    return $ircnets{$key};
318}
319
3201;
Note: See TracBrowser for help on using the repository browser.