source: perl/modules/IRC/lib/BarnOwl/Module/IRC.pm

release-1.10
Last change on this file was d4f33f1, checked in by Jason Gross <jgross@mit.edu>, 10 years ago
Clean up ircnets on socketless disconnect This allows recovery from the state that BarnOwl gets into when (I think) a disconnect message from the server is dropped, and BarnOwl thinks it's connected, and the IRC server thinks it's not, and so you can neither disconnect nor reconnect.
  • Property mode set to 100644
File size: 25.1 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 AnyEvent::IRC;
23use Encode;
24use File::Spec;
25use Getopt::Long;
26use Text::Wrap;
27
28our $VERSION = 0.02;
29
30our $IRC_SUBS_FILENAME = "ircchannels";
31
32our $irc;
33
34# Hash alias -> BarnOwl::Module::IRC::Connection object
35our %ircnets;
36
37sub startup {
38    BarnOwl::new_variable_string('irc:nick', {
39        default     => $ENV{USER},
40        summary     => 'The default IRC nickname',
41        description => 'By default, irc-connect will use this nick '  .
42        'when connecting to a new server. See :help irc-connect for ' .
43        'more information.'
44       });
45
46    BarnOwl::new_variable_string('irc:user', {
47        default => $ENV{USER},
48        summary => 'The IRC "username" field'
49       });
50        BarnOwl::new_variable_string('irc:name', {
51        default => "",
52        summary     => 'A short name field for IRC',
53        description => 'A short (maybe 60 or so chars) piece of text, ' .
54        'originally intended to display your real name, which people '  .
55        'often use for pithy quotes and URLs.'
56       });
57
58    BarnOwl::new_variable_bool('irc:spew', {
59        default     => 0,
60        summary     => 'Show unhandled IRC events',
61        description => 'If set, display all unrecognized IRC events as ' .
62        'admin messages. Intended for debugging and development use only.'
63       });
64
65    BarnOwl::new_variable_string('irc:skip', {
66        default     => 'welcome yourhost created ' .
67        'luserclient luserme luserop luserchannels',
68        summary     => 'Skip messages of these types',
69        description => 'If set, each (space-separated) message type ' .
70        'provided will be hidden and ignored if received.'
71       });
72
73    BarnOwl::new_variable_int('irc:max-message-length', {
74        default     => 450,
75        summary     => 'Split messages to at most this many characters.' .
76                       "If non-positive, don't split messages",
77        description => 'If set to a positive number, any paragraph in an ' .
78                       'IRC message will be split after this many characters.'
79       });
80
81    register_commands();
82    BarnOwl::filter(qw{irc type ^IRC$ or ( type ^admin$ and adminheader ^IRC$ )});
83}
84
85sub shutdown {
86    for my $conn (values %ircnets) {
87        $conn->conn->disconnect('Quitting');
88    }
89}
90
91sub quickstart {
92    return <<'END_QUICKSTART';
93@b[IRC:]
94Use ':irc-connect @b[server]' to connect to an IRC server, and
95':irc-join @b[#channel]' to join a channel. ':irc-msg @b[#channel]
96@b[message]' sends a message to a channel.
97END_QUICKSTART
98}
99
100sub buddylist {
101    my $list = "";
102
103    for my $net (sort keys %ircnets) {
104        my $conn = $ircnets{$net};
105        my ($nick, $server) = ($conn->nick, $conn->server);
106        $list .= BarnOwl::Style::boldify("IRC channels for $net ($nick\@$server)");
107        $list .= "\n";
108
109        for my $chan (keys %{$conn->conn->{channel_list}}) {
110            $list .= "  $chan\n";
111        }
112    }
113
114    return $list;
115}
116
117sub skip_msg {
118    my $class = shift;
119    my $type = lc shift;
120    my $skip = lc BarnOwl::getvar('irc:skip');
121    return grep {$_ eq $type} split ' ', $skip;
122}
123
124=head2 mk_irc_command SUB FLAGS
125
126Return a subroutine that can be bound as a an IRC command. The
127subroutine will be called with arguments (COMMAND-NAME,
128IRC-CONNECTION, [CHANNEL], ARGV...).
129
130C<IRC-CONNECTION> and C<CHANNEL> will be inferred from arguments to
131the command and the current message if appropriate.
132
133The bitwise C<or> of zero or more C<FLAGS> can be passed in as a
134second argument to alter the behavior of the returned commands:
135
136=over 4
137
138=item C<CHANNEL_ARG>
139
140This command accepts the name of a channel. Pass in the C<CHANNEL>
141argument listed above, and die if no channel argument can be found.
142
143=item C<CHANNEL_OR_USER>
144
145Pass the channel argument, but accept it if it's a username (e.g.
146has no hash).  Only relevant with C<CHANNEL_ARG>.
147
148=item C<CHANNEL_OPTIONAL>
149
150Pass the channel argument, but don't die if not present. Only relevant
151with C<CHANNEL_ARG>.
152
153=item C<ALLOW_DISCONNECTED>
154
155C<IRC-CONNECTION> may be a disconnected connection object that is
156currently pending a reconnect.
157
158=back
159
160=cut
161
162use constant CHANNEL_ARG        => 1;
163use constant CHANNEL_OPTIONAL   => 2;
164use constant CHANNEL_OR_USER    => 4;
165
166use constant ALLOW_DISCONNECTED => 8;
167
168sub register_commands {
169    BarnOwl::new_command(
170        'irc-connect' => \&cmd_connect,
171        {
172            summary => 'Connect to an IRC server',
173            usage =>
174'irc-connect [-a ALIAS] [-s] [-p PASSWORD] [-n NICK] SERVER [port]',
175            description => <<END_DESCR
176Connect to an IRC server. Supported options are:
177
178 -a <alias>          Define an alias for this server
179 -s                  Use SSL
180 -p <password>       Specify the password to use
181 -n <nick>           Use a non-default nick
182
183The -a option specifies an alias to use for this connection. This
184alias can be passed to the '-a' argument of any other IRC command to
185control which connection it operates on.
186
187For servers with hostnames of the form "irc.FOO.{com,org,...}", the
188alias will default to "FOO"; For other servers the full hostname is
189used.
190END_DESCR
191        }
192    );
193
194    BarnOwl::new_command(
195        'irc-disconnect' => mk_irc_command( \&cmd_disconnect, ALLOW_DISCONNECTED ),
196        {
197            summary => 'Disconnect from an IRC server',
198            usage   => 'irc-disconnect [-a ALIAS]',
199
200            description => <<END_DESCR
201Disconnect from an IRC server. You can specify a specific server with
202"-a SERVER-ALIAS" if necessary.
203END_DESCR
204        }
205    );
206
207    BarnOwl::new_command(
208        'irc-msg' => mk_irc_command( \&cmd_msg, CHANNEL_OR_USER|CHANNEL_ARG|CHANNEL_OPTIONAL ),
209        {
210            summary => 'Send an IRC message',
211            usage   => 'irc-msg [-a ALIAS] DESTINATION MESSAGE',
212
213            description => <<END_DESCR
214Send an IRC message.
215END_DESCR
216        }
217    );
218
219    BarnOwl::new_command(
220        'irc-mode' => mk_irc_command( \&cmd_mode, CHANNEL_OPTIONAL|CHANNEL_ARG ),
221        {
222            summary => 'Change an IRC channel or user mode',
223            usage   => 'irc-mode [-a ALIAS] TARGET [+-]MODE OPTIONS',
224
225            description => <<END_DESCR
226Change the mode of an IRC user or channel.
227END_DESCR
228        }
229    );
230
231    BarnOwl::new_command(
232        'irc-join' => mk_irc_command( \&cmd_join ),
233        {
234            summary => 'Join an IRC channel',
235            usage   => 'irc-join [-a ALIAS] [-t] #channel [KEY]',
236
237            description => <<END_DESCR
238Join an IRC channel.  If the -t option is present the subscription will only be
239temporary, i.e., it will not be written to the subscription file and will
240therefore not be present the next time BarnOwl is started, and will disappear
241if the connection is lost.
242END_DESCR
243        }
244    );
245
246    BarnOwl::new_command(
247        'irc-part' => mk_irc_command( \&cmd_part, CHANNEL_ARG ),
248        {
249            summary => 'Leave an IRC channel',
250            usage   => 'irc-part [-a ALIAS] [-t] #channel',
251
252            description => <<END_DESCR
253Part from an IRC channel.  If the -t option is present the unsubscription will
254only be temporary, i.e., it will not be updated in the subscription file and
255will therefore not be in effect the next time BarnOwl is started, or if the
256connection is lost.
257END_DESCR
258        }
259    );
260
261    BarnOwl::new_command(
262        'irc-nick' => mk_irc_command( \&cmd_nick ),
263        {
264            summary => 'Change your IRC nick on an existing connection.',
265            usage   => 'irc-nick [-a ALIAS] NEW-NICK',
266
267            description => <<END_DESCR
268Set your IRC nickname on an existing connect. To change it prior to
269connecting, adjust the `irc:nick' variable.
270END_DESCR
271        }
272    );
273
274    BarnOwl::new_command(
275        'irc-names' => mk_irc_command( \&cmd_names, CHANNEL_ARG ),
276        {
277            summary => 'View the list of users in a channel',
278            usage   => 'irc-names [-a ALIAS] #channel',
279
280            description => <<END_DESCR
281`irc-names' displays the list of users in a given channel in a pop-up
282window.
283END_DESCR
284        }
285    );
286
287    BarnOwl::new_command(
288        'irc-whois' => mk_irc_command( \&cmd_whois ),
289        {
290            summary => 'Displays information about a given IRC user',
291            usage   => 'irc-whois [-a ALIAS] NICK',
292
293            description => <<END_DESCR
294Pops up information about a given IRC user.
295END_DESCR
296        }
297    );
298
299    BarnOwl::new_command(
300        'irc-motd' => mk_irc_command( \&cmd_motd ),
301        {
302            summary => 'Displays an IRC server\'s MOTD (Message of the Day)',
303            usage   => 'irc-motd [-a ALIAS]',
304
305            description => <<END_DESCR
306Displays an IRC server's message of the day.
307END_DESCR
308        }
309    );
310
311    BarnOwl::new_command(
312        'irc-list' => \&cmd_list,
313        {
314            summary => 'Show all the active IRC connections.',
315            usage   => 'irc-list',
316
317            description => <<END_DESCR
318Show all the currently active IRC connections with their aliases and
319server names.
320END_DESCR
321        }
322    );
323
324    BarnOwl::new_command( 'irc-who'   => mk_irc_command( \&cmd_who ) );
325    BarnOwl::new_command( 'irc-stats' => mk_irc_command( \&cmd_stats ) );
326
327    BarnOwl::new_command(
328        'irc-topic' => mk_irc_command( \&cmd_topic, CHANNEL_ARG ),
329        {
330            summary => 'View or change the topic of an IRC channel',
331            usage   => 'irc-topic [-a ALIAS] #channel [TOPIC]',
332
333            description => <<END_DESCR
334Without extra arguments, fetches and displays a given channel's topic.
335
336With extra arguments, changes the target channel's topic string. This
337may require +o on some channels.
338END_DESCR
339        }
340    );
341
342    BarnOwl::new_command(
343        'irc-quote' => mk_irc_command( \&cmd_quote ),
344        {
345            summary => 'Send a raw command to the IRC servers.',
346            usage   => 'irc-quote [-a ALIAS] TEXT',
347
348            description => <<END_DESCR
349Send a raw command line to an IRC server.
350
351This can be used to perform some operation not yet supported by
352BarnOwl, or to define new IRC commands.
353END_DESCR
354        }
355    );
356
357    BarnOwl::new_command(
358        'irc-loadchannels' => \&cmd_loadchannels,
359        {
360            summary => 'Reload persistent channels',
361            usage   => 'irc-loadchannels [-a ALIAS] [<file>]',
362
363            description => <<END_DESCR
364Load persistent channels from a file.  The file defaults to
365\$HOME/.owl/$IRC_SUBS_FILENAME.  If the ALIAS is present, only channels
366on the given alias are loaded.  The ALIAS is case-sensitive.
367
368Each line of the file should describe a single channel, in the format
369'\$alias \$channel' (without quotes).
370END_DESCR
371        }
372    );
373}
374
375
376$BarnOwl::Hooks::startup->add('BarnOwl::Module::IRC::startup');
377$BarnOwl::Hooks::shutdown->add('BarnOwl::Module::IRC::shutdown');
378$BarnOwl::Hooks::getQuickstart->add('BarnOwl::Module::IRC::quickstart');
379$BarnOwl::Hooks::getBuddyList->add("BarnOwl::Module::IRC::buddylist");
380
381################################################################################
382######################## Owl command handlers ##################################
383################################################################################
384
385sub make_autoconnect_filename {
386    # can't use ||, or else we'll treat '0' as invalid.  We could check for eq "" ...
387    # TODO(jgross): When we move to requiring perl 5.10, combine the
388    # following two lines using //
389    my $filename = shift;
390    $filename = File::Spec->catfile(BarnOwl::get_config_dir(), $IRC_SUBS_FILENAME) unless defined $filename;
391    if (!File::Spec->file_name_is_absolute($filename)) {
392        $filename = File::Spec->catfile($ENV{HOME}, $filename);
393    }
394    return $filename;
395}
396
397sub _get_autoconnect_lines {
398    my $filename = shift;
399
400    # TODO(jgross): Write a C-side function to do this, asynchronously;
401    #               AIUI, perl doesn't do asynchronous I/O in any useful way
402    if (open (my $subsfile, "<:encoding(UTF-8)", $filename)) {
403        my @lines = <$subsfile>;
404        close($subsfile);
405
406        # strip trailing newlines
407        local $/ = "";
408        chomp(@lines);
409
410        return @lines;
411    }
412
413    return ();
414}
415
416sub get_autoconnect_channels {
417    my $filename = make_autoconnect_filename(shift);
418    my %channel_hash = ();
419
420    # Load the subs from the file
421    my @lines = _get_autoconnect_lines($filename);
422
423    foreach my $line (@lines) {
424        my @parsed_args = split(' ', $line);
425        if (scalar @parsed_args == 2) {
426            push @{$channel_hash{$parsed_args[0]}}, $parsed_args[1];
427        } else {
428            warn "Trouble parsing irc configuration file '$filename' line '$line'; the format is '\$alias \$channel', with no spaces in either\n";
429        }
430    }
431
432    return %channel_hash;
433}
434
435sub add_autoconnect_channel {
436    my $conn = shift;
437    my $channel = shift;
438    my $alias = $conn->alias;
439    my $filename = make_autoconnect_filename(shift);
440
441    # we already checked for spaces in $channel in cmd_join, but we still need
442    # to check $alias
443    die "Alias name '$alias' contains a space; parsing will fail.  Use the -t flag.\n" unless index($alias, " ") == -1;
444
445    my $line = "$alias $channel";
446
447    my @lines = _get_autoconnect_lines($filename);
448
449    # We don't want to be noisy about duplicated joins.  For example, some
450    # people might have :irc-join in startup files, even though that doesn't
451    # work correctly anymore because connect is asynchronous and so join on
452    # startup races with connect.  Regardless, just fail silently if the line
453    # already exists.
454    return if grep { $_ eq $line } @lines;
455
456    open (my $subsfile, ">>:encoding(UTF-8)", make_autoconnect_filename($filename))
457        or die "Cannot open $filename for writing: $!\n";
458    local $, = "";
459    local $/ = "";
460    print $subsfile "$line\n";
461    close($subsfile);
462}
463
464sub remove_autoconnect_channel {
465    my $conn = shift;
466    my $channel = shift;
467    my $alias = $conn->alias;
468    my $filename = make_autoconnect_filename(shift);
469
470    BarnOwl::Internal::file_deleteline($filename, "$alias $channel", 1);
471}
472
473sub cmd_loadchannels {
474    my $cmd = shift;
475    my $alias;
476    my $getopt = Getopt::Long::Parser->new;
477
478    local @ARGV = @_;
479    $getopt->configure(qw(pass_through permute no_getopt_compat prefix_pattern=-|--));
480    $getopt->getoptions("alias=s" => \$alias);
481
482    my %channel_hash = get_autoconnect_channels(@ARGV);
483
484    my $aliases = (defined $alias) ? [$alias] : [keys %channel_hash];
485
486    foreach my $cur_alias (@$aliases) {
487        # get_connection_by_alias might die, and we don't want to
488        eval {
489            my $conn = get_connection_by_alias($cur_alias, 1);
490            my %existing_channels = map { $_ => 1 } @{$conn->autoconnect_channels}, @{$channel_hash{$cur_alias}};
491            $conn->autoconnect_channels([keys %existing_channels]);
492        };
493        foreach my $channel (@{$channel_hash{$cur_alias}}) {
494            if ($cur_alias eq "") {
495                BarnOwl::command("irc-join", "-t", $channel);
496            } else {
497                BarnOwl::command("irc-join", "-t", "-a", $cur_alias, $channel);
498            }
499        }
500    }
501}
502
503sub cmd_connect {
504    my $cmd = shift;
505
506    my $nick = BarnOwl::getvar('irc:nick');
507    my $username = BarnOwl::getvar('irc:user');
508    my $ircname = BarnOwl::getvar('irc:name');
509    my $host;
510    my $port;
511    my $alias;
512    my $ssl;
513    my $password = undef;
514
515    {
516        local @ARGV = @_;
517        GetOptions(
518            "alias=s"    => \$alias,
519            "ssl"        => \$ssl,
520            "password=s" => \$password,
521            "nick=s"     => \$nick,
522        );
523        $host = shift @ARGV or die("Usage: $cmd HOST\n");
524        if(!$alias) {
525            if($host =~ /^(?:irc[.])?([\w-]+)[.]\w+$/) {
526                $alias = $1;
527            } else {
528                $alias = $host;
529            }
530        }
531        $ssl ||= 0;
532        $port = shift @ARGV || ($ssl ? 6697 : 6667);
533    }
534
535    if(exists $ircnets{$alias}) {
536        die("Already connected to a server with alias '$alias'. Either disconnect or specify an alias with -a.\n");
537    }
538
539    my %channel_hash = get_autoconnect_channels;
540
541    my $conn = BarnOwl::Module::IRC::Connection->new($alias, $host, $port, {
542        nick                 => $nick,
543        user                 => $username,
544        real                 => $ircname,
545        password             => $password,
546        SSL                  => $ssl,
547        timeout              => sub {0},
548        autoconnect_channels => $channel_hash{$alias}
549       });
550    $ircnets{$alias} = $conn;
551    return;
552}
553
554sub cmd_disconnect {
555    my $cmd = shift;
556    my $conn = shift;
557    if ($conn->conn->{socket}) {
558        $conn->did_quit(1);
559        $conn->conn->disconnect("Goodbye!");
560    } elsif ($conn->{reconnect_timer}) {
561        BarnOwl::admin_message('IRC',
562                               "[" . $conn->alias . "] Reconnect cancelled");
563        $conn->cancel_reconnect;
564        delete $ircnets{$conn->alias};
565    } elsif (exists $ircnets{$conn->alias}) { # inconsistent state; no socket, but not yet deleted
566        BarnOwl::admin_message('IRC',
567                               "[" . $conn->alias . "] Attempt to disconnect from a socketless connection; deleting it");
568        delete $ircnets{$conn->alias};
569    }
570}
571
572sub cmd_msg {
573    my $cmd  = shift;
574    my $conn = shift;
575    my $to = shift or die("Usage: $cmd [NICK|CHANNEL]\n");
576    # handle multiple recipients?
577    if(@_) {
578        process_msg($conn, $to, join(" ", @_));
579    } else {
580        BarnOwl::start_edit_win(BarnOwl::quote('/msg', '-a', $conn->alias, $to), sub {process_msg($conn, $to, @_)});
581    }
582    return;
583}
584
585sub process_msg {
586    my $conn = shift;
587    my $to = shift;
588    my $fullbody = shift;
589    my @msgs;
590    # Require the user to send in paragraphs (double-newline between) to
591    # actually send multiple PRIVMSGs, in order to play nice with autofill.
592    $fullbody =~ s/\r//g;
593    @msgs = split "\n\n", $fullbody;
594    map { tr/\n/ / } @msgs;
595    # split each body at irc:max-message-length characters, if that number
596    # is positive.  Only split at space boundaries.  Start counting a-fresh
597    # at the beginning of each paragraph
598    my $max_len = BarnOwl::getvar('irc:max-message-length');
599    if ($max_len > 0) {
600        local($Text::Wrap::columns) = $max_len;
601        @msgs = split "\n", wrap("", "", join "\n", @msgs);
602    }
603    for my $body (@msgs) {
604        if ($body =~ /^\/me (.*)/) {
605            $conn->me($to, Encode::encode('utf-8', $1));
606            $body = '* '.$conn->nick.' '.$1;
607        } else {
608            $conn->conn->send_msg('privmsg', $to, Encode::encode('utf-8', $body));
609        }
610        my $msg = BarnOwl::Message->new(
611            type        => 'IRC',
612            direction   => is_private($to) ? 'out' : 'in',
613            server      => $conn->server,
614            network     => $conn->alias,
615            recipient   => $to,
616            body        => $body,
617            sender      => $conn->nick,
618            is_private($to) ?
619              (isprivate  => 'true') : (channel => $to),
620            replycmd    => BarnOwl::quote('irc-msg',  '-a', $conn->alias, $to),
621            replysendercmd => BarnOwl::quote('irc-msg', '-a', $conn->alias, $to),
622        );
623        BarnOwl::queue_message($msg);
624    }
625    return;
626}
627
628sub cmd_mode {
629    my $cmd = shift;
630    my $conn = shift;
631    my $target = shift;
632    $target ||= shift;
633    $conn->conn->send_msg(mode => $target, @_);
634    return;
635}
636
637sub cmd_join {
638    my $cmd = shift;
639    my $is_temporary;
640
641    my $getopt = Getopt::Long::Parser->new;
642
643    local @ARGV = @_;
644    $getopt->configure(qw(pass_through permute no_getopt_compat prefix_pattern=-|--));
645    $getopt->getoptions("temporary" => \$is_temporary);
646
647    my $conn = shift @ARGV;
648    my $chan = shift @ARGV or die("Usage: $cmd channel\n");
649
650    die "Channel name '$chan' contains a space.  As per RFC 2812, IRC channel names may not contain spaces.\n" unless index($chan, " ") == -1;
651
652    $conn->conn->send_msg(join => $chan, @ARGV);
653
654    # regardless of whether or not this is temporary, we want to persist it
655    # across reconnects.
656
657    # check if the channel is already in the list
658    if (!grep { $_ eq $chan } @{$conn->autoconnect_channels}) {
659        push @{$conn->autoconnect_channels}, $chan;
660    }
661
662    if (!$is_temporary) {
663        # add the line to the subs file
664        add_autoconnect_channel($conn, $chan);
665    }
666
667    return;
668}
669
670sub cmd_part {
671    my $cmd = shift;
672    my $is_temporary;
673
674    my $getopt = Getopt::Long::Parser->new;
675
676    local @ARGV = @_;
677    $getopt->configure(qw(pass_through permute no_getopt_compat prefix_pattern=-|--));
678    $getopt->getoptions("temporary" => \$is_temporary);
679
680    my $conn = shift @ARGV;
681    my $chan = shift @ARGV or die("Usage: $cmd channel\n");
682
683    $conn->conn->send_msg(part => $chan);
684
685    # regardless of whether or not this is temporary, we want to persist it
686    # across reconnects
687    my %existing_channels = map { $_ => 1 } @{$conn->autoconnect_channels};
688    delete $existing_channels{$chan};
689    $conn->autoconnect_channels([keys %existing_channels]);
690
691    if (!$is_temporary) {
692        # remove the line from the subs file
693        remove_autoconnect_channel($conn, $chan);
694    }
695
696    return;
697}
698
699sub cmd_nick {
700    my $cmd = shift;
701    my $conn = shift;
702    my $nick = shift or die("Usage: $cmd <new nick>\n");
703    $conn->conn->send_msg(nick => $nick);
704    return;
705}
706
707sub cmd_names {
708    my $cmd = shift;
709    my $conn = shift;
710    my $chan = shift;
711    $conn->names_tmp([]);
712    $conn->conn->send_msg(names => $chan);
713    return;
714}
715
716sub cmd_whois {
717    my $cmd = shift;
718    my $conn = shift;
719    my $who = shift || die("Usage: $cmd <user>\n");
720    $conn->conn->send_msg(whois => $who);
721    return;
722}
723
724sub cmd_motd {
725    my $cmd = shift;
726    my $conn = shift;
727    $conn->conn->send_msg('motd');
728    return;
729}
730
731sub cmd_list {
732    my $cmd = shift;
733    my $message = BarnOwl::Style::boldify('Current IRC networks:') . "\n";
734    while (my ($alias, $conn) = each %ircnets) {
735        $message .= '  ' . $alias . ' => ' . $conn->nick . '@' . $conn->server . "\n";
736    }
737    BarnOwl::popless_ztext($message);
738    return;
739}
740
741sub cmd_who {
742    my $cmd = shift;
743    my $conn = shift;
744    my $who = shift || die("Usage: $cmd <user>\n");
745    $conn->conn->send_msg(who => $who);
746    return;
747}
748
749sub cmd_stats {
750    my $cmd = shift;
751    my $conn = shift;
752    my $type = shift || die("Usage: $cmd <chiklmouy> [server] \n");
753    $conn->conn->send_msg(stats => $type, @_);
754    return;
755}
756
757sub cmd_topic {
758    my $cmd = shift;
759    my $conn = shift;
760    my $chan = shift;
761    $conn->conn->send_msg(topic => $chan, @_ ? join(" ", @_) : undef);
762    return;
763}
764
765sub cmd_quote {
766    my $cmd = shift;
767    my $conn = shift;
768    $conn->conn->send_msg(@_);
769    return;
770}
771
772################################################################################
773########################### Utilities/Helpers ##################################
774################################################################################
775
776sub find_channel {
777    my $channel = shift;
778    my @found;
779    for my $conn (values %ircnets) {
780        if($conn->conn->{channel_list}{lc $channel}) {
781            push @found, $conn;
782        }
783    }
784    return $found[0] if(scalar @found == 1);
785}
786
787sub mk_irc_command {
788    my $sub = shift;
789    my $flags = shift || 0;
790    return sub {
791        my $cmd = shift;
792        my $conn;
793        my $alias;
794        my $channel;
795        my $is_temporary;
796        my $getopt = Getopt::Long::Parser->new;
797        my $m = BarnOwl::getcurmsg();
798
799        local @ARGV = @_;
800        $getopt->configure(qw(pass_through permute no_getopt_compat prefix_pattern=-|--));
801        $getopt->getoptions("alias=s" => \$alias,
802                            "temporary" => \$is_temporary);
803
804        if(defined($alias)) {
805            $conn = get_connection_by_alias($alias,
806                                            $flags & ALLOW_DISCONNECTED);
807        }
808        if($flags & CHANNEL_ARG) {
809            $channel = $ARGV[0];
810            if(defined($channel) && $channel =~ /^#/) {
811                if(my $c = find_channel($channel)) {
812                    shift @ARGV;
813                    $conn ||= $c;
814                }
815            } elsif (defined($channel) && ($flags & CHANNEL_OR_USER)) {
816                shift @ARGV;
817            } elsif ($m && $m->type eq 'IRC' && !$m->is_private) {
818                $channel = $m->channel;
819            } else {
820                undef $channel;
821            }
822        }
823
824        if(!defined($channel) &&
825           ($flags & CHANNEL_ARG) &&
826           !($flags & CHANNEL_OPTIONAL)) {
827            die("Usage: $cmd <channel>\n");
828        }
829        if(!$conn) {
830            if($m && $m->type eq 'IRC') {
831                $conn = get_connection_by_alias($m->network,
832                                               $flags & ALLOW_DISCONNECTED);
833            }
834        }
835        if(!$conn && scalar keys %ircnets == 1) {
836            $conn = [values(%ircnets)]->[0];
837        }
838        if(!$conn) {
839            die("You must specify an IRC network using -a.\n");
840        }
841        push @ARGV, "-t" if $is_temporary;
842        if($flags & CHANNEL_ARG) {
843            $sub->($cmd, $conn, $channel, @ARGV);
844        } else {
845            $sub->($cmd, $conn, @ARGV);
846        }
847    };
848}
849
850sub get_connection_by_alias {
851    my $key = shift;
852    my $allow_disconnected = shift;
853
854    my $conn = $ircnets{$key};
855    die("No such ircnet: $key\n") unless $conn;
856    if ($conn->conn->{registered} || $allow_disconnected) {
857        return $conn;
858    }
859    die("[@{[$conn->alias]}] Not currently connected.");
860}
861
8621;
Note: See TracBrowser for help on using the repository browser.