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

barnowl_perlaimdebianrelease-1.4release-1.5release-1.6release-1.7release-1.8release-1.9
Last change on this file since 9c7a701 was 9c7a701, checked in by Alejandro R. Sedeño <asedeno@mit.edu>, 13 years ago
Initial select() changes. stdin, zephyr, jabber, and irc are checked and have dispatch functions. aim is hacked in -- not entirely pretty, but documented and isolated. We still want timers.
  • 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}->{SIDS}->{$sid}->{sock} || -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        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.