XMPP2/Ext/RegisterForm.pm

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

=head1 NAME

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