File Coverage

blib/lib/Toader/AutoDoc.pm
Criterion Covered Total %
statement 15 271 5.5
branch 0 102 0.0
condition 0 6 0.0
subroutine 5 20 25.0
pod 15 15 100.0
total 35 414 8.4


line stmt bran cond sub pod time code
1             package Toader::AutoDoc;
2              
3 4     4   21566 use warnings;
  4         9  
  4         133  
4 4     4   20 use strict;
  4         10  
  4         92  
5 4     4   21 use base 'Error::Helper';
  4         8  
  4         1005  
6 4     4   1247 use Toader::isaToaderDir;
  4         8  
  4         107  
7 4     4   3273 use Script::isAperlScript;
  4         3192  
  4         10079  
8              
9             =head1 NAME
10              
11             Toader::AutoDoc - Automatically build documentation from specified directories.
12              
13             =head1 VERSION
14              
15             Version 0.2.0
16              
17             =cut
18              
19             our $VERSION = '0.2.0';
20              
21             =head1 METHODS
22              
23             =head2 new
24              
25             This initiates the object.
26              
27             One argument is required and it is a L object.
28              
29             my $foo = Toader::AutoDoc->new( $toader );
30             if ( $foo->error ){
31             warn('error:'.$foo->error.': '.$foo->errorString);
32             }
33              
34             =cut
35              
36             sub new{
37 0     0 1   my $toader=$_[1];
38              
39 0           my $self={
40             error=>undef,
41             errorString=>'',
42             perror=>undef,
43             dir=>undef,
44             toader=>undef,
45             errorExtra=>{
46             flags=>{
47             1=>'noDirSpecified',
48             2=>'notAtoaderDir',
49             3=>'pathsFileOpenFailed',
50             4=>'noDirSet',
51             5=>'noPathSpecified',
52             6=>'invalidPath',
53             7=>'dirCreationFailed',
54             8=>'notAtoaderObj',
55             9=>'getVCSerrored',
56             10=>'VCSusableErrored',
57             11=>'underVCSerrored',
58             12=>'VCSaddErrored',
59             13=>'noToaderObj',
60             },
61             },
62             VCSusable=>0,
63             };
64 0           bless $self;
65              
66             #if we have a Toader object, reel it in
67 0 0         if ( ! defined( $toader ) ){
68 0           $self->{perror}=1;
69 0           $self->{error}=13;
70 0           $self->{errorString}='No Toader object specified';
71 0           $self->warn;
72 0           return $self;
73             }
74 0 0         if ( ref( $toader ) ne "Toader" ){
75 0           $self->{perror}=1;
76 0           $self->{error}=8;
77 0           $self->{errorString}='The object specified is a "'.ref($toader).'"';
78 0           $self->warn;
79 0           return $self;
80             }
81 0           $self->{toader}=$toader;
82              
83             #gets the Toader::VCS object
84 0           $self->{vcs}=$self->{toader}->getVCS;
85 0 0         if ( $toader->error ){
86 0           $self->{perror}=1;
87 0           $self->{error}=9;
88             $self->{errorString}='Toader->getVCS errored. error="'.
89 0           $self->{toader}->error.'" errorString="'.$self->{toader}->errorString.'"';
90 0           $self->warn;
91 0           return $self;
92             }
93            
94             #checks if VCS is usable
95 0           $self->{VCSusable}=$self->{vcs}->usable;
96 0 0         if ( $self->{vcs}->error ){
97 0           $self->{perror}=1;
98 0           $self->{error}=10;
99             $self->{errorString}='Toader::VCS->usable errored. error="'.
100 0           $self->{toader}->error.'" errorString="'.$self->{toader}->errorString.'"';
101 0           $self->warn;
102 0           return $self;
103             }
104              
105 0           return $self;
106             }
107              
108             =head2 dirGet
109              
110             This gets L directory this entry is associated with.
111              
112             This will only error if a permanent error is set.
113              
114             This will return undef if no directory has been set.
115              
116             my $dir=$foo->dirGet;
117             if($foo->error){
118             warn('Error:'.$foo->error.': '.$foo->errorString);
119             }
120              
121             =cut
122              
123             sub dirGet{
124 0     0 1   my $self=$_[0];
125              
126 0 0         if (!$self->errorblank){
127 0           return undef;
128             }
129              
130 0           return $self->{dir};
131             }
132              
133             =head2 dirSet
134              
135             This sets L directory this entry is associated with.
136              
137             One argument is taken and it is the L directory to set it to.
138              
139             my $dir=$foo->dirSet($toaderDirectory);
140             if($foo->error){
141             warn('Error:'.$foo->error.': '.$foo->errorString);
142             }
143              
144             =cut
145              
146             sub dirSet{
147 0     0 1   my $self=$_[0];
148 0           my $dir=$_[1];
149              
150 0 0         if (!$self->errorblank){
151 0           return undef;
152             }
153              
154             #make sure a directory has been specified
155 0 0         if (!defined($dir)) {
156 0           $self->{error}=1;
157 0           $self->{errorString}='No directory specified.';
158 0           $self->warn;
159 0           return undef;
160             }
161              
162             #cleans up the naming
163 0           my $pathHelper=Toader::pathHelper->new($dir);
164 0           $dir=$pathHelper->cleanup($dir);
165              
166             #checks if the directory is Toader directory or not
167 0           my $isatd=Toader::isaToaderDir->new;
168 0           my $returned=$isatd->isaToaderDir($dir);
169 0 0         if (! $returned ) {
170 0           $self->{error}=2;
171 0           $self->{errorString}='"'.$dir.'" is not a Toader directory.';
172 0           $self->warn;
173 0           return undef;
174             }
175              
176 0           $self->{dir}=$dir;
177              
178 0           return 1;
179             }
180              
181             =head2 findDocs
182              
183             Finds documentation under the specified paths.
184              
185             =cut
186              
187             sub findDocs{
188 0     0 1   my $self=$_[0];
189 0           my $cp=$_[1];
190              
191 0 0         if (!$self->errorblank){
192 0           return undef;
193             }
194              
195 0 0         if ( ! defined( $self->{dir} ) ){
196 0           $self->{error}=4;
197 0           $self->{errorString}='No directory is set';
198 0           $self->warn;
199 0           return undef;
200             }
201              
202             #gets the paths
203 0           my @paths;
204 0 0         if ( ! defined( $cp ) ){
205             # get the paths
206 0           @paths=$self->pathsGet;
207 0 0         if ( $self->error ){
208 0           $self->warnString('Failed to get the paths');
209 0           return undef;
210             }
211 0           $cp='';
212             }else{
213 0           my $dh;
214 0 0         if ( ! opendir( $dh, $self->{dir}.'/'.$cp ) ){
215 0           $self->warnString('Failed to open the directory "'.$self->{dir}.'/'.$cp.'"');
216 0           return undef;
217             }
218 0           @paths=grep( !/^\./, readdir( $dh ) );
219 0           closedir( $dh );
220             }
221            
222             #process each path
223 0           my $int=0;
224 0           my @toreturn;
225 0           while( defined( $paths[$int] ) ){
226 0           my $item=$self->{dir}.'/'.$cp.'/'.$paths[$int];
227              
228 0           my $checker=Script::isAperlScript->new({
229             env=>1,
230             any=>1,
231             });
232            
233             #processes any files found
234 0 0 0       if (
      0        
235             ( -f $item ) &&
236             (
237             ( $item =~ /\/README$/ ) ||
238             ( $item =~ /\/Changes$/ ) ||
239             ( $item =~ /\/TODO$/ ) ||
240             ( $item =~ /\.pm$/ ) ||
241             ( $item =~ /\.[Pp][Oo][Dd]$/ ) ||
242             ( $item =~ /\.[Tt][Xx][Tt]$/ ) ||
243             ( $checker->isAperlScript( $item ) )
244             )
245             ){
246 0           push( @toreturn, $cp.'/'.$paths[$int] );
247             }
248            
249             #process any directories found
250 0 0         if ( -d $item ){
251 0           my @returned=$self->findDocs( $cp.'/'.$paths[$int] );
252 0 0         if ( defined( $returned[0] ) ){
253 0           push( @toreturn, @returned );
254             }
255             }
256              
257 0           $int++;
258             }
259              
260             #make sure there are no //
261 0 0         if ( $cp eq '' ){
262 0           $int=0;
263 0           while( defined( $toreturn[$int] ) ){
264 0           $toreturn[$int]=~s/\/\//\//g;
265 0           $toreturn[$int]=~s/^\///;
266              
267 0           $int++;
268             }
269             }
270              
271             #removes any potential dupes...
272 0           my %found;
273 0           $int=0;
274 0           while ( defined( $toreturn[$int] ) ){
275 0           $found{ $toreturn[$int] }='';
276              
277 0           $int++;
278             }
279              
280 0           return keys(%found);
281             }
282              
283             =head2 pathAdd
284              
285             This adds a new path.
286              
287              
288              
289             =cut
290              
291             sub pathAdd{
292 0     0 1   my $self=$_[0];
293 0           my $path=$_[1];
294              
295 0 0         if (!$self->errorblank){
296 0           return undef;
297             }
298              
299 0 0         if ( ! defined( $self->{dir} ) ){
300 0           $self->{error}=4;
301 0           $self->{errorString}='No directory is set';
302 0           $self->warn;
303 0           return undef;
304             }
305              
306 0 0         if ( ! defined( $path ) ){
307 0           $self->{error}=5;
308 0           $self->{errorString}='No path specified';
309 0           $self->warn;
310 0           return undef;
311             }
312              
313 0 0         if ( ! $self->validPath( $path ) ){
314 0           $self->{error}=6;
315 0           $self->{errorString}='Invalid path specified';
316 0           $self->warn;
317 0           return undef;
318             }
319              
320 0           my @paths=$self->pathsGet;
321 0 0         if ( $self->error ){
322 0           $self->warnString('Failed to get the current paths');
323 0           return undef;
324             }
325              
326 0           push( @paths, $path );
327              
328 0           $self->pathsSet( \@paths );
329 0 0         if ( $self->error ){
330 0           $self->warnString('Failed to set save the paths list');
331 0           return undef;
332             }
333              
334 0           return 1;
335             }
336              
337             =head2 pathRemove
338              
339             Remove a specified path.
340              
341             =cut
342              
343             sub pathRemove{
344 0     0 1   my $self=$_[0];
345 0           my $path=$_[1];
346              
347 0 0         if (!$self->errorblank){
348 0           return undef;
349             }
350              
351 0 0         if ( ! defined( $self->{dir} ) ){
352 0           $self->{error}=4;
353 0           $self->{errorString}='No directory is set';
354 0           $self->warn;
355 0           return undef;
356             }
357              
358 0 0         if ( ! defined( $path ) ){
359 0           $self->{error}='5';
360 0           $self->{errorString}='No path specified';
361 0           $self->warn;
362 0           return undef;
363             }
364              
365 0           my @paths=$self->pathsGet;
366 0 0         if ( $self->error ){
367 0           $self->warnString('Failed to get the current paths');
368 0           return undef;
369             }
370              
371             #
372 0           my $int=0;
373 0           my @newpaths;
374 0           while ( defined( $paths[$int] ) ){
375 0 0         if ( $paths[$int] ne $path ){
376 0           push( @newpaths, $paths[$int] );
377             }
378              
379 0           $int++;
380             }
381              
382 0           $self->pathsSet( \@newpaths );
383 0 0         if ( $self->error ){
384 0           $self->warnString('Failed to set save the paths list');
385 0           return undef;
386             }
387              
388 0           return 1;
389             }
390              
391             =head2 pathsGet
392              
393             This gets the list of what is to by handled.
394              
395             No arguments are taken.
396              
397             The returned value is a list. Each item in the
398             list is a path to recursively search.
399              
400             my @paths=$foo->pathsGet;
401              
402             =cut
403              
404             sub pathsGet{
405 0     0 1   my $self=$_[0];
406              
407 0 0         if (!$self->errorblank){
408 0           return undef;
409             }
410              
411 0 0         if ( ! defined( $self->{dir} ) ){
412 0           $self->{error}=4;
413 0           $self->{errorString}='No directory is set';
414 0           $self->warn;
415 0           return undef;
416             }
417              
418 0           my $file=$self->{dir}.'/.toader/autodoc/dirs';
419              
420             #it does not exist... no directories to search
421 0 0         if ( ! -f $file ){
422 0           return;
423             }
424              
425             #read the file
426 0           my $fh;
427 0 0         if ( ! open( $fh, '<', $file ) ){
428 0           $self->{error}=3;
429 0           $self->{errorString}='Failed to open "'.$file.'"';
430 0           $self->warn;
431 0           return undef;
432             }
433 0           my $line=<$fh>;
434 0           my @data;
435 0           while( defined( $line ) ){
436 0           chomp( $line );
437 0 0         if ( $line ne '' ){
438 0           push( @data, $line );
439             }
440              
441 0           $line=<$fh>;
442             }
443 0           close $fh;
444              
445 0           return @data;
446             }
447              
448             =head2 pathsSet
449              
450             This sets the AutoDoc paths for a directory.
451              
452             One argument is required and that is a array ref of
453             relative paths.
454              
455             $foo->pathsSet( \@paths );
456              
457             =cut
458              
459             sub pathsSet{
460 0     0 1   my $self=$_[0];
461 0           my @paths;
462 0 0         if ( defined( $_[1] ) ){
463 0           @paths=@{ $_[1] };
  0            
464             }
465              
466 0 0         if (!$self->errorblank){
467 0           return undef;
468             }
469              
470 0 0         if ( ! defined( $self->{dir} ) ){
471 0           $self->{error}=4;
472 0           $self->{errorString}='No directory is set';
473 0           $self->warn;
474 0           return undef;
475             }
476              
477 0           my $dir=$self->{dir}.'/.toader/autodoc/';
478 0           my $file=$self->{dir}.'/.toader/autodoc/dirs';
479              
480             #try to create to autodoc config directory
481 0 0         if ( ! -e $dir ){
482 0 0         if ( ! mkdir( $dir ) ){
483 0           $self->{error}=7;
484 0           $self->{errorString}='Failed to create to Autodoc configuration directory, "'.$dir.'",';
485 0           $self->warn;
486 0           return undef;
487             }
488             }
489              
490 0           my $data=join("\n", @paths)."\n";
491            
492             #open and write it
493 0           my $fh;
494 0 0         if ( ! open( $fh, '>', $file ) ){
495 0           $self->{error}=3;
496 0           $self->{errorString}='Failed to open "'.$file.'"';
497 0           $self->warn;
498 0           return undef;
499             }
500 0           print $fh $data;
501 0           close $fh;
502              
503             #if VCS is not usable, stop here
504 0 0         if ( ! $self->{VCSusable} ){
505 0           return 1;
506             }
507              
508             #if it is under VCS, we have nothing to do
509 0           my $underVCS=$self->{vcs}->underVCS($file);
510 0 0         if ( $self->{vcs}->error ){
511 0           $self->{error}=11;
512             $self->{errorString}='Toader::VCS->underVCS errored. error="'.
513 0           $self->{vcs}->error.'" errorString="'.$self->{vcs}->errorString.'"';
514 0           $self->warn;
515 0           return undef;
516             }
517 0 0         if ( $underVCS ){
518 0           return 1;
519             }
520              
521             #add it as if we reach here it is not under VCS and VCS is being used
522 0           $self->{vcs}->add( $file );
523 0 0         if ( $self->{vcs}->error ){
524 0           $self->{error}=12;
525             $self->{errorString}='Toader::VCS->add errored. error="'.
526 0           $self->{vcs}->error.'" errorString="'.$self->{vcs}->errorString.'"';
527 0           $self->warn;
528 0           return undef;
529             }
530              
531 0           return 1;
532             }
533              
534             =head2 validPath
535              
536             This verifies that a path is valid.
537              
538             It makes sure it defined and does not match any thing below.
539              
540             ^..\/
541             \/..\/
542             \/..$
543              
544             =cut
545              
546             sub validPath{
547 0     0 1   my $path=$_[1];
548              
549 0 0         if ( ! defined( $path ) ){
550 0           return 0;
551             }
552              
553 0 0         if ( $path =~ /^\.\.\// ){
554 0           return 0;
555             }
556              
557 0 0         if ( $path =~ /\/\.\.\// ){
558 0           return 0;
559             }
560              
561 0 0         if ( $path =~ /\/.\.$/ ){
562 0           return 0;
563             }
564              
565 0           return 1;
566             }
567              
568             =head1 REQUIRED RENDERING METHODS
569              
570             =head2 filesDir
571              
572             This returns the file directory for the object.
573              
574             This is not a full path, but a partial path that should
575             be appended the directory current directory being outputted to.
576              
577             =cut
578              
579             sub filesDir{
580 0     0 1   my $self=$_[0];
581              
582 0 0         if (!$self->errorblank){
583 0           return undef;
584             }
585              
586 0           return $self->renderDir.'/.files';
587             }
588              
589             =head2 locationID
590              
591             This returns the location ID.
592              
593             This one requires the object to be initialized.
594              
595             =cut
596              
597             sub locationID{
598 0     0 1   my $self=$_[0];
599              
600 0 0         if (!$self->errorblank){
601 0           return undef;
602             }
603              
604 0           return 'Documentation';
605             }
606              
607             =head2 renderDir
608              
609             This is the directory that it will be rendered to.
610              
611             The base directory that will be used for rendering.
612              
613             =cut
614              
615             sub renderDir{
616 0     0 1   return '.autodoc';
617             }
618              
619             =head2 renderUsing
620              
621             This returns the module to use for rendering.
622              
623             my $module=$foo->renderUsing;
624              
625             =cut
626              
627             sub renderUsing{
628 0     0 1   return 'Toader::Render::AutoDoc';
629             }
630              
631             =head2 toaderRenderable
632              
633             This method returns true and marks it as being L
634             renderable.
635              
636             =cut
637              
638             sub toaderRenderable{
639 0     0 1   return 1;
640             }
641              
642             =head2 toDir
643              
644             This returns the relative path to the object.
645              
646             This is not a full path, but a partial path that should
647             be appended the directory current directory being outputted to.
648              
649             =cut
650              
651             sub toDir{
652 0     0 1   my $self=$_[0];
653              
654 0 0         if (!$self->errorblank){
655 0           return undef;
656             }
657              
658 0           return $self->renderDir;
659             }
660              
661             =head1 ERROR CODES
662              
663             =head2 1, noDirSpecified
664              
665             No directory specified.
666              
667             =head2 2, notAtoaderDir
668              
669             The directory is not a Toader directory.
670              
671             =head2 3, pathsFileOpenFailed
672              
673             Failed to open the paths file.
674              
675             =head2 4, noDirSet
676              
677             No directory set.
678              
679             =head2 5, noPathSpecified
680              
681             No path specified.
682              
683             =head2 6, invalidPath
684              
685             Invalid path.
686              
687             =head2 7, dirCreationFailed
688              
689             The AutoDoc configuration directory could not be created.
690              
691             =head2 8, notAtoaderObj
692              
693             The specified object is not a Toader object.
694              
695             =head2 9, getVCSerrored
696              
697             L->getVCS errored.
698              
699             =head2 10, VCSusableFailedErrored
700              
701             L->VCSusable errored.
702              
703             =head2 11, underVCSerrored
704              
705             L->underVCS errored.
706              
707             =head2 12, VCSaddErrored
708              
709             L->add errored.
710              
711             =head2 13, noToaderObj
712              
713             =head1 AUTHOR
714              
715             Zane C. Bowers-Hadley, C<< >>
716              
717             =head1 BUGS
718              
719             Please report any bugs or feature requests to C, or through
720             the web interface at L. I will be notified, and then you'll
721             automatically be notified of progress on your bug as I make changes.
722              
723             =head1 SUPPORT
724              
725             You can find documentation for this module with the perldoc command.
726              
727             perldoc Toader::AutoDoc
728              
729              
730             You can also look for information at:
731              
732             =over 4
733              
734             =item * RT: CPAN's request tracker
735              
736             L
737              
738             =item * AnnoCPAN: Annotated CPAN documentation
739              
740             L
741              
742             =item * CPAN Ratings
743              
744             L
745              
746             =item * Search CPAN
747              
748             L
749              
750             =back
751              
752              
753             =head1 ACKNOWLEDGEMENTS
754              
755              
756             =head1 LICENSE AND COPYRIGHT
757              
758             Copyright 2013 Zane C. Bowers-Hadley.
759              
760             This program is free software; you can redistribute it and/or modify it
761             under the terms of either: the GNU General Public License as published
762             by the Free Software Foundation; or the Artistic License.
763              
764             See http://dev.perl.org/licenses/ for more information.
765              
766              
767             =cut
768              
769             1; # End of Toader::AutoDoc