view release on metacpan or  search on metacpan

lib/App/podweaver.pm  view on Meta::CPAN

package App::podweaver;

# ABSTRACT: Run Pod::Weaver on the files within a distribution.

use warnings;
use strict;

use Carp;
use Config::Tiny;
use CPAN::Meta;
use IO::File;
use File::Copy;
use File::HomeDir;
use File::Find::Rule;
use File::Find::Rule::Perl;
use File::Find::Rule::VCS;
use File::Slurp ();
use File::Spec;
use Log::Any qw/$log/;
use Module::Metadata;
use Pod::Elemental;
use Pod::Elemental::Transformer::Pod5;
use Pod::Weaver;
use PPI::Document;
use Try::Tiny;

our $VERSION = '1.00';

sub FAIL()              { 0; }
sub SUCCESS_UNCHANGED() { 1; }
sub SUCCESS_CHANGED()   { 2; }

sub weave_file
{
    my ( $self, %input ) = @_;
    my ( $file, $no_backup, $write_to_dot_new, $weaver );
    my ( $perl, $ppi_document, $pod_after_end, @pod_tokens, $pod_str,
         $pod_document, %weave_args, $new_pod, $end, $new_perl,
         $output_file, $backup_file, $fh, $module_info );

    unless( $file = delete $input{ filename } )
    {
        $log->errorf( 'Missing file parameter in args %s', \%input )
            if $log->is_error();
        return( FAIL );
    }
    unless( $weaver = delete $input{ weaver } )
    {
        $log->errorf( 'Missing weaver parameter in args %s', \%input )
            if $log->is_error();
        return( FAIL );
    }
    $no_backup        = delete $input{ no_backup };
    $write_to_dot_new = delete $input{ new };

    #  From here and below is mostly hacked out from
    #    Dist::Zilla::Plugin::PodWeaver

    $perl = File::Slurp::read_file( $file );

    unless( $ppi_document = PPI::Document->new( \$perl ) )
    {
        $log->errorf( "PPI error in '%s': %s", $file, PPI::Document->errstr() )
            if $log->is_error();
        return( FAIL );
    }

    #  If they have some pod after __END__ then assume it's safe to put
    #  it all there.
    $pod_after_end =
        ( $ppi_document->find( 'PPI::Statement::End' ) and
          grep { $_->find_first( 'PPI::Token::Pod' ) }
              @{$ppi_document->find( 'PPI::Statement::End' )} ) ?
        1 : 0;

    @pod_tokens =
        map { "$_" } @{ $ppi_document->find( 'PPI::Token::Pod' ) || [] };
    $ppi_document->prune( 'PPI::Token::Pod' );

    if( $ppi_document->serialize =~ /^=[a-z]/m )
    {
        #  TODO: no idea what the problem is here, but DZP::PodWeaver had it...
        $log->errorf( "Can't do podweave on '%s': " .
            "there is POD inside string literals", $file )
            if $log->is_error();
        return( FAIL );
    }

    $pod_str = join "\n", @pod_tokens;
    $pod_document = Pod::Elemental->read_string( $pod_str );

#  TODO: This _really_ doesn't like being run twice on a document with
#  TODO: regions for some reason.  Comment out for now and trust they
#  TODO: have [@CorePrep] enabled.
#    Pod::Elemental::Transformer::Pod5->new->transform_node( $pod_document );

    %weave_args = (
        %input,
        pod_document => $pod_document,
        ppi_document => $ppi_document,
        filename     => $file,
        );

    $module_info = Module::Metadata->new_from_file( $file );
    if( $module_info and defined( $module_info->version() ) )
    {
        $weave_args{ version } = $module_info->version();
    }
    elsif( defined( $input{ dist_version } ) )
    {
        $log->warningf( "Unable to parse version in '%s', " .
            "using dist_version '%s'", $file, $input{ dist_version } )
            if $log->is_warning();
        $weave_args{ version } = $input{ dist_version };
    }
    else
    {
        $log->warningf( "Unable to parse version in '%s' and " .
            "no dist_version supplied", $file )
            if $log->is_warning();
    }

    #  Try::Tiny this, it can croak.
    try
    {
        $pod_document = $weaver->weave_document( \%weave_args );

        $log->errorf( "weave_document() failed on '%s': No Pod generated",
            $file )
            if $log->is_error() and not $pod_document;
    }
    catch
    {
        $log->errorf( "weave_document() failed on '%s': %s",
            $file, $_ )
            if $log->is_error();
        $pod_document = undef;
    };
    return( FAIL ) unless $pod_document;

    $new_pod = $pod_document->as_pod_string;

    $end = do {
        my $end_elem = $ppi_document->find( 'PPI::Statement::Data' )
                    || $ppi_document->find( 'PPI::Statement::End' );
        join q{}, @{ $end_elem || [] };
        };

    $ppi_document->prune( 'PPI::Statement::End' );
    $ppi_document->prune( 'PPI::Statement::Data' );

    $new_perl = $ppi_document->serialize;

    $new_perl =~ s/\n+$//;
    $new_perl .= "\n";

    $new_pod  =~ s/\n+$//;
    $new_pod  =~ s/^\n+//;
    $new_pod  .= "\n";

    if( not $end )
    {
        $end = "__END__\n\n";
        $pod_after_end = 1;
    }

    if( $pod_after_end )
    {
        $new_perl = "$new_perl\n$end$new_pod";
    }
    else
    {
        $new_perl = "$new_perl\n$new_pod\n$end";
    }

    if( $perl eq $new_perl )
    {
        $log->infof( "Contents of '%s' unchanged", $file )
            if $log->is_info();
        return( SUCCESS_UNCHANGED );
    }

    $output_file = $write_to_dot_new ? ( $file . '.new' ) : $file;