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

barnowl_perlaimdebianrelease-1.4release-1.5release-1.6release-1.7release-1.8release-1.9
Last change on this file since 6858d2d was 6858d2d, checked in by Nelson Elhage <nelhage@mit.edu>, 13 years ago
Implement /part and /names. We don't parse the /names response yet
  • Property mode set to 100644
File size: 5.7 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', {default => $ENV{USER}});
33    BarnOwl::new_variable_string('irc:user', {default => $ENV{USER}});
34    BarnOwl::new_variable_string('irc:name', {default => ""});
35    BarnOwl::new_variable_bool('irc:spew', {default => 0});
36    register_commands();
37    register_handlers();
38    BarnOwl::filter('irc type ^IRC$');
39}
40
41sub shutdown {
42    for my $conn (values %ircnets) {
43        $conn->disconnect();
44    }
45}
46
47sub mainloop_hook {
48    return unless defined $irc;
49    eval {
50        $irc->do_one_loop();
51    };
52    return;
53}
54
55sub register_handlers {
56    if(!$irc) {
57        $irc = Net::IRC->new;
58        $irc->timeout(0);
59    }
60}
61
62sub register_commands {
63    BarnOwl::new_command('irc-connect' => \&cmd_connect);
64    BarnOwl::new_command('irc-disconnect' => \&cmd_disconnect);
65    BarnOwl::new_command('irc-msg'     => \&cmd_msg);
66    BarnOwl::new_command('irc-join'    => \&cmd_join);
67    BarnOwl::new_command('irc-part'    => \&cmd_part);
68    BarnOwl::new_command('irc-nick'    => \&cmd_nick);
69    BarnOwl::new_command('irc-names'   => \&cmd_names);
70}
71
72$BarnOwl::Hooks::startup->add(\&startup);
73$BarnOwl::Hooks::shutdown->add(\&shutdown);
74$BarnOwl::Hooks::mainLoop->add(\&mainloop_hook);
75
76################################################################################
77######################## Owl command handlers ##################################
78################################################################################
79
80sub cmd_connect {
81    my $cmd = shift;
82
83    my $nick = BarnOwl::getvar('irc:nick');
84    my $username = BarnOwl::getvar('irc:user');
85    my $ircname = BarnOwl::getvar('irc:name');
86    my $host;
87    my $port;
88    my $alias;
89    my $ssl;
90    my $password = undef;
91
92    {
93        local @ARGV = @_;
94        GetOptions(
95            "alias=s"    => \$alias,
96            "ssl"        => \$ssl,
97            "password=s" => \$password,
98            "port=i"     => \$port,
99        );
100        $host = shift @ARGV or die("Usage: $cmd HOST\n");
101        if(!$alias) {
102            $alias = $1 if $host =~ /^(?:irc[.])?(\w+)[.]\w+$/;
103            $alias ||= $host;
104        }
105        $port ||= 6667;
106        $ssl ||= 0;
107    }
108
109    my $conn = BarnOwl::Module::IRC::Connection->new($irc, $alias,
110        Nick      => $nick,
111        Server    => $host,
112        Port      => $port,
113        Username  => $username,
114        Ircname   => $ircname,
115        Port      => $port,
116        Password  => $password,
117        SSL       => $ssl
118       );
119
120    $ircnets{$alias} = $conn;
121    return;
122}
123
124sub cmd_disconnect {
125    my $cmd = shift;
126    my $conn = get_connection(\@_);
127    $conn->disconnect;
128    delete $ircnets{$conn->alias};
129}
130
131sub cmd_msg {
132    my $cmd = shift;
133    my $conn = get_connection(\@_);
134    my $to = shift or die("Usage: $cmd NICK\n");
135    # handle multiple recipients?
136    if(@_) {
137        process_msg($conn, $to, join(" ", @_));
138    } else {
139        BarnOwl::start_edit_win("/msg $to -a " . $conn->alias, sub {process_msg($conn, $to, @_)});
140    }
141}
142
143sub process_msg {
144    my $conn = shift;
145    my $to = shift;
146    my $body = shift;
147    # Strip whitespace. In the future -- send one message/line?
148    $body =~ tr/\n\r/  /;
149    $conn->privmsg($to, $body);
150    my $msg = BarnOwl::Message->new(
151        type        => 'IRC',
152        direction   => is_private($to) ? 'out' : 'in',
153        server      => $conn->server,
154        network     => $conn->alias,
155        recipient   => $to,
156        body        => $body,
157        sender      => $conn->nick,
158        is_private($to) ?
159          (isprivate  => 'true') : (channel => $to),
160        replycmd    => "irc-msg $to",
161        replysendercmd => "irc-msg $to"
162       );
163    BarnOwl::queue_message($msg);
164}
165
166sub cmd_join {
167    my $cmd = shift;
168    my $conn = get_connection(\@_);
169    my $chan = shift or die("Usage: $cmd channel\n");
170    $conn->join($chan);
171}
172
173sub cmd_part {
174    my $cmd = shift;
175    my $conn = get_connection(\@_);
176    my $chan = get_channel(\@_) || die("Usage: $cmd <channel>");
177    $conn->part($chan);
178}
179
180sub cmd_nick {
181    my $cmd = shift;
182    my $conn = get_connection(\@_);
183    my $nick = shift or die("Usage: $cmd <new nick>");
184    $conn->nick($nick);
185}
186
187sub cmd_names {
188    my $cmd = shift;
189    my $conn = get_connection(\@_);
190    my $chan = get_channel(\@_) || die("Usage: $cmd <channel>");
191    $conn->names($chan);
192}
193
194################################################################################
195########################### Utilities/Helpers ##################################
196################################################################################
197
198sub get_connection {
199    my $args = shift;
200    if(scalar @$args >= 2 && $args->[0] eq '-a') {
201        shift @$args;
202        return get_connection_by_alias(shift @$args);
203    }
204    my $m = BarnOwl::getcurmsg();
205    if($m && $m->type eq 'IRC') {
206        return get_connection_by_alias($m->network);
207    }
208    if(scalar keys %ircnets == 1) {
209        return [values(%ircnets)]->[0];
210    }
211    die("You must specify a network with -a\n");
212}
213
214sub get_channel {
215    my $args = shift;
216    if(scalar @$args) {
217        return shift @$args;
218    }
219    my $m = BarnOwl::getcurmsg();
220    if($m && $m->type eq 'IRC') {
221        return $m->channel if !$m->is_private;
222    }
223    return undef;
224}
225
226sub get_connection_by_alias {
227    my $key = shift;
228    die("No such ircnet: $key\n") unless exists $ircnets{$key};
229    return $ircnets{$key};
230}
231
2321;
Note: See TracBrowser for help on using the repository browser.