Ignore:
Timestamp:
Mar 18, 2007, 4:28:31 PM (18 years ago)
Author:
Nelson Elhage <nelhage@mit.edu>
Branches:
master, barnowl_perlaim, debian, release-1.10, release-1.4, release-1.5, release-1.6, release-1.7, release-1.8, release-1.9
Children:
300b470
Parents:
2622450
git-author:
Nelson Elhage <nelhage@mit.edu> (03/18/07 16:28:18)
git-committer:
Nelson Elhage <nelhage@mit.edu> (03/18/07 16:28:31)
Message:
Adding the new M::Iified jabber module. There isn't a target to build
the PAR yet.
Location:
perl/modules/Jabber
Files:
4 added
1 moved

Legend:

Unmodified
Added
Removed

  • perl/modules/Jabber/lib/BarnOwl/Module/Jabber.pm

    rd47d5fc r2cedb7a  
    1 # -*- mode: cperl; cperl-indent-level: 4; indent-tabs-mode: nil -*-
     1use strict;
    22use warnings;
    3 use strict;
    4 
    5 package BarnOwl::Jabber;
     3
     4package BarnOwl::Module::Jabber;
     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::Jabber;
     19use BarnOwl::Module::Jabber::Connection;
     20use BarnOwl::Module::Jabber::ConnectionManager;
    621
    722use Authen::SASL qw(Perl);
    … …  
    1025use Net::DNS;
    1126use Getopt::Long;
     27
     28our $VERSION = 0.1;
    1229
    1330BEGIN {
    … …  
    3855################################################################################
    3956
    40 
    41 ################################################################################
    42 ################################################################################
    43 package BarnOwl::Jabber::Connection;
    44 
    45 use base qw(Net::Jabber::Client);
    46 
    47 sub new {
    48     my $class = shift;
    49 
    50     my %args = ();
    51     if(BarnOwl::getvar('debug') eq 'on') {
    52         $args{debuglevel} = 1;
    53         $args{debugfile} = 'jabber.log';
    54     }
    55     my $self = $class->SUPER::new(%args);
    56     $self->{_BARNOWL_MUCS} = [];
    57     return $self;
    58 }
    59 
    60 =head2 MUCJoin
    61 
    62 Extends MUCJoin to keep track of the MUCs we're joined to as
    63 Net::Jabber::MUC objects. Takes the same arguments as
    64 L<Net::Jabber::MUC/new> and L<Net::Jabber::MUC/Connect>
    65 
    66 =cut
    67 
    68 sub MUCJoin {
    69     my $self = shift;
    70     my $muc = Net::Jabber::MUC->new(connection => $self, @_);
    71     $muc->Join(@_);
    72     push @{$self->MUCs}, $muc;
    73 }
    74 
    75 =head2 MUCLeave ARGS
    76 
    77 Leave a MUC. The MUC is specified in the same form as L</FindMUC>
    78 
    79 =cut
    80 
    81 sub MUCLeave {
    82     my $self = shift;
    83     my $muc = $self->FindMUC(@_);
    84     return unless $muc;
    85 
    86     $muc->Leave();
    87     $self->{_BARNOWL_MUCS} = [grep {$_->BaseJID ne $muc->BaseJID} $self->MUCs];
    88 }
    89 
    90 =head2 FindMUC ARGS
    91 
    92 Return the Net::Jabber::MUC object representing a specific MUC we're
    93 joined to, undef if it doesn't exists. ARGS can be either JID => $JID,
    94 or Room => $room, Server => $server.
    95 
    96 =cut
    97 
    98 sub FindMUC {
    99     my $self = shift;
    100 
    101     my %args;
    102     while($#_ >= 0) { $args{ lc(pop(@_)) } = pop(@_); }
    103 
    104     my $jid;
    105     if($args{jid}) {
    106         $jid = $args{jid};
    107     } elsif($args{room} && $args{server}) {
    108         $jid = Net::Jabber::JID->new(userid => $args{room},
    109                                      server => $args{server});
    110     }
    111     $jid = $jid->GetJID('base') if UNIVERSAL::isa($jid, 'Net::XMPP::JID');
    112 
    113     foreach my $muc ($self->MUCs) {
    114         return $muc if $muc->BaseJID eq $jid;
    115     }
    116     return undef;
    117 }
    118 
    119 =head2 MUCs
    120 
    121 Returns a list (or arrayref in scalar context) of Net::Jabber::MUC
    122 objects we believe ourself to be connected to.
    123 
    124 =cut
    125 
    126 sub MUCs {
    127     my $self = shift;
    128     my $mucs = $self->{_BARNOWL_MUCS};
    129     return wantarray ? @$mucs : $mucs;
    130 }
    131 
    132 ################################################################################
    133 ################################################################################
    134 package BarnOwl::Jabber::ConnectionManager;
    135 sub new {
    136     my $class = shift;
    137     return bless { }, $class;
    138 }
    139 
    140 sub addConnection {
    141     my $self = shift;
    142     my $jidStr = shift;
    143 
    144     my $client = BarnOwl::Jabber::Connection->new;
    145 
    146     $self->{$jidStr}->{Client} = $client;
    147     $self->{$jidStr}->{Roster} = $client->Roster();
    148     $self->{$jidStr}->{Status} = "available";
    149     return $client;
    150 }
    151 
    152 sub removeConnection {
    153     my $self = shift;
    154     my $jidStr = shift;
    155     return 0 unless exists $self->{$jidStr};
    156 
    157     $self->{$jidStr}->{Client}->Disconnect()
    158       if $self->{$jidStr}->{Client};
    159     delete $self->{$jidStr};
    160 
    161     return 1;
    162 }
    163 
    164 sub connected {
    165     my $self = shift;
    166     return scalar keys %{ $self };
    167 }
    168 
    169 sub getJIDs {
    170     my $self = shift;
    171     return keys %{ $self };
    172 }
    173 
    174 sub jidExists {
    175     my $self = shift;
    176     my $jidStr = shift;
    177     return exists $self->{$jidStr};
    178 }
    179 
    180 sub sidExists {
    181     my $self = shift;
    182     my $sid = shift || "";
    183     foreach my $c ( values %{ $self } ) {
    184         return 1 if ($c->{Client}->{SESSION}->{id} eq $sid);
    185     }
    186     return 0;
    187 }
    188 
    189 sub getConnectionFromSid {
    190     my $self = shift;
    191     my $sid = shift;
    192     foreach my $c (values %{ $self }) {
    193         return $c->{Client} if $c->{Client}->{SESSION}->{id} eq $sid;
    194     }
    195     return undef;
    196 }
    197 
    198 sub getConnectionFromJID {
    199     my $self = shift;
    200     my $jid = shift;
    201     $jid = $jid->GetJID('full') if UNIVERSAL::isa($jid, 'Net::XMPP::JID');
    202     return $self->{$jid}->{Client} if exists $self->{$jid};
    203 }
    204 
    205 sub getRosterFromSid {
    206     my $self = shift;
    207     my $sid = shift;
    208     foreach my $c (values %{ $self }) {
    209         return $c->{Roster}
    210           if $c->{Client}->{SESSION}->{id} eq $sid;
    211     }
    212     return undef;
    213 }
    214 
    215 sub getRosterFromJID {
    216     my $self = shift;
    217     my $jid = shift;
    218     $jid = $jid->GetJID('full') if UNIVERSAL::isa($jid, 'Net::XMPP::JID');
    219     return $self->{$jid}->{Roster} if exists $self->{$jid};
    220 }
    221 ################################################################################
    222 
    223 package BarnOwl::Jabber;
    224 
    225 our $conn = new BarnOwl::Jabber::ConnectionManager unless $conn;;
     57our $conn = BarnOwl::Module::Jabber::ConnectionManager->new unless $conn;;
    22658our %vars;
    22759
    … …  
    22961    if ( *BarnOwl::queue_message{CODE} ) {
    23062        register_owl_commands();
    231         register_keybindings() unless $BarnOwl::reload;
    232         register_filters() unless $BarnOwl::reload;
    233         push @::onMainLoop,     sub { BarnOwl::Jabber::onMainLoop(@_) };
    234         push @::onGetBuddyList, sub { BarnOwl::Jabber::onGetBuddyList(@_) };
     63        register_keybindings();
     64        register_filters();
     65        $BarnOwl::Hooks::mainLoop->add(\&onMainLoop);
     66        $BarnOwl::Hooks::getBuddyList->add(\&onGetBuddyList);
    23567        $vars{show} = '';
    23668    } else {
    … …  
    24173}
    24274
    243 push @::onStartSubs, sub { BarnOwl::Jabber::onStart(@_) };
     75$BarnOwl::Hooks::startup->add(\&onStart);
    24476
    24577sub onMainLoop {
    … …  
    303135        $blistStr .= " [" . ( $rq{show} ? $rq{show} : 'online' ) . "]";
    304136        $blistStr .= " " . $rq{status} if $rq{status};
    305         $blistStr = boldify($blistStr);
     137        $blistStr = BarnOwl::Style::boldify($blistStr);
    306138    }
    307139    else {
    … …  
    326158    my $roster = $conn->getRosterFromJID($jid);
    327159    if ($roster) {
    328         $blist .= "\n" . boldify("Jabber Roster for $jid\n");
     160        $blist .= "\n" . BarnOwl::Style::boldify("Jabber Roster for $jid\n");
    329161
    330162        foreach my $group ( $roster->groups() ) {
    … …  
    497329        # when we reload
    498330        $client->SetMessageCallBacks(
    499             chat      => sub { BarnOwl::Jabber::process_incoming_chat_message(@_) },
    500             error     => sub { BarnOwl::Jabber::process_incoming_error_message(@_) },
    501             groupchat => sub { BarnOwl::Jabber::process_incoming_groupchat_message(@_) },
    502             headline  => sub { BarnOwl::Jabber::process_incoming_headline_message(@_) },
    503             normal    => sub { BarnOwl::Jabber::process_incoming_normal_message(@_) }
     331            chat      => sub { BarnOwl::Module::Jabber::process_incoming_chat_message(@_) },
     332            error     => sub { BarnOwl::Module::Jabber::process_incoming_error_message(@_) },
     333            groupchat => sub { BarnOwl::Module::Jabber::process_incoming_groupchat_message(@_) },
     334            headline  => sub { BarnOwl::Module::Jabber::process_incoming_headline_message(@_) },
     335            normal    => sub { BarnOwl::Module::Jabber::process_incoming_normal_message(@_) }
    504336        );
    505337        $client->SetPresenceCallBacks(
    506             available    => sub { BarnOwl::Jabber::process_presence_available(@_) },
    507             unavailable  => sub { BarnOwl::Jabber::process_presence_available(@_) },
    508             subscribe    => sub { BarnOwl::Jabber::process_presence_subscribe(@_) },
    509             subscribed   => sub { BarnOwl::Jabber::process_presence_subscribed(@_) },
    510             unsubscribe  => sub { BarnOwl::Jabber::process_presence_unsubscribe(@_) },
    511             unsubscribed => sub { BarnOwl::Jabber::process_presence_unsubscribed(@_) },
    512             error        => sub { BarnOwl::Jabber::process_presence_error(@_) });
     338            available    => sub { BarnOwl::Module::Jabber::process_presence_available(@_) },
     339            unavailable  => sub { BarnOwl::Module::Jabber::process_presence_available(@_) },
     340            subscribe    => sub { BarnOwl::Module::Jabber::process_presence_subscribe(@_) },
     341            subscribed   => sub { BarnOwl::Module::Jabber::process_presence_subscribed(@_) },
     342            unsubscribe  => sub { BarnOwl::Module::Jabber::process_presence_unsubscribe(@_) },
     343            unsubscribed => sub { BarnOwl::Module::Jabber::process_presence_unsubscribed(@_) },
     344            error        => sub { BarnOwl::Module::Jabber::process_presence_error(@_) });
    513345
    514346        my $status = $client->Connect( %{ $vars{jlogin_connhash} } );
    … …  
    800632        my $str = "";
    801633        foreach my $jid ($conn->getJIDs()) {
    802             $str .= boldify("Conferences for $jid:\n");
     634            $str .= BarnOwl::Style::boldify("Conferences for $jid:\n");
    803635            my $connection = $conn->getConnectionFromJID($jid);
    804636            foreach my $muc ($connection->MUCs) {
    … …  
    13071139}
    13081140
    1309 sub boldify($) {
    1310     my $str = shift;
    1311 
    1312     return '@b(' . $str . ')' if ( $str !~ /\)/ );
    1313     return '@b<' . $str . '>' if ( $str !~ /\>/ );
    1314     return '@b{' . $str . '}' if ( $str !~ /\}/ );
    1315     return '@b[' . $str . ']' if ( $str !~ /\]/ );
    1316 
    1317     my $txt = "$str";
    1318     $txt =~ s{[)]}{)\@b[)]\@b(}g;
    1319     return '@b(' . $txt . ')';
    1320 }
    1321 
    13221141sub getServerFromJID {
    13231142    my $jid = shift;
    … …  
    14571276}
    14581277
    1459 #####################################################################
    1460 #####################################################################
    1461 
    1462 package BarnOwl::Message::Jabber;
    1463 
    1464 our @ISA = qw( BarnOwl::Message );
    1465 
    1466 sub jtype { shift->{jtype} };
    1467 sub from { shift->{from} };
    1468 sub to { shift->{to} };
    1469 sub room { shift->{room} };
    1470 sub status { shift->{status} }
    1471 
    1472 sub login_extra {
    1473     my $self = shift;
    1474     my $show = $self->{show};
    1475     my $status = $self->status;
    1476     my $s = "";
    1477     $s .= $show if $show;
    1478     $s .= ", $status" if $status;
    1479     return $s;
    1480 }
    1481 
    1482 sub long_sender {
    1483     my $self = shift;
    1484     return $self->from;
    1485 }
    1486 
    1487 sub context {
    1488     return shift->room;
    1489 }
    1490 
    1491 sub smartfilter {
    1492     my $self = shift;
    1493     my $inst = shift;
    1494 
    1495     my ($filter, $ftext);
    1496 
    1497     if($self->jtype eq 'chat') {
    1498         my $user;
    1499         if($self->direction eq 'in') {
    1500             $user = $self->from;
    1501         } else {
    1502             $user = $self->to;
    1503         }
    1504         return smartfilter_user($user, $inst);
    1505     } elsif ($self->jtype eq 'groupchat') {
    1506         my $room = $self->room;
    1507         $filter = "jabber-room-$room";
    1508         $ftext = qq{type ^jabber\$ and room ^$room\$};
    1509         BarnOwl::filter("$filter $ftext");
    1510         return $filter;
    1511     } elsif ($self->login ne 'none') {
    1512         return smartfilter_user($self->from, $inst);
    1513     }
    1514 }
    1515 
    1516 sub smartfilter_user {
    1517     my $user = shift;
    1518     my $inst = shift;
    1519 
    1520     $user   = Net::Jabber::JID->new($user)->GetJID( $inst ? 'full' : 'base' );
    1521     my $filter = "jabber-user-$user";
    1522     my $ftext  =
    1523         qq{type ^jabber\$ and ( ( direction ^in\$ and from ^$user ) }
    1524       . qq{or ( direction ^out\$ and to ^$user ) ) };
    1525     BarnOwl::filter("$filter $ftext");
    1526     return $filter;
    1527 
    1528 }
    1529 
    1530 
    153112781;
Note: See TracChangeset for help on using the changeset viewer.