XMPP2/Ext/RegisterForm.pm

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

=head1 NAME

Net::XMPP2::Ext::RegisterForm - Handle for in band registration

=head1 SYNOPSIS

   my $con = Net::XMPP2::Connection->new (...);
   ...
   $con->do_in_band_register (sub {
      my ($form, $error) = @_;
      if ($error) { print "ERROR: ".$error->string."\n" }
      else {
         if ($form->type eq 'simple') {
            if ($form->has_field ('username') && $form->has_field ('password')) {
               $form->set_field (
                  username => 'test',
                  password => 'qwerty',
               );
               $form->submit (sub {
                  my ($form, $error) = @_;
                  if ($error) { print "SUBMIT ERROR: ".$error->string."\n" }
                  else {
                     print "Successfully registered as ".$form->field ('username')."\n"
                  }
               });
            } else {
               print "Couldn't fill out the form: " . $form->field ('instructions') ."\n";
            }
         } elsif ($form->type eq 'data_form' {
            my $dform = $form->data_form;
            ... fill out the form $dform (of type Net::XMPP2::DataForm) ...
            $form->submit_data_form ($dform, sub {
               my ($form, $error) = @_;
               if ($error) { print "DATA FORM SUBMIT ERROR: ".$error->string."\n" }
               else {
                  print "Successfully registered as ".$form->field ('username')."\n"
               }
            })
         }
      }
   });

=head1 DESCRIPTION

This module represents an in band registration form
which can be filled out and submitted.

You can get an instance of this class only by requesting it
from a L<Net::XMPP2::Connection> by calling the C<request_inband_register_form>
method.

=cut

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

sub _get_legacy_form {
   my ($self, $node) = @_;

   my $form = {};

   for ($node->nodes) {
      if ($_->eq_ns ('register')) {
         $form->{$_->name} = $_->text;
      }
   }

   $form
}

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

   my $form;
   my $nform;

   if (my $df = $self->get_data_form) {
      my $af = Net::XMPP2::Ext::DataForm->new;
      $af->make_answer_form ($df);
      $af->set_field_value (username => $username);
      $af->set_field_value (password => $password);
      $nform = $af;

   } else {
      my $frm = $self->get_standard_form_fields;
      $form = {
         username => $username,
         password => $password
      };
   }

   return
      Net::XMPP2::Ext::RegisterForm->new (
         data_form   => $nform,
         legacy_form => $form,
         answered    => 1
      );
}

sub is_answer_form {
   my ($self) = @_;
   $self->{answered}
}

sub is_already_registered {
   my ($self) = @_;
   exists $self->{legacy_form}
   && exists $self->{legacy_form}->{registered}
}

sub init_new_form {
   my ($self, $node) = @_;

   my (@x) = $node->find_all ([qw/register query/], [qw/data_form x/]);

   if (@x) {
      my $df = Net::XMPP2::Ext::DataForm->new;
      $df->from_node (@x);
      $self->{data_form} = $df;

   } else {
      die "TODO!";
   }
}


=item B<get_legacy_form_fields>

This method returns a hash with....
as specified in the in band registration XEP.

=cut

sub get_legacy_form_fields {
   my ($self) = @_;
   $self->{legacy_form}
}

=item B<get_data_form>

This method returns the L<Net::XMPP2::Ext::DataForm> that came
with the registration response. If no data form was provided by the
server this method returns undef.

=cut

sub get_data_form {
   my ($self) = @_;
   $self->{data_form}
}


=item B<get_oob>

This method returns a hash like the one returned from
the function C<url_from_node> in L<Net::XMPP2::Ext::OOB>.
It contains the out of band data for this registration form.

=cut

sub get_oob {
   my ($self) = @_;
   $self->{oob}
}

sub init_from_node {
   my ($self, $node) = @_;

   if ($node->find_all ([qw/register query/], [qw/data_form x/])) {
      $self->init_new_form ($node);
   }
   if (my ($xoob) = $node->find_all ([qw/register query/], [qw/oob x/])) {
      $self->{oob} = Net::XMPP2::Ext::OOB->url_from_node ($xoob);
   }

   my $form = $self->_get_legacy_form ($node);
   $self->{legacy_form} = $form;
}

