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.
#	User	Rev	Content
1	elmex	1.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	elmex	1.2	my ($url) = $node->find_all ([qw/x_oob url/]);
55			my ($desc) = $node->find_all ([qw/x_oob desc/]);
56	elmex	1.1	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	elmex	1.2	? { url => $url->text, desc => ($desc ? $desc->text : undef) }
63	elmex	1.1	: ()
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