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, $error, $cb) = @_;

   my $error =
      Net::XMPP2::Error::Register->new (
         node => $e->xml_node, 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.6
Committed:	Thu Jul 26 19:45:13 2007 UTC (19 years, 2 months ago) by elmex
Branch:	MAIN
Changes since 1.5:	+120 -10 lines
Log Message:	Finally implemented the last parts of in band registration. Let me call it 'in band frustration'!
#	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			my ($self, $error, $cb) = @_;
139
140			my $error =
141			Net::XMPP2::Error::Register->new (
142			node => $e->xml_node, register_state => 'submit'
143			);
144
145			if ($e->find_all ([qw/register query/], [qw/data_form x/])) {
146			my $form = Net::XMPP2::Ext::RegisterForm->new;
147			$form->init_from_node ($e);
148
149			$cb->($self, 0, $error, $form)
150			} else {
151			$cb->($self, 0, $error)
152			}
153			}
154
155			sub send_unregistration_request {
156			my ($self, $cb) = @_;
157
158			my $con = $self->{connection};
159
160			$con->send_iq (set => {
161			defns => 'register',
162			node => { ns => 'register', name => 'query', childs => [
163			{ ns => 'register', name => 'remove' }
164			]}
165			}, sub {
166			my ($node, $error) = @_;
167			if ($node) {
168			$cb->($self, 1)
169			} else {
170			$self->_error_or_form_cb ($error, $cb);
171			}
172			});
173			}
174
175			sub send_password_change_request {
176			my ($self, $username, $password, $cb) = @_;
177
178			my $con = $self->{connection};
179
180			$con->send_iq (set => {
181			defns => 'register',
182			node => { ns => 'register', name => 'query', childs => [
183			{ ns => 'register', name => 'username', childs => [ $username ] },
184			{ ns => 'register', name => 'password', childs => [ $password ] },
185			]}
186			}, sub {
187			my ($node, $error) = @_;
188			if ($node) {
189			$cb->($self, 1)
190			} else {
191			$self->_error_or_form_cb ($error, $cb);
192			}
193			});
194			}
195
196			=item B<submit_form ($form, $cb)>
197
198			This method submits the C<$form> which should be of
199			type L<Net::XMPP2::Ext::RegisterForm> and should be an answer
200			form.
201
202			C<$con> is the connection on which to send this form.
203
204			C<$cb> is the callback that will be called once the form has been submitted and
205			either an error or success was received. The first argument to the callback
206			will be the L<Net::XMPP2::Ext::Registration> object, the second will be a
207			boolean value that is true when the form was successfully transmitted and
208			everything is fine. If the second argument is false then the third argument is
209			a L<Net::XMPP2::Error::Register> object. If the error contained a data form
210			which is required to successfully make the request then the fourth argument
211			will be a L<Net::XMPP2::Ext::RegisterForm> which you should fill out and send
212			again with C<submit_form>.
213
214			For the semantics of such an error form see also XEP-0077.
215	elmex	1.1
216	elmex	1.5	=cut
217
218			sub submit_form {
219	elmex	1.6	my ($self, $form, $cb) = @_;
220
221			my $con = $self->{connection};
222
223			$con->send_iq (set => {
224			defns => 'register',
225			node => { ns => 'register', name => 'quert', childs => [
226			$form->answer_form_to_simxml
227			]}
228			}, sub {
229			my ($n, $e) = @_;
230
231			if ($n) {
232			$cb->($self, 1)
233			} else {
234			$self->_error_or_form_cb ($e, $cb);
235			}
236			});
237	elmex	1.5	}
238
239	elmex	1.2	=back
240
241	elmex	1.1	=head1 AUTHOR
242
243			Robin Redeker, C<< <elmex at ta-sa.org> >>, JID: C<< <elmex at jabber.org> >>
244
245			=head1 COPYRIGHT & LICENSE
246
247			Copyright 2007 Robin Redeker, all rights reserved.
248
249			This program is free software; you can redistribute it and/or modify it
250			under the same terms as Perl itself.
251
252			=cut
253
254			1; # End of Net::XMPP2::Ext::Registration