source: perl/modules/IRC/lib/BarnOwl/Module/IRC.pm @ 9a023d0

release-1.6release-1.7release-1.8release-1.9
Last change on this file since 9a023d0 was 9a023d0, checked in by Geoffrey Thomas <geofft@mit.edu>, 12 years ago
Send multiple PRIVMSGs for IRC messages entered as multiple paragraphs It is occasionally useful to be able to send multiple lines of IRC text at once, and I've grown used to barnowl's excellent support for composing long messages. As a compromise between allowing multiline IRC messages and not causing autowrap to send them inadvertently, send one IRC-level message (PRIVMSG or CTCP ACTION) for each two-newlines-separated paragraph in the user input to :irc-msg. Reviewed-by: Geoffrey Thomas <geofft@mit.edu>
  • Property mode set to 100644
File size: 17.4 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=item C<ALLOW_DISCONNECTED>
164
165C<IRC-CONNECTION> may be a disconnected connection object that is
166currently pending a reconnect.
167
168=back
169
170=cut
171
172use constant CHANNEL_ARG        => 1;
173use constant CHANNEL_OPTIONAL   => 2;
174
175use constant ALLOW_DISCONNECTED => 4;
176
177sub register_commands {
178    BarnOwl::new_command(
179        'irc-connect' => \&cmd_connect,
180        {
181            summary => 'Connect to an IRC server',
182            usage =>
183'irc-connect [-a ALIAS ] [-s] [-p PASSWORD] [-n NICK] SERVER [port]',
184            description => <<END_DESCR
185Connect to an IRC server. Supported options are:
186
187 -a <alias>          Define an alias for this server
188 -s                  Use SSL
189 -p <password>       Specify the password to use
190 -n <nick>           Use a non-default nick
191
192The -a option specifies an alias to use for this connection. This
193alias can be passed to the '-a' argument of any other IRC command to
194control which connection it operates on.
195
196For servers with hostnames of the form "irc.FOO.{com,org,...}", the
197alias will default to "FOO"; For other servers the full hostname is
198used.
199END_DESCR
200        }
201    );
202
203    BarnOwl::new_command(
204        'irc-disconnect' => mk_irc_command( \&cmd_disconnect, ALLOW_DISCONNECTED ),
205        {
206            summary => 'Disconnect from an IRC server',
207            usage   => 'irc-disconnect [-a ALIAS]',
208
209            description => <<END_DESCR
210Disconnect from an IRC server. You can specify a specific server with
211"-a SERVER-ALIAS" if necessary.
212END_DESCR
213        }
214    );
215
216    BarnOwl::new_command(
217        'irc-msg' => mk_irc_command( \&cmd_msg ),
218        {
219            summary => 'Send an IRC message',
220            usage   => 'irc-msg [-a ALIAS] DESTINATION MESSAGE',
221
222            description => <<END_DESCR
223Send an IRC message.
224END_DESCR
225        }
226    );
227
228    BarnOwl::new_command(
229        'irc-mode' => mk_irc_command( \&cmd_mode, CHANNEL_OPTIONAL|CHANNEL_ARG ),
230        {
231            summary => 'Change an IRC channel or user mode',
232            usage   => 'irc-mode [-a ALIAS] TARGET [+-]MODE OPTIONS',
233
234            description => <<END_DESCR
235Change the mode of an IRC user or channel.
236END_DESCR
237        }
238    );
239
240    BarnOwl::new_command(
241        'irc-join' => mk_irc_command( \&cmd_join ),
242        {
243            summary => 'Join an IRC channel',
244            usage   => 'irc-join [-a ALIAS] #channel [KEY]',
245
246            description => <<END_DESCR
247Join an IRC channel.
248END_DESCR
249        }
250    );
251
252    BarnOwl::new_command(
253        'irc-part' => mk_irc_command( \&cmd_part, CHANNEL_ARG ),
254        {
255            summary => 'Leave an IRC channel',
256            usage   => 'irc-part [-a ALIAS] #channel',
257
258            description => <<END_DESCR
259Part from an IRC channel.
260END_DESCR
261        }
262    );
263
264    BarnOwl::new_command(
265        'irc-nick' => mk_irc_command( \&cmd_nick ),
266        {
267            summary => 'Change your IRC nick on an existing connection.',
268            usage   => 'irc-nick [-a ALIAS] NEW-NICK',
269
270            description => <<END_DESCR
271Set your IRC nickname on an existing connect. To change it prior to
272connecting, adjust the `irc:nick' variable.
273END_DESCR
274        }
275    );
276
277    BarnOwl::new_command(
278        'irc-names' => mk_irc_command( \&cmd_names, CHANNEL_ARG ),
279        {
280            summary => 'View the list of users in a channel',
281            usage   => 'irc-names [-a ALIAS] #channel',
282
283            description => <<END_DESCR
284`irc-names' displays the list of users in a given channel in a pop-up
285window.
286END_DESCR
287        }
288    );
289
290    BarnOwl::new_command(
291        'irc-whois' => mk_irc_command( \&cmd_whois ),
292        {
293            summary => 'Displays information about a given IRC user',
294            usage   => 'irc-whois [-a ALIAS] NICK',
295
296            description => <<END_DESCR
297Pops up information about a given IRC user.
298END_DESCR
299        }
300    );
301
302    BarnOwl::new_command(
303        'irc-motd' => mk_irc_command( \&cmd_motd ),
304        {
305            summary => 'Displays an IRC server\'s MOTD (Message of the Day)',
306            usage   => 'irc-motd [-a ALIAS]',
307
308            description => <<END_DESCR
309Displays an IRC server's message of the day.
310END_DESCR
311        }
312    );
313
314    BarnOwl::new_command(
315        'irc-list' => \&cmd_list,
316        {
317            summary => 'Show all the active IRC connections.',
318            usage   => 'irc-list',
319
320            description => <<END_DESCR
321Show all the currently active IRC connections with their aliases and
322server names.
323END_DESCR
324        }
325    );
326
327    BarnOwl::new_command( 'irc-who'   => mk_irc_command( \&cmd_who ) );
328    BarnOwl::new_command( 'irc-stats' => mk_irc_command( \&cmd_stats ) );
329
330    BarnOwl::new_command(
331        'irc-topic' => mk_irc_command( \&cmd_topic, CHANNEL_ARG ),
332        {
333            summary => 'View or change the topic of an IRC channel',
334            usage   => 'irc-topic [-a ALIAS] #channel [TOPIC]',
335
336            description => <<END_DESCR
337Without extra arguments, fetches and displays a given channel's topic.
338
339With extra arguments, changes the target channel's topic string. This
340may require +o on some channels.
341END_DESCR
342        }
343    );
344
345    BarnOwl::new_command(
346        'irc-quote' => mk_irc_command( \&cmd_quote ),
347        {
348            summary => 'Send a raw command to the IRC servers.',
349            usage   => 'irc-quote [-a ALIAS] TEXT',
350
351            description => <<END_DESCR
352Send a raw command line to an IRC server.
353
354This can be used to perform some operation not yet supported by
355BarnOwl, or to define new IRC commands.
356END_DESCR
357        }
358    );
359}
360
361
362$BarnOwl::Hooks::startup->add('BarnOwl::Module::IRC::startup');
363$BarnOwl::Hooks::shutdown->add('BarnOwl::Module::IRC::shutdown');
364$BarnOwl::Hooks::getQuickstart->add('BarnOwl::Module::IRC::quickstart');
365$BarnOwl::Hooks::getBuddyList->add("BarnOwl::Module::IRC::buddylist");
366
367################################################################################
368######################## Owl command handlers ##################################
369################################################################################
370
371sub cmd_connect {
372    my $cmd = shift;
373
374    my $nick = BarnOwl::getvar('irc:nick');
375    my $username = BarnOwl::getvar('irc:user');
376    my $ircname = BarnOwl::getvar('irc:name');
377    my $host;
378    my $port;
379    my $alias;
380    my $ssl;
381    my $password = undef;
382
383    {
384        local @ARGV = @_;
385        GetOptions(
386            "alias=s"    => \$alias,
387            "ssl"        => \$ssl,
388            "password=s" => \$password,
389            "nick=s"     => \$nick,
390        );
391        $host = shift @ARGV or die("Usage: $cmd HOST\n");
392        if(!$alias) {
393            if($host =~ /^(?:irc[.])?([\w-]+)[.]\w+$/) {
394                $alias = $1;
395            } else {
396                $alias = $host;
397            }
398        }
399        $ssl ||= 0;
400        $port = shift @ARGV || ($ssl ? 6697 : 6667);
401    }
402
403    if(exists $ircnets{$alias}) {
404        die("Already connected to a server with alias '$alias'. Either disconnect or specify an alias with -a.\n");
405    }
406
407    my $conn = BarnOwl::Module::IRC::Connection->new($irc, $alias,
408        Nick      => $nick,
409        Server    => $host,
410        Port      => $port,
411        Username  => $username,
412        Ircname   => $ircname,
413        Port      => $port,
414        Password  => $password,
415        SSL       => $ssl
416       );
417
418    if ($conn->conn->connected) {
419        $conn->connected("Connected to $alias as $nick");
420    } else {
421        die("IRC::Connection->connect failed: $!");
422    }
423
424    return;
425}
426
427sub cmd_disconnect {
428    my $cmd = shift;
429    my $conn = shift;
430    if ($conn->conn->connected) {
431        $conn->conn->disconnect;
432    } elsif ($reconnect{$conn->alias}) {
433        BarnOwl::admin_message('IRC',
434                               "[" . $conn->alias . "] Reconnect cancelled");
435        $conn->cancel_reconnect;
436    }
437}
438
439sub cmd_msg {
440    my $cmd  = shift;
441    my $conn = shift;
442    my $to = shift or die("Usage: $cmd [NICK|CHANNEL]\n");
443    # handle multiple recipients?
444    if(@_) {
445        process_msg($conn, $to, join(" ", @_));
446    } else {
447        BarnOwl::start_edit_win(BarnOwl::quote('/msg', '-a', $conn->alias, $to), sub {process_msg($conn, $to, @_)});
448    }
449    return;
450}
451
452sub process_msg {
453    my $conn = shift;
454    my $to = shift;
455    my $fullbody = shift;
456    my @msgs;
457    # Require the user to send in paragraphs (double-newline between) to
458    # actually send multiple PRIVMSGs, in order to play nice with autofill.
459    $fullbody =~ s/\r//g;
460    @msgs = split "\n\n", $fullbody;
461    map { tr/\n/ / } @msgs;
462    for my $body (@msgs) {
463        if ($body =~ /^\/me (.*)/) {
464            $conn->conn->me($to, Encode::encode('utf-8', $1));
465            $body = '* '.$conn->nick.' '.$1;
466        } else {
467            $conn->conn->privmsg($to, Encode::encode('utf-8', $body));
468        }
469        my $msg = BarnOwl::Message->new(
470            type        => 'IRC',
471            direction   => is_private($to) ? 'out' : 'in',
472            server      => $conn->server,
473            network     => $conn->alias,
474            recipient   => $to,
475            body        => $body,
476            sender      => $conn->nick,
477            is_private($to) ?
478              (isprivate  => 'true') : (channel => $to),
479            replycmd    => BarnOwl::quote('irc-msg',  '-a', $conn->alias, $to),
480            replysendercmd => BarnOwl::quote('irc-msg', '-a', $conn->alias, $to),
481        );
482        BarnOwl::queue_message($msg);
483    }
484    return;
485}
486
487sub cmd_mode {
488    my $cmd = shift;
489    my $conn = shift;
490    my $target = shift;
491    $target ||= shift;
492    $conn->conn->mode($target, @_);
493    return;
494}
495
496sub cmd_join {
497    my $cmd = shift;
498    my $conn = shift;
499    my $chan = shift or die("Usage: $cmd channel\n");
500    $channels{$chan} ||= [];
501    push @{$channels{$chan}}, $conn;
502    $conn->conn->join($chan, @_);
503    return;
504}
505
506sub cmd_part {
507    my $cmd = shift;
508    my $conn = shift;
509    my $chan = shift;
510    $channels{$chan} = [grep {$_ ne $conn} @{$channels{$chan} || []}];
511    $conn->conn->part($chan);
512    return;
513}
514
515sub cmd_nick {
516    my $cmd = shift;
517    my $conn = shift;
518    my $nick = shift or die("Usage: $cmd <new nick>\n");
519    $conn->conn->nick($nick);
520    return;
521}
522
523sub cmd_names {
524    my $cmd = shift;
525    my $conn = shift;
526    my $chan = shift;
527    $conn->names_tmp([]);
528    $conn->conn->names($chan);
529    return;
530}
531
532sub cmd_whois {
533    my $cmd = shift;
534    my $conn = shift;
535    my $who = shift || die("Usage: $cmd <user>\n");
536    $conn->conn->whois($who);
537    return;
538}
539
540sub cmd_motd {
541    my $cmd = shift;
542    my $conn = shift;
543    $conn->conn->motd;
544    return;
545}
546
547sub cmd_list {
548    my $cmd = shift;
549    my $message = BarnOwl::Style::boldify('Current IRC networks:') . "\n";
550    while (my ($alias, $conn) = each %ircnets) {
551        $message .= '  ' . $alias . ' => ' . $conn->nick . '@' . $conn->server . "\n";
552    }
553    BarnOwl::popless_ztext($message);
554    return;
555}
556
557sub cmd_who {
558    my $cmd = shift;
559    my $conn = shift;
560    my $who = shift || die("Usage: $cmd <user>\n");
561    BarnOwl::error("WHO $cmd $conn $who");
562    $conn->conn->who($who);
563    return;
564}
565
566sub cmd_stats {
567    my $cmd = shift;
568    my $conn = shift;
569    my $type = shift || die("Usage: $cmd <chiklmouy> [server] \n");
570    $conn->conn->stats($type, @_);
571    return;
572}
573
574sub cmd_topic {
575    my $cmd = shift;
576    my $conn = shift;
577    my $chan = shift;
578    $conn->conn->topic($chan, @_ ? join(" ", @_) : undef);
579    return;
580}
581
582sub cmd_quote {
583    my $cmd = shift;
584    my $conn = shift;
585    $conn->conn->sl(join(" ", @_));
586    return;
587}
588
589################################################################################
590########################### Utilities/Helpers ##################################
591################################################################################
592
593sub mk_irc_command {
594    my $sub = shift;
595    my $flags = shift || 0;
596    return sub {
597        my $cmd = shift;
598        my $conn;
599        my $alias;
600        my $channel;
601        my $getopt = Getopt::Long::Parser->new;
602        my $m = BarnOwl::getcurmsg();
603
604        local @ARGV = @_;
605        $getopt->configure(qw(pass_through permute no_getopt_compat prefix_pattern=-|--));
606        $getopt->getoptions("alias=s" => \$alias);
607
608        if(defined($alias)) {
609            $conn = get_connection_by_alias($alias,
610                                            $flags & ALLOW_DISCONNECTED);
611        }
612        if($flags & CHANNEL_ARG) {
613            $channel = $ARGV[0];
614            if(defined($channel) && $channel =~ /^#/) {
615                if($channels{$channel} && @{$channels{$channel}} == 1) {
616                    shift @ARGV;
617                    $conn = $channels{$channel}[0] unless $conn;
618                }
619            } elsif ($m && $m->type eq 'IRC' && !$m->is_private) {
620                $channel = $m->channel;
621            } else {
622                undef $channel;
623            }
624        }
625
626        if(!$channel &&
627           ($flags & CHANNEL_ARG) &&
628           !($flags & CHANNEL_OPTIONAL)) {
629            die("Usage: $cmd <channel>\n");
630        }
631        if(!$conn) {
632            if($m && $m->type eq 'IRC') {
633                $conn = get_connection_by_alias($m->network,
634                                               $flags & ALLOW_DISCONNECTED);
635            }
636        }
637        if(!$conn && scalar keys %ircnets == 1) {
638            $conn = [values(%ircnets)]->[0];
639        }
640        if(!$conn) {
641            die("You must specify an IRC network using -a.\n");
642        }
643        if($flags & CHANNEL_ARG) {
644            $sub->($cmd, $conn, $channel, @ARGV);
645        } else {
646            $sub->($cmd, $conn, @ARGV);
647        }
648    };
649}
650
651sub get_connection_by_alias {
652    my $key = shift;
653    my $allow_disconnected = shift;
654
655    return $ircnets{$key} if exists $ircnets{$key};
656    return $reconnect{$key} if $allow_disconnected && exists $reconnect{$key};
657    die("No such ircnet: $key\n")
658}
659
6601;
Note: See TracBrowser for help on using the repository browser.