Net/XMPP2/Client.pm

package Net::XMPP2::Client;
use strict;
use AnyEvent;
use Net::XMPP2::IM::Connection;
use Net::XMPP2::Util qw/stringprep_jid prep_bare_jid/;
use Net::XMPP2::Namespaces qw/xmpp_ns/;
use Net::XMPP2::Event;
use Net::XMPP2::IM::Account;

use XML::Twig;

sub _dumpxml {
   my $data = shift;
   my $t = XML::Twig->new;
   if ($t->safe_parse ("<deb>$data</deb>")) {
      $t->set_pretty_print ('indented');
      $t->print;
      print "\n";
   } else {
      print "[$data]\n";
   }
}

our @ISA = qw/Net::XMPP2::Event/;

=head1 NAME

Net::XMPP2::Client - A XMPP Client abstraction

=head1 SYNOPSIS

   use Net::XMPP2::Client;
   use AnyEvent;

   my $j = AnyEvent->condvar;

   my $cl = Net::XMPP2::Client->new;
   $cl->start;

   $j->wait;

=head1 DESCRIPTION

This module tries to implement a straight forward and easy to
use API to communicate with XMPP entities. L<Net::XMPP2::Client>
handles connections and timeouts and all such stuff for you.

For more flexibility please have a look at L<Net::XMPP2::Connection>
and L<Net::XMPP2::IM::Connection>, they allow you to control what
and how something is being sent more precisely.

=head1 METHODS

=head2 new (%args)

Following arguments can be passed in C<%args>:

=over 4

=back

=cut

sub new {
   my $this = shift;
   my $class = ref($this) || $this;
   my $self = { @_ };
   bless $self, $class;
   return $self;
}

=head2 add_account ($jid, $password, $host, $port)

This method adds a jabber account for connection with the JID C<$jid>
and the password C<$password>.

C<$host> and C<$port> are optional and can be undef. C<$host> overrides the
host to connect to.

Returns 1 on success and undef when the account already exists.

=cut

sub add_account {
   my ($self, $jid, $password, $host, $port) = @_;

   $jid = stringprep_jid $jid;
   my $bj = prep_bare_jid $jid;

   return if exists $self->{accounts}->{$bj};

   my $acc =
      $self->{accounts}->{$bj} =
         Net::XMPP2::IM::Account->new (
            jid      => $jid,
            password => $password,
            host     => $host,
            port     => $port,
         );

   $self->update_connections
      if $self->{started};

   $acc
}

=head2 start ()

This method initiates the connections to the XMPP servers.

=cut

sub start {
   my ($self) = @_;
   $self->{started} = 1;
   $self->update_connections;
}

sub update_connections {
   my ($self) = @_;

   for my $acc (values %{$self->{accounts}}) {
      unless ($acc->is_connected) {
         my $con = $acc->spawn_connection;

         $con->reg_cb (
            session_ready => sub {
               my ($con) = @_;
               $self->event (connected => $acc);
               warn "ADDED ACCOUNT $acc->{jid} [$con]\n";
               0 # do once
            },
            debug_recv      => sub { print "RRRRRRRRECVVVVVV:\n"; _dumpxml ($_[1]); 1 },
            debug_send      => sub { print "SSSSSSSSENDDDDDD:\n"; _dumpxml ($_[1]); 1 },
            message         => sub {
               my ($con, $msg) = @_;
               $self->event (message => $acc, $msg);
               1
            },
            roster_update => sub {
               my ($con, $roster, $contacts) = @_;
               $self->event (roster_update => $acc, $roster, $contacts);
               1
            },
            sasl_error => sub {
               my ($con, $error) = @_;
               $self->event (sasl_error => $acc, $error);
               1
            },
            presence_update => sub {
               my ($con, $roster, $contact, $old, $new) = @_;
               $self->event (presence_update => $acc, $roster, $contact, $old, $new);
               1
            }
         );

         $con->connect
            or die "Couldn't connect to ".($acc->jid).": $!";
         $con->init
      }
   }
}

=item send_message ($msg, $dest_jid, $src)

