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

package Pod::Generate::Recursive;

use strict;
use warnings;

use vars qw{
  $VERSION
  @ISA
  @EXPORT
  @EXPORT_OK
  $source
  $destination
  $debug
  };

BEGIN
{
    require Exporter;

    @ISA       = qw( Exporter );
    @EXPORT    = qw( debug destination source);
    @EXPORT_OK = qw( );
}

use Data::Dumper qw(Dumper);
use File::Find qw( finddepth );
use File::Path qw( make_path );
use Pod::POM;
use Pod::POM::View::Pod;

=head1 NAME

Pod::Generate::Recursive - Generate POD for directory contents.

=head1 VERSION

Version 0.3

=cut

our $VERSION = '0.3';

=head1 SYNOPSIS

    use Pod::Generate::Recursive;

    my $pgr = Pod::Generate::Recursive->new();
    $pgr->source("catalyst/");
    $pgr->destination("docs/");
    $pgr->debug(1);
    $pgr->run();

=cut

=head1 SUBROUTINES/METHODS

=cut

my %files = ();

sub run
{
    my ($self) = @_;

    my (
        $directory, $file, $filehandle, $filename,  $newbase,
        $parser,    $pod,  $pom,        $targetdir, $oldfile
       )
      = (undef, undef, undef, undef, undef, undef, undef, undef, undef, undef);

    die "ERROR: Source directory cannot be empty.\n" if !$self->{source};

    die "ERROR: Destination directory cannot be empty.\n"
      if !$self->{destination};

    if (!-d $self->{destination})
    {
        make_path $self->{destination}
          or die "Failed to create $self->{destination}.\n";
    }

    finddepth(\&_wanted, ($self->{source}));

    if ($self->{debug}) { print Dumper(%files) }

    while (($filename, $directory) = each %files)
    {
        $newbase = File::Spec->catdir(($self->{destination}, $directory));
        $oldfile = File::Spec->catdir(($directory, $filename));
        if ($self->{debug}) { print $newbase . "\n" }
        if (!-d $newbase)
        {
            make_path $newbase or die "Failed to create $newbase.\n";
        }

        $pom = $self->{parser}->parse_file($oldfile) || die $parser->error();
        $pod = Pod::POM::View::Pod->print($pom);
        $targetdir = dir($newbase);

        ## Should we change the extension to pod?
        $file = $targetdir->file($filename);

        ## Missing docs
        if ($pod eq "")
        {
            $file = $targetdir->file($filename . ".MISSING");
        }

        $filehandle = $file->openw();
        $filehandle->print($pod . "\n");
        $filehandle->close;
    }

}

sub _wanted
{
    ## No hidden files
    return if $_ =~ m/^\./;

    ## Skip dirs
    return if !-f $_;

    print $_ . "\n";

    $files{"$_"} = "$File::Find::dir" if $_ =~ /\.p[ml]/;

}

sub debug
{
    my ($self, $debug) = @_;
    if ($debug)
    {
        $self->{debug} = $debug;
    }
    return $self->{debug};
}

sub destination
{
    my ($self, $destination) = @_;
    if ($destination)
    {
        $self->{destination} = $destination;
    }
    return $self->{destination};
}

sub source
{
    my ($self, $source) = @_;
    if ($source)
    {
        $self->{source} = $source;
    }
    return $self->{source};
}

sub new
{
    my $class = shift;

    my $self = {};

    bless $self, $class;

    $self->{source}      = undef;
    $self->{destination} = undef;

    ## Parsing files. ##
    $self->{parser} = Pod::POM->new();

    ## Debug
    $self->{debug} = 0;

    return $self;
}

=head1 AUTHOR

Adam M Dutko, 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::Generate::Recursive


You can also look for information at:

=over 4

=item * RT: CPAN's request tracker (report bugs here)

L

=item * AnnoCPAN: Annotated CPAN documentation

L

=item * CPAN Ratings

L

=item * Search CPAN

L

=back


=head1 ACKNOWLEDGEMENTS


=head1 LICENSE AND COPYRIGHT

Copyright 2014 Adam M Dutko.

This program is free software; you can redistribute it and/or modify it
under the terms of either: the GNU General Public License as published
by the Free Software Foundation; or the Artistic License.

See L for more information.


=cut

1;    # End of Pod::Generate::Recursive