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

release-1.10release-1.5release-1.6release-1.7release-1.8release-1.9
Last change on this file since 385cce2 was 0dbb7d2, checked in by Alejandro R. Sedeño <asedeno@mit.edu>, 14 years ago
Factor out some common jabber connect-time code Call it upon successful connection and reconnection.
  • Property mode set to 100644
File size: 4.8 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
[0dbb7d2]165=head2 OnConnect
166
167Actions to perform on connecting and reconnecting.
168
169=cut
170
171sub onConnect {
172    my $self = shift;
173    my $conn = shift;
174    my $jidStr = shift;
175
176    my $fullJid = $self->{SESSION}->{FULLJID} || $jidStr;
177    my $roster = $conn->getRosterFromJID($jidStr);
178
179    $roster->fetch();
180    $self->PresenceSend( priority => 1 );
181
182    $conn->renameConnection($jidStr, $fullJid);
183    BarnOwl::admin_message('Jabber', "Connected to jabber as $fullJid");
184    # The remove_io_dispatch() method is called from the
185    # ConnectionManager's removeConnection() method.
186    $self->{fileno} = $self->getSocket()->fileno();
187    BarnOwl::add_io_dispatch($self->{fileno}, 'r', sub { $self->OwlProcess($fullJid) });
188
189    # populate completion from roster.
190    for my $buddy ( $roster->jids('all') ) {
191        my %jq  = $roster->query($buddy);
192        my $name = $jq{name} || $buddy->GetUserID();
193        $BarnOwl::Module::Jabber::completion_jids{$name} = 1;
194        $BarnOwl::Module::Jabber::completion_jids{$buddy->GetJID()} = 1;
195    }
196    $BarnOwl::Module::Jabber::vars{idletime} |= BarnOwl::getidletime();
197    unless (exists $BarnOwl::Module::Jabber::vars{keepAliveTimer}) {
198        $BarnOwl::Module::Jabber::vars{keepAliveTimer} =
199            BarnOwl::Timer->new({
200                'after' => 5,
201                'interval' => 5,
202                'cb' => sub { BarnOwl::Module::Jabber::do_keep_alive_and_auto_away(@_) }
203                                });
204    }
205}
206
[2cedb7a]207=head1 SEE ALSO
208
209L<Net::Jabber::Client>, L<BarnOwl::Module::Jabber>
210
211=cut
212
2131;
Note: See TracBrowser for help on using the repository browser.