source: perl/modules/IRC/lib/BarnOwl/Module/IRC.pm @ 54b4a87

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