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

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