File Coverage

blib/lib/App/Pod/Example.pm
Criterion Covered Total %
statement 79 89 88.7
branch 17 18 94.4
condition 5 9 55.5
subroutine 13 13 100.0
pod 2 2 100.0
total 116 131 88.5


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__