App-CamelPKI
view release on metacpan or search on metacpan
inc/My/Module/Build.pm view on Meta::CPAN
A large fraction of the unit tests are written as perlmodlib-style
__END__ documents attached directly to the module to test. See
L<My::Tests::Below> for details. My::Module::Build removes the test
footer at build time so as not to waste any resources on the install
target platform.
=head3 Extended C<test> action
The C<./Build test> action allows one to specify a list of individual
test scripts to run, in a less cumbersome fashion than straight
L<Module::Build>:
./Build test t/sometest.t lib/Foo/Bar.pm
For the developper's comfort, if only one test is specified in this
way, I<ACTION_test> assumes that I<verbose> mode is wanted (see
L<Module::Build/test>). This DWIM can be reversed on the command line:
./Build test verbose=0 t/sometest.t
In the case of running a single test, I<ACTION_test> also
automatically detects that we are running under Emacs' perldb mode and
runs the required test script under the Perl debugger. Running a
particular test under Emacs perldb is therefore as simple as typing:
M-x perldb <RET> /path/to/CPAN/module/Build test MyModule.pm
If a relative path is passed (as shown), it is interpreted relative to
the current directory set by Emacs (which, except under very bizarre
conditions, will be the directory of the file currently being
edited). The verbose switch above applies here by default,
conveniently causing the test script to run in verbose mode in the
debugger.
Like the original L<Module::Build/test>, C<./Build test> accepts
supplemental key=value command line switches, as exemplified above
with C<verbose>. Additional switches are provided by
I<My::Module::Build>:
=over
=item I<< use_blib=0 >>
Load modules from the B<source> directory (e.g. C<lib>) instead of the
build directories (e.g. C<blib/lib> and C<blib/arch>). I use this to
debug L<Inline::C> code in a tight tweak-run-tweak-run loop, a
situation in which the MD5-on-C-code feature of L<Inline> saves a lot
of rebuilds.
=item I<full_debugging=1>
Sets the FULL_DEBUGGING environment variable to 1 while running
C<./Build test>, in addition to any environment customization already
performed by L</customize_env>. Packages of mine that use L<Inline>
enable extra debugging when this environment variable is set.
=back
=head3 Dependent Option Graph
This feature wraps around L<Module::Build/prompt>,
L<Module::Build/get_options> and L<Module::Build/notes> to streamline
the programming of optional features into a ./Build.PL script. Here is
a short synopsis for this feature:
=for My::Tests::Below "option-graph" begin
my $class = My::Module::Build->subclass(code => <<'CODE');
sub install_everything: Config_Option {
question => "Install everything",
default => 1;
}
sub install_module_foo: Config_Option(type="boolean") {
my $build = shift;
return (default => 1) # Don't even bother asking the question
if $build->option_value("install_everything");
question => "Install module foo",
default => 0;
}
CODE
my $builder = $class->new(...) # See SYNOPSIS
=for My::Tests::Below "option-graph" end
Options can then be fed from the command line (e.g. C<< ./Build.PL
--gender=f >>) or by answering the questions interactively on the
terminal. I<My::Module::Build> will ask the questions at L</new>
time, in the correct order if they depend on each other (as shown in
the example), detect circular dependencies, and die if a mandatory
question does not get an appropriate answer.
=head3 Syntax
As shown above, options are methods in a subclass to
I<My::Module::Build> with a subroutine attribute of the form C<<
Config_Option(key1=value1, ...) >>. Right now the
following keys are defined:
=over
=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>);
}
inc/My/Module/Build.pm view on Meta::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 $svk_cmd = sprintf("yes n | svk info '%s' 2>%s",
catdir($self->base_dir, "Build.PL"),
File::Spec->devnull);
`$svk_cmd`; return 1 if ! $?;
# `svk info` puts the terminal into non-echo mode if run before
# initializing a main depot. Shame, shame...
eval { require Term::ReadKey; 1 } and
Term::ReadKey::ReadMode("normal");
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
CPAN package. You will therefore only be able to contribute small
bugfixes until you install YAML.
MESSAGE
foreach my $testmod (qw(Test::NoBreakpoints
Test::Pod Test::Pod::Coverage)) {
unless ($self->check_installed_status($testmod, 0)->{ok})
{ $self->show_warning(<<"MESSAGE")};
The $testmod module from CPAN is missing on your system.
One of the tests in t/maintainer will fail because of that. Please
install the corresponding module to run the full test suite.
MESSAGE
}
}
=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.
inc/My/Module/Build.pm view on Meta::CPAN
}
$declared_options{$coderef}++;
next ATTRIBUTE if ! defined $1; # No keys / values
foreach my $keyval (split qr/\s*,\s*/, $1) {
if ($keyval =~ m/^type\s*=\s*(\S+)\s*$/) {
my $type = $1;
$type =~ s/^"(.*)"$/$1/s;
$type =~ s/^'(.*)'$/$1/s;
my %canonicaltype =
( (map { $_ => "string" } qw(=s string)),
(map { $_ => "integer" } qw(=i int integer)),
(map { $_ => "boolean" } qw(! bool boolean)),
);
defined ($option_type{$coderef} = $canonicaltype{$type})
or die qq'Bad type "$type" in attribute "$attr"';
} else {
die qq'Unknown key "$keyval" in attribute "$attr"';
}
}
}
return @retval;
}
=item I<_option_value_nocache($key)>
The workhorse behind L</option_value>, which is just a caching wrapper.
=cut
sub _option_value_nocache {
my ($self, $key) = @_;
# return $self->_option_default_value($key) if
# ($self->_option_phase($key) ne $self->{phase});
do { # Look at command line
my $keyopt = lc($key); $keyopt =~ s/_/-/g;
my %type2getopt = ("string" => "=s", "integer" => "=i",
"boolean" => "!");
my $getopt = new Getopt::Long::Parser(config => [qw(pass_through)]);
my $type = $self->_option_type($key);
my $retval;
$getopt->getoptions($keyopt . $type2getopt{$type} => \$retval)
or die "Bad value for --$keyopt command-line option".
" (expected $type)\n";
if (defined $retval) {
$self->_option_check_value($key, \$retval);
return $retval;
}
};
my $default = $self->_option_default_value($key);
if (defined(my $question = $self->_option_question($key))) { # Ask user
if ($self->_option_type($key) eq "boolean") {
$default = $default ? "yes" : "no";
}
ASK_AGAIN: {
my $answer = $self->prompt($question, $default);
my $problem = $self->_option_check_value($key, \$answer);
return $answer if (! $problem);
if (-t STDIN && (-t STDOUT || !(-f STDOUT || -c STDOUT))) {
warn $problem;
redo ASK_AGAIN;
} else {
die $problem;
}
}
};
return $default;
}
=item I<_option_type($key)>
Returns the type for option $key (either "boolean", "integer" or
"string"), or undef if no such option exists.
=cut
sub _option_type {
my ($self, $key) = @_;
croak "Unknown question $key" unless (my $meth = $self->can($key));
my $type = $option_type{overload::StrVal($meth)};
$type ||= $key =~ m/^(install_|enable_)/ ? "boolean" :
$key =~ m/(_port)$/ ? "integer" :
"string";
return $type;
}
=item I<_option_is_mandatory($key)>
Returns true if a value is mandatory for $key; always false in the
case of a boolean.
=cut
sub _option_is_mandatory {
my ($self, $key) = @_;
return if $self->_option_type eq "boolean";
my $t = $self->_option_compute_template($key);
return $t->{mandatory} if exists $t->{mandatory};
return (exists $t->{default});
}
=item I<_option_default_value($key)>
Returns the option's default value, taken either from the answers from
the previous run of Build.PL (if available) or from the option
template method's return value.
=cut
sub _option_default_value {
my ($self, $key) = @_;
my $previousrun = $self->notes("option:$key");
return $previousrun if defined $previousrun;
return $self->_option_compute_template($key)->{default};
}
inc/My/Module/Build.pm view on Meta::CPAN
The zero-wing easter egg only works through the Makefile.PL
compatibility mode. On the other hand, "./Build your time" would not
sound quite right, would it?
Perhaps the L</Dependent Option Graph> features should be repackaged
as a standalone Module::Build plug-in.
=head1 SEE ALSO
L<My::Tests::Below>
t/maintainer/*.t
=cut
require My::Tests::Below unless caller;
1;
__END__
use Test::More "no_plan";
########### Dependent graph stuff ################
# We keep the tests in a separate package so that if we later decide
# to refactor the dependent graph stuff into a standalone
# Module::Build plug-in, a simple cut-n-paste operation will do the
# job.
do {
# We re-route the process of creating a Module::Build object to
# a fake package, so as not to make Module::Build itself part
# of the tests over the dependent graph stuff:
local @My::Module::Build::ISA=qw(Fake::Module::Build);
package Fake::Module::Build;
sub new { bless {}, shift }
# Various stuff that is being called by My::Module::Build as part
# of this test, and that we therefore need to stub out:
no warnings "redefine";
local *My::Module::Build::maintainer_mode_enabled = sub { 0 };
local *My::Module::Build::subclass = sub {
my ($self, %opts) = @_;
eval <<'HEADER' . $opts{code}; die $@ if $@;
package Fake::Subclass;
BEGIN { our @ISA=qw(My::Module::Build); }
HEADER
return "Fake::Subclass";
};
sub notes {
my ($self, $k, @v) = @_;
if (@v) { $self->{notes}->{$k} = $v[0]; }
return $self->{notes}->{$k};
}
# "batch" version of ->prompt()
our %answers = ("Install module foo?" => 1);
sub prompt {
my ($self, $question) = @_;
die "Unexpected question $question" if
(! exists $answers{$question});
return delete $answers{$question}; # Will not answer twice
# the same question
}
package main_screen; # Do not to pollute the namespace of "main" with
# the "use" directives below - Still keeping refactoring in mind.
BEGIN { *write_file = \&My::Module::Build::write_file;
*read_file = \&My::Module::Build::read_file; }
use Test::More;
use Fatal qw(mkdir chdir);
local @ARGV = qw(--noinstall-everything);
my $define_options =
My::Tests::Below->pod_code_snippet("option-graph");
$define_options =~ s/\.\.\.//g;
my $builder = eval $define_options; die $@ if $@;
isa_ok($builder, "Fake::Module::Build",
"construction of builder successful");
is(scalar keys %My::Module::Build::declared_options,
2, "Number of declarations seen");
is(scalar(keys %answers), 0, "All questions have been asked");
ok(! $builder->notes("option:install_everything"),
"note install_everything");
ok($builder->notes("option:install_module_foo"),
"note install_module_foo");
ok(! $builder->option_value("install_everything"),
"install_everything");
ok($builder->option_value("install_module_foo"),
"install_module_foo");
# Some whitebox testing here:
is($builder->_option_type("install_everything"), "boolean",
"implicit typing");
is($builder->_option_type("install_module_foo"), "boolean",
"explicit typing");
}; # End of fixture for option graph tests
####################### Main test suite ###########################
use File::Copy qw(copy);
use File::Spec::Functions qw(catfile catdir);
use IO::Pipe;
BEGIN { *write_file = \&My::Module::Build::write_file;
*read_file = \&My::Module::Build::read_file; }
# Probably wise to add this in real test suites too:
use Fatal qw(mkdir chdir copy);
mkdir(my $fakemoduledir = My::Tests::Below->tempdir() . "/Fake-Module");
my $sample_Build_PL = My::Tests::Below->pod_code_snippet("synopsis");
( run in 0.846 second using v1.01-cache-2.11-cpan-6aa56a78535 )