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

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