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

barnowl_perlaimdebianrelease-1.10release-1.4release-1.5release-1.6release-1.7release-1.8release-1.9
Last change on this file since b0c8011 was b0c8011, checked in by Nelson Elhage <nelhage@mit.edu>, 16 years ago
doc nits
  • Property mode set to 100644
File size: 7.6 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;
30
31sub startup {
32    BarnOwl::new_variable_string('irc:nick', {
33        default     => $ENV{USER},
34        summary     => 'The default IRC nickname',
35        description => 'By default, irc-connect will use this nick '  .
36        'when connecting to a new server. See :help irc-connect for ' .
37        'more information.'
38       });
39
40    BarnOwl::new_variable_string('irc:user', {
41        default => $ENV{USER},
42        summary => 'The IRC "username" field'
43       });
44        BarnOwl::new_variable_string('irc:name', {
45        default => "",
46        summary     => 'A short name field for IRC',
47        description => 'A short (maybe 60 or so chars) piece of text, ' .
48        'originally intended to display your real name, which people '  .
49        'often use for pithy quotes and URLs.'
50       });
51   
52    BarnOwl::new_variable_bool('irc:spew', {
53        default     => 0,
54        summary     => 'Show unhandled IRC events',
55        description => 'If set, display all unrecognized IRC events as ' .
56        'admin messages. Intended for debugging and development use only '
57       });
58   
59    register_commands();
60    register_handlers();
61    BarnOwl::filter('irc type ^IRC$');
62}
63
64sub shutdown {
65    for my $conn (values %ircnets) {
66        $conn->disconnect();
67    }
68}
69
70sub mainloop_hook {
71    return unless defined $irc;
72    eval {
73        $irc->do_one_loop();
74    };
75    return;
76}
77
78sub register_handlers {
79    if(!$irc) {
80        $irc = Net::IRC->new;
81        $irc->timeout(0);
82    }
83}
84
85sub register_commands {
86    BarnOwl::new_command('irc-connect' => \&cmd_connect,
87                       {
88                           summary      => 'Connect to an IRC server',
89                           usage        => 'irc-connect [-a ALIAS ] [-s] [-p PASSWORD] [-n NICK] SERVER [port]',
90                           description  =>
91
92                           "Connect to an IRC server. Supported options are\n\n" .
93                           "-a <alias>          Define an alias for this server\n" .
94                           "-s                  Use SSL\n" .
95                           "-p <password>       Specify the password to use\n" .
96                           "-n <nick>           Use a non-default nick"
97                       });
98    BarnOwl::new_command('irc-disconnect' => \&cmd_disconnect);
99    BarnOwl::new_command('irc-msg'        => \&cmd_msg);
100    BarnOwl::new_command('irc-join'       => \&cmd_join);
101    BarnOwl::new_command('irc-part'       => \&cmd_part);
102    BarnOwl::new_command('irc-nick'       => \&cmd_nick);
103    BarnOwl::new_command('irc-names'      => \&cmd_names);
104    BarnOwl::new_command('irc-whois'      => \&cmd_whois);
105}
106
107$BarnOwl::Hooks::startup->add(\&startup);
108$BarnOwl::Hooks::shutdown->add(\&shutdown);
109$BarnOwl::Hooks::mainLoop->add(\&mainloop_hook);
110
111################################################################################
112######################## Owl command handlers ##################################
113################################################################################
114
115sub cmd_connect {
116    my $cmd = shift;
117
118    my $nick = BarnOwl::getvar('irc:nick');
119    my $username = BarnOwl::getvar('irc:user');
120    my $ircname = BarnOwl::getvar('irc:name');
121    my $host;
122    my $port;
123    my $alias;
124    my $ssl;
125    my $password = undef;
126
127    {
128        local @ARGV = @_;
129        GetOptions(
130            "alias=s"    => \$alias,
131            "ssl"        => \$ssl,
132            "password=s" => \$password,
133            "nick=s"     => \$nick,
134        );
135        $host = shift @ARGV or die("Usage: $cmd HOST\n");
136        if(!$alias) {
137            if($host =~ /^(?:irc[.])?(\w+)[.]\w+$/) {
138                $alias = $1;
139            } else {
140                $alias = $host;
141            }
142        }
143        $port = shift @ARGV || 6667;
144        $ssl ||= 0;
145    }
146
147    if(exists $ircnets{$alias}) {
148        die("Already connected to a server with alias '$alias'. Either disconnect or specify an alias with -a.\n");
149    }
150
151    my $conn = BarnOwl::Module::IRC::Connection->new($irc, $alias,
152        Nick      => $nick,
153        Server    => $host,
154        Port      => $port,
155        Username  => $username,
156        Ircname   => $ircname,
157        Port      => $port,
158        Password  => $password,
159        SSL       => $ssl
160       );
161
162    $ircnets{$alias} = $conn;
163    return;
164}
165
166sub cmd_disconnect {
167    my $cmd = shift;
168    my $conn = get_connection(\@_);
169    $conn->disconnect;
170    delete $ircnets{$conn->alias};
171}
172
173sub cmd_msg {
174    my $cmd = shift;
175    my $conn = get_connection(\@_);
176    my $to = shift or die("Usage: $cmd NICK\n");
177    # handle multiple recipients?
178    if(@_) {
179        process_msg($conn, $to, join(" ", @_));
180    } else {
181        BarnOwl::start_edit_win("/msg $to -a " . $conn->alias, sub {process_msg($conn, $to, @_)});
182    }
183}
184
185sub process_msg {
186    my $conn = shift;
187    my $to = shift;
188    my $body = shift;
189    # Strip whitespace. In the future -- send one message/line?
190    $body =~ tr/\n\r/  /;
191    $conn->privmsg($to, $body);
192    my $msg = BarnOwl::Message->new(
193        type        => 'IRC',
194        direction   => is_private($to) ? 'out' : 'in',
195        server      => $conn->server,
196        network     => $conn->alias,
197        recipient   => $to,
198        body        => $body,
199        sender      => $conn->nick,
200        is_private($to) ?
201          (isprivate  => 'true') : (channel => $to),
202        replycmd    => "irc-msg $to",
203        replysendercmd => "irc-msg $to"
204       );
205    BarnOwl::queue_message($msg);
206}
207
208sub cmd_join {
209    my $cmd = shift;
210    my $conn = get_connection(\@_);
211    my $chan = shift or die("Usage: $cmd channel\n");
212    $conn->join($chan);
213}
214
215sub cmd_part {
216    my $cmd = shift;
217    my $conn = get_connection(\@_);
218    my $chan = get_channel(\@_) || die("Usage: $cmd <channel>\n");
219    $conn->part($chan);
220}
221
222sub cmd_nick {
223    my $cmd = shift;
224    my $conn = get_connection(\@_);
225    my $nick = shift or die("Usage: $cmd <new nick>\n");
226    $conn->nick($nick);
227}
228
229sub cmd_names {
230    my $cmd = shift;
231    my $conn = get_connection(\@_);
232    my $chan = get_channel(\@_) || die("Usage: $cmd <channel>\n");
233    $conn->names($chan);
234}
235
236sub cmd_whois {
237    my $cmd = shift;
238    my $conn = get_connection(\@_);
239    my $who = shift || die("Usage: $cmd <user>\n");
240    $conn->whois($who);
241}
242
243################################################################################
244########################### Utilities/Helpers ##################################
245################################################################################
246
247sub get_connection {
248    my $args = shift;
249    if(scalar @$args >= 2 && $args->[0] eq '-a') {
250        shift @$args;
251        return get_connection_by_alias(shift @$args);
252    }
253    my $m = BarnOwl::getcurmsg();
254    if($m && $m->type eq 'IRC') {
255        return get_connection_by_alias($m->network);
256    }
257    if(scalar keys %ircnets == 1) {
258        return [values(%ircnets)]->[0];
259    }
260    die("You must specify a network with -a\n");
261}
262
263sub get_channel {
264    my $args = shift;
265    if(scalar @$args) {
266        return shift @$args;
267    }
268    my $m = BarnOwl::getcurmsg();
269    if($m && $m->type eq 'IRC') {
270        return $m->channel if !$m->is_private;
271    }
272    return undef;
273}
274
275sub get_connection_by_alias {
276    my $key = shift;
277    die("No such ircnet: $key\n") unless exists $ircnets{$key};
278    return $ircnets{$key};
279}
280
2811;
Note: See TracBrowser for help on using the repository browser.