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

barnowl_perlaimdebianrelease-1.4release-1.5release-1.6release-1.7release-1.8release-1.9
Last change on this file since b38b0b2 was b38b0b2, checked in by Nelson Elhage <nelhage@mit.edu>, 13 years ago
Committing a partial IRC plugin
  • Property mode set to 100644
File size: 4.4 KB
Line 
1use strict;
2use warnings;
3
4package BarnOwl::Module::IRC;
5
6=head1 NAME
7
8BarnOwl::Module::Jabber
9
10=head1 DESCRIPTION
11
12This module implements Jabber support for barnowl.
13
14=cut
15
16use BarnOwl;
17use BarnOwl::Hooks;
18use BarnOwl::Message::IRC;
19use BarnOwl::Module::IRC::Connection;
20
21use Net::IRC;
22use Getopt::Long;
23
24our $VERSION = 0.01;
25
26our $irc;
27
28# Hash alias -> BarnOwl::Module::IRC::Connection object
29our %ircnets;
30
31sub startup {
32    BarnOwl::new_variable_string(ircnick => {default => $ENV{USER}});
33    BarnOwl::new_variable_string(ircuser => {default => $ENV{USER}});
34    BarnOwl::new_variable_string(ircname => {default => ""});
35    register_commands();
36    register_handlers();
37    BarnOwl::filter('irc type ^IRC$');
38}
39
40sub shutdown {
41    for my $conn (values %ircnets) {
42        $conn->disconnect;
43    }
44}
45
46sub mainloop_hook {
47    return unless defined $irc;
48    eval {
49        $irc->do_one_loop();
50    };
51    return;
52}
53
54sub register_handlers {
55    if(!$irc) {
56        $irc = Net::IRC->new;
57        $irc->timeout(0);
58    }
59}
60
61sub register_commands {
62    BarnOwl::new_command('irc-connect' => \&cmd_connect);
63    BarnOwl::new_command('irc-disconnect' => \&cmd_disconnect);
64    BarnOwl::new_command('irc-msg'     => \&cmd_msg);
65}
66
67$BarnOwl::Hooks::startup->add(\&startup);
68$BarnOwl::Hooks::shutdown->add(\&shutdown);
69$BarnOwl::Hooks::mainLoop->add(\&mainloop_hook);
70
71################################################################################
72######################## Owl command handlers ##################################
73################################################################################
74
75sub cmd_connect {
76    my $cmd = shift;
77
78    my $nick = BarnOwl::getvar('ircnick');
79    my $username = BarnOwl::getvar('ircuser');
80    my $ircname = BarnOwl::getvar('ircname');
81    my $host;
82    my $port;
83    my $alias;
84    my $ssl;
85    my $password = undef;
86
87    {
88        local @ARGV = @_;
89        GetOptions(
90            "alias=s"    => \$alias,
91            "ssl"        => \$ssl,
92            "password=s" => \$password);
93        $host = shift @ARGV or die("Usage: $cmd HOST\n");
94        if(!$alias) {
95            $alias = $1 if $host =~ /^(?:irc[.])?(\w+)[.]\w+$/;
96            $alias ||= $host;
97        }
98        $port ||= 6667;
99        $ssl ||= 0;
100    }
101
102    my $conn = BarnOwl::Module::IRC::Connection->new($irc, $alias,
103        Nick      => $nick,
104        Server    => $host,
105        Port      => $port,
106        Username  => $username,
107        Ircname   => $ircname,
108        Port      => $port,
109        Password  => $password,
110        SSL       => $ssl
111       );
112
113    $ircnets{$alias} = $conn;
114    return;
115}
116
117sub cmd_disconnect {
118    my $cmd = shift;
119    my $conn = get_connection(\@_);
120    $conn->disconnect;
121    delete $ircnets{$conn->alias};
122}
123
124sub cmd_msg {
125    my $cmd = shift;
126    my $conn = get_connection(\@_);
127    my $to = shift or die("Usage: $cmd NICK\n");
128    if(@_) {
129        process_msg($conn, $to, join(" ", @_));
130    } else {
131        BarnOwl::start_edit_win("/msg $to -a " . $conn->alias, sub {process_msg($conn, $to, @_)});
132    }
133}
134
135sub process_msg {
136    my $conn = shift;
137    my $to = shift;
138    my $body = shift;
139    # Strip whitespace. In the future -- send one message/line?
140    $body =~ tr/\n\r/  /;
141    $conn->privmsg($to, $body);
142    my $msg = BarnOwl::Message->new(
143        type        => 'IRC',
144        direction   => 'out',
145        server      => $conn->server,
146        network     => $conn->alias,
147        recipient   => $to,
148        body        => $body,
149        sender      => $conn->nick,
150        isprivate   => 'true',
151        replycmd    => "irc-msg $to",
152        replysendercmd => "irc-msg " . $conn->nick
153       );
154    BarnOwl::queue_message($msg);
155}
156
157
158################################################################################
159########################### Utilities/Helpers ##################################
160################################################################################
161
162sub get_connection {
163    my $args = shift;
164    if(scalar @$args >= 2 && $args->[0] eq '-a') {
165        shift @$args;
166        return get_connection_by_alias(shift @$args);
167    }
168    my $m = BarnOwl::getcurmsg();
169    if($m && $m->type eq 'IRC') {
170        return get_connection_by_alias($m->network);
171    }
172    if(scalar keys %ircnets == 1) {
173        return [values(%ircnets)]->[0];
174    }
175    die("You must specify a network with -a\n");
176}
177
178sub get_connection_by_alias {
179    die("No such ircnet: $alias\n") unless exists $ircnets{$key};
180    return $ircnets{$key};
181}
182
1831;
Note: See TracBrowser for help on using the repository browser.