File Coverage

blib/lib/POD/Walker.pm

Criterion	Covered	Total	%
statement	24	147	16.3
branch	0	88	0.0
condition	0	9	0.0
subroutine	8	10	80.0
pod	2	2	100.0
total	34	256	13.2

package POD::Walker;

use warnings;
use strict;
use Script::isAperlScript;
use Pod::Html;
use Pod::LaTeX;
use Pod::Man;
use Pod::Text;
use File::Copy;

=head1 NAME

POD::Walker - Walks a directory and runs any Perl files through the specified POD converter.

=head1 VERSION

Version 0.0.0

=cut

our $VERSION = '0.0.0';


=head1 SYNOPSIS

    use POD::Walker;
    my $returned=POD::Walker->run({in=>"/input/path", out=>"/output/path", format=>"html" });
    if($returned->{error}){
        print "Error: ".$returned->{error}."\n";
    }

=head1 FUNCTION

=head2 run

Process a directory try and ignore any hidden directories or files.

The returned value is a hash. See the section "RETURN HASH" for more information.

=head3 args hash ref

=head4 changesCopy

This copies any "Changes" files.

This defaults to "1".

=head4 in

The directory to start in.

=head4 format

The output type. This can be any of the ones listed below.

    html
    latex
    man
    text

If one is not specified, 'html' will be used.

=head4 manifestCopy

This copies any "MANIFEST" files.

This defaults to "1".

=head4 readmeCopy

This copies any "README" files.

This defaults to "1".

=head4 out

This is the directory to output to.

=cut

sub run{
	#make sure we have something passed to us
	if (!defined($_[1])) {
		return {error=>1};
	}
	my %args=%{$_[1]};

	#make sure all arguements are defined
	if (!defined($args{in})) {
		return {error=>2};
	}
	if (!defined($args{out})) {
		return {error=>3};
	}
	if (!defined($args{format})) {
		$args{format}='html';
	}

	#make sure the input directory is usable
	if (! -d $args{in}) {
		return {error=>4};
	}
	if (! -r $args{in}) {
		return {error=>5};
	}

	#make sure the output directory is usable
	if (! -d $args{out}) {
		if (!mkdir($args{out})) {
			return {error=>6};
		}
	}
	if (! -w $args{out}) {
		return {error=>7};
	}
	if (! -w $args{out}) {
		return {error=>8};
	}

	#default to 1 for MANIFEST copying
	if (!defined( $args{manifestCopy} )) {
		$args{manifestCopy}=1;
	}

	#default to 1 for README copying
	if (!defined( $args{readmeCopy} )) {
		$args{readmeCopy}=1;
	}

	#default to 1 for Changes copying
	if (!defined( $args{changesCopy} )) {
		$args{changesCopy}=1;
	}

	#starts processing and returns it
	return process(\%args);
}

=head2 process

This is a internal function.

=cut

