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

barnowl_perlaimdebianrelease-1.4release-1.5release-1.6release-1.7release-1.8release-1.9
Last change on this file since 6b580b0 was 6b580b0, checked in by Alejandro R. Sedeño <asedeno@mit.edu>, 13 years ago
functions.c: * removing the redisplay call from owl_function_lastmsg_noredisplay() select.c: * Watch AIM sockets for writing as well. This speeds up AIM connections significantly. Jabber.pm * keep a copy of the fd around for later. * Process() on mainloop for keep-alives Jabber/ConnectionManager.pm * Use the stored fd to drop the dispatch for a connection. Jabber/Connection.pm * Use the GetSock() abstraction since we have it. * Call the right do_logout when we have trouble.
  • Property mode set to 100644
File size: 3.1 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
46    # Add MUC to list of MUCs, unless we're just changing nicks.
47    push @{$self->MUCs}, $muc unless grep {$_->BaseJID eq $muc->BaseJID} $self->MUCs;
48}
49
50=head2 MUCLeave ARGS
51
52Leave a MUC. The MUC is specified in the same form as L</FindMUC>
53
54Returns true if successful, false if this connection was not in the
55named MUC.
56
57=cut
58
59sub MUCLeave {
60    my $self = shift;
61    my $muc = $self->FindMUC(@_);
62    return unless $muc;
63
64    $muc->Leave();
65    $self->{_BARNOWL_MUCS} = [grep {$_->BaseJID ne $muc->BaseJID} $self->MUCs];
66    return 1;
67}
68
69=head2 FindMUC ARGS
70
71Return the Net::Jabber::MUC object representing a specific MUC we're
72joined to, undef if it doesn't exists. ARGS can be either JID => $JID,
73or Room => $room, Server => $server.
74
75=cut
76
77sub FindMUC {
78    my $self = shift;
79
80    my %args;
81    while($#_ >= 0) { $args{ lc(pop(@_)) } = pop(@_); }
82
83    my $jid;
84    if($args{jid}) {
85        $jid = $args{jid};
86    } elsif($args{room} && $args{server}) {
87        $jid = Net::Jabber::JID->new(userid => $args{room},
88                                     server => $args{server});
89    }
90    $jid = $jid->GetJID('base') if UNIVERSAL::isa($jid, 'Net::XMPP::JID');
91
92    foreach my $muc ($self->MUCs) {
93        return $muc if $muc->BaseJID eq $jid;
94    }
95    return undef;
96}
97
98=head2 MUCs
99
100Returns a list (or arrayref in scalar context) of Net::Jabber::MUC
101objects we believe ourself to be connected to.
102
103=cut
104
105sub MUCs {
106    my $self = shift;
107    my $mucs = $self->{_BARNOWL_MUCS};
108    return wantarray ? @$mucs : $mucs;
109}
110
111
112=head2 getSID
113
114Returns the StreamID for this connection.
115
116=cut
117
118sub getStreamID {
119    my $self = shift;
120    return $self->{SESSION}->{id} || "";
121}
122
123=head2 getSocket
124
125Returns the IO::Socket for this connection.
126
127=cut
128
129sub getSocket {
130    my $self = shift;
131    my $sid = getStreamID($self);
132    return $self->{STREAM}->GetSock($sid) || -1;
133}
134
135=head2 OwlProcess
136
137Non-blocking connection processing. For use in a select loop.
138
139=cut
140
141sub OwlProcess {
142    my $self = shift;
143    my $status = $self->Process(0);
144    if ( !defined($status) ) {
145        my $jid = $self->{SESSION}->{FULLJID};
146        BarnOwl::error("Jabber account $jid disconnected!");
147        BarnOwl::Module::Jabber::do_logout($jid);
148    }
149}
150
151=head1 SEE ALSO
152
153L<Net::Jabber::Client>, L<BarnOwl::Module::Jabber>
154
155=cut
156
1571;
Note: See TracBrowser for help on using the repository browser.