=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::RegisterForm
Revision:	1.7
Committed:	Wed Jul 25 21:29:12 2007 UTC (19 years, 2 months ago) by elmex
Branch:	MAIN
Changes since 1.6:	+2 -1 lines
Log Message:	fixed small thing in register form
#	User	Rev	Content
1	elmex	1.5	package Net::XMPP2::Ext::RegisterForm;
2	elmex	1.1	use strict;
3			use Net::XMPP2::Util;
4			use Net::XMPP2::Namespaces qw/xmpp_ns/;
5	elmex	1.5	use Net::XMPP2::Ext::DataForm;
6	elmex	1.6	use Net::XMPP2::Ext::OOB;
7	elmex	1.1
8			=head1 NAME
9
10	elmex	1.5	Net::XMPP2::Ext::RegisterForm - Handle for in band registration
11	elmex	1.1
12			=head1 SYNOPSIS
13
14			my $con = Net::XMPP2::Connection->new (...);
15			...
16			$con->do_in_band_register (sub {
17			my ($form, $error) = @_;
18			if ($error) { print "ERROR: ".$error->string."\n" }
19			else {
20			if ($form->type eq 'simple') {
21			if ($form->has_field ('username') && $form->has_field ('password')) {
22			$form->set_field (
23			username => 'test',
24			password => 'qwerty',
25			);
26			$form->submit (sub {
27			my ($form, $error) = @_;
28			if ($error) { print "SUBMIT ERROR: ".$error->string."\n" }
29			else {
30			print "Successfully registered as ".$form->field ('username')."\n"
31			}
32			});
33			} else {
34			print "Couldn't fill out the form: " . $form->field ('instructions') ."\n";
35			}
36			} elsif ($form->type eq 'data_form' {
37			my $dform = $form->data_form;
38			... fill out the form $dform (of type Net::XMPP2::DataForm) ...
39			$form->submit_data_form ($dform, sub {
40			my ($form, $error) = @_;
41			if ($error) { print "DATA FORM SUBMIT ERROR: ".$error->string."\n" }
42			else {
43			print "Successfully registered as ".$form->field ('username')."\n"
44			}
45			})
46			}
47			}
48			});
49
50			=head1 DESCRIPTION
51
52			This module represents an in band registration form
53			which can be filled out and submitted.
54
55			You can get an instance of this class only by requesting it
56			from a L<Net::XMPP2::Connection> by calling the C<request_inband_register_form>
57			method.
58
59			=cut
60
61			sub new {
62			my $this = shift;
63			my $class = ref($this) \|\| $this;
64			my $self = bless { @_ }, $class;
65			$self
66			}
67
68	elmex	1.6	sub _get_legacy_form {
69	elmex	1.4	my ($self, $node) = @_;
70
71			my $form = {};
72
73			for ($node->nodes) {
74			if ($_->eq_ns ('register')) {
75			$form->{$_->name} = $_->text;
76			}
77			}
78
79			$form
80			}
81
82			sub try_fillout_registration {
83			my ($self, $username, $password) = @_;
84
85			my $form;
86			my $nform;
87	elmex	1.6
88	elmex	1.4	if (my $df = $self->get_data_form) {
89			my $af = Net::XMPP2::Ext::DataForm->new;
90			$af->make_answer_form ($df);
91			$af->set_field_value (username => $username);
92			$af->set_field_value (password => $password);
93			$nform = $af;
94
95			} else {
96			my $frm = $self->get_standard_form_fields;
97			$form = {
98			username => $username,
99			password => $password
100			};
101			}
102
103			return
104			Net::XMPP2::Ext::RegisterForm->new (
105	elmex	1.6	data_form => $nform,
106			legacy_form => $form,
107			answered => 1
108	elmex	1.4	);
109			}
110
111			sub is_answer_form {
112			my ($self) = @_;
113			$self->{answered}
114			}
115
116			sub is_already_registered {
117	elmex	1.1	my ($self) = @_;
118	elmex	1.7	exists $self->{legacy_form}
119			&& exists $self->{legacy_form}->{registered}
120	elmex	1.4	}
121
122			sub init_new_form {
123			my ($self, $node) = @_;
124
125	elmex	1.5	my (@x) = $node->find_all ([qw/register query/], [qw/data_form x/]);
126	elmex	1.4
127			if (@x) {
128			my $df = Net::XMPP2::Ext::DataForm->new;
129			$df->from_node (@x);
130	elmex	1.6	$self->{data_form} = $df;
131	elmex	1.4
132			} else {
133			die "TODO!";
134			}
135			}
136
137	elmex	1.6
138			=item B<get_legacy_form_fields>
139
140			This method returns a hash with....
141			as specified in the in band registration XEP.
142
143			=cut
144
145			sub get_legacy_form_fields {
146	elmex	1.4	my ($self) = @_;
147	elmex	1.6	$self->{legacy_form}
148	elmex	1.4	}
149
150	elmex	1.6	=item B<get_data_form>
151
152			This method returns the L<Net::XMPP2::Ext::DataForm> that came
153			with the registration response. If no data form was provided by the
154			server this method returns undef.
155
156			=cut
157
158	elmex	1.4	sub get_data_form {
159			my ($self) = @_;
160	elmex	1.6	$self->{data_form}
161			}
162
163
164			=item B<get_oob>
165
166			This method returns a hash like the one returned from
167			the function C<url_from_node> in L<Net::XMPP2::Ext::OOB>.
168			It contains the out of band data for this registration form.
169
170			=cut
171
172			sub get_oob {
173			my ($self) = @_;
174			$self->{oob}
175	elmex	1.4	}
176
177			sub init_from_node {
178			my ($self, $node) = @_;
179	elmex	1.1
180	elmex	1.5	if ($node->find_all ([qw/register query/], [qw/data_form x/])) {
181	elmex	1.4	$self->init_new_form ($node);
182			}
183	elmex	1.6	if (my ($xoob) = $node->find_all ([qw/register query/], [qw/oob x/])) {
184			$self->{oob} = Net::XMPP2::Ext::OOB->url_from_node ($xoob);
185			}
186
187			my $form = $self->_get_legacy_form ($node);
188			$self->{legacy_form} = $form;
189	elmex	1.1	}
190
191			=head1 AUTHOR
192
193	elmex	1.2	Robin Redeker, C<< <elmex at ta-sa.org> >>, JID: C<< <elmex at jabber.org> >>
194	elmex	1.1
195			=head1 COPYRIGHT & LICENSE
196
197			Copyright 2007 Robin Redeker, all rights reserved.
198
199			This program is free software; you can redistribute it and/or modify it
200			under the same terms as Perl itself.
201
202			=cut
203
204			1; # End of Net::XMPP2::RegisterForm