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

Last change on this file since 1c014eec was 1c014eec, checked in by Nelson Elhage <nelhage@mit.edu>, 12 years ago
Show IRC /me messages with the conventional * instead of bold.
  • Property mode set to 100644
File size: 9.7 KB
RevLine 
[b38b0b2]1use strict;
2use warnings;
3
4package BarnOwl::Module::IRC;
5
6=head1 NAME
7
[2c40dc0]8BarnOwl::Module::IRC
[b38b0b2]9
10=head1 DESCRIPTION
11
[2c40dc0]12This module implements IRC support for barnowl.
[b38b0b2]13
14=cut
15
16use BarnOwl;
17use BarnOwl::Hooks;
18use BarnOwl::Message::IRC;
[380b1ab]19use BarnOwl::Module::IRC::Connection qw(is_private);
[b38b0b2]20
21use Net::IRC;
22use Getopt::Long;
23
[2c40dc0]24our $VERSION = 0.02;
[b38b0b2]25
26our $irc;
27
28# Hash alias -> BarnOwl::Module::IRC::Connection object
29our %ircnets;
[fe8cad8]30our %channels;
[b38b0b2]31
32sub startup {
[b10f340]33    BarnOwl::new_variable_string('irc:nick', {
34        default     => $ENV{USER},
35        summary     => 'The default IRC nickname',
36        description => 'By default, irc-connect will use this nick '  .
37        'when connecting to a new server. See :help irc-connect for ' .
38        'more information.'
39       });
40
41    BarnOwl::new_variable_string('irc:user', {
42        default => $ENV{USER},
43        summary => 'The IRC "username" field'
44       });
45        BarnOwl::new_variable_string('irc:name', {
46        default => "",
47        summary     => 'A short name field for IRC',
48        description => 'A short (maybe 60 or so chars) piece of text, ' .
49        'originally intended to display your real name, which people '  .
50        'often use for pithy quotes and URLs.'
51       });
52   
53    BarnOwl::new_variable_bool('irc:spew', {
54        default     => 0,
55        summary     => 'Show unhandled IRC events',
56        description => 'If set, display all unrecognized IRC events as ' .
57        'admin messages. Intended for debugging and development use only '
58       });
59   
[b38b0b2]60    register_commands();
61    register_handlers();
62    BarnOwl::filter('irc type ^IRC$');
63}
64
65sub shutdown {
66    for my $conn (values %ircnets) {
[ba2ca66]67        $conn->conn->disconnect();
[b38b0b2]68    }
69}
70
[9c7a701]71#sub mainloop_hook {
72#    return unless defined $irc;
73#    eval {
74#        $irc->do_one_loop();
75#    };
76#    return;
77#}
78
79sub OwlProcess {
[b38b0b2]80    return unless defined $irc;
81    eval {
82        $irc->do_one_loop();
83    };
84    return;
85}
86
[9c7a701]87
[b38b0b2]88sub register_handlers {
89    if(!$irc) {
90        $irc = Net::IRC->new;
91        $irc->timeout(0);
92    }
93}
94
95sub register_commands {
[b0c8011]96    BarnOwl::new_command('irc-connect' => \&cmd_connect,
97                       {
98                           summary      => 'Connect to an IRC server',
99                           usage        => 'irc-connect [-a ALIAS ] [-s] [-p PASSWORD] [-n NICK] SERVER [port]',
100                           description  =>
101
102                           "Connect to an IRC server. Supported options are\n\n" .
103                           "-a <alias>          Define an alias for this server\n" .
104                           "-s                  Use SSL\n" .
105                           "-p <password>       Specify the password to use\n" .
106                           "-n <nick>           Use a non-default nick"
107                       });
[b38b0b2]108    BarnOwl::new_command('irc-disconnect' => \&cmd_disconnect);
[b0c8011]109    BarnOwl::new_command('irc-msg'        => \&cmd_msg);
110    BarnOwl::new_command('irc-join'       => \&cmd_join);
111    BarnOwl::new_command('irc-part'       => \&cmd_part);
112    BarnOwl::new_command('irc-nick'       => \&cmd_nick);
113    BarnOwl::new_command('irc-names'      => \&cmd_names);
114    BarnOwl::new_command('irc-whois'      => \&cmd_whois);
[56e72d5]115    BarnOwl::new_command('irc-motd'       => \&cmd_motd);
[f094fc4]116    BarnOwl::new_command('irc-list'       => \&cmd_list);
117    BarnOwl::new_command('irc-who'        => \&cmd_who);
118    BarnOwl::new_command('irc-stats'      => \&cmd_stats);
[3ad15ff]119    BarnOwl::new_command('irc-topic'      => \&cmd_topic);
[b38b0b2]120}
121
[167044b]122$BarnOwl::Hooks::startup->add('BarnOwl::Module::IRC::startup');
123$BarnOwl::Hooks::shutdown->add('BarnOwl::Module::IRC::shutdown');
[b38b0b2]124
125################################################################################
126######################## Owl command handlers ##################################
127################################################################################
128
129sub cmd_connect {
130    my $cmd = shift;
131
[2c40dc0]132    my $nick = BarnOwl::getvar('irc:nick');
133    my $username = BarnOwl::getvar('irc:user');
134    my $ircname = BarnOwl::getvar('irc:name');
[b38b0b2]135    my $host;
136    my $port;
137    my $alias;
138    my $ssl;
139    my $password = undef;
140
141    {
142        local @ARGV = @_;
143        GetOptions(
144            "alias=s"    => \$alias,
145            "ssl"        => \$ssl,
[2c40dc0]146            "password=s" => \$password,
[b10f340]147            "nick=s"     => \$nick,
[2c40dc0]148        );
[b38b0b2]149        $host = shift @ARGV or die("Usage: $cmd HOST\n");
150        if(!$alias) {
[f094fc4]151            if($host =~ /^(?:irc[.])?([\w-]+)[.]\w+$/) {
[b0c8011]152                $alias = $1;
153            } else {
154                $alias = $host;
155            }
[b38b0b2]156        }
157        $ssl ||= 0;
[f094fc4]158        $port = shift @ARGV || ($ssl ? 6697 : 6667);
[b38b0b2]159    }
160
[b0c8011]161    if(exists $ircnets{$alias}) {
162        die("Already connected to a server with alias '$alias'. Either disconnect or specify an alias with -a.\n");
163    }
164
[b38b0b2]165    my $conn = BarnOwl::Module::IRC::Connection->new($irc, $alias,
166        Nick      => $nick,
167        Server    => $host,
168        Port      => $port,
169        Username  => $username,
170        Ircname   => $ircname,
171        Port      => $port,
172        Password  => $password,
173        SSL       => $ssl
174       );
175
[cab045b]176    if ($conn->conn->connected) {
[5ff830a]177        BarnOwl::admin_message("IRC", "Connected to $alias as $nick");
178        $ircnets{$alias} = $conn;
[9c7a701]179        my $fd = $conn->getSocket()->fileno();
180        BarnOwl::add_dispatch($fd, \&OwlProcess);
181        $conn->{FD} = $fd;
[5ff830a]182    } else {
183        die("IRC::Connection->connect failed: $!");
184    }
185
[b38b0b2]186    return;
187}
188
189sub cmd_disconnect {
190    my $cmd = shift;
191    my $conn = get_connection(\@_);
[ba2ca66]192    $conn->conn->disconnect;
[b38b0b2]193    delete $ircnets{$conn->alias};
194}
195
196sub cmd_msg {
197    my $cmd = shift;
198    my $conn = get_connection(\@_);
199    my $to = shift or die("Usage: $cmd NICK\n");
[2c40dc0]200    # handle multiple recipients?
[b38b0b2]201    if(@_) {
202        process_msg($conn, $to, join(" ", @_));
203    } else {
[3c5fe43]204        BarnOwl::start_edit_win("/msg -a " . $conn->alias . " $to", sub {process_msg($conn, $to, @_)});
[b38b0b2]205    }
206}
207
208sub process_msg {
209    my $conn = shift;
210    my $to = shift;
211    my $body = shift;
212    # Strip whitespace. In the future -- send one message/line?
213    $body =~ tr/\n\r/  /;
[919535f]214    if ($body =~ /^\/me (.*)/) {
215        $conn->conn->me($to, $1);
[1c014eec]216        $body = '* '.$conn->nick.' '.$1;
[919535f]217    } else {
218        $conn->conn->privmsg($to, $body);
219    }
[b38b0b2]220    my $msg = BarnOwl::Message->new(
221        type        => 'IRC',
[6858d2d]222        direction   => is_private($to) ? 'out' : 'in',
[b38b0b2]223        server      => $conn->server,
224        network     => $conn->alias,
225        recipient   => $to,
226        body        => $body,
227        sender      => $conn->nick,
[2c40dc0]228        is_private($to) ?
[0e52069]229          (isprivate  => 'true') : (channel => $to),
[3c5fe43]230        replycmd    => "irc-msg -a " . $conn->alias . " $to",
231        replysendercmd => "irc-msg -a " . $conn->alias . " $to"
[b38b0b2]232       );
233    BarnOwl::queue_message($msg);
234}
235
[2c40dc0]236sub cmd_join {
237    my $cmd = shift;
238    my $conn = get_connection(\@_);
239    my $chan = shift or die("Usage: $cmd channel\n");
[fe8cad8]240    $channels{$chan} ||= [];
241    push @{$channels{$chan}}, $conn;
[ba2ca66]242    $conn->conn->join($chan);
[2c40dc0]243}
[b38b0b2]244
[6858d2d]245sub cmd_part {
246    my $cmd = shift;
247    my $conn = get_connection(\@_);
[b0c8011]248    my $chan = get_channel(\@_) || die("Usage: $cmd <channel>\n");
[fe8cad8]249    $channels{$chan} = [grep {$_ ne $conn} @{$channels{$chan} || []}];
[ba2ca66]250    $conn->conn->part($chan);
[6858d2d]251}
252
[6286f26]253sub cmd_nick {
254    my $cmd = shift;
255    my $conn = get_connection(\@_);
[b0c8011]256    my $nick = shift or die("Usage: $cmd <new nick>\n");
[ba2ca66]257    $conn->conn->nick($nick);
[6286f26]258}
259
[6858d2d]260sub cmd_names {
261    my $cmd = shift;
262    my $conn = get_connection(\@_);
[b0c8011]263    my $chan = get_channel(\@_) || die("Usage: $cmd <channel>\n");
[d264c6d]264    $conn->names_tmp([]);
[ba2ca66]265    $conn->conn->names($chan);
[6858d2d]266}
267
[b0c8011]268sub cmd_whois {
269    my $cmd = shift;
270    my $conn = get_connection(\@_);
271    my $who = shift || die("Usage: $cmd <user>\n");
[ba2ca66]272    $conn->conn->whois($who);
[b0c8011]273}
274
[56e72d5]275sub cmd_motd {
276    my $cmd = shift;
277    my $conn = get_connection(\@_);
[ba2ca66]278    $conn->conn->motd;
[56e72d5]279}
280
[f094fc4]281sub cmd_list {
282    my $cmd = shift;
283    my $message = BarnOwl::Style::boldify('Current IRC networks:') . "\n";
284    while (my ($alias, $conn) = each %ircnets) {
285        $message .= '  ' . $alias . ' => ' . $conn->nick . '@' . $conn->server . "\n";
286    }
287    BarnOwl::popless_ztext($message);
288}
289
290sub cmd_who {
291    my $cmd = shift;
292    my $conn = get_connection(\@_);
293    my $who = shift || die("Usage: $cmd <user>\n");
294    $conn->conn->who($who);
295}
296
297sub cmd_stats {
298    my $cmd = shift;
299    my $conn = get_connection(\@_);
300    my $type = shift || die("Usage: $cmd <chiklmouy> [server] \n");
301    $conn->conn->stats($type, @_);
302}
303
[3ad15ff]304sub cmd_topic {
305    my $cmd = shift;
306    my $conn = get_connection(\@_);
307    $conn->conn->topic(@_);
308}
309
[b38b0b2]310################################################################################
311########################### Utilities/Helpers ##################################
312################################################################################
313
314sub get_connection {
315    my $args = shift;
316    if(scalar @$args >= 2 && $args->[0] eq '-a') {
317        shift @$args;
318        return get_connection_by_alias(shift @$args);
319    }
[fe8cad8]320    my $channel = $args->[-1];
[56e72d5]321    if (defined($channel) && $channel =~ /^#/
322        and $channels{$channel} and @{$channels{$channel}} == 1) {
[fe8cad8]323        return $channels{$channel}[0];
324    }
[b38b0b2]325    my $m = BarnOwl::getcurmsg();
326    if($m && $m->type eq 'IRC') {
327        return get_connection_by_alias($m->network);
328    }
329    if(scalar keys %ircnets == 1) {
330        return [values(%ircnets)]->[0];
331    }
332    die("You must specify a network with -a\n");
333}
334
[6858d2d]335sub get_channel {
336    my $args = shift;
337    if(scalar @$args) {
338        return shift @$args;
339    }
340    my $m = BarnOwl::getcurmsg();
341    if($m && $m->type eq 'IRC') {
342        return $m->channel if !$m->is_private;
343    }
344    return undef;
345}
346
[b38b0b2]347sub get_connection_by_alias {
[2c40dc0]348    my $key = shift;
349    die("No such ircnet: $key\n") unless exists $ircnets{$key};
[b38b0b2]350    return $ircnets{$key};
351}
352
3531;
Note: See TracBrowser for help on using the repository browser.