1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272
|
package AnyEvent::XMPP::Ext::Registration;
use strict;
use AnyEvent::XMPP::Util;
use AnyEvent::XMPP::Namespaces qw/xmpp_ns/;
use AnyEvent::XMPP::Ext::RegisterForm;
=head1 NAME
AnyEvent::XMPP::Ext::Registration - Handles all tasks of in band registration
=head1 SYNOPSIS
my $con = AnyEvent::XMPP::Connection->new (...);
$con->reg_cb (stream_pre_authentication => sub {
my ($con) = @_;
my $reg = AnyEvent::XMPP::Ext::Registration->new (connection => $con);
$reg->send_registration_request (sub {
my ($reg, $form, $error) = @_;
if ($error) {
# error handling
} else {
my $af = $form->try_fillout_registration ("tester", "secret");
$reg->submit_form ($af, sub {
my ($reg, $ok, $error, $form) = @_;
if ($ok) { # registered successfully!
$con->authenticate
} else { # error
if ($form) { # we got an alternative form!
# fill it out and submit it with C<submit_form> again
}
}
});
}
});
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<AnyEvent::XMPP::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<AnyEvent::XMPP::Ext::RegisterForm> object.
If an error occured the second argument will be undef
and the third argument will be a L<AnyEvent::XMPP::Error::Register>
object.
For hints how L<AnyEvent::XMPP::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<AnyEvent::XMPP::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 = AnyEvent::XMPP::Ext::RegisterForm->new;
$form->init_from_node ($node);
} else {
$error =
AnyEvent::XMPP::Error::Register->new (
node => $error->xml_node, register_state => 'register'
);
}
$cb->($self, $form, $error);
});
}
sub _error_or_form_cb {
my ($self, $e, $cb) = @_;
$e = $e->xml_node;
my $error =
AnyEvent::XMPP::Error::Register->new (
node => $e, register_state => 'submit'
);
if ($e->find_all ([qw/register query/], [qw/data_form x/])) {
my $form = AnyEvent::XMPP::Ext::RegisterForm->new;
$form->init_from_node ($e);
$cb->($self, 0, $error, $form)
} else {
$cb->($self, 0, $error, undef)
}
}
=item B<send_unregistration_request ($cb)>
This method sends an unregistration request.
For description of the semantics of the callback in C<$cb>
plase look in the description of the C<submit_form> method below.
=cut
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);
}
});
}
=item B<send_password_change_request ($username, $password, $cb)>
This method sends a password change request for the user C<$username>
with the new password C<$password>.
For description of the semantics of the callback in C<$cb>
plase look in the description of the C<submit_form> method below.
=cut
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, undef, undef)
} 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<AnyEvent::XMPP::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<AnyEvent::XMPP::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<AnyEvent::XMPP::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<AnyEvent::XMPP::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 => 'query', childs => [
$form->answer_form_to_simxml
]}
}, sub {
my ($n, $e) = @_;
if ($n) {
$cb->($self, 1, undef, undef)
} 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, 2008 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 AnyEvent::XMPP::Ext::Registration
|