File Coverage

blib/lib/App/Perl/Module/Examples.pm
Criterion Covered Total %
statement 28 57 49.1
branch 0 8 0.0
condition 0 3 0.0
subroutine 9 10 90.0
pod 2 2 100.0
total 39 80 48.7


line stmt bran cond sub pod time code
1             package App::Perl::Module::Examples;
2              
3 3     3   75452 use strict;
  3         18  
  3         83  
4 3     3   15 use warnings;
  3         6  
  3         87  
5              
6 3     3   1491 use Class::Utils qw(set_params);
  3         40149  
  3         70  
7 3     3   1873 use File::Find::Rule;
  3         28912  
  3         24  
8 3     3   1618 use File::Spec::Functions qw(catfile);
  3         2755  
  3         226  
9 3     3   6106 use Getopt::Std;
  3         169  
  3         182  
10 3     3   1395 use IO::Barf qw(barf);
  3         2045  
  3         44  
11 3     3   1621 use Pod::Example qw(get sections);
  3         89942  
  3         73  
12              
13             our $VERSION = 0.02;
14              
15             # Constructor.
16             sub new {
17 2     2 1 818 my ($class, @params) = @_;
18              
19             # Create object.
20 2         6 my $self = bless {}, $class;
21              
22             # Process parameters.
23 2         15 set_params($self, @params);
24              
25             # Object.
26 1         11 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__