Sends a message to the destination C<$dest_jid>.
C<$msg> can either be a string or a L<Net::XMPP2::IM::Message> object.
If C<$msg> is such an object C<$dest_jid> is optional, and will, when
passed, override the destination of the message.

C<$src> is optional. It specifies which account to use
to send the message. If it is not passed L<Net::XMPP2::Client> will try
to find an account itself. First it will look through all rosters
to find C<$dest_jid> and if none found it will pick any of the accounts that
are connected.

C<$src> can either be a JID or a L<Net::XMPP2::IM::Account> object as returned
by C<add_account> and C<get_account>.

=cut

sub send_message {
   my ($self, $msg, $dest_jid, $src) = @_;

   unless (ref $msg) {
      $msg = Net::XMPP2::IM::Message->new (body => $msg);
   }

   if (defined $dest_jid) {
      my $jid = stringprep_jid $dest_jid
         or die "send_message: \$dest_jid is not a proper JID";
      $msg->to ($jid);
   }

   my $srcacc;
   if (ref $src) {
      $srcacc = $src;
   } elsif (defined $src) {
      $srcacc = $self->get_account ($src)
   } else {
      $srcacc = $self->find_account_for_dest_jid ($dest_jid);
   }

   unless ($srcacc && $srcacc->is_connected) {
      die "send_message: Couldn't get connected account for sending"
   }

   $msg->send ($srcacc->connection)
}

=item get_account ($jid)

Returns the L<Net::XMPP2::IM::Account> account object for the JID C<$jid>
if there is any such account added. (returns undef otherwise).

=cut

sub get_account {
   my ($self, $jid) = @_;
   $self->{accounts}->{prep_bare_jid $jid}
}

sub find_account_for_dest_jid {
   my ($self, $jid) = @_;

   my $any_acc;
   for my $acc (values %{$self->{accounts}}) {
      next unless $acc->is_connected;

      # take "first" active account
      $any_acc = $acc unless defined $any_acc;

      my $roster = $acc->connection ()->get_roster;
      if (my $c = $roster->get_contact ($jid)) {
         return $acc;
      }
   }

   $any_acc
}

=head1 EVENTS

These events can be registered on with C<reg_cb>:

In the following event descriptions the argument C<$account>
is always a L<Net::XMMP2::IM::Account> object.

=over 4

=item connected => $account

This event is sent when the C<$account> was successfully connected.

=item connect_error => $account

This event is emitted when an error occured in the connection process for the
account C<$account>.

=item error => $account

This event is emitted when any error occured while communicating
over the connection to the C<$account> - after a connection was established.

=item presence_update => $account, $roster, $contact, $old_presence, $new_presence

This event is emitted when a presence update was received on the C<$account>.
For a description of the other argument please look at the documentation
of the C<presence_update> event in L<Net::XMPP2::IM::Connection>.

=item message => $account, $msg

This event is emited when a message has been received on the C<$account>.
C<$msg> is a L<Net::XMPP2::IM::Message> object.

=back

=head1 AUTHOR

Robin Redeker, C<< <elmex at ta-sa.org> >>

=head1 COPYRIGHT & LICENSE

Copyright 2007 Robin Redeker, all rights reserved.

This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.

=cut

