XMPP2/Ext/DataForm.pm

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

=head1 NAME

Net::XMPP2::Ext::DataForm - XEP-0004 DataForm

=head1 SYNOPSIS

   package foo;

=head1 DESCRIPTION

This module represents a Data Form as specified in XEP-0004.

=head1 METHODS

=over 4

=item B<new (%args)>

=cut

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

sub init {
   my ($self) = @_;
   $self->{fields}    = [];
   $self->{field_var} = {};
   $self->{items}     = [];
   $self->{reported}  = [];
   delete $self->{type};
   delete $self->{title};
   delete $self->{instructions};
}

=item B<append_field ($field)>

This method appends a field to the form.
C<$field> must have the structure as described in L<FIELD STRUCTURE> below.

=cut

sub append_field {
   my ($self, $field) = @_;
   $self->{fields}    = [] unless $self->{fields};
   $self->{field_var} = {} unless $self->{field_var};
   push @{$self->{fields}}, $field;
   $self->{field_var}->{$field->{var}} = $field if defined $field->{var};
}

=item B<from_node ($node)>

This method interprets the L<Net::XMPP2::Node> object in C<$node> as
data form XML node and reads out the fields and all associated information.

(C<$node> must be the XML node of the <x xmlns='jabber:x:data'> tag).

=cut

sub _extract_field {
   my ($field) = @_;

   my $fo = {
      label => $field->attr ('label'),
      var   => $field->attr ('var'),
      type  => $field->attr ('type'),
   };

   my ($desc) = $field->find_all ([qw/data_form desc/]);
   if ($desc) {
      $fo->{desc} = $desc->text;
   }
   if ($field->find_all ([qw/data_form required/])) {
      $fo->{required} = 1;
   }
   my (@vals) = $field->find_all ([qw/data_form value/]);
   $fo->{values} = [];
   for (@vals) {
      push @{$fo->{values}}, $_->text;
   }
   my (@opts) = $field->find_all ([qw/data_form option/]);
   $fo->{options} = [];
   for my $o (@opts) {
      my (@v) = $o->find_all ([qw/data_form value/]);
      my $vals = [];
      for my $val (@v) {
         push @$vals, $val->text;
      }
      push @{$fo->{options}}, [$o->attr ('label'), $vals];
   }

   $fo
}

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

   $self->init;

   my ($title) = $node->find_all ([qw/data_form title/]);
   my ($instr) = $node->find_all ([qw/data_form instructions/]);

   $self->{type}         = $node->attr ('type');
   $self->{title}        = $title->text if $title;
   $self->{instructions} = $instr->text if $instr;

   for my $field ($node->find_all ([qw/data_form field/])) {
      my $fo = _extract_field ($field);
      $self->append_field ($fo);
   }

   my ($rep) = $node->find_all ([qw/data_form reported/]);
   if ($rep) {
      for my $field ($rep->find_all ([qw/data_form field/])) {
         my $fo = {
            label => $field->attr ('label'),
            var   => $field->attr ('var'),
            type  => $field->attr ('type'),
         };
         push @{$self->{reported}}, $fo;
      }
   }

   for my $item ($node->find_all ([qw/data_form item/])) {
      my $flds = [];
      for my $field ($item->find_all ([qw/data_form field/])) {
         my $fo = _extract_field ($field);
         push @$flds, $fo;
      }
      push @{$self->{items}}, $flds;
   }
}

=item B<make_answer_form ($request_form)>

This method initializes this form with default answers and
other neccessary fields from C<$request_form>, which must be
of type L<Net::XMPP2::Ext::DataForm> or compatible.

The result will be a form with a copy of all fields which are not of
type C<fixed>. The fields will also have the default value copied over.

The form type will be set to C<submit>.

The idea is: this creates a template answer form from C<$request_form>.

To strip out the unneccessary fields later you don't need call the
C<clear_empty_fields> method.

=cut

sub make_answer_form {
   my ($self, $reqform) = @_;

   $self->set_form_type ('submit');

   for my $field ($reqform->get_fields) {
      next if $field->{type} eq 'fixed';

      my $fo = {
         var     => $field->{var},
         type    => $field->{type},
         values  => [ @{$field->{values}} ],
         options => [],
      };

      $self->append_field ($fo);
   }
}

=item B<clear_empty_fields>

This method removes all fields that have no values and options.

=cut

