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

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