App-podweaver

 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();

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

    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;
    $backup_file = $file . '.bak';

    unless( $write_to_dot_new or $no_backup )
    {
        unlink( $backup_file );
        copy( $file, $backup_file );
    }

    $log->debugf( "Writing new '%s' for '%s'", $output_file, $file )
        if $log->is_debug();
    #  We want to preserve permissions and other stuff, so we open
    #  it for read/write.
    $fh = IO::File->new( $output_file, $write_to_dot_new ? '>' : '+<' );
    unless( $fh )
    {
        $log->errorf( "Unable to write to '%s' for '%s': %s",
            $output_file, $file, $! )
            if $log->is_error();
        return( FAIL );
    }
    $fh->truncate( 0 );
    $fh->print( $new_perl );
    $fh->close();
    return( SUCCESS_CHANGED );
}

sub get_dist_info
{
    my ( $self, %options ) = @_;
    my ( $dist_info, $dist_root, $meta_file );

    $dist_root = $options{ dist_root } || '.';    

    $dist_info = {};

    if( -r ( $meta_file = File::Spec->catfile( $dist_root, 'META.json' ) ) or
        -r ( $meta_file = File::Spec->catfile( $dist_root, 'META.yml'  ) ) )
    {
        $log->debugf( "Reading '%s'", $meta_file )
            if $log->is_debug();
        $dist_info->{ meta } = CPAN::Meta->load_file( $meta_file );
    }
    else
    {
        $log->warningf( "No META.json or META.yml file found, " .
            "is '%s' a distribution directory?", $dist_root )
            if $log->is_warning();
    }

    if( $dist_info->{ meta } )
    {
        $dist_info->{ authors } = [ $dist_info->{ meta }->authors() ];

        $dist_info->{ authors } =
            [ map { s/\@/ $options{ antispam } /; $_; }
                  @{$dist_info->{ authors }} ]
            if $options{ antispam };

        $log->debug( "Creating license object" )
            if $log->is_debug();
        my @licenses = $dist_info->{ meta }->licenses();
        if( @licenses != 1 )
        {
            $log->error( "Pod::Weaver requires one, and only one, " .
                "license at a time." )
                if $log->is_error();

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

  Creating META.yml
  ERROR: Missing required field 'dist_abstract' for metafile
  $ podweaver -v
  No META.json or META.yml file found, are you running in a distribution directory?
  Processing lib/App/podweaver.pm
  $ ./Build distmeta
  Creating META.yml
  $ podweaver -v
  Processing lib/App/podweaver.pm

This should only be neccessary on newly created distributions as
both the META and the neccessary POD abstract should be present
subsequently.

=for readme stop

=head1 METHODS

=begin :private

=head2 B<FAIL>

Indicates the file failed to be woven.

=head2 B<SUCCESS_UNCHANGED>

Indicates the file was successfully woven but resulted in no changes.

=head2 B<SUCCESS_CHANGED>

Indicates the file was successfully woven and contained changes.

=end :private

=head2 I<$success> = B<< App::podweaver->weave_file( >> I<%options> B<)>

Runs L<Pod::Weaver> on the given file, merges the generated Pod back
into the appropriate place and writes the new file out.

C<< App::podweaver->weave_file() >> returns
C<< App::podweaver::FAIL >> on failure,
and either C<< App::podweaver::SUCCESS_UNCHANGED >> or
C<< App::podweaver::SUCCESS_CHANGED >> on success,
depending on whether changes needed to be made as a result of
the weaving.

Currently these constants are not exportable.

The following options configure C<< App::podweaver->weave_file() >>:

=over

=item B<< filename => >> I<$filename> (required)

The filename of the file to weave.

=item B<< weaver => >> I<$weaver> (required)

The L<Pod::Weaver> instance to use for the weaving.

=item B<< no_backup => >> I<0> | I<1> (default: 0)

If set to a true value, no backup will be made of the original file.

=item B<< new => >> I<0> | I<1> (default: 0)

If set to a true value, the modified file will be written to the
original filename with C<.new> appended, rather than overwriting
the original.

=item B<< dist_version => >> I<$version>

If no C<$VERSION> can be parsed from the file by
L<Module::Metadata>, the version supplied in
C<dist_version> will be used as a fallback.

=back

Any additional options are passed untouched to L<Pod::Weaver>.

=head2 I<$dist_info> = B<< App::podweaver->get_dist_info( >> I<%options> B<)>

Attempts to extract the information needed by L<Pod::Weaver>
about the distribution.

It does this by examining any C<META.json> or C<META.yml> file
it finds, and by expanding various fields found within.

Valid options are:

=over

=item B<< dist_root => >> I<$directory> (default: current working directory)

Treats I<$directory> as the root directory of the distribution,
where the C<META.json> or C<META.yml> file should be found.

If not supplied, this will default to the current working directory.

=item B<< antispam => >> I<$string>

If set, any @ sign in author emails will be replaced by a space,
the given string, and a further space, in an attempt to confuse
spammers.

For example C<< antispam => 'NOSPAM' >> will transform an email
of C<< nobody@127.0.0.1 >> into C<< nobody NOSPAM 127.0.0.1 >>.

=back

=head2 I<$weaver> = B<< App::podweaver->get_weaver( >> I<%options> B<)>

Builds a L<Pod::Weaver> instance, attemping to find a C<weaver.ini>
in the distribution root directory.

Valid options are:

=over

=item B<< dist_root => >> I<$directory> (default: current working directory)

Treats I<$directory> as the root directory of the distribution,
where the C<weaver.ini> file should be found.



( run in 1.277 second using v1.01-cache-2.11-cpan-c966e8aa7e8 )