XMPP2/Ext/OOB.pm

package Net::XMPP2::Ext::OOB;
use strict;
use Net::XMPP2::Namespaces qw/xmpp_ns/;
use Net::XMPP2::Ext;

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

=head1 NAME

Net::XMPP2::Ext::OOB - XEP-0066 Out of Band Data

=head1 SYNOPSIS

=head1 DESCRIPTION

This module provides a helper abstraction for handling out of band
data as specified in XEP-0066.

The object that is generated handles out of band data requests to and
from others.

There is are also some utility function defined to get for example the
oob info from an XML element:

=head1 FUNCTIONS

=over 4

=item B<url_from_node ($node)>

This function extracts the URL and optionally a description
field from the XML element in C<$node> (which must be a
L<Net::XMPP2::Node>).

C<$node> must be the XML node which contains the <url> and optionally <desc> element
(which is eg. a <x xmlns='jabber:x:oob'> element)!

(This method searches both, the jabber:x:oob and jabber:iq:oob namespaces for
the <url> and <desc> elements).

It returns a hash reference which should have following structure:

   {
      url  => "http://someurl.org/mycoolparty.jpg",
      desc => "That was a party!",
   }

If nothing was found this method returns nothing (undef).

=cut

sub url_from_node {
   my ($node) = @_;
   my ($url)  = $node->find_all ([qw/x_oob url/]);
   my ($desc) = $node->find_all ([qw/x_oob desc/]);
   my ($url2)  = $node->find_all ([qw/iq_oob url/]);
   my ($desc2) = $node->find_all ([qw/iq_oob desc/]);
   $url  ||= $url2;
   $desc ||= $desc2;

   defined $url
      ?  { url => $url->text, desc => ($desc ? $desc->text : undef) }
      : ()
}

=back

=head1 METHODS

=over 4

=item B<new ()>

This is the constructor, it takes no further arguments.

=cut

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

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

   $self->reg_cb (
      iq_set_request_xml => sub {
         my ($self, $con, $node) = @_;

         my $handled = 0;
         for ($node->find_all ([qw/iq_oob query/])) {
            my $url = url_from_node ($_);
            $self->event (oob_recv => $con, $node, $url);
            $handled = 1;
         }

         $handled
      }
   );
}

sub disco_feature { (xmpp_ns ('x_oob'), xmpp_ns ('iq_oob')) }

=item B<reply_success ($con, $node)>

This method replies to the sender of the oob that the URL
was retrieved successfully.

C<$con> and C<$node> are the C<$con> and C<$node> arguments
of the C<oob_recv> event you want to reply to.

=cut

sub reply_success {
   my ($self, $con, $node) = @_;
   $con->reply_iq_result ($node);
}

=item B<reply_failure ($con, $node, $type)>

This method replies to the sender that either the transfer was rejected
or it was not fount.

If the transfer was rejectes you have to set C<$type> to 'reject',
otherwise C<$type> must be 'not-found'.

C<$con> and C<$node> are the C<$con> and C<$node> arguments
of the C<oob_recv> event you want to reply to.

=cut

sub reply_failure {
   my ($self, $con, $node, $type) = @_;

   if ($type eq 'reject') {
      $con->reply_iq_error (
         $node, 'cancel', 'item-not-found', to => $node->attr ('from')
      );
   } else {
      $con->reply_iq_error (
         $node, 'modify', 'not-acceptable', to => $node->attr ('from')
      );
   }
}

=item B<send_url ($con, $jid, $url, $desc, $cb)>

This method sends a out of band file transfer request to C<$jid>.
C<$url> is the URL that the otherone has to download. C<$desc> is an optional
description string (human readable) for the file pointed at by the url and
can be undef when you don't want to transmit any description.

C<$cb> is a callback that will be called once the transfer is successful.

The first argument to the callback will either be undef in case of success
or 'reject' when the other side rejected the file or 'not-found' if the other
side was unable to download the file.

=cut

