source: perl/modules/Jabber/lib/BarnOwl/Module/Jabber/Connection.pm @ 693c8f2

barnowl_perlaimdebianrelease-1.4release-1.5release-1.6release-1.7release-1.8release-1.9
Last change on this file since 693c8f2 was 2cedb7a, checked in by Nelson Elhage <nelhage@mit.edu>, 14 years ago
Adding the new M::Iified jabber module. There isn't a target to build the PAR yet.
  • Property mode set to 100644
File size: 2.2 KB
Line 
1use warnings;
2use strict;
3
4=head1 NAME
5
6BarnOwl::Module::Jabber::Connection
7
8=head1 DESCRIPTION
9
10A subclass of L<Net::Jabber::Client> used in the BarnOwl jabber module
11
12=cut
13
14package BarnOwl::Module::Jabber::Connection;
15
16use base qw(Net::Jabber::Client);
17
18use Net::Jabber;
19
20sub new {
21    my $class = shift;
22
23    my %args = ();
24    if(BarnOwl::getvar('debug') eq 'on') {
25        $args{debuglevel} = 1;
26        $args{debugfile} = 'jabber.log';
27    }
28    my $self = $class->SUPER::new(%args);
29    $self->{_BARNOWL_MUCS} = [];
30    return $self;
31}
32
33=head2 MUCJoin
34
35Extends MUCJoin to keep track of the MUCs we're joined to as
36Net::Jabber::MUC objects. Takes the same arguments as
37L<Net::Jabber::MUC/new> and L<Net::Jabber::MUC/Connect>
38
39=cut
40
41sub MUCJoin {
42    my $self = shift;
43    my $muc = Net::Jabber::MUC->new(connection => $self, @_);
44    $muc->Join(@_);
45    push @{$self->MUCs}, $muc;
46}
47
48=head2 MUCLeave ARGS
49
50Leave a MUC. The MUC is specified in the same form as L</FindMUC>
51
52=cut
53
54sub MUCLeave {
55    my $self = shift;
56    my $muc = $self->FindMUC(@_);
57    return unless $muc;
58
59    $muc->Leave();
60    $self->{_BARNOWL_MUCS} = [grep {$_->BaseJID ne $muc->BaseJID} $self->MUCs];
61}
62
63=head2 FindMUC ARGS
64
65Return the Net::Jabber::MUC object representing a specific MUC we're
66joined to, undef if it doesn't exists. ARGS can be either JID => $JID,
67or Room => $room, Server => $server.
68
69=cut
70
71sub FindMUC {
72    my $self = shift;
73
74    my %args;
75    while($#_ >= 0) { $args{ lc(pop(@_)) } = pop(@_); }
76
77    my $jid;
78    if($args{jid}) {
79        $jid = $args{jid};
80    } elsif($args{room} && $args{server}) {
81        $jid = Net::Jabber::JID->new(userid => $args{room},
82                                     server => $args{server});
83    }
84    $jid = $jid->GetJID('base') if UNIVERSAL::isa($jid, 'Net::XMPP::JID');
85
86    foreach my $muc ($self->MUCs) {
87        return $muc if $muc->BaseJID eq $jid;
88    }
89    return undef;
90}
91
92=head2 MUCs
93
94Returns a list (or arrayref in scalar context) of Net::Jabber::MUC
95objects we believe ourself to be connected to.
96
97=cut
98
99sub MUCs {
100    my $self = shift;
101    my $mucs = $self->{_BARNOWL_MUCS};
102    return wantarray ? @$mucs : $mucs;
103}
104
105
106=head1 SEE ALSO
107
108L<Net::Jabber::Client>, L<BarnOwl::Module::Jabber>
109
110=cut
111
1121;
Note: See TracBrowser for help on using the repository browser.