view release on metacpan or  search on metacpan

t/lib/TestPW.pm  view on Meta::CPAN

$zilla->set_always( license =>
      Software::License::BSD->new( { holder => 'DZHolder', year => 2017, } ) );
$zilla->set_always( authors     => ['DZAuth Belman <vrurg@cpan.org>'] );
$zilla->set_always( stash_named => undef );
$zilla->mock( copyright_holder => sub { $_[0]->license->holder } );

# proposed changes to Pod::Weaver::Section::Legal look for a license file.  we can ignore that for these tests.
$zilla->set_always( files => [] );

has dir => ( is => 'rw', );

has testName => ( is => 'rw', );

has inFile => (
    is      => 'rw',
    lazy    => 1,
    builder => 'initInFile',
);

has inSource => (
    is      => 'rw',
    lazy    => 1,
    builder => 'initInSource',
);

# fromPod is true if source is loaded from .pod, not .pm
has fromPod => ( is => 'rw', lazy => 1, builder => 'initFromPod', );

has expected => (
    is      => 'rw',
    lazy    => 1,
    builder => 'initExpected',
);

has args => (
    is      => 'rw',
    lazy    => 1,
    builder => 'initArgs',
);

has weaver => (
    is      => 'ro',
    lazy    => 1,
    builder => 'initWeaver',
);

# Used only when fromPod is true.
has docPod => (
    is      => 'rw',
    lazy    => 1,
    builder => 'initDocPod',
);

# User only when fromPod is true. Will contain fake Perl code PPI.
has docPPI => (
    is      => 'rw',
    lazy    => 1,
    builder => 'initDocPPI',
);

sub slurp_file { local ( @ARGV, $/ ) = @_; <> }

sub run_in_dir {
    shift if $_[0]->isa(__PACKAGE__);    # Take TestPW->run_in_dir into account.
    my $dir = shift;

    my $tDir = File::Spec->catdir( "t", $dir );

    my $tester = __PACKAGE__->new( dir => $tDir, testName => $dir, );

    $tester->run;
}

sub run {
    my $this = shift;

    my $outStr;

    if ( $this->fromPod ) {
        my $doc = $this->weaver->weave_document(
            {
                %{ $this->args },
                pod_document => $this->docPod,
                ppi_document => $this->docPPI,
            }
        );
        $outStr = $doc->as_pod_string;
    }
    else {
        $outStr = $this->munge_perl_string( $this->inSource, $this->args );
    }
    
    compare_pod_ok(
        $outStr,
        $this->expected,
        "test "
          . $this->testName
          . ": exactly the pod string we wanted after weaving!",
    );
}

sub munge_perl_string {
    my $this = shift;
    my ( $doc, $args ) = @_;

    my $newDoc = $this->weaver->weave_document(
        {
            %$args,
            pod_document => $doc->{pod},
            ppi_document => $doc->{ppi},
        }
    );

    return {
        pod => $newDoc,
        ppi => $doc->{ppi},
    };
}

sub compare_pod_ok {
    my ( $got, $exp, $desc ) = @_;