sub clear_empty_fields {
   my ($self) = @_;

   my @dead;
   for ($self->get_fields) {
      unless (@{$_->{values}} || @{$_->{options}}) {
         push @dead, $_;
      }
   }
   $self->remove_field ($_) for @dead;
}

=item B<remove_field ($field_or_var)>

This method removes a field either by it's unique name or
by reference. C<$field_or_var> can either be the unique name or
the actual field hash reference you get from C<get_field> or C<get_fields>.

=cut

sub remove_field {
   my ($self, $field) = @_;
   unless (ref $field) {
      $field = $self->get_field ($field) or return;
   }
   @{$self->{fields}} = grep { $_ ne $field } @{$self->{fields}};
   if (defined $field->{var}) {
      delete $self->{field_var}->{$field->{var}};
   }
}

=item B<set_form_type ($type)>

This method sets the type of the form, which must be one of:

   form, submit, cancel, result

=cut

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

=item B<form_type>

This method returns the type of the form, which is one of the
options described in C<set_form_type> above or undef if no type
was yet set.

=cut

sub form_type { return $_[0]->{type} }

=item B<get_reported_fields>

If this is a search result this method returns more than one element
here. The returned list consists of fields as described in L<FIELD STRUCTURE>,
only that they lack values and options.

See also the C<get_items> method.

=cut

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

=item B<get_items>

If this form is a search result this method returns the list of
items of that search.

An item is a array ref of fields (field structure is described in L<FIELD STRUCTURE>).
This method returns a list of items.

=cut

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

=item B<get_fields>

This method returns a list of fields. Each field has the structure as described
in L<FIELD STRUCTURE>.

=cut

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

=item B<get_field ($var)>

Returns the field with the unique field name C<$var> or
undef if no such field is in this form.

=cut

sub get_field {
   my ($self, $var) = @_;
   $self->{field_var}->{$var}
}

=item B<set_field_value ($var, $value)>

This method sets the value of the field with the unique name C<$var>.
If the field has supports multiple values all values will be removed
and only C<$value> will be added, if C<$value> is undefined the field's
value will be deleted.

=cut

sub set_field_value {
   my ($self, $var, $val) = @_;
   my $f = $self->get_field ($var) or return;
   $f->{values} = defined $val ? [ $val ] : [];
}

=item B<add_field_value ($var, $value)>

This method adds the C<$value> to the field with the unique name C<$var>.
If the field doesn't support multiple values this method has the same
effect as C<set_field_value>.

=cut

sub add_field_value {
   my ($self, $var, $val) = @_;
   my $f = $self->get_field ($var) or return;
   if (grep { $f->{type} eq $_ } qw/jid-multi list-multi text-multi/) {
      push @{$f->{values}}, $val;
   } else {
      $self->set_field_value ($var, $val);
   }
}

=item B<to_simxml>

This method converts the form to a data strcuture
that you can pass as C<node> argument to the C<simxml>
function which is documented in L<Net::XMPP2::Util>.

Example call might be:

   my $node = $form->to_simxml;
   simxml ($w, defns => $node->{ns}, node => $node);

=cut

sub _field_to_simxml {
   my ($f) = @_;

   my $ofa = [];
   my $ofc = [];
   my $of = {
      ns   => 'data_form',
      name => 'field',
      attrs  => $ofa,
      childs => $ofc,
   };

   push @$ofa, (label => $f->{label}) if defined $f->{label};
   push @$ofa, (var   => $f->{var})   if defined $f->{var};
   push @$ofa, (type  => $f->{type})  if defined $f->{type};

   for (@{$f->{values}}) {
      push @$ofc, { ns => 'data_form', name => 'value', childs => [ $_ ] }
   }

   for (@{$f->{options}}) {
      my $at = [];
      my $chlds = [];
      push @$ofc, {
         ns => 'data_form', name => 'option',
         attrs => $at, childs => $chlds
      };
      for (@{$_->[1]}) {
         push @$chlds, { name => 'value', childs => [ $_ ] }
      }
      if (defined $_->[0]) { push @$at, (label => $_->[0]) }
   }

   if ($f->{desc}) {
      push @$ofc, { ns => 'data_form', name => 'desc', childs => [ $f->{desc} ] }
   }

   if ($f->{required}) {
      push @$ofc, { ns => 'data_form', name => 'required' }
   }

   $of
}

