Changeset 8ba9313 for perl/modules


Ignore:
Timestamp:
Apr 3, 2011, 3:06:00 PM (14 years ago)
Author:
Nelson Elhage <nelhage@mit.edu>
Branches:
master, release-1.10, release-1.8, release-1.9
Children:
38d50c2
Parents:
fb96152
git-author:
Nelson Elhage <nelhage@nelhage.com> (02/24/11 22:14:37)
git-committer:
Nelson Elhage <nelhage@mit.edu> (04/03/11 15:06:00)
Message:
Port IRC support to AnyEvent::IRC.
Location:
perl/modules/IRC/lib/BarnOwl/Module
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • perl/modules/IRC/lib/BarnOwl/Module/IRC.pm

    r9620c8d r8ba9313  
    2020use BarnOwl::Module::IRC::Completion;
    2121
    22 use Net::IRC;
     22use AnyEvent::IRC;
    2323use Getopt::Long;
    2424use Encode;
     
    7070
    7171    register_commands();
    72     register_handlers();
    7372    BarnOwl::filter(qw{irc type ^IRC$ or ( type ^admin$ and adminheader ^IRC$ )});
    7473}
     
    7675sub shutdown {
    7776    for my $conn (values %ircnets) {
    78         $conn->conn->disconnect();
     77        $conn->conn->disconnect('Quitting');
    7978    }
    8079}
     
    105104
    106105    return $list;
    107 }
    108 
    109 #sub mainloop_hook {
    110 #    return unless defined $irc;
    111 #    eval {
    112 #        $irc->do_one_loop();
    113 #    };
    114 #    return;
    115 #}
    116 
    117 sub OwlProcess {
    118     return unless defined $irc;
    119     eval {
    120         $irc->do_one_loop();
    121     };
    122     return;
    123 }
    124 
    125 
    126 sub register_handlers {
    127     if(!$irc) {
    128         $irc = Net::IRC->new;
    129         $irc->timeout(0);
    130     }
    131106}
    132107
     
    406381    }
    407382
    408     my $conn = BarnOwl::Module::IRC::Connection->new($irc, $alias,
    409         Nick      => $nick,
    410         Server    => $host,
    411         Port      => $port,
    412         Username  => $username,
    413         Ircname   => $ircname,
    414         Port      => $port,
    415         Password  => $password,
    416         SSL       => $ssl
    417        );
    418 
    419     if ($conn->conn->connected) {
    420         $conn->connected("Connected to $alias as $nick");
    421     } else {
    422         die("IRC::Connection->connect failed: $!");
    423     }
    424 
     383    my $conn = BarnOwl::Module::IRC::Connection->new($alias, $host, $port, {
     384        nick      => $nick,
     385        user      => $username,
     386        real      => $ircname,
     387        password  => $password,
     388        SSL       => $ssl,
     389        timeout   => sub {0}
     390       });
    425391    return;
    426392}
     
    429395    my $cmd = shift;
    430396    my $conn = shift;
    431     if ($conn->conn->connected) {
    432         $conn->conn->disconnect;
     397    if ($conn->conn->is_connected) {
     398        $conn->conn->disconnect("Goodbye!");
    433399    } elsif ($reconnect{$conn->alias}) {
    434400        BarnOwl::admin_message('IRC',
     
    463429    for my $body (@msgs) {
    464430        if ($body =~ /^\/me (.*)/) {
    465             $conn->conn->me($to, Encode::encode('utf-8', $1));
     431            $conn->me($to, Encode::encode('utf-8', $1));
    466432            $body = '* '.$conn->nick.' '.$1;
    467433        } else {
    468             $conn->conn->privmsg($to, Encode::encode('utf-8', $body));
     434            $conn->conn->send_msg('privmsg', $to, Encode::encode('utf-8', $body));
    469435        }
    470436        my $msg = BarnOwl::Message->new(
     
    491457    my $target = shift;
    492458    $target ||= shift;
    493     $conn->conn->mode($target, @_);
     459    $conn->conn->send_msg(mode => $target, @_);
    494460    return;
    495461}
     
    501467    $channels{$chan} ||= [];
    502468    push @{$channels{$chan}}, $conn;
    503     $conn->conn->join($chan, @_);
     469    $conn->conn->send_msg(join => $chan, @_);
    504470    return;
    505471}
     
    510476    my $chan = shift;
    511477    $channels{$chan} = [grep {$_ ne $conn} @{$channels{$chan} || []}];
    512     $conn->conn->part($chan);
     478    $conn->conn->send_msg(part => $chan);
    513479    return;
    514480}
     
    518484    my $conn = shift;
    519485    my $nick = shift or die("Usage: $cmd <new nick>\n");
    520     $conn->conn->nick($nick);
     486    $conn->conn->send_msg(nick => $nick);
    521487    return;
    522488}
     
    527493    my $chan = shift;
    528494    $conn->names_tmp([]);
    529     $conn->conn->names($chan);
     495    $conn->conn->send_msg(names => $chan);
    530496    return;
    531497}
     
    535501    my $conn = shift;
    536502    my $who = shift || die("Usage: $cmd <user>\n");
    537     $conn->conn->whois($who);
     503    $conn->conn->send_msg(whois => $who);
    538504    return;
    539505}
     
    542508    my $cmd = shift;
    543509    my $conn = shift;
    544     $conn->conn->motd;
     510    $conn->conn->send_msg('motd');
    545511    return;
    546512}
     
    560526    my $conn = shift;
    561527    my $who = shift || die("Usage: $cmd <user>\n");
    562     BarnOwl::error("WHO $cmd $conn $who");
    563     $conn->conn->who($who);
     528    $conn->conn->send_msg(who => $who);
    564529    return;
    565530}
     
    569534    my $conn = shift;
    570535    my $type = shift || die("Usage: $cmd <chiklmouy> [server] \n");
    571     $conn->conn->stats($type, @_);
     536    $conn->conn->send_msg(stats => $type, @_);
    572537    return;
    573538}
     
    577542    my $conn = shift;
    578543    my $chan = shift;
    579     $conn->conn->topic($chan, @_ ? join(" ", @_) : undef);
     544    $conn->conn->send_msg(topic => $chan, @_ ? join(" ", @_) : undef);
    580545    return;
    581546}
     
    584549    my $cmd = shift;
    585550    my $conn = shift;
    586     $conn->conn->sl(join(" ", @_));
     551    $conn->conn->send_msg(@_);
    587552    return;
    588553}
  • perl/modules/IRC/lib/BarnOwl/Module/IRC/Connection.pm

    rfb6e8e3 r8ba9313  
    1616=cut
    1717
    18 use Net::IRC::Connection;
    19 
    20 use base qw(Class::Accessor Exporter);
    21 __PACKAGE__->mk_accessors(qw(conn alias channels motd names_tmp whois_tmp));
    22 our @EXPORT_OK = qw(&is_private);
     18use AnyEvent::IRC::Client;
     19use AnyEvent::IRC::Util qw(split_prefix prefix_nick);
     20
     21use base qw(Class::Accessor);
     22use Exporter 'import';
     23__PACKAGE__->mk_accessors(qw(conn alias motd names_tmp whois_tmp nick server autoconnect_channels));
     24our @EXPORT_OK = qw(is_private);
    2325
    2426use BarnOwl;
    2527use Scalar::Util qw(weaken);
    2628
    27 BEGIN {
    28     no strict 'refs';
    29     my @delegate = qw(nick server);
    30     for my $meth (@delegate) {
    31         *{"BarnOwl::Module::IRC::Connection::$meth"} = sub {
    32             shift->conn->$meth(@_);
    33         }
    34     }
    35 };
    36 
    3729sub new {
    3830    my $class = shift;
    39     my $irc = shift;
    4031    my $alias = shift;
    41     my %args = (@_);
    42     my $conn = Net::IRC::Connection->new($irc, %args);
     32    my $host  = shift;
     33    my $port  = shift;
     34    my $args  = shift;
     35    my $nick = $args->{nick};
     36    my $conn = AnyEvent::IRC::Client->new();
     37    if(delete $args->{SSL}) {
     38        $conn->enable_ssl;
     39    }
     40    $conn->connect($host, $port, $args);
    4341    my $self = bless({}, $class);
    4442    $self->conn($conn);
     43    $self->autoconnect_channels([]);
    4544    $self->alias($alias);
    46     $self->channels([]);
     45    $self->server($host);
     46    $self->nick($nick);
    4747    $self->motd("");
    4848    $self->names_tmp(0);
    4949    $self->whois_tmp("");
    5050
    51     $self->conn->add_default_handler(sub { shift; $self->on_event(@_) });
    52     $self->conn->add_handler(['msg', 'notice', 'public', 'caction'],
    53             sub { shift; $self->on_msg(@_) });
    54     $self->conn->add_handler(['welcome', 'yourhost', 'created',
    55                               'luserclient', 'luserop', 'luserchannels', 'luserme',
    56                               'error'],
    57             sub { shift; $self->on_admin_msg(@_) });
    58     $self->conn->add_handler(['myinfo', 'map', 'n_local', 'n_global',
    59             'luserconns'],
    60             sub { });
    61     $self->conn->add_handler(motdstart => sub { shift; $self->on_motdstart(@_) });
    62     $self->conn->add_handler(motd      => sub { shift; $self->on_motd(@_) });
    63     $self->conn->add_handler(endofmotd => sub { shift; $self->on_endofmotd(@_) });
    64     $self->conn->add_handler(join      => sub { shift; $self->on_join(@_) });
    65     $self->conn->add_handler(part      => sub { shift; $self->on_part(@_) });
    66     $self->conn->add_handler(quit      => sub { shift; $self->on_quit(@_) });
    67     $self->conn->add_handler(disconnect => sub { shift; $self->on_disconnect(@_) });
    68     $self->conn->add_handler(nicknameinuse => sub { shift; $self->on_nickinuse(@_) });
    69     $self->conn->add_handler(cping     => sub { shift; $self->on_ping(@_) });
    70     $self->conn->add_handler(topic     => sub { shift; $self->on_topic(@_) });
    71     $self->conn->add_handler(topicinfo => sub { shift; $self->on_topicinfo(@_) });
    72     $self->conn->add_handler(namreply  => sub { shift; $self->on_namreply(@_) });
    73     $self->conn->add_handler(endofnames=> sub { shift; $self->on_endofnames(@_) });
    74     $self->conn->add_handler(endofwhois=> sub { shift; $self->on_endofwhois(@_) });
    75     $self->conn->add_handler(mode      => sub { shift; $self->on_mode(@_) });
    76     $self->conn->add_handler(nosuchchannel => sub { shift; $self->on_nosuchchannel(@_) });
     51    # $self->conn->add_default_handler(sub { shift; $self->on_event(@_) });
     52    $self->conn->reg_cb(registered => sub { shift; $self->connected("Connected to $alias as $nick") },
     53                        connfail   => sub { shift; BarnOwl::error("Connection to $host failed!") },
     54                        disconnect => sub { shift; $self->on_disconnect(@_) },
     55                        publicmsg  => sub { shift; $self->on_msg(@_) },
     56                        privatemsg => sub { shift; $self->on_msg(@_) });
     57    for my $m (qw(welcome yourhost created
     58                  luserclient luserop luserchannels luserme
     59                  error)) {
     60        $self->conn->reg_cb("irc_$m" => sub { shift;  $self->on_admin_msg(@_) });
     61    }
     62    $self->conn->reg_cb(irc_375       => sub { shift; $self->on_motdstart(@_) },
     63                        irc_372       => sub { shift; $self->on_motd(@_) },
     64                        irc_376       => sub { shift; $self->on_endofmotd(@_) },
     65                        irc_join      => sub { shift; $self->on_join(@_) },
     66                        irc_part      => sub { shift; $self->on_part(@_) },
     67                        irc_quit      => sub { shift; $self->on_quit(@_) },
     68                        irc_433       => sub { shift; $self->on_nickinuse(@_) },
     69                        channel_topic => sub { shift; $self->on_topic(@_) },
     70                        irc_333       => sub { shift; $self->on_topicinfo(@_) },
     71                        irc_353       => sub { shift; $self->on_namreply(@_) },
     72                        irc_366       => sub { shift; $self->on_endofnames(@_) },
     73                        irc_311       => sub { shift; $self->on_whois(@_) },
     74                        irc_312       => sub { shift; $self->on_whois(@_) },
     75                        irc_319       => sub { shift; $self->on_whois(@_) },
     76                        irc_320       => sub { shift; $self->on_whois(@_) },
     77                        irc_318       => sub { shift; $self->on_endofwhois(@_) },
     78                        irc_mode      => sub { shift; $self->on_mode(@_) },
     79                        irc_401       => sub { shift; $self->on_nosuch(@_) },
     80                        irc_402       => sub { shift; $self->on_nosuch(@_) },
     81                        irc_403       => sub { shift; $self->on_nosuch(@_) },
     82                        'irc_*' => sub { BarnOwl::debug("IRC: " . $_[1]->{command}) });
    7783
    7884    return $self;
     
    9298    my $self = shift;
    9399    my $evt = shift;
     100    my ($nick, $user, $host) = split_prefix($evt);
    94101    return BarnOwl::Message->new(
    95102        type        => 'IRC',
    96103        server      => $self->server,
    97104        network     => $self->alias,
    98         sender      => $evt->nick,
    99         hostname    => $evt->host,
    100         from        => $evt->from,
     105        sender      => $nick,
     106        defined($host) ? (hostname    => $host) : (),
     107        from        => $evt->{prefix},
    101108        @_
    102109       );
     
    104111
    105112sub on_msg {
    106     my ($self, $evt) = @_;
    107     my ($recipient) = $evt->to;
    108     my $body = strip_irc_formatting([$evt->args]->[0]);
    109     my $nick = $self->nick;
    110     $body = '* '.$evt->nick.' '.$body if $evt->type eq 'caction';
     113    my ($self, $recipient, $evt) = @_;
     114    my $body = strip_irc_formatting($evt->{params}->[1]);
     115
    111116    my $msg = $self->new_message($evt,
    112117        direction   => 'in',
    113118        recipient   => $recipient,
    114         body => $body,
    115         $evt->type eq 'notice' ?
     119        body        => $body,
     120        $evt->{command} eq 'notice' ?
    116121          (notice     => 'true') : (),
    117122        is_private($recipient) ?
    118123          (private  => 'true') : (channel => $recipient),
    119124        replycmd    => BarnOwl::quote('irc-msg', '-a', $self->alias,
    120           (is_private($recipient) ? $evt->nick : $recipient)),
    121         replysendercmd => BarnOwl::quote('irc-msg', '-a', $self->alias, $evt->nick),
     125           (is_private($recipient) ? prefix_nick($evt) : $recipient)),
     126        replysendercmd => BarnOwl::quote('irc-msg', '-a', $self->alias, prefix_nick($evt)),
    122127       );
    123128
     
    125130}
    126131
    127 sub on_ping {
    128     my ($self, $evt) = @_;
    129     $self->conn->ctcp_reply($evt->nick, join (' ', ($evt->args)));
    130 }
    131 
    132132sub on_admin_msg {
    133133    my ($self, $evt) = @_;
    134     return if BarnOwl::Module::IRC->skip_msg($evt->type);
    135     BarnOwl::admin_message("IRC",
    136             BarnOwl::Style::boldify('IRC ' . $evt->type . ' message from '
     134    return if BarnOwl::Module::IRC->skip_msg($evt->{command});
     135    BarnOwl::admin_message("IRC",
     136            BarnOwl::Style::boldify('IRC ' . $evt->{command} . ' message from '
    137137                . $self->alias) . "\n"
    138             . strip_irc_formatting(join ' ', cdr($evt->args)));
     138            . strip_irc_formatting(join ' ', cdr($evt->{params})));
    139139}
    140140
    141141sub on_motdstart {
    142142    my ($self, $evt) = @_;
    143     $self->motd(join "\n", cdr($evt->args));
     143    $self->motd(join "\n", cdr(@{$evt->{params}}));
    144144}
    145145
    146146sub on_motd {
    147147    my ($self, $evt) = @_;
    148     $self->motd(join "\n", $self->motd, cdr($evt->args));
     148    $self->motd(join "\n", $self->motd, cdr(@{$evt->{params}}));
    149149}
    150150
    151151sub on_endofmotd {
    152152    my ($self, $evt) = @_;
    153     $self->motd(join "\n", $self->motd, cdr($evt->args));
     153    $self->motd(join "\n", $self->motd, cdr(@{$evt->{params}}));
    154154    BarnOwl::admin_message("IRC",
    155155            BarnOwl::Style::boldify('MOTD for ' . $self->alias) . "\n"
     
    159159sub on_join {
    160160    my ($self, $evt) = @_;
     161    my $chan = $evt->{params}[0];
    161162    my $msg = $self->new_message($evt,
    162163        loginout   => 'login',
    163164        action     => 'join',
    164         channel    => $evt->to,
    165         replycmd   => BarnOwl::quote('irc-msg', '-a', $self->alias, $evt->to),
    166         replysendercmd => BarnOwl::quote('irc-msg', '-a', $self->alias, $evt->nick),
     165        channel    => $chan,
     166        replycmd   => BarnOwl::quote('irc-msg', '-a', $self->alias, $chan),
     167        replysendercmd => BarnOwl::quote('irc-msg', '-a', $self->alias, prefix_nick($evt)),
    167168        );
    168169    BarnOwl::queue_message($msg);
    169     push @{$self->channels}, $evt->to;
    170170}
    171171
    172172sub on_part {
    173173    my ($self, $evt) = @_;
     174    my $chan = $evt->{params}[0];
    174175    my $msg = $self->new_message($evt,
    175176        loginout   => 'logout',
    176177        action     => 'part',
    177         channel    => $evt->to,
    178         replycmd   => BarnOwl::quote('irc-msg', '-a', $self->alias, $evt->to),
    179         replysendercmd => BarnOwl::quote('irc-msg', '-a', $self->alias, $evt->nick),
     178        channel    => $chan,
     179        replycmd   => BarnOwl::quote('irc-msg', '-a', $self->alias, $chan),
     180        replysendercmd => BarnOwl::quote('irc-msg', '-a', $self->alias, prefix_nick($evt)),
    180181        );
    181182    BarnOwl::queue_message($msg);
    182     $self->channels([ grep {$_ ne $evt->to} @{$self->channels}]);
    183183}
    184184
     
    188188        loginout   => 'logout',
    189189        action     => 'quit',
    190         from       => $evt->to,
    191         reason     => [$evt->args]->[0],
    192         replycmd   => BarnOwl::quote('irc-msg', '-a', $self->alias, $evt->nick),
    193         replysendercmd => BarnOwl::quote('irc-msg', '-a', $self->alias, $evt->nick),
     190        from       => $evt->{prefix},
     191        reason     => $evt->{params}->[1],
     192        replycmd   => BarnOwl::quote('irc-msg', '-a', $self->alias, prefix_nick($evt)),
     193        replysendercmd => BarnOwl::quote('irc-msg', '-a', $self->alias, prefix_nick($evt)),
    194194        );
    195195    BarnOwl::queue_message($msg);
     
    207207        }
    208208    }
    209     BarnOwl::remove_io_dispatch($self->{FD});
    210209    $self->motd("");
    211210}
    212211
    213212sub on_disconnect {
    214     my ($self, $evt) = @_;
     213    my ($self, $why) = @_;
    215214    $self->disconnect;
    216215    BarnOwl::admin_message('IRC',
    217216                           "[" . $self->alias . "] Disconnected from server");
    218     if ($evt->format and $evt->format eq "error") {
     217    if ($why && $why =~ m{error in connection}) {
    219218        $self->schedule_reconnect;
    220     } else {
    221         $self->channels([]);
    222219    }
    223220}
     
    227224    BarnOwl::admin_message("IRC",
    228225                           "[" . $self->alias . "] " .
    229                            [$evt->args]->[1] . ": Nick already in use");
    230     $self->disconnect unless $self->motd;
     226                           $evt->{params}->[1] . ": Nick already in use");
    231227}
    232228
    233229sub on_topic {
    234     my ($self, $evt) = @_;
    235     my @args = $evt->args;
    236     if (scalar @args > 1) {
     230    my ($self, $channel, $topic, $who) = @_;
     231    if ($channel) {
    237232        BarnOwl::admin_message("IRC",
    238                 "Topic for $args[1] on " . $self->alias . " is $args[2]");
     233                "Topic for $channel on " . $self->alias . " is $topic");
    239234    } else {
    240235        BarnOwl::admin_message("IRC",
    241                 "Topic changed to $args[0]");
     236                "Topic changed to $channel");
    242237    }
    243238}
     
    245240sub on_topicinfo {
    246241    my ($self, $evt) = @_;
    247     my @args = $evt->args;
     242    my @args = @{$evt->{params}};
    248243    BarnOwl::admin_message("IRC",
    249244        "Topic for $args[1] set by $args[2] at " . localtime($args[3]));
     
    257252    my ($self, $evt) = @_;
    258253    return unless $self->names_tmp;
    259     $self->names_tmp([@{$self->names_tmp}, split(' ', [$evt->args]->[3])]);
     254    $self->names_tmp([@{$self->names_tmp}, split(' ', $evt->{params}[3])]);
    260255}
    261256
     
    272267    my ($self, $evt) = @_;
    273268    return unless $self->names_tmp;
    274     my $names = BarnOwl::Style::boldify("Members of " . [$evt->args]->[1] . ":\n");
     269    my $names = BarnOwl::Style::boldify("Members of " . $evt->{params}->[1] . ":\n");
    275270    for my $name (sort {cmp_user($a, $b)} @{$self->names_tmp}) {
    276271        $names .= "  $name\n";
     
    282277sub on_whois {
    283278    my ($self, $evt) = @_;
     279    my %names = (
     280        311 => 'user',
     281        312 => 'server',
     282        319 => 'channels',
     283        330 => 'whowas',
     284       );
    284285    $self->whois_tmp(
    285       $self->whois_tmp . "\n" . $evt->type . ":\n  " .
    286       join("\n  ", cdr(cdr($evt->args))) . "\n"
    287     );
     286        $self->whois_tmp . "\n" . $names{$evt->{command}} . ":\n  " .
     287        join("\n  ", cdr(cdr(@{$evt->{params}}))) . "\n"
     288       );
    288289}
    289290
     
    291292    my ($self, $evt) = @_;
    292293    BarnOwl::popless_ztext(
    293         BarnOwl::Style::boldify("/whois for " . [$evt->args]->[1] . ":\n") .
     294        BarnOwl::Style::boldify("/whois for " . $evt->{params}->[1] . ":\n") .
    294295        $self->whois_tmp
    295296    );
     
    300301    my ($self, $evt) = @_;
    301302    BarnOwl::admin_message("IRC",
    302                            "[" . $self->alias . "] User " . ($evt->nick) . + " set mode " .
    303                            join(" ", $evt->args) . "on " . $evt->to->[0]
     303                           "[" . $self->alias . "] User " . (prefix_nick($evt)) . + " set mode " .
     304                           join(" ", cdr(@{$evt->{params}})) . "on " . $evt->{params}->[0]
    304305                          );
    305306}
    306307
    307 sub on_nosuchchannel {
    308     my ($self, $evt) = @_;
     308sub on_nosuch {
     309    my ($self, $evt) = @_;
     310    my %things = (401 => 'nick', 402 => 'server', 403 => 'channel');
    309311    BarnOwl::admin_message("IRC",
    310312                           "[" . $self->alias . "] " .
    311                            "No such channel: " . [$evt->args]->[1])
     313                           "No such @{[$things{$evt->{command}}]}: @{[$evt->{params}->[1]]}")
    312314}
    313315
     
    356358    $self->cancel_reconnect;
    357359    $BarnOwl::Module::IRC::ircnets{$self->alias} = $self;
    358     my $fd = $self->getSocket()->fileno();
    359     BarnOwl::add_io_dispatch($fd, 'r', \&BarnOwl::Module::IRC::OwlProcess);
    360     $self->{FD} = $fd;
     360    if ($self->autoconnect_channels) {
     361        for my $c (@{$self->autoconnect_channels}) {
     362            $self->conn->send_msg(join => $c);
     363        }
     364        $self->autoconnect_channels([]);
     365    }
     366    $self->conn->enable_ping(60, sub {
     367                                 $self->disconnect("Connection timed out.");
     368                                 $self->schedule_reconnect;
     369                             });
    361370}
    362371
     
    365374    my $backoff = shift;
    366375
     376    $self->autoconnect_channels([keys(%{$self->channel_list})]);
    367377    $self->conn->connect;
    368378    if ($self->conn->connected) {
    369379        $self->connected("Reconnected to ".$self->alias);
    370         my @channels = @{$self->channels};
    371         $self->channels([]);
    372         $self->conn->join($_) for @channels;
    373380        return;
    374381    }
Note: See TracChangeset for help on using the changeset viewer.