ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/Net-XMPP2/lib/Net/XMPP2/Client.pm
Revision: 1.20
Committed: Tue Jul 24 12:31:15 2007 UTC (19 years, 2 months ago) by elmex
Branch: MAIN
CVS Tags: HEAD
Changes since 1.19: +2 -4 lines
Log Message:
documentation update

File Contents

# User Rev Content
1 elmex 1.1 package Net::XMPP2::Client;
2     use strict;
3     use AnyEvent;
4 elmex 1.2 use Net::XMPP2::IM::Connection;
5 elmex 1.16 use Net::XMPP2::Util qw/stringprep_jid prep_bare_jid dump_twig_xml/;
6 elmex 1.2 use Net::XMPP2::Namespaces qw/xmpp_ns/;
7 elmex 1.1 use Net::XMPP2::Event;
8 elmex 1.16 use Net::XMPP2::Extendable;
9 elmex 1.2 use Net::XMPP2::IM::Account;
10    
11 elmex 1.11 #use XML::Twig;
12     #
13     #sub _dumpxml {
14     # my $data = shift;
15     # my $t = XML::Twig->new;
16     # if ($t->safe_parse ("<deb>$data</deb>")) {
17     # $t->set_pretty_print ('indented');
18     # $t->print;
19     # print "\n";
20     # } else {
21     # print "[$data]\n";
22     # }
23     #}
24 elmex 1.1
25 elmex 1.16 our @ISA = qw/Net::XMPP2::Event Net::XMPP2::Extendable/;
26 elmex 1.1
27     =head1 NAME
28    
29 elmex 1.13 Net::XMPP2::Client - XMPP Client abstraction
30 elmex 1.1
31     =head1 SYNOPSIS
32    
33     use Net::XMPP2::Client;
34     use AnyEvent;
35    
36     my $j = AnyEvent->condvar;
37    
38     my $cl = Net::XMPP2::Client->new;
39     $cl->start;
40    
41     $j->wait;
42    
43     =head1 DESCRIPTION
44    
45     This module tries to implement a straight forward and easy to
46     use API to communicate with XMPP entities. L<Net::XMPP2::Client>
47     handles connections and timeouts and all such stuff for you.
48    
49     For more flexibility please have a look at L<Net::XMPP2::Connection>
50     and L<Net::XMPP2::IM::Connection>, they allow you to control what
51     and how something is being sent more precisely.
52    
53     =head1 METHODS
54    
55     =head2 new (%args)
56    
57     Following arguments can be passed in C<%args>:
58    
59     =over 4
60    
61     =back
62    
63     =cut
64    
65     sub new {
66     my $this = shift;
67     my $class = ref($this) || $this;
68     my $self = { @_ };
69     bless $self, $class;
70 elmex 1.19
71 elmex 1.16 if ($self->{debug}) {
72     $self->reg_cb (
73     debug_recv => sub {
74     my ($self, $acc, $data) = @_;
75     printf "recv>> %s\n%s", $acc->jid, dump_twig_xml ($data)
76     },
77     debug_send => sub {
78     my ($self, $acc, $data) = @_;
79     printf "send<< %s\n%s", $acc->jid, dump_twig_xml ($data)
80     },
81     )
82     }
83 elmex 1.2 return $self;
84     }
85    
86 elmex 1.16 sub add_extension {
87     my ($self, $ext) = @_;
88     $self->add_forward ($ext, sub {
89     my ($self, $ext, $ev, $acc, @args) = @_;
90     $ext->event ($ev, $acc->connection (), @args);
91     });
92     }
93    
94 elmex 1.2 =head2 add_account ($jid, $password, $host, $port)
95    
96     This method adds a jabber account for connection with the JID C<$jid>
97     and the password C<$password>.
98    
99     C<$host> and C<$port> are optional and can be undef. C<$host> overrides the
100     host to connect to.
101    
102     Returns 1 on success and undef when the account already exists.
103    
104     =cut
105    
106     sub add_account {
107     my ($self, $jid, $password, $host, $port) = @_;
108    
109     $jid = stringprep_jid $jid;
110     my $bj = prep_bare_jid $jid;
111    
112     return if exists $self->{accounts}->{$bj};
113    
114     my $acc =
115     $self->{accounts}->{$bj} =
116     Net::XMPP2::IM::Account->new (
117     jid => $jid,
118     password => $password,
119     host => $host,
120     port => $port,
121     );
122    
123     $self->update_connections
124     if $self->{started};
125    
126     $acc
127     }
128    
129     =head2 start ()
130    
131     This method initiates the connections to the XMPP servers.
132    
133     =cut
134    
135     sub start {
136     my ($self) = @_;
137     $self->{started} = 1;
138     $self->update_connections;
139     }
140    
141 elmex 1.11 =head2 update_connections ()
142    
143     This method tries to connect all unconnected accounts.
144    
145     =cut
146    
147 elmex 1.2 sub update_connections {
148     my ($self) = @_;
149 elmex 1.1
150 elmex 1.2 for my $acc (values %{$self->{accounts}}) {
151     unless ($acc->is_connected) {
152 elmex 1.18 my %args = (initial_presence => 10);
153    
154     if (defined $self->{presence}) {
155     if (defined $self->{presence}->{priority}) {
156     $args{initial_presence} = $self->{presence}->{priority};
157     }
158     }
159    
160     my $con = $acc->spawn_connection (%args);
161 elmex 1.2
162 elmex 1.5 $con->add_forward ($self, sub {
163     my ($con, $self, $ev, @arg) = @_;
164     $self->event ($ev, $acc, @arg);
165     });
166    
167 elmex 1.2 $con->reg_cb (
168     session_ready => sub {
169     my ($con) = @_;
170     $self->event (connected => $acc);
171 elmex 1.18 if (defined $self->{presence}) {
172     $con->send_presence (undef, undef, %{$self->{presence} || {}});
173     }
174 elmex 1.20 $con->unreg_me
175 elmex 1.2 },
176 elmex 1.7 disconnect => sub {
177     delete $self->{accounts}->{$acc};
178 elmex 1.20 $_[0]->unreg_me
179 elmex 1.7 }
180 elmex 1.2 );
181    
182 elmex 1.7 unless ($con->connect) {
183     $self->event (connect_error => "Couldn't connect to ".($acc->jid).": $!");
184     next
185     }
186 elmex 1.2 $con->init
187     }
188     }
189     }
190    
191 elmex 1.11 =head2 disconnect ($msg)
192 elmex 1.6
193     Disconnect all accounts.
194    
195     =cut
196    
197     sub disconnect {
198     my ($self, $msg) = @_;
199     for my $acc (values %{$self->{accounts}}) {
200     if ($acc->is_connected) { $acc->connection ()->disconnect ($msg) }
201     }
202     }
203    
204 elmex 1.11 =head2 remove_accounts ($msg)
205 elmex 1.6
206     Removes all accounts and disconnects.
207    
208     =cut
209    
210     sub remove_accounts {
211     my ($self, $msg) = @_;
212     for my $acc (keys %{$self->{accounts}}) {
213     my $acca = $self->{accounts}->{$acc};
214     if ($acca->is_connected) { $acca->connection ()->disconnect ($msg) }
215     delete $self->{accounts}->{$acc};
216     }
217     }
218    
219 elmex 1.11 =head2 remove_account ($acc)
220 elmex 1.7
221     Removes and disconnects account C<$acc>.
222    
223     =cut
224    
225     sub remove_account {
226     my ($self, $acc, $reason) = @_;
227     if ($acc->is_connected) {
228     $acc->connection ()->disconnect ($reason);
229     }
230     delete $self->{accounts}->{$acc};
231     }
232    
233 elmex 1.15 =head2 send_message ($msg, $dest_jid, $src, $type)
234 elmex 1.2
235     Sends a message to the destination C<$dest_jid>.
236     C<$msg> can either be a string or a L<Net::XMPP2::IM::Message> object.
237 elmex 1.15 If C<$msg> is such an object C<$dest_jid> is optional, but will, when
238 elmex 1.2 passed, override the destination of the message.
239    
240     C<$src> is optional. It specifies which account to use
241     to send the message. If it is not passed L<Net::XMPP2::Client> will try
242     to find an account itself. First it will look through all rosters
243     to find C<$dest_jid> and if none found it will pick any of the accounts that
244     are connected.
245    
246     C<$src> can either be a JID or a L<Net::XMPP2::IM::Account> object as returned
247     by C<add_account> and C<get_account>.
248    
249 elmex 1.15 C<$type> is optional but overrides the type of the message object in C<$msg>
250     if C<$msg> is such an object.
251    
252     C<$type> should be 'chat' for normal chatter. If no C<$type> is specified
253     the type of the message defaults to the value documented in L<Net::XMPP2::IM::Message>
254     (should be 'normal').
255    
256 elmex 1.2 =cut
257    
258     sub send_message {
259 elmex 1.15 my ($self, $msg, $dest_jid, $src, $type) = @_;
260 elmex 1.2
261     unless (ref $msg) {
262     $msg = Net::XMPP2::IM::Message->new (body => $msg);
263     }
264    
265     if (defined $dest_jid) {
266     my $jid = stringprep_jid $dest_jid
267     or die "send_message: \$dest_jid is not a proper JID";
268     $msg->to ($jid);
269     }
270    
271 elmex 1.15 $msg->type ($type) if defined $type;
272    
273 elmex 1.2 my $srcacc;
274     if (ref $src) {
275     $srcacc = $src;
276     } elsif (defined $src) {
277     $srcacc = $self->get_account ($src)
278     } else {
279     $srcacc = $self->find_account_for_dest_jid ($dest_jid);
280     }
281    
282     unless ($srcacc && $srcacc->is_connected) {
283     die "send_message: Couldn't get connected account for sending"
284     }
285    
286     $msg->send ($srcacc->connection)
287     }
288    
289 elmex 1.11 =head2 get_account ($jid)
290 elmex 1.2
291     Returns the L<Net::XMPP2::IM::Account> account object for the JID C<$jid>
292     if there is any such account added. (returns undef otherwise).
293    
294     =cut
295    
296     sub get_account {
297     my ($self, $jid) = @_;
298     $self->{accounts}->{prep_bare_jid $jid}
299     }
300    
301 elmex 1.11 =head2 get_accounts ()
302    
303     Returns a list of L<Net::XMPP2::IM::Account>s.
304    
305     =cut
306    
307 elmex 1.9 sub get_accounts {
308     my ($self) = @_;
309     values %{$self->{accounts}}
310     }
311    
312 elmex 1.17 =head2 get_connected_accounts ()
313 elmex 1.11
314     Returns a list of connected L<Net::XMPP2::IM::Account>s.
315    
316     Same as:
317    
318     grep { $_->is_connected } $client->get_accounts ();
319    
320     =cut
321    
322 elmex 1.7 sub get_connected_accounts {
323     my ($self, $jid) = @_;
324     my (@a) = grep $_->is_connected, values %{$self->{accounts}};
325     @a
326     }
327    
328 elmex 1.11 =head2 find_account_for_dest_jid ($jid)
329    
330     This method tries to find any account that has the contact C<$jid>
331     on his roster. If no account with C<$jid> on his roster was found
332     it takes the first one that is connected. (Return value is a L<Net::XMPP2::IM::Account>
333     object).
334    
335     If no account is connected it returns undef.
336    
337     =cut
338    
339 elmex 1.2 sub find_account_for_dest_jid {
340     my ($self, $jid) = @_;
341    
342     my $any_acc;
343     for my $acc (values %{$self->{accounts}}) {
344     next unless $acc->is_connected;
345    
346     # take "first" active account
347     $any_acc = $acc unless defined $any_acc;
348    
349     my $roster = $acc->connection ()->get_roster;
350     if (my $c = $roster->get_contact ($jid)) {
351     return $acc;
352     }
353     }
354    
355     $any_acc
356 elmex 1.1 }
357    
358 elmex 1.11 =head2 get_contacts_for_jid ($jid)
359    
360     This method returns all contacts that we are connected to.
361     That means: It joins the contact lists of all account's rosters
362     that we are connected to.
363    
364     =cut
365    
366 elmex 1.7 sub get_contacts_for_jid {
367     my ($self, $jid) = @_;
368     my @cons;
369     for ($self->get_connected_accounts) {
370     my $roster = $_->connection ()->get_roster ();
371     my $con = $roster->get_contact ($jid);
372     push @cons, $con if $con;
373     }
374     return @cons;
375     }
376    
377 elmex 1.11 =head2 get_priority_presence_for_jid ($jid)
378    
379     This method returns the presence for the contact C<$jid> with the highest
380     priority.
381    
382     If the contact C<$jid> is on multiple account's rosters it's undefined which
383     roster the presence belongs to.
384    
385     =cut
386    
387 elmex 1.8 sub get_priority_presence_for_jid {
388     my ($self, $jid) = @_;
389    
390     my $lpres;
391     for ($self->get_connected_accounts) {
392     my $roster = $_->connection ()->get_roster ();
393     my $con = $roster->get_contact ($jid);
394     next unless defined $con;
395     my $pres = $con->get_priority_presence ($jid);
396     next unless defined $pres;
397     if ((not defined $lpres) || $lpres->priority < $pres->priority) {
398     $lpres = $pres;
399     }
400     }
401    
402     $lpres
403     }
404    
405 elmex 1.11 =head2 set_presence ($show, $status, $priority)
406    
407     This sets the presence of all accounts. For a meaning of C<$show>, C<$status>
408     and C<$priority> see the description of the C<%attrs> hash in
409 elmex 1.12 C<send_presence> method of L<Net::XMPP2::Writer>.
410 elmex 1.11
411     =cut
412    
413 elmex 1.9 sub set_presence {
414     my ($self, $show, $status, $priority) = @_;
415    
416 elmex 1.18 $self->{presence} = {
417     show => $show,
418     status => $status,
419     priority => $priority
420     };
421    
422 elmex 1.9 for my $ac ($self->get_connected_accounts) {
423     my $con = $ac->connection ();
424 elmex 1.18 $con->send_presence (undef, undef, %{$self->{presence}});
425 elmex 1.9 }
426     }
427    
428 elmex 1.1 =head1 EVENTS
429    
430 elmex 1.2 In the following event descriptions the argument C<$account>
431 elmex 1.12 is always a L<Net::XMPP2::IM::Account> object.
432 elmex 1.2
433 elmex 1.5 All events from L<Net::XMPP2::IM::Connection> are forwarded to the client,
434     only that the first argument for every event is a C<$account> object.
435    
436     Aside fom those, these events can be registered on with C<reg_cb>:
437    
438 elmex 1.1 =over 4
439    
440 elmex 1.2 =item connected => $account
441    
442     This event is sent when the C<$account> was successfully connected.
443    
444 elmex 1.14 =item connect_error => $account, $reason
445 elmex 1.2
446     This event is emitted when an error occured in the connection process for the
447     account C<$account>.
448    
449     =item error => $account
450    
451     This event is emitted when any error occured while communicating
452     over the connection to the C<$account> - after a connection was established.
453    
454 elmex 1.1 =back
455    
456     =head1 AUTHOR
457    
458 elmex 1.11 Robin Redeker, C<< <elmex at ta-sa.org> >>, JID: C<< <elmex at jabber.org> >>
459 elmex 1.1
460     =head1 COPYRIGHT & LICENSE
461    
462     Copyright 2007 Robin Redeker, all rights reserved.
463    
464     This program is free software; you can redistribute it and/or modify it
465     under the same terms as Perl itself.
466    
467     =cut
468    
469     1; # End of Net::XMPP2::Client