XMPP2/Ext/Registration.pm

package Net::XMPP2::Ext::Registration;
use strict;
use Net::XMPP2::Util;
use Net::XMPP2::Namespaces qw/xmpp_ns/;
use Net::XMPP2::Ext::RegisterForm;

=head1 NAME

Net::XMPP2::Ext::Registration - Handles all tasks of in band registration

=head1 SYNOPSIS

   my $con = Net::XMPP2::Connection->new (...);

   $con->reg_cb (stream_pre_authentication => sub {
      my ($con, $rcont) = @_;

      my $reg = Net::XMPP2::Ext::Registration->new;
      $reg->send_registration_request ($con, sub {
         my ($reg, $con, $form, $error) = @_;

         if ($form) {
            my $res = $form->try_fillout_registration ('myusername', 'mypassword');

            $reg->submit_form ($con, $res, sub {
               my ($reg, $con, $ok, $error) = @_;

               if ($ok) {
                  $con->authenticate; # just make sure the connection knows your
                                      # username and password :-)
               } else {
                  print "error: " . $error->string . "\n";
               }
            });

         } else {
            print "error: " . $error->string . "\n";
         }
      });

      $$rcont = 0;
      0
   });

=head1 DESCRIPTION

This module handles all tasks of in band registration that are possible and
specified by XEP-0077. It's mainly a helper class that eases some tasks such
as submitting and retrieving a form.

=cut

=head1 METHODS

=over 4

=item B<new (%args)>

This is the constructor for a registration object.

=over 4

=item connection

This must be a L<Net::XMPP2::Connection> (or some other subclass of that) object.

This argument is required.

=back

=cut

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

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

=item B<send_registration_request ($cb)>

This method sends a register form request.
C<$cb> will be called when either the form arrived or
an error occured.

The first argument of C<$cb> is always C<$self>.
If the form arrived the second argument of C<$cb> will be
a L<Net::XMPP2::Ext::RegisterForm> object.
If an error occured the second argument will be undef
and the third argument will be a L<Net::XMPP2::Error::Register>
object.

For hints how L<Net::XMPP2::Ext::RegisterForm> should be filled
out look in XEP-0077. Either you have legacy form fields, out of band
data or a data form.

See also L<try_fillout_registration> in L<Net::XMPP2::Ext::RegisterForm>.

=cut

sub send_registration_request {
   my ($self, $cb) = @_;

   my $con = $self->{connection};

   $con->send_iq (get => {
      defns => 'register',
      node => { ns => 'register', name => 'query' }
   }, sub {
      my ($node, $error) = @_;

      my $form;
      if ($node) {
         $form = Net::XMPP2::Ext::RegisterForm->new;
         $form->init_from_node ($node);
      } else {
         $error =
            Net::XMPP2::Error::Register->new (
               node => $error->xml_node, register_state => 'register'
            );
      }

      $cb->($self, $form, $error);
   });
}

=item B<send_unregistration_request>

=cut

sub _error_or_form_cb {
   my ($self, $e, $cb) = @_;

   my $e = $e->xml_node;

   my $error =
      Net::XMPP2::Error::Register->new (
         node => $e, register_state => 'submit'
      );

   if ($e->find_all ([qw/register query/], [qw/data_form x/])) {
      my $form = Net::XMPP2::Ext::RegisterForm->new;
      $form->init_from_node ($e);

      $cb->($self, 0, $error, $form)
   } else {
      $cb->($self, 0, $error)
   }
}

sub send_unregistration_request {
   my ($self, $cb) = @_;

   my $con = $self->{connection};

   $con->send_iq (set => {
      defns => 'register',
      node => { ns => 'register', name => 'query', childs => [
         { ns => 'register', name => 'remove' }
      ]}
   }, sub {
      my ($node, $error) = @_;
      if ($node) {
         $cb->($self, 1)
      } else {
         $self->_error_or_form_cb ($error, $cb);
      }
   });
}

sub send_password_change_request {
   my ($self, $username, $password, $cb) = @_;

   my $con = $self->{connection};

   $con->send_iq (set => {
      defns => 'register',
      node => { ns => 'register', name => 'query', childs => [
         { ns => 'register', name => 'username', childs => [ $username ] },
         { ns => 'register', name => 'password', childs => [ $password ] },
      ]}
   }, sub {
      my ($node, $error) = @_;
      if ($node) {
         $cb->($self, 1)
      } else {
         $self->_error_or_form_cb ($error, $cb);
      }
   });
}

=item B<submit_form ($form, $cb)>

This method submits the C<$form> which should be of
type L<Net::XMPP2::Ext::RegisterForm> and should be an answer
form.

C<$con> is the connection on which to send this form.

