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

barnowl_perlaimdebianrelease-1.10release-1.4release-1.5release-1.6release-1.7release-1.8release-1.9
Last change on this file since 3baf77f was 56e72d5, checked in by Nelson Elhage <nelhage@mit.edu>, 17 years ago
Kill a uninitialized warning
  • Property mode set to 100644
File size: 8.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->disconnect();
68    }
69}
70
71sub mainloop_hook {
72    return unless defined $irc;
73    eval {
74        $irc->do_one_loop();
75    };
76    return;
77}
78
79sub register_handlers {
80    if(!$irc) {
81        $irc = Net::IRC->new;
82        $irc->timeout(0);
83    }
84}
85
86sub register_commands {
87    BarnOwl::new_command('irc-connect' => \&cmd_connect,
88                       {
89                           summary      => 'Connect to an IRC server',
90                           usage        => 'irc-connect [-a ALIAS ] [-s] [-p PASSWORD] [-n NICK] SERVER [port]',
91                           description  =>
92
93                           "Connect to an IRC server. Supported options are\n\n" .
94                           "-a <alias>          Define an alias for this server\n" .
95                           "-s                  Use SSL\n" .
96                           "-p <password>       Specify the password to use\n" .
97                           "-n <nick>           Use a non-default nick"
98                       });
99    BarnOwl::new_command('irc-disconnect' => \&cmd_disconnect);
100    BarnOwl::new_command('irc-msg'        => \&cmd_msg);
101    BarnOwl::new_command('irc-join'       => \&cmd_join);
102    BarnOwl::new_command('irc-part'       => \&cmd_part);
103    BarnOwl::new_command('irc-nick'       => \&cmd_nick);
104    BarnOwl::new_command('irc-names'      => \&cmd_names);
105    BarnOwl::new_command('irc-whois'      => \&cmd_whois);
106    BarnOwl::new_command('irc-motd'       => \&cmd_motd);
107}
108
109$BarnOwl::Hooks::startup->add(\&startup);
110$BarnOwl::Hooks::shutdown->add(\&shutdown);
111$BarnOwl::Hooks::mainLoop->add(\&mainloop_hook);
112
113################################################################################
114######################## Owl command handlers ##################################
115################################################################################
116
117sub cmd_connect {
118    my $cmd = shift;
119
120    my $nick = BarnOwl::getvar('irc:nick');
121    my $username = BarnOwl::getvar('irc:user');
122    my $ircname = BarnOwl::getvar('irc:name');
123    my $host;
124    my $port;
125    my $alias;
126    my $ssl;
127    my $password = undef;
128
129    {
130        local @ARGV = @_;
131        GetOptions(
132            "alias=s"    => \$alias,
133            "ssl"        => \$ssl,
134            "password=s" => \$password,
135            "nick=s"     => \$nick,
136        );
137        $host = shift @ARGV or die("Usage: $cmd HOST\n");
138        if(!$alias) {
139            if($host =~ /^(?:irc[.])?(\w+)[.]\w+$/) {
140                $alias = $1;
141            } else {
142                $alias = $host;
143            }
144        }
145        $port = shift @ARGV || 6667;
146        $ssl ||= 0;
147    }
148
149    if(exists $ircnets{$alias}) {
150        die("Already connected to a server with alias '$alias'. Either disconnect or specify an alias with -a.\n");
151    }
152
153    my $conn = BarnOwl::Module::IRC::Connection->new($irc, $alias,
154        Nick      => $nick,
155        Server    => $host,
156        Port      => $port,
157        Username  => $username,
158        Ircname   => $ircname,
159        Port      => $port,
160        Password  => $password,
161        SSL       => $ssl
162       );
163
164    $ircnets{$alias} = $conn;
165    return;
166}
167
168sub cmd_disconnect {
169    my $cmd = shift;
170    my $conn = get_connection(\@_);
171    $conn->disconnect;
172    delete $ircnets{$conn->alias};
173}
174
175sub cmd_msg {
176    my $cmd = shift;
177    my $conn = get_connection(\@_);
178    my $to = shift or die("Usage: $cmd NICK\n");
179    # handle multiple recipients?
180    if(@_) {
181        process_msg($conn, $to, join(" ", @_));
182    } else {
183        BarnOwl::start_edit_win("/msg $to -a " . $conn->alias, sub {process_msg($conn, $to, @_)});
184    }
185}
186
187sub process_msg {
188    my $conn = shift;
189    my $to = shift;
190    my $body = shift;
191    # Strip whitespace. In the future -- send one message/line?
192    $body =~ tr/\n\r/  /;
193    $conn->privmsg($to, $body);
194    my $msg = BarnOwl::Message->new(
195        type        => 'IRC',
196        direction   => is_private($to) ? 'out' : 'in',
197        server      => $conn->server,
198        network     => $conn->alias,
199        recipient   => $to,
200        body        => $body,
201        sender      => $conn->nick,
202        is_private($to) ?
203          (isprivate  => 'true') : (channel => $to),
204        replycmd    => "irc-msg $to",
205        replysendercmd => "irc-msg $to"
206       );
207    BarnOwl::queue_message($msg);
208}
209
210sub cmd_join {
211    my $cmd = shift;
212    my $conn = get_connection(\@_);
213    my $chan = shift or die("Usage: $cmd channel\n");
214    $channels{$chan} ||= [];
215    push @{$channels{$chan}}, $conn;
216    $conn->join($chan);
217}
218
219sub cmd_part {
220    my $cmd = shift;
221    my $conn = get_connection(\@_);
222    my $chan = get_channel(\@_) || die("Usage: $cmd <channel>\n");
223    $channels{$chan} = [grep {$_ ne $conn} @{$channels{$chan} || []}];
224    $conn->part($chan);
225}
226
227sub cmd_nick {
228    my $cmd = shift;
229    my $conn = get_connection(\@_);
230    my $nick = shift or die("Usage: $cmd <new nick>\n");
231    $conn->nick($nick);
232}
233
234sub cmd_names {
235    my $cmd = shift;
236    my $conn = get_connection(\@_);
237    my $chan = get_channel(\@_) || die("Usage: $cmd <channel>\n");
238    $conn->names($chan);
239}
240
241sub cmd_whois {
242    my $cmd = shift;
243    my $conn = get_connection(\@_);
244    my $who = shift || die("Usage: $cmd <user>\n");
245    $conn->whois($who);
246}
247
248sub cmd_motd {
249    my $cmd = shift;
250    my $conn = get_connection(\@_);
251    $conn->motd;
252}
253
254################################################################################
255########################### Utilities/Helpers ##################################
256################################################################################
257
258sub get_connection {
259    my $args = shift;
260    if(scalar @$args >= 2 && $args->[0] eq '-a') {
261        shift @$args;
262        return get_connection_by_alias(shift @$args);
263    }
264    my $channel = $args->[-1];
265    if (defined($channel) && $channel =~ /^#/
266        and $channels{$channel} and @{$channels{$channel}} == 1) {
267        return $channels{$channel}[0];
268    }
269    my $m = BarnOwl::getcurmsg();
270    if($m && $m->type eq 'IRC') {
271        return get_connection_by_alias($m->network);
272    }
273    if(scalar keys %ircnets == 1) {
274        return [values(%ircnets)]->[0];
275    }
276    die("You must specify a network with -a\n");
277}
278
279sub get_channel {
280    my $args = shift;
281    if(scalar @$args) {
282        return shift @$args;
283    }
284    my $m = BarnOwl::getcurmsg();
285    if($m && $m->type eq 'IRC') {
286        return $m->channel if !$m->is_private;
287    }
288    return undef;
289}
290
291sub get_connection_by_alias {
292    my $key = shift;
293    die("No such ircnet: $key\n") unless exists $ircnets{$key};
294    return $ircnets{$key};
295}
296
2971;
Note: See TracBrowser for help on using the repository browser.