line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package HTML::FormHandler::Render::Util; |
2
|
|
|
|
|
|
|
# ABSTRACT: rendering utility |
3
|
1
|
|
|
1
|
|
51210
|
use Sub::Exporter; |
|
1
|
|
|
|
|
71999
|
|
|
1
|
|
|
|
|
9
|
|
4
|
|
|
|
|
|
|
Sub::Exporter::setup_exporter({ exports => [ 'process_attrs', 'cc_widget', 'ucc_widget' ] } ); |
5
|
|
|
|
|
|
|
|
6
|
|
|
|
|
|
|
|
7
|
|
|
|
|
|
|
# this is a function for processing various attribute flavors |
8
|
|
|
|
|
|
|
sub process_attrs { |
9
|
0
|
|
|
0
|
0
|
0
|
my ($attrs) = @_; |
10
|
|
|
|
|
|
|
|
11
|
0
|
|
|
|
|
0
|
my @use_attrs; |
12
|
0
|
|
0
|
|
|
0
|
my $javascript = delete $attrs->{javascript} || ''; |
13
|
0
|
|
|
|
|
0
|
for my $attr( sort keys %$attrs ) { |
14
|
0
|
|
|
|
|
0
|
my $value = ''; |
15
|
0
|
0
|
|
|
|
0
|
if( defined $attrs->{$attr} ) { |
16
|
0
|
0
|
|
|
|
0
|
if( ref $attrs->{$attr} eq 'ARRAY' ) { |
17
|
|
|
|
|
|
|
# we don't want class="" if no classes specified |
18
|
0
|
0
|
|
|
|
0
|
next unless scalar @{$attrs->{$attr}}; |
|
0
|
|
|
|
|
0
|
|
19
|
0
|
|
|
|
|
0
|
$value = join (' ', @{$attrs->{$attr}} ); |
|
0
|
|
|
|
|
0
|
|
20
|
|
|
|
|
|
|
} |
21
|
|
|
|
|
|
|
else { |
22
|
0
|
|
|
|
|
0
|
$value = $attrs->{$attr}; |
23
|
|
|
|
|
|
|
} |
24
|
|
|
|
|
|
|
} |
25
|
0
|
|
|
|
|
0
|
push @use_attrs, sprintf( '%s="%s"', $attr, $value ); |
26
|
|
|
|
|
|
|
} |
27
|
0
|
|
|
|
|
0
|
my $output = join( ' ', @use_attrs ); |
28
|
0
|
0
|
|
|
|
0
|
$output = " $output" if length $output; |
29
|
0
|
0
|
|
|
|
0
|
$output .= " $javascript" if $javascript; |
30
|
0
|
|
|
|
|
0
|
return $output; |
31
|
|
|
|
|
|
|
} |
32
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
sub cc_widget { |
34
|
4
|
|
|
4
|
0
|
9
|
my $widget = shift; |
35
|
4
|
50
|
|
|
|
12
|
return '' unless $widget; |
36
|
4
|
50
|
|
|
|
14
|
if($widget eq lc $widget) { |
37
|
4
|
|
|
|
|
45
|
$widget =~ s/^(\w{1})/\u$1/g; |
38
|
4
|
|
|
|
|
21
|
$widget =~ s/_(\w{1})/\u$1/g; |
39
|
|
|
|
|
|
|
} |
40
|
4
|
|
|
|
|
23
|
return $widget; |
41
|
|
|
|
|
|
|
} |
42
|
|
|
|
|
|
|
|
43
|
|
|
|
|
|
|
sub ucc_widget { |
44
|
4
|
|
|
4
|
0
|
30
|
my $widget = shift; |
45
|
4
|
50
|
|
|
|
20
|
if($widget ne lc $widget) { |
46
|
4
|
|
|
|
|
10
|
$widget =~ s/::/_/g; |
47
|
4
|
|
|
|
|
12
|
$widget = ucfirst($widget); |
48
|
4
|
|
|
|
|
30
|
my @parts = $widget =~ /([A-Z][a-z]*)/g; |
49
|
4
|
|
|
|
|
12
|
$widget = join('_', @parts); |
50
|
4
|
|
|
|
|
11
|
$widget = lc($widget); |
51
|
|
|
|
|
|
|
} |
52
|
4
|
|
|
|
|
26
|
return $widget; |
53
|
|
|
|
|
|
|
} |
54
|
|
|
|
|
|
|
|
55
|
|
|
|
|
|
|
|
56
|
|
|
|
|
|
|
1; |
57
|
|
|
|
|
|
|
|
58
|
|
|
|
|
|
|
__END__ |
59
|
|
|
|
|
|
|
|
60
|
|
|
|
|
|
|
=pod |
61
|
|
|
|
|
|
|
|
62
|
|
|
|
|
|
|
=encoding UTF-8 |
63
|
|
|
|
|
|
|
|
64
|
|
|
|
|
|
|
=head1 NAME |
65
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
HTML::FormHandler::Render::Util - rendering utility |
67
|
|
|
|
|
|
|
|
68
|
|
|
|
|
|
|
=head1 VERSION |
69
|
|
|
|
|
|
|
|
70
|
|
|
|
|
|
|
version 0.40057 |
71
|
|
|
|
|
|
|
|
72
|
|
|
|
|
|
|
=head1 SYNOPSIS |
73
|
|
|
|
|
|
|
|
74
|
|
|
|
|
|
|
The 'process_attrs' takes a hashref and creates an attribute string |
75
|
|
|
|
|
|
|
for constructing HTML. |
76
|
|
|
|
|
|
|
|
77
|
|
|
|
|
|
|
my $attrs => { |
78
|
|
|
|
|
|
|
some_attr => 1, |
79
|
|
|
|
|
|
|
placeholder => 'Enter email...", |
80
|
|
|
|
|
|
|
class => ['help', 'special'], |
81
|
|
|
|
|
|
|
}; |
82
|
|
|
|
|
|
|
my $string = process_attrs($attrs); |
83
|
|
|
|
|
|
|
|
84
|
|
|
|
|
|
|
...will produce: |
85
|
|
|
|
|
|
|
|
86
|
|
|
|
|
|
|
' some_attr="1" placeholder="Enter email..." class="help special"' |
87
|
|
|
|
|
|
|
|
88
|
|
|
|
|
|
|
If an arrayref is empty, it will be skipped. For a hash key of 'javascript' |
89
|
|
|
|
|
|
|
only the value will be appended (without '$key=""'); |
90
|
|
|
|
|
|
|
|
91
|
|
|
|
|
|
|
=head1 AUTHOR |
92
|
|
|
|
|
|
|
|
93
|
|
|
|
|
|
|
FormHandler Contributors - see HTML::FormHandler |
94
|
|
|
|
|
|
|
|
95
|
|
|
|
|
|
|
=head1 COPYRIGHT AND LICENSE |
96
|
|
|
|
|
|
|
|
97
|
|
|
|
|
|
|
This software is copyright (c) 2014 by Gerda Shank. |
98
|
|
|
|
|
|
|
|
99
|
|
|
|
|
|
|
This is free software; you can redistribute it and/or modify it under |
100
|
|
|
|
|
|
|
the same terms as the Perl 5 programming language system itself. |
101
|
|
|
|
|
|
|
|
102
|
|
|
|
|
|
|
=cut |