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

barnowl_perlaimdebianrelease-1.10release-1.4release-1.5release-1.6release-1.7release-1.8release-1.9
Last change on this file since 3381399 was 5f3168a, checked in by Alejandro R. Sedeño <asedeno@mit.edu>, 16 years ago
Merged revisions 928-950 via svnmerge from file:///afs/sipb.mit.edu/project/barnowl/src/svn/trunk ........ r937 | nelhage | 2008-02-11 23:09:54 -0500 (Mon, 11 Feb 2008) | 2 lines Bind M-left and M-right by default in the editor ........ r947 | nelhage | 2008-02-18 16:45:22 -0500 (Mon, 18 Feb 2008) | 2 lines We need to stick modules on the beginning of @INC, not the end ........ r949 | asedeno | 2008-02-18 19:43:09 -0500 (Mon, 18 Feb 2008) | 1 line Merging in the select branch. ........ r950 | asedeno | 2008-02-18 20:54:45 -0500 (Mon, 18 Feb 2008) | 1 line Merging in the select branch, part 2. select.c ........
  • Property mode set to 100644
File size: 3.1 KB
Line 
1use warnings;
2use strict;
3use utf8;
4
5=head1 NAME
6
7BarnOwl::Module::Jabber::Connection
8
9=head1 DESCRIPTION
10
11A subclass of L<Net::Jabber::Client> used in the BarnOwl jabber module
12
13=cut
14
15package BarnOwl::Module::Jabber::Connection;
16
17use base qw(Net::Jabber::Client);
18
19use Net::Jabber;
20
21sub new {
22    my $class = shift;
23
24    my %args = ();
25    if(BarnOwl::getvar('debug') eq 'on') {
26        $args{debuglevel} = 1;
27        $args{debugfile} = 'jabber.log';
28    }
29    my $self = $class->SUPER::new(%args);
30    $self->{_BARNOWL_MUCS} = [];
31    return $self;
32}
33
34=head2 MUCJoin
35
36Extends MUCJoin to keep track of the MUCs we're joined to as
37Net::Jabber::MUC objects. Takes the same arguments as
38L<Net::Jabber::MUC/new> and L<Net::Jabber::MUC/Connect>
39
40=cut
41
42sub MUCJoin {
43    my $self = shift;
44    my $muc = Net::Jabber::MUC->new(connection => $self, @_);
45    $muc->Join(@_);
46
47    # Add MUC to list of MUCs, unless we're just changing nicks.
48    push @{$self->MUCs}, $muc unless grep {$_->BaseJID eq $muc->BaseJID} $self->MUCs;
49}
50
51=head2 MUCLeave ARGS
52
53Leave a MUC. The MUC is specified in the same form as L</FindMUC>
54
55Returns true if successful, false if this connection was not in the
56named MUC.
57
58=cut
59
60sub MUCLeave {
61    my $self = shift;
62    my $muc = $self->FindMUC(@_);
63    return unless $muc;
64
65    $muc->Leave();
66    $self->{_BARNOWL_MUCS} = [grep {$_->BaseJID ne $muc->BaseJID} $self->MUCs];
67    return 1;
68}
69
70=head2 FindMUC ARGS
71
72Return the Net::Jabber::MUC object representing a specific MUC we're
73joined to, undef if it doesn't exists. ARGS can be either JID => $JID,
74or Room => $room, Server => $server.
75
76=cut
77
78sub FindMUC {
79    my $self = shift;
80
81    my %args;
82    while($#_ >= 0) { $args{ lc(pop(@_)) } = pop(@_); }
83
84    my $jid;
85    if($args{jid}) {
86        $jid = $args{jid};
87    } elsif($args{room} && $args{server}) {
88        $jid = Net::Jabber::JID->new(userid => $args{room},
89                                     server => $args{server});
90    }
91    $jid = $jid->GetJID('base') if UNIVERSAL::isa($jid, 'Net::XMPP::JID');
92
93    foreach my $muc ($self->MUCs) {
94        return $muc if $muc->BaseJID eq $jid;
95    }
96    return undef;
97}
98
99=head2 MUCs
100
101Returns a list (or arrayref in scalar context) of Net::Jabber::MUC
102objects we believe ourself to be connected to.
103
104=cut
105
106sub MUCs {
107    my $self = shift;
108    my $mucs = $self->{_BARNOWL_MUCS};
109    return wantarray ? @$mucs : $mucs;
110}
111
112
113=head2 getSID
114
115Returns the StreamID for this connection.
116
117=cut
118
119sub getStreamID {
120    my $self = shift;
121    return $self->{SESSION}->{id} || "";
122}
123
124=head2 getSocket
125
126Returns the IO::Socket for this connection.
127
128=cut
129
130sub getSocket {
131    my $self = shift;
132    my $sid = getStreamID($self);
133    return $self->{STREAM}->GetSock($sid) || -1;
134}
135
136=head2 OwlProcess
137
138Non-blocking connection processing. For use in a select loop.
139
140=cut
141
142sub OwlProcess {
143    my $self = shift;
144    my $status = $self->Process(0);
145    if ( !defined($status) ) {
146        my $jid = $self->{SESSION}->{FULLJID};
147        BarnOwl::error("Jabber account $jid disconnected!");
148        BarnOwl::Module::Jabber::do_logout($jid);
149    }
150}
151
152=head1 SEE ALSO
153
154L<Net::Jabber::Client>, L<BarnOwl::Module::Jabber>
155
156=cut
157
1581;
Note: See TracBrowser for help on using the repository browser.