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

barnowl_perlaimdebianrelease-1.10release-1.4release-1.5release-1.6release-1.7release-1.8release-1.9
Last change on this file since 380b1ab was 380b1ab, checked in by Nelson Elhage <nelhage@mit.edu>, 17 years ago
import is_private from ::Connection
  • Property mode set to 100644
File size: 4.8 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}
68
69$BarnOwl::Hooks::startup->add(\&startup);
70$BarnOwl::Hooks::shutdown->add(\&shutdown);
71$BarnOwl::Hooks::mainLoop->add(\&mainloop_hook);
72
73################################################################################
74######################## Owl command handlers ##################################
75################################################################################
76
77sub cmd_connect {
78    my $cmd = shift;
79
80    my $nick = BarnOwl::getvar('irc:nick');
81    my $username = BarnOwl::getvar('irc:user');
82    my $ircname = BarnOwl::getvar('irc:name');
83    my $host;
84    my $port;
85    my $alias;
86    my $ssl;
87    my $password = undef;
88
89    {
90        local @ARGV = @_;
91        GetOptions(
92            "alias=s"    => \$alias,
93            "ssl"        => \$ssl,
94            "password=s" => \$password,
95            "port=i"     => \$port,
96        );
97        $host = shift @ARGV or die("Usage: $cmd HOST\n");
98        if(!$alias) {
99            $alias = $1 if $host =~ /^(?:irc[.])?(\w+)[.]\w+$/;
100            $alias ||= $host;
101        }
102        $port ||= 6667;
103        $ssl ||= 0;
104    }
105
106    my $conn = BarnOwl::Module::IRC::Connection->new($irc, $alias,
107        Nick      => $nick,
108        Server    => $host,
109        Port      => $port,
110        Username  => $username,
111        Ircname   => $ircname,
112        Port      => $port,
113        Password  => $password,
114        SSL       => $ssl
115       );
116
117    $ircnets{$alias} = $conn;
118    return;
119}
120
121sub cmd_disconnect {
122    my $cmd = shift;
123    my $conn = get_connection(\@_);
124    $conn->disconnect;
125    delete $ircnets{$conn->alias};
126}
127
128sub cmd_msg {
129    my $cmd = shift;
130    my $conn = get_connection(\@_);
131    my $to = shift or die("Usage: $cmd NICK\n");
132    # handle multiple recipients?
133    if(@_) {
134        process_msg($conn, $to, join(" ", @_));
135    } else {
136        BarnOwl::start_edit_win("/msg $to -a " . $conn->alias, sub {process_msg($conn, $to, @_)});
137    }
138}
139
140sub process_msg {
141    my $conn = shift;
142    my $to = shift;
143    my $body = shift;
144    # Strip whitespace. In the future -- send one message/line?
145    $body =~ tr/\n\r/  /;
146    $conn->privmsg($to, $body);
147    my $msg = BarnOwl::Message->new(
148        type        => 'IRC',
149        direction   => 'out',
150        server      => $conn->server,
151        network     => $conn->alias,
152        recipient   => $to,
153        body        => $body,
154        sender      => $conn->nick,
155        is_private($to) ?
156          (isprivate  => 'true') : (channel => $to),
157        replycmd    => "irc-msg $to",
158        replysendercmd => "irc-msg $to"
159       );
160    BarnOwl::queue_message($msg);
161}
162
163sub cmd_join {
164    my $cmd = shift;
165    my $conn = get_connection(\@_);
166    my $chan = shift or die("Usage: $cmd channel\n");
167    $conn->join($chan);
168}
169
170################################################################################
171########################### Utilities/Helpers ##################################
172################################################################################
173
174sub get_connection {
175    my $args = shift;
176    if(scalar @$args >= 2 && $args->[0] eq '-a') {
177        shift @$args;
178        return get_connection_by_alias(shift @$args);
179    }
180    my $m = BarnOwl::getcurmsg();
181    if($m && $m->type eq 'IRC') {
182        return get_connection_by_alias($m->network);
183    }
184    if(scalar keys %ircnets == 1) {
185        return [values(%ircnets)]->[0];
186    }
187    die("You must specify a network with -a\n");
188}
189
190sub get_connection_by_alias {
191    my $key = shift;
192    die("No such ircnet: $key\n") unless exists $ircnets{$key};
193    return $ircnets{$key};
194}
195
1961;
Note: See TracBrowser for help on using the repository browser.