line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
15
|
|
|
15
|
|
9632
|
use strict; |
|
15
|
|
|
|
|
27
|
|
|
15
|
|
|
|
|
368
|
|
2
|
15
|
|
|
15
|
|
70
|
use warnings; |
|
15
|
|
|
|
|
24
|
|
|
15
|
|
|
|
|
821
|
|
3
|
|
|
|
|
|
|
package HTML::Widget::Plugin::Input; |
4
|
|
|
|
|
|
|
# ABSTRACT: the most basic input widget |
5
|
|
|
|
|
|
|
$HTML::Widget::Plugin::Input::VERSION = '0.204'; |
6
|
15
|
|
|
15
|
|
72
|
use parent 'HTML::Widget::Plugin'; |
|
15
|
|
|
|
|
26
|
|
|
15
|
|
|
|
|
80
|
|
7
|
|
|
|
|
|
|
|
8
|
|
|
|
|
|
|
#pod =head1 SYNOPSIS |
9
|
|
|
|
|
|
|
#pod |
10
|
|
|
|
|
|
|
#pod $widget_factory->input({ |
11
|
|
|
|
|
|
|
#pod id => 'flavor', # if "name" isn't given, id will be used for name |
12
|
|
|
|
|
|
|
#pod size => 25, |
13
|
|
|
|
|
|
|
#pod value => $default_flavor, |
14
|
|
|
|
|
|
|
#pod }); |
15
|
|
|
|
|
|
|
#pod |
16
|
|
|
|
|
|
|
#pod ...or... |
17
|
|
|
|
|
|
|
#pod |
18
|
|
|
|
|
|
|
#pod $widget_factory->hidden({ |
19
|
|
|
|
|
|
|
#pod id => 'flavor', # if "name" isn't given, id will be used for name |
20
|
|
|
|
|
|
|
#pod value => $default_flavor, |
21
|
|
|
|
|
|
|
#pod }); |
22
|
|
|
|
|
|
|
#pod |
23
|
|
|
|
|
|
|
#pod =head1 DESCRIPTION |
24
|
|
|
|
|
|
|
#pod |
25
|
|
|
|
|
|
|
#pod This plugin provides a basic input widget. |
26
|
|
|
|
|
|
|
#pod |
27
|
|
|
|
|
|
|
#pod The C attribute may be used to add a default class to every |
28
|
|
|
|
|
|
|
#pod produced input. This class cannot be overridden. |
29
|
|
|
|
|
|
|
#pod |
30
|
|
|
|
|
|
|
#pod my $plugin = HTML::Widget::Factory::Input->new({ |
31
|
|
|
|
|
|
|
#pod default_classes => [ qw(foo bar) ], |
32
|
|
|
|
|
|
|
#pod }); |
33
|
|
|
|
|
|
|
#pod |
34
|
|
|
|
|
|
|
#pod =cut |
35
|
|
|
|
|
|
|
|
36
|
15
|
|
|
15
|
|
944
|
use HTML::Element; |
|
15
|
|
|
|
|
24
|
|
|
15
|
|
|
|
|
94
|
|
37
|
|
|
|
|
|
|
|
38
|
|
|
|
|
|
|
#pod =head1 METHODS |
39
|
|
|
|
|
|
|
#pod |
40
|
|
|
|
|
|
|
#pod =head2 C< provided_widgets > |
41
|
|
|
|
|
|
|
#pod |
42
|
|
|
|
|
|
|
#pod This plugin provides the following widgets: input, hidden |
43
|
|
|
|
|
|
|
#pod |
44
|
|
|
|
|
|
|
#pod =cut |
45
|
|
|
|
|
|
|
|
46
|
19
|
|
|
19
|
1
|
67
|
sub provided_widgets { qw(input hidden) } |
47
|
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
#pod =head2 C< input > |
49
|
|
|
|
|
|
|
#pod |
50
|
|
|
|
|
|
|
#pod This method returns a basic one-line text-entry widget. |
51
|
|
|
|
|
|
|
#pod |
52
|
|
|
|
|
|
|
#pod In addition to the generic L attributes, the following |
53
|
|
|
|
|
|
|
#pod are valid arguments: |
54
|
|
|
|
|
|
|
#pod |
55
|
|
|
|
|
|
|
#pod =over |
56
|
|
|
|
|
|
|
#pod |
57
|
|
|
|
|
|
|
#pod =item value |
58
|
|
|
|
|
|
|
#pod |
59
|
|
|
|
|
|
|
#pod This is the widget's initial value. |
60
|
|
|
|
|
|
|
#pod |
61
|
|
|
|
|
|
|
#pod =item type |
62
|
|
|
|
|
|
|
#pod |
63
|
|
|
|
|
|
|
#pod This is the type of input widget to be created. You may wish to use a |
64
|
|
|
|
|
|
|
#pod different plugin, instead. |
65
|
|
|
|
|
|
|
#pod |
66
|
|
|
|
|
|
|
#pod =back |
67
|
|
|
|
|
|
|
#pod |
68
|
|
|
|
|
|
|
#pod =cut |
69
|
|
|
|
|
|
|
|
70
|
84
|
|
|
84
|
|
359
|
sub _attribute_args { qw(disabled type value size maxlength) } |
71
|
135
|
|
|
135
|
|
378
|
sub _boolean_args { qw(disabled) } |
72
|
|
|
|
|
|
|
|
73
|
|
|
|
|
|
|
sub input { |
74
|
8
|
|
|
8
|
1
|
15
|
my ($self, $factory, $arg) = @_; |
75
|
|
|
|
|
|
|
|
76
|
8
|
|
|
|
|
24
|
$self->build($factory, $arg); |
77
|
|
|
|
|
|
|
} |
78
|
|
|
|
|
|
|
|
79
|
|
|
|
|
|
|
#pod =head2 C< hidden > |
80
|
|
|
|
|
|
|
#pod |
81
|
|
|
|
|
|
|
#pod This method returns a hidden input that is not displayed in the rendered HTML. |
82
|
|
|
|
|
|
|
#pod Its arguments are the same as those to C. |
83
|
|
|
|
|
|
|
#pod |
84
|
|
|
|
|
|
|
#pod This method may later be factored out into a plugin. |
85
|
|
|
|
|
|
|
#pod |
86
|
|
|
|
|
|
|
#pod =cut |
87
|
|
|
|
|
|
|
|
88
|
|
|
|
|
|
|
sub hidden { |
89
|
1
|
|
|
1
|
1
|
3
|
my ($self, $factory, $arg) = @_; |
90
|
|
|
|
|
|
|
|
91
|
1
|
|
|
|
|
2
|
$arg->{attr}{type} = 'hidden'; |
92
|
|
|
|
|
|
|
|
93
|
1
|
|
|
|
|
4
|
$self->build($factory, $arg); |
94
|
|
|
|
|
|
|
} |
95
|
|
|
|
|
|
|
|
96
|
|
|
|
|
|
|
#pod =head2 C< build > |
97
|
|
|
|
|
|
|
#pod |
98
|
|
|
|
|
|
|
#pod my $widget = $class->build($factory, $arg); |
99
|
|
|
|
|
|
|
#pod |
100
|
|
|
|
|
|
|
#pod This method does the actual construction of the input based on the args |
101
|
|
|
|
|
|
|
#pod collected by the widget-constructing method. It is primarily here for |
102
|
|
|
|
|
|
|
#pod subclasses to exploit. |
103
|
|
|
|
|
|
|
#pod |
104
|
|
|
|
|
|
|
#pod =cut |
105
|
|
|
|
|
|
|
|
106
|
|
|
|
|
|
|
sub build { |
107
|
11
|
|
|
11
|
1
|
16
|
my ($self, $factory, $arg) = @_; |
108
|
|
|
|
|
|
|
|
109
|
11
|
100
|
|
|
|
47
|
$arg->{attr}{name} = $arg->{attr}{id} unless defined $arg->{attr}{name}; |
110
|
|
|
|
|
|
|
|
111
|
11
|
|
|
|
|
46
|
my $widget = HTML::Element->new('input'); |
112
|
|
|
|
|
|
|
|
113
|
11
|
|
|
|
|
266
|
$widget->attr($_ => $arg->{attr}{$_}) for keys %{ $arg->{attr} }; |
|
11
|
|
|
|
|
69
|
|
114
|
11
|
|
|
|
|
417
|
return $widget->as_XML; |
115
|
|
|
|
|
|
|
} |
116
|
|
|
|
|
|
|
|
117
|
|
|
|
|
|
|
sub rewrite_arg { |
118
|
11
|
|
|
11
|
1
|
20
|
my ($self, $arg, $method) = @_; |
119
|
|
|
|
|
|
|
|
120
|
11
|
|
|
|
|
50
|
$arg = $self->SUPER::rewrite_arg($arg); |
121
|
|
|
|
|
|
|
|
122
|
11
|
100
|
66
|
|
|
56
|
if ($self->{default_classes} && $method ne 'hidden') { |
123
|
2
|
|
|
|
|
3
|
my $class = join q{ }, @{ $self->{default_classes} }; |
|
2
|
|
|
|
|
6
|
|
124
|
|
|
|
|
|
|
$arg->{attr}{class} = defined $arg->{attr}{class} |
125
|
2
|
100
|
|
|
|
10
|
? "$class $arg->{attr}{class}" |
126
|
|
|
|
|
|
|
: $class; |
127
|
|
|
|
|
|
|
} |
128
|
|
|
|
|
|
|
|
129
|
11
|
|
|
|
|
29
|
return $arg; |
130
|
|
|
|
|
|
|
} |
131
|
|
|
|
|
|
|
|
132
|
|
|
|
|
|
|
|
133
|
|
|
|
|
|
|
1; |
134
|
|
|
|
|
|
|
|
135
|
|
|
|
|
|
|
__END__ |