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

        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 "use YAML 0.30; 1;" or die ($@ . <<"MESSAGE");

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

MESSAGE
    my $retval = $self->SUPER::ACTION_distmeta;

    my $metafile = $self->can("metafile") ? # True as of Module::Build 0.2805
      $self->metafile() : $self->{metafile};
    my $meta_yml = YAML::LoadFile($metafile);

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

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

    YAML::DumpFile($metafile, $meta_yml) or die "Could not write to $metafile: $!";
    return $retval;
}

=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(@_);
}

=item I<process_pm_file_if_modified(%args)>

Does the same as L<copy_file_if_modified> (which it actually replaces
while L<process_pm_files> runs), except that the L</new_pm_filter> is
applied instead of performing a vanilla copy as L<Module::Build> does.

=cut