line
stmt
bran
cond
sub
pod
time
code
1
package DBIx::HTML::PopupRadio;
2
3
2
2
76696
use strict;
2
15
2
59
4
2
2
11
use warnings;
2
3
2
72
5
6
2
2
1014
use HTML::Entities::Interpolate;
2
19070
2
13
7
8
our $VERSION = '1.17';
9
10
# -----------------------------------------------
11
12
# Encapsulated class data.
13
14
{
15
my(%_attr_data) =
16
( # Alphabetical order.
17
_dbh => '',
18
_default => '', # For popup_menu or radio_group.
19
_javascript => '',
20
_linebreak => 0, # For radio_group.
21
_name => 'dbix_menu',
22
_options => {},
23
_prompt => '', # For popup_menu.
24
_sql => '',
25
);
26
27
sub _default_for
28
{
29
0
0
my($self, $attr_name) = @_;
30
31
0
$_attr_data{$attr_name};
32
}
33
34
sub _read_data
35
{
36
0
0
my($self) = @_;
37
0
my($sth) = $$self{'_dbh'} -> prepare($$self{'_sql'});
38
0
$$self{'_data'} = {};
39
0
my($order) = 0;
40
41
0
$sth -> execute();
42
43
0
my($data);
44
45
0
while ($data = $sth -> fetch() )
46
{
47
0
$$self{'_data'}{$$data[0]} =
48
{
49
order => $order++,
50
value => $$data[1],
51
};
52
}
53
54
0
$$self{'_size'} = $order;
55
56
} # End of _read_data.
57
58
sub _standard_keys
59
{
60
0
0
sort keys %_attr_data;
61
}
62
63
sub _validate_options
64
{
65
0
0
my($self) = @_;
66
67
0
0
0
croak(__PACKAGE__ . ". You must supply values for these parameters: dbh, name and sql") if (! $$self{'_dbh'} || ! $$self{'_name'} || ! $$self{'_sql'});
68
69
# # Reset empty parameters to their defaults.
70
# # This could be optional, depending on another option.
71
#
72
# for my $attr_name ($self -> _standard_keys() )
73
# {
74
# $$self{$attr_name} = $self -> _default_for($attr_name) if (! $$self{$attr_name});
75
# }
76
77
} # End of _validate_options.
78
79
} # End of Encapsulated class data.
80
81
# -----------------------------------------------
82
83
sub new
84
{
85
0
0
1
my($class, %arg) = @_;
86
0
my($self) = bless({}, $class);
87
88
0
for my $attr_name ($self -> _standard_keys() )
89
{
90
0
my($arg_name) = $attr_name =~ /^_(.*)/;
91
92
0
0
if (exists($arg{$arg_name}) )
93
{
94
0
$$self{$attr_name} = $arg{$arg_name};
95
}
96
else
97
{
98
0
$$self{$attr_name} = $self -> _default_for($attr_name);
99
}
100
}
101
102
# This is the size (# if items) in the menu.
103
# Ie, it is the number of rows returned by the SQL.
104
105
0
$$self{'_size'} = 0;
106
107
0
return $self;
108
109
} # End of new.
110
111
# -----------------------------------------------
112
113
sub param
114
{
115
0
0
1
my($self, $id) = @_;
116
117
0
0
$id ? $$self{'_data'}{$id}{'value'} : '';
118
119
} # End of param.
120
121
# -----------------------------------------------
122
123
sub popup_menu
124
{
125
0
0
1
my($self, %arg) = @_;
126
127
# Give the user one last chance to set some parameters.
128
129
0
$self -> set(%arg);
130
0
$self -> _validate_options();
131
0
0
$self -> _read_data() if (! $$self{'_data'});
132
133
0
my(@html, $s);
134
135
0
$s = qq|
136
0
$s .= qq|$_="$Entitize{$$self{'_options'}{$_} }" | for sort keys %{$$self{'_options'} };
0
137
0
0
$s .= $$self{'_javascript'} if ($$self{'_javascript'});
138
0
$s .= '>';
139
140
0
push(@html, '', $s);
141
142
0
my($prompt) = $$self{'_prompt'};
143
144
0
0
if ($prompt)
145
{
146
0
0
if (ref($prompt) eq 'HASH')
147
{
148
0
push @html, qq|$Entitize{$$prompt{$_} } | for sort keys %$prompt;
149
}
150
else
151
{
152
0
push @html, qq|$Entitize{$prompt} |;
153
}
154
}
155
156
0
for (sort{$$self{'_data'}{$a}{'order'} <=> $$self{'_data'}{$b}{'order'} } keys %{$$self{'_data'} })
0
0
157
{
158
0
$s = qq|
159
0
0
0
$s .= qq| selected="selected"| if (defined($$self{'_default'}) && (lc $$self{'_default'} eq lc $$self{'_data'}{$_}{'value'}) );
160
0
$s .= qq|>$Entitize{$$self{'_data'}{$_}{'value'} }|;
161
162
0
push @html, $s;
163
}
164
165
0
push @html, '', '';
166
167
0
join "\n", @html;
168
169
} # End of popup_menu.
170
171
# -----------------------------------------------
172
173
sub radio_group
174
{
175
0
0
1
my($self, %arg) = @_;
176
177
# Give the user one last chance to set some parameters.
178
179
0
$self -> set(%arg);
180
0
$self -> _validate_options();
181
0
0
$self -> _read_data() if (! $$self{'_data'});
182
183
0
my($count) = 0;
184
185
0
my(@html, $s);
186
187
0
push @html, '';
188
189
0
for (sort{$$self{'_data'}{$a}{'order'} <=> $$self{'_data'}{$b}{'order'} } keys %{$$self{'_data'} })
0
0
190
{
191
0
$s = qq|
192
193
0
0
if ($$self{'_default'})
194
{
195
0
0
$s .= qq| checked="checked"| if (lc $$self{'_default'} eq lc $$self{'_data'}{$_}{'value'});
196
}
197
else
198
{
199
0
$count++;
200
201
0
0
$s .= qq| checked="checked"| if ($count == 1);
202
}
203
204
0
$s .= qq| />$Entitize{$$self{'_data'}{$_}{'value'} }|;
205
0
0
$s .= ' ' if ($$self{'_linebreak'});
206
207
0
push @html, $s;
208
}
209
210
0
push @html, '';
211
212
0
join "\n", @html;
213
214
} # End of radio_group.
215
216
# -----------------------------------------------
217
218
sub set
219
{
220
0
0
1
my($self, %arg) = @_;
221
222
0
for my $arg (keys %arg)
223
{
224
0
0
$$self{"_$arg"} = $arg{$arg} if (exists($$self{"_$arg"}) );
225
}
226
227
} # End of set.
228
229
# -----------------------------------------------
230
231
sub size
232
{
233
0
0
1
my($self) = @_;
234
235
0
$$self{'_size'};
236
237
} # End of size.
238
239
# -----------------------------------------------
240
241
1;
242
243
__END__