sub process{
	my %args=%{$_[0]};

	#inits the return value
	my %toreturn;
	$toreturn{error}=undef;

	#holds any thing that errored
	my @errored;

	#make sure all arguements are defined
	if (!defined($args{in})) {
		$toreturn{errored}=\@errored;
		$toreturn{error}=2;
		return \%toreturn;
	}
	if (!defined($args{out})) {
		$toreturn{errored}=\@errored;
		$toreturn{error}=3;
		return \%toreturn;
	}
	if (!defined($args{format})) {
		$args{format}='html';
	}

	#make sure the input directory is usable
	if (! -d $args{in}) {
		$toreturn{errored}=\@errored;
		$toreturn{error}=4;
		return \%toreturn;
	}
	if (! -r $args{in}) {
		$toreturn{errored}=\@errored;
		$toreturn{error}=5;
		return \%toreturn;
	}

	#make sure the output directory is usable
	if (! -d $args{out}) {
		if (!mkdir($args{out})){
			$toreturn{errored}=\@errored;
			$toreturn{error}=6;
			return \%toreturn;
		}
	}
	if (! -w $args{out}) {
		$toreturn{errored}=\@errored;
		$toreturn{error}=7;
		return \%toreturn;
	}
	if (! -w $args{out}) {
		$toreturn{errored}=\@errored;
		$toreturn{error}=8;
		return \%toreturn;
	}

	#processes the input directory
	my $dir;
	if (opendir($dir, $args{in})) {
		#removes hidden files/directories
		my @dirEntries=grep(!/^\./ , readdir($dir));
		closedir($dir);

		#process each entry
		my $int=0;
		while (defined( $dirEntries[$int] )) {
			my %newArgs=%args;
			$newArgs{in}=$args{in}.'/'.$dirEntries[$int];
			$newArgs{out}=$args{out}.'/'.$dirEntries[$int];

			#The directory and file stuff like this is split to simplify handling odd stuff the path in question.
			#handles directories
			if (-d $newArgs{in}) {
				#process it if it was a directory
				my $returned=process(\%newArgs);
				#push what failed onto the list, if needed
				if ($returned->{error}) {
					my @errors=@{$returned->{errored}};

					print $returned->{error}." ".$newArgs{in}."\n";

					push(@errored, @errors);
					push(@errored, $newArgs{in});
				}
			}
			#handles files
			if (-f $newArgs{in}) {
				#we don't process a file by default
				my $process=0;

				#checks if we should process a file
				if ( $newArgs{in} =~ /\.[Pp][Mm]$/ ) {
					$process=1;
				}
				if ( ( $newArgs{in} =~ /\.[Pp][Ll]$/ ) && (!$process) ) {
					$process=1;
				}
				if ( ( $newArgs{in} =~ /\.[Pp][Oo][Dd]$/ ) && (!$process) ) {
					$process=1;
				}
				if ( ( -x $newArgs{in} ) && (!$process) ) {
					if ( !isAperlScript( $newArgs{in} ) ) {
						$process=1;
					}
				}

				#handles it if it is one of the copy types
				if ($dirEntries[$int] eq "Changes") {
					if ($args{changesCopy}) {
						copy($newArgs{in}, $newArgs{out});
					}
				}
				if ($dirEntries[$int] eq "README") {
					if ($args{readmeCopy}) {
						copy($newArgs{in}, $newArgs{out});
					}
				}
				if ($dirEntries[$int] eq "MANIFEST") {
					if ($args{manifestCopy}) {
						copy($newArgs{in}, $newArgs{out});
					}
				}

				#process a file if needed
				if ($process) {
					if ($args{format} eq "html") {
						pod2html("--flush", "--infile=".$newArgs{in}, "--outfile=".$newArgs{out}.".html");
						if (-f "pod2htmd.tmp") {
							unlink("pod2htmd.tmp");
						}
						if (-f "pod2htmi.tmp") {
							unlink("pod2htmi.tmp");
						}
					}

					if ($args{format} eq "latex") {
						my $parser = Pod::LaTeX->new;
						$parser->parse_from_file ($newArgs{in}, $newArgs{out}.".latex");
					}

					if ($args{format} eq "man") {
						my $parser = Pod::Man->new;
						$parser->parse_from_file ($newArgs{in}, $newArgs{out}.".man");
					}

					if ($args{format} eq "text") {
						my $parser = Pod::Text->new;
						$parser->parse_from_file ($newArgs{in}, $newArgs{out}.".text");
					}

				}

			}

			$int++;
		}

	}else {
		$toreturn{errored}=\@errored;
		$toreturn{error}=9;
		return \%toreturn;
	}

	$toreturn{errored}=\@errored;

	return \%toreturn;
}

=head1 RETURN HASH

=head2 error

This integer represents if there is a error or note.

This is set to true if there was an error is set to a
integet greater than or equal to "1".

=head3 error codes

=head4 1

No arguements passed.

=head4 2

No in directory specified.

=head4 3

No in directory specified.

=head4 4

The input directory does not exist or is not a directory.

=head4 5

The input directory is not readable.

=head4 6

The specified outpbut directory does not exist, is is not
a directory, or could not be created.

=head4 7

The output directory is not readable.

=head4 8

The output directory is not writable.

=head4 9

Failed to open the input directory.

=head2 errored

This contains a list of files or directories that could not be processed.

=head1 AUTHOR

Zane C. Bowers, C<<  >>

=head1 BUGS

Please report any bugs or feature requests to C, or through
the web interface at L.  I will be notified, and then you'll
automatically be notified of progress on your bug as I make changes.




=head1 SUPPORT

You can find documentation for this module with the perldoc command.

    perldoc POD::Walker


You can also look for information at:

=over 4

=item * RT: CPAN's request tracker

L

=item * AnnoCPAN: Annotated CPAN documentation

L

=item * CPAN Ratings

L

=item * Search CPAN

L

=back


=head1 ACKNOWLEDGEMENTS


=head1 COPYRIGHT & LICENSE

Copyright 2010 Zane C. Bowers, all rights reserved.

This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.


=cut

1; # End of POD::Walker