1; # End of Net::XMPP2::Client
Revision:	1.4
Committed:	Sun Apr 22 14:36:52 2007 UTC (19 years, 5 months ago) by elmex
Branch:	MAIN
Changes since 1.3:	+5 -0 lines
Log Message:	implemented addition/removal/update of roster items and first functionality for subscription.
#	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			use Net::XMPP2::Util qw/stringprep_jid prep_bare_jid/;
6			use Net::XMPP2::Namespaces qw/xmpp_ns/;
7	elmex	1.1	use Net::XMPP2::Event;
8	elmex	1.2	use Net::XMPP2::IM::Account;
9
10			use XML::Twig;
11
12			sub _dumpxml {
13			my $data = shift;
14			my $t = XML::Twig->new;
15			if ($t->safe_parse ("<deb>$data</deb>")) {
16			$t->set_pretty_print ('indented');
17			$t->print;
18			print "\n";
19			} else {
20			print "[$data]\n";
21			}
22			}
23	elmex	1.1
24			our @ISA = qw/Net::XMPP2::Event/;
25
26			=head1 NAME
27
28			Net::XMPP2::Client - A XMPP Client abstraction
29
30			=head1 SYNOPSIS
31
32			use Net::XMPP2::Client;
33			use AnyEvent;
34
35			my $j = AnyEvent->condvar;
36
37			my $cl = Net::XMPP2::Client->new;
38			$cl->start;
39
40			$j->wait;
41
42			=head1 DESCRIPTION
43
44			This module tries to implement a straight forward and easy to
45			use API to communicate with XMPP entities. L<Net::XMPP2::Client>
46			handles connections and timeouts and all such stuff for you.
47
48			For more flexibility please have a look at L<Net::XMPP2::Connection>
49			and L<Net::XMPP2::IM::Connection>, they allow you to control what
50			and how something is being sent more precisely.
51
52			=head1 METHODS
53
54			=head2 new (%args)
55
56			Following arguments can be passed in C<%args>:
57
58			=over 4
59
60			=back
61
62			=cut
63
64			sub new {
65			my $this = shift;
66			my $class = ref($this) \|\| $this;
67			my $self = { @_ };
68			bless $self, $class;
69	elmex	1.2	return $self;
70			}
71
72			=head2 add_account ($jid, $password, $host, $port)
73
74			This method adds a jabber account for connection with the JID C<$jid>
75			and the password C<$password>.
76
77			C<$host> and C<$port> are optional and can be undef. C<$host> overrides the
78			host to connect to.
79
80			Returns 1 on success and undef when the account already exists.
81
82			=cut
83
84			sub add_account {
85			my ($self, $jid, $password, $host, $port) = @_;
86
87			$jid = stringprep_jid $jid;
88			my $bj = prep_bare_jid $jid;
89
90			return if exists $self->{accounts}->{$bj};
91
92			my $acc =
93			$self->{accounts}->{$bj} =
94			Net::XMPP2::IM::Account->new (
95			jid => $jid,
96			password => $password,
97			host => $host,
98			port => $port,
99			);
100
101			$self->update_connections
102			if $self->{started};
103
104			$acc
105			}
106
107			=head2 start ()
108
109			This method initiates the connections to the XMPP servers.
110
111			=cut
112
113			sub start {
114			my ($self) = @_;
115			$self->{started} = 1;
116			$self->update_connections;
117			}
118
119			sub update_connections {
120			my ($self) = @_;
121	elmex	1.1
122	elmex	1.2	for my $acc (values %{$self->{accounts}}) {
123			unless ($acc->is_connected) {
124			my $con = $acc->spawn_connection;
125
126			$con->reg_cb (
127			session_ready => sub {
128			my ($con) = @_;
129			$self->event (connected => $acc);
130			warn "ADDED ACCOUNT $acc->{jid} [$con]\n";
131			0 # do once
132			},
133			debug_recv => sub { print "RRRRRRRRECVVVVVV:\n"; _dumpxml ($_[1]); 1 },
134			debug_send => sub { print "SSSSSSSSENDDDDDD:\n"; _dumpxml ($_[1]); 1 },
135			message => sub {
136			my ($con, $msg) = @_;
137			$self->event (message => $acc, $msg);
138			1
139			},
140	elmex	1.4	roster_update => sub {
141			my ($con, $roster, $contacts) = @_;
142			$self->event (roster_update => $acc, $roster, $contacts);
143			1
144			},
145	elmex	1.3	sasl_error => sub {
146			my ($con, $error) = @_;
147			$self->event (sasl_error => $acc, $error);
148			1
149			},
150	elmex	1.2	presence_update => sub {
151			my ($con, $roster, $contact, $old, $new) = @_;
152			$self->event (presence_update => $acc, $roster, $contact, $old, $new);
153			1
154			}
155			);
156
157			$con->connect
158			or die "Couldn't connect to ".($acc->jid).": $!";
159			$con->init
160			}
161			}
162			}
163
164			=item send_message ($msg, $dest_jid, $src)
165
166			Sends a message to the destination C<$dest_jid>.
167			C<$msg> can either be a string or a L<Net::XMPP2::IM::Message> object.
168			If C<$msg> is such an object C<$dest_jid> is optional, and will, when
169			passed, override the destination of the message.
170
171			C<$src> is optional. It specifies which account to use
172			to send the message. If it is not passed L<Net::XMPP2::Client> will try
173			to find an account itself. First it will look through all rosters
174			to find C<$dest_jid> and if none found it will pick any of the accounts that
175			are connected.
176
177			C<$src> can either be a JID or a L<Net::XMPP2::IM::Account> object as returned
178			by C<add_account> and C<get_account>.
179
180			=cut
181
182			sub send_message {
183			my ($self, $msg, $dest_jid, $src) = @_;
184
185			unless (ref $msg) {
186			$msg = Net::XMPP2::IM::Message->new (body => $msg);
187			}
188
189			if (defined $dest_jid) {
190			my $jid = stringprep_jid $dest_jid
191			or die "send_message: \$dest_jid is not a proper JID";
192			$msg->to ($jid);
193			}
194
195			my $srcacc;
196			if (ref $src) {
197			$srcacc = $src;
198			} elsif (defined $src) {
199			$srcacc = $self->get_account ($src)
200			} else {
201			$srcacc = $self->find_account_for_dest_jid ($dest_jid);
202			}
203
204			unless ($srcacc && $srcacc->is_connected) {
205			die "send_message: Couldn't get connected account for sending"
206			}
207
208			$msg->send ($srcacc->connection)
209			}
210
211			=item get_account ($jid)
212
213			Returns the L<Net::XMPP2::IM::Account> account object for the JID C<$jid>
214			if there is any such account added. (returns undef otherwise).
215
216			=cut
217
218			sub get_account {
219			my ($self, $jid) = @_;
220			$self->{accounts}->{prep_bare_jid $jid}
221			}
222
223			sub find_account_for_dest_jid {
224			my ($self, $jid) = @_;
225
226			my $any_acc;
227			for my $acc (values %{$self->{accounts}}) {
228			next unless $acc->is_connected;
229
230			# take "first" active account
231			$any_acc = $acc unless defined $any_acc;
232
233			my $roster = $acc->connection ()->get_roster;
234			if (my $c = $roster->get_contact ($jid)) {
235			return $acc;
236			}
237			}
238
239			$any_acc
240	elmex	1.1	}
241
242			=head1 EVENTS
243
244			These events can be registered on with C<reg_cb>:
245
246	elmex	1.2	In the following event descriptions the argument C<$account>
247			is always a L<Net::XMMP2::IM::Account> object.
248
249	elmex	1.1	=over 4
250
251	elmex	1.2	=item connected => $account
252
253			This event is sent when the C<$account> was successfully connected.
254
255			=item connect_error => $account
256
257			This event is emitted when an error occured in the connection process for the
258			account C<$account>.
259
260			=item error => $account
261
262			This event is emitted when any error occured while communicating
263			over the connection to the C<$account> - after a connection was established.
264
265			=item presence_update => $account, $roster, $contact, $old_presence, $new_presence
266	elmex	1.1
267	elmex	1.2	This event is emitted when a presence update was received on the C<$account>.
268			For a description of the other argument please look at the documentation
269			of the C<presence_update> event in L<Net::XMPP2::IM::Connection>.
270	elmex	1.1
271	elmex	1.2	=item message => $account, $msg
272	elmex	1.1
273	elmex	1.2	This event is emited when a message has been received on the C<$account>.
274			C<$msg> is a L<Net::XMPP2::IM::Message> object.
275	elmex	1.1
276			=back
277
278			=head1 AUTHOR
279
280			Robin Redeker, C<< <elmex at ta-sa.org> >>
281
282			=head1 COPYRIGHT & LICENSE
283
284			Copyright 2007 Robin Redeker, all rights reserved.
285
286			This program is free software; you can redistribute it and/or modify it
287			under the same terms as Perl itself.
288
289			=cut
290
291			1; # End of Net::XMPP2::Client