C<$cb> is the callback that will be called once the form has been submitted and
either an error or success was received.  The first argument to the callback
will be the L<Net::XMPP2::Ext::Registration> object, the second will be a
boolean value that is true when the form was successfully transmitted and
everything is fine.  If the second argument is false then the third argument is
a L<Net::XMPP2::Error::Register> object.  If the error contained a data form
which is required to successfully make the request then the fourth argument
will be a L<Net::XMPP2::Ext::RegisterForm> which you should fill out and send
again with C<submit_form>.

For the semantics of such an error form see also XEP-0077.

=cut

sub submit_form {
   my ($self, $form, $cb) = @_;

   my $con = $self->{connection};

   $con->send_iq (set => {
      defns => 'register',
      node => { ns => 'register', name => 'quert', childs => [
         $form->answer_form_to_simxml
      ]}
   }, sub {
      my ($n, $e) = @_;

      if ($n) {
         $cb->($self, 1)
      } else {
         $self->_error_or_form_cb ($e, $cb);
      }
   });
}

=back

=head1 AUTHOR

Robin Redeker, C<< <elmex at ta-sa.org> >>, JID: C<< <elmex at jabber.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::Ext::Registration
Revision:	1.7
Committed:	Thu Jul 26 19:45:18 2007 UTC (19 years, 2 months ago) by elmex
Branch:	MAIN
Changes since 1.6:	+4 -2 lines
Log Message:	Fixed some bugs in OOB and registration.
#	User	Rev	Content
1	elmex	1.1	package Net::XMPP2::Ext::Registration;
2			use strict;
3			use Net::XMPP2::Util;
4			use Net::XMPP2::Namespaces qw/xmpp_ns/;
5	elmex	1.4	use Net::XMPP2::Ext::RegisterForm;
6	elmex	1.1
7			=head1 NAME
8
9			Net::XMPP2::Ext::Registration - Handles all tasks of in band registration
10
11			=head1 SYNOPSIS
12
13			my $con = Net::XMPP2::Connection->new (...);
14
15			$con->reg_cb (stream_pre_authentication => sub {
16			my ($con, $rcont) = @_;
17
18			my $reg = Net::XMPP2::Ext::Registration->new;
19			$reg->send_registration_request ($con, sub {
20			my ($reg, $con, $form, $error) = @_;
21
22			if ($form) {
23			my $res = $form->try_fillout_registration ('myusername', 'mypassword');
24
25			$reg->submit_form ($con, $res, sub {
26			my ($reg, $con, $ok, $error) = @_;
27
28			if ($ok) {
29			$con->authenticate; # just make sure the connection knows your
30			# username and password :-)
31			} else {
32			print "error: " . $error->string . "\n";
33			}
34			});
35
36			} else {
37			print "error: " . $error->string . "\n";
38			}
39			});
40
41			$$rcont = 0;
42			0
43			});
44
45			=head1 DESCRIPTION
46
47	elmex	1.6	This module handles all tasks of in band registration that are possible and
48			specified by XEP-0077. It's mainly a helper class that eases some tasks such
49			as submitting and retrieving a form.
50	elmex	1.1
51			=cut
52
53			=head1 METHODS
54
55			=over 4
56
57			=item B<new (%args)>
58
59			This is the constructor for a registration object.
60
61			=over 4
62
63			=item connection
64
65			This must be a L<Net::XMPP2::Connection> (or some other subclass of that) object.
66
67			This argument is required.
68
69			=back
70
71			=cut
72
73			sub new {
74			my $this = shift;
75			my $class = ref($this) \|\| $this;
76			my $self = bless { @_ }, $class;
77			$self->init;
78			$self
79			}
80
81			sub init {
82			my ($self) = @_;
83	elmex	1.6	#...
84	elmex	1.1	}
85
86	elmex	1.6	=item B<send_registration_request ($cb)>
87	elmex	1.1
88			This method sends a register form request.
89			C<$cb> will be called when either the form arrived or
90			an error occured.
91
92			The first argument of C<$cb> is always C<$self>.
93			If the form arrived the second argument of C<$cb> will be
94			a L<Net::XMPP2::Ext::RegisterForm> object.
95			If an error occured the second argument will be undef
96			and the third argument will be a L<Net::XMPP2::Error::Register>
97			object.
98
99	elmex	1.6	For hints how L<Net::XMPP2::Ext::RegisterForm> should be filled
100			out look in XEP-0077. Either you have legacy form fields, out of band
101			data or a data form.
102
103			See also L<try_fillout_registration> in L<Net::XMPP2::Ext::RegisterForm>.
104
105	elmex	1.1	=cut
106
107			sub send_registration_request {
108	elmex	1.6	my ($self, $cb) = @_;
109
110			my $con = $self->{connection};
111	elmex	1.1
112	elmex	1.3	$con->send_iq (get => {
113			defns => 'register',
114			node => { ns => 'register', name => 'query' }
115			}, sub {
116			my ($node, $error) = @_;
117
118			my $form;
119			if ($node) {
120			$form = Net::XMPP2::Ext::RegisterForm->new;
121			$form->init_from_node ($node);
122	elmex	1.6	} else {
123			$error =
124			Net::XMPP2::Error::Register->new (
125			node => $error->xml_node, register_state => 'register'
126			);
127	elmex	1.3	}
128	elmex	1.1
129	elmex	1.6	$cb->($self, $form, $error);
130	elmex	1.3	});
131			}
132	elmex	1.1
133	elmex	1.6	=item B<send_unregistration_request>
134
135			=cut
136
137			sub _error_or_form_cb {
138	elmex	1.7	my ($self, $e, $cb) = @_;
139
140			my $e = $e->xml_node;
141	elmex	1.6
142			my $error =
143			Net::XMPP2::Error::Register->new (
144	elmex	1.7	node => $e, register_state => 'submit'
145	elmex	1.6	);
146
147			if ($e->find_all ([qw/register query/], [qw/data_form x/])) {
148			my $form = Net::XMPP2::Ext::RegisterForm->new;
149			$form->init_from_node ($e);
150
151			$cb->($self, 0, $error, $form)
152			} else {
153			$cb->($self, 0, $error)
154			}
155			}
156
157			sub send_unregistration_request {
158			my ($self, $cb) = @_;
159
160			my $con = $self->{connection};
161
162			$con->send_iq (set => {
163			defns => 'register',
164			node => { ns => 'register', name => 'query', childs => [
165			{ ns => 'register', name => 'remove' }
166			]}
167			}, sub {
168			my ($node, $error) = @_;
169			if ($node) {
170			$cb->($self, 1)
171			} else {
172			$self->_error_or_form_cb ($error, $cb);
173			}
174			});
175			}
176
177			sub send_password_change_request {
178			my ($self, $username, $password, $cb) = @_;
179
180			my $con = $self->{connection};
181
182			$con->send_iq (set => {
183			defns => 'register',
184			node => { ns => 'register', name => 'query', childs => [
185			{ ns => 'register', name => 'username', childs => [ $username ] },
186			{ ns => 'register', name => 'password', childs => [ $password ] },
187			]}
188			}, sub {
189			my ($node, $error) = @_;
190			if ($node) {
191			$cb->($self, 1)
192			} else {
193			$self->_error_or_form_cb ($error, $cb);
194			}
195			});
196			}
197
198			=item B<submit_form ($form, $cb)>
199
200			This method submits the C<$form> which should be of
201			type L<Net::XMPP2::Ext::RegisterForm> and should be an answer
202			form.
203
204			C<$con> is the connection on which to send this form.
205
206			C<$cb> is the callback that will be called once the form has been submitted and
207			either an error or success was received. The first argument to the callback
208			will be the L<Net::XMPP2::Ext::Registration> object, the second will be a
209			boolean value that is true when the form was successfully transmitted and
210			everything is fine. If the second argument is false then the third argument is
211			a L<Net::XMPP2::Error::Register> object. If the error contained a data form
212			which is required to successfully make the request then the fourth argument
213			will be a L<Net::XMPP2::Ext::RegisterForm> which you should fill out and send
214			again with C<submit_form>.
215
216			For the semantics of such an error form see also XEP-0077.
217	elmex	1.1
218	elmex	1.5	=cut
219
220			sub submit_form {
221	elmex	1.6	my ($self, $form, $cb) = @_;
222
223			my $con = $self->{connection};
224
225			$con->send_iq (set => {
226			defns => 'register',
227			node => { ns => 'register', name => 'quert', childs => [
228			$form->answer_form_to_simxml
229			]}
230			}, sub {
231			my ($n, $e) = @_;
232
233			if ($n) {
234			$cb->($self, 1)
235			} else {
236			$self->_error_or_form_cb ($e, $cb);
237			}
238			});
239	elmex	1.5	}
240
241	elmex	1.2	=back
242
243	elmex	1.1	=head1 AUTHOR
244
245			Robin Redeker, C<< <elmex at ta-sa.org> >>, JID: C<< <elmex at jabber.org> >>
246
247			=head1 COPYRIGHT & LICENSE
248
249			Copyright 2007 Robin Redeker, all rights reserved.
250
251			This program is free software; you can redistribute it and/or modify it
252			under the same terms as Perl itself.
253
254			=cut
255
256			1; # End of Net::XMPP2::Ext::Registration