view release on metacpan or  search on metacpan

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

=item I<show_warning($message)>

Displays a multi-line message $message to the user, and prompts
him/her to "Press RETURN to continue".

=cut

sub show_warning {
    my ($self, $message) = @_;
    $message = "\n$message" until ($message =~ m/^\n\n/);
    $message .= "\n" until ($message =~ m/\n\n$/);
    warn $message;
    $self->prompt("Press RETURN to continue");
    1;
}

=item I<show_fatal_error($message)>

Like L</show_warning>, but throws an exception after displaying
$message.

=cut

sub show_fatal_error {
    my ($self, $message) = @_;
    $self->show_warning($message);
    die "Fatal error, bailing out.\n";
}

=back

=head2 Methods

These are intended to be called directly from Build.PL

=over

=item I<topir>

Returns the directory in which C<Build.PL> resides.

=cut

sub topdir {
    # TODO: probably not good enough in some cases.
    require FindBin;
    no warnings "once";
    return $FindBin::Bin;
}

=item I<package2filename($packagename)>

Converts $packagename (e.g. C<Foo::Bar>) into its OS-specific notation
(e.g. C<Foo/Bar.pm>).

=cut

sub package2filename {
    my ($self, $package) = @_;
    my @components = split m/::/, $package;
    $components[$#components] .= ".pm";
    return catfile(@components);
}

=item I<process_Inline_C_file($filename, @preload_modules)>

Arranges for L<Inline::C> code contained in $filename to be compiled
into .bs's and .so's.  @preload_modules is a list of Perl packages (in
Perl C<use> notation, eg C<Foo::Bar> instead of C<Foo/Bar.pm>) that
should be loaded with C<use> before starting the L<Inline> install
process.  Uses a stamp file in C<blib/stamp> to avoid compiling anew
if neither $filename nor @preload_modules changed.

=cut

sub process_Inline_C_file {
    my ($self, $filename, @preload_modules) = @_;

    my $stampfile = do {
        my ($volume, $dir, $base) = splitpath($filename);
        catfile(qw(blib stamp Inline-C),
                 join("_", splitdir($dir), $base));
    };
    return if $self->up_to_date
                ([$filename,
                  map { catfile("lib", $self->package2filename($_)) }
                  @preload_modules], [$stampfile]);

    # Remove any leftovers from a (failed) previous run.
    do { unlink($_) or die "Cannot unlink($_): $!" } for glob("*.inl");

    # And now some ugly kludge to make everything hold together.
    # Inline::C wants to use MakeMaker; we don't.  So let's call it in
    # a sub-Perl.
    my $version = $self->dist_version;
    my $module_name = $self->module_name;

    my $script = <<"SET_VERSION";
BEGIN { \$${module_name}::VERSION = '$version' ; }
SET_VERSION
    $script .= "use $_; " foreach (@preload_modules);
    $script .= <<"ACTIVATE_INLINE_COMPILE";
use Inline qw(_INSTALL_);
require "$filename";
ACTIVATE_INLINE_COMPILE
    $script =~ s/\n/ /g;

    my @cmdline = ($^X, "-I" => catdir($self->topdir, "lib"),
                   -e => $script, $version, catdir(qw(blib arch)));
    warn(join(" ", @cmdline, "\n"));
    local %ENV = $self->customize_env(%ENV);
    system(@cmdline);
    die "Command exited with status " . ($? >> 8) if $?;

    # Remove the leftovers again.
    do { unlink($_) or die "Cannot unlink($_): $!" } for glob("*.inl");
    rmdir("arch");

    # Update timestamp
    if (! -d (my $stampdir = dirname($stampfile))) {

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

    # 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;

    $node->{no_index} = $self->{properties}->{add_to_no_index} || {};
    $node->{no_index}->{directory} ||= [];
    unshift(@{$node->{no_index}->{directory}}, qw(examples inc t),
            (map { File::Spec::Unix->catdir("lib", split m/::/) }
             (@{$node->{no_index}->{namespace} || []})));

    foreach my $package (keys %{$node->{provides}}) {
        delete $node->{provides}->{$package} if
            (grep {$package =~ m/^\Q$_\E/}
             @{$node->{no_index}->{namespace} || []});
        delete $node->{provides}->{$package} if
            (grep {$package eq $_}
             @{$node->{no_index}->{package} || []});
    }

    my $metafile =
        $self->can("metafile") ? # True as of Module::Build 0.2805
            $self->metafile() : $self->{metafile};
    # YAML API changed after version 0.30
    my $yaml_sub =
        ($YAML::VERSION le '0.30' ? \&YAML::StoreFile : \&YAML::DumpFile);
    $yaml_sub->($metafile, $node)
        or die "Could not write to $metafile: $!";
;
}

=item I<customize_env(%env)>

Returns a copy of %env, an environment hash, modified in a
package-specific fashion.  To be used typically as

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

The default implementation sets PERL_INLINE_BUILD_NOISY to 1 and also
sets FULL_DEBUGGING if so directed by the command line (see L</
ACTION_test>).

=cut

sub customize_env {
    my ($self, %env) = @_;
    delete $env{FULL_DEBUGGING};

    $env{PERL_INLINE_BUILD_NOISY} = 1;
    $env{FULL_DEBUGGING} = 1 if ($self->{args}->{full_debugging});
    return %env;
}

=item I<process_pm_files>

Called internally in Build to convert lib/**.pm files into their
blib/**.pm counterpart; overloaded here to remove the test suite (see
L</Unit tests>) and standardize the copyright of the files authored by
me.

=cut

sub process_pm_files {
    no warnings "once";
    local *copy_if_modified = \*process_pm_file_if_modified;
    my $self = shift;
    return $self->SUPER::process_pm_files(@_);
}