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

debianrelease-1.4release-1.5release-1.6release-1.7release-1.8release-1.9
Last change on this file since e625b5e was e625b5e, checked in by Nelson Elhage <nelhage@mit.edu>, 12 years ago
IRC: Implement irc-mode. We could probably be smarter about this; Right now I believe 'irc-mode #channel +m' works, but 'irc-mode +m #channel' doesn't. But it's a start.
  • Property mode set to 100644
File size: 11.1 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);
20
21use Net::IRC;
22use Getopt::Long;
23
24our $VERSION = 0.02;
25
26our $irc;
27
28# Hash alias -> BarnOwl::Module::IRC::Connection object
29our %ircnets;
30our %channels;
31
32sub startup {
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   
60    register_commands();
61    register_handlers();
62    BarnOwl::filter('irc type ^IRC$');
63}
64
65sub shutdown {
66    for my $conn (values %ircnets) {
67        $conn->conn->disconnect();
68    }
69}
70
71#sub mainloop_hook {
72#    return unless defined $irc;
73#    eval {
74#        $irc->do_one_loop();
75#    };
76#    return;
77#}
78
79sub OwlProcess {
80    return unless defined $irc;
81    eval {
82        $irc->do_one_loop();
83    };
84    return;
85}
86
87
88sub register_handlers {
89    if(!$irc) {
90        $irc = Net::IRC->new;
91        $irc->timeout(0);
92    }
93}
94
95use constant OPTIONAL_CHANNEL => 1;
96use constant REQUIRE_CHANNEL => 2;
97
98sub register_commands {
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                       });
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-mode'       => mk_irc_command(\&cmd_mode, OPTIONAL_CHANNEL));
114    BarnOwl::new_command('irc-join'       => mk_irc_command(\&cmd_join));
115    BarnOwl::new_command('irc-part'       => mk_irc_command(\&cmd_part, REQUIRE_CHANNEL));
116    BarnOwl::new_command('irc-nick'       => mk_irc_command(\&cmd_nick));
117    BarnOwl::new_command('irc-names'      => mk_irc_command(\&cmd_names, REQUIRE_CHANNEL));
118    BarnOwl::new_command('irc-whois'      => mk_irc_command(\&cmd_whois));
119    BarnOwl::new_command('irc-motd'       => mk_irc_command(\&cmd_motd));
120    BarnOwl::new_command('irc-list'       => \&cmd_list);
121    BarnOwl::new_command('irc-who'        => mk_irc_command(\&cmd_who));
122    BarnOwl::new_command('irc-stats'      => mk_irc_command(\&cmd_stats));
123    BarnOwl::new_command('irc-topic'      => mk_irc_command(\&cmd_topic, REQUIRE_CHANNEL));
124    BarnOwl::new_command('irc-quote'      => mk_irc_command(\&cmd_quote));
125}
126
127$BarnOwl::Hooks::startup->add('BarnOwl::Module::IRC::startup');
128$BarnOwl::Hooks::shutdown->add('BarnOwl::Module::IRC::shutdown');
129
130################################################################################
131######################## Owl command handlers ##################################
132################################################################################
133
134sub cmd_connect {
135    my $cmd = shift;
136
137    my $nick = BarnOwl::getvar('irc:nick');
138    my $username = BarnOwl::getvar('irc:user');
139    my $ircname = BarnOwl::getvar('irc:name');
140    my $host;
141    my $port;
142    my $alias;
143    my $ssl;
144    my $password = undef;
145
146    {
147        local @ARGV = @_;
148        GetOptions(
149            "alias=s"    => \$alias,
150            "ssl"        => \$ssl,
151            "password=s" => \$password,
152            "nick=s"     => \$nick,
153        );
154        $host = shift @ARGV or die("Usage: $cmd HOST\n");
155        if(!$alias) {
156            if($host =~ /^(?:irc[.])?([\w-]+)[.]\w+$/) {
157                $alias = $1;
158            } else {
159                $alias = $host;
160            }
161        }
162        $ssl ||= 0;
163        $port = shift @ARGV || ($ssl ? 6697 : 6667);
164    }
165
166    if(exists $ircnets{$alias}) {
167        die("Already connected to a server with alias '$alias'. Either disconnect or specify an alias with -a.\n");
168    }
169
170    my $conn = BarnOwl::Module::IRC::Connection->new($irc, $alias,
171        Nick      => $nick,
172        Server    => $host,
173        Port      => $port,
174        Username  => $username,
175        Ircname   => $ircname,
176        Port      => $port,
177        Password  => $password,
178        SSL       => $ssl
179       );
180
181    if ($conn->conn->connected) {
182        BarnOwl::admin_message("IRC", "Connected to $alias as $nick");
183        $ircnets{$alias} = $conn;
184        my $fd = $conn->getSocket()->fileno();
185        BarnOwl::add_dispatch($fd, \&OwlProcess);
186        $conn->{FD} = $fd;
187    } else {
188        die("IRC::Connection->connect failed: $!");
189    }
190
191    return;
192}
193
194sub cmd_disconnect {
195    my $cmd = shift;
196    my $conn = shift;
197    $conn->conn->disconnect;
198    delete $ircnets{$conn->alias};
199}
200
201sub cmd_msg {
202    my $cmd  = shift;
203    my $conn = shift;
204    my $to = shift || shift or die("Usage: $cmd NICK\n");
205    # handle multiple recipients?
206    if(@_) {
207        process_msg($conn, $to, join(" ", @_));
208    } else {
209        BarnOwl::start_edit_win("/msg -a " . $conn->alias . " $to", sub {process_msg($conn, $to, @_)});
210    }
211}
212
213sub process_msg {
214    my $conn = shift;
215    my $to = shift;
216    my $body = shift;
217    # Strip whitespace. In the future -- send one message/line?
218    $body =~ tr/\n\r/  /;
219    if ($body =~ /^\/me (.*)/) {
220        $conn->conn->me($to, $1);
221        $body = '* '.$conn->nick.' '.$1;
222    } else {
223        $conn->conn->privmsg($to, $body);
224    }
225    my $msg = BarnOwl::Message->new(
226        type        => 'IRC',
227        direction   => is_private($to) ? 'out' : 'in',
228        server      => $conn->server,
229        network     => $conn->alias,
230        recipient   => $to,
231        body        => $body,
232        sender      => $conn->nick,
233        is_private($to) ?
234          (isprivate  => 'true') : (channel => $to),
235        replycmd    => "irc-msg -a " . $conn->alias . " $to",
236        replysendercmd => "irc-msg -a " . $conn->alias . " $to"
237       );
238    BarnOwl::queue_message($msg);
239}
240
241sub cmd_mode {
242    my $cmd = shift;
243    my $conn = shift;
244    my $target = shift;
245    $target ||= shift;
246    $conn->conn->mode($target, @_);
247}
248
249sub cmd_join {
250    my $cmd = shift;
251    my $conn = shift;
252    my $chan = shift or die("Usage: $cmd channel\n");
253    $channels{$chan} ||= [];
254    push @{$channels{$chan}}, $conn;
255    $conn->conn->join($chan);
256}
257
258sub cmd_part {
259    my $cmd = shift;
260    my $conn = shift;
261    my $chan = shift;
262    $channels{$chan} = [grep {$_ ne $conn} @{$channels{$chan} || []}];
263    $conn->conn->part($chan);
264}
265
266sub cmd_nick {
267    my $cmd = shift;
268    my $conn = shift;
269    my $nick = shift or die("Usage: $cmd <new nick>\n");
270    $conn->conn->nick($nick);
271}
272
273sub cmd_names {
274    my $cmd = shift;
275    my $conn = shift;
276    my $chan = shift;
277    $conn->names_tmp([]);
278    $conn->conn->names($chan);
279}
280
281sub cmd_whois {
282    my $cmd = shift;
283    my $conn = shift;
284    my $who = shift || die("Usage: $cmd <user>\n");
285    $conn->conn->whois($who);
286}
287
288sub cmd_motd {
289    my $cmd = shift;
290    my $conn = shift;
291    $conn->conn->motd;
292}
293
294sub cmd_list {
295    my $cmd = shift;
296    my $message = BarnOwl::Style::boldify('Current IRC networks:') . "\n";
297    while (my ($alias, $conn) = each %ircnets) {
298        $message .= '  ' . $alias . ' => ' . $conn->nick . '@' . $conn->server . "\n";
299    }
300    BarnOwl::popless_ztext($message);
301}
302
303sub cmd_who {
304    my $cmd = shift;
305    my $conn = shift;
306    my $who = shift || die("Usage: $cmd <user>\n");
307    BarnOwl::error("WHO $cmd $conn $who");
308    $conn->conn->who($who);
309}
310
311sub cmd_stats {
312    my $cmd = shift;
313    my $conn = shift;
314    my $type = shift || die("Usage: $cmd <chiklmouy> [server] \n");
315    $conn->conn->stats($type, @_);
316}
317
318sub cmd_topic {
319    my $cmd = shift;
320    my $conn = shift;
321    my $chan = shift;
322    $conn->conn->topic($chan, @_ ? join(" ", @_) : undef);
323}
324
325sub cmd_quote {
326    my $cmd = shift;
327    my $conn = shift;
328    $conn->conn->sl(join(" ", @_));
329}
330
331################################################################################
332########################### Utilities/Helpers ##################################
333################################################################################
334
335sub mk_irc_command {
336    my $sub = shift;
337    my $use_channel = shift || 0;
338    return sub {
339        my $cmd = shift;
340        my $conn;
341        my $alias;
342        my $channel;
343        my $getopt = Getopt::Long::Parser->new;
344        my $m = BarnOwl::getcurmsg();
345
346        local @ARGV = @_;
347        $getopt->configure(qw(pass_through permute no_getopt_compat prefix_pattern=-|--));
348        $getopt->getoptions("alias=s" => \$alias);
349
350        if(defined($alias)) {
351            $conn = get_connection_by_alias($alias);
352        }
353        if(!$conn && $use_channel) {
354            $channel = $ARGV[0];
355            if(defined($channel) && $channel =~ /^#/) {
356                if($channels{$channel} && @{$channels{$channel}} == 1) {
357                    shift @ARGV;
358                    $conn = $channels{$channel}[0];
359                } 
360            } else {
361                if($m && $m->type eq 'IRC' && !$m->is_private) {
362                    $channel = $m->channel;
363                } else {
364                    undef $channel;
365                }
366            }
367        }
368        if(!$channel && $use_channel == REQUIRE_CHANNEL) {
369            die("Usage: $cmd <channel>\n");
370        }
371        if(!$conn) {
372            if($m && $m->type eq 'IRC') {
373                $conn = get_connection_by_alias($m->network);
374            }
375        }
376        if(!$conn && scalar keys %ircnets == 1) {
377            $conn = [values(%ircnets)]->[0];
378        }
379        if(!$conn) {
380            die("You must specify an IRC network using -a.\n");
381        }
382        if($use_channel) {
383            $sub->($cmd, $conn, $channel, @ARGV);
384        } else {
385            $sub->($cmd, $conn, @ARGV);
386        }
387    };
388}
389
390sub get_connection_by_alias {
391    my $key = shift;
392    die("No such ircnet: $key\n") unless exists $ircnets{$key};
393    return $ircnets{$key};
394}
395
3961;
Note: See TracBrowser for help on using the repository browser.