[799] in BarnOwl Developers
[D-O-H] r799 - in trunk/owl/perl/modules: . IRC IRC/lib IRC/lib/BarnOwl IRC/lib/BarnOwl/Message IRC/lib/BarnOwl/Module IRC/lib/BarnOwl/Module/IRC
daemon@ATHENA.MIT.EDU (nelhage@MIT.EDU)
Thu Oct 29 18:09:50 2009
Resent-From: nelhage@mit.edu
Resent-To: barnowl-dev-mtg@charon.mit.edu
To: dirty-owl-hackers@mit.edu
From: nelhage@MIT.EDU
Reply-to: dirty-owl-hackers@MIT.EDU
Date: Mon, 7 Jan 2008 20:13:18 -0500 (EST)
Author: nelhage
Date: 2008-01-07 20:13:17 -0500 (Mon, 07 Jan 2008)
New Revision: 799
Added:
trunk/owl/perl/modules/IRC/
trunk/owl/perl/modules/IRC/Makefile.PL
trunk/owl/perl/modules/IRC/lib/
trunk/owl/perl/modules/IRC/lib/BarnOwl/
trunk/owl/perl/modules/IRC/lib/BarnOwl/Message/
trunk/owl/perl/modules/IRC/lib/BarnOwl/Message/IRC.pm
trunk/owl/perl/modules/IRC/lib/BarnOwl/Module/
trunk/owl/perl/modules/IRC/lib/BarnOwl/Module/IRC.pm
trunk/owl/perl/modules/IRC/lib/BarnOwl/Module/IRC/
trunk/owl/perl/modules/IRC/lib/BarnOwl/Module/IRC/Connection.pm
Log:
Committing a partial IRC plugin
Added: trunk/owl/perl/modules/IRC/Makefile.PL
===================================================================
--- trunk/owl/perl/modules/IRC/Makefile.PL (rev 0)
+++ trunk/owl/perl/modules/IRC/Makefile.PL 2008-01-08 01:13:17 UTC (rev 799)
@@ -0,0 +1,8 @@
+use strict;
+use warnings;
+
+use inc::Module::Install;
+
+barnowl_module('IRC');
+
+WriteAll;
Added: trunk/owl/perl/modules/IRC/lib/BarnOwl/Message/IRC.pm
===================================================================
--- trunk/owl/perl/modules/IRC/lib/BarnOwl/Message/IRC.pm (rev 0)
+++ trunk/owl/perl/modules/IRC/lib/BarnOwl/Message/IRC.pm 2008-01-08 01:13:17 UTC (rev 799)
@@ -0,0 +1,52 @@
+use warnings;
+use strict;
+
+=head1 NAME
+
+BarnOwl::Message::IRC
+
+=head1 DESCRIPTION
+
+A subclass of BarnOwl::Message for IRC messages
+
+=cut
+
+package BarnOwl::Message::IRC;
+
+use base qw( BarnOwl::Message );
+
+sub smartfilter {
+ my $self = shift;
+ my $inst = shift;
+
+ my ($filter, $ftext);
+
+ if($self->is_private) {
+ my $who;
+ if($self->direction eq 'out') {
+ $who = $self->recipient;
+ } else {
+ $who = $self->sender;
+ }
+ $filter = "irc-user-$who";
+ my $ftext =
+ qq{type ^irc\$ and ( ( direction ^in\$ and sender ^$who\$ ) }
+ . qq{or ( direction ^out\$ and recipient ^$who\$ ) ) };
+ BarnOwl::filter("$filter $ftext");
+ return $filter;
+ } else {
+ # Unimplemented
+ return undef;
+ }
+}
+
+sub server {shift->{server}}
+sub network {shift->{network}}
+
+# display
+sub context {shift->{channel};}
+
+sub long_sender {shift->{from} || ""};
+
+
+1;
Added: trunk/owl/perl/modules/IRC/lib/BarnOwl/Module/IRC/Connection.pm
===================================================================
--- trunk/owl/perl/modules/IRC/lib/BarnOwl/Module/IRC/Connection.pm (rev 0)
+++ trunk/owl/perl/modules/IRC/lib/BarnOwl/Module/IRC/Connection.pm 2008-01-08 01:13:17 UTC (rev 799)
@@ -0,0 +1,86 @@
+use strict;
+use warnings;
+
+package BarnOwl::Module::IRC::Connection;
+
+=head1 NAME
+
+BarnOwl::Module::IRC::Connection
+
+=head1 DESCRIPTION
+
+This module is a Net::IRC::Connection subclass for BarnOwl's IRC
+support
+
+=cut
+
+use base qw(Net::IRC::Connection Class::Accessor);
+__PACKAGE__->mk_accessors(qw(alias channels));
+
+use BarnOwl;
+
+sub new {
+ my $class = shift;
+ my $irc = shift;
+ my $alias = shift;
+ my %args = (@_);
+ my $self = $class->SUPER::new($irc, %args);
+ $self->alias($alias);
+ $self->channels([]);
+ bless($self, $class);
+
+ $self->add_global_handler(endofmotd => sub { goto &on_connect });
+ $self->add_global_handler(msg => sub { goto &on_msg });
+ $self->add_global_handler(notice => sub { goto &on_msg });
+ $self->add_default_handler(sub { goto &on_event; });
+
+ return $self;
+}
+
+################################################################################
+############################### IRC callbacks ##################################
+################################################################################
+
+sub on_connect {
+ my ($self, $evt) = @_;
+ BarnOwl::admin_message("IRC", "Connected to " . $self->server . " (" . $self->alias . ")");
+}
+
+sub on_msg {
+ my ($self, $evt) = @_;
+ my $replycmd = "irc-msg " . $evt->nick;
+ my $msg = BarnOwl::Message->new(
+ type => 'IRC',
+ direction => 'in',
+ server => $self->server,
+ network => $self->alias,
+ recipient => $self->nick,
+ body => strip_irc_formatting([$evt->args]->[0]),
+ sender => $evt->nick,
+ hostname => $evt->host,
+ from => $evt->from,
+ notice => $evt->type eq 'notice' ? 'true' : '',
+ isprivate => 'true',
+ replycmd => $replycmd,
+ replysendercmd => $replycmd
+ );
+ BarnOwl::queue_message($msg);
+}
+
+################################################################################
+########################### Utilities/Helpers ##################################
+################################################################################
+
+sub strip_irc_formatting {
+ my $body = shift;
+ my @pieces = split /\x02/, $body;
+ my $out;
+ while(@pieces) {
+ $out .= shift @pieces;
+ $out .= BarnOwl::Style::boldify(shift @pieces) if @pieces;
+ }
+ return $out;
+}
+
+
+1;
Added: trunk/owl/perl/modules/IRC/lib/BarnOwl/Module/IRC.pm
===================================================================
--- trunk/owl/perl/modules/IRC/lib/BarnOwl/Module/IRC.pm (rev 0)
+++ trunk/owl/perl/modules/IRC/lib/BarnOwl/Module/IRC.pm 2008-01-08 01:13:17 UTC (rev 799)
@@ -0,0 +1,183 @@
+use strict;
+use warnings;
+
+package BarnOwl::Module::IRC;
+
+=head1 NAME
+
+BarnOwl::Module::Jabber
+
+=head1 DESCRIPTION
+
+This module implements Jabber support for barnowl.
+
+=cut
+
+use BarnOwl;
+use BarnOwl::Hooks;
+use BarnOwl::Message::IRC;
+use BarnOwl::Module::IRC::Connection;
+
+use Net::IRC;
+use Getopt::Long;
+
+our $VERSION = 0.01;
+
+our $irc;
+
+# Hash alias -> BarnOwl::Module::IRC::Connection object
+our %ircnets;
+
+sub startup {
+ BarnOwl::new_variable_string(ircnick => {default => $ENV{USER}});
+ BarnOwl::new_variable_string(ircuser => {default => $ENV{USER}});
+ BarnOwl::new_variable_string(ircname => {default => ""});
+ register_commands();
+ register_handlers();
+ BarnOwl::filter('irc type ^IRC$');
+}
+
+sub shutdown {
+ for my $conn (values %ircnets) {
+ $conn->disconnect;
+ }
+}
+
+sub mainloop_hook {
+ return unless defined $irc;
+ eval {
+ $irc->do_one_loop();
+ };
+ return;
+}
+
+sub register_handlers {
+ if(!$irc) {
+ $irc = Net::IRC->new;
+ $irc->timeout(0);
+ }
+}
+
+sub register_commands {
+ BarnOwl::new_command('irc-connect' => \&cmd_connect);
+ BarnOwl::new_command('irc-disconnect' => \&cmd_disconnect);
+ BarnOwl::new_command('irc-msg' => \&cmd_msg);
+}
+
+$BarnOwl::Hooks::startup->add(\&startup);
+$BarnOwl::Hooks::shutdown->add(\&shutdown);
+$BarnOwl::Hooks::mainLoop->add(\&mainloop_hook);
+
+################################################################################
+######################## Owl command handlers ##################################
+################################################################################
+
+sub cmd_connect {
+ my $cmd = shift;
+
+ my $nick = BarnOwl::getvar('ircnick');
+ my $username = BarnOwl::getvar('ircuser');
+ my $ircname = BarnOwl::getvar('ircname');
+ my $host;
+ my $port;
+ my $alias;
+ my $ssl;
+ my $password = undef;
+
+ {
+ local @ARGV = @_;
+ GetOptions(
+ "alias=s" => \$alias,
+ "ssl" => \$ssl,
+ "password=s" => \$password);
+ $host = shift @ARGV or die("Usage: $cmd HOST\n");
+ if(!$alias) {
+ $alias = $1 if $host =~ /^(?:irc[.])?(\w+)[.]\w+$/;
+ $alias ||= $host;
+ }
+ $port ||= 6667;
+ $ssl ||= 0;
+ }
+
+ my $conn = BarnOwl::Module::IRC::Connection->new($irc, $alias,
+ Nick => $nick,
+ Server => $host,
+ Port => $port,
+ Username => $username,
+ Ircname => $ircname,
+ Port => $port,
+ Password => $password,
+ SSL => $ssl
+ );
+
+ $ircnets{$alias} = $conn;
+ return;
+}
+
+sub cmd_disconnect {
+ my $cmd = shift;
+ my $conn = get_connection(\@_);
+ $conn->disconnect;
+ delete $ircnets{$conn->alias};
+}
+
+sub cmd_msg {
+ my $cmd = shift;
+ my $conn = get_connection(\@_);
+ my $to = shift or die("Usage: $cmd NICK\n");
+ if(@_) {
+ process_msg($conn, $to, join(" ", @_));
+ } else {
+ BarnOwl::start_edit_win("/msg $to -a " . $conn->alias, sub {process_msg($conn, $to, @_)});
+ }
+}
+
+sub process_msg {
+ my $conn = shift;
+ my $to = shift;
+ my $body = shift;
+ # Strip whitespace. In the future -- send one message/line?
+ $body =~ tr/\n\r/ /;
+ $conn->privmsg($to, $body);
+ my $msg = BarnOwl::Message->new(
+ type => 'IRC',
+ direction => 'out',
+ server => $conn->server,
+ network => $conn->alias,
+ recipient => $to,
+ body => $body,
+ sender => $conn->nick,
+ isprivate => 'true',
+ replycmd => "irc-msg $to",
+ replysendercmd => "irc-msg " . $conn->nick
+ );
+ BarnOwl::queue_message($msg);
+}
+
+
+################################################################################
+########################### Utilities/Helpers ##################################
+################################################################################
+
+sub get_connection {
+ my $args = shift;
+ if(scalar @$args >= 2 && $args->[0] eq '-a') {
+ shift @$args;
+ return get_connection_by_alias(shift @$args);
+ }
+ my $m = BarnOwl::getcurmsg();
+ if($m && $m->type eq 'IRC') {
+ return get_connection_by_alias($m->network);
+ }
+ if(scalar keys %ircnets == 1) {
+ return [values(%ircnets)]->[0];
+ }
+ die("You must specify a network with -a\n");
+}
+
+sub get_connection_by_alias {
+ die("No such ircnet: $alias\n") unless exists $ircnets{$key};
+ return $ircnets{$key};
+}
+
+1;
