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}->{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.6
Committed:	Wed Jul 25 13:53:33 2007 UTC (19 years, 2 months ago) by elmex
Branch:	MAIN
Changes since 1.5:	+47 -22 lines
Log Message:	implemented OOB and fixed bugs in Disco and further developed in band registration.
#	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.6	exists $self->{legacy_form}->{registered}
119	elmex	1.4	}
120
121			sub init_new_form {
122			my ($self, $node) = @_;
123
124	elmex	1.5	my (@x) = $node->find_all ([qw/register query/], [qw/data_form x/]);
125	elmex	1.4
126			if (@x) {
127			my $df = Net::XMPP2::Ext::DataForm->new;
128			$df->from_node (@x);
129	elmex	1.6	$self->{data_form} = $df;
130	elmex	1.4
131			} else {
132			die "TODO!";
133			}
134			}
135
136	elmex	1.6
137			=item B<get_legacy_form_fields>
138
139			This method returns a hash with....
140			as specified in the in band registration XEP.
141
142			=cut
143
144			sub get_legacy_form_fields {
145	elmex	1.4	my ($self) = @_;
146	elmex	1.6	$self->{legacy_form}
147	elmex	1.4	}
148
149	elmex	1.6	=item B<get_data_form>
150
151			This method returns the L<Net::XMPP2::Ext::DataForm> that came
152			with the registration response. If no data form was provided by the
153			server this method returns undef.
154
155			=cut
156
157	elmex	1.4	sub get_data_form {
158			my ($self) = @_;
159	elmex	1.6	$self->{data_form}
160			}
161
162
163			=item B<get_oob>
164
165			This method returns a hash like the one returned from
166			the function C<url_from_node> in L<Net::XMPP2::Ext::OOB>.
167			It contains the out of band data for this registration form.
168
169			=cut
170
171			sub get_oob {
172			my ($self) = @_;
173			$self->{oob}
174	elmex	1.4	}
175
176			sub init_from_node {
177			my ($self, $node) = @_;
178	elmex	1.1
179	elmex	1.5	if ($node->find_all ([qw/register query/], [qw/data_form x/])) {
180	elmex	1.4	$self->init_new_form ($node);
181			}
182	elmex	1.6	if (my ($xoob) = $node->find_all ([qw/register query/], [qw/oob x/])) {
183			$self->{oob} = Net::XMPP2::Ext::OOB->url_from_node ($xoob);
184			}
185
186			my $form = $self->_get_legacy_form ($node);
187			$self->{legacy_form} = $form;
188	elmex	1.1	}
189
190			=head1 AUTHOR
191
192	elmex	1.2	Robin Redeker, C<< <elmex at ta-sa.org> >>, JID: C<< <elmex at jabber.org> >>
193	elmex	1.1
194			=head1 COPYRIGHT & LICENSE
195
196			Copyright 2007 Robin Redeker, all rights reserved.
197
198			This program is free software; you can redistribute it and/or modify it
199			under the same terms as Perl itself.
200
201			=cut
202
203			1; # End of Net::XMPP2::RegisterForm