File Coverage

blib/lib/CGI/Test/Form/Widget.pm
Criterion Covered Total %
statement 58 81 71.6
branch 10 22 45.4
condition n/a
subroutine 17 28 60.7
pod 18 20 90.0
total 103 151 68.2


line stmt bran cond sub pod time code
1             package CGI::Test::Form::Widget;
2 14     14   54 use strict;
  14         11  
  14         282  
3 14     14   37 use warnings;
  14         9  
  14         246  
4             ################################################################
5             # $Id: Widget.pm 411 2011-09-26 11:19:30Z nohuhu@nohuhu.org $
6             # $Name: cgi-test_0-104_t1 $
7             ################################################################
8             #
9             # Copyright (c) 2001, Raphael Manfredi
10             #
11             # You may redistribute only under the terms of the Artistic License,
12             # as specified in the README file that comes with the distribution.
13             #
14              
15 14     14   34 use Carp;
  14         14  
  14         8893  
16              
17             #
18             # This class models a CGI form widget (button, text field, etc...).
19             # It belongs to one form, identified by its `form' attribute , a ref
20             # to a CGI::Test::Form object.
21             #
22              
23             ############################################################
24             #
25             # ->new
26             #
27             # Creation routine -- common to ALL widgets but
28             #
29             ############################################################
30             sub new
31             {
32 307     307 0 342 my $this = bless {}, shift;
33 307         248 my ($node, $form) = @_;
34              
35             #
36             # Can't create a CGI::Test::Form::Widget object, only heirs.
37             #
38              
39 307 50       421 confess "%s is a deferred class", __PACKAGE__
40             if ref $this eq __PACKAGE__;
41              
42 307         574 $this->_common_init($form);
43              
44             #
45             # We don't keep any reference on the node.
46             # Analyze the HTML tree to determine some parameters.
47             #
48              
49 307         601 $this->_init($node); # Defined in each heir
50              
51 307         379 return $this;
52             }
53              
54             ############################################################
55             #
56             # ->_common_init
57             #
58             # Common attribute initialization for all widgets
59             #
60             ############################################################
61             sub _common_init
62             {
63 371     371   230 my $this = shift;
64 371         232 my ($form) = @_;
65              
66 371         677 $this->{form} = $form; #
containing this widget
67 371         314 $this->{name} = ""; # Always possible to query, must be defined
68 371         257 $this->{value} = ""; # Idem
69              
70 371         305 return;
71             }
72              
73             ############################################################
74             #
75             # ->_init
76             #
77             # Per-widget initialization routine.
78             # Parse HTML node to determine our specific parameters.
79             #
80             ############################################################
81             sub _init
82             {
83 0     0   0 my $this = shift;
84 0         0 my ($node) = @_;
85 0         0 confess "deferred";
86             }
87              
88             ############################################################
89             #
90             # ->_parse_attr
91             #
92             # Each heir locally defines a hash table mapping HTML node attributes to
93             # class attributes. This structure is used to parse the node and setup
94             # the object accordingly.
95             #
96             ############################################################
97             sub _parse_attr
98             {
99 371     371   232 my $this = shift;
100 371         247 my ($node, $attr) = @_;
101              
102 371         763 while (my ($html_attr, $obj_attr) = each %$attr)
103             {
104 1449         1680 my $val = $node->attr($html_attr);
105 1449 100       8361 $this->{$obj_attr} = $val if defined $val;
106             }
107              
108 371         416 return;
109             }
110              
111             #
112             # Attribute access
113             #
114              
115             sub form
116             {
117 19     19 1 17 my $this = shift;
118 19         51 return $this->{form};
119             }
120              
121             #
122             # Access to attributes that must be setup by heirs within _init()
123             # Those are common attributes for the whole Widget hierarchy.
124             #
125             # The `value' attribute may not have any meaning (e.g. for an image button)
126             # but it is always possible to query it.
127             #
128              
129             sub name
130             {
131 789     789 1 511 my $this = shift;
132 789         1444 return $this->{name};
133             }
134              
135             sub value
136             {
137 382     382 1 234 my $this = shift;
138 382         770 return $this->{value};
139             }
140              
141             sub old_value
142             {
143 0     0 0 0 my $this = shift;
144 0         0 return $this->{old_value};
145             }
146              
147             sub is_disabled
148             {
149 475     475 1 303 my $this = shift;
150 475         642 return $this->{is_disabled};
151             } # "grayed out"
152              
153             #
154             # Global widget predicates
155             #
156              
157             sub is_read_only
158             {
159 0     0 1 0 0
160             } # Can change "value"
161              
162             #
163             # High-level classification predicates
164             #
165              
166             ############################################################
167             sub is_button
168             {
169 0     0 1 0 return 0;
170             }
171             ############################################################
172             sub is_input
173             {
174 0     0 1 0 return 0;
175             }
176             ############################################################
177             sub is_menu
178             {
179 21     21 1 56 return 0;
180             }
181             ############################################################
182             sub is_box
183             {
184 0     0 1 0 return 0;
185             }
186             ############################################################
187             sub is_hidden
188             {
189 0     0 1 0 return 0;
190             }
191             ############################################################
192             sub is_file
193             {
194 205     205 1 521 return 0;
195             }
196              
197             sub gui_type
198             {
199 0     0 1 0 confess "deferred";
200             }
201              
202             ############################################################
203             #
204             # ->is_mutable
205             #
206             # Check whether it is possible to change widget's value from a user interface.
207             # Optionally warn if widget's value cannot be changed.
208             #
209             ############################################################
210             sub is_mutable
211             {
212 36     36 1 32 my $this = shift;
213 36         26 my ($warn) = @_;
214              
215 36 50       50 if ($this->is_disabled)
216             {
217 0 0       0 carp 'cannot change value of disabled %s "%s"', $this->gui_type,
218             $this->name
219             if $warn;
220 0         0 return 0;
221             }
222              
223 36 50       94 if ($this->is_read_only)
224             {
225 0 0       0 carp 'cannot change value of read-only %s "%s"', $this->gui_type,
226             $this->name
227             if $warn;
228 0         0 return 0;
229             }
230              
231 36         60 return 1;
232             }
233              
234             ############################################################
235             #
236             # ->set_value
237             #
238             # Change value.
239             # Only allowd to proceed if mutable.
240             #
241             ############################################################
242             sub set_value
243             {
244 36     36 1 32 my $this = shift;
245 36         50 my ($value) = @_;
246              
247 36 50       80 return unless $this->is_mutable(1); # Cannot change value
248 36 50       52 return if $value eq $this->{value}; # No change
249              
250             #
251             # To ease redefinition, let this call _frozen_set_value, which is
252             # not redefinable and performs the common operation.
253             #
254              
255 36         84 $this->_frozen_set_value($value);
256 36         54 return;
257             }
258              
259             ############################################################
260             #
261             # ->_frozen_set_value -- frozen
262             #
263             # Change value.
264             #
265             ############################################################
266             sub _frozen_set_value
267             {
268 36     36   26 my $this = shift;
269 36         30 my ($value) = @_;
270              
271             #
272             # The first time we do this, save current value in `old_value'.
273             #
274              
275 36 100       64 $this->{old_value} = $this->{value} unless exists $this->{old_value};
276 36         32 $this->{value} = $value;
277              
278 36         32 return;
279             }
280              
281             ############################################################
282             #
283             # ->reset_state
284             #
285             # Called when a "Reset" button is pressed to restore the value the widget
286             # had upon form entry.
287             #
288             ############################################################
289             sub reset_state
290             {
291 0     0 1 0 my $this = shift;
292              
293             #
294             # If there is `old_value' attribute yet, then the value is already OK.
295             #
296              
297 0 0       0 return unless exists $this->{old_value};
298              
299             #
300             # Restore value from old_value, and delete this attribute to signal that
301             # the value is now back to its original setting.
302             #
303              
304 0         0 $this->{value} = delete $this->{old_value};
305 0         0 return;
306             }
307              
308             ############################################################
309             #
310             # ->is_submitable
311             #
312             # Check whether widget is "successful" (that's such an ugly name), in other
313             # words, whether its name/value pair should be part of submittted form data.
314             #
315             # A "successful" widget must not be disabled.
316             # Heirs should define the _is_successful internal routine.
317             #
318             # Returns true if submitable.
319             #
320             ############################################################
321             sub is_submitable
322             {
323 439     439 1 315 my $this = shift;
324              
325 439 50       589 return 0 if $this->is_disabled;
326 439         832 return $this->_is_successful;
327             }
328              
329             ############################################################
330             #
331             # ->_is_successful
332             #
333             # Is the enabled widget "successful", according to W3C's specs?
334             #
335             ############################################################
336             sub _is_successful
337             {
338 0     0   0 confess "deferred";
339             }
340              
341             ############################################################
342             #
343             # ->submit_tuples
344             #
345             # Returns list of (name => value) tuples that should be part of the
346             # submitted form data. There may be more than one tuple returned for
347             # scrollable lists only: each checkbox is a widget, and therefore can
348             # return only one tuple.
349             #
350             ############################################################
351             sub submit_tuples
352             {
353 243     243 1 144 my $this = shift;
354              
355 243         288 return ($this->name(), $this->value());
356             }
357              
358             ############################################################
359             #
360             # ->delete
361             #
362             # Done with this widget, cleanup by breaking circular refs.
363             #
364             ############################################################
365             sub delete
366             {
367 0     0 1   my $this = shift;
368 0           $this->{form} = undef;
369 0           return;
370             }
371              
372             1;
373              
374             =head1 NAME
375              
376             CGI::Test::Form::Widget - Ancestor of all form widget classes
377              
378             =head1 SYNOPSIS
379              
380             # Deferred class, only heirs can be created
381              
382             =head1 DESCRIPTION
383              
384             The C class is deferred.
385             It is an abstract representation of a widget, i.e. a graphical control
386             element like a popup menu or a submit button.
387              
388             Here is an outline of the class hierarchy tree, with the leading
389             C string stripped for readability, and a trailing C<*>
390             indicating deferred classes:
391              
392             Widget*
393             . Widget::Box*
394             . . Widget::Box::Check
395             . . Widget::Box::Radio
396             . Widget::Button*
397             . . Widget::Button::Plain
398             . . Widget::Button::Submit
399             . . Widget::Button::Image
400             . . Widget::Button::Reset
401             . Widget::Hidden
402             . Widget::Input*
403             . . Widget::Input::Text_Area
404             . . Widget::Input::Text_Field
405             . . Widget::Input::File
406             . . Widget::Input::Password
407             . Widget::Menu*
408             . . Widget::Menu::List
409             . . Widget::Menu::Popup
410              
411             Only leaf nodes are concrete classes, and there is one such class for each
412             known control type that can appear in the element.
413              
414             Those classes are constructed as needed by C. They are the
415             programmatic artefacts which can be used to manipulate those graphical
416             elements, on which you would otherwise click and fill within a browser.
417              
418             =head1 INTERFACE
419              
420             This is the interface defined at the C level,
421             and which is therefore common to all classes in the hierarchy.
422             Each subclass may naturally add further specific features.
423              
424             It is very important to stick to using common widget features when
425             writing a matching callback for the C routine in
426             C, or you run the risk of getting a runtime error
427             since Perl is not statically typed.
428              
429             =head2 Attributes
430              
431             =over 4
432              
433             =item C
434              
435             The C to which this widget belongs.
436              
437             =item C
438              
439             A human readable description of the widget, as it would appear on a GUI,
440             like "popup menu" or "radio button". Meant for logging only, not to
441             determine the object type.
442              
443             =item C
444              
445             The CGI parameter name.
446              
447             =item C
448              
449             The current CGI parameter value.
450              
451             =back
452              
453             =head2 Attribute Setting
454              
455             =over 4
456              
457             =item C I
458              
459             Change the C attribute to I.
460             The widget must not be C nor C.
461              
462             =back
463              
464             =head2 Widget Modification Predicates
465              
466             Those predicates may be used to determine whether it is possible to
467             change the value of a widget from the user interface.
468              
469             =over 4
470              
471             =item C
472              
473             When I, the widget is disabled, i.e. not available for editing.
474             It would typically appear as being I within a browser.
475              
476             This predicate is not architecturally defined: a widget may or may not
477             be marked as disabled in HTML via a suitable attribute.
478              
479             =item C [I]
480              
481             Test whether widget can change value. Returns I when
482             the widget C or C.
483              
484             When the optional I is true, C is called
485             to emit a warning from the perspective of the caller.
486              
487             =item C
488              
489             When I, the C parameter can be changed with C.
490             This is an architecturally defined predicate, i.e. its value depends only
491             on the widget type.
492              
493             =back
494              
495             =head2 Widget Classification Predicates
496              
497             Those predicates may be used to determine the overall widget type.
498             The classification is rather high level and only helps determining
499             the kind of calls that may be used on a given widget object.
500              
501             =over 4
502              
503             =item C
504              
505             Returns true for radio buttons and checkboxes.
506              
507             =item C
508              
509             Returns true for all buttons that are not boxes.
510              
511             =item C
512              
513             Returns true for a I widget, which allows file selection.
514              
515             =item C
516              
517             Returns true for hidden fields, which have no graphical representation
518             by definition.
519              
520             =item C
521              
522             Returns true for all input fields, where the user can type text.
523              
524             =item C
525              
526             Returns true for popup menus and scrolling lists.
527              
528             =back
529              
530             =head2 Miscellaneous Features
531              
532             Although documented, those features are more targetted for internal use...
533              
534             =over 4
535              
536             =item C
537              
538             Breaks circular references.
539             This is normally done by the C routine on the enclosing form.
540              
541             =item C
542              
543             Returns I when the name/value tupple of this widget need to be
544             part of the submitted parameters. The rules for determining the submitable
545             nature of a widget vary depending on the widget type.
546              
547             =item C
548              
549             Reset the widget's C to the one it had initially. Invoked internally
550             when a reset button is pressed.
551              
552             =item C
553              
554             For submitable widgets, return the list of (name => value) tupples that
555             should be part of the submitted data. Widgets like scrolling list may return
556             more than one tuple.
557              
558             This routine is invoked to compute the parameter list that must be sent back
559             when pressing a submit button.
560              
561             =back
562              
563             =head1 AUTHORS
564              
565             The original author is Raphael Manfredi.
566              
567             Steven Hilton was long time maintainer of this module.
568              
569             Current maintainer is Alexander Tokarev Ftokarev@cpan.orgE>.
570              
571             =head1 SEE ALSO
572              
573             CGI::Test::Form(3),
574             CGI::Test::Form::Widget::Box(3),
575             CGI::Test::Form::Widget::Button(3),
576             CGI::Test::Form::Widget::Input(3),
577             CGI::Test::Form::Widget::Hidden(3),
578             CGI::Test::Form::Widget::Menu(3).
579              
580             =cut
581