sub send_url {
   my ($self, $con, $jid, $url, $desc, $cb) = @_;

   $con->send_iq (set => { defns => iq_oob => node => {
      ns => iq_oob => name => 'query', childs => [
         { ns => iq_oob => name => 'url', childs => [ $url ] },
         { ns => iq_oob => name => 'desc', (defined $desc ? (childs => [ $desc ]) : ()) }
      ]
   }}, sub {
      my ($n, $e) = @_;
      if ($e) {
         $cb->($e->condition eq 'item-not-found' ? 'not-found' : 'reject')
            if $cb;
      } else {
         $cb->() if $cb;
      }
   }, to => $jid);
}

=back

=head1 EVENTS

These events can be registered to whith C<reg_cb>:

=over 4

=item oob_recv => $con, $node, $url

This event is generated whenever someone wants to send you a out of band data file.
C<$url> is a hash reference like it's returned by C<url_from_node>.

C<$con> is the L<Net::XMPP2::Connection> (Or L<Net::XMPP2::IM::Connection>)
the data was received from.

C<$node> is the L<Net::XMPP2::Node> of the IQ request, you can get the senders
JID from the 'from' attribute of it.

If you fetched the file successfully you have to call C<reply_success>.
If you want to reject the file or couldn't get it call C<reply_failure>.

=back

=cut

