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

release-1.5release-1.6release-1.7release-1.8release-1.9
Last change on this file since 8590774 was 8590774, checked in by Alejandro R. Sedeño <asedeno@mit.edu>, 10 years ago
Reconnect to MUCs when reconnecting to Jabber. Signed-off-by: Alejandro R. Sedeño <asedeno@mit.edu> Signed-off-by: Nelson Elhage <nelhage@mit.edu>
  • Property mode set to 100644
File size: 3.3 KB
RevLine 
[2cedb7a]1use warnings;
2use strict;
[e0ffe77]3use utf8;
[2cedb7a]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, @_);
[8590774]45    $muc->{ARGS} = @_; # Save these for later
[2cedb7a]46    $muc->Join(@_);
[3c455b4]47
48    # Add MUC to list of MUCs, unless we're just changing nicks.
49    push @{$self->MUCs}, $muc unless grep {$_->BaseJID eq $muc->BaseJID} $self->MUCs;
[2cedb7a]50}
51
52=head2 MUCLeave ARGS
53
54Leave a MUC. The MUC is specified in the same form as L</FindMUC>
55
[892568b]56Returns true if successful, false if this connection was not in the
57named MUC.
58
[2cedb7a]59=cut
60
61sub MUCLeave {
62    my $self = shift;
63    my $muc = $self->FindMUC(@_);
64    return unless $muc;
65
66    $muc->Leave();
67    $self->{_BARNOWL_MUCS} = [grep {$_->BaseJID ne $muc->BaseJID} $self->MUCs];
[892568b]68    return 1;
[2cedb7a]69}
70
71=head2 FindMUC ARGS
72
73Return the Net::Jabber::MUC object representing a specific MUC we're
74joined to, undef if it doesn't exists. ARGS can be either JID => $JID,
75or Room => $room, Server => $server.
76
77=cut
78
79sub FindMUC {
80    my $self = shift;
81
82    my %args;
83    while($#_ >= 0) { $args{ lc(pop(@_)) } = pop(@_); }
84
85    my $jid;
86    if($args{jid}) {
87        $jid = $args{jid};
88    } elsif($args{room} && $args{server}) {
89        $jid = Net::Jabber::JID->new(userid => $args{room},
90                                     server => $args{server});
91    }
92    $jid = $jid->GetJID('base') if UNIVERSAL::isa($jid, 'Net::XMPP::JID');
93
94    foreach my $muc ($self->MUCs) {
95        return $muc if $muc->BaseJID eq $jid;
96    }
97    return undef;
98}
99
100=head2 MUCs
101
102Returns a list (or arrayref in scalar context) of Net::Jabber::MUC
103objects we believe ourself to be connected to.
104
105=cut
106
107sub MUCs {
108    my $self = shift;
109    my $mucs = $self->{_BARNOWL_MUCS};
110    return wantarray ? @$mucs : $mucs;
111}
112
113
[9c7a701]114=head2 getSID
115
116Returns the StreamID for this connection.
117
118=cut
119
120sub getStreamID {
121    my $self = shift;
122    return $self->{SESSION}->{id} || "";
123}
124
125=head2 getSocket
126
127Returns the IO::Socket for this connection.
128
129=cut
130
131sub getSocket {
132    my $self = shift;
133    my $sid = getStreamID($self);
[6b580b0]134    return $self->{STREAM}->GetSock($sid) || -1;
[9c7a701]135}
136
137=head2 OwlProcess
138
139Non-blocking connection processing. For use in a select loop.
140
141=cut
142
143sub OwlProcess {
144    my $self = shift;
[a957e92]145    my $jid = shift || $self->{SESSION}->{FULLJID};
[9c7a701]146    my $status = $self->Process(0);
147    if ( !defined($status) ) {
[a957e92]148        $BarnOwl::Module::Jabber::conn->scheduleReconnect($jid);
[9c7a701]149    }
150}
151
[a957e92]152=head2 Disconnect
153
154Work around a bug in Net::Jabber::Client where Process' return status
155is not cleared on disconnect.
156
157=cut
158
159sub Disconnect {
160    my $self = shift;
161    delete $self->{PROCESSERROR};
162    return $self->SUPER::Disconnect(@_);
163}
164
[2cedb7a]165=head1 SEE ALSO
166
167L<Net::Jabber::Client>, L<BarnOwl::Module::Jabber>
168
169=cut
170
1711;
Note: See TracBrowser for help on using the repository browser.