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

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