source: perl/modules/IRC/lib/BarnOwl/Module/IRC.pm @ 926c721

release-1.10
Last change on this file since 926c721 was 926c721, checked in by Edward Z. Yang <ezyang@mit.edu>, 11 years ago
fix cmd_join in BarnOwl/Module/IRC.pm to use $chan, not $channel which is not declared or defined in that sub
  • Property mode set to 100644
File size: 24.8 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    }
566}
567
568sub cmd_msg {
569    my $cmd  = shift;
570    my $conn = shift;
571    my $to = shift or die("Usage: $cmd [NICK|CHANNEL]\n");
572    # handle multiple recipients?
573    if(@_) {
574        process_msg($conn, $to, join(" ", @_));
575    } else {
576        BarnOwl::start_edit_win(BarnOwl::quote('/msg', '-a', $conn->alias, $to), sub {process_msg($conn, $to, @_)});
577    }
578    return;
579}
580
581sub process_msg {
582    my $conn = shift;
583    my $to = shift;
584    my $fullbody = shift;
585    my @msgs;
586    # Require the user to send in paragraphs (double-newline between) to
587    # actually send multiple PRIVMSGs, in order to play nice with autofill.
588    $fullbody =~ s/\r//g;
589    @msgs = split "\n\n", $fullbody;
590    map { tr/\n/ / } @msgs;
591    # split each body at irc:max-message-length characters, if that number
592    # is positive.  Only split at space boundaries.  Start counting a-fresh
593    # at the beginning of each paragraph
594    my $max_len = BarnOwl::getvar('irc:max-message-length');
595    if ($max_len > 0) {
596        local($Text::Wrap::columns) = $max_len;
597        @msgs = split "\n", wrap("", "", join "\n", @msgs);
598    }
599    for my $body (@msgs) {
600        if ($body =~ /^\/me (.*)/) {
601            $conn->me($to, Encode::encode('utf-8', $1));
602            $body = '* '.$conn->nick.' '.$1;
603        } else {
604            $conn->conn->send_msg('privmsg', $to, Encode::encode('utf-8', $body));
605        }
606        my $msg = BarnOwl::Message->new(
607            type        => 'IRC',
608            direction   => is_private($to) ? 'out' : 'in',
609            server      => $conn->server,
610            network     => $conn->alias,
611            recipient   => $to,
612            body        => $body,
613            sender      => $conn->nick,
614            is_private($to) ?
615              (isprivate  => 'true') : (channel => $to),
616            replycmd    => BarnOwl::quote('irc-msg',  '-a', $conn->alias, $to),
617            replysendercmd => BarnOwl::quote('irc-msg', '-a', $conn->alias, $to),
618        );
619        BarnOwl::queue_message($msg);
620    }
621    return;
622}
623
624sub cmd_mode {
625    my $cmd = shift;
626    my $conn = shift;
627    my $target = shift;
628    $target ||= shift;
629    $conn->conn->send_msg(mode => $target, @_);
630    return;
631}
632
633sub cmd_join {
634    my $cmd = shift;
635    my $is_temporary;
636
637    my $getopt = Getopt::Long::Parser->new;
638
639    local @ARGV = @_;
640    $getopt->configure(qw(pass_through permute no_getopt_compat prefix_pattern=-|--));
641    $getopt->getoptions("temporary" => \$is_temporary);
642
643    my $conn = shift @ARGV;
644    my $chan = shift @ARGV or die("Usage: $cmd channel\n");
645
646    die "Channel name '$chan' contains a space.  As per RFC 2812, IRC channel names may not contain spaces.\n" unless index($chan, " ") == -1;
647
648    $conn->conn->send_msg(join => $chan, @ARGV);
649
650    # regardless of whether or not this is temporary, we want to persist it
651    # across reconnects.
652
653    # check if the channel is already in the list
654    if (!grep { $_ eq $chan } @{$conn->autoconnect_channels}) {
655        push @{$conn->autoconnect_channels}, $chan;
656    }
657
658    if (!$is_temporary) {
659        # add the line to the subs file
660        add_autoconnect_channel($conn, $chan);
661    }
662
663    return;
664}
665
666sub cmd_part {
667    my $cmd = shift;
668    my $is_temporary;
669
670    my $getopt = Getopt::Long::Parser->new;
671
672    local @ARGV = @_;
673    $getopt->configure(qw(pass_through permute no_getopt_compat prefix_pattern=-|--));
674    $getopt->getoptions("temporary" => \$is_temporary);
675
676    my $conn = shift @ARGV;
677    my $chan = shift @ARGV or die("Usage: $cmd channel\n");
678
679    $conn->conn->send_msg(part => $chan);
680
681    # regardless of whether or not this is temporary, we want to persist it
682    # across reconnects
683    my %existing_channels = map { $_ => 1 } @{$conn->autoconnect_channels};
684    delete $existing_channels{$chan};
685    $conn->autoconnect_channels([keys %existing_channels]);
686
687    if (!$is_temporary) {
688        # remove the line from the subs file
689        remove_autoconnect_channel($conn, $chan);
690    }
691
692    return;
693}
694
695sub cmd_nick {
696    my $cmd = shift;
697    my $conn = shift;
698    my $nick = shift or die("Usage: $cmd <new nick>\n");
699    $conn->conn->send_msg(nick => $nick);
700    return;
701}
702
703sub cmd_names {
704    my $cmd = shift;
705    my $conn = shift;
706    my $chan = shift;
707    $conn->names_tmp([]);
708    $conn->conn->send_msg(names => $chan);
709    return;
710}
711
712sub cmd_whois {
713    my $cmd = shift;
714    my $conn = shift;
715    my $who = shift || die("Usage: $cmd <user>\n");
716    $conn->conn->send_msg(whois => $who);
717    return;
718}
719
720sub cmd_motd {
721    my $cmd = shift;
722    my $conn = shift;
723    $conn->conn->send_msg('motd');
724    return;
725}
726
727sub cmd_list {
728    my $cmd = shift;
729    my $message = BarnOwl::Style::boldify('Current IRC networks:') . "\n";
730    while (my ($alias, $conn) = each %ircnets) {
731        $message .= '  ' . $alias . ' => ' . $conn->nick . '@' . $conn->server . "\n";
732    }
733    BarnOwl::popless_ztext($message);
734    return;
735}
736
737sub cmd_who {
738    my $cmd = shift;
739    my $conn = shift;
740    my $who = shift || die("Usage: $cmd <user>\n");
741    $conn->conn->send_msg(who => $who);
742    return;
743}
744
745sub cmd_stats {
746    my $cmd = shift;
747    my $conn = shift;
748    my $type = shift || die("Usage: $cmd <chiklmouy> [server] \n");
749    $conn->conn->send_msg(stats => $type, @_);
750    return;
751}
752
753sub cmd_topic {
754    my $cmd = shift;
755    my $conn = shift;
756    my $chan = shift;
757    $conn->conn->send_msg(topic => $chan, @_ ? join(" ", @_) : undef);
758    return;
759}
760
761sub cmd_quote {
762    my $cmd = shift;
763    my $conn = shift;
764    $conn->conn->send_msg(@_);
765    return;
766}
767
768################################################################################
769########################### Utilities/Helpers ##################################
770################################################################################
771
772sub find_channel {
773    my $channel = shift;
774    my @found;
775    for my $conn (values %ircnets) {
776        if($conn->conn->{channel_list}{lc $channel}) {
777            push @found, $conn;
778        }
779    }
780    return $found[0] if(scalar @found == 1);
781}
782
783sub mk_irc_command {
784    my $sub = shift;
785    my $flags = shift || 0;
786    return sub {
787        my $cmd = shift;
788        my $conn;
789        my $alias;
790        my $channel;
791        my $is_temporary;
792        my $getopt = Getopt::Long::Parser->new;
793        my $m = BarnOwl::getcurmsg();
794
795        local @ARGV = @_;
796        $getopt->configure(qw(pass_through permute no_getopt_compat prefix_pattern=-|--));
797        $getopt->getoptions("alias=s" => \$alias,
798                            "temporary" => \$is_temporary);
799
800        if(defined($alias)) {
801            $conn = get_connection_by_alias($alias,
802                                            $flags & ALLOW_DISCONNECTED);
803        }
804        if($flags & CHANNEL_ARG) {
805            $channel = $ARGV[0];
806            if(defined($channel) && $channel =~ /^#/) {
807                if(my $c = find_channel($channel)) {
808                    shift @ARGV;
809                    $conn ||= $c;
810                }
811            } elsif (defined($channel) && ($flags & CHANNEL_OR_USER)) {
812                shift @ARGV;
813            } elsif ($m && $m->type eq 'IRC' && !$m->is_private) {
814                $channel = $m->channel;
815            } else {
816                undef $channel;
817            }
818        }
819
820        if(!defined($channel) &&
821           ($flags & CHANNEL_ARG) &&
822           !($flags & CHANNEL_OPTIONAL)) {
823            die("Usage: $cmd <channel>\n");
824        }
825        if(!$conn) {
826            if($m && $m->type eq 'IRC') {
827                $conn = get_connection_by_alias($m->network,
828                                               $flags & ALLOW_DISCONNECTED);
829            }
830        }
831        if(!$conn && scalar keys %ircnets == 1) {
832            $conn = [values(%ircnets)]->[0];
833        }
834        if(!$conn) {
835            die("You must specify an IRC network using -a.\n");
836        }
837        push @ARGV, "-t" if $is_temporary;
838        if($flags & CHANNEL_ARG) {
839            $sub->($cmd, $conn, $channel, @ARGV);
840        } else {
841            $sub->($cmd, $conn, @ARGV);
842        }
843    };
844}
845
846sub get_connection_by_alias {
847    my $key = shift;
848    my $allow_disconnected = shift;
849
850    my $conn = $ircnets{$key};
851    die("No such ircnet: $key\n") unless $conn;
852    if ($conn->conn->{registered} || $allow_disconnected) {
853        return $conn;
854    }
855    die("[@{[$conn->alias]}] Not currently connected.");
856}
857
8581;
Note: See TracBrowser for help on using the repository browser.