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

debianrelease-1.4release-1.5release-1.6release-1.7release-1.8release-1.9
Last change on this file since 330c55a was 330c55a, checked in by Nelson Elhage <nelhage@mit.edu>, 13 years ago
Refactor IRC argument processing. The primary concrete improvement here is that '-a [connection]' no longer needs to come at the start of the command line.
  • Property mode set to 100644
File size: 10.7 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);
[b38b0b2]20
21use Net::IRC;
22use Getopt::Long;
23
[2c40dc0]24our $VERSION = 0.02;
[b38b0b2]25
26our $irc;
27
28# Hash alias -> BarnOwl::Module::IRC::Connection object
29our %ircnets;
[fe8cad8]30our %channels;
[b38b0b2]31
32sub startup {
[b10f340]33    BarnOwl::new_variable_string('irc:nick', {
34        default     => $ENV{USER},
35        summary     => 'The default IRC nickname',
36        description => 'By default, irc-connect will use this nick '  .
37        'when connecting to a new server. See :help irc-connect for ' .
38        'more information.'
39       });
40
41    BarnOwl::new_variable_string('irc:user', {
42        default => $ENV{USER},
43        summary => 'The IRC "username" field'
44       });
45        BarnOwl::new_variable_string('irc:name', {
46        default => "",
47        summary     => 'A short name field for IRC',
48        description => 'A short (maybe 60 or so chars) piece of text, ' .
49        'originally intended to display your real name, which people '  .
50        'often use for pithy quotes and URLs.'
51       });
52   
53    BarnOwl::new_variable_bool('irc:spew', {
54        default     => 0,
55        summary     => 'Show unhandled IRC events',
56        description => 'If set, display all unrecognized IRC events as ' .
57        'admin messages. Intended for debugging and development use only '
58       });
59   
[b38b0b2]60    register_commands();
61    register_handlers();
62    BarnOwl::filter('irc type ^IRC$');
63}
64
65sub shutdown {
66    for my $conn (values %ircnets) {
[ba2ca66]67        $conn->conn->disconnect();
[b38b0b2]68    }
69}
70
[9c7a701]71#sub mainloop_hook {
72#    return unless defined $irc;
73#    eval {
74#        $irc->do_one_loop();
75#    };
76#    return;
77#}
78
79sub OwlProcess {
[b38b0b2]80    return unless defined $irc;
81    eval {
82        $irc->do_one_loop();
83    };
84    return;
85}
86
[9c7a701]87
[b38b0b2]88sub register_handlers {
89    if(!$irc) {
90        $irc = Net::IRC->new;
91        $irc->timeout(0);
92    }
93}
94
[330c55a]95use constant OPTIONAL_CHANNEL => 1;
96use constant REQUIRE_CHANNEL => 2;
97
[b38b0b2]98sub register_commands {
[b0c8011]99    BarnOwl::new_command('irc-connect' => \&cmd_connect,
100                       {
101                           summary      => 'Connect to an IRC server',
102                           usage        => 'irc-connect [-a ALIAS ] [-s] [-p PASSWORD] [-n NICK] SERVER [port]',
103                           description  =>
104
105                           "Connect to an IRC server. Supported options are\n\n" .
106                           "-a <alias>          Define an alias for this server\n" .
107                           "-s                  Use SSL\n" .
108                           "-p <password>       Specify the password to use\n" .
109                           "-n <nick>           Use a non-default nick"
110                       });
[330c55a]111    BarnOwl::new_command('irc-disconnect' => mk_irc_command(\&cmd_disconnect));
112    BarnOwl::new_command('irc-msg'        => mk_irc_command(\&cmd_msg, OPTIONAL_CHANNEL));
113    BarnOwl::new_command('irc-join'       => mk_irc_command(\&cmd_join));
114    BarnOwl::new_command('irc-part'       => mk_irc_command(\&cmd_part, REQUIRE_CHANNEL));
115    BarnOwl::new_command('irc-nick'       => mk_irc_command(\&cmd_nick));
116    BarnOwl::new_command('irc-names'      => mk_irc_command(\&cmd_names, REQUIRE_CHANNEL));
117    BarnOwl::new_command('irc-whois'      => mk_irc_command(\&cmd_whois));
118    BarnOwl::new_command('irc-motd'       => mk_irc_command(\&cmd_motd));
[f094fc4]119    BarnOwl::new_command('irc-list'       => \&cmd_list);
[330c55a]120    BarnOwl::new_command('irc-who'        => mk_irc_command(\&cmd_who));
121    BarnOwl::new_command('irc-stats'      => mk_irc_command(\&cmd_stats));
122    BarnOwl::new_command('irc-topic'      => mk_irc_command(\&cmd_topic, REQUIRE_CHANNEL));
[b38b0b2]123}
124
[167044b]125$BarnOwl::Hooks::startup->add('BarnOwl::Module::IRC::startup');
126$BarnOwl::Hooks::shutdown->add('BarnOwl::Module::IRC::shutdown');
[b38b0b2]127
128################################################################################
129######################## Owl command handlers ##################################
130################################################################################
131
132sub cmd_connect {
133    my $cmd = shift;
134
[2c40dc0]135    my $nick = BarnOwl::getvar('irc:nick');
136    my $username = BarnOwl::getvar('irc:user');
137    my $ircname = BarnOwl::getvar('irc:name');
[b38b0b2]138    my $host;
139    my $port;
140    my $alias;
141    my $ssl;
142    my $password = undef;
143
144    {
145        local @ARGV = @_;
146        GetOptions(
147            "alias=s"    => \$alias,
148            "ssl"        => \$ssl,
[2c40dc0]149            "password=s" => \$password,
[b10f340]150            "nick=s"     => \$nick,
[2c40dc0]151        );
[b38b0b2]152        $host = shift @ARGV or die("Usage: $cmd HOST\n");
153        if(!$alias) {
[f094fc4]154            if($host =~ /^(?:irc[.])?([\w-]+)[.]\w+$/) {
[b0c8011]155                $alias = $1;
156            } else {
157                $alias = $host;
158            }
[b38b0b2]159        }
160        $ssl ||= 0;
[f094fc4]161        $port = shift @ARGV || ($ssl ? 6697 : 6667);
[b38b0b2]162    }
163
[b0c8011]164    if(exists $ircnets{$alias}) {
165        die("Already connected to a server with alias '$alias'. Either disconnect or specify an alias with -a.\n");
166    }
167
[b38b0b2]168    my $conn = BarnOwl::Module::IRC::Connection->new($irc, $alias,
169        Nick      => $nick,
170        Server    => $host,
171        Port      => $port,
172        Username  => $username,
173        Ircname   => $ircname,
174        Port      => $port,
175        Password  => $password,
176        SSL       => $ssl
177       );
178
[cab045b]179    if ($conn->conn->connected) {
[5ff830a]180        BarnOwl::admin_message("IRC", "Connected to $alias as $nick");
181        $ircnets{$alias} = $conn;
[9c7a701]182        my $fd = $conn->getSocket()->fileno();
183        BarnOwl::add_dispatch($fd, \&OwlProcess);
184        $conn->{FD} = $fd;
[5ff830a]185    } else {
186        die("IRC::Connection->connect failed: $!");
187    }
188
[b38b0b2]189    return;
190}
191
192sub cmd_disconnect {
193    my $cmd = shift;
194    my $conn = get_connection(\@_);
[ba2ca66]195    $conn->conn->disconnect;
[b38b0b2]196    delete $ircnets{$conn->alias};
197}
198
199sub cmd_msg {
[330c55a]200    my $cmd  = shift;
201    my $conn = shift;
202    my $to = shift || shift or die("Usage: $cmd NICK\n");
[2c40dc0]203    # handle multiple recipients?
[b38b0b2]204    if(@_) {
205        process_msg($conn, $to, join(" ", @_));
206    } else {
[3c5fe43]207        BarnOwl::start_edit_win("/msg -a " . $conn->alias . " $to", sub {process_msg($conn, $to, @_)});
[b38b0b2]208    }
209}
210
211sub process_msg {
212    my $conn = shift;
213    my $to = shift;
214    my $body = shift;
215    # Strip whitespace. In the future -- send one message/line?
216    $body =~ tr/\n\r/  /;
[919535f]217    if ($body =~ /^\/me (.*)/) {
218        $conn->conn->me($to, $1);
[56d0189]219        $body = '* '.$conn->nick.' '.$1;
[919535f]220    } else {
221        $conn->conn->privmsg($to, $body);
222    }
[b38b0b2]223    my $msg = BarnOwl::Message->new(
224        type        => 'IRC',
[6858d2d]225        direction   => is_private($to) ? 'out' : 'in',
[b38b0b2]226        server      => $conn->server,
227        network     => $conn->alias,
228        recipient   => $to,
229        body        => $body,
230        sender      => $conn->nick,
[2c40dc0]231        is_private($to) ?
[0e52069]232          (isprivate  => 'true') : (channel => $to),
[3c5fe43]233        replycmd    => "irc-msg -a " . $conn->alias . " $to",
234        replysendercmd => "irc-msg -a " . $conn->alias . " $to"
[b38b0b2]235       );
236    BarnOwl::queue_message($msg);
237}
238
[2c40dc0]239sub cmd_join {
240    my $cmd = shift;
[330c55a]241    my $conn = shift;
[2c40dc0]242    my $chan = shift or die("Usage: $cmd channel\n");
[fe8cad8]243    $channels{$chan} ||= [];
244    push @{$channels{$chan}}, $conn;
[ba2ca66]245    $conn->conn->join($chan);
[2c40dc0]246}
[b38b0b2]247
[6858d2d]248sub cmd_part {
249    my $cmd = shift;
[330c55a]250    my $conn = shift;
251    my $chan = shift;
[fe8cad8]252    $channels{$chan} = [grep {$_ ne $conn} @{$channels{$chan} || []}];
[ba2ca66]253    $conn->conn->part($chan);
[6858d2d]254}
255
[6286f26]256sub cmd_nick {
257    my $cmd = shift;
[330c55a]258    my $conn = shift;
[b0c8011]259    my $nick = shift or die("Usage: $cmd <new nick>\n");
[ba2ca66]260    $conn->conn->nick($nick);
[6286f26]261}
262
[6858d2d]263sub cmd_names {
264    my $cmd = shift;
[330c55a]265    my $conn = shift;
266    my $chan = shift;
[d264c6d]267    $conn->names_tmp([]);
[ba2ca66]268    $conn->conn->names($chan);
[6858d2d]269}
270
[b0c8011]271sub cmd_whois {
272    my $cmd = shift;
[330c55a]273    my $conn = shift;
[b0c8011]274    my $who = shift || die("Usage: $cmd <user>\n");
[ba2ca66]275    $conn->conn->whois($who);
[b0c8011]276}
277
[56e72d5]278sub cmd_motd {
279    my $cmd = shift;
[330c55a]280    my $conn = shift;
[ba2ca66]281    $conn->conn->motd;
[56e72d5]282}
283
[f094fc4]284sub cmd_list {
285    my $cmd = shift;
286    my $message = BarnOwl::Style::boldify('Current IRC networks:') . "\n";
287    while (my ($alias, $conn) = each %ircnets) {
288        $message .= '  ' . $alias . ' => ' . $conn->nick . '@' . $conn->server . "\n";
289    }
290    BarnOwl::popless_ztext($message);
291}
292
293sub cmd_who {
294    my $cmd = shift;
[330c55a]295    my $conn = shift;
[f094fc4]296    my $who = shift || die("Usage: $cmd <user>\n");
[330c55a]297    BarnOwl::error("WHO $cmd $conn $who");
[f094fc4]298    $conn->conn->who($who);
299}
300
301sub cmd_stats {
302    my $cmd = shift;
[330c55a]303    my $conn = shift;
[f094fc4]304    my $type = shift || die("Usage: $cmd <chiklmouy> [server] \n");
305    $conn->conn->stats($type, @_);
306}
307
[3ad15ff]308sub cmd_topic {
309    my $cmd = shift;
[330c55a]310    my $conn = shift;
311    my $chan = shift;
312    $conn->conn->topic($chan, @_ ? join(" ", @_) : undef);
[3ad15ff]313}
314
[b38b0b2]315################################################################################
316########################### Utilities/Helpers ##################################
317################################################################################
318
[330c55a]319sub mk_irc_command {
320    my $sub = shift;
321    my $use_channel = shift || 0;
322    return sub {
323        my $cmd = shift;
324        my $conn;
325        my $alias;
326        my $channel;
327        my $getopt = Getopt::Long::Parser->new;
328        my $m = BarnOwl::getcurmsg();
[b38b0b2]329
[330c55a]330        local @ARGV = @_;
331        $getopt->configure(qw(pass_through permute no_getopt_compat prefix_pattern=-|--));
332        $getopt->getoptions("alias=s" => \$alias);
333
334        if(defined($alias)) {
335            $conn = get_connection_by_alias($alias);
336        }
337        if(!$conn && $use_channel) {
338            $channel = $ARGV[-1];
339            if(defined($channel) && $channel =~ /^#/) {
340                if($channels{$channel} && @{$channels{$channel}} == 1) {
341                    pop @ARGV;
342                    $conn = $channels{$channel}[0];
343                } 
344            } else {
345                if($m && $m->type eq 'IRC' && !$m->is_private) {
346                    $channel = $m->channel;
347                } else {
348                    undef $channel;
349                }
350            }
351        }
352        if(!$channel && $use_channel == REQUIRE_CHANNEL) {
353            die("Usage: $cmd <channel>\n");
354        }
355        if(!$conn) {
356            if($m && $m->type eq 'IRC') {
357                $conn = get_connection_by_alias($m->network);
358            }
359        }
360        if(!$conn && scalar keys %ircnets == 1) {
361            $conn = [values(%ircnets)]->[0];
362        }
363        if(!$conn) {
364            die("You must specify an IRC network using -a.\n");
365        }
366        if($use_channel) {
367            $sub->($cmd, $conn, $channel, @ARGV);
368        } else {
369            $sub->($cmd, $conn, @ARGV);
370        }
371    };
[6858d2d]372}
373
[b38b0b2]374sub get_connection_by_alias {
[2c40dc0]375    my $key = shift;
376    die("No such ircnet: $key\n") unless exists $ircnets{$key};
[b38b0b2]377    return $ircnets{$key};
378}
379
3801;
Note: See TracBrowser for help on using the repository browser.