sub to_simxml {
   my ($self) = @_;

   my $fields = [];
   my $top = {
      ns     => 'data_form',
      name   => 'x',
      attrs  => [],
      childs => $fields,
   };

   push @{$top->{attrs}}, ( type => $self->{type} );

   if (defined $self->{title}) {
      push @$fields, {
         name => 'title', childs => [ $self->{title} ]
      }
   }

   if (defined $self->{instructions}) {
      push @$fields, {
         name => 'instructions', childs => [ $self->{instructions} ]
      }
   }

   for my $f ($self->get_fields) {
      push @$fields, _field_to_simxml ($f);
   }

   my $repchld = [];
   for my $rf ($self->get_reported_fields) {
      push @$repchld, _field_to_simxml ($rf);
   }

   if (@$repchld) {
      push @$fields, {
         name => 'reported',
         childs => $repchld
      };
   }

   for my $itf ($self->get_items) {
      my $itfields = [];

      for my $f (@$itf) {
         push @$itfields, _field_to_simxml ($f);
      }

      push @$fields, {
         name => 'item',
         childs => $itfields
      }
   }

   $top
}

=item B<as_debug_string>

This method returns a string that represents the form.
Only for debugging purposes.

=cut

sub as_debug_string {
   my ($self) = @_;

   my $str;
   $str .= "title: $self->{title}\n"
          ."instructions: $self->{instructions}\n"
          ."type: $self->{type}\n";
   for my $f ($self->get_fields) {
      $str .= sprintf "- var : %-50s label: %s\n  type: %-10s required: %d\n",
                 $f->{var}, $f->{label}, $f->{type}, $f->{required};
      for (@{$f->{values}}) {
         $str .= sprintf "     * val    : %s\n", $_
      }
      for (@{$f->{options}}) {
         $str .= sprintf "     * opt lbl: %-50s text: %s\n", @$_
      }
   }

   $str .= "reported:\n";
   for my $f (@{$self->{reported}}) {
      $str .= sprintf "- var: %-50s label: %-30s type: %-10s %d\n",
                    $f->{var}, $f->{label}, $f->{type};
   }

   $str .= "items:\n";
   for my $i (@{$self->{items}}) {
      $str .= "-" x 60 . "\n";
      for my $f (@$i) {
         $str .= sprintf "- var : %-50s\n", $f->{var};
         for (@{$f->{values}}) {
            $str .= sprintf "     * val    : %s\n", $_
         }
         for (@{$f->{options}}) {
            $str .= sprintf "     * opt lbl: %-50s text: %s\n", @$_
         }
      }
   }

   $str
}

=back

=head1 FIELD STRUCTURE

   {
      label    => 'field label',
      type     => 'field type',
      var      => '(unique) field name'
      required => true or false value,
      values   => [
         'value text',
         ...
      ],
      options  => [
         ['option label', 'option text'],
         ...
      ]
   }

For the semantics of all fields please consult XEP 0004.

=head1 SEE ALSO

   XEP 0004

