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

release-1.10release-1.5release-1.6release-1.7release-1.8release-1.9
Last change on this file since 23fddad was a957e92, checked in by Alex Vandiver <alexmv@mit.edu>, 14 years ago
Make Jabber try to reconnect when disconnected, at exponential intervals Make the ConnectionManager store auth information on connect, and use that auth information to try to reconnect and re-auth. Use some simple exponential backoff, capped at 5 minutes, as intervals for reconnecting.
  • Property mode set to 100644
File size: 3.3 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 $jid = shift || $self->{SESSION}->{FULLJID};
145    my $status = $self->Process(0);
146    if ( !defined($status) ) {
147        $BarnOwl::Module::Jabber::conn->scheduleReconnect($jid);
148    }
149}
150
151=head2 Disconnect
152
153Work around a bug in Net::Jabber::Client where Process' return status
154is not cleared on disconnect.
155
156=cut
157
158sub Disconnect {
159    my $self = shift;
160    delete $self->{PROCESSERROR};
161    return $self->SUPER::Disconnect(@_);
162}
163
164=head1 SEE ALSO
165
166L<Net::Jabber::Client>, L<BarnOwl::Module::Jabber>
167
168=cut
169
1701;
Note: See TracBrowser for help on using the repository browser.