source: perl/modules/IRC/lib/BarnOwl/Module/IRC.pm @ 3b4ba7d

release-1.5release-1.6release-1.7release-1.8release-1.9
Last change on this file since 3b4ba7d was 3b4ba7d, checked in by Alex Vandiver <alexmv@mit.edu>, 12 years ago
Reconnect and re-join channels on IRC disconnect
  • Property mode set to 100644
File size: 15.3 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);
20use BarnOwl::Module::IRC::Completion;
21
22use Net::IRC;
23use Getopt::Long;
24
25our $VERSION = 0.02;
26
27our $irc;
28
29# Hash alias -> BarnOwl::Module::IRC::Connection object
30our %ircnets;
31our %channels;
32our %reconnect;
33
34sub startup {
35    BarnOwl::new_variable_string('irc:nick', {
36        default     => $ENV{USER},
37        summary     => 'The default IRC nickname',
38        description => 'By default, irc-connect will use this nick '  .
39        'when connecting to a new server. See :help irc-connect for ' .
40        'more information.'
41       });
42
43    BarnOwl::new_variable_string('irc:user', {
44        default => $ENV{USER},
45        summary => 'The IRC "username" field'
46       });
47        BarnOwl::new_variable_string('irc:name', {
48        default => "",
49        summary     => 'A short name field for IRC',
50        description => 'A short (maybe 60 or so chars) piece of text, ' .
51        'originally intended to display your real name, which people '  .
52        'often use for pithy quotes and URLs.'
53       });
54   
55    BarnOwl::new_variable_bool('irc:spew', {
56        default     => 0,
57        summary     => 'Show unhandled IRC events',
58        description => 'If set, display all unrecognized IRC events as ' .
59        'admin messages. Intended for debugging and development use only '
60       });
61   
62    register_commands();
63    register_handlers();
64    BarnOwl::filter(qw{irc type ^IRC$ or ( type ^admin$ and adminheader ^IRC$ )});
65}
66
67sub shutdown {
68    for my $conn (values %ircnets) {
69        $conn->conn->disconnect();
70    }
71}
72
73sub quickstart {
74    return <<'END_QUICKSTART';
75@b[IRC:]
76Use ':irc-connect @b[server]' to connect to an IRC server, and
77':irc-join @b[#channel]' to join a channel. ':irc-msg @b[#channel]
78@b[message]' sends a message to a channel.
79END_QUICKSTART
80}
81
82sub buddylist {
83    my $list = "";
84
85    for my $net (sort keys %ircnets) {
86        my $conn = $ircnets{$net};
87        my ($nick, $server) = ($conn->nick, $conn->server);
88        $list .= BarnOwl::Style::boldify("IRC channels for $net ($nick\@$server)\n");
89
90        for my $chan (keys %channels) {
91            next unless grep $_ eq $conn, @{$channels{$chan}};
92            $list .= "  $chan\n";
93        }
94        $list .= "\n";
95    }
96
97    return $list;
98}
99
100#sub mainloop_hook {
101#    return unless defined $irc;
102#    eval {
103#        $irc->do_one_loop();
104#    };
105#    return;
106#}
107
108sub OwlProcess {
109    return unless defined $irc;
110    eval {
111        $irc->do_one_loop();
112    };
113    return;
114}
115
116
117sub register_handlers {
118    if(!$irc) {
119        $irc = Net::IRC->new;
120        $irc->timeout(0);
121    }
122}
123
124use constant OPTIONAL_CHANNEL => 1;
125use constant REQUIRE_CHANNEL => 2;
126
127sub register_commands {
128    BarnOwl::new_command(
129        'irc-connect' => \&cmd_connect,
130        {
131            summary => 'Connect to an IRC server',
132            usage =>
133'irc-connect [-a ALIAS ] [-s] [-p PASSWORD] [-n NICK] SERVER [port]',
134            description =>
135
136              <<END_DESCR
137Connect to an IRC server. Supported options are
138
139 -a <alias>          Define an alias for this server
140 -s                  Use SSL
141 -p <password>       Specify the password to use
142 -n <nick>           Use a non-default nick
143
144The -a option specifies an alias to use for this connection. This
145alias can be passed to the '-a' argument of any other IRC command to
146control which connection it operates on.
147
148For servers with hostnames of the form "irc.FOO.{com,org,...}", the
149alias will default to "FOO"; For other servers the full hostname is
150used.
151END_DESCR
152        }
153    );
154
155    BarnOwl::new_command(
156        'irc-disconnect' => mk_irc_command( \&cmd_disconnect ),
157        {
158            summary => 'Disconnect from an IRC server',
159            usage   => 'irc-disconnect [-a ALIAS]',
160
161            description => <<END_DESCR
162Disconnect from an IRC server. You can specify a specific server with
163"-a SERVER-ALIAS" if necessary.
164END_DESCR
165        }
166    );
167
168    BarnOwl::new_command(
169        'irc-msg' => mk_irc_command( \&cmd_msg ),
170        {
171            summary => 'Send an IRC message',
172            usage   => 'irc-msg [-a ALIAS] DESTINATION MESSAGE',
173
174            description => <<END_DESCR
175Send an IRC message
176END_DESCR
177        }
178    );
179
180    BarnOwl::new_command(
181        'irc-mode' => mk_irc_command( \&cmd_mode, OPTIONAL_CHANNEL ),
182        {
183            summary => 'Change an IRC channel or user mode',
184            usage   => 'irc-mode [-a ALIAS] TARGET [+-]MODE OPTIONS',
185
186            description => <<END_DESCR
187
188Change the mode of an IRC user or channel.
189END_DESCR
190        }
191    );
192
193    BarnOwl::new_command(
194        'irc-join' => mk_irc_command( \&cmd_join ),
195        {
196            summary => 'Join an IRC channel',
197            usage   => 'irc-join [-a ALIAS] #channel [KEY]',
198
199            description => <<END_DESCR
200
201Join an IRC channel.
202END_DESCR
203        }
204    );
205
206    BarnOwl::new_command(
207        'irc-part' => mk_irc_command( \&cmd_part, REQUIRE_CHANNEL ),
208        {
209            summary => 'Leave an IRC channel',
210            usage   => 'irc-part [-a ALIAS] #channel',
211
212            description => <<END_DESCR
213
214Part from an IRC channel.
215END_DESCR
216        }
217    );
218
219    BarnOwl::new_command(
220        'irc-nick' => mk_irc_command( \&cmd_nick ),
221        {
222            summary => 'Change your IRC nick on an existing connection.',
223            usage   => 'irc-nick [-a ALIAS] NEW-NICK',
224
225            description => <<END_DESCR
226
227Set your IRC nickname on an existing connect. To change it prior to
228connecting, adjust the `irc:nick' variable.
229END_DESCR
230        }
231    );
232
233    BarnOwl::new_command(
234        'irc-names' => mk_irc_command( \&cmd_names, REQUIRE_CHANNEL ),
235        {
236            summary => 'View the list of users in a channel',
237            usage   => 'irc-names [-a ALIAS] #channel',
238
239            description => <<END_DESCR
240
241`irc-names' displays the list of users in a given channel in a pop-up
242window.
243END_DESCR
244        }
245    );
246
247    BarnOwl::new_command(
248        'irc-whois' => mk_irc_command( \&cmd_whois ),
249        {
250            summary => 'Displays information about a given IRC user',
251            usage   => 'irc-whois [-a ALIAS] NICK',
252
253            description => <<END_DESCR
254
255Pops up information about a given IRC user.
256END_DESCR
257        }
258    );
259
260    BarnOwl::new_command(
261        'irc-motd' => mk_irc_command( \&cmd_motd ),
262        {
263            summary => 'Displays an IRC server\'s MOTD (Message of the Day)',
264            usage   => 'irc-motd [-a ALIAS]',
265
266            description => <<END_DESCR
267
268Displays an IRC server's message of the day.
269END_DESCR
270        }
271    );
272
273    BarnOwl::new_command(
274        'irc-list' => \&cmd_list,
275        {
276            summary => 'Show all the active IRC connections.',
277            usage   => 'irc-list',
278
279            description => <<END_DESCR
280
281Show all the currently active IRC connections with their aliases and
282server names.
283END_DESCR
284        }
285    );
286
287    BarnOwl::new_command( 'irc-who'   => mk_irc_command( \&cmd_who ) );
288    BarnOwl::new_command( 'irc-stats' => mk_irc_command( \&cmd_stats ) );
289
290    BarnOwl::new_command(
291        'irc-topic' => mk_irc_command( \&cmd_topic, REQUIRE_CHANNEL ),
292        {
293            summary => 'View or change the topic of an IRC channel',
294            usage   => 'irc-topic [-a ALIAS] #channel [TOPIC]',
295
296            description => <<END_DESCR
297
298Without extra arguments, fetches and displays a given channel's topic.
299
300With extra arguments, changes the target channel's topic string. This
301may require +o on some channels.
302END_DESCR
303        }
304    );
305
306    BarnOwl::new_command(
307        'irc-quote' => mk_irc_command( \&cmd_quote ),
308        {
309            summary => 'Send a raw command to the IRC servers.',
310            usage   => 'irc-quote [-a ALIAS] TEXT',
311
312            description => <<END_DESCR
313
314Send a raw command line to an IRC server.
315
316This can be used to perform some operation not yet supported by
317BarnOwl, or to define new IRC commands.
318END_DESCR
319        }
320    );
321}
322
323
324$BarnOwl::Hooks::startup->add('BarnOwl::Module::IRC::startup');
325$BarnOwl::Hooks::shutdown->add('BarnOwl::Module::IRC::shutdown');
326$BarnOwl::Hooks::getQuickstart->add('BarnOwl::Module::IRC::quickstart');
327$BarnOwl::Hooks::getBuddyList->add("BarnOwl::Module::IRC::buddylist");
328
329################################################################################
330######################## Owl command handlers ##################################
331################################################################################
332
333sub cmd_connect {
334    my $cmd = shift;
335
336    my $nick = BarnOwl::getvar('irc:nick');
337    my $username = BarnOwl::getvar('irc:user');
338    my $ircname = BarnOwl::getvar('irc:name');
339    my $host;
340    my $port;
341    my $alias;
342    my $ssl;
343    my $password = undef;
344
345    {
346        local @ARGV = @_;
347        GetOptions(
348            "alias=s"    => \$alias,
349            "ssl"        => \$ssl,
350            "password=s" => \$password,
351            "nick=s"     => \$nick,
352        );
353        $host = shift @ARGV or die("Usage: $cmd HOST\n");
354        if(!$alias) {
355            if($host =~ /^(?:irc[.])?([\w-]+)[.]\w+$/) {
356                $alias = $1;
357            } else {
358                $alias = $host;
359            }
360        }
361        $ssl ||= 0;
362        $port = shift @ARGV || ($ssl ? 6697 : 6667);
363    }
364
365    if(exists $ircnets{$alias}) {
366        die("Already connected to a server with alias '$alias'. Either disconnect or specify an alias with -a.\n");
367    }
368
369    my $conn = BarnOwl::Module::IRC::Connection->new($irc, $alias,
370        Nick      => $nick,
371        Server    => $host,
372        Port      => $port,
373        Username  => $username,
374        Ircname   => $ircname,
375        Port      => $port,
376        Password  => $password,
377        SSL       => $ssl
378       );
379
380    if ($conn->conn->connected) {
381        $conn->connected("Connected to $alias as $nick");
382    } else {
383        die("IRC::Connection->connect failed: $!");
384    }
385
386    return;
387}
388
389sub cmd_disconnect {
390    my $cmd = shift;
391    my $conn = shift;
392    $conn->conn->disconnect;
393    return;
394}
395
396sub cmd_msg {
397    my $cmd  = shift;
398    my $conn = shift;
399    my $to = shift or die("Usage: $cmd [NICK|CHANNEL]\n");
400    # handle multiple recipients?
401    if(@_) {
402        process_msg($conn, $to, join(" ", @_));
403    } else {
404        BarnOwl::start_edit_win(BarnOwl::quote('/msg', '-a', $conn->alias, $to), sub {process_msg($conn, $to, @_)});
405    }
406    return;
407}
408
409sub process_msg {
410    my $conn = shift;
411    my $to = shift;
412    my $body = shift;
413    # Strip whitespace. In the future -- send one message/line?
414    $body =~ tr/\n\r/  /;
415    if ($body =~ /^\/me (.*)/) {
416        $conn->conn->me($to, Encode::encode('utf-8', $1));
417        $body = '* '.$conn->nick.' '.$1;
418    } else {
419        $conn->conn->privmsg($to, Encode::encode('utf-8', $body));
420    }
421    my $msg = BarnOwl::Message->new(
422        type        => 'IRC',
423        direction   => is_private($to) ? 'out' : 'in',
424        server      => $conn->server,
425        network     => $conn->alias,
426        recipient   => $to,
427        body        => $body,
428        sender      => $conn->nick,
429        is_private($to) ?
430          (isprivate  => 'true') : (channel => $to),
431        replycmd    => BarnOwl::quote('irc-msg',  '-a', $conn->alias, $to),
432        replysendercmd => BarnOwl::quote('irc-msg', '-a', $conn->alias, $to),
433       );
434    BarnOwl::queue_message($msg);
435    return;
436}
437
438sub cmd_mode {
439    my $cmd = shift;
440    my $conn = shift;
441    my $target = shift;
442    $target ||= shift;
443    $conn->conn->mode($target, @_);
444    return;
445}
446
447sub cmd_join {
448    my $cmd = shift;
449    my $conn = shift;
450    my $chan = shift or die("Usage: $cmd channel\n");
451    $channels{$chan} ||= [];
452    push @{$channels{$chan}}, $conn;
453    $conn->conn->join($chan, @_);
454    return;
455}
456
457sub cmd_part {
458    my $cmd = shift;
459    my $conn = shift;
460    my $chan = shift;
461    $channels{$chan} = [grep {$_ ne $conn} @{$channels{$chan} || []}];
462    $conn->conn->part($chan);
463    return;
464}
465
466sub cmd_nick {
467    my $cmd = shift;
468    my $conn = shift;
469    my $nick = shift or die("Usage: $cmd <new nick>\n");
470    $conn->conn->nick($nick);
471    return;
472}
473
474sub cmd_names {
475    my $cmd = shift;
476    my $conn = shift;
477    my $chan = shift;
478    $conn->names_tmp([]);
479    $conn->conn->names($chan);
480    return;
481}
482
483sub cmd_whois {
484    my $cmd = shift;
485    my $conn = shift;
486    my $who = shift || die("Usage: $cmd <user>\n");
487    $conn->conn->whois($who);
488    return;
489}
490
491sub cmd_motd {
492    my $cmd = shift;
493    my $conn = shift;
494    $conn->conn->motd;
495    return;
496}
497
498sub cmd_list {
499    my $cmd = shift;
500    my $message = BarnOwl::Style::boldify('Current IRC networks:') . "\n";
501    while (my ($alias, $conn) = each %ircnets) {
502        $message .= '  ' . $alias . ' => ' . $conn->nick . '@' . $conn->server . "\n";
503    }
504    BarnOwl::popless_ztext($message);
505    return;
506}
507
508sub cmd_who {
509    my $cmd = shift;
510    my $conn = shift;
511    my $who = shift || die("Usage: $cmd <user>\n");
512    BarnOwl::error("WHO $cmd $conn $who");
513    $conn->conn->who($who);
514    return;
515}
516
517sub cmd_stats {
518    my $cmd = shift;
519    my $conn = shift;
520    my $type = shift || die("Usage: $cmd <chiklmouy> [server] \n");
521    $conn->conn->stats($type, @_);
522    return;
523}
524
525sub cmd_topic {
526    my $cmd = shift;
527    my $conn = shift;
528    my $chan = shift;
529    $conn->conn->topic($chan, @_ ? join(" ", @_) : undef);
530    return;
531}
532
533sub cmd_quote {
534    my $cmd = shift;
535    my $conn = shift;
536    $conn->conn->sl(join(" ", @_));
537    return;
538}
539
540################################################################################
541########################### Utilities/Helpers ##################################
542################################################################################
543
544sub mk_irc_command {
545    my $sub = shift;
546    my $use_channel = shift || 0;
547    return sub {
548        my $cmd = shift;
549        my $conn;
550        my $alias;
551        my $channel;
552        my $getopt = Getopt::Long::Parser->new;
553        my $m = BarnOwl::getcurmsg();
554
555        local @ARGV = @_;
556        $getopt->configure(qw(pass_through permute no_getopt_compat prefix_pattern=-|--));
557        $getopt->getoptions("alias=s" => \$alias);
558
559        if(defined($alias)) {
560            $conn = get_connection_by_alias($alias);
561        }
562        if($use_channel) {
563            $channel = $ARGV[0];
564            if(defined($channel) && $channel =~ /^#/) {
565                if($channels{$channel} && @{$channels{$channel}} == 1) {
566                    shift @ARGV;
567                    $conn = $channels{$channel}[0] unless $conn;
568                }
569            } elsif ($m && $m->type eq 'IRC' && !$m->is_private) {
570                $channel = $m->channel;
571            } else {
572                undef $channel;
573            }
574        }
575
576        if(!$channel && $use_channel == REQUIRE_CHANNEL) {
577            die("Usage: $cmd <channel>\n");
578        }
579        if(!$conn) {
580            if($m && $m->type eq 'IRC') {
581                $conn = get_connection_by_alias($m->network);
582            }
583        }
584        if(!$conn && scalar keys %ircnets == 1) {
585            $conn = [values(%ircnets)]->[0];
586        }
587        if(!$conn) {
588            die("You must specify an IRC network using -a.\n");
589        }
590        if($use_channel) {
591            $sub->($cmd, $conn, $channel, @ARGV);
592        } else {
593            $sub->($cmd, $conn, @ARGV);
594        }
595    };
596}
597
598sub get_connection_by_alias {
599    my $key = shift;
600    die("No such ircnet: $key\n") unless exists $ircnets{$key};
601    return $ircnets{$key};
602}
603
6041;
Note: See TracBrowser for help on using the repository browser.