=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;
Revision:	1.3
Committed:	Fri Jul 6 22:22:21 2007 UTC (19 years, 2 months ago) by elmex
Branch:	MAIN
Changes since 1.2:	+477 -2 lines
Log Message:	implemented dataforms - phew! that was a bullet of work
#	User	Rev	Content
1	elmex	1.3	package Net::XMPP2::Ext::DataForm;
2			use strict;
3	elmex	1.1	use Net::XMPP2::Namespaces qw/xmpp_ns/;
4
5			=head1 NAME
6
7	elmex	1.3	Net::XMPP2::Ext::DataForm - XEP-0004 DataForm
8	elmex	1.1
9			=head1 SYNOPSIS
10
11			package foo;
12
13			=head1 DESCRIPTION
14
15			This module represents a Data Form as specified in XEP-0004.
16
17			=head1 METHODS
18
19			=over 4
20
21			=item B<new (%args)>
22
23			=cut
24
25			sub new {
26			my $this = shift;
27			my $class = ref($this) \|\| $this;
28			my $self = bless { @_ }, $class;
29			$self->init;
30			$self
31			}
32
33			sub init {
34			my ($self) = @_;
35	elmex	1.3	$self->{fields} = [];
36			$self->{field_var} = {};
37			$self->{items} = [];
38			$self->{reported} = [];
39			delete $self->{type};
40			delete $self->{title};
41			delete $self->{instructions};
42			}
43
44			=item B<append_field ($field)>
45
46			This method appends a field to the form.
47			C<$field> must have the structure as described in L<FIELD STRUCTURE> below.
48
49			=cut
50
51			sub append_field {
52			my ($self, $field) = @_;
53			$self->{fields} = [] unless $self->{fields};
54			$self->{field_var} = {} unless $self->{field_var};
55			push @{$self->{fields}}, $field;
56			$self->{field_var}->{$field->{var}} = $field if defined $field->{var};
57			}
58
59			=item B<from_node ($node)>
60
61			This method interprets the L<Net::XMPP2::Node> object in C<$node> as
62			data form XML node and reads out the fields and all associated information.
63
64			(C<$node> must be the XML node of the <x xmlns='jabber:x:data'> tag).
65
66			=cut
67
68			sub _extract_field {
69			my ($field) = @_;
70
71			my $fo = {
72			label => $field->attr ('label'),
73			var => $field->attr ('var'),
74			type => $field->attr ('type'),
75			};
76
77			my ($desc) = $field->find_all ([qw/data_form desc/]);
78			if ($desc) {
79			$fo->{desc} = $desc->text;
80			}
81			if ($field->find_all ([qw/data_form required/])) {
82			$fo->{required} = 1;
83			}
84			my (@vals) = $field->find_all ([qw/data_form value/]);
85			$fo->{values} = [];
86			for (@vals) {
87			push @{$fo->{values}}, $_->text;
88			}
89			my (@opts) = $field->find_all ([qw/data_form option/]);
90			$fo->{options} = [];
91			for my $o (@opts) {
92			my (@v) = $o->find_all ([qw/data_form value/]);
93			my $vals = [];
94			for my $val (@v) {
95			push @$vals, $val->text;
96			}
97			push @{$fo->{options}}, [$o->attr ('label'), $vals];
98			}
99
100			$fo
101			}
102
103			sub from_node {
104			my ($self, $node) = @_;
105
106			$self->init;
107
108			my ($title) = $node->find_all ([qw/data_form title/]);
109			my ($instr) = $node->find_all ([qw/data_form instructions/]);
110
111			$self->{type} = $node->attr ('type');
112			$self->{title} = $title->text if $title;
113			$self->{instructions} = $instr->text if $instr;
114
115			for my $field ($node->find_all ([qw/data_form field/])) {
116			my $fo = _extract_field ($field);
117			$self->append_field ($fo);
118			}
119
120			my ($rep) = $node->find_all ([qw/data_form reported/]);
121			if ($rep) {
122			for my $field ($rep->find_all ([qw/data_form field/])) {
123			my $fo = {
124			label => $field->attr ('label'),
125			var => $field->attr ('var'),
126			type => $field->attr ('type'),
127			};
128			push @{$self->{reported}}, $fo;
129			}
130			}
131
132			for my $item ($node->find_all ([qw/data_form item/])) {
133			my $flds = [];
134			for my $field ($item->find_all ([qw/data_form field/])) {
135			my $fo = _extract_field ($field);
136			push @$flds, $fo;
137			}
138			push @{$self->{items}}, $flds;
139			}
140			}
141
142			=item B<make_answer_form ($request_form)>
143
144			This method initializes this form with default answers and
145			other neccessary fields from C<$request_form>, which must be
146			of type L<Net::XMPP2::Ext::DataForm> or compatible.
147
148			The result will be a form with a copy of all fields which are not of
149			type C<fixed>. The fields will also have the default value copied over.
150
151			The form type will be set to C<submit>.
152
153			The idea is: this creates a template answer form from C<$request_form>.
154
155			To strip out the unneccessary fields later you don't need call the
156			C<clear_empty_fields> method.
157
158			=cut
159
160			sub make_answer_form {
161			my ($self, $reqform) = @_;
162
163			$self->set_form_type ('submit');
164
165			for my $field ($reqform->get_fields) {
166			next if $field->{type} eq 'fixed';
167
168			my $fo = {
169			var => $field->{var},
170			type => $field->{type},
171			values => [ @{$field->{values}} ],
172			options => [],
173			};
174
175			$self->append_field ($fo);
176			}
177			}
178
179			=item B<clear_empty_fields>
180
181			This method removes all fields that have no values and options.
182
183			=cut
184
185			sub clear_empty_fields {
186			my ($self) = @_;
187
188			my @dead;
189			for ($self->get_fields) {
190			unless (@{$_->{values}} \|\| @{$_->{options}}) {
191			push @dead, $_;
192			}
193			}
194			$self->remove_field ($_) for @dead;
195			}
196
197			=item B<remove_field ($field_or_var)>
198
199			This method removes a field either by it's unique name or
200			by reference. C<$field_or_var> can either be the unique name or
201			the actual field hash reference you get from C<get_field> or C<get_fields>.
202
203			=cut
204
205			sub remove_field {
206			my ($self, $field) = @_;
207			unless (ref $field) {
208			$field = $self->get_field ($field) or return;
209			}
210			@{$self->{fields}} = grep { $_ ne $field } @{$self->{fields}};
211			if (defined $field->{var}) {
212			delete $self->{field_var}->{$field->{var}};
213			}
214			}
215
216			=item B<set_form_type ($type)>
217
218			This method sets the type of the form, which must be one of:
219
220			form, submit, cancel, result
221
222			=cut
223
224			sub set_form_type {
225			my ($self, $type) = @_;
226			$self->{type} = $type;
227			}
228
229			=item B<form_type>
230
231			This method returns the type of the form, which is one of the
232			options described in C<set_form_type> above or undef if no type
233			was yet set.
234
235			=cut
236
237			sub form_type { return $_[0]->{type} }
238
239			=item B<get_reported_fields>
240
241			If this is a search result this method returns more than one element
242			here. The returned list consists of fields as described in L<FIELD STRUCTURE>,
243			only that they lack values and options.
244
245			See also the C<get_items> method.
246
247			=cut
248
249			sub get_reported_fields {
250			my ($self) = @_;
251			@{$self->{reported}}
252			}
253
254			=item B<get_items>
255
256			If this form is a search result this method returns the list of
257			items of that search.
258
259			An item is a array ref of fields (field structure is described in L<FIELD STRUCTURE>).
260			This method returns a list of items.
261
262			=cut
263
264			sub get_items {
265			my ($self) = @_;
266			@{$self->{items}};
267			}
268
269			=item B<get_fields>
270
271			This method returns a list of fields. Each field has the structure as described
272			in L<FIELD STRUCTURE>.
273
274			=cut
275
276			sub get_fields {
277			my ($self) = @_;
278			@{$self->{fields}}
279			}
280
281			=item B<get_field ($var)>
282
283			Returns the field with the unique field name C<$var> or
284			undef if no such field is in this form.
285
286			=cut
287
288			sub get_field {
289			my ($self, $var) = @_;
290			$self->{field_var}->{$var}
291			}
292
293			=item B<set_field_value ($var, $value)>
294
295			This method sets the value of the field with the unique name C<$var>.
296			If the field has supports multiple values all values will be removed
297			and only C<$value> will be added, if C<$value> is undefined the field's
298			value will be deleted.
299
300			=cut
301
302			sub set_field_value {
303			my ($self, $var, $val) = @_;
304			my $f = $self->get_field ($var) or return;
305			$f->{values} = defined $val ? [ $val ] : [];
306			}
307
308			=item B<add_field_value ($var, $value)>
309
310			This method adds the C<$value> to the field with the unique name C<$var>.
311			If the field doesn't support multiple values this method has the same
312			effect as C<set_field_value>.
313
314			=cut
315
316			sub add_field_value {
317			my ($self, $var, $val) = @_;
318			my $f = $self->get_field ($var) or return;
319			if (grep { $f->{type} eq $_ } qw/jid-multi list-multi text-multi/) {
320			push @{$f->{values}}, $val;
321			} else {
322			$self->set_field_value ($var, $val);
323			}
324			}
325
326			=item B<to_simxml>
327
328			This method converts the form to a data strcuture
329			that you can pass as C<node> argument to the C<simxml>
330			function which is documented in L<Net::XMPP2::Util>.
331
332			Example call might be:
333
334			my $node = $form->to_simxml;
335			simxml ($w, defns => $node->{ns}, node => $node);
336
337			=cut
338
339			sub _field_to_simxml {
340			my ($f) = @_;
341
342			my $ofa = [];
343			my $ofc = [];
344			my $of = {
345			ns => 'data_form',
346			name => 'field',
347			attrs => $ofa,
348			childs => $ofc,
349			};
350
351			push @$ofa, (label => $f->{label}) if defined $f->{label};
352			push @$ofa, (var => $f->{var}) if defined $f->{var};
353			push @$ofa, (type => $f->{type}) if defined $f->{type};
354
355			for (@{$f->{values}}) {
356			push @$ofc, { ns => 'data_form', name => 'value', childs => [ $_ ] }
357			}
358
359			for (@{$f->{options}}) {
360			my $at = [];
361			my $chlds = [];
362			push @$ofc, {
363			ns => 'data_form', name => 'option',
364			attrs => $at, childs => $chlds
365			};
366			for (@{$_->[1]}) {
367			push @$chlds, { name => 'value', childs => [ $_ ] }
368			}
369			if (defined $_->[0]) { push @$at, (label => $_->[0]) }
370			}
371
372			if ($f->{desc}) {
373			push @$ofc, { ns => 'data_form', name => 'desc', childs => [ $f->{desc} ] }
374			}
375
376			if ($f->{required}) {
377			push @$ofc, { ns => 'data_form', name => 'required' }
378			}
379
380			$of
381			}
382
383			sub to_simxml {
384			my ($self) = @_;
385
386			my $fields = [];
387			my $top = {
388			ns => 'data_form',
389			name => 'x',
390			attrs => [],
391			childs => $fields,
392			};
393
394			push @{$top->{attrs}}, ( type => $self->{type} );
395
396			if (defined $self->{title}) {
397			push @$fields, {
398			name => 'title', childs => [ $self->{title} ]
399			}
400			}
401
402			if (defined $self->{instructions}) {
403			push @$fields, {
404			name => 'instructions', childs => [ $self->{instructions} ]
405			}
406			}
407
408			for my $f ($self->get_fields) {
409			push @$fields, _field_to_simxml ($f);
410			}
411
412			my $repchld = [];
413			for my $rf ($self->get_reported_fields) {
414			push @$repchld, _field_to_simxml ($rf);
415			}
416
417			if (@$repchld) {
418			push @$fields, {
419			name => 'reported',
420			childs => $repchld
421			};
422			}
423
424			for my $itf ($self->get_items) {
425			my $itfields = [];
426
427			for my $f (@$itf) {
428			push @$itfields, _field_to_simxml ($f);
429			}
430
431			push @$fields, {
432			name => 'item',
433			childs => $itfields
434			}
435			}
436
437			$top
438			}
439
440			=item B<as_debug_string>
441
442			This method returns a string that represents the form.
443			Only for debugging purposes.
444
445			=cut
446
447			sub as_debug_string {
448			my ($self) = @_;
449
450			my $str;
451			$str .= "title: $self->{title}\n"
452			."instructions: $self->{instructions}\n"
453			."type: $self->{type}\n";
454			for my $f ($self->get_fields) {
455			$str .= sprintf "- var : %-50s label: %s\n type: %-10s required: %d\n",
456			$f->{var}, $f->{label}, $f->{type}, $f->{required};
457			for (@{$f->{values}}) {
458			$str .= sprintf " * val : %s\n", $_
459			}
460			for (@{$f->{options}}) {
461			$str .= sprintf " * opt lbl: %-50s text: %s\n", @$_
462			}
463			}
464
465			$str .= "reported:\n";
466			for my $f (@{$self->{reported}}) {
467			$str .= sprintf "- var: %-50s label: %-30s type: %-10s %d\n",
468			$f->{var}, $f->{label}, $f->{type};
469			}
470
471			$str .= "items:\n";
472			for my $i (@{$self->{items}}) {
473			$str .= "-" x 60 . "\n";
474			for my $f (@$i) {
475			$str .= sprintf "- var : %-50s\n", $f->{var};
476			for (@{$f->{values}}) {
477			$str .= sprintf " * val : %s\n", $_
478			}
479			for (@{$f->{options}}) {
480			$str .= sprintf " * opt lbl: %-50s text: %s\n", @$_
481			}
482			}
483			}
484
485			$str
486	elmex	1.1	}
487
488			=back
489
490	elmex	1.3	=head1 FIELD STRUCTURE
491
492			{
493			label => 'field label',
494			type => 'field type',
495			var => '(unique) field name'
496			required => true or false value,
497			values => [
498			'value text',
499			...
500			],
501			options => [
502			['option label', 'option text'],
503			...
504			]
505			}
506
507			For the semantics of all fields please consult XEP 0004.
508
509			=head1 SEE ALSO
510
511			XEP 0004
512
513	elmex	1.1	=head1 AUTHOR
514
515			Robin Redeker, C<< <elmex at ta-sa.org> >>, JID: C<< <elmex at jabber.org> >>
516
517			=head1 COPYRIGHT & LICENSE
518
519			Copyright 2007 Robin Redeker, all rights reserved.
520
521			This program is free software; you can redistribute it and/or modify it
522			under the same terms as Perl itself.
523
524			=cut
525
526			1;