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

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