view release on metacpan or  search on metacpan

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

=item        I<type>

The datatype of this option, either as a word (e.g. "boolean", "integer" or
"string") or as a L<GetOpt::Long> qualifier (e.g. "!", "=s" or "=i").

The default is to guess from the name of the option: "install_foo" and
"enable_bar" are supposed to be booleans, "baz_port" an integer, and
everything else a string.

=back

The name of the method is the internal key for the corresponding
option (e.g. for L</option_value>). It is also the name of the
corresponding command-line switch, except that all underscores are
converted to dashes.

The method shall return a (key, value) "flat hash" with the following
keys recognized:

=over

=item        I<question>

The question to ask, as text. A question mark is appended
automatically for convenience if there isn't already one. If no
question is set, I<My::Module::Build> will not ask anything for this
question even in interactive mode, and will attempt to use the default
value instead (see below).

=item        I<default>

In batch mode, the value to use if none is available from the command
line or the persisted answer set from previous attempts to run
./Build.PL. In interactive mode, the value to offer to the user as the
default.

=item       I<mandatory>

A Boolean indicating whether answering the question with a non-empty
value is mandatory (see also L</prompt> for a twist on what
"non-empty" exactly means). The default mandatoryness is 1 if
I<default> is not returned, 0 if I<default> is returned (even with an
undef value).

=back

=head1 REFERENCE

=cut

package My::Module::Build;
use strict;
use warnings;
use base "Module::Build";

use IO::File;
use File::Path qw(mkpath);
use File::Spec::Functions qw(catfile catdir splitpath splitdir);
use File::Basename qw(dirname);
use File::Spec::Unix ();
use File::Find;

=begin internals

=head2 Global variables

=head3 $running_under_emacs_debugger

Set by L</_massage_ARGV> if (you guessed it) we are currently running
under the Emacs debugger.

=cut

our $running_under_emacs_debugger;

=head2 Constants

=head3 is_win32

Your usual bugware-enabling OS checks.

=cut

use constant is_win32 => scalar($^O =~ /^(MS)?Win32$/);

=head2 read_file($file)

=head2 write_file($file, @lines)

Like in L<File::Slurp>.

=cut

sub read_file {
  my ($filename) = @_;
  defined(my $file = IO::File->new($filename, "<")) or die <<"MESSAGE";
Cannot open $filename for reading: $!.
MESSAGE
  return wantarray? <$file> : join("", <$file>);
}

sub write_file {
  my ($filename, @contents) = @_;
  defined(my $file = IO::File->new($filename, ">")) or die <<"MESSAGE";
Cannot open $filename for writing: $!.
MESSAGE
  ($file->print(join("", @contents)) and $file->close()) or die <<"MESSAGE";
Cannot write into $filename: $!.
MESSAGE
}

=end internals

=head2 Constructors and Class Methods

These are intended to be called directly from Build.PL

=over

=item I<new(%named_options)>

Overloaded from parent class in order to call
L</check_maintainer_dependencies> if L</maintainer_mode_enabled> is
true.  Also sets the C<recursive_test_files> property to true by
default (see L<Module::Build/test_files>), since I like to store
maintainer-only tests in C<t/maintainer> (as documented in
L</find_test_files>).

In addition to the %named_options documented in L<Module::Build/new>,
I<My::Module::Build> provides support for the following switches:

=over

=item I<< add_to_no_index => $data_structure >>

Appends the aforementioned directories and/or namespaces to the list
that L</ACTION_distmeta> stores in META.yml.  Useful to hide some of
the Perl modules from the CPAN index.

=back

=cut

sub new {
    my ($class, %opts) = @_;
    $opts{recursive_test_files} = 1 if
        (! defined $opts{recursive_test_files});
    my $self = $class->SUPER::new(%opts);
    if ($self->maintainer_mode_enabled()) {
        print "Running specific maintainer checks...\n";
        $self->check_maintainer_dependencies();
    }
    $self->_process_options;
    $self;
}

=item I<requires_for_build()>

Returns a list of packages that are required by I<My::Module::Build>
itself, and should therefore be appended to the C<build_requires> hash
as shown in L</SYNOPSIS>.

=cut

sub requires_for_build {
       ('IO::File'              => 0,
        'File::Path'            => 0,
        'File::Spec'            => 0,
        'File::Spec::Functions' => 0,
        'File::Spec::Unix'      => 0,
        'File::Find'            => 0,
        'Module::Build'         => 0,
        'Module::Build::Compat' => 0,
        'FindBin'               => 0, # As per L</SYNOPSIS>

        # The following are actually requirements for tests:
        'File::Temp' => 0,  # for tempdir() in My::Tests::Below
        'Fatal' => 0, # Used to cause tests to die early if fixturing
                      # fails, see sample in this module's test suite
                      # (at the bottom of this file)
       );
}

{
    no warnings "once";
    *requires_for_tests = \&requires_for_build; # OBSOLETE misnomer
}

=item I<maintainer_mode_enabled()>

Returns true iff we are running "./Build.PL" or "./Build" off a
revision control system of some kind. Returns false in all other
situations, especially if we are running on an untarred package
downloaded from CPAN.

=cut

sub maintainer_mode_enabled {
    my $self = shift;
    foreach my $vc_dir (qw(CVS .svn .hg .git)) {
        return 1 if -d catdir($self->base_dir, $vc_dir);
    }
   
    my $full_cmd = sprintf("yes n | svk info '%s' 2>%s",
                           catdir($self->base_dir, "Build.PL"),
                           File::Spec->devnull);
    `$full_cmd`; return 1 if ! $?;

    return 0;
}

=item I<check_maintainer_dependencies()>

Checks that the modules required for B<modifying> the CPAN package are
installed on the target system, and displays a friendly, non-fatal
message otherwise. This method is automatically run from L</new> if
appropriate (that is, if L</maintainer_mode_enabled> is true).

=cut

sub check_maintainer_dependencies {
    my $self = shift;
    unless ($self->check_installed_status('YAML', 0)->{ok})
        { $self->show_warning(<<"MESSAGE"); }

The YAML module from CPAN is missing on your system.

YAML is required for the "./Build distmeta" operation. You have to run
that command to regenerate META.yml every time you add a new .pm,
change dependencies or otherwise alter the namespace footprint of this

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