| line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
|
1
|
2
|
|
|
2
|
|
11301705
|
use strict; |
|
|
2
|
|
|
|
|
4
|
|
|
|
2
|
|
|
|
|
64
|
|
|
2
|
2
|
|
|
2
|
|
10
|
use warnings; |
|
|
2
|
|
|
|
|
2
|
|
|
|
2
|
|
|
|
|
94
|
|
|
3
|
|
|
|
|
|
|
|
|
4
|
|
|
|
|
|
|
package Petal::CodePerl::Expr; |
|
5
|
|
|
|
|
|
|
|
|
6
|
|
|
|
|
|
|
require Exporter; |
|
7
|
2
|
|
|
2
|
|
10
|
use base 'Exporter'; |
|
|
2
|
|
|
|
|
7
|
|
|
|
2
|
|
|
|
|
140
|
|
|
8
|
|
|
|
|
|
|
|
|
9
|
2
|
|
|
2
|
|
1096
|
use Petal::CodePerl::Expr::DerefTAL; |
|
|
2
|
|
|
|
|
8
|
|
|
|
2
|
|
|
|
|
128
|
|
|
10
|
2
|
|
|
2
|
|
1588
|
use Petal::CodePerl::Expr::PathExists; |
|
|
2
|
|
|
|
|
6
|
|
|
|
2
|
|
|
|
|
58
|
|
|
11
|
2
|
|
|
2
|
|
1398
|
use Petal::CodePerl::Expr::Alternate; |
|
|
2
|
|
|
|
|
6
|
|
|
|
2
|
|
|
|
|
66
|
|
|
12
|
2
|
|
|
2
|
|
1498
|
use Petal::CodePerl::Expr::PerlSprintf; |
|
|
2
|
|
|
|
|
6
|
|
|
|
2
|
|
|
|
|
492
|
|
|
13
|
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
our %EXPORT_TAGS = ( |
|
15
|
|
|
|
|
|
|
easy => [qw( dereft pathexists alternate perlsprintf )], |
|
16
|
|
|
|
|
|
|
); |
|
17
|
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
our @EXPORT_OK = @{$EXPORT_TAGS{"easy"}}; |
|
19
|
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
=head1 NAME |
|
21
|
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
Code::Perl::Expr - Extra Code::Perl classes for Petal |
|
23
|
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
=head1 DESCRIPTION |
|
25
|
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
These are some extra L Expression classes that are specific to |
|
27
|
|
|
|
|
|
|
Petal |
|
28
|
|
|
|
|
|
|
|
|
29
|
|
|
|
|
|
|
=head1 EXPRESSION CLASSES |
|
30
|
|
|
|
|
|
|
|
|
31
|
|
|
|
|
|
|
C has been removed from the front of the class names, |
|
32
|
|
|
|
|
|
|
so for example C is really C. |
|
33
|
|
|
|
|
|
|
|
|
34
|
|
|
|
|
|
|
=cut |
|
35
|
|
|
|
|
|
|
|
|
36
|
|
|
|
|
|
|
=head2 Alternate |
|
37
|
|
|
|
|
|
|
|
|
38
|
|
|
|
|
|
|
$class->new(Paths => \@paths); |
|
39
|
|
|
|
|
|
|
|
|
40
|
|
|
|
|
|
|
alternate(@paths); |
|
41
|
|
|
|
|
|
|
|
|
42
|
|
|
|
|
|
|
@paths - an array of Expression objects |
|
43
|
|
|
|
|
|
|
|
|
44
|
|
|
|
|
|
|
Alternate will try each expression in turn, looking for the first one which |
|
45
|
|
|
|
|
|
|
evaluates without dieing. |
|
46
|
|
|
|
|
|
|
|
|
47
|
|
|
|
|
|
|
=cut |
|
48
|
|
|
|
|
|
|
|
|
49
|
|
|
|
|
|
|
sub alternate |
|
50
|
|
|
|
|
|
|
{ |
|
51
|
18
|
|
|
18
|
0
|
1865
|
return Petal::CodePerl::Expr::Alternate->new( |
|
52
|
|
|
|
|
|
|
Paths => [@_], |
|
53
|
|
|
|
|
|
|
); |
|
54
|
|
|
|
|
|
|
} |
|
55
|
|
|
|
|
|
|
|
|
56
|
|
|
|
|
|
|
=head2 |
|
57
|
|
|
|
|
|
|
|
|
58
|
|
|
|
|
|
|
$class->new(Expr => $path); |
|
59
|
|
|
|
|
|
|
|
|
60
|
|
|
|
|
|
|
pathexists($path); |
|
61
|
|
|
|
|
|
|
|
|
62
|
|
|
|
|
|
|
$path - an Expression object |
|
63
|
|
|
|
|
|
|
|
|
64
|
|
|
|
|
|
|
PathExists will return true if the $path can be followed without dieing, |
|
65
|
|
|
|
|
|
|
false otherwise |
|
66
|
|
|
|
|
|
|
|
|
67
|
|
|
|
|
|
|
=cut |
|
68
|
|
|
|
|
|
|
|
|
69
|
|
|
|
|
|
|
sub pathexists |
|
70
|
|
|
|
|
|
|
{ |
|
71
|
1
|
|
|
1
|
0
|
124
|
my $expr = shift; |
|
72
|
|
|
|
|
|
|
|
|
73
|
1
|
|
|
|
|
16
|
return Petal::CodePerl::Expr::PathExists->new( |
|
74
|
|
|
|
|
|
|
Expr => $expr, |
|
75
|
|
|
|
|
|
|
); |
|
76
|
|
|
|
|
|
|
} |
|
77
|
|
|
|
|
|
|
|
|
78
|
|
|
|
|
|
|
=head2 DerefTAL |
|
79
|
|
|
|
|
|
|
|
|
80
|
|
|
|
|
|
|
$class->new(Ref => $ref, Key => $key); |
|
81
|
|
|
|
|
|
|
|
|
82
|
|
|
|
|
|
|
dereft($ref, $key); |
|
83
|
|
|
|
|
|
|
|
|
84
|
|
|
|
|
|
|
$ref - an Expression object |
|
85
|
|
|
|
|
|
|
$key - a string |
|
86
|
|
|
|
|
|
|
|
|
87
|
|
|
|
|
|
|
DerefTAL will attempt to dereference the object returned by $ref in the TAL |
|
88
|
|
|
|
|
|
|
style, using the $key. This means if $ref yields a blessed reference the |
|
89
|
|
|
|
|
|
|
$key will used as a method name if possible. If $key cannot be used as a |
|
90
|
|
|
|
|
|
|
method name or $ref yielded an unblessed reference then DerefTAL tries to |
|
91
|
|
|
|
|
|
|
dereference $ref as an array or a hash, using $key. If $ref doesn't yield a |
|
92
|
|
|
|
|
|
|
reference then we die. |
|
93
|
|
|
|
|
|
|
|
|
94
|
|
|
|
|
|
|
=cut |
|
95
|
|
|
|
|
|
|
|
|
96
|
|
|
|
|
|
|
sub dereft |
|
97
|
|
|
|
|
|
|
{ |
|
98
|
15
|
|
|
15
|
0
|
1039
|
my $ref = shift; |
|
99
|
15
|
|
|
|
|
26
|
my $key = shift; |
|
100
|
15
|
|
50
|
|
|
74
|
my $strict = shift || 0; |
|
101
|
|
|
|
|
|
|
|
|
102
|
15
|
|
|
|
|
100
|
return Petal::CodePerl::Expr::DerefTAL->new( |
|
103
|
|
|
|
|
|
|
Ref => $ref, |
|
104
|
|
|
|
|
|
|
Key => $key, |
|
105
|
|
|
|
|
|
|
Strict => $strict, |
|
106
|
|
|
|
|
|
|
); |
|
107
|
|
|
|
|
|
|
} |
|
108
|
|
|
|
|
|
|
|
|
109
|
|
|
|
|
|
|
=head2 PerlSprintf |
|
110
|
|
|
|
|
|
|
|
|
111
|
|
|
|
|
|
|
$class->new(Perl => $perl, Params => \@params); |
|
112
|
|
|
|
|
|
|
|
|
113
|
|
|
|
|
|
|
perlsprintf($perl, @params); |
|
114
|
|
|
|
|
|
|
|
|
115
|
|
|
|
|
|
|
$string - an string of Perl code |
|
116
|
|
|
|
|
|
|
@params - an array of exprs to be place into the string |
|
117
|
|
|
|
|
|
|
|
|
118
|
|
|
|
|
|
|
B
|
|
119
|
|
|
|
|
|
|
hopefully it will go away soon> |
|
120
|
|
|
|
|
|
|
|
|
121
|
|
|
|
|
|
|
When PerlSprintf is producing Perl code, it will use Perl's sprintf function |
|
122
|
|
|
|
|
|
|
to insert the expressions in @params into the string in $string. You should |
|
123
|
|
|
|
|
|
|
put a %s in $string to mark where you want the expressions in @params to be |
|
124
|
|
|
|
|
|
|
placed. The expressions will be wrapped in () to avoid precedence problems. |
|
125
|
|
|
|
|
|
|
Because it uses Perl's sprintf function you must B if there is |
|
126
|
|
|
|
|
|
|
a "%" in your Perl, you have to change any "%" to "%%". |
|
127
|
|
|
|
|
|
|
|
|
128
|
|
|
|
|
|
|
|
|
129
|
|
|
|
|
|
|
perlsprintf('$array[%s].$hash->{%s}', scal("a"), string("harry")); |
|
130
|
|
|
|
|
|
|
|
|
131
|
|
|
|
|
|
|
will give perl like |
|
132
|
|
|
|
|
|
|
|
|
133
|
|
|
|
|
|
|
$array[($a]).$hash->{"harray"} |
|
134
|
|
|
|
|
|
|
|
|
135
|
|
|
|
|
|
|
=cut |
|
136
|
|
|
|
|
|
|
|
|
137
|
|
|
|
|
|
|
sub perlsprintf |
|
138
|
|
|
|
|
|
|
{ |
|
139
|
3
|
|
|
3
|
0
|
76
|
my $perl = shift; |
|
140
|
3
|
|
|
|
|
9
|
my @params = @_; |
|
141
|
|
|
|
|
|
|
|
|
142
|
3
|
|
|
|
|
41
|
return Petal::CodePerl::Expr::PerlSprintf->new( |
|
143
|
|
|
|
|
|
|
Perl => $perl, |
|
144
|
|
|
|
|
|
|
Params => \@params, |
|
145
|
|
|
|
|
|
|
); |
|
146
|
|
|
|
|
|
|
} |
|
147
|
|
|
|
|
|
|
|
|
148
|
|
|
|
|
|
|
1; |
|
149
|
|
|
|
|
|
|
|
|
150
|
|
|
|
|
|
|
__END__ |