line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package App::Pod::Example; |
2
|
|
|
|
|
|
|
|
3
|
4
|
|
|
4
|
|
74586
|
use strict; |
|
4
|
|
|
|
|
26
|
|
|
4
|
|
|
|
|
112
|
|
4
|
4
|
|
|
4
|
|
23
|
use warnings; |
|
4
|
|
|
|
|
9
|
|
|
4
|
|
|
|
|
127
|
|
5
|
|
|
|
|
|
|
|
6
|
4
|
|
|
4
|
|
2022
|
use Class::Utils qw(set_params); |
|
4
|
|
|
|
|
118039
|
|
|
4
|
|
|
|
|
85
|
|
7
|
4
|
|
|
4
|
|
321
|
use English qw(-no_match_vars); |
|
4
|
|
|
|
|
8
|
|
|
4
|
|
|
|
|
29
|
|
8
|
4
|
|
|
4
|
|
1558
|
use Error::Pure qw(err); |
|
4
|
|
|
|
|
10
|
|
|
4
|
|
|
|
|
174
|
|
9
|
4
|
|
|
4
|
|
3214
|
use File::Temp qw(tempfile); |
|
4
|
|
|
|
|
79955
|
|
|
4
|
|
|
|
|
270
|
|
10
|
4
|
|
|
4
|
|
8017
|
use Getopt::Std; |
|
4
|
|
|
|
|
266
|
|
|
4
|
|
|
|
|
252
|
|
11
|
4
|
|
|
4
|
|
1868
|
use IO::Barf qw(barf); |
|
4
|
|
|
|
|
2412
|
|
|
4
|
|
|
|
|
65
|
|
12
|
4
|
|
|
4
|
|
2188
|
use Pod::Example qw(get); |
|
4
|
|
|
|
|
110925
|
|
|
4
|
|
|
|
|
122
|
|
13
|
4
|
|
|
4
|
|
290
|
use Readonly; |
|
4
|
|
|
|
|
9
|
|
|
4
|
|
|
|
|
3296
|
|
14
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
# Constants. |
16
|
|
|
|
|
|
|
Readonly::Scalar my $DASH => q{-}; |
17
|
|
|
|
|
|
|
Readonly::Scalar my $EMPTY_STR => q{}; |
18
|
|
|
|
|
|
|
Readonly::Scalar my $HASH => q{#}; |
19
|
|
|
|
|
|
|
Readonly::Scalar my $SPACE => q{ }; |
20
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
our $VERSION = 0.18; |
22
|
|
|
|
|
|
|
|
23
|
|
|
|
|
|
|
# Constructor. |
24
|
|
|
|
|
|
|
sub new { |
25
|
17
|
|
|
17
|
1
|
55883
|
my ($class, @params) = @_; |
26
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
# Create object. |
28
|
17
|
|
|
|
|
89
|
my $self = bless {}, $class; |
29
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
# Process params. |
31
|
17
|
|
|
|
|
231
|
set_params($self, @params); |
32
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
# Process arguments. |
34
|
15
|
|
|
|
|
272
|
$self->{'_opts'} = { |
35
|
|
|
|
|
|
|
'd' => 0, |
36
|
|
|
|
|
|
|
'h' => 0, |
37
|
|
|
|
|
|
|
'e' => 0, |
38
|
|
|
|
|
|
|
'n' => undef, |
39
|
|
|
|
|
|
|
'p' => 0, |
40
|
|
|
|
|
|
|
'r' => 0, |
41
|
|
|
|
|
|
|
's' => 'EXAMPLE', |
42
|
|
|
|
|
|
|
}; |
43
|
15
|
50
|
33
|
|
|
226
|
if (! getopts('d:ehn:prs:', $self->{'_opts'}) || @ARGV < 1 |
|
|
|
33
|
|
|
|
|
44
|
|
|
|
|
|
|
|| $self->{'_opts'}->{'h'}) { |
45
|
|
|
|
|
|
|
|
46
|
0
|
|
|
|
|
0
|
print STDERR "Usage: $0 [-d flag] [-e] [-h] [-n number] ". |
47
|
|
|
|
|
|
|
"[-p] [-r]\n\t[-s section] [--version] ". |
48
|
|
|
|
|
|
|
"pod_file_or_module [argument ..]\n\n"; |
49
|
0
|
|
|
|
|
0
|
print STDERR "\t-d flag\t\tTurn debug (0/1) (default is 1).\n"; |
50
|
0
|
|
|
|
|
0
|
print STDERR "\t-e\t\tEnumerate lines. Only for print mode.\n"; |
51
|
0
|
|
|
|
|
0
|
print STDERR "\t-h\t\tHelp.\n"; |
52
|
0
|
|
|
|
|
0
|
print STDERR "\t-n number\tNumber of example (default is ". |
53
|
|
|
|
|
|
|
"nothing).\n"; |
54
|
0
|
|
|
|
|
0
|
print STDERR "\t-p\t\tPrint example.\n"; |
55
|
0
|
|
|
|
|
0
|
print STDERR "\t-r\t\tRun example.\n"; |
56
|
0
|
|
|
|
|
0
|
print STDERR "\t-s section\tUse section (default EXAMPLE).\n"; |
57
|
0
|
|
|
|
|
0
|
print STDERR "\t--version\tPrint version.\n"; |
58
|
0
|
|
|
|
|
0
|
exit 1; |
59
|
|
|
|
|
|
|
} |
60
|
15
|
|
|
|
|
1524
|
$self->{'_pod_file_or_module'} = shift @ARGV; |
61
|
15
|
|
|
|
|
48
|
$self->{'_args'} = \@ARGV; |
62
|
15
|
|
|
|
|
42
|
$self->{'_debug'} = $self->{'_opts'}->{'d'}; |
63
|
15
|
|
|
|
|
40
|
$self->{'_enumerate'} = $self->{'_opts'}->{'e'}; |
64
|
15
|
|
|
|
|
33
|
$self->{'_number'} = $self->{'_opts'}->{'n'}; |
65
|
15
|
|
|
|
|
33
|
$self->{'_print'} = $self->{'_opts'}->{'p'}; |
66
|
15
|
|
|
|
|
48
|
$self->{'_run'} = $self->{'_opts'}->{'r'}; |
67
|
15
|
|
|
|
|
35
|
$self->{'_section'} = $self->{'_opts'}->{'s'}; |
68
|
|
|
|
|
|
|
|
69
|
|
|
|
|
|
|
# No action. |
70
|
15
|
100
|
100
|
|
|
72
|
if (! $self->{'_print'} && ! $self->{'_run'}) { |
71
|
1
|
|
|
|
|
4
|
err 'Cannot process any action (-p or -r options).'; |
72
|
|
|
|
|
|
|
} |
73
|
|
|
|
|
|
|
|
74
|
|
|
|
|
|
|
# Object. |
75
|
14
|
|
|
|
|
118
|
return $self; |
76
|
|
|
|
|
|
|
} |
77
|
|
|
|
|
|
|
|
78
|
|
|
|
|
|
|
# Run. |
79
|
|
|
|
|
|
|
sub run { |
80
|
14
|
|
|
14
|
1
|
33
|
my $self = shift; |
81
|
|
|
|
|
|
|
|
82
|
|
|
|
|
|
|
# Get example code. |
83
|
14
|
|
|
|
|
149
|
my $code = get($self->{'_pod_file_or_module'}, $self->{'_section'}, $self->{'_number'}); |
84
|
|
|
|
|
|
|
|
85
|
|
|
|
|
|
|
# No code. |
86
|
14
|
100
|
|
|
|
93854
|
if (! defined $code) { |
87
|
1
|
|
|
|
|
41
|
print "No code.\n"; |
88
|
1
|
|
|
|
|
7
|
return; |
89
|
|
|
|
|
|
|
} |
90
|
|
|
|
|
|
|
|
91
|
|
|
|
|
|
|
# Print. |
92
|
13
|
100
|
|
|
|
54
|
if ($self->{'_print'}) { |
93
|
3
|
100
|
|
|
|
8
|
if ($self->{'_debug'}) { |
94
|
1
|
|
|
|
|
4
|
_debug('Example source'); |
95
|
|
|
|
|
|
|
} |
96
|
3
|
100
|
|
|
|
15
|
if ($self->{'_enumerate'}) { |
97
|
1
|
|
|
|
|
8
|
my @lines = split "\n", $code; |
98
|
1
|
|
|
|
|
3
|
my $count = 1; |
99
|
1
|
|
|
|
|
10
|
foreach my $line (@lines) { |
100
|
5
|
|
|
|
|
74
|
print $count.': '.$line."\n"; |
101
|
5
|
|
|
|
|
23
|
$count++; |
102
|
|
|
|
|
|
|
} |
103
|
|
|
|
|
|
|
} else { |
104
|
2
|
|
|
|
|
52
|
print $code."\n"; |
105
|
|
|
|
|
|
|
} |
106
|
|
|
|
|
|
|
} |
107
|
|
|
|
|
|
|
|
108
|
|
|
|
|
|
|
# Run. |
109
|
13
|
100
|
|
|
|
44
|
if ($self->{'_run'}) { |
110
|
10
|
100
|
|
|
|
34
|
if ($self->{'_debug'}) { |
111
|
9
|
|
|
|
|
33
|
_debug('Example output'); |
112
|
|
|
|
|
|
|
} |
113
|
10
|
|
|
|
|
58
|
my (undef, $tempfile) = tempfile(); |
114
|
10
|
|
|
|
|
4653
|
barf($tempfile, $code); |
115
|
10
|
|
|
|
|
1865
|
my $args = $EMPTY_STR; |
116
|
10
|
100
|
|
|
|
22
|
if (@{$self->{'_args'}}) { |
|
10
|
|
|
|
|
43
|
|
117
|
1
|
|
|
|
|
8
|
$args = '"'.(join '" "', @{$self->{'_args'}}).'"'; |
|
1
|
|
|
|
|
9
|
|
118
|
|
|
|
|
|
|
} |
119
|
10
|
|
|
|
|
122548
|
system "$EXECUTABLE_NAME $tempfile $args"; |
120
|
10
|
|
|
|
|
9189
|
unlink $tempfile; |
121
|
|
|
|
|
|
|
} |
122
|
|
|
|
|
|
|
|
123
|
13
|
|
|
|
|
405
|
return; |
124
|
|
|
|
|
|
|
} |
125
|
|
|
|
|
|
|
|
126
|
|
|
|
|
|
|
sub _debug { |
127
|
10
|
|
|
10
|
|
85
|
my $text = shift; |
128
|
10
|
|
|
|
|
572
|
print $HASH, $DASH x 79, "\n"; |
129
|
10
|
|
|
|
|
142
|
print $HASH, $SPACE, $text."\n"; |
130
|
10
|
|
|
|
|
114
|
print $HASH, $DASH x 79, "\n"; |
131
|
10
|
|
|
|
|
40
|
return; |
132
|
|
|
|
|
|
|
} |
133
|
|
|
|
|
|
|
|
134
|
|
|
|
|
|
|
1; |
135
|
|
|
|
|
|
|
|
136
|
|
|
|
|
|
|
|
137
|
|
|
|
|
|
|
__END__ |