1
Revision:	1.2
Committed:	Thu Jul 26 19:45:17 2007 UTC (19 years, 2 months ago) by elmex
Branch:	MAIN
CVS Tags:	HEAD
Changes since 1.1:	+3 -3 lines
Log Message:	Fixed some bugs in OOB and registration.
#	Content
1	package Net::XMPP2::Ext::OOB;
2	use strict;
3	use Net::XMPP2::Namespaces qw/xmpp_ns/;
4	use Net::XMPP2::Ext;
5
6	our @ISA = qw/Net::XMPP2::Ext/;
7
8	=head1 NAME
9
10	Net::XMPP2::Ext::OOB - XEP-0066 Out of Band Data
11
12	=head1 SYNOPSIS
13
14	=head1 DESCRIPTION
15
16	This module provides a helper abstraction for handling out of band
17	data as specified in XEP-0066.
18
19	The object that is generated handles out of band data requests to and
20	from others.
21
22	There is are also some utility function defined to get for example the
23	oob info from an XML element:
24
25	=head1 FUNCTIONS
26
27	=over 4
28
29	=item B<url_from_node ($node)>
30
31	This function extracts the URL and optionally a description
32	field from the XML element in C<$node> (which must be a
33	L<Net::XMPP2::Node>).
34
35	C<$node> must be the XML node which contains the <url> and optionally <desc> element
36	(which is eg. a <x xmlns='jabber:x:oob'> element)!
37
38	(This method searches both, the jabber:x:oob and jabber:iq:oob namespaces for
39	the <url> and <desc> elements).
40
41	It returns a hash reference which should have following structure:
42
43	{
44	url => "http://someurl.org/mycoolparty.jpg",
45	desc => "That was a party!",
46	}
47
48	If nothing was found this method returns nothing (undef).
49
50	=cut
51
52	sub url_from_node {
53	my ($node) = @_;
54	my ($url) = $node->find_all ([qw/x_oob url/]);
55	my ($desc) = $node->find_all ([qw/x_oob desc/]);
56	my ($url2) = $node->find_all ([qw/iq_oob url/]);
57	my ($desc2) = $node->find_all ([qw/iq_oob desc/]);
58	$url \|\|= $url2;
59	$desc \|\|= $desc2;
60
61	defined $url
62	? { url => $url->text, desc => ($desc ? $desc->text : undef) }
63	: ()
64	}
65
66	=back
67
68	=head1 METHODS
69
70	=over 4
71
72	=item B<new ()>
73
74	This is the constructor, it takes no further arguments.
75
76	=cut
77
78	sub new {
79	my $this = shift;
80	my $class = ref($this) \|\| $this;
81	my $self = bless { @_ }, $class;
82	$self->init;
83	$self
84	}
85
86	sub init {
87	my ($self) = @_;
88
89	$self->reg_cb (
90	iq_set_request_xml => sub {
91	my ($self, $con, $node) = @_;
92
93	my $handled = 0;
94	for ($node->find_all ([qw/iq_oob query/])) {
95	my $url = url_from_node ($_);
96	$self->event (oob_recv => $con, $node, $url);
97	$handled = 1;
98	}
99
100	$handled
101	}
102	);
103	}
104
105	sub disco_feature { (xmpp_ns ('x_oob'), xmpp_ns ('iq_oob')) }
106
107	=item B<reply_success ($con, $node)>
108
109	This method replies to the sender of the oob that the URL
110	was retrieved successfully.
111
112	C<$con> and C<$node> are the C<$con> and C<$node> arguments
113	of the C<oob_recv> event you want to reply to.
114
115	=cut
116
117	sub reply_success {
118	my ($self, $con, $node) = @_;
119	$con->reply_iq_result ($node);
120	}
121
122	=item B<reply_failure ($con, $node, $type)>
123
124	This method replies to the sender that either the transfer was rejected
125	or it was not fount.
126
127	If the transfer was rejectes you have to set C<$type> to 'reject',
128	otherwise C<$type> must be 'not-found'.
129
130	C<$con> and C<$node> are the C<$con> and C<$node> arguments
131	of the C<oob_recv> event you want to reply to.
132
133	=cut
134
135	sub reply_failure {
136	my ($self, $con, $node, $type) = @_;
137
138	if ($type eq 'reject') {
139	$con->reply_iq_error (
140	$node, 'cancel', 'item-not-found', to => $node->attr ('from')
141	);
142	} else {
143	$con->reply_iq_error (
144	$node, 'modify', 'not-acceptable', to => $node->attr ('from')
145	);
146	}
147	}
148
149	=item B<send_url ($con, $jid, $url, $desc, $cb)>
150
151	This method sends a out of band file transfer request to C<$jid>.
152	C<$url> is the URL that the otherone has to download. C<$desc> is an optional
153	description string (human readable) for the file pointed at by the url and
154	can be undef when you don't want to transmit any description.
155
156	C<$cb> is a callback that will be called once the transfer is successful.
157
158	The first argument to the callback will either be undef in case of success
159	or 'reject' when the other side rejected the file or 'not-found' if the other
160	side was unable to download the file.
161
162	=cut
163
164	sub send_url {
165	my ($self, $con, $jid, $url, $desc, $cb) = @_;
166
167	$con->send_iq (set => { defns => iq_oob => node => {
168	ns => iq_oob => name => 'query', childs => [
169	{ ns => iq_oob => name => 'url', childs => [ $url ] },
170	{ ns => iq_oob => name => 'desc', (defined $desc ? (childs => [ $desc ]) : ()) }
171	]
172	}}, sub {
173	my ($n, $e) = @_;
174	if ($e) {
175	$cb->($e->condition eq 'item-not-found' ? 'not-found' : 'reject')
176	if $cb;
177	} else {
178	$cb->() if $cb;
179	}
180	}, to => $jid);
181	}
182
183	=back
184
185	=head1 EVENTS
186
187	These events can be registered to whith C<reg_cb>:
188
189	=over 4
190
191	=item oob_recv => $con, $node, $url
192
193	This event is generated whenever someone wants to send you a out of band data file.
194	C<$url> is a hash reference like it's returned by C<url_from_node>.
195
196	C<$con> is the L<Net::XMPP2::Connection> (Or L<Net::XMPP2::IM::Connection>)
197	the data was received from.
198
199	C<$node> is the L<Net::XMPP2::Node> of the IQ request, you can get the senders
200	JID from the 'from' attribute of it.
201
202	If you fetched the file successfully you have to call C<reply_success>.
203	If you want to reject the file or couldn't get it call C<reply_failure>.
204
205	=back
206
207	=cut
208
209	1