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   77317 use strict;
  4         37  
  4         149  
4 4     4   27 use warnings;
  4         10  
  4         168  
5              
6 4     4   2497 use Class::Utils qw(set_params);
  4         126687  
  4         81  
7 4     4   305 use English qw(-no_match_vars);
  4         8  
  4         25  
8 4     4   1463 use Error::Pure qw(err);
  4         6  
  4         168  
9 4     4   3207 use File::Temp qw(tempfile);
  4         78596  
  4         258  
10 4     4   8256 use Getopt::Std;
  4         213  
  4         243  
11 4     4   1935 use IO::Barf qw(barf);
  4         2451  
  4         71  
12 4     4   2255 use Pod::Example qw(get);
  4         114244  
  4         100  
13 4     4   312 use Readonly;
  4         10  
  4         3415  
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.19;
22              
23             # Constructor.
24             sub new {
25 17     17 1 57490 my ($class, @params) = @_;
26              
27             # Create object.
28 17         91 my $self = bless {}, $class;
29              
30             # Process params.
31 17         293 set_params($self, @params);
32              
33             # Process arguments.
34 15         283 $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     169 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         1660 $self->{'_pod_file_or_module'} = shift @ARGV;
61 15         44 $self->{'_args'} = \@ARGV;
62 15         41 $self->{'_debug'} = $self->{'_opts'}->{'d'};
63 15         33 $self->{'_enumerate'} = $self->{'_opts'}->{'e'};
64 15         37 $self->{'_number'} = $self->{'_opts'}->{'n'};
65 15         32 $self->{'_print'} = $self->{'_opts'}->{'p'};
66 15         48 $self->{'_run'} = $self->{'_opts'}->{'r'};
67 15         32 $self->{'_section'} = $self->{'_opts'}->{'s'};
68              
69             # No action.
70 15 100 100     134 if (! $self->{'_print'} && ! $self->{'_run'}) {
71 1         6 err 'Cannot process any action (-p or -r options).';
72             }
73              
74             # Object.
75 14         121 return $self;
76             }
77              
78             # Run.
79             sub run {
80 14     14 1 31 my $self = shift;
81              
82             # Get example code.
83 14         151 my $code = get($self->{'_pod_file_or_module'}, $self->{'_section'}, $self->{'_number'});
84              
85             # No code.
86 14 100       99234 if (! defined $code) {
87 1         35 print "No code.\n";
88 1         7 return;
89             }
90              
91             # Print.
92 13 100       47 if ($self->{'_print'}) {
93 3 100       20 if ($self->{'_debug'}) {
94 1         10 _debug('Example source');
95             }
96 3 100       15 if ($self->{'_enumerate'}) {
97 1         22 my @lines = split "\n", $code;
98 1         5 my $count = 1;
99 1         8 foreach my $line (@lines) {
100 5         71 print $count.': '.$line."\n";
101 5         18 $count++;
102             }
103             } else {
104 2         49 print $code."\n";
105             }
106             }
107              
108             # Run.
109 13 100       41 if ($self->{'_run'}) {
110 10 100       29 if ($self->{'_debug'}) {
111 9         27 _debug('Example output');
112             }
113 10         53 my (undef, $tempfile) = tempfile();
114 10         4366 barf($tempfile, $code);
115 10         1758 my $args = $EMPTY_STR;
116 10 100       21 if (@{$self->{'_args'}}) {
  10         44  
117 1         10 $args = '"'.(join '" "', @{$self->{'_args'}}).'"';
  1         14  
118             }
119 10         135133 system "$EXECUTABLE_NAME $tempfile $args";
120 10         1252 unlink $tempfile;
121             }
122              
123 13         509 return;
124             }
125              
126             sub _debug {
127 10     10   77 my $text = shift;
128 10         416 print $HASH, $DASH x 79, "\n";
129 10         149 print $HASH, $SPACE, $text."\n";
130 10         117 print $HASH, $DASH x 79, "\n";
131 10         35 return;
132             }
133              
134             1;
135              
136             __END__