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