view release on metacpan or  search on metacpan

inc/My/Module/Build.pm  view on Meta::CPAN

    $self->do_create_makefile_pl if $self->create_makefile_pl;
    $self->do_create_readme if $self->create_readme;
    $self->depends_on("manifest");

    $self->SUPER::ACTION_dist(@_);
}

=item I<ACTION_buildXS>

Does nothing.  Intended for overloading by packages that have XS code,
which e.g. may want to call L</process_Inline_C_file> there.

=cut

sub ACTION_buildXS { }

=item I<ACTION_test>

Overloaded to add t/lib and t/inc to the test scripts' @INC (we
sometimes put helper test classes in there), and also to implement the
features described in L</Extended C<test> action>.  See also
L</_massage_ARGV> for more bits of the Emacs debugger support code.

=cut

sub ACTION_test {
    my $self = shift;

    # Tweak @INC (done this way, works regardless of whether we'll be
    # doing the harnessing ourselves or not)
    local @INC = (@INC, catdir($self->base_dir, "t", "lib"),
                  catdir($self->base_dir, "t", "inc"));

    # use_blib feature, part 1:
    $self->depends_on("buildXS") if $self->use_blib;

    my @files_to_test = map {
        our $initial_cwd; # Set at BEGIN time, see L<_startperl>
        File::Spec->rel2abs($_, $initial_cwd)
    } (@{$self->{args}->{ARGV} || []});

    if ($running_under_emacs_debugger && @files_to_test == 1) {
        # We want to run this script under a slave_editor debugger, so
        # as to implement the documented trick. The simplest way
        # (although inelegant) is to bypass Module::Build and
        # Test::Harness entirely, and run the child Perl
        # ourselves. Most of the code below was therefore cobbled
        # together from the real T::H version 2.40 and M::B 0.26
        $self->depends_on('code'); # As in original ACTION_test

        # Compute adequate @INC for sub-perl:
        my @inc = do { my %inc_dupes; grep { !$inc_dupes{$_}++ } @INC };
        if (is_win32) { s/[\\\/+]$// foreach @inc; }
        # Add blib/lib and blib/arch like the original ACTION_test does:
        if ($self->use_blib) {
            unshift @inc, catdir($self->base_dir(), $self->blib, 'lib'),
                catdir($self->base_dir(), $self->blib, 'arch');
        } else {
            unshift @inc, catdir($self->base_dir(), 'lib');
        }
        # Parse shebang line to set taintedness properly:
        local *TEST;
        open(TEST, $files_to_test[0]) or die
            "Can't open $files_to_test[0]. $!\n";
        my $shebang = <TEST>;
        close(TEST) or print "Can't close $files_to_test[0]. $!\n";
        my $taint = ( $shebang =~ /^#!.*\bperl.*\s-\w*([Tt]+)/ );
        my ($perl) = ($^X =~ m/^(.*)$/); # Untainted
        system($perl, "-d",
               ($taint ? ("-T") : ()),
               (map { ("-I" => $_) } @inc),
               $files_to_test[0], "-emacs");
        return;
    }

    # Localize stuff in order to fool our superclass for fun & profit

    local %ENV = $self->customize_env(%ENV);

    local $self->{FORCE_find_test_files_result}; # See L</find_test_files>
    $self->{FORCE_find_test_files_result} = \@files_to_test if
        @files_to_test;
    # DWIM for ->{verbose} (see POD)
    local $self->{properties} = { %{$self->{properties}} };
    if (@files_to_test == 1) {
        $self->{properties}->{verbose} = 1 if
            (! defined $self->{properties}->{verbose});
    }

    # use_blib feature, cont'd:
    no warnings "once";
    local *blib = sub {
        my $self = shift;

        return File::Spec->curdir if ! $self->use_blib;
        return $self->SUPER::blib(@_);
    };


    $self->SUPER::ACTION_test(@_);
}

=item I<ACTION_distmeta>

Overloaded to ensure that .pm modules in inc/ don't get indexed and
that the C<add_to_no_index> parameter to L</new> is honored.

=cut

sub ACTION_distmeta {
    my $self = shift;

    eval { require YAML } or die ($@ . <<"MESSAGE");

YAML is required for distmeta to produce accurate results. Please
install it and re-run this command.

MESSAGE

    # Steals a reference to the YAML object that will be constructed
    # by the parent class (duhh)
    local our $orig_yaml_node_new = \&YAML::Node::new;
    local our $node;
    no warnings "redefine";
    local *YAML::Node::new = sub {
        $node = $orig_yaml_node_new->(@_);
    };

    my $retval = $self->SUPER::ACTION_distmeta;
    die "Failed to steal the YAML node" unless defined $node;

inc/My/Module/Build.pm  view on Meta::CPAN

=cut

my $fakemodule = <<'FAKE_MODULE';
#!perl -w

# (C) DOMQ

use strict;
package Fake::Module;

our $VERSION = '0.42';

=head1 NAME

Fake::Module - This module is for testing My::Module::Build.pm

=head1 SYNOPSIS

Hey, gimme a break, this is a *bogus* package for Pete's sake!

=sorry, you're right

=cut the schizoid POD freakiness now will you? This is not M-x doctor!

# Good.

package Fake::Module::Ancillary::Class;

1;

__END__

package This::Package::Should::Not::Be::Reported::In::METAyml;

FAKE_MODULE

=end this_pod_is_not_mine

=cut

write_file("$fakemoduledir/lib/Fake/Module.pm", $fakemodule);

mkdir("$fakemoduledir/$_") foreach
    (qw(inc inc/My inc/My/Module
        lib/My lib/My/Private lib/My/Private/Stuff));

use FindBin qw($Bin $Script);
copy(catfile($Bin, $Script),
            "$fakemoduledir/inc/My/Module/Build.pm");
write_file(catfile($fakemoduledir, qw(lib My Private Stuff Indeed.pm)),
           <<"BOGON");
#!perl -w

package My::Private::Stuff::Indeed;
use strict;

1;

BOGON

my ($perl) = ($^X =~ m/^(.*)$/); # Untainted
chdir($fakemoduledir);

my $pipe = new IO::Pipe();
$pipe->reader($perl, "$fakemoduledir/Build.PL");
my $log = join('', <$pipe>);
$pipe->close(); is($?, 0, "Running Build.PL");
like($log, qr/version.*0.42/, "Build.PL found the version string");

SKIP: {
    skip "Not testing Build distmeta (YAML not available)", 2
        unless eval { require YAML };

    my $snippet = My::Tests::Below->pod_data_snippet("distmeta");
    my $errfile = "$fakemoduledir/meta-yml-error.log";
    my $script = <<"SCRIPT";
exec > "$errfile" 2>&1
set -x
cd "$fakemoduledir"
$snippet
SCRIPT
    system($script);
    is($?, 0, "creating META.yml using documented procedure")
        or diag($script . read_file($errfile));
    my $META_yml = read_file("$fakemoduledir/META.yml");
    my $excerpt = My::Tests::Below->pod_data_snippet("META.yml excerpt");
    $excerpt =~ s/\n+/\n/gs; $excerpt =~ s/^\n//s;
    like($META_yml, qr/\Q$excerpt\E/,
        "META.yml contains provisions against indexing My::* modules");
    like($META_yml, qr|My\b.*\bPrivate\b.*\bStuff|,
        "these provisions can be customized");
    like($META_yml, qr/\bFake::Module\b/,
        "Fake::Module is indexed");
    like($META_yml, qr/\bFake::Module::Ancillary::Class\b/,
        "Fake::Module::Ancillary::Class is indexed");
    unlike($META_yml, qr/This::Package::Should::Not::Be::Reported/,
        "META.yml should not index stuff that is after __END__");
    unlike($META_yml, qr/Indeed/,
        "META.yml should not index stuff that is in add_to_no_index");
}

# You have no chance to survive...
test_Makefile_PL_your_time($_) for
    ($sample_Build_PL, <<'SUBCLASSED_BUILD_PL');
use strict;
use warnings;

use FindBin; use lib "$FindBin::Bin/inc";
use My::Module::Build;

my $subclass = My::Module::Build->subclass(code => "");

my $builder = $subclass->new(
      module_name         => 'Fake::Module',
      license             => 'perl',
      dist_author         => 'Octave Hergebelle <hector@tdlgb.org>',
      dist_version_from   => 'lib/Fake/Module.pm',
      dist_abstract       => 'required for Module::Build 0.2805, sheesh',
      requires            => {
        'Module::Build' => 0,
      },