File Coverage

blib/lib/App/Perl/Module/Examples.pm
Criterion Covered Total %
statement 24 57 42.1
branch 0 8 0.0
condition 0 3 0.0
subroutine 8 10 80.0
pod 2 2 100.0
total 34 80 42.5


line stmt bran cond sub pod time code
1             package App::Perl::Module::Examples;
2              
3 2     2   60315 use strict;
  2         9  
  2         41  
4 2     2   9 use warnings;
  2         3  
  2         40  
5              
6 2     2   825 use Class::Utils qw(set_params);
  2         47303  
  2         32  
7 2     2   924 use File::Find::Rule;
  2         13604  
  2         13  
8 2     2   929 use File::Spec::Functions qw(catfile);
  2         1216  
  2         149  
9 2     2   3079 use Getopt::Std;
  2         93  
  2         102  
10 2     2   687 use IO::Barf qw(barf);
  2         1037  
  2         36  
11 2     2   1008 use Pod::Example qw(get sections);
  2         44099  
  2         39  
12              
13             our $VERSION = 0.01;
14              
15             # Constructor.
16             sub new {
17 0     0 1   my ($class, @params) = @_;
18              
19             # Create object.
20 0           my $self = bless {}, $class;
21              
22             # Process parameters.
23 0           set_params($self, @params);
24              
25             # Object.
26 0           return $self;
27             }
28              
29             # Run.
30             sub run {
31 0     0 1   my $self = shift;
32              
33             # Process arguments.
34 0           $self->{'_opts'} = {
35             'd' => 0,
36             'h' => 0,
37             };
38 0 0 0       if (! getopts('dh', $self->{'_opts'})
39             || $self->{'_opts'}->{'h'}) {
40              
41 0           print STDERR "Usage: $0 [-d] [-h] [--version]\n";
42 0           print STDERR "\t-d\t\tDebug mode.\n";
43 0           print STDERR "\t-h\t\tPrint help.\n";
44 0           print STDERR "\t--version\tPrint version.\n";
45 0           return 1;
46             }
47              
48             # Find all perl module files in actual directory.
49 0           my $rule = File::Find::Rule->new;
50 0           my @pm = $rule->or(
51             $rule->new->directory->name('t')->prune->discard,
52             $rule->new->directory->name('inc')->prune->discard,
53             $rule->new->directory->name('blib')->prune->discard,
54             $rule->new,
55             )->name('*.pm')->in('.');
56              
57             # Dump perl modules in debug mode.
58 0 0         if ($self->{'_opts'}->{'d'}) {
59 0           require Dumpvalue;
60 0           my $dump = Dumpvalue->new;
61 0           $dump->dumpValues(\@pm);
62             }
63              
64             # For each example save example.
65 0           my $num = 1;
66 0           foreach my $perl_module_file (@pm) {
67              
68             # Get all example sections.
69 0           my @examples = sections($perl_module_file);
70              
71             # For each section.
72 0           foreach my $example_sec (@examples) {
73              
74             # Create example content.
75 0           my ($example_data, $example_file) = get($perl_module_file, $example_sec);
76 0 0         if (! defined $example_file) {
77 0           $example_file = sprintf 'ex%d.pl', $num;
78             }
79 0           $example_data = "#!/usr/bin/env perl\n\n".
80             $example_data;
81 0           my $example_path = catfile('examples', $example_file);
82              
83             # Examples directory.
84 0 0         if (! -r 'examples') {
85 0           mkdir 'examples';
86             }
87              
88             # Save example.
89 0           barf($example_path, $example_data);
90 0           chmod 0755, $example_path;
91              
92 0           $num++;
93             }
94             }
95            
96 0           return 0;
97             }
98              
99             1;
100              
101             __END__