blib/lib/DBIx/CodeKit.pm | |||
---|---|---|---|
Criterion | Covered | Total | % |
statement | 15 | 270 | 5.5 |
branch | 0 | 134 | 0.0 |
condition | 0 | 61 | 0.0 |
subroutine | 5 | 24 | 20.8 |
pod | 2 | 15 | 13.3 |
total | 22 | 504 | 4.3 |
line | stmt | bran | cond | sub | pod | time | code |
---|---|---|---|---|---|---|---|
1 | package DBIx::CodeKit; | ||||||
2 | |||||||
3 | 1 | 1 | 32391 | use strict; | |||
1 | 2 | ||||||
1 | 44 | ||||||
4 | 1 | 1 | 6 | use warnings; | |||
1 | 2 | ||||||
1 | 34 | ||||||
5 | 1 | 1 | 4 | use Carp; | |||
1 | 6 | ||||||
1 | 75 | ||||||
6 | |||||||
7 | 1 | 1 | 5 | use vars qw( $VERSION ); | |||
1 | 2 | ||||||
1 | 2810 | ||||||
8 | $VERSION = '1.07'; | ||||||
9 | |||||||
10 | =head1 NAME | ||||||
11 | |||||||
12 | DBIx::CodeKit - Universal Code Table Interface | ||||||
13 | |||||||
14 | =head1 SYNOPSIS | ||||||
15 | |||||||
16 | use DBIx::CodeKit; | ||||||
17 | |||||||
18 | my $ck = new DBIx::CodeKit($dbh, | ||||||
19 | table => 'ck_code', | ||||||
20 | getparam => sub { $cgi->param(shift) }, | ||||||
21 | getparams => sub { $cgi->param(shift.'[]') } | ||||||
22 | ); | ||||||
23 | |||||||
24 | =cut | ||||||
25 | |||||||
26 | ### See the rest of the pod documentation at the end of this file. ### | ||||||
27 | |||||||
28 | sub new { | ||||||
29 | 0 | 0 | 0 | my $class = shift; | |||
30 | 0 | my $dbh = shift; | |||||
31 | 0 | 0 | my $args = ref($_[0]) ? shift : { @_ }; | ||||
32 | 0 | my $self = {}; | |||||
33 | 0 | bless $self, $class; | |||||
34 | |||||||
35 | 0 | 0 | croak 'DBIx::CodeKit->new($dbh): $dbh is not an object' unless ref $dbh; | ||||
36 | 0 | $self->{dbh} = $dbh; | |||||
37 | |||||||
38 | 0 | 0 | $self->{table} = $args->{table} || 'ck_code'; | ||||
39 | 0 | $self->{getparam} = $args->{getparam}; | |||||
40 | 0 | $self->{getparams} = $args->{getparams}; | |||||
41 | |||||||
42 | 0 | return $self; | |||||
43 | } | ||||||
44 | |||||||
45 | |||||||
46 | # # # HTML display methods. | ||||||
47 | |||||||
48 | sub desc { | ||||||
49 | 0 | 0 | 0 | my $self = shift; | |||
50 | 0 | return &htmlspecialchars( $self->data(@_) ); | |||||
51 | } | ||||||
52 | |||||||
53 | sub ucfirst { | ||||||
54 | 0 | 0 | 0 | my $self = shift; | |||
55 | 0 | return CORE::ucfirst( $self->desc(@_) ); | |||||
56 | } | ||||||
57 | |||||||
58 | sub ucwords { | ||||||
59 | 0 | 0 | 0 | my $self = shift; | |||
60 | 0 | my $str = $self->desc(@_); | |||||
61 | 0 | $str =~ s/(^|\s)([a-z])/$1\u$2/g; | |||||
62 | 0 | return $str; | |||||
63 | } | ||||||
64 | |||||||
65 | |||||||
66 | # # # Data methods. | ||||||
67 | |||||||
68 | sub data { | ||||||
69 | 0 | 0 | 0 | my $self = shift; | |||
70 | 0 | my $code_set = shift; | |||||
71 | 0 | my $code_code = shift; | |||||
72 | 0 | $code_code .= ''; # DBI needs strings here. | |||||
73 | 0 | 0 | $self->{data_sth} = $self->{dbh}->prepare(" | ||||
74 | select code_desc | ||||||
75 | from $self->{table} | ||||||
76 | where code_set = ? | ||||||
77 | and code_code = ? | ||||||
78 | ") unless $self->{data_sth}; | ||||||
79 | 0 | $self->{data_sth}->execute($code_set, $code_code); | |||||
80 | 0 | my $code_desc = $self->{data_sth}->fetchrow; | |||||
81 | 0 | 0 | $code_desc = '' unless defined $code_desc; # Avoid warnings. | ||||
82 | 0 | return $code_desc; | |||||
83 | } | ||||||
84 | |||||||
85 | |||||||
86 | # # # HTML select single value methods: | ||||||
87 | |||||||
88 | sub select { | ||||||
89 | 0 | 0 | 1 | my $self = shift; | |||
90 | 0 | my $code_set = shift; | |||||
91 | 0 | 0 | my $args = ref($_[0]) ? shift : { @_ }; | ||||
92 | |||||||
93 | 0 | 0 | my $var_name = $args->{var_name} || $code_set; | ||||
94 | 0 | my $value = $args->{value}; | |||||
95 | 0 | my $default = $args->{default}; | |||||
96 | 0 | my $subset = $args->{subset}; | |||||
97 | 0 | my $options = $args->{options}; | |||||
98 | 0 | my $select_prompt = $args->{select_prompt}; | |||||
99 | 0 | my $blank_prompt = $args->{blank_prompt}; | |||||
100 | |||||||
101 | # Variable setup. | ||||||
102 | 0 | $value = $self->_getparam($var_name, $value, $default); | |||||
103 | 0 | my $Subset = &keyme($subset); | |||||
104 | 0 | 0 | $options = $options ? " $options" : ''; | ||||
105 | 0 | 0 | $select_prompt = '' unless defined $select_prompt; | ||||
106 | 0 | 0 | $blank_prompt = '' unless defined $blank_prompt; | ||||
107 | |||||||
108 | # Drop down box. | ||||||
109 | 0 | my $select = " | |||||
110 | |||||||
111 | # Blank options. | ||||||
112 | 0 | my $selected = ''; | |||||
113 | 0 | 0 | if ($value eq '') { | ||||
0 | |||||||
114 | 0 | 0 | if ($select_prompt eq '') { | ||||
115 | 0 | $select_prompt = | |||||
116 | $self->ucwords('code_set', $code_set) . '?'; | ||||||
117 | } | ||||||
118 | 0 | $select .= " | |||||
119 | 0 | $selected = 1; | |||||
120 | } elsif ($blank_prompt ne '') { | ||||||
121 | 0 | $select .= " | |||||
122 | } | ||||||
123 | |||||||
124 | # Show code set options. | ||||||
125 | 0 | my $set_list = $self->code_set($code_set); | |||||
126 | 0 | for my $row ( @$set_list ) { | |||||
127 | 0 | my ($code_code, $code_desc) = @$row; | |||||
128 | 0 | 0 | 0 | next if ($Subset && !$Subset->{$code_code} && $code_code ne $value); | |||
0 | |||||||
129 | 0 | $code_desc = htmlspecialchars(CORE::ucfirst($code_desc)); | |||||
130 | |||||||
131 | 0 | 0 | if ($code_code eq $value) { | ||||
0 | |||||||
132 | 0 | $selected = 1; | |||||
133 | 0 | $select .= " | |||||
134 | } elsif ($row->[3] ne 'd') { | ||||||
135 | 0 | $select .= " | |||||
136 | } | ||||||
137 | } | ||||||
138 | |||||||
139 | # Show a missing value. | ||||||
140 | 0 | 0 | if (!$selected) { | ||||
141 | 0 | $select .= " | |||||
142 | } | ||||||
143 | |||||||
144 | 0 | $select .= "\n"; | |||||
145 | 0 | return $select; | |||||
146 | } | ||||||
147 | |||||||
148 | sub radio { | ||||||
149 | 0 | 0 | 0 | my $self = shift; | |||
150 | 0 | my $code_set = shift; | |||||
151 | 0 | 0 | my $args = ref($_[0]) ? shift : { @_ }; | ||||
152 | |||||||
153 | 0 | 0 | my $var_name = $args->{var_name} || $code_set; | ||||
154 | 0 | my $value = $args->{value}; | |||||
155 | 0 | my $default = $args->{default}; | |||||
156 | 0 | my $subset = $args->{subset}; | |||||
157 | 0 | my $options = $args->{options}; | |||||
158 | 0 | my $blank_prompt = $args->{blank_prompt}; | |||||
159 | 0 | my $sep = $args->{sep}; | |||||
160 | |||||||
161 | # Variable setup. | ||||||
162 | 0 | $value = $self->_getparam($var_name, $value, $default); | |||||
163 | 0 | my $Subset = &keyme($subset); | |||||
164 | 0 | 0 | $options = $options ? " $options" : ''; | ||||
165 | 0 | 0 | $blank_prompt = '' unless defined $blank_prompt; | ||||
166 | 0 | 0 | $sep = " \n" unless defined $sep; |
||||
167 | |||||||
168 | # Blank options. | ||||||
169 | 0 | my $select = ''; | |||||
170 | 0 | my $selected = ''; | |||||
171 | 0 | 0 | if ($value eq '') { | ||||
172 | 0 | $selected = 1; | |||||
173 | 0 | 0 | if ($blank_prompt ne '') { | ||||
174 | 0 | $select .= " | |||||
175 | 0 | $select .= " value=\"\" checked>$blank_prompt"; | |||||
176 | } | ||||||
177 | } else { | ||||||
178 | 0 | 0 | if ($blank_prompt ne '') { | ||||
179 | 0 | $select .= " | |||||
180 | 0 | $select .= " value=\"\">$blank_prompt"; | |||||
181 | } | ||||||
182 | } | ||||||
183 | |||||||
184 | # Show code set options. | ||||||
185 | 0 | my $set_list = $self->code_set($code_set); | |||||
186 | 0 | for my $row ( @$set_list ) { | |||||
187 | 0 | my ($code_code, $code_desc) = @$row; | |||||
188 | 0 | 0 | 0 | next if ($Subset && !$Subset->{$code_code} && $code_code ne $value); | |||
0 | |||||||
189 | 0 | $code_desc = htmlspecialchars(CORE::ucfirst($code_desc)); | |||||
190 | 0 | 0 | if ( $code_code eq $value ) { | ||||
0 | |||||||
191 | 0 | $selected = 1; | |||||
192 | 0 | 0 | $select .= $sep if $select; | ||||
193 | 0 | $select .= " | |||||
194 | 0 | $select .= " value=\"$code_code\" checked>$code_desc"; | |||||
195 | } elsif ($row->[3] ne 'd') { | ||||||
196 | 0 | 0 | $select .= $sep if $select; | ||||
197 | 0 | $select .= " | |||||
198 | 0 | $select .= " value=\"$code_code\">$code_desc"; | |||||
199 | } | ||||||
200 | } | ||||||
201 | |||||||
202 | # Show missing values. | ||||||
203 | 0 | 0 | if (!$selected) { | ||||
204 | 0 | 0 | $select .= $sep if $select; | ||||
205 | 0 | $select .= " | |||||
206 | 0 | $select .= " value=\"$value\" checked>$value"; | |||||
207 | } | ||||||
208 | |||||||
209 | 0 | return $select; | |||||
210 | } | ||||||
211 | |||||||
212 | |||||||
213 | # # # HTML select multiple value methods: | ||||||
214 | |||||||
215 | sub multiple { | ||||||
216 | 0 | 0 | 1 | my $self = shift; | |||
217 | 0 | my $code_set = shift; | |||||
218 | 0 | 0 | my $args = ref($_[0]) ? shift : { @_ }; | ||||
219 | |||||||
220 | 0 | 0 | my $var_name = $args->{var_name} || $code_set; | ||||
221 | 0 | my $value = $args->{value}; | |||||
222 | 0 | my $default = $args->{default}; | |||||
223 | 0 | my $subset = $args->{subset}; | |||||
224 | 0 | my $options = $args->{options}; | |||||
225 | 0 | my $size = $args->{size}; | |||||
226 | |||||||
227 | # Variable setup. | ||||||
228 | 0 | my $Value = $self->_getparams($var_name, $value, $default); | |||||
229 | 0 | my $Subset = &keyme($subset); | |||||
230 | 0 | 0 | $options = $options ? " $options" : ''; | ||||
231 | |||||||
232 | # Select multiple box. | ||||||
233 | 0 | my $select = " | |||||
234 | 0 | 0 | $select .= " size=\"$size\"" if ($size); | ||||
235 | 0 | $select .= ">\n"; | |||||
236 | |||||||
237 | # Show code set options. | ||||||
238 | 0 | my $set_list = $self->code_set($code_set); | |||||
239 | 0 | for my $row ( @$set_list ) { | |||||
240 | 0 | my ($code_code, $code_desc) = @$row; | |||||
241 | 0 | 0 | 0 | next if ($Subset && !$Subset->{$code_code} && !$Value->{$code_code}); | |||
0 | |||||||
242 | 0 | $code_desc = htmlspecialchars(CORE::ucfirst($code_desc)); | |||||
243 | 0 | 0 | if ( $Value->{$code_code} ) { | ||||
0 | |||||||
244 | 0 | $select .= " | |||||
245 | 0 | delete $Value->{$code_code}; | |||||
246 | } elsif ($row->[3] ne 'd') { | ||||||
247 | 0 | $select .= " | |||||
248 | } | ||||||
249 | } | ||||||
250 | |||||||
251 | # Show missing values. | ||||||
252 | 0 | for my $code_code ( keys %$Value ) { | |||||
253 | 0 | $select .= " | |||||
254 | } | ||||||
255 | |||||||
256 | 0 | $select .= "\n"; | |||||
257 | 0 | return $select; | |||||
258 | } | ||||||
259 | |||||||
260 | sub checkbox { | ||||||
261 | 0 | 0 | 0 | my $self = shift; | |||
262 | 0 | my $code_set = shift; | |||||
263 | 0 | 0 | my $args = ref($_[0]) ? shift : { @_ }; | ||||
264 | |||||||
265 | 0 | 0 | my $var_name = $args->{var_name} || $code_set; | ||||
266 | 0 | my $value = $args->{value}; | |||||
267 | 0 | my $default = $args->{default}; | |||||
268 | 0 | my $subset = $args->{subset}; | |||||
269 | 0 | my $options = $args->{options}; | |||||
270 | 0 | my $sep = $args->{sep}; | |||||
271 | |||||||
272 | # Variable setup. | ||||||
273 | 0 | my $Value = $self->_getparams($var_name, $value, $default); | |||||
274 | 0 | my $Subset = &keyme($subset); | |||||
275 | 0 | 0 | $options = $options ? " $options" : ''; | ||||
276 | 0 | 0 | $sep = " \n" unless defined $sep; |
||||
277 | |||||||
278 | # Show code set options. | ||||||
279 | 0 | my $select; | |||||
280 | 0 | my $set_list = $self->code_set($code_set); | |||||
281 | 0 | for my $row ( @$set_list ) { | |||||
282 | 0 | my ($code_code, $code_desc) = @$row; | |||||
283 | 0 | 0 | 0 | next if ($Subset && !$Subset->{$code_code} && !$Value->{$code_code}); | |||
0 | |||||||
284 | 0 | $code_desc = htmlspecialchars(CORE::ucfirst($code_desc)); | |||||
285 | 0 | 0 | if ( $Value->{$code_code} ) { | ||||
0 | |||||||
286 | 0 | 0 | $select .= $sep if $select; | ||||
287 | 0 | $select .= " | |||||
288 | 0 | $select .= "$options value=\"$code_code\" checked>$code_desc"; | |||||
289 | 0 | delete $Value->{$code_code}; | |||||
290 | } elsif ($row->[3] ne 'd') { | ||||||
291 | 0 | 0 | $select .= $sep if $select; | ||||
292 | 0 | $select .= " | |||||
293 | 0 | $select .= "$options value=\"$code_code\">$code_desc"; | |||||
294 | } | ||||||
295 | } | ||||||
296 | |||||||
297 | # Show missing values. | ||||||
298 | 0 | for my $code_code ( keys %$Value ) { | |||||
299 | 0 | 0 | $select .= $sep if $select; | ||||
300 | 0 | $select .= " | |||||
301 | 0 | $select .= "$options value=\"$code_code\" checked>$code_code"; | |||||
302 | } | ||||||
303 | |||||||
304 | 0 | return $select; | |||||
305 | } | ||||||
306 | |||||||
307 | |||||||
308 | # # # Code Set Methods. | ||||||
309 | |||||||
310 | sub code_set { | ||||||
311 | 0 | 0 | 0 | my $self = shift; | |||
312 | 0 | my $code_set = shift; | |||||
313 | 0 | 0 | $self->{set_sth} = $self->{dbh}->prepare(" | ||||
314 | select code_code, | ||||||
315 | code_desc, | ||||||
316 | code_order, | ||||||
317 | code_flag | ||||||
318 | from $self->{table} | ||||||
319 | where code_set = ? | ||||||
320 | order by code_order, code_code | ||||||
321 | ") unless $self->{set_sth}; | ||||||
322 | 0 | $self->{set_sth}->execute($code_set); | |||||
323 | 0 | return $self->{set_sth}->fetchall_arrayref; | |||||
324 | } | ||||||
325 | |||||||
326 | |||||||
327 | # # # Code Table Updates. | ||||||
328 | |||||||
329 | sub remove { | ||||||
330 | 0 | 0 | 0 | my $self = shift; | |||
331 | 0 | my $code_set = shift; | |||||
332 | 0 | my $code_code = shift; | |||||
333 | 0 | $code_code .= ''; # DBI needs strings here. | |||||
334 | 0 | 0 | $self->{remove_sth} = $self->{dbh}->prepare(" | ||||
335 | delete from $self->{table} | ||||||
336 | where code_set = ? | ||||||
337 | and code_code = ? | ||||||
338 | ") unless $self->{remove_sth}; | ||||||
339 | 0 | $self->{remove_sth}->execute($code_set, $code_code); | |||||
340 | } | ||||||
341 | |||||||
342 | sub get { | ||||||
343 | 0 | 0 | 0 | my $self = shift; | |||
344 | 0 | my $code_set = shift; | |||||
345 | 0 | my $code_code = shift; | |||||
346 | 0 | 0 | $self->{get_sth} = $self->{dbh}->prepare(" | ||||
347 | select code_desc, | ||||||
348 | code_order, | ||||||
349 | code_flag | ||||||
350 | from $self->{table} | ||||||
351 | where code_set = ? | ||||||
352 | and code_code = ? | ||||||
353 | ") unless $self->{get_sth}; | ||||||
354 | 0 | $self->{get_sth}->execute($code_set, $code_code); | |||||
355 | 0 | my @info = $self->{get_sth}->fetchrow_array; | |||||
356 | 0 | return @info; | |||||
357 | } | ||||||
358 | |||||||
359 | sub put { | ||||||
360 | 0 | 0 | 0 | my $self = shift; | |||
361 | 0 | my $code_set = shift; | |||||
362 | 0 | my $code_code = shift; | |||||
363 | 0 | my $code_desc = shift; | |||||
364 | 0 | my $code_order = shift; | |||||
365 | 0 | my $code_flag = shift; | |||||
366 | |||||||
367 | # Get the existing code info, if any. | ||||||
368 | 0 | my @old = $self->get($code_set, $code_code); | |||||
369 | |||||||
370 | # Field work. | ||||||
371 | 0 | $code_code .= ''; # DBI needs strings here. | |||||
372 | 0 | $code_desc .= ''; | |||||
373 | 0 | 0 | 0 | if (!@old and | |||
0 | |||||||
0 | |||||||
374 | ( not defined($code_order) or $code_order eq '' ) | ||||||
375 | and $code_code =~ /^\d+$/) { | ||||||
376 | 0 | $code_order = $code_code; | |||||
377 | } | ||||||
378 | { # Argument "" isn't numeric in int. Isn't that int's job? | ||||||
379 | 1 | 1 | 13 | no warnings; | |||
1 | 2 | ||||||
1 | 921 | ||||||
0 | |||||||
380 | 0 | $code_order = int($code_order); | |||||
381 | } | ||||||
382 | 0 | $code_flag .= ''; | |||||
383 | |||||||
384 | # Make it so: add, update, or delete. | ||||||
385 | 0 | 0 | if (@old) { | ||||
0 | |||||||
386 | 0 | my ( $old_desc, $old_order, $old_flag ) = @old; | |||||
387 | 0 | 0 | if ($code_desc ne '') { | ||||
388 | 0 | 0 | 0 | if ($code_desc ne $old_desc || | |||
0 | |||||||
389 | $code_order ne $old_order || | ||||||
390 | $code_flag ne $old_flag) { | ||||||
391 | 0 | $self->_update($code_set, $code_code, | |||||
392 | $code_desc, $code_order, $code_flag); | ||||||
393 | } | ||||||
394 | } | ||||||
395 | else { | ||||||
396 | 0 | $self->remove($code_set, $code_code); | |||||
397 | } | ||||||
398 | } | ||||||
399 | elsif ($code_desc ne '') { | ||||||
400 | 0 | $self->_insert($code_set, $code_code, | |||||
401 | $code_desc, $code_order, $code_flag); | ||||||
402 | } | ||||||
403 | } | ||||||
404 | |||||||
405 | |||||||
406 | # # # Private methods. | ||||||
407 | |||||||
408 | sub _insert { | ||||||
409 | 0 | 0 | my $self = shift; | ||||
410 | 0 | 0 | $self->{insert_sth} = $self->{dbh}->prepare(" | ||||
411 | insert into $self->{table} set | ||||||
412 | code_set = ?, | ||||||
413 | code_code = ?, | ||||||
414 | code_desc = ?, | ||||||
415 | code_order = ?, | ||||||
416 | code_flag = ? | ||||||
417 | ") unless $self->{insert_sth}; | ||||||
418 | 0 | $self->{insert_sth}->execute(@_); | |||||
419 | } | ||||||
420 | |||||||
421 | sub _update { | ||||||
422 | 0 | 0 | my $self = shift; | ||||
423 | 0 | my $code_set = shift; | |||||
424 | 0 | my $code_code = shift; | |||||
425 | 0 | my $code_desc = shift; | |||||
426 | 0 | my $code_order = shift; | |||||
427 | 0 | my $code_flag = shift; | |||||
428 | 0 | 0 | $self->{update_sth} = $self->{dbh}->prepare(" | ||||
429 | update $self->{table} set | ||||||
430 | code_desc = ?, | ||||||
431 | code_order = ?, | ||||||
432 | code_flag = ? | ||||||
433 | where code_set = ? | ||||||
434 | and code_code = ? | ||||||
435 | ") unless $self->{update_sth}; | ||||||
436 | 0 | $self->{update_sth}->execute( | |||||
437 | $code_desc, | ||||||
438 | $code_order, | ||||||
439 | $code_flag, | ||||||
440 | $code_set, | ||||||
441 | $code_code | ||||||
442 | ); | ||||||
443 | } | ||||||
444 | |||||||
445 | sub _getparam { | ||||||
446 | 0 | 0 | my $self = shift; | ||||
447 | 0 | my $var_name = shift; | |||||
448 | 0 | my $value = shift; | |||||
449 | 0 | my $default = shift; | |||||
450 | 0 | 0 | if ( not defined $value ) { | ||||
451 | 0 | 0 | if ( $self->{getparam} ) { | ||||
452 | 0 | $value = &{$self->{getparam}}($var_name); | |||||
0 | |||||||
453 | } | ||||||
454 | 0 | 0 | $value = $default unless defined $value; | ||||
455 | 0 | 0 | $value = '' unless defined $value; | ||||
456 | } | ||||||
457 | 0 | return $value; | |||||
458 | } | ||||||
459 | |||||||
460 | sub _getparams { | ||||||
461 | 0 | 0 | my $self = shift; | ||||
462 | 0 | my $var_name = shift; | |||||
463 | 0 | my $value = shift; | |||||
464 | 0 | my $default = shift; | |||||
465 | 0 | 0 | if ( not defined $value ) { | ||||
466 | 0 | 0 | my $call = $self->{getparams} ? $self->{getparams} : $self->{getparam}; | ||||
467 | 0 | 0 | if ( $call ) { | ||||
468 | 0 | $value = [ grep { defined $_ } &$call($var_name) ]; | |||||
0 | |||||||
469 | 0 | 0 | $value = $value->[0] if ref $value->[0]; | ||||
470 | } | ||||||
471 | 0 | 0 | $value = $default unless defined $value; | ||||
472 | 0 | 0 | $value = '' unless defined $value; | ||||
473 | } | ||||||
474 | 0 | 0 | return &keyme($value) || {}; | ||||
475 | } | ||||||
476 | |||||||
477 | sub keyme { | ||||||
478 | 0 | 0 | 0 | my $value = shift; | |||
479 | 0 | 0 | return $value if ref($value) eq 'HASH'; | ||||
480 | 0 | my $Keyhash; | |||||
481 | 0 | 0 | 0 | if (ref($value) eq 'ARRAY') { | |||
0 | 0 | ||||||
482 | 0 | for my $val ( @$value ) { $Keyhash->{$val} = 1; } | |||||
0 | |||||||
483 | } elsif (defined($value) && $value ne '' && !ref($value)) { | ||||||
484 | 0 | $Keyhash->{$value} = 1; | |||||
485 | } | ||||||
486 | 0 | return $Keyhash; | |||||
487 | } | ||||||
488 | |||||||
489 | sub htmlspecialchars { | ||||||
490 | 0 | 0 | 0 | my $str = shift; | |||
491 | 0 | $str =~ s/&/\&/g; | |||||
492 | 0 | $str =~ s/"/\"/g; | |||||
493 | 0 | $str =~ s/\</g; | |||||
494 | 0 | $str =~ s/>/\>/g; | |||||
495 | 0 | return $str; | |||||
496 | } | ||||||
497 | |||||||
498 | 1; | ||||||
499 | |||||||
500 | __END__ |