We're now in sync with CPAN--no local changes remain in blead.
TODO: Various extra core changes are now required to handle the new bundle.pl script as per the existing config_data script.
lib/Module/Build.pm Module::Build
lib/Module/Build/PodParser.pm Module::Build
lib/Module/Build/PPMMaker.pm Module::Build
+lib/Module/Build/scripts/bundle.pl Module::Build
lib/Module/Build/scripts/config_data Module::Build
+lib/Module/Build/t/add_property.t Module::Build
lib/Module/Build/t/basic.t Module::Build
lib/Module/Build/t/bundled/Tie/CPHash.pm Module::Build.pm
lib/Module/Build/t/compat.t Module::Build
use vars qw($VERSION @ISA);
@ISA = qw(Module::Build::Base);
-$VERSION = '0.30_01';
+$VERSION = '0.31012';
$VERSION = eval $VERSION;
# Okay, this is the brute-force method of finding out what kind of
darwin Unix
machten Unix
midnightbsd Unix
+ mirbsd Unix
next Unix
openbsd Unix
netbsd Unix
[version 0.20]
-This should be a short description of the distribution. This is used
-when generating metadata for F<META.yml> and PPD files. If it is not
-given then C<Module::Build> looks in the POD of the module from which
-it gets the distribution's version. It looks for the first line
-matching C<$package\s-\s(.+)>, and uses the captured text as the
-abstract.
+This should be a short description of the distribution. This is used when
+generating metadata for F<META.yml> and PPD files. If it is not given
+then C<Module::Build> looks in the POD of the module from which it gets
+the distribution's version. If it finds a POD section marked "=head1
+NAME", then it looks for the first line matching C<\s+-\s+(.+)>,
+and uses the captured text as the abstract.
=item dist_author
this process, so there's no real opportunity to change to something
better.
+If the target file of L</dist_version_from> contains more than one package
+declaration, the version returned will be the one matching the configured
+L</module_name>.
+
=item dynamic_config
[version 0.07]
defaults to C<MyModuleBuilder>. The C<code> parameter specifies Perl
code to use as the body of the subclass.
+=item add_property
+
+[version 0.31]
+
+ package 'My::Build';
+ use base 'Module::Build';
+ __PACKAGE__->add_property( 'pedantic' );
+ __PACKAGE__->add_property( answer => 42 );
+ __PACKAGE__->add_property(
+ 'epoch',
+ default => sub { time },
+ check => sub {
+ return 1 if /^\d+$/;
+ shift->property_error( "'$_' is not an epoch time" );
+ return 0;
+ },
+ );
+
+Adds a property to a Module::Build class. Properties are those attributes of a
+Module::Build object which can be passed to the constructor and which have
+accessors to get and set them. All of the core properties, such as
+C<module_name> and C<license>, are defined using this class method.
+
+The first argument to C<add_property()> is always the name of the property.
+The second argument can be either a default value for the property, or a list
+of key/value pairs. The supported keys are:
+
+=over
+
+=item C<default>
+
+The default value. May optionally be specified as a code reference, in which
+case the return value from the execution of the code reference will be used.
+If you need the default to be a code reference, just use a code reference to
+return it, e.g.:
+
+ default => sub { sub { ... } },
+
+=item C<check>
+
+A code reference that checks that a value specified for the property is valid.
+During the execution of the code reference, the new value will be included in
+the C<$_> variable. If the value is correct, the C<check> code reference
+should return true. If the value is not correct, it sends an error message to
+C<property_error()> and returns false.
+
+=back
+
+When this method is called, a new property will be installed in the
+Module::Build class, and an accessor will be built to allow the property to be
+get or set on the build object.
+
+ print $build->pedantic, $/;
+ $build->pedantic(0);
+
+If the default value is a hash reference, this generetes a special-case
+accessor method, wherein individual key/value pairs may be set or fetched:
+
+ print "stuff{foo} is: ", $build->stuff( 'foo' ), $/;
+ $build->stuff( foo => 'bar' );
+ print $build->stuff( 'foo' ), $/; # Outputs "bar"
+
+Of course, you can still set the entire hash reference at once, as well:
+
+ $build->stuff( { foo => 'bar', baz => 'yo' } );
+
+In either case, if a C<check> has been specified for the property, it will be
+applied to the entire hash. So the check code reference should look something
+like:
+
+ check => sub {
+ return 1 if defined $_ && exists $_->{foo};
+ shift->property_error(qq{Property "stuff" needs "foo"});
+ return 0;
+ },
+
+=item property_error
+
+[version 0.31]
+
=back
compiling & linking C code. If no such object is available (e.g. if
the system has no compiler installed) an exception will be thrown.
-
=item check_installed_status($module, $version)
[version 0.11]
=item conflicts()
+=item create_license()
+
=item create_makefile_pl()
=item create_packlist()
use strict;
use vars qw($VERSION);
-$VERSION = '0.30';
+$VERSION = '0.31012';
$VERSION = eval $VERSION;
BEGIN { require 5.00503 }
################## End constructors #########################
-sub log_info { print @_ unless shift()->quiet }
-sub log_verbose { shift()->log_info(@_) if $_[0]->verbose }
+sub log_info {
+ my $self = shift;
+ print @_ unless(ref($self) and $self->quiet);
+}
+sub log_verbose {
+ my $self = shift;
+ $self->log_info(@_) if(ref($self) and $self->verbose);
+}
sub log_warn {
# Try to make our call stack invisible
shift;
);
}
-{
- my %valid_properties = ( __PACKAGE__, {} );
- my %additive_properties;
+########################################################################
+{ # enclosing these lexicals -- TODO
+ my %valid_properties = ( __PACKAGE__, {} );
+ my %additive_properties;
- sub _mb_classes {
- my $class = ref($_[0]) || $_[0];
- return ($class, $class->mb_parents);
- }
+ sub _mb_classes {
+ my $class = ref($_[0]) || $_[0];
+ return ($class, $class->mb_parents);
+ }
+
+ sub valid_property {
+ my ($class, $prop) = @_;
+ return grep exists( $valid_properties{$_}{$prop} ), $class->_mb_classes;
+ }
+
+ sub valid_properties {
+ return keys %{ shift->valid_properties_defaults() };
+ }
- sub valid_property {
- my ($class, $prop) = @_;
- return grep exists( $valid_properties{$_}{$prop} ), $class->_mb_classes;
+ sub valid_properties_defaults {
+ my %out;
+ for (reverse shift->_mb_classes) {
+ @out{ keys %{ $valid_properties{$_} } } = map {
+ $_->()
+ } values %{ $valid_properties{$_} };
}
+ return \%out;
+ }
- sub valid_properties {
- return keys %{ shift->valid_properties_defaults() };
+ sub array_properties {
+ for (shift->_mb_classes) {
+ return @{$additive_properties{$_}->{ARRAY}}
+ if exists $additive_properties{$_}->{ARRAY};
}
+ }
- sub valid_properties_defaults {
- my %out;
- for (reverse shift->_mb_classes) {
- @out{ keys %{ $valid_properties{$_} } } = values %{ $valid_properties{$_} };
- }
- return \%out;
+ sub hash_properties {
+ for (shift->_mb_classes) {
+ return @{$additive_properties{$_}->{'HASH'}}
+ if exists $additive_properties{$_}->{'HASH'};
}
+ }
- sub array_properties {
- for (shift->_mb_classes) {
- return @{$additive_properties{$_}->{ARRAY}}
- if exists $additive_properties{$_}->{ARRAY};
- }
+ sub add_property {
+ my ($class, $property) = (shift, shift);
+ die "Property '$property' already exists"
+ if $class->valid_property($property);
+ my %p = @_ == 1 ? ( default => shift ) : @_;
+
+ my $type = ref $p{default};
+ $valid_properties{$class}{$property} = $type eq 'CODE'
+ ? $p{default}
+ : sub { $p{default} };
+
+ push @{$additive_properties{$class}->{$type}}, $property
+ if $type;
+
+ unless ($class->can($property)) {
+ # TODO probably should put these in a util package
+ my $sub = $type eq 'HASH'
+ ? _make_hash_accessor($property, \%p)
+ : _make_accessor($property, \%p);
+ no strict 'refs';
+ *{"$class\::$property"} = $sub;
}
- sub hash_properties {
- for (shift->_mb_classes) {
- return @{$additive_properties{$_}->{'HASH'}}
- if exists $additive_properties{$_}->{'HASH'};
- }
+ return $class;
+ }
+
+ sub property_error {
+ my $self = shift;
+ die 'ERROR: ', @_;
}
- sub add_property {
- my ($class, $property, $default) = @_;
- die "Property '$property' already exists" if $class->valid_property($property);
+ sub _set_defaults {
+ my $self = shift;
- $valid_properties{$class}{$property} = $default;
+ # Set the build class.
+ $self->{properties}{build_class} ||= ref $self;
- my $type = ref $default;
- if ($type) {
- push @{$additive_properties{$class}->{$type}}, $property;
- }
+ # If there was no orig_dir, set to the same as base_dir
+ $self->{properties}{orig_dir} ||= $self->{properties}{base_dir};
- unless ($class->can($property)) {
- no strict 'refs';
- if ( $type eq 'HASH' ) {
- *{"$class\::$property"} = sub {
- # XXX this needs 'use strict' again
- my $self = shift;
- my $x = $self->{properties};
- return $x->{$property} unless @_;
-
- if ( defined($_[0]) && !ref($_[0]) ) {
- if ( @_ == 1 ) {
- return exists( $x->{$property}{$_[0]} ) ?
- $x->{$property}{$_[0]} : undef;
- } elsif ( @_ % 2 == 0 ) {
- my %args = @_;
- while ( my($k, $v) = each %args ) {
- $x->{$property}{$k} = $v;
- }
- } else {
- die "Unexpected arguments for property '$property'\n";
- }
- } else {
- $x->{$property} = $_[0];
- }
- };
-
- } else {
- *{"$class\::$property"} = sub {
- # XXX this needs 'use strict' again
- my $self = shift;
- $self->{properties}{$property} = shift if @_;
- return $self->{properties}{$property};
- }
- }
+ my $defaults = $self->valid_properties_defaults;
- }
- return $class;
+ foreach my $prop (keys %$defaults) {
+ $self->{properties}{$prop} = $defaults->{$prop}
+ unless exists $self->{properties}{$prop};
}
- sub _set_defaults {
- my $self = shift;
+ # Copy defaults for arrays any arrays.
+ for my $prop ($self->array_properties) {
+ $self->{properties}{$prop} = [@{$defaults->{$prop}}]
+ unless exists $self->{properties}{$prop};
+ }
+ # Copy defaults for arrays any hashes.
+ for my $prop ($self->hash_properties) {
+ $self->{properties}{$prop} = {%{$defaults->{$prop}}}
+ unless exists $self->{properties}{$prop};
+ }
+ }
- # Set the build class.
- $self->{properties}{build_class} ||= ref $self;
+} # end closure
+########################################################################
+sub _make_hash_accessor {
+ my ($property, $p) = @_;
+ my $check = $p->{check} || sub { 1 };
- # If there was no orig_dir, set to the same as base_dir
- $self->{properties}{orig_dir} ||= $self->{properties}{base_dir};
+ return sub {
+ my $self = shift;
- my $defaults = $self->valid_properties_defaults;
-
- foreach my $prop (keys %$defaults) {
- $self->{properties}{$prop} = $defaults->{$prop}
- unless exists $self->{properties}{$prop};
- }
-
- # Copy defaults for arrays any arrays.
- for my $prop ($self->array_properties) {
- $self->{properties}{$prop} = [@{$defaults->{$prop}}]
- unless exists $self->{properties}{$prop};
- }
- # Copy defaults for arrays any hashes.
- for my $prop ($self->hash_properties) {
- $self->{properties}{$prop} = {%{$defaults->{$prop}}}
- unless exists $self->{properties}{$prop};
+ # This is only here to deprecate the historic accident of calling
+ # properties as class methods - I suspect it only happens in our
+ # test suite.
+ unless(ref($self)) {
+ carp("\n$property not a class method (@_)");
+ return;
+ }
+
+ my $x = $self->{properties};
+ return $x->{$property} unless @_;
+
+ my $prop = $x->{$property};
+ if ( defined $_[0] && !ref $_[0] ) {
+ if ( @_ == 1 ) {
+ return exists $prop->{$_[0]} ? $prop->{$_[0]} : undef;
+ } elsif ( @_ % 2 == 0 ) {
+ my %new = (%{ $prop }, @_);
+ local $_ = \%new;
+ $x->{$property} = \%new if $check->($self);
+ return $x->{$property};
+ } else {
+ die "Unexpected arguments for property '$property'\n";
}
+ } else {
+ die "Unexpected arguments for property '$property'\n"
+ if defined $_[0] && ref $_[0] ne 'HASH';
+ local $_ = $_[0];
+ $x->{$property} = shift if $check->($self);
}
+ };
+}
+########################################################################
+sub _make_accessor {
+ my ($property, $p) = @_;
+ my $check = $p->{check} || sub { 1 };
+
+ return sub {
+ my $self = shift;
+ # This is only here to deprecate the historic accident of calling
+ # properties as class methods - I suspect it only happens in our
+ # test suite.
+ unless(ref($self)) {
+ carp("\n$property not a class method (@_)");
+ return;
+ }
+
+ my $x = $self->{properties};
+ return $x->{$property} unless @_;
+ local $_ = $_[0];
+ $x->{$property} = shift if $check->($self);
+ return $x->{$property};
+ };
}
+########################################################################
# Add the default properties.
__PACKAGE__->add_property(blib => 'blib');
__PACKAGE__->add_property(build_bat => 0);
__PACKAGE__->add_property(config_dir => '_build');
__PACKAGE__->add_property(include_dirs => []);
-__PACKAGE__->add_property(installdirs => 'site');
__PACKAGE__->add_property(metafile => 'META.yml');
__PACKAGE__->add_property(recurse_into => []);
__PACKAGE__->add_property(use_rcfile => 1);
__PACKAGE__->add_property(test_file_exts => ['.t']);
__PACKAGE__->add_property(use_tap_harness => 0);
__PACKAGE__->add_property(tap_harness_args => {});
+__PACKAGE__->add_property(
+ 'installdirs',
+ default => 'site',
+ check => sub {
+ return 1 if /^(core|site|vendor)$/;
+ return shift->property_error(
+ $_ eq 'perl'
+ ? 'Perhaps you meant installdirs to be "core" rather than "perl"?'
+ : 'installdirs must be one of "core", "site", or "vendor"'
+ );
+ return shift->property_error("Perhaps you meant 'core'?") if $_ eq 'perl';
+ return 0;
+ },
+);
{
my $Is_ActivePerl = eval {require ActivePerl::DocTools};
base_dir
bindoc_dirs
c_source
+ create_license
create_makefile_pl
create_readme
debugger
$self->log_info("Checking features:\n");
- my $max_name_len = 0;
- $max_name_len = ( length($_) > $max_name_len ) ?
- length($_) : $max_name_len
- for keys %$features;
+ # TODO refactor into ::Util
+ my $longest = sub {
+ my @str = @_ or croak("no strings given");
+
+ my @len = map({length($_)} @str);
+ my $max = 0;
+ my $longest;
+ for my $i (0..$#len) {
+ ($max, $longest) = ($len[$i], $str[$i]) if($len[$i] > $max);
+ }
+ return($longest);
+ };
+ my $max_name_len = length($longest->(keys %$features));
while (my ($name, $info) = each %$features) {
$self->log_info(" $name" . '.' x ($max_name_len - length($name) + 4));
my $self = shift;
my (@argv) = @_;
+ # XXX is it even valid to call this as a class method?
+ return({}, @argv) unless(ref($self)); # no object
+
my $specs = $self->get_options;
return({}, @argv) unless($specs and %$specs); # no user options
(my $tr_opt = $opt) =~ tr/-/_/;
return $tr_opt if grep $tr_opt =~ /^(?:no_?)?$_$/, qw(
+ create_license
create_makefile_pl
create_readme
extra_compiler_flags
my @bool_opts = qw(
build_bat
+ create_license
create_readme
pollute
quiet
$self->_add_to_manifest('MANIFEST', 'Makefile.PL');
}
+sub do_create_license {
+ my $self = shift;
+ $self->log_info("Creating LICENSE file");
+
+ my $l = $self->license
+ or die "No license specified";
+
+ my $key = $self->valid_licenses->{$l}
+ or die "'$l' isn't a license key we know about";
+ my $class = "Software::License::$key";
+
+ eval "use $class; 1"
+ or die "Can't load Software::License to create LICENSE file: $@";
+
+ $self->delete_filetree('LICENSE');
+
+ my $author = join " & ", @{ $self->dist_author };
+ my $license = $class->new({holder => $author});
+ my $fh = IO::File->new('> LICENSE')
+ or die "Can't write LICENSE file: $!";
+ print $fh $license->fulltext;
+ close $fh;
+
+ $self->_add_to_manifest('MANIFEST', 'LICENSE');
+}
+
sub do_create_readme {
my $self = shift;
$self->delete_filetree('README');
{
my %licenses = (
+ perl => 'Perl_5',
+ apache => 'Apache_2_0',
+ artistic => 'Artistic_1_0',
+ artistic_2 => 'Artistic_2_0',
+ lgpl => 'LGPL_2_1',
+ lgpl2 => 'LGPL_2_1',
+ lgpl3 => 'LGPL_3_0',
+ bsd => 'BSD',
+ gpl => 'GPL_1',
+ gpl2 => 'GPL_2',
+ gpl3 => 'GPL_3',
+ mit => 'MIT',
+ mozilla => 'Mozilla_1_1',
+ open_source => undef,
+ unrestricted => undef,
+ restrictive => undef,
+ unknown => undef,
+ );
+
+ # TODO - would be nice to not have these here, since they're more
+ # properly stored only in Software::License
+ my %license_urls = (
perl => 'http://dev.perl.org/licenses/',
apache => 'http://apache.org/licenses/LICENSE-2.0',
artistic => 'http://opensource.org/licenses/artistic-license.php',
artistic_2 => 'http://opensource.org/licenses/artistic-license-2.0.php',
lgpl => 'http://opensource.org/licenses/lgpl-license.php',
+ lgpl2 => 'http://opensource.org/licenses/lgpl-2.1.php',
+ lgpl3 => 'http://opensource.org/licenses/lgpl-3.0.html',
bsd => 'http://opensource.org/licenses/bsd-license.php',
gpl => 'http://opensource.org/licenses/gpl-license.php',
gpl2 => 'http://opensource.org/licenses/gpl-2.0.php',
sub valid_licenses {
return \%licenses;
}
+ sub _license_url {
+ return $license_urls{$_[1]};
+ }
}
sub _hash_merge {
$self->do_create_makefile_pl if $self->create_makefile_pl;
$self->do_create_readme if $self->create_readme;
+ $self->do_create_license if $self->create_license;
$self->do_create_metafile;
}
}
$node->{version} = '' . $node->{version}; # Stringify version objects
- if (defined( $self->license ) &&
- defined( my $url = $self->valid_licenses->{ $self->license } )) {
- $node->{resources}{license} = $url;
+ if (defined( my $l = $self->license )) {
+ die "Unknown license string '$l'"
+ unless exists $self->valid_licenses->{ $self->license };
+
+ if (my $key = $self->valid_licenses->{ $self->license }) {
+ my $class = "Software::License::$key";
+ if (eval "use $class; 1") {
+ # S::L requires a 'holder' key
+ $node->{resources}{license} = $class->new({holder=>"nobody"})->url;
+ } else {
+ $node->{resources}{license} = $self->_license_url($key);
+ }
+ }
}
if (exists $p->{configure_requires}) {
$self->do_system($self->split_like_shell($self->{args}{gzip}), "$file.tar") if $self->{args}{gzip};
} else {
require Archive::Tar;
+
# Archive::Tar versions >= 1.09 use the following to enable a compatibility
# hack so that the resulting archive is compatible with older clients.
$Archive::Tar::DO_NOT_USE_PREFIX = 0;
+
my $files = $self->rscan_dir($dir);
- Archive::Tar->create_archive("$file.tar.gz", 1, @$files);
+ my $tar = Archive::Tar->new;
+ $tar->add_files(@$files);
+ for my $f ($tar->get_files) {
+ $f->mode($f->mode & ~022); # chmod go-w
+ }
+ $tar->write("$file.tar.gz", 1);
}
}
use strict;
use vars qw($VERSION);
-$VERSION = '0.30';
+$VERSION = '0.31012';
use File::Spec;
use IO::File;
$MM_Args{EXE_FILES} = [ sort keys %{$build->script_files} ] if $build->script_files;
- $MM_Args{PL_FILES} = {};
+ $MM_Args{PL_FILES} = $build->PL_files if $build->PL_files;
local $Data::Dumper::Terse = 1;
my $args = Data::Dumper::Dumper(\%MM_Args);
use strict;
use vars qw($VERSION);
-$VERSION = '0.30';
+$VERSION = '0.31012';
$VERSION = eval $VERSION;
use Config;
package Module::Build::Cookbook;
use strict;
use vars qw($VERSION);
-$VERSION = '0.30';
+$VERSION = '0.31012';
=head1 NAME
I'm sure I could not have handled this complexity with EU::MM, but it
was very easy to do with M::B.
-=back 4
+=back
=head2 Modifying an action
)->create_build_script;
+=head2 Adding an action
+
+You can add a new C<./Build> action simply by writing the method for
+it in your subclass. Use C<depends_on> to declare that another action
+must have been run before your action.
+
+For example, let's say you wanted to be able to write C<./Build
+commit> to test your code and commit it to Subversion.
+
+ # Build.PL
+ use Module::Build;
+ my $class = Module::Build->subclass(
+ class => "Module::Build::Custom",
+ code => <<'SUBCLASS' );
+
+ sub ACTION_commit {
+ my $self = shift;
+
+ $self->depends_on("test");
+ $self->do_system(qw(svn commit));
+ }
+ SUBCLASS
+
+
+=head2 Bundling Module::Build
+
+Note: This section probably needs an update as the technology improves
+(see scripts/bundle.pl in the distribution).
+
+Suppose you want to use some new-ish features of Module::Build,
+e.g. newer than the version of Module::Build your users are likely to
+already have installed on their systems. The first thing you should
+do is set C<configure_requires> to your minimum version of
+Module::Build. See L<Module::Build::Authoring>.
+
+But not every build system honors C<configure_requires> yet. Here's
+how you can ship a copy of Module::Build, but still use a newer
+installed version to take advantage of any bug fixes and upgrades.
+
+First, install Module::Build into F<Your-Project/inc/Module-Build>.
+CPAN will not index anything in the F<inc> directory so this copy will
+not show up in CPAN searches.
+
+ cd Module-Build
+ perl Build.PL --install_base /path/to/Your-Project/inc/Module-Build
+ ./Build test
+ ./Build install
+
+You should now have all the Module::Build .pm files in
+F<Your-Project/inc/Module-Build/lib/perl5>.
+
+Next, add this to the top of your F<Build.PL>.
+
+ my $Bundled_MB = 0.30; # or whatever version it was.
+
+ # Find out what version of Module::Build is installed or fail quietly.
+ # This should be cross-platform.
+ my $Installed_MB =
+ `$^X -e "eval q{require Module::Build; print Module::Build->VERSION} or exit 1";
+
+ # some operating systems put a newline at the end of every print.
+ chomp $Installed_MB;
+
+ $Installed_MB = 0 if $?;
+
+ # Use our bundled copy of Module::Build if it's newer than the installed.
+ unshift @INC, "inc/Module-Build/lib/perl5" if $Bundled_MB > $Installed_MB;
+
+ require Module::Build;
+
+And write the rest of your F<Build.PL> normally. Module::Build will
+remember your change to C<@INC> and use it when you run F<./Build>.
+
+In the future, we hope to provide a more automated solution for this
+scenario; see C<inc/latest.pm> in the Module::Build distribution for
+one indication of the direction we're moving.
+
+
=head1 AUTHOR
Ken Williams <kwilliams@cpan.org>
=head1 COPYRIGHT
-Copyright (c) 2001-2006 Ken Williams. All rights reserved.
+Copyright (c) 2001-2008 Ken Williams. All rights reserved.
This library is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.
package Module::Build::Dumper;
use strict;
use vars qw($VERSION);
-$VERSION = '0.30';
+$VERSION = '0.31012';
# This is just a split-out of a wrapper function to do Data::Dumper
# stuff "the right way". See:
use strict;
use vars qw($VERSION);
-$VERSION = '0.30';
+$VERSION = '0.31012';
$VERSION = eval $VERSION;
use File::Spec;
use strict;
use vars qw($VERSION);
-$VERSION = '0.30';
+$VERSION = '0.31012';
$VERSION = eval $VERSION;
use Data::Dumper;
use IO::File;
use strict;
use vars qw($VERSION);
-$VERSION = '0.30';
+$VERSION = '0.31012';
$VERSION = eval $VERSION;
# This code is mostly borrowed from ExtUtils::MM_Unix 6.10_03, with a
use strict;
use vars qw($VERSION);
-$VERSION = '0.30';
+$VERSION = '0.31012';
$VERSION = eval $VERSION;
use Module::Build::Base;
use strict;
use vars qw($VERSION);
-$VERSION = '0.30';
+$VERSION = '0.31012';
$VERSION = eval $VERSION;
use Module::Build::Base;
use strict;
use vars qw($VERSION);
-$VERSION = '0.30';
+$VERSION = '0.31012';
$VERSION = eval $VERSION;
use Module::Build::Base;
use strict;
use vars qw($VERSION);
-$VERSION = '0.30';
+$VERSION = '0.31012';
$VERSION = eval $VERSION;
use Module::Build::Base;
use strict;
use vars qw($VERSION);
-$VERSION = '0.30';
+$VERSION = '0.31012';
$VERSION = eval $VERSION;
use Module::Build::Base;
use vars qw(@ISA);
use strict;
use vars qw($VERSION);
-$VERSION = '0.30';
+$VERSION = '0.31012';
$VERSION = eval $VERSION;
use Module::Build::Base;
use strict;
use vars qw($VERSION);
-$VERSION = '0.30';
+$VERSION = '0.31012';
$VERSION = eval $VERSION;
use Module::Build::Base;
$value =~ s[^~(\w[-\w]*)?(?=/|$)] # tilde with optional username
[$1 ?
((getpwnam $1)[7] || "~$1") :
- (getpwuid $>)[7]
+ ($ENV{HOME} || (getpwuid $>)[7])
]ex;
return $value;
}
use strict;
use vars qw($VERSION);
-$VERSION = '0.30';
+$VERSION = '0.31012';
$VERSION = eval $VERSION;
use Module::Build::Base;
use strict;
use vars qw($VERSION);
-$VERSION = '0.30';
+$VERSION = '0.31012';
$VERSION = eval $VERSION;
use Module::Build::Base;
use strict;
use vars qw($VERSION);
-$VERSION = '0.30';
+$VERSION = '0.31012';
$VERSION = eval $VERSION;
use Config;
use strict;
use vars qw($VERSION);
-$VERSION = '0.30';
+$VERSION = '0.31012';
$VERSION = eval $VERSION;
use Module::Build::Platform::Unix;
use strict;
use vars qw($VERSION);
-$VERSION = '0.30';
+$VERSION = '0.31012';
$VERSION = eval $VERSION;
use Module::Build::Platform::Unix;
use strict;
use vars qw($VERSION);
-$VERSION = '0.30';
+$VERSION = '0.31012';
$VERSION = eval $VERSION;
use Module::Build::Platform::Unix;
use strict;
use vars qw($VERSION);
-$VERSION = '0.30';
+$VERSION = '0.31012';
$VERSION = eval $VERSION;
use Module::Build::Platform::Unix;
use strict;
use vars qw($VERSION);
-$VERSION = '0.30';
+$VERSION = '0.31012';
$VERSION = eval $VERSION;
use vars qw(@ISA);
use locale;
use vars qw ($VERSION @ISA @REGEXS);
-$VERSION = 0.74;
+$VERSION = 0.76;
push @REGEXS, qr/
^v? # optional leading 'v'
require Carp;
Carp::croak("Invalid version object");
}
- return $self->{original};
+ return exists $self->{original}
+ ? $self->{original}
+ : exists $self->{qv}
+ ? $self->normal
+ : $self->numify;
}
sub vcmp
# Thanks to Yitzchak Scott-Thoennes for this mode of operation
{
local $^W;
- *UNIVERSAL::VERSION = sub {
+ *UNIVERSAL::VERSION # Module::Build::ModuleInfo doesn't see this now
+ = sub {
my ($obj, $req) = @_;
my $class = ref($obj) || $obj;
--- /dev/null
+#!/usr/bin/perl
+
+# this is just a first crack and it uses File::Fu because I'm lazy.
+
+=head1 using
+
+This installs from a fresh Module::Build to your inc/inc_Module-Build
+directory. Use it from within your dist:
+
+ perl /path/to/Module-Build/scripts/bundle.pl
+
+You still need to manually add the following to your Build.PL
+
+ use lib 'inc';
+ use latest 'Module::Build';
+
+You also need to regen your manifest.
+
+ perl Build.PL
+ ./Build distmeta; >MANIFEST; ./Build manifest; svn diff MANIFEST
+
+=cut
+
+use warnings;
+use strict;
+
+use File::Fu;
+use File::Copy ();
+
+my $inc_dir = shift(@ARGV);
+$inc_dir = File::Fu->dir($inc_dir || 'inc/inc_Module-Build');
+$inc_dir->create unless($inc_dir->e);
+$inc_dir = $inc_dir->absolutely;
+
+
+my $mb_dir = File::Fu->program_dir->dirname;
+
+$mb_dir->chdir_for(sub {
+ my $temp = File::Fu->temp_dir('mb_bundle');
+ local @INC = @INC;
+ unshift(@INC, 'lib', 'inc');
+ require Module::Build;
+ my $builder = Module::Build->new_from_context;
+ $builder->dispatch(install =>
+ install_base => $temp,
+ install_path => {lib => $inc_dir},
+ );
+});
+
+my $latest = $mb_dir/'inc'+'latest.pm';
+File::Copy::copy($latest, 'inc');
+
+# vim:ts=2:sw=2:et:sta
--- /dev/null
+#!/usr/bin/perl -w
+
+use strict;
+use lib $ENV{PERL_CORE} ? '../lib/Module/Build/t/lib' : 't/lib';
+use MBTest tests => 29;
+#use MBTest 'no_plan';
+use DistGen;
+
+BEGIN { use_ok 'Module::Build' or die; }
+ensure_blib 'Module::Build';
+
+my $tmp = MBTest->tmpdir;
+my $dist = DistGen->new( dir => $tmp );
+$dist->regen;
+$dist->chdir_in;
+
+ADDPROP: {
+ package My::Build::Prop;
+ use base 'Module::Build';
+ __PACKAGE__->add_property( 'foo' );
+ __PACKAGE__->add_property( 'bar', 'howdy' );
+ __PACKAGE__->add_property( 'baz', default => 'howdy' );
+ __PACKAGE__->add_property( 'code', default => sub { 'yay' } );
+ __PACKAGE__->add_property(
+ 'check',
+ default => sub { 'howdy' },
+ check => sub {
+ return 1 if $_ eq 'howdy';
+ shift->property_error(qq{"$_" is invalid});
+ return 0;
+ },
+ );
+ __PACKAGE__->add_property(
+ 'hash',
+ default => { foo => 1 },
+ check => sub {
+ return 1 if !defined $_ or exists $_->{foo};
+ shift->property_error(qq{hash is invalid});
+ return 0;
+ },
+ );
+}
+
+ok my $build = My::Build::Prop->new(
+ 'module_name' => 'Simple',
+ quiet => 1,
+), 'Create new build object';
+
+is $build->foo, undef, 'Property "foo" should be undef';
+ok $build->foo(42), 'Set "foo"';
+is $build->foo, 42, 'Now "foo" should have new value';
+
+is $build->bar, 'howdy', 'Property "bar" should be its default';
+ok $build->bar('yo'), 'Set "bar"';
+is $build->bar, 'yo', 'Now "bar" should have new value';
+
+is $build->check, 'howdy', 'Property "check" should be its default';
+
+eval { $build->check('yo') };
+ok my $err = $@, 'Should get an error for an invalid value';
+like $err, qr/^ERROR: "yo" is invalid/, 'It should be the correct error';
+
+is $build->code, 'yay', 'Property "code" should have its code value';
+
+is_deeply $build->hash, { foo => 1 }, 'Property "hash" should be default';
+is $build->hash('foo'), 1, 'Should be able to get key in hash';
+ok $build->hash( bar => 3 ), 'Add a key to the hash prop';
+is_deeply $build->hash, { foo => 1, bar => 3 }, 'New key should be in hash';
+
+eval { $build->hash({ bar => 3 }) };
+ok $err = $@, 'Should get exception for assigning invalid hash';
+like $err, qr/^ERROR: hash is invalid/, 'It should be the correct error';
+
+eval { $build->hash( []) };
+ok $err = $@, 'Should get exception for assigning an array for a hash';
+like $err, qr/^Unexpected arguments for property 'hash'/,
+ 'It should be the proper error';
+is $build->hash(undef), undef, 'Should be able to set hash to undef';
+
+# Check core properties.
+is $build->installdirs, 'site', 'Property "installdirs" should be default';
+ok $build->installdirs('core'), 'Set "installdirst" to "core"';
+is $build->installdirs, 'core', 'Now "installdirs" should be "core"';
+
+eval { $build->installdirs('perl') };
+ok $err = $@, 'Should have caught exception setting "installdirs" to "perl"';
+like $err, qr/^ERROR: Perhaps you meant installdirs to be "core" rather than "perl"\?/,
+ 'And it should suggest "core" in the error message';
+
+eval { $build->installdirs('foo') };
+ok $err = $@, 'Should catch exception for invalid "installdirs" value';
+like $err, qr/ERROR: installdirs must be one of "core", "site", or "vendor"/,
+ 'And it should suggest the proper values in the error message';
#
# Author: Christopher J. Madsen <cjm@pobox.com>
# Created: 08 Nov 1997
-# $Revision: 5841 $ $Date: 2006-03-21 07:27:29 -0600 (Tue, 21 Mar 2006) $
+# $Revision: 5841 $ $Date: 2006-03-21 05:27:29 -0800 (Tue, 21 Mar 2006) $
#
# This program is free software; you can redistribute it and/or modify
# it under the same terms as Perl itself.
#find_in_path does not understand VMS.
if ( $Config{make} && $^O ne 'VMS' ? find_in_path($Config{make}) : 1 ) {
- plan tests => 34 + @makefile_types*$tests_per_type*2;
+ plan 'no_plan';
} else {
plan skip_all => "Don't know how to invoke 'make'";
}
test_makefile_types();
-# Test with requires
+# Test with requires and PL_files
my $distname = $dist->name;
$dist->change_build_pl({
build_requires => {
'Test::More' => 0,
},
+ PL_files => { 'foo.PL' => 'foo' },
});
+$dist->add_file("foo.PL", <<'END');
+open my $fh, ">$ARGV[0]" or die $!;
+print $fh "foo\n";
+END
+
$dist->regen;
-test_makefile_types( requires => {
- 'perl' => $],
- 'File::Spec' => 0,
- 'Test::More' => 0,
-});
+test_makefile_types(
+ requires => {
+ 'perl' => $],
+ 'File::Spec' => 0,
+ 'Test::More' => 0,
+ },
+ PL_files => {
+ 'foo.PL' => 'foo',
+ },
+);
######################
sub test_makefile_types {
my %opts = @_;
$opts{requires} ||= {};
+ $opts{PL_files} ||= {};
foreach my $type (@makefile_types) {
# Create M::B instance
test_makefile_pl_requires_perl( $opts{requires}{perl} );
test_makefile_creation($mb);
test_makefile_prereq_pm( $opts{requires} );
+ test_makefile_pl_files( $opts{PL_files} ) if $type eq 'traditional';
my ($output,$success);
# Capture output to keep our STDOUT clean
});
ok $success, "make ran without error";
+ for my $file (values %{ $opts{PL_files} }) {
+ ok -e $file, "PL_files generated - $file";
+ }
+
# Can't let 'test' STDOUT go to our STDOUT, or it'll confuse Test::Harness.
$output = stdout_of( sub {
$success = $mb->do_system(@make, 'test');
delete $requires{perl}; # until EU::MM supports this
SKIP: {
skip "$makefile not found", 1 unless -e $makefile;
- my $prereq_pm = find_makefile_prereq_pm();
+ my $prereq_pm = find_params_in_makefile()->{PREREQ_PM} || {};
is_deeply $prereq_pm, \%requires,
"$makefile has correct PREREQ_PM line";
}
}
+sub test_makefile_pl_files {
+ my $expected = shift;
+
+ SKIP: {
+ skip "$makefile not found", 1 unless -e $makefile;
+ my $pl_files = find_params_in_makefile()->{PL_FILES} || {};
+ is_deeply $pl_files, $expected,
+ "$makefile has correct PL_FILES line";
+ }
+}
+
sub test_makefile_pl_requires_perl {
my $perl_version = shift || q{};
SKIP: {
}
}
-# Following subroutine adapted from code in CPAN.pm
-# by Andreas Koenig and A. Speer.
-sub find_makefile_prereq_pm {
+sub find_params_in_makefile {
my $fh = IO::File->new( $makefile, 'r' )
or die "Can't read $makefile: $!";
- my $req = {};
local($/) = "\n";
+
+ my %params;
while (<$fh>) {
- # locate PREREQ_PM
- last if /MakeMaker post_initialize section/;
- my($p) = m{^[\#]
- \s+PREREQ_PM\s+=>\s+(.+)
- }x;
- next unless $p;
-
- # extract modules
- while ( $p =~ m/(?:\s)([\w\:]+)=>(q\[.*?\]|undef),?/g ){
+ # Blank line after params.
+ last if keys %params and !/\S+/;
+
+ next unless m{^\# \s+ ( [A-Z_]+ ) \s+ => \s+ ( .* )$}x;
+
+ my($key, $val) = ($1, $2);
+ # extract keys and values
+ while ( $val =~ m/(?:\s)(\S+)=>(q\[.*?\]|undef),?/g ) {
my($m,$n) = ($1,$2);
if ($n =~ /^q\[(.*?)\]$/) {
$n = $1;
}
- $req->{$m} = $n;
+ $params{$key}{$m} = $n;
}
- last;
}
- return $req;
+
+ return \%params;
}
# Make sure data can make a round-trip through an external perl
# process, which can involve the shell command line
- # Holy crap, I can't believe this works:
- local $Module::Build{properties}{quiet} = 1;
+ # silence the printing for easier matching
+ local *Module::Build::log_info = sub {};
my @data = map values(%$_), @unix_splits, @win_splits;
for my $d (@data) {
# Make sure data can make a round-trip through an external backtick
# process, which can involve the shell command line
- local $Module::Build{properties}{quiet} = 1;
+ # silence the printing for easier matching
+ local *Module::Build::log_info = sub {};
+
my @data = map values(%$_), @unix_splits, @win_splits;
for my $d (@data) {
chomp(my $out = Module::Build->_backticks('perl', '-le', 'print join " ", map "{$_}", @ARGV', @$d));
use File::Spec;
use File::Path ();
+
+# Setup the code to clean out %ENV
+BEGIN {
+ # Environment variables which might effect our testing
+ my @delete_env_keys = qw(
+ DEVEL_COVER_OPTIONS
+ MODULEBUILDRC
+ HARNESS_TIMER
+ HARNESS_OPTIONS
+ HARNESS_VERBOSE
+ PREFIX
+ INSTALL_BASE
+ INSTALLDIRS
+ );
+
+ # Remember the ENV values because on VMS %ENV is global
+ # to the user, not the process.
+ my %restore_env_keys;
+
+ sub clean_env {
+ for my $key (@delete_env_keys) {
+ if( exists $ENV{$key} ) {
+ $restore_env_keys{$key} = delete $ENV{$key};
+ }
+ else {
+ delete $ENV{$key};
+ }
+ }
+ }
+
+ END {
+ while( my($key, $val) = each %restore_env_keys ) {
+ $ENV{$key} = $val;
+ }
+ }
+}
+
+
BEGIN {
- # Make sure none of our tests load the users ~/.modulebuildrc file
- $ENV{MODULEBUILDRC} = 'NONE';
+ clean_env();
# In case the test wants to use our other bundled
# modules, make sure they can be loaded.
push @EXPORT, @extra_exports;
__PACKAGE__->export(scalar caller, @extra_exports);
# XXX ^-- that should really happen in import()
+
+
########################################################################
{ # Setup a temp directory if it doesn't exist
use strict;
use lib $ENV{PERL_CORE} ? '../lib/Module/Build/t/lib' : 't/lib';
-use MBTest tests => 17;
+use MBTest tests => 18;
use_ok 'Module::Build';
ensure_blib('Module::Build');
unless (defined $home) {
my @info = eval { getpwuid $> };
- skip "No home directory for tilde-expansion tests", 14 if $@;
+ skip "No home directory for tilde-expansion tests", 15 if $@;
$home = $info[7];
}
is( run_sample( prefix => '~' )->prefix,
$home );
+ # Test when HOME is different from getpwuid(), as in sudo.
+ {
+ local $ENV{HOME} = '/wibble/whomp';
+
+ is( run_sample( $p => '~' )->$p(), "/wibble/whomp" );
+ }
+
my $mb = run_sample( install_path => { html => '~/html',
lib => '~/lib' }
);
projects / p5sagit/p5-mst-13.2.git / commitdiff