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;

=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_old_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 (
         type => $self->{type},
         form     => $nform,
         old_form => $form,
         answered => 1
      );
}

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

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

sub is_already_registered {
   my ($self) = @_;
   exists $self->{old_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->{form} = $df;

   } else {
      die "TODO!";
   }
}

sub get_standard_form_fields {
   my ($self) = @_;
   $self->{old_form};
}

sub get_data_form {
   my ($self) = @_;
   if ($self->{type} eq 'form') {
      return $self->{form};
   }
}

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

   if ($node->find_all ([qw/register query/], [qw/data_form x/])) {
      $self->init_new_form ($node);
      $self->{type} = 'form';
   } else {
      $self->{type} = 'standard';
   }
   my $form = $self->get_old_form ($node);
   $self->{old_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.5
Committed:	Fri Jul 20 20:41:48 2007 UTC (19 years, 2 months ago) by elmex
Branch:	MAIN
Changes since 1.4:	+5 -4 lines
Log Message:	lots of changes. added as_string to Net::XMPP2::Node to restore the original xml document part of a stanza or subtree. also implemented the jabber component protocol.
#	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.1
7			=head1 NAME
8
9	elmex	1.5	Net::XMPP2::Ext::RegisterForm - Handle for in band registration
10	elmex	1.1
11			=head1 SYNOPSIS
12
13			my $con = Net::XMPP2::Connection->new (...);
14			...
15			$con->do_in_band_register (sub {
16			my ($form, $error) = @_;
17			if ($error) { print "ERROR: ".$error->string."\n" }
18			else {
19			if ($form->type eq 'simple') {
20			if ($form->has_field ('username') && $form->has_field ('password')) {
21			$form->set_field (
22			username => 'test',
23			password => 'qwerty',
24			);
25			$form->submit (sub {
26			my ($form, $error) = @_;
27			if ($error) { print "SUBMIT ERROR: ".$error->string."\n" }
28			else {
29			print "Successfully registered as ".$form->field ('username')."\n"
30			}
31			});
32			} else {
33			print "Couldn't fill out the form: " . $form->field ('instructions') ."\n";
34			}
35			} elsif ($form->type eq 'data_form' {
36			my $dform = $form->data_form;
37			... fill out the form $dform (of type Net::XMPP2::DataForm) ...
38			$form->submit_data_form ($dform, sub {
39			my ($form, $error) = @_;
40			if ($error) { print "DATA FORM SUBMIT ERROR: ".$error->string."\n" }
41			else {
42			print "Successfully registered as ".$form->field ('username')."\n"
43			}
44			})
45			}
46			}
47			});
48
49			=head1 DESCRIPTION
50
51			This module represents an in band registration form
52			which can be filled out and submitted.
53
54			You can get an instance of this class only by requesting it
55			from a L<Net::XMPP2::Connection> by calling the C<request_inband_register_form>
56			method.
57
58			=cut
59
60			sub new {
61			my $this = shift;
62			my $class = ref($this) \|\| $this;
63			my $self = bless { @_ }, $class;
64			$self
65			}
66
67	elmex	1.4	sub get_old_form {
68			my ($self, $node) = @_;
69
70			my $form = {};
71
72			for ($node->nodes) {
73			if ($_->eq_ns ('register')) {
74			$form->{$_->name} = $_->text;
75			}
76			}
77
78			$form
79			}
80
81			sub try_fillout_registration {
82			my ($self, $username, $password) = @_;
83
84			my $form;
85			my $nform;
86			if (my $df = $self->get_data_form) {
87			my $af = Net::XMPP2::Ext::DataForm->new;
88			$af->make_answer_form ($df);
89			$af->set_field_value (username => $username);
90			$af->set_field_value (password => $password);
91			$nform = $af;
92
93			} else {
94			my $frm = $self->get_standard_form_fields;
95			$form = {
96			username => $username,
97			password => $password
98			};
99			}
100
101			return
102			Net::XMPP2::Ext::RegisterForm->new (
103			type => $self->{type},
104			form => $nform,
105			old_form => $form,
106			answered => 1
107			);
108			}
109
110			sub type {
111			my ($self) = @_;
112			$self->{type}
113			}
114
115			sub is_answer_form {
116			my ($self) = @_;
117			$self->{answered}
118			}
119
120			sub is_already_registered {
121	elmex	1.1	my ($self) = @_;
122	elmex	1.4	exists $self->{old_form}->{registered}
123			}
124
125			sub init_new_form {
126			my ($self, $node) = @_;
127
128	elmex	1.5	my (@x) = $node->find_all ([qw/register query/], [qw/data_form x/]);
129	elmex	1.4
130			if (@x) {
131			my $df = Net::XMPP2::Ext::DataForm->new;
132			$df->from_node (@x);
133			$self->{form} = $df;
134
135			} else {
136			die "TODO!";
137			}
138			}
139
140			sub get_standard_form_fields {
141			my ($self) = @_;
142			$self->{old_form};
143			}
144
145			sub get_data_form {
146			my ($self) = @_;
147			if ($self->{type} eq 'form') {
148			return $self->{form};
149			}
150			}
151
152			sub init_from_node {
153			my ($self, $node) = @_;
154	elmex	1.1
155	elmex	1.5	if ($node->find_all ([qw/register query/], [qw/data_form x/])) {
156	elmex	1.4	$self->init_new_form ($node);
157			$self->{type} = 'form';
158			} else {
159			$self->{type} = 'standard';
160			}
161			my $form = $self->get_old_form ($node);
162			$self->{old_form} = $form;
163	elmex	1.1	}
164
165			=head1 AUTHOR
166
167	elmex	1.2	Robin Redeker, C<< <elmex at ta-sa.org> >>, JID: C<< <elmex at jabber.org> >>
168	elmex	1.1
169			=head1 COPYRIGHT & LICENSE
170
171			Copyright 2007 Robin Redeker, all rights reserved.
172
173			This program is free software; you can redistribute it and/or modify it
174			under the same terms as Perl itself.
175
176			=cut
177
178			1; # End of Net::XMPP2::RegisterForm