File Coverage

blib/lib/Pod/Generate/Recursive.pm
Criterion Covered Total %
statement 23 25 92.0
branch n/a
condition n/a
subroutine 8 8 100.0
pod n/a
total 31 33 93.9


line stmt bran cond sub pod time code
1             package Pod::Generate::Recursive;
2              
3 1     1   16966 use strict;
  1         2  
  1         54  
4 1     1   7 use warnings;
  1         7  
  1         42  
5              
6 1         108 use vars qw{
7             $VERSION
8             @ISA
9             @EXPORT
10             @EXPORT_OK
11             $source
12             $destination
13             $debug
14 1     1   11 };
  1         6  
15              
16             BEGIN
17             {
18 1     1   6 require Exporter;
19              
20 1         7 @ISA = qw( Exporter );
21 1         5 @EXPORT = qw( debug destination source);
22 1         20 @EXPORT_OK = qw( );
23             }
24              
25 1     1   588 use Data::Dumper qw(Dumper);
  1         8872  
  1         108  
26 1     1   9 use File::Find qw( finddepth );
  1         1  
  1         56  
27 1     1   5 use File::Path qw( make_path );
  1         2  
  1         40  
28 1     1   210 use Pod::POM;
  0            
  0            
29             use Pod::POM::View::Pod;
30              
31             =head1 NAME
32              
33             Pod::Generate::Recursive - Generate POD for directory contents.
34              
35             =head1 VERSION
36              
37             Version 0.3
38              
39             =cut
40              
41             our $VERSION = '0.3';
42              
43             =head1 SYNOPSIS
44              
45             use Pod::Generate::Recursive;
46              
47             my $pgr = Pod::Generate::Recursive->new();
48             $pgr->source("catalyst/");
49             $pgr->destination("docs/");
50             $pgr->debug(1);
51             $pgr->run();
52              
53             =cut
54              
55             =head1 SUBROUTINES/METHODS
56              
57             =cut
58              
59             my %files = ();
60              
61             sub run
62             {
63             my ($self) = @_;
64              
65             my (
66             $directory, $file, $filehandle, $filename, $newbase,
67             $parser, $pod, $pom, $targetdir, $oldfile
68             )
69             = (undef, undef, undef, undef, undef, undef, undef, undef, undef, undef);
70              
71             die "ERROR: Source directory cannot be empty.\n" if !$self->{source};
72              
73             die "ERROR: Destination directory cannot be empty.\n"
74             if !$self->{destination};
75              
76             if (!-d $self->{destination})
77             {
78             make_path $self->{destination}
79             or die "Failed to create $self->{destination}.\n";
80             }
81              
82             finddepth(\&_wanted, ($self->{source}));
83              
84             if ($self->{debug}) { print Dumper(%files) }
85              
86             while (($filename, $directory) = each %files)
87             {
88             $newbase = File::Spec->catdir(($self->{destination}, $directory));
89             $oldfile = File::Spec->catdir(($directory, $filename));
90             if ($self->{debug}) { print $newbase . "\n" }
91             if (!-d $newbase)
92             {
93             make_path $newbase or die "Failed to create $newbase.\n";
94             }
95              
96             $pom = $self->{parser}->parse_file($oldfile) || die $parser->error();
97             $pod = Pod::POM::View::Pod->print($pom);
98             $targetdir = dir($newbase);
99              
100             ## Should we change the extension to pod?
101             $file = $targetdir->file($filename);
102              
103             ## Missing docs
104             if ($pod eq "")
105             {
106             $file = $targetdir->file($filename . ".MISSING");
107             }
108              
109             $filehandle = $file->openw();
110             $filehandle->print($pod . "\n");
111             $filehandle->close;
112             }
113              
114             }
115              
116             sub _wanted
117             {
118             ## No hidden files
119             return if $_ =~ m/^\./;
120              
121             ## Skip dirs
122             return if !-f $_;
123              
124             print $_ . "\n";
125              
126             $files{"$_"} = "$File::Find::dir" if $_ =~ /\.p[ml]/;
127              
128             }
129              
130             sub debug
131             {
132             my ($self, $debug) = @_;
133             if ($debug)
134             {
135             $self->{debug} = $debug;
136             }
137             return $self->{debug};
138             }
139              
140             sub destination
141             {
142             my ($self, $destination) = @_;
143             if ($destination)
144             {
145             $self->{destination} = $destination;
146             }
147             return $self->{destination};
148             }
149              
150             sub source
151             {
152             my ($self, $source) = @_;
153             if ($source)
154             {
155             $self->{source} = $source;
156             }
157             return $self->{source};
158             }
159              
160             sub new
161             {
162             my $class = shift;
163              
164             my $self = {};
165              
166             bless $self, $class;
167              
168             $self->{source} = undef;
169             $self->{destination} = undef;
170              
171             ## Parsing files. ##
172             $self->{parser} = Pod::POM->new();
173              
174             ## Debug
175             $self->{debug} = 0;
176              
177             return $self;
178             }
179              
180             =head1 AUTHOR
181              
182             Adam M Dutko, C<< >>
183              
184             =head1 BUGS
185              
186             Please report any bugs or feature requests to C, or through
187             the web interface at L. I will be notified, and then you'll
188             automatically be notified of progress on your bug as I make changes.
189              
190              
191             =head1 SUPPORT
192              
193             You can find documentation for this module with the perldoc command.
194              
195             perldoc Pod::Generate::Recursive
196              
197              
198             You can also look for information at:
199              
200             =over 4
201              
202             =item * RT: CPAN's request tracker (report bugs here)
203              
204             L
205              
206             =item * AnnoCPAN: Annotated CPAN documentation
207              
208             L
209              
210             =item * CPAN Ratings
211              
212             L
213              
214             =item * Search CPAN
215              
216             L
217              
218             =back
219              
220              
221             =head1 ACKNOWLEDGEMENTS
222              
223              
224             =head1 LICENSE AND COPYRIGHT
225              
226             Copyright 2014 Adam M Dutko.
227              
228             This program is free software; you can redistribute it and/or modify it
229             under the terms of either: the GNU General Public License as published
230             by the Free Software Foundation; or the Artistic License.
231              
232             See L for more information.
233              
234              
235             =cut
236              
237             1; # End of Pod::Generate::Recursive