diff options
| author | David Golden <dagolden@cpan.org> | 2009-11-18 00:52:18 -0500 |
|---|---|---|
| committer | David Golden <dagolden@cpan.org> | 2009-11-18 00:52:18 -0500 |
| commit | 613f422f899872b39e45f0f48c3285ac4cece8c7 (patch) | |
| tree | 8a11a9316ba0a7dc5dae3d983ee987ac851a1421 /cpan/Module-Build/lib/Module/Build | |
| parent | 6821e3836b3437b3deb760f4225a6b3dbe4d7015 (diff) | |
| download | perl-613f422f899872b39e45f0f48c3285ac4cece8c7.tar.gz | |
Updated Module::Build to 0.35_08
0.35_08 - Mon Nov 16 22:38:28 EST 2009
Bug fixes:
- Multiple tests were failing due to dependency problems. Author
dependencies have been largely removed from core 'requires' into
optional features. Feature prereq detection and messaging have been
expanded and bugs on older Perls have been removed.
0.35_07 - Sat Nov 14 17:14:39 EST 2009
Bug fixes:
- Auto-detection of abstract and author fixed for mixed-case POD headers
(RT#51117) [David Wheeler]
- resume() was not restoring additions to @INC added in Build.PL
(RT#50145) [David Golden]
- When tarball paths are less than 100 characters, disables 'prefix'
mode of Archive::Tar for maximum compatibility (RT#50571) [David Golden]
0.35_06 - Fri Nov 13 14:51:28 EST 2009
Enhancements:
- Added experimental inc/ bundling; see Module::Build::Bundling for
details. [David Golden and Eric Wilhelm]
- Clarified that 'apache' in the license attribute indicates the Apache
License 2.0 and added 'apache_1_1' for the older version of the license
(RT#50614) [David Golden]
Bug fixes:
- Merging 'requires' and 'build_requires' in Module::Build::Compat could
lead to duplicate PREREQ_PM entries; now the highest version is used
for PREREQ_PM. (RT#50948) [David Golden]
- Module::Build::Compat will now die with an error if advanced,
non-numeric prerequisites are given, as these are not supported by
ExtUtils::MakeMaker in PREREQ_PM [David Golden]
- Made MYMETA generation non-fatal if fields required for META.yml
are missing [David Golden]
- Added Pod::Simple to requirements for manpage support; avoids
problems if a user has a broken Pod::Man/Pod::Simple. (RT#50081)
[David Golden]
- Won't die if installed Pod::Readme is broken [David Golden]
Other:
- Fixed Module::Build::Notes POD [David Golden]
- Some commands had become silent by default, so added a few short status
messages so users know something actually happened [David Golden]
- Cleaned up Changes file formatting [David Golden]
- Removed most PERL_CORE customizations from test files due to
reorganization of dual-life modules in core (RT#49522) [David Golden]
0.35_05 - Wed Oct 28 17:20:59 EDT 2009
Bug fixes:
- Fix test failure in t/actions/installdeps.t when $^X is not the default
perl [David Golden]
- Work around $VERSION numbers in ActiveState with multiple underscores
that prevent Module::Build from installing on Win32 [David Golden]
- Fix bug cleaning compatibility Makefile when older ExtUtils::Manifest is
installed [David Golden with help from David Cantrell]
Other:
- Suppressed more warnings from tests [David Golden]
- Add provisional support for 'package NAME VERSION' syntax added in
Perl 5.11.1 [David Golden]
0.35_04 - Fri Oct 23 11:20:41 EDT 2009
Bug fixes:
- Fix test failure if IPC::Cmd isn't installed [David Golden]
Other:
- Suppressed warning messages from various tests [David Golden]
0.35_03 - Wed Oct 21 21:20:59 EDT 2009
*** API CHANGE ***
- The prepare_metadata() method used to take a YAML::Node object as an
argument for modification. The method now takes no arguments and just
returns a hash reference of metadata. [David Golden]
Enhancements
- Command line options may be set via the PERL_MB_OPT environment
variable (similar to PERL_MM_OPT in ExtUtils::MakeMaker)
Bug fixes:
- Updated PPM generation to PPM v4 (RT#49600) [Olivier Mengue]
- When c_source is specified, the directory scan will include additional,
less-common C++ extensions (RT49298) [David Golden]
- When module_name is not supplied, no packlist was being written; fixed
by guessing module_name from dist_version_from or the directory name
(just like ExtUtils::Manifest does without NAME) [David Golden]
- Bumped IO::File prereq to fix binmode failures in PPMMaker on Perl
prior to 5.8.8 [David Golden]
Other:
- Replaced use of YAML.pm with YAML::Tiny; Module::Build::YAML is now
based on YAML::Tiny as well [David Golden]
- Reduced amount of console output under normal operation (use --verbose
to see all output) [David Golden]
0.35_02 - Mon Sep 7 22:37:42 EDT 2009
Enhancements:
- Added 'needs_compiler' property. Defaults to true if XS or c_source
exist. If true, ExtUtils::CBuilder is also added to build_requires.
[David Golden]
- File::ShareDir automatically added to 'requires' if 'share_dir' is set
[David Golden]
- Added 'Build installdeps' action to install needed dependencies via
a user-configurable command line program. (Defaults to 'cpan'.)
[Eric Wilhelm]
Bug fixes:
- Failure to detect a compiler will now warn during Build.PL and be a
fatal error when trying to compile during Build. (RT#48918) [David
Golden]
- Fixed directory sorting failure in share_dir.t [David Golden]
- Property defaults that are data structures were being assigned as
references to new objects. Changed so that defaults are cloned instead.
(This mostly affects testing, which often creates multiple objects in the
same process) [David Golden]
- Simplified error message on exit under use_tap_harness [suggested by
David Wheeler]
- Fixed typemap search to use a dist-level typemap if a typemap is not
found in the directory with the *.xs file; (was manifesting as warnings
in Perl 5.6 tests) [David Golden]
Other:
- Replaced guts of new_from_context(). Build.PL is now executed in a
separate process before resume() is called. (This is generally only of
interest to Module::Build or toolchain developers) (RT#49350) [David
Golden, Eric Wilhelm, Ken Williams]
- Revised test helper classes to fix potential bugs and add new features
to make writing tests simpler and easier. Changes incorporated into
t/README.pod and t/sample.t as examples for new testing. [David Golden]
0.35_01 - Mon Aug 31 12:11:10 EDT 2009
Enhancements:
- Generates MYMETA.yml during Build.PL (new standard protocol for
communicating configuration results between toolchain components)
[David Golden]
- Added 'share_dir' property to provide File::ShareDir support;
set automatically if a directory called 'share' exists
[David Golden]
Bug fixes:
- Fix the t/destinations.t fix. [David Golden, with thanks to Eric Wilhelm]
- Fix recursive test files in generated Makefile.PL (RT#49254) [Sawyer X]
- Guard against trying :utf8 when :utf8 isn't available
- The "test" action now dies when using the 'use_tap_harness'
option and tests fail, matching the behavior under Test::Harness.
(RT#49080) [initial patch from David Wheeler; revised by David Golden]
Other:
- Added t/README.pod and t/sample.t to guide developers writing new tests
[David Golden, with some code from Eric Wilhelm]
- Module::Build::Compat 'passthrough' style has been deprecated. Using
'passthrough' will issue warnings on Makefile.PL generation. See
Module::Build::Compat documentation for rationale.
Diffstat (limited to 'cpan/Module-Build/lib/Module/Build')
27 files changed, 2024 insertions, 700 deletions
diff --git a/cpan/Module-Build/lib/Module/Build/API.pod b/cpan/Module-Build/lib/Module/Build/API.pod index f4e4cea09d..1f5d51f777 100644 --- a/cpan/Module-Build/lib/Module/Build/API.pod +++ b/cpan/Module-Build/lib/Module/Build/API.pod @@ -454,8 +454,13 @@ Specifies the licensing terms of your distribution. Valid options include: =item apache -The distribution is licensed under the Apache Software License -(L<http://opensource.org/licenses/apachepl.php>). +The distribution is licensed under the Apache License, Version 2.0 +(L<http://apache.org/licenses/LICENSE-2.0>). + +=item apache_1_1 + +The distribution is licensed under the Apache Software License, Version 1.1 +(L<http://apache.org/licenses/LICENSE-1.1>). =item artistic @@ -580,6 +585,18 @@ used to set C<dist_version>. Setting C<module_name> won't override a C<dist_*> parameter you specify explicitly. +=item needs_compiler + +[version 0.36] + +The C<needs_compiler> parameter indicates whether a compiler is required to +build the distsribution. The default is false, unless XS files are found or +the C<c_source> parameter is set, in which case it is true. If true, +L<ExtUtils::CBuilder> is automatically added to C<build_requires> if needed. + +For a distribution where a compiler is I<optional>, e.g. a dual XS/pure-Perl +distribution, C<needs_compiler> should explicitly be set to a false value. + =item PL_files [version 0.06] @@ -737,6 +754,35 @@ For backward compatibility, you may use the parameter C<scripts> instead of C<script_files>. Please consider this usage deprecated, though it will continue to exist for several version releases. +=item share_dir + +[version 0.36] + +An optional parameter specifying directories of static data files to +be installed as read-only files for use with L<File::ShareDir>. The +C<share_dir> property supports both distribution-level and +module-level share files. + +The default when C<share_dir> is not set is for any files in a F<share> +directory at the top level of the distribution to be installed in +distribution-level share directory. Alternatively, C<share_dir> can be set to +a directory name or an arrayref of directory names containing files to be +installed in the distribution-level share directory. + +If C<share_dir> is a hashref, it may have C<dist> or C<module> keys +providing full flexibility in defining share directories to install. + + share_dir => { + dist => [ 'examples', 'more_examples' ], + module => { + Foo::Templates => ['share/html', 'share/text'], + Foo::Config => 'share/config', + } + } + +If C<share_dir> is set (manually or automatically), then File::ShareDir +will automatically be added to the C<requires> hash. + =item sign [version 0.16] @@ -802,25 +848,23 @@ files in your distribution. [version 0.28] -When called from a directory containing a F<Build.PL> script and a -F<META.yml> file (in other words, the base directory of a -distribution), this method will run the F<Build.PL> and return the -resulting C<Module::Build> object to the caller. Any key-value -arguments given to C<new_from_context()> are essentially like -command line arguments given to the F<Build.PL> script, so for example -you could pass C<< verbose => 1 >> to this method to turn on -verbosity. +When called from a directory containing a F<Build.PL> script (in other words, +the base directory of a distribution), this method will run the F<Build.PL> and +call C<resume()> to return the resulting C<Module::Build> object to the caller. +Any key-value arguments given to C<new_from_context()> are essentially like +command line arguments given to the F<Build.PL> script, so for example you +could pass C<< verbose => 1 >> to this method to turn on verbosity. =item resume() [version 0.03] -You'll probably never call this method directly, it's only called from -the auto-generated C<Build> script. The C<new()> method is only -called once, when the user runs C<perl Build.PL>. Thereafter, when -the user runs C<Build test> or another action, the C<Module::Build> -object is created using the C<resume()> method to re-instantiate with -the settings given earlier to C<new()>. +You'll probably never call this method directly, it's only called from the +auto-generated C<Build> script (and the C<new_from_context> method). The +C<new()> method is only called once, when the user runs C<perl Build.PL>. +Thereafter, when the user runs C<Build test> or another action, the +C<Module::Build> object is created using the C<resume()> method to +re-instantiate with the settings given earlier to C<new()>. =item subclass() @@ -1527,22 +1571,25 @@ Assigning the value C<undef> to an element causes it to be removed. =item prepare_metadata() -[version 0.28] +[version 0.36] -This method is provided for authors to override to customize the -fields of F<META.yml>. It is passed a YAML::Node node object which can -be modified as desired and then returned. E.g. +This method returns a hash reference of metadata that can be used to create a +YAML datastream. It is provided for authors to override or customize the fields +of F<META.yml>. E.g. package My::Builder; use base 'Module::Build'; sub prepare_metadata { my $self = shift; - my $node = $self->SUPER::prepare_metadata( shift ); - $node->{custom_field} = 'foo'; - return $node; + my $data = $self->SUPER::prepare_metadata(); + $data->{custom_field} = 'foo'; + return $data; } +Prior to version 0.36, this method took a YAML::Node as an argument to hold +assembled metadata. + =item prereq_failures() [version 0.11] @@ -1782,6 +1829,10 @@ accessor methods for the following properties: =item build_script() +=item bundle_inc() + +=item bundle_inc_preload() + =item c_source() =item config_dir() @@ -1790,6 +1841,8 @@ accessor methods for the following properties: =item conflicts() +=item cpan_client() + =item create_license() =item create_makefile_pl() @@ -1830,6 +1883,10 @@ accessor methods for the following properties: =item module_name() +=item mymetafile() + +=item needs_compiler() + =item orig_dir() =item perl() @@ -1920,7 +1977,7 @@ modify it under the same terms as Perl itself. =head1 SEE ALSO perl(1), L<Module::Build>(3), L<Module::Build::Authoring>(3), -L<Module::Build::Cookbook>(3), L<ExtUtils::MakeMaker>(3), L<YAML>(3) +L<Module::Build::Cookbook>(3), L<ExtUtils::MakeMaker>(3), L<YAML::Tiny>(3) F<META.yml> Specification: L<http://module-build.sourceforge.net/META-spec-current.html> diff --git a/cpan/Module-Build/lib/Module/Build/Base.pm b/cpan/Module-Build/lib/Module/Build/Base.pm index 531c35487e..abeea2ef0a 100644 --- a/cpan/Module-Build/lib/Module/Build/Base.pm +++ b/cpan/Module-Build/lib/Module/Build/Base.pm @@ -4,7 +4,7 @@ package Module::Build::Base; use strict; use vars qw($VERSION); -$VERSION = '0.35'; +$VERSION = '0.35_08'; $VERSION = eval $VERSION; BEGIN { require 5.00503 } @@ -23,6 +23,7 @@ use Text::ParseWords (); use Module::Build::ModuleInfo; use Module::Build::Notes; use Module::Build::Config; +use Module::Build::Version; #################### Constructors ########################### @@ -31,16 +32,37 @@ sub new { $self->{invoked_action} = $self->{action} ||= 'Build_PL'; $self->cull_args(@ARGV); - + die "Too early to specify a build action '$self->{action}'. Do 'Build $self->{action}' instead.\n" if $self->{action} && $self->{action} ne 'Build_PL'; $self->check_manifest; - $self->check_prereq; - $self->check_autofeatures; + $self->auto_require; + if ( $self->check_prereq + $self->check_autofeatures != 2) { + $self->log_warn(<<EOF); + +ERRORS/WARNINGS FOUND IN PREREQUISITES. You may wish to install the versions +of the modules indicated above before proceeding with this installation + +EOF + unless ( + $self->dist_name eq 'Module-Build' || + $ENV{PERL5_CPANPLUS_IS_RUNNING} || $ENV{PERL5_CPAN_IS_RUNNING} + ) { + $self->log_warn( + "Run 'Build installdeps' to install missing prerequisites.\n\n" + ); + } + } + + # record for later use in resume; + $self->{properties}{_added_to_INC} = [ $self->_added_to_INC ]; + + $self->set_bundle_inc; $self->dist_name; $self->dist_version; + $self->_guess_module_name unless $self->module_name; $self->_find_nested_builds; @@ -52,6 +74,8 @@ sub resume { my $self = $package->_construct(@_); $self->read_config; + unshift @INC, @{ $self->{properties}{_added_to_INC} || [] }; + # If someone called Module::Build->current() or # Module::Build->new_from_context() and the correct class to use is # actually a *subclass* of Module::Build, we may need to load that @@ -72,7 +96,7 @@ sub resume { $self->log_warn(" * WARNING: Configuration was initially created with '$self->{properties}{perl}',\n". " but we are now using '$perl'.\n"); } - + $self->cull_args(@ARGV); unless ($self->allow_mb_mismatch) { @@ -82,7 +106,7 @@ sub resume { " or use --allow_mb_mismatch 1 to skip this version check.\n") if $mb_version ne $self->{properties}{mb_version}; } - + $self->{invoked_action} = $self->{action} ||= 'build'; return $self; @@ -90,18 +114,8 @@ sub resume { sub new_from_context { my ($package, %args) = @_; - - # XXX Read the META.yml and see whether we need to run the Build.PL? - - # Run the Build.PL. We use do() rather than run_perl_script() so - # that it runs in this process rather than a subprocess, because we - # need to make sure that the environment is the same during Build.PL - # as it is during resume() (and thereafter). - { - local @ARGV = $package->unparse_args(\%args); - do './Build.PL'; - die $@ if $@; - } + + $package->run_perl_script('Build.PL',[],[$package->unparse_args(\%args)]); return $package->resume; } @@ -497,6 +511,28 @@ sub _discover_perl_interpreter { "in (@paths)\n"; } +# Adapted from IPC::Cmd::can_run() +sub find_command { + my ($self, $command) = @_; + + if( File::Spec->file_name_is_absolute($command) ) { + return $self->_maybe_command($command); + + } else { + for my $dir ( File::Spec->path ) { + my $abs = File::Spec->catfile($dir, $command); + return $abs if $abs = $self->_maybe_command($abs); + } + } +} + +# Copied from ExtUtils::MM_Unix::maybe_command +sub _maybe_command { + my($self,$file) = @_; + return $file if -x $file && ! -d $file; + return; +} + sub _is_interactive { return -t STDIN && (-t STDOUT || !(-f STDOUT || -c STDOUT)) ; # Pipe? } @@ -588,10 +624,18 @@ sub features { } if (my $info = $ph->{auto_features}->access($key)) { - my $failures = $self->prereq_failures($info); - my $disabled = grep( /^(?:\w+_)?(?:requires|conflicts)$/, - keys %$failures ) ? 1 : 0; - return !$disabled; + my $disabled; + for my $type ( @{$self->prereq_action_types} ) { + next if $type eq 'description' || $type eq 'recommends' || ! exists $info->{$type}; + my $prereqs = $info->{$type}; + for my $modname ( sort keys %$prereqs ) { + my $spec = $prereqs->{$modname}; + my $status = $self->check_installed_status($modname, $spec); + if ((!$status->{ok}) xor ($type =~ /conflicts$/)) { return 0; } + if ( ! eval "require $modname; 1" ) { return 0; } + } + } + return 1; } return $ph->{features}->access($key, @_); @@ -614,7 +658,7 @@ BEGIN { *feature = \&features } # Alias sub _mb_feature { my $self = shift; - + if (($self->module_name || '') eq 'Module::Build') { # We're building Module::Build itself, so ...::ConfigData isn't # valid, but $self->features() should be. @@ -625,6 +669,15 @@ sub _mb_feature { } } +sub _warn_mb_feature_deps { + my $self = shift; + my $name = shift; + $self->log_warn( + "The '$name' feature is not available. Please install missing\n" . + "feature dependencies and try again.\n". + $self->_feature_deps_msg($name) . "\n" + ); +} sub add_build_element { my ($self, $elem) = @_; @@ -635,7 +688,7 @@ sub add_build_element { sub ACTION_config_data { my $self = shift; return unless $self->has_config_data; - + my $module_name = $self->module_name or die "The config_data feature requires that 'module_name' be set"; my $notes_name = $module_name . '::ConfigData'; # TODO: Customize name ??? @@ -646,7 +699,7 @@ sub ACTION_config_data { $self->config_file('features') ], $notes_pm); - $self->log_info("Writing config notes to $notes_pm\n"); + $self->log_verbose("Writing config notes to $notes_pm\n"); File::Path::mkpath(File::Basename::dirname($notes_pm)); Module::Build::Notes->write_config_data @@ -661,7 +714,7 @@ sub ACTION_config_data { } ######################################################################## -{ # enclosing these lexicals -- TODO +{ # enclosing these lexicals -- TODO my %valid_properties = ( __PACKAGE__, {} ); my %additive_properties; @@ -681,10 +734,10 @@ sub ACTION_config_data { sub valid_properties_defaults { my %out; - for (reverse shift->_mb_classes) { - @out{ keys %{ $valid_properties{$_} } } = map { + for my $class (reverse shift->_mb_classes) { + @out{ keys %{ $valid_properties{$class} } } = map { $_->() - } values %{ $valid_properties{$_} }; + } values %{ $valid_properties{$class} }; } return \%out; } @@ -710,9 +763,11 @@ sub ACTION_config_data { my %p = @_ == 1 ? ( default => shift ) : @_; my $type = ref $p{default}; - $valid_properties{$class}{$property} = $type eq 'CODE' - ? $p{default} - : sub { $p{default} }; + $valid_properties{$class}{$property} = + $type eq 'CODE' ? $p{default} : + $type eq 'HASH' ? sub { return { %{ $p{default} } } } : + $type eq 'ARRAY'? sub { return [ @{ $p{default} } ] } : + sub { return $p{default} } ; push @{$additive_properties{$class}->{$type}}, $property if $type; @@ -831,12 +886,16 @@ sub _make_accessor { __PACKAGE__->add_property(auto_configure_requires => 1); __PACKAGE__->add_property(blib => 'blib'); __PACKAGE__->add_property(build_class => 'Module::Build'); -__PACKAGE__->add_property(build_elements => [qw(PL support pm xs pod script)]); +__PACKAGE__->add_property(build_elements => [qw(PL support pm xs share_dir pod script)]); __PACKAGE__->add_property(build_script => 'Build'); __PACKAGE__->add_property(build_bat => 0); +__PACKAGE__->add_property(bundle_inc => []); +__PACKAGE__->add_property(bundle_inc_preload => []); __PACKAGE__->add_property(config_dir => '_build'); __PACKAGE__->add_property(include_dirs => []); +__PACKAGE__->add_property(license => 'unknown'); __PACKAGE__->add_property(metafile => 'META.yml'); +__PACKAGE__->add_property(mymetafile => 'MYMETA.yml'); __PACKAGE__->add_property(recurse_into => []); __PACKAGE__->add_property(use_rcfile => 1); __PACKAGE__->add_property(create_packlist => 1); @@ -844,6 +903,7 @@ __PACKAGE__->add_property(allow_mb_mismatch => 0); __PACKAGE__->add_property(config => undef); __PACKAGE__->add_property(test_file_exts => ['.t']); __PACKAGE__->add_property(use_tap_harness => 0); +__PACKAGE__->add_property(cpan_client => 'cpan'); __PACKAGE__->add_property(tap_harness_args => {}); __PACKAGE__->add_property( 'installdirs', @@ -906,10 +966,10 @@ __PACKAGE__->add_property($_) for qw( has_config_data install_base libdoc_dirs - license magic_number mb_version module_name + needs_compiler orig_dir perl pm_files @@ -921,6 +981,7 @@ __PACKAGE__->add_property($_) for qw( recursive_test_files script_files scripts + share_dir sign test_files verbose @@ -993,14 +1054,14 @@ sub subclass { $opts{code} ||= ''; $opts{class} ||= 'MyModuleBuilder'; - + my $filename = File::Spec->catfile($build_dir, 'lib', split '::', $opts{class}) . '.pm'; my $filedir = File::Basename::dirname($filename); - $pack->log_info("Creating custom builder $filename in $filedir\n"); - + $pack->log_verbose("Creating custom builder $filename in $filedir\n"); + File::Path::mkpath($filedir); die "Can't create directory $filedir: $!" unless -d $filedir; - + my $fh = IO::File->new("> $filename") or die "Can't create $filename: $!"; print $fh <<EOF; package $opts{class}; @@ -1010,7 +1071,7 @@ $opts{code} 1; EOF close $fh; - + unshift @INC, File::Spec->catdir(File::Spec->rel2abs($build_dir), 'lib'); eval "use $opts{class}"; die $@ if $@; @@ -1018,16 +1079,43 @@ EOF return $opts{class}; } +sub _guess_module_name { + my $self = shift; + my $p = $self->{properties}; + return if $p->{module_name}; + if ( $p->{dist_version_from} && -e $p->{dist_version_from} ) { + my $mi = Module::Build::ModuleInfo->new_from_file($self->dist_version_from); + $p->{module_name} = $mi->name; + } + else { + my $mod_path = my $mod_name = File::Basename::basename($self->base_dir); + $mod_name =~ s{-}{::}g; + $mod_path =~ s{-}{/}g; + $mod_path .= ".pm"; + if ( -e $mod_path || -e File::Spec->catfile('lib', $mod_path) ) { + $p->{module_name} = $mod_name; + } + else { + $self->log_warn( << 'END_WARN' ); +No 'module_name' was provided and it could not be inferred +from other properties. This will prevent a packlist from +being written for this file. Please set either 'module_name' +or 'dist_version_from' in Build.PL. +END_WARN + } + } +} + sub dist_name { my $self = shift; my $p = $self->{properties}; return $p->{dist_name} if defined $p->{dist_name}; - + die "Can't determine distribution name, must supply either 'dist_name' or 'module_name' parameter" unless $self->module_name; - + ($p->{dist_name} = $self->module_name) =~ s/::/-/g; - + return $p->{dist_name}; } @@ -1069,12 +1157,12 @@ sub _pod_parse { my $p = $self->{properties}; my $member = "dist_$part"; return $p->{$member} if defined $p->{$member}; - + my $docfile = $self->_main_docfile or return; my $fh = IO::File->new($docfile) or return; - + require Module::Build::PodParser; my $parser = Module::Build::PodParser->new(fh => $fh); my $method = "get_$part"; @@ -1109,7 +1197,7 @@ sub config_file { sub read_config { my ($self) = @_; - + my $file = $self->config_file('build_params') or die "Can't find 'build_params' in " . $self->config_dir; my $fh = IO::File->new($file) or die "Can't read '$file': $!"; @@ -1128,7 +1216,7 @@ sub has_config_data { sub _write_data { my ($self, $filename, $data) = @_; - + my $file = $self->config_file($filename); my $fh = IO::File->new("> $file") or die "Can't create '$file': $!"; unless (ref($data)) { # e.g. magicnum @@ -1141,10 +1229,10 @@ sub _write_data { sub write_config { my ($self) = @_; - + File::Path::mkpath($self->{properties}{config_dir}); -d $self->{properties}{config_dir} or die "Can't mkdir $self->{properties}{config_dir}: $!"; - + my @items = @{ $self->prereq_action_types }; $self->_write_data('prereqs', { map { $_, $self->$_() } @items }); $self->_write_data('build_params', [$self->{args}, $self->{config}->values_set, $self->{properties}]); @@ -1155,13 +1243,74 @@ sub write_config { $self->{phash}{$_}->write() foreach qw(notes cleanup features auto_features config_data runtime_params); } +{ + # packfile map -- keys are guts of regular expressions; If they match, + # values are module names corresponding to the packlist + my %packlist_map = ( + '^File::Spec' => 'Cwd', + '^Devel::AssertOS' => 'Devel::CheckOS', + ); + + sub _find_packlist { + my ($self, $inst, $mod) = @_; + my $lookup = $mod; + my $packlist = eval { $inst->packlist($lookup) }; + if ( ! $packlist ) { + # try from packlist_map + while ( my ($re, $new_mod) = each %packlist_map ) { + if ( $mod =~ qr/$re/ ) { + $lookup = $new_mod; + $packlist = eval { $inst->packlist($lookup) }; + last; + } + } + } + return $packlist ? $lookup : undef; + } + + sub set_bundle_inc { + my $self = shift; + + my $bundle_inc = $self->{properties}{bundle_inc}; + my $bundle_inc_preload = $self->{properties}{bundle_inc_preload}; + # We're in author mode if inc::latest is loaded, but not from cwd + return unless inc::latest->can('loaded_modules'); + require ExtUtils::Installed; + # ExtUtils::Installed is buggy about finding additions to default @INC + my $inst = ExtUtils::Installed->new(extra_libs => [@INC]); + my @bundle_list = map { [ $_, 0 ] } inc::latest->loaded_modules; + + # XXX TODO: Need to get ordering of prerequisites correct so they are + # are loaded in the right order. Use an actual tree?! + + while( @bundle_list ) { + my ($mod, $prereq) = @{ shift @bundle_list }; + + # XXX TODO: Append prereqs to list + # skip if core or already in bundle or preload lists + # push @bundle_list, [$_, 1] for prereqs() + + # Locate packlist for bundling + my $lookup = $self->_find_packlist($inst,$mod); + if ( ! $lookup ) { + # XXX Really needs a more helpful error message here + die << "NO_PACKLIST"; +Could not find a packlist for '$mod'. If it's a core module, try +force installing it from CPAN. +NO_PACKLIST + } + else { + push @{ $prereq ? $bundle_inc_preload : $bundle_inc }, $lookup; + } + } + } # sub check_bundling +} + sub check_autofeatures { my ($self) = @_; my $features = $self->auto_features; - - return unless %$features; - $self->log_info("Checking features:\n"); + return 1 unless %$features; # TODO refactor into ::Util my $longest = sub { @@ -1177,30 +1326,117 @@ sub check_autofeatures { }; 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 ($num_disabled, $log_text) = (0, "\nChecking optional features...\n"); + for my $name ( sort keys %$features ) { + $log_text .= $self->_feature_deps_msg($name, $max_name_len); + } + + $num_disabled = () = $log_text =~ /disabled/g; + + # warn user if features disabled + if ( $num_disabled ) { + $self->log_warn( $log_text ); + return 0; + } + else { + $self->log_verbose( $log_text ); + return 1; + } +} + +sub _feature_deps_msg { + my ($self, $name, $max_name_len) = @_; + $max_name_len ||= length $name; + my $features = $self->auto_features; + my $info = $features->{$name}; + my $feature_text = "$name" . '.' x ($max_name_len - length($name) + 4); + my ($log_text, $disabled) = ('',''); if ( my $failures = $self->prereq_failures($info) ) { - my $disabled = grep( /^(?:\w+_)?(?:requires|conflicts)$/, - keys %$failures ) ? 1 : 0; - $self->log_info( $disabled ? "disabled\n" : "enabled\n" ); - - my $log_text; - while (my ($type, $prereqs) = each %$failures) { - while (my ($module, $status) = each %$prereqs) { - my $required = - ($type =~ /^(?:\w+_)?(?:requires|conflicts)$/) ? 1 : 0; - my $prefix = ($required) ? '-' : '*'; - $log_text .= " $prefix $status->{message}\n"; - } + $disabled = grep( /^(?:\w+_)?(?:requires|conflicts)$/, + keys %$failures ) ? 1 : 0; + $feature_text .= $disabled ? "disabled\n" : "enabled\n"; + + for my $type ( @{ $self->prereq_action_types } ) { + next unless exists $failures->{$type}; + $feature_text .= " $type:\n"; + my $prereqs = $failures->{$type}; + for my $module ( sort keys %$prereqs ) { + my $status = $prereqs->{$module}; + my $required = + ($type =~ /^(?:\w+_)?(?:requires|conflicts)$/) ? 1 : 0; + my $prefix = ($required) ? '!' : '*'; + $feature_text .= " $prefix $status->{message}\n"; + } } - $self->log_warn("$log_text") unless $self->quiet; } else { - $self->log_info("enabled\n"); + $feature_text .= "enabled\n"; + } + $log_text .= $feature_text if $disabled || $self->verbose; + return $log_text; +} + +# Automatically detect and add prerequisites based on configuration +sub auto_require { + my ($self) = @_; + my $p = $self->{properties}; + + # add current Module::Build to configure_requires if there + # isn't one already specified (but not ourself, so we're not circular) + if ( $self->dist_name ne 'Module-Build' + && $self->auto_configure_requires + && ! exists $p->{configure_requires}{'Module::Build'} + ) { + (my $ver = $VERSION) =~ s/^(\d+\.\d\d).*$/$1/; # last major release only + $self->_add_prereq('configure_requires', 'Module::Build', $ver); + } + + # if we're in author mode, add inc::latest modules to + # configure_requires if not already set. If we're not in author mode + # then configure_requires will have been satisfied, or we'll just + # live with what we've bundled + if ( inc::latest->can('loaded_module') ) { + for my $mod ( inc::latest->loaded_modules ) { + next if exists $p->{configure_requires}{$mod}; + $self->_add_prereq('configure_requires', $mod, $mod->VERSION); } } - $self->log_warn("\n") unless $self->quiet; + # If needs_compiler is not explictly set, automatically set it + # If set, we need ExtUtils::CBuilder (and a compiler) + my $xs_files = $self->find_xs_files; + if ( ! defined $p->{needs_compiler} ) { + $self->needs_compiler( keys %$xs_files || defined $self->c_source ); + } + if ($self->needs_compiler) { + $self->_add_prereq('build_requires', 'ExtUtils::CBuilder', 0); + if ( ! $self->have_c_compiler ) { + $self->log_warn(<<'EOM'); +Warning: ExtUtils::CBuilder not installed or no compiler detected +Proceeding with configuration, but compilation may fail during Build + +EOM + } + } + + # If using share_dir, require File::ShareDir + if ( $self->share_dir ) { + $self->_add_prereq( 'requires', 'File::ShareDir', '1.00' ); + } + + return; +} + +sub _add_prereq { + my ($self, $type, $module, $version) = @_; + my $p = $self->{properties}; + $version = 0 unless defined $version; + if ( exists $p->{$type}{$module} ) { + return if $self->compare_versions( $version, '<=', $p->{$type}{$module} ); + } + $self->log_verbose("Adding to $type\: $module => $version\n"); + $p->{$type}{$module} = $version; + return 1; } sub prereq_failures { @@ -1213,7 +1449,8 @@ sub prereq_failures { foreach my $type (@types) { my $prereqs = $info->{$type}; - while ( my ($modname, $spec) = each %$prereqs ) { + for my $modname ( keys %$prereqs ) { + my $spec = $prereqs->{$modname}; my $status = $self->check_installed_status($modname, $spec); if ($type =~ /^(?:\w+_)?conflicts$/) { @@ -1224,7 +1461,7 @@ sub prereq_failures { } elsif ($type =~ /^(?:\w+_)?recommends$/) { next if $status->{ok}; $status->{message} = (!ref($status->{have}) && $status->{have} eq '<none>' - ? "Optional prerequisite $modname is not installed" + ? "$modname is not installed" : "$modname ($status->{have}) is installed, but we prefer to have $spec"); } else { next if $status->{ok}; @@ -1253,44 +1490,29 @@ sub _enum_prereqs { sub check_prereq { my $self = shift; - # If we have XS files, make sure we can process them. - my $xs_files = $self->find_xs_files; - if (keys %$xs_files && !$self->_mb_feature('C_support')) { - $self->log_warn("Warning: this distribution contains XS files, ". - "but Module::Build is not configured with C_support. ". - "Please install ExtUtils::CBuilder to enable C_support.\n"); - } - # Check to see if there are any prereqs to check my $info = $self->_enum_prereqs; return 1 unless $info; - $self->log_info("Checking prerequisites...\n"); + my $log_text = "Checking prerequisites...\n"; my $failures = $self->prereq_failures($info); if ( $failures ) { - - while (my ($type, $prereqs) = each %$failures) { - while (my ($module, $status) = each %$prereqs) { - my $prefix = ($type =~ /^(?:\w+_)?recommends$/) ? '*' : '- ERROR:'; - $self->log_warn(" $prefix $status->{message}\n"); + $self->log_warn($log_text); + for my $type ( @{ $self->prereq_action_types } ) { + my $prereqs = $failures->{$type}; + $self->log_warn(" ${type}:\n") if keys %$prereqs; + for my $module ( sort keys %$prereqs ) { + my $status = $prereqs->{$module}; + my $prefix = ($type =~ /^(?:\w+_)?recommends$/) ? "* " : "! "; + $self->log_warn(" $prefix $status->{message}\n"); } } - - $self->log_warn(<<EOF); - -ERRORS/WARNINGS FOUND IN PREREQUISITES. You may wish to install the versions -of the modules indicated above before proceeding with this installation - -EOF return 0; - } else { - - $self->log_info("Looks good\n\n"); + $self->log_verbose($log_text . "Looks good\n\n"); return 1; - } } @@ -1323,44 +1545,44 @@ sub _parse_conditions { sub check_installed_status { my ($self, $modname, $spec) = @_; my %status = (need => $spec); - + if ($modname eq 'perl') { $status{have} = $self->perl_version; - + } elsif (eval { no strict; $status{have} = ${"${modname}::VERSION"} }) { # Don't try to load if it's already loaded - + } else { my $pm_info = Module::Build::ModuleInfo->new_from_module( $modname ); unless (defined( $pm_info )) { @status{ qw(have message) } = ('<none>', "$modname is not installed"); return \%status; } - + $status{have} = $pm_info->version(); if ($spec and !defined($status{have})) { @status{ qw(have message) } = (undef, "Couldn't find a \$VERSION in prerequisite $modname"); return \%status; } } - + my @conditions = $self->_parse_conditions($spec); - + foreach (@conditions) { my ($op, $version) = /^\s* (<=?|>=?|==|!=) \s* ([\w.]+) \s*$/x or die "Invalid prerequisite condition '$_' for $modname"; - + $version = $self->perl_version_to_float($version) if $modname eq 'perl'; - + next if $op eq '>=' and !$version; # Module doesn't have to actually define a $VERSION - + unless ($self->compare_versions( $status{have}, $op, $version )) { $status{message} = "$modname ($status{have}) is installed, but we need version $op $version"; return \%status; } } - + $status{ok} = 1; return \%status; } @@ -1368,7 +1590,7 @@ sub check_installed_status { sub compare_versions { my $self = shift; my ($v1, $op, $v2) = @_; - $v1 = Module::Build::Version->new($v1) + $v1 = Module::Build::Version->new($v1) unless UNIVERSAL::isa($v1,'Module::Build::Version'); my $eval_str = "\$v1 $op \$v2"; @@ -1381,14 +1603,14 @@ sub compare_versions { # I wish I could set $! to a string, but I can't, so I use $@ sub check_installed_version { my ($self, $modname, $spec) = @_; - + my $status = $self->check_installed_status($modname, $spec); - + if ($status->{ok}) { return $status->{have} if $status->{have} and "$status->{have}" ne '<none>'; return '0 but true'; } - + $@ = $status->{message}; return 0; } @@ -1430,23 +1652,23 @@ sub _added_to_INC { sub _default_INC { my $self = shift; return @default_inc if @default_inc; - + local $ENV{PERL5LIB}; # this is not considered part of the default. - + my $perl = ref($self) ? $self->perl : $self->find_perl_interpreter; - + my @inc = $self->_backticks($perl, '-le', 'print for @INC'); chomp @inc; - + return @default_inc = @inc; } } sub print_build_script { my ($self, $fh) = @_; - + my $build_package = $self->build_class; - + my $closedata=""; my %q = map {$_, $self->$_()} qw(config_dir base_dir); @@ -1532,20 +1754,29 @@ EOF sub create_build_script { my ($self) = @_; $self->write_config; - + + # Create MYMETA.yml + my $mymetafile = $self->mymetafile; + if ( $self->delete_filetree($mymetafile) ) { + $self->log_verbose("Removed previous '$mymetafile'\n"); + } + $self->log_info("Creating new '$mymetafile' with configuration results\n"); + $self->write_metafile( $mymetafile, $self->prepare_metadata( fatal => 0 ) ); + + # Create Build my ($build_script, $dist_name, $dist_version) = map $self->$_(), qw(build_script dist_name dist_version); - + if ( $self->delete_filetree($build_script) ) { - $self->log_info("Removed previous script '$build_script'\n\n"); + $self->log_verbose("Removed previous script '$build_script'\n"); } $self->log_info("Creating new '$build_script' script for ", - "'$dist_name' version '$dist_version'\n"); + "'$dist_name' version '$dist_version'\n"); my $fh = IO::File->new(">$build_script") or die "Can't create '$build_script': $!"; $self->print_build_script($fh); close $fh; - + $self->make_executable($build_script); return 1; @@ -1554,20 +1785,20 @@ sub create_build_script { sub check_manifest { my $self = shift; return unless -e 'MANIFEST'; - + # Stolen nearly verbatim from MakeMaker. But ExtUtils::Manifest # could easily be re-written into a modern Perl dialect. require ExtUtils::Manifest; # ExtUtils::Manifest is not warnings clean. local ($^W, $ExtUtils::Manifest::Quiet) = (0,1); - - $self->log_info("Checking whether your kit is complete...\n"); + + $self->log_verbose("Checking whether your kit is complete...\n"); if (my @missed = ExtUtils::Manifest::manicheck()) { $self->log_warn("WARNING: the following files are missing in your kit:\n", "\t", join("\n\t", @missed), "\n", "Please inform the author.\n\n"); } else { - $self->log_info("Looks good\n\n"); + $self->log_verbose("Looks good\n\n"); } } @@ -1692,6 +1923,7 @@ sub _translate_option { use_rcfile use_tap_harness tap_harness_args + cpan_client ); # normalize only selected option names return $opt; @@ -1824,7 +2056,7 @@ sub read_args { require Module::Build::Compat; %args = (%args, Module::Build::Compat->makefile_to_build_macros); } - + return \%args, $action; } @@ -1977,7 +2209,10 @@ sub merge_args { sub cull_args { my $self = shift; - my ($args, $action) = $self->read_args(@_); + my @arg_list = @_; + unshift @arg_list, $self->split_like_shell($ENV{PERL_MB_OPT}) + if $ENV{PERL_MB_OPT}; + my ($args, $action) = $self->read_args(@arg_list); $self->merge_args($action, %$args); $self->merge_modulebuildrc( $action, %$args ); } @@ -1986,7 +2221,7 @@ sub super_classes { my ($self, $class, $seen) = @_; $class ||= ref($self) || $self; $seen ||= {}; - + no strict 'refs'; my @super = grep {not $seen->{$_}++} $class, @{ $class . '::ISA' }; return @super, map {$self->super_classes($_,$seen)} @super; @@ -1997,7 +2232,7 @@ sub known_actions { my %actions; no strict 'refs'; - + foreach my $class ($self->super_classes) { foreach ( keys %{ $class . '::' } ) { $actions{$1}++ if /^ACTION_(\w+)/; @@ -2073,7 +2308,7 @@ sub get_action_docs { $@ = "Couldn't find any docs for action '$action'"; return; } - + return join '', @docs; } @@ -2147,7 +2382,7 @@ sub prereq_report { sub ACTION_help { my ($self) = @_; my $actions = $self->known_actions; - + if (@{$self->{args}{ARGV}}) { my $msg = eval {$self->get_action_docs($self->{args}{ARGV}[0], $actions)}; print $@ ? "$@\n" : $msg; @@ -2158,10 +2393,10 @@ sub ACTION_help { Usage: $0 <action> arg1=value arg2=value ... Example: $0 test verbose=1 - + Actions defined: EOF - + print $self->_action_listing($actions); print "\nRun `Build help <action>` for details on an individual action.\n"; @@ -2174,7 +2409,7 @@ sub _action_listing { # Flow down columns, not across rows my @actions = sort keys %$actions; @actions = map $actions[($_ + ($_ % 2) * @actions) / 2], 0..$#actions; - + my $out = ''; while (my ($one, $two) = splice @actions, 0, 2) { $out .= sprintf(" %-12s %-12s\n", $one, $two||''); @@ -2184,7 +2419,7 @@ sub _action_listing { sub ACTION_retest { my ($self) = @_; - + # Protect others against our @INC changes local @INC = @INC; @@ -2232,7 +2467,7 @@ sub generic_test { my $p = $self->{properties}; my @types = ( - (exists($args{type}) ? $args{type} : ()), + (exists($args{type}) ? $args{type} : ()), (exists($args{types}) ? @{$args{types}} : ()), ); @types or croak "need some types of tests to check"; @@ -2265,6 +2500,8 @@ sub generic_test { $self->do_tests; } +# Test::Harness dies on failure but TAP::Harness does not, so we must +# die if running under TAP::Harness sub do_tests { my $self = shift; @@ -2273,7 +2510,10 @@ sub do_tests { if(@$tests) { my $args = $self->tap_harness_args; if($self->use_tap_harness or ($args and %$args)) { - $self->run_tap_harness($tests); + my $aggregate = $self->run_tap_harness($tests); + if ( $aggregate->has_errors ) { + die "Errors in testing. Cannot continue.\n"; + } } else { $self->run_test_harness($tests); @@ -2293,12 +2533,14 @@ sub run_tap_harness { # TODO allow the test @INC to be set via our API? - TAP::Harness->new({ + my $aggregate = TAP::Harness->new({ lib => [@INC], verbosity => $self->{properties}{verbose}, switches => [ $self->harness_switches ], %{ $self->tap_harness_args }, })->runtests(@$tests); + + return $aggregate; } sub run_test_harness { @@ -2382,14 +2624,14 @@ sub ACTION_testcover { my $pm_files = $self->rscan_dir (File::Spec->catdir($self->blib, 'lib'), file_qr('\.pm$') ); my $cover_files = $self->rscan_dir('cover_db', sub {-f $_ and not /\.html$/}); - + $self->do_system(qw(cover -delete)) unless $self->up_to_date($pm_files, $cover_files) && $self->up_to_date($self->test_files, $cover_files); } - local $Test::Harness::switches = - local $Test::Harness::Switches = + local $Test::Harness::switches = + local $Test::Harness::Switches = local $ENV{HARNESS_PERL_SWITCHES} = "-MDevel::Cover"; $self->depends_on('test'); @@ -2398,17 +2640,17 @@ sub ACTION_testcover { sub ACTION_code { my ($self) = @_; - + # All installable stuff gets created in blib/ . # Create blib/arch to keep blib.pm happy my $blib = $self->blib; $self->add_to_cleanup($blib); File::Path::mkpath( File::Spec->catdir($blib, 'arch') ); - + if (my $split = $self->autosplit) { $self->autosplit_file($_, $blib) for ref($split) ? @$split : ($split); } - + foreach my $element (@{$self->build_elements}) { my $method = "process_${element}_files"; $method = "process_files_by_extension" unless $self->can($method); @@ -2420,16 +2662,17 @@ sub ACTION_code { sub ACTION_build { my $self = shift; + $self->log_info("Building " . $self->dist_name . "\n"); $self->depends_on('code'); $self->depends_on('docs'); } sub process_files_by_extension { my ($self, $ext) = @_; - + my $method = "find_${ext}_files"; my $files = $self->can($method) ? $self->$method() : $self->_find_file_by_type($ext, 'lib'); - + while (my ($file, $dest) = each %$files) { $self->copy_if_modified(from => $file, to => File::Spec->catfile($self->blib, $dest) ); } @@ -2439,19 +2682,70 @@ sub process_support_files { my $self = shift; my $p = $self->{properties}; return unless $p->{c_source}; - + push @{$p->{include_dirs}}, $p->{c_source}; - - my $files = $self->rscan_dir($p->{c_source}, file_qr('\.c(pp)?$')); + + my $files = $self->rscan_dir($p->{c_source}, file_qr('\.c(c|p|pp|xx|\+\+)?$')); foreach my $file (@$files) { push @{$p->{objects}}, $self->compile_c($file); } } +sub process_share_dir_files { + my $self = shift; + my $files = $self->_find_share_dir_files; + return unless $files; + + # root for all File::ShareDir paths + my $share_prefix = File::Spec->catdir($self->blib, qw/lib auto share/); + + # copy all share files to blib + while (my ($file, $dest) = each %$files) { + $self->copy_if_modified( + from => $file, to => File::Spec->catfile( $share_prefix, $dest ) + ); + } +} + +sub _find_share_dir_files { + my $self = shift; + my $share_dir = $self->share_dir; + return unless $share_dir; + + my @file_map; + if ( $share_dir->{dist} ) { + my $prefix = File::Spec->catdir( "dist", $self->dist_name ); + push @file_map, $self->_share_dir_map( $prefix, $share_dir->{dist} ); + } + + if ( $share_dir->{module} ) { + for my $mod ( keys %{ $share_dir->{module} } ) { + (my $altmod = $mod) =~ s{::}{-}g; + my $prefix = File::Spec->catdir("module", $altmod); + push @file_map, $self->_share_dir_map($prefix, $share_dir->{module}{$mod}); + } + } + + return { @file_map }; +} + +sub _share_dir_map { + my ($self, $prefix, $list) = @_; + my %files; + for my $dir ( @$list ) { + for my $f ( @{ $self->rscan_dir( $dir, sub {-f} )} ) { + $files{File::Spec->canonpath($f)} = File::Spec->catfile( + $prefix, File::Spec->abs2rel( $f, $dir ) + ); + } + } + return %files; +} + sub process_PL_files { my ($self) = @_; my $files = $self->find_PL_files; - + while (my ($file, $to) = each %$files) { unless ($self->up_to_date( $file, $to )) { $self->run_perl_script($file, [], [@$to]) or die "$file failed"; @@ -2482,7 +2776,7 @@ sub process_script_files { my $script_dir = File::Spec->catdir($self->blib, 'script'); File::Path::mkpath( $script_dir ); - + foreach my $file (keys %$files) { my $result = $self->copy_if_modified($file, $script_dir, 'flatten') or next; $self->fix_shebang_line($result) unless $self->is_vmsish; @@ -2494,7 +2788,7 @@ sub find_PL_files { my $self = shift; if (my $files = $self->{properties}{PL_files}) { # 'PL_files' is given as a Unix file spec, so we localize_file_path(). - + if (UNIVERSAL::isa($files, 'ARRAY')) { return { map {$_, [/^(.*)\.PL$/]} map $self->localize_file_path($_), @@ -2512,7 +2806,7 @@ sub find_PL_files { die "'PL_files' must be a hash reference or array reference"; } } - + return unless -d 'lib'; return { map {$_, [/^(.*)\.PL$/i ]} @{ $self->rscan_dir('lib', file_qr('\.PL$')) } }; @@ -2529,7 +2823,7 @@ sub find_script_files { # meaningless, but we preserve if present. return { map {$self->localize_file_path($_), $files->{$_}} keys %$files }; } - + # No default location for script files return {}; } @@ -2543,10 +2837,10 @@ sub find_test_files { $files = [map { -d $_ ? $self->expand_test_dir($_) : $_ } map glob, $self->split_like_shell($files)]; - + # Always given as a Unix file spec. return [ map $self->localize_file_path($_), @$files ]; - + } else { # Find all possible tests in t/ or test.pl my @tests; @@ -2558,12 +2852,12 @@ sub find_test_files { sub _find_file_by_type { my ($self, $type, $dir) = @_; - + if (my $files = $self->{properties}{"${type}_files"}) { # Always given as a Unix file spec return { map $self->localize_file_path($_), %$files }; } - + return {} unless -d $dir; return { map {$_, $_} map $self->localize_file_path($_), @@ -2584,48 +2878,48 @@ sub localize_dir_path { sub fix_shebang_line { # Adapted from fixin() in ExtUtils::MM_Unix 1.35 my ($self, @files) = @_; my $c = ref($self) ? $self->{config} : 'Module::Build::Config'; - + my ($does_shbang) = $c->get('sharpbang') =~ /^\s*\#\!/; for my $file (@files) { my $FIXIN = IO::File->new($file) or die "Can't process '$file': $!"; local $/ = "\n"; chomp(my $line = <$FIXIN>); next unless $line =~ s/^\s*\#!\s*//; # Not a shbang file. - + my ($cmd, $arg) = (split(' ', $line, 2), ''); next unless $cmd =~ /perl/i; my $interpreter = $self->{properties}{perl}; - + $self->log_verbose("Changing sharpbang in $file to $interpreter"); my $shb = ''; $shb .= $c->get('sharpbang')."$interpreter $arg\n" if $does_shbang; - + # I'm not smart enough to know the ramifications of changing the # embedded newlines here to \n, so I leave 'em in. $shb .= qq{ eval 'exec $interpreter $arg -S \$0 \${1+"\$\@"}' if 0; # not running under some shell } unless $self->is_windowsish; # this won't work on win32, so don't - + my $FIXOUT = IO::File->new(">$file.new") or die "Can't create new $file: $!\n"; - + # Print out the new #! line (or equivalent). local $\; undef $/; # Was localized above print $FIXOUT $shb, <$FIXIN>; close $FIXIN; close $FIXOUT; - + rename($file, "$file.bak") or die "Can't rename $file to $file.bak: $!"; - + rename("$file.new", $file) or die "Can't rename $file.new to $file: $!"; - + $self->delete_filetree("$file.bak") or $self->log_warn("Couldn't clean up $file.bak, leaving it there"); - + $self->do_system($c->get('eunicefix'), $file) if $c->get('eunicefix') ne ':'; } } @@ -2634,7 +2928,7 @@ eval 'exec $interpreter $arg -S \$0 \${1+"\$\@"}' sub ACTION_testpod { my $self = shift; $self->depends_on('docs'); - + eval q{use Test::Pod 0.95; 1} or die "The 'testpod' action requires Test::Pod version 0.95"; @@ -2655,7 +2949,7 @@ sub ACTION_testpodcoverage { my $self = shift; $self->depends_on('docs'); - + eval q{use Test::Pod::Coverage 1.00; 1} or die "The 'testpodcoverage' action requires ", "Test::Pod::Coverage version 1.00"; @@ -2738,9 +3032,9 @@ sub manify_bin_pods { $self->config( 'man1ext' ); my $outfile = File::Spec->catfile($mandir, $manpage); next if $self->up_to_date( $file, $outfile ); - $self->log_info("Manifying $file -> $outfile\n"); + $self->log_verbose("Manifying $file -> $outfile\n"); eval { $parser->parse_from_file( $file, $outfile ); 1 } - or $self->log_warn("Error creating '$outfile': $@\n"); + or $self->log_warn("Error creating '$outfile': $@\n"); $files->{$file} = $outfile; } } @@ -2763,9 +3057,9 @@ sub manify_lib_pods { $self->config( 'man3ext' ); my $outfile = File::Spec->catfile( $mandir, $manpage); next if $self->up_to_date( $file, $outfile ); - $self->log_info("Manifying $file -> $outfile\n"); + $self->log_verbose("Manifying $file -> $outfile\n"); eval { $parser->parse_from_file( $file, $outfile ); 1 } - or $self->log_warn("Error creating '$outfile': $@\n"); + or $self->log_warn("Error creating '$outfile': $@\n"); $files->{$file} = $outfile; } } @@ -2790,12 +3084,12 @@ sub _find_pods { sub contains_pod { my ($self, $file) = @_; return '' unless -T $file; # Only look at text files - + my $fh = IO::File->new( $file ) or die "Can't open $file: $!"; while (my $line = <$fh>) { return 1 if $line =~ /^\=(?:head|pod|item)/; } - + return ''; } @@ -2808,7 +3102,7 @@ sub ACTION_html { foreach my $type ( qw(bin lib) ) { my $files = $self->_find_pods( $self->{properties}{"${type}doc_dirs"}, - exclude => + exclude => [ file_qr('\.(?:bat|com|html)$') ] ); next unless %$files; @@ -2897,9 +3191,9 @@ sub htmlify_pods { push( @opts, "--css=$path2root/" . $self->html_css) if $self->html_css; } - $self->log_info("HTMLifying $infile -> $outfile\n"); + $self->log_verbose("HTMLifying $infile -> $outfile\n"); $self->log_verbose("pod2html @opts\n"); - eval { Pod::Html::pod2html(@opts); 1 } + eval { Pod::Html::pod2html(@opts); 1 } or $self->log_warn("pod2html @opts failed: $@"); } @@ -2919,10 +3213,10 @@ sub man3page_name { my $self = shift; my ($vol, $dirs, $file) = File::Spec->splitpath( shift ); my @dirs = File::Spec->splitdir( File::Spec->canonpath($dirs) ); - + # Remove known exts from the base name $file =~ s/\.p(?:od|m|l)\z//i; - + return join( $self->manpage_separator, @dirs, $file ); } @@ -2942,7 +3236,7 @@ sub ACTION_diff { my @flags = @{$self->{args}{ARGV}}; @flags = $self->split_like_shell($self->{args}{flags} || '') unless @flags; - + my $installmap = $self->install_map; delete $installmap->{read}; delete $installmap->{write}; @@ -2952,22 +3246,22 @@ sub ACTION_diff { while (my $localdir = each %$installmap) { my @localparts = File::Spec->splitdir($localdir); my $files = $self->rscan_dir($localdir, sub {-f}); - + foreach my $file (@$files) { my @parts = File::Spec->splitdir($file); @parts = @parts[@localparts .. $#parts]; # Get rid of blib/lib or similar - + my $installed = Module::Build::ModuleInfo->find_module_by_name( join('::', @parts), \@myINC ); if (not $installed) { print "Only in lib: $file\n"; next; } - + my $status = File::Compare::compare($installed, $file); next if $status == 0; # Files are the same die "Can't compare $installed and $file: $!" if $status == -1; - + if ($file =~ $text_suffix) { $self->do_system('diff', @flags, $installed, $file); } else { @@ -2985,7 +3279,7 @@ sub ACTION_install { my ($self) = @_; require ExtUtils::Install; $self->depends_on('build'); - ExtUtils::Install::install($self->install_map, !$self->quiet, 0, $self->{args}{uninst}||0); + ExtUtils::Install::install($self->install_map, $self->verbose, 0, $self->{args}{uninst}||0); } sub ACTION_fakeinstall { @@ -3005,19 +3299,74 @@ sub ACTION_fakeinstall { sub ACTION_versioninstall { my ($self) = @_; - + die "You must have only.pm 0.25 or greater installed for this operation: $@\n" unless eval { require only; 'only'->VERSION(0.25); 1 }; - + $self->depends_on('build'); - + my %onlyargs = map {exists($self->{args}{$_}) ? ($_ => $self->{args}{$_}) : ()} qw(version versionlib); only::install::install(%onlyargs); } +sub ACTION_installdeps { + my ($self) = @_; + + # XXX include feature prerequisites as optional prereqs? + + my $info = $self->_enum_prereqs; + if (! $info ) { + $self->log_info( "No prerequisites detected\n" ); + return; + } + + my $failures = $self->prereq_failures($info); + if ( ! $failures ) { + $self->log_info( "All prerequisites satisfied\n" ); + return; + } + + my @install; + while (my ($type, $prereqs) = each %$failures) { + if($type =~ m/^(?:\w+_)?requires$/) { + push(@install, keys %$prereqs); + next; + } + $self->log_info("Checking optional dependencies:\n"); + while (my ($module, $status) = each %$prereqs) { + push(@install, $module) if($self->y_n("Install $module?", 'y')); + } + } + + return unless @install; + + my ($command, @opts) = $self->split_like_shell($self->cpan_client); + + # relative command should be relative to our active Perl + # so we need to locate that command + if ( ! File::Spec->file_name_is_absolute( $command ) ) { + my @bindirs = File::Basename::dirname($self->perl); + push @bindirs, map {$self->config->{"install${_}bin"}} '','site','vendor'; + for my $d ( @bindirs ) { + my $abs_cmd = $self->find_command(File::Spec->catfile( $d, $command )); + if ( defined $abs_cmd ) { + $command = $abs_cmd; + last; + } + } + } + + if ( ! -x $command ) { + die "cpan_client '$command' is not executable\n"; + } + + $self->do_system($command, @opts, @install); +} + sub ACTION_clean { my ($self) = @_; + $self->log_info("Cleaning up build files\n"); foreach my $item (map glob($_), $self->cleanup) { $self->delete_filetree($item); } @@ -3026,11 +3375,15 @@ sub ACTION_clean { sub ACTION_realclean { my ($self) = @_; $self->depends_on('clean'); - $self->delete_filetree($self->config_dir, $self->build_script); + $self->log_info("Cleaning up configuration files\n"); + $self->delete_filetree( + $self->config_dir, $self->mymetafile, $self->build_script + ); } sub ACTION_ppd { my ($self) = @_; + require Module::Build::PPMMaker; my $ppd = Module::Build::PPMMaker->new(); my $file = $ppd->make_ppd(%{$self->{args}}, build => $self); @@ -3104,7 +3457,7 @@ sub ACTION_pardist { ); return(); } - + $self->depends_on( 'build' ); return PAR::Dist::blib_to_par( @@ -3115,11 +3468,11 @@ sub ACTION_pardist { sub ACTION_dist { my ($self) = @_; - + $self->depends_on('distdir'); - + my $dist_dir = $self->dist_dir; - + $self->make_tarball($dist_dir); $self->delete_filetree($dist_dir); } @@ -3127,6 +3480,8 @@ sub ACTION_dist { sub ACTION_distcheck { my ($self) = @_; + $self->_check_manifest_skip; + require ExtUtils::Manifest; local $^W; # ExtUtils::Manifest is not warnings clean. my ($missing, $extra) = ExtUtils::Manifest::fullcheck(); @@ -3141,6 +3496,25 @@ sub ACTION_distcheck { } } +sub _check_mymeta_skip { + my $self = shift; + my $maniskip = shift || 'MANIFEST.SKIP'; + + require ExtUtils::Manifest; + local $^W; # ExtUtils::Manifest is not warnings clean. + + # older ExtUtils::Manifest had a private _maniskip + my $skip_factory = ExtUtils::Manifest->can('maniskip') + || ExtUtils::Manifest->can('_maniskip'); + + my $mymetafile = $self->mymetafile; + # we can't check it, just add it anyway to be safe + unless ( $skip_factory && $skip_factory->($maniskip)->($mymetafile) ) { + $self->log_warn("File '$maniskip' does not include '$mymetafile'. Adding it now.\n"); + $self->_append_maniskip("^$mymetafile\$", $maniskip); + } +} + sub _add_to_manifest { my ($self, $manifest, $lines) = @_; $lines = [$lines] unless ref $lines; @@ -3153,7 +3527,7 @@ sub _add_to_manifest { my $mode = (stat $manifest)[2]; chmod($mode | oct(222), $manifest) or die "Can't make $manifest writable: $!"; - + my $fh = IO::File->new("< $manifest") or die "Can't read $manifest: $!"; my $last_line = (<$fh>)[-1] || "\n"; my $has_newline = $last_line =~ /\n$/; @@ -3165,7 +3539,7 @@ sub _add_to_manifest { close $fh; chmod($mode, $manifest); - $self->log_info(map "Added to $manifest: $_\n", @$lines); + $self->log_verbose(map "Added to $manifest: $_\n", @$lines); } sub _sign_dir { @@ -3175,16 +3549,16 @@ sub _sign_dir { $self->log_warn("Couldn't load Module::Signature for 'distsign' action:\n $@\n"); return; } - + # Add SIGNATURE to the MANIFEST { my $manifest = File::Spec->catfile($dir, 'MANIFEST'); die "Signing a distribution requires a MANIFEST file" unless -e $manifest; $self->_add_to_manifest($manifest, "SIGNATURE Added here by Module::Build"); } - + # Would be nice if Module::Signature took a directory argument. - + $self->_do_in_dir($dir, sub {local $Module::Signature::Quiet = 1; Module::Signature::sign()}); } @@ -3210,7 +3584,7 @@ sub ACTION_distsign { sub ACTION_skipcheck { my ($self) = @_; - + require ExtUtils::Manifest; local $^W; # ExtUtils::Manifest is not warnings clean. ExtUtils::Manifest::skipcheck(); @@ -3218,7 +3592,7 @@ sub ACTION_skipcheck { sub ACTION_distclean { my ($self) = @_; - + $self->depends_on('realclean'); $self->depends_on('distcheck'); } @@ -3235,6 +3609,11 @@ sub do_create_license { my $self = shift; $self->log_info("Creating LICENSE file\n"); + if ( ! $self->_mb_feature('license_creation') ) { + $self->_warn_mb_feature_deps('license_creation'); + die "Aborting.\n"; + } + my $l = $self->license or die "No license specified"; @@ -3243,7 +3622,7 @@ sub do_create_license { my $class = "Software::License::$key"; eval "use $class; 1" - or die "Can't load Software::License to create LICENSE file: $@"; + or die "Can't load Software::License::$key to create LICENSE file: $@"; $self->delete_filetree('LICENSE'); @@ -3270,7 +3649,9 @@ EOF return; } - if ( eval {require Pod::Readme; 1} ) { + # work around some odd Pod::Readme->new() failures in test reports by + # confirming that new() is available + if ( eval {require Pod::Readme; Pod::Readme->can('new') } ) { $self->log_info("Creating README using Pod::Readme\n"); my $parser = Pod::Readme->new; @@ -3326,29 +3707,48 @@ sub _main_docfile { } } +sub do_create_bundle_inc { + my $self = shift; + my $dist_inc = File::Spec->catdir( $self->dist_dir, 'inc' ); + require inc::latest; + inc::latest->write($dist_inc, @{$self->bundle_inc_preload}); + inc::latest->bundle_module($_, $dist_inc) for @{$self->bundle_inc}; + return 1; +} + sub ACTION_distdir { my ($self) = @_; + if ( @{$self->bundle_inc} && ! $self->_mb_feature('inc_bundling_support') ) { + $self->_warn_mb_feature_deps('inc_bundling_support'); + die "Aborting.\n"; + } + $self->depends_on('distmeta'); + # Must not include MYMETA + $self->_check_mymeta_skip('MANIFEST.SKIP'); + my $dist_files = $self->_read_manifest('MANIFEST') - or die "Can't create distdir without a MANIFEST file - run 'manifest' action first"; + or die "Can't create distdir without a MANIFEST file - run 'manifest' action first.\n"; delete $dist_files->{SIGNATURE}; # Don't copy, create a fresh one die "No files found in MANIFEST - try running 'manifest' action?\n" unless ($dist_files and keys %$dist_files); my $metafile = $self->metafile; $self->log_warn("*** Did you forget to add $metafile to the MANIFEST?\n") unless exists $dist_files->{$metafile}; - + my $dist_dir = $self->dist_dir; $self->delete_filetree($dist_dir); $self->log_info("Creating $dist_dir\n"); $self->add_to_cleanup($dist_dir); - + foreach my $file (keys %$dist_files) { my $new = $self->copy_if_modified(from => $file, to_dir => $dist_dir, verbose => 0); } - + + $self->do_create_bundle_inc if @{$self->bundle_inc}; + $self->_sign_dir($dist_dir) if $self->{properties}{sign}; } @@ -3388,8 +3788,7 @@ sub _eumanifest_has_include { my $self = shift; require ExtUtils::Manifest; - return ExtUtils::Manifest->VERSION >= 1.50 ? 1 : 0; - return 0; + return eval { ExtUtils::Manifest->VERSION(1.50); 1 }; } @@ -3436,6 +3835,19 @@ sub _slurp { } + +sub _append_maniskip { + my $self = shift; + my $skip = shift; + my $file = shift || 'MANIFEST.SKIP'; + return unless defined $skip && length $skip; + my $fh = IO::File->new(">> $file") + or die "Can't open $file: $!"; + + print $fh "$skip\n"; + $fh->close(); +} + sub _write_default_maniskip { my $self = shift; my $file = shift || 'MANIFEST.SKIP'; @@ -3446,6 +3858,8 @@ sub _write_default_maniskip { : $self->_slurp( $self->_default_maniskip ); $content .= <<'EOF'; +# Avoid configuration metadata file +^MYMETA\.$ # Avoid Module::Build generated and utility files. \bBuild$ @@ -3466,14 +3880,27 @@ EOF return; } -sub ACTION_manifest { +sub _check_manifest_skip { my ($self) = @_; my $maniskip = 'MANIFEST.SKIP'; - unless ( -e 'MANIFEST' || -e $maniskip ) { + + if ( ! -e $maniskip ) { $self->log_warn("File '$maniskip' does not exist: Creating a default '$maniskip'\n"); $self->_write_default_maniskip($maniskip); } + else { + # MYMETA must not be added to MANIFEST, so always confirm the skip + $self->_check_mymeta_skip( $maniskip ); + } + + return; +} + +sub ACTION_manifest { + my ($self) = @_; + + $self->_check_manifest_skip; require ExtUtils::Manifest; # ExtUtils::Manifest is not warnings clean. local ($^W, $ExtUtils::Manifest::Quiet) = (0,1); @@ -3511,6 +3938,63 @@ sub _files_in { return @files; } +sub share_dir { + my $self = shift; + my $p = $self->{properties}; + + $p->{share_dir} = shift if @_; + + # Always coerce to proper hash form + if ( ! defined $p->{share_dir} ) { + # not set -- use default 'share' dir if exists + $p->{share_dir} = { dist => [ 'share' ] } if -d 'share'; + } + elsif ( ! ref $p->{share_dir} ) { + # scalar -- treat as a single 'dist' directory + $p->{share_dir} = { dist => [ $p->{share_dir} ] }; + } + elsif ( ref $p->{share_dir} eq 'ARRAY' ) { + # array -- treat as a list of 'dist' directories + $p->{share_dir} = { dist => $p->{share_dir} }; + } + elsif ( ref $p->{share_dir} eq 'HASH' ) { + # hash -- check structure + my $share_dir = $p->{share_dir}; + # check dist key + if ( defined $share_dir->{dist} ) { + if ( ! ref $share_dir->{dist} ) { + # scalar, so upgrade to arrayref + $share_dir->{dist} = [ $share_dir->{dist} ]; + } + elsif ( ref $share_dir->{dist} ne 'ARRAY' ) { + die "'dist' key in 'share_dir' must be scalar or arrayref"; + } + } + # check module key + if ( defined $share_dir->{module} ) { + my $mod_hash = $share_dir->{module}; + if ( ref $mod_hash eq 'HASH' ) { + for my $k ( keys %$mod_hash ) { + if ( ! ref $mod_hash->{$k} ) { + $mod_hash->{$k} = [ $mod_hash->{$k} ]; + } + elsif( ref $mod_hash->{$k} ne 'ARRAY' ) { + die "modules in 'module' key of 'share_dir' must be scalar or arrayref"; + } + } + } + else { + die "'module' key in 'share_dir' must be hashref"; + } + } + } + else { + die "'share_dir' must be hashref, arrayref or string"; + } + + return $p->{share_dir}; +} + sub script_files { my $self = shift; @@ -3529,13 +4013,13 @@ sub script_files { } my %pl_files = map { - File::Spec->canonpath( File::Spec->case_tolerant ? uc $_ : $_ ) => 1 + File::Spec->canonpath( File::Spec->case_tolerant ? uc $_ : $_ ) => 1 } keys %{ $self->PL_files || {} }; my @bin_files = $self->_files_in('bin'); my %bin_map = map { - $_ => File::Spec->canonpath( File::Spec->case_tolerant ? uc $_ : $_ ) + $_ => File::Spec->canonpath( File::Spec->case_tolerant ? uc $_ : $_ ) } @bin_files; return $_ = { map {$_ => 1} grep !$pl_files{$bin_map{$_}}, @bin_files }; @@ -3546,6 +4030,7 @@ BEGIN { *scripts = \&script_files; } my %licenses = ( perl => 'Perl_5', apache => 'Apache_2_0', + apache_1_1 => 'Apache_1_1', artistic => 'Artistic_1_0', artistic_2 => 'Artistic_2_0', lgpl => 'LGPL_2_1', @@ -3568,6 +4053,7 @@ BEGIN { *scripts = \&script_files; } my %license_urls = ( perl => 'http://dev.perl.org/licenses/', apache => 'http://apache.org/licenses/LICENSE-2.0', + apache_1_1 => 'http://apache.org/licenses/LICENSE-1.1', 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', @@ -3615,10 +4101,10 @@ sub ACTION_distmeta { sub do_create_metafile { my $self = shift; return if $self->{wrote_metadata}; - + my $p = $self->{properties}; my $metafile = $self->metafile; - + unless ($p->{license}) { $self->log_warn("No license specified, setting license = 'unknown'\n"); $p->{license} = 'unknown'; @@ -3639,7 +4125,7 @@ sub do_create_metafile { push @INC, File::Spec->catdir($self->blib, 'lib'); } - if ( $self->write_metafile( $self->metafile, $self->generate_metadata ) ) { + if ( $self->write_metafile( $self->metafile, $self->prepare_metadata( fatal => 1 ) ) ) { $self->{wrote_metadata} = 1; $self->_add_to_manifest('MANIFEST', $metafile); } @@ -3647,42 +4133,22 @@ sub do_create_metafile { return 1; } -sub generate_metadata { - my $self = shift; - my $node = {}; - - if ($self->_mb_feature('YAML_support')) { - require YAML; - require YAML::Node; - # We use YAML::Node to get the order nice in the YAML file. - $self->prepare_metadata( $node = YAML::Node->new({}) ); - } else { - require Module::Build::YAML; - my @order_keys; - $self->prepare_metadata($node, \@order_keys); - $node->{_order} = \@order_keys; - } - return $node; -} - sub write_metafile { my $self = shift; my ($metafile, $node) = @_; + my $yaml; if ($self->_mb_feature('YAML_support')) { # XXX this is probably redundant, but stick with it - require YAML; - require YAML::Node; - delete $node->{_order}; # XXX also probably redundant, but for safety - # YAML API changed after version 0.30 - my $yaml_sub = $YAML::VERSION le '0.30' ? \&YAML::StoreFile : \&YAML::DumpFile; - $yaml_sub->( $metafile, $node ); + require YAML::Tiny; + $yaml = YAML::Tiny->new($node); } else { - # XXX probably redundant require Module::Build::YAML; - &Module::Build::YAML::DumpFile($metafile, $node); + $yaml = Module::Build::YAML->new($node); } - return 1; + my $result = $yaml->write($metafile) + or $self->log_warn( "Error writing '$metafile': " . $yaml->errstr . "\n"); + return $result; } sub normalize_version { @@ -3690,7 +4156,7 @@ sub normalize_version { if ( $version =~ /[=<>!,]/ ) { # logic, not just version # take as is without modification } - elsif ( ref $version eq 'version' || + elsif ( ref $version eq 'version' || ref $version eq 'Module::Build::Version' ) { # version objects $version = $version->is_qv ? $version->normal : $version->stringify; } @@ -3705,31 +4171,46 @@ sub normalize_version { } sub prepare_metadata { - my ($self, $node, $keys) = @_; + my ($self, %args) = @_; + my $fatal = $args{fatal} || 0; my $p = $self->{properties}; + my $node = {}; # A little helper sub my $add_node = sub { my ($name, $val) = @_; $node->{$name} = $val; - push @$keys, $name if $keys; }; foreach (qw(dist_name dist_version dist_author dist_abstract license)) { (my $name = $_) =~ s/^dist_//; $add_node->($name, $self->$_()); - die "ERROR: Missing required field '$_' for META.yml\n" - unless defined($node->{$name}) && length($node->{$name}); + unless ( defined($node->{$name}) && length($node->{$name}) ) { + my $err = "ERROR: Missing required field '$_' for metafile\n"; + if ( $fatal ) { + die $err; + } + else { + $self->log_warn($err); + } + } } - $node->{version} = $self->normalize_version($node->{version}); + $node->{version} = $self->normalize_version($node->{version}); if (defined( my $l = $self->license )) { - die "Unknown license string '$l'" - unless exists $self->valid_licenses->{ $l }; + unless ( exists $self->valid_licenses->{ $l } ) { + my $err = "Unknown license string '$l'"; + if ( $fatal ) { + die $err; + } + else { + $self->log_warn($err); + } + } if (my $key = $self->valid_licenses->{ $l }) { my $class = "Software::License::$key"; - if (eval "use $class; 1") { + if (eval "require Software::License; require $class; 1") { # S::L requires a 'holder' key $node->{resources}{license} = $class->new({holder=>"nobody"})->url; } @@ -3743,24 +4224,14 @@ sub prepare_metadata { # copy prereq data structures so we can modify them before writing to META my %prereq_types; for my $type ( 'configure_requires', @{$self->prereq_action_types} ) { - if (exists $p->{$type}) { + if (exists $p->{$type}) { for my $mod ( keys %{ $p->{$type} } ) { - $prereq_types{$type}{$mod} = + $prereq_types{$type}{$mod} = $self->normalize_version($p->{$type}{$mod}); } } } - # add current Module::Build to configure_requires if there - # isn't one already specified (but not ourself, so we're not circular) - if ( $self->dist_name ne 'Module-Build' - && $self->auto_configure_requires - && ! exists $prereq_types{'configure_requires'}{'Module::Build'} - ) { - (my $ver = $VERSION) =~ s/^(\d+\.\d\d).*$/$1/; # last major release only - $prereq_types{configure_requires}{'Module::Build'} = $ver; - } - for my $t ( keys %prereq_types ) { $add_node->($t, $prereq_types{$t}); } @@ -3771,7 +4242,7 @@ sub prepare_metadata { my $pkgs = eval { $self->find_dist_packages }; if ($@) { $self->log_warn("$@\nWARNING: Possible missing or corrupt 'MANIFEST' file.\n" . - "Nothing to enter for 'provides' field in META.yml\n"); + "Nothing to enter for 'provides' field in metafile.\n"); } else { $node->{provides} = $pkgs if %$pkgs; } @@ -3782,7 +4253,7 @@ sub prepare_metadata { $add_node->('generated_by', "Module::Build version $Module::Build::VERSION"); - $add_node->('meta-spec', + $add_node->('meta-spec', {version => '1.4', url => 'http://module-build.sourceforge.net/META-spec-v1.4.html', }); @@ -3815,21 +4286,28 @@ sub find_dist_packages { # private stock. my $manifest = $self->_read_manifest('MANIFEST') - or die "Can't find dist packages without a MANIFEST file - run 'manifest' action first"; + or die "Can't find dist packages without a MANIFEST file\nRun 'Build manifest' to generate one\n"; # Localize my %dist_files = map { $self->localize_file_path($_) => $_ } keys %$manifest; - my @pm_files = grep {exists $dist_files{$_}} keys %{ $self->find_pm_files }; + my @pm_files = grep { $_ !~ m{^t} } # skip things in t/ + grep {exists $dist_files{$_}} + keys %{ $self->find_pm_files }; + + return $self->find_packages_in_files(\@pm_files, \%dist_files); +} + +sub find_packages_in_files { + my ($self, $file_list, $filename_map) = @_; # First, we enumerate all packages & versions, # separating into primary & alternative candidates my( %prime, %alt ); - foreach my $file (@pm_files) { - next if $dist_files{$file} =~ m{^t/}; # Skip things in t/ - - my @path = split( /\//, $dist_files{$file} ); + foreach my $file (@{$file_list}) { + my $mapped_filename = $filename_map->{$file}; + my @path = split( /\//, $mapped_filename ); (my $prime_package = join( '::', @path[1..$#path] )) =~ s/\.pm$//; my $pm_info = Module::Build::ModuleInfo->new_from_file( $file ); @@ -3841,18 +4319,18 @@ sub find_dist_packages { my $version = $pm_info->version( $package ); if ( $package eq $prime_package ) { - if ( exists( $prime{$package} ) ) { - # M::B::ModuleInfo will handle this conflict - die "Unexpected conflict in '$package'; multiple versions found.\n"; - } else { - $prime{$package}{file} = $dist_files{$file}; + if ( exists( $prime{$package} ) ) { + # M::B::ModuleInfo will handle this conflict + die "Unexpected conflict in '$package'; multiple versions found.\n"; + } else { + $prime{$package}{file} = $mapped_filename; $prime{$package}{version} = $version if defined( $version ); } } else { - push( @{$alt{$package}}, { - file => $dist_files{$file}, - version => $version, - } ); + push( @{$alt{$package}}, { + file => $mapped_filename, + version => $version, + } ); } } } @@ -3972,24 +4450,29 @@ sub _resolve_module_versions { sub make_tarball { my ($self, $dir, $file) = @_; $file ||= $dir; - + $self->log_info("Creating $file.tar.gz\n"); - + if ($self->{args}{tar}) { my $tar_flags = $self->verbose ? 'cvf' : 'cf'; $self->do_system($self->split_like_shell($self->{args}{tar}), $tar_flags, "$file.tar", $dir); $self->do_system($self->split_like_shell($self->{args}{gzip}), "$file.tar") if $self->{args}{gzip}; } else { - eval { require Archive::Tar && Archive::Tar->VERSION(1.08); 1 } - or die "You must install Archive::Tar to make a distribution tarball\n". + eval { require Archive::Tar && Archive::Tar->VERSION(1.09); 1 } + or die "You must install Archive::Tar 1.09+ to make a distribution tarball\n". "or specify a binary tar program with the '--tar' option.\n". "See the documentation for the 'dist' action.\n"; + my $files = $self->rscan_dir($dir); + # 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; + # If no file path is 100 chars or longer, we disable the prefix field + # for maximum compatibility. If there are any long file paths then we + # need the prefix field after all. + $Archive::Tar::DO_NOT_USE_PREFIX = + (grep { length($_) >= 100 } @$files) ? 0 : 1; - my $files = $self->rscan_dir($dir); my $tar = Archive::Tar->new; $tar->add_files(@$files); for my $f ($tar->get_files) { @@ -4055,7 +4538,7 @@ sub original_prefix { # or original_prefix('lib' => $value); my ($self, $key, $value) = @_; # update property before merging with defaults - if ( @_ == 3 && defined $key) { + if ( @_ == 3 && defined $key) { # $value can be undef; will mask default $self->{properties}{original_prefix}{$key} = $value; } @@ -4263,7 +4746,7 @@ sub install_map { } } } - + $map{read} = ''; # To keep ExtUtils::Install quiet return \%map; @@ -4284,7 +4767,7 @@ sub rscan_dir { !ref($pattern) || (ref $pattern eq 'Regexp') ? sub {push @result, $File::Find::name if /$pattern/} : ref($pattern) eq 'CODE' ? sub {push @result, $File::Find::name if $pattern->()} : die "Unknown pattern type"; - + File::Find::find({wanted => $subr, no_chdir => 1}, $dir); return \@result; } @@ -4294,7 +4777,7 @@ sub delete_filetree { my $deleted = 0; foreach (@_) { next unless -e $_; - $self->log_info("Deleting $_\n"); + $self->log_verbose("Deleting $_\n"); File::Path::rmtree($_, 0, 0); die "Couldn't remove '$_': $!\n" if -e $_; $deleted++; @@ -4327,21 +4810,25 @@ sub cbuilder { sub have_c_compiler { my ($self) = @_; - + my $p = $self->{properties}; - return $p->{have_compiler} if defined $p->{have_compiler}; - + return $p->{_have_c_compiler} if defined $p->{_have_c_compiler}; + $self->log_verbose("Checking if compiler tools configured... "); my $b = eval { $self->cbuilder }; - my $have = $b && $b->have_compiler; + my $have = $b && eval { $b->have_compiler }; $self->log_verbose($have ? "ok.\n" : "failed.\n"); - return $p->{have_compiler} = $have; + return $p->{_have_c_compiler} = $have; } sub compile_c { my ($self, $file, %args) = @_; - my $b = $self->cbuilder; + if ( ! $self->have_c_compiler ) { + die "Error: no compiler detected to compile '$file'. Aborting\n"; + } + + my $b = $self->cbuilder; my $obj_file = $b->object_file($file); $self->add_to_cleanup($obj_file); return $obj_file if $self->up_to_date($file, $obj_file); @@ -4381,11 +4868,11 @@ sub link_c { sub compile_xs { my ($self, $file, %args) = @_; - - $self->log_info("$file -> $args{outfile}\n"); + + $self->log_verbose("$file -> $args{outfile}\n"); if (eval {require ExtUtils::ParseXS; 1}) { - + ExtUtils::ParseXS::process_file( filename => $file, prototypes => 0, @@ -4393,26 +4880,26 @@ sub compile_xs { ); } else { # Ok, I give up. Just use backticks. - + my $xsubpp = Module::Build::ModuleInfo->find_module_by_name('ExtUtils::xsubpp') or die "Can't find ExtUtils::xsubpp in INC (@INC)"; - + my @typemaps; push @typemaps, Module::Build::ModuleInfo->find_module_by_name( 'ExtUtils::typemap', \@INC ); my $lib_typemap = Module::Build::ModuleInfo->find_module_by_name( - 'typemap', [File::Basename::dirname($file)] + 'typemap', [File::Basename::dirname($file), File::Spec->rel2abs('.')] ); push @typemaps, $lib_typemap if $lib_typemap; @typemaps = map {+'-typemap', $_} @typemaps; my $cf = $self->{config}; my $perl = $self->{properties}{perl}; - + my @command = ($perl, "-I".$cf->get('installarchlib'), "-I".$cf->get('installprivlib'), $xsubpp, '-noprototypes', @typemaps, $file); - + $self->log_info("@command\n"); my $fh = IO::File->new("> $args{outfile}") or die "Couldn't write $args{outfile}: $!"; print {$fh} $self->_backticks(@command); @@ -4422,12 +4909,12 @@ sub compile_xs { sub split_like_shell { my ($self, $string) = @_; - + return () unless defined($string); return @$string if UNIVERSAL::isa($string, 'ARRAY'); $string =~ s/^\s+|\s+$//g; return () unless length($string); - + return Text::ParseWords::shellwords($string); } @@ -4553,12 +5040,12 @@ sub process_xs { sub do_system { my ($self, @cmd) = @_; - $self->log_info("@cmd\n"); + $self->log_verbose("@cmd\n"); # Some systems proliferate huge PERL5LIBs, try to ameliorate: my %seen; my $sep = $self->config('path_sep'); - local $ENV{PERL5LIB} = + local $ENV{PERL5LIB} = ( !exists($ENV{PERL5LIB}) ? '' : length($ENV{PERL5LIB}) < 500 ? $ENV{PERL5LIB} @@ -4587,8 +5074,8 @@ sub copy_if_modified { unless (defined $file and length $file) { die "No 'from' parameter given to copy_if_modified"; } - - # makes no sense to replicate an absolute path, so assume flatten + + # makes no sense to replicate an absolute path, so assume flatten $args{flatten} = 1 if File::Spec->file_name_is_absolute( $file ); my $to_path; @@ -4601,7 +5088,7 @@ sub copy_if_modified { } else { die "No 'to' or 'to_dir' parameter given to copy_if_modified"; } - + return if $self->up_to_date($file, $to_path); # Already fresh { @@ -4611,9 +5098,9 @@ sub copy_if_modified { # Create parent directories File::Path::mkpath(File::Basename::dirname($to_path), 0, oct(777)); - - $self->log_info("Copying $file -> $to_path\n") if $args{verbose}; - + + $self->log_verbose("Copying $file -> $to_path\n"); + if ($^O eq 'os2') {# copy will not overwrite; 0x1 = overwrite chmod 0666, $to_path; File::Copy::syscopy($file, $to_path, 0x1) or die "Can't copy('$file', '$to_path'): $!"; @@ -4644,7 +5131,7 @@ sub up_to_date { } $most_recent_source = -M _ if -M _ < $most_recent_source; } - + foreach my $derived (@$derived) { return 0 if -M $derived > $most_recent_source; } @@ -4655,21 +5142,21 @@ sub dir_contains { my ($self, $first, $second) = @_; # File::Spec doesn't have an easy way to check whether one directory # is inside another, unfortunately. - + ($first, $second) = map File::Spec->canonpath($_), ($first, $second); my @first_dirs = File::Spec->splitdir($first); my @second_dirs = File::Spec->splitdir($second); return 0 if @second_dirs < @first_dirs; - + my $is_same = ( File::Spec->case_tolerant ? sub {lc(shift()) eq lc(shift())} : sub {shift() eq shift()} ); - + while (@first_dirs) { return 0 unless $is_same->(shift @first_dirs, shift @second_dirs); } - + return 1; } diff --git a/cpan/Module-Build/lib/Module/Build/Bundling.pod b/cpan/Module-Build/lib/Module/Build/Bundling.pod new file mode 100644 index 0000000000..0a60d8f70d --- /dev/null +++ b/cpan/Module-Build/lib/Module/Build/Bundling.pod @@ -0,0 +1,154 @@ +=head1 NAME + +Module::Build::Bundling - How to bundle Module::Build with a distribution + +=head1 SYNOPSIS + + # Build.PL + use lib '.'; + use inc::latest 'Module::Build'; + + Module::Build->new( + module_name => 'Foo::Bar', + license => 'perl', + )->create_build_script; + +=head1 DESCRIPTION + +B<WARNING -- THIS IS AN EXPERIMENTAL FEATURE> + +In order to install a distribution using Module::Build, users must +have Module::Build available on their systems. There are two ways +to do this. The first way is to include Module::Build in the +C<configure_requires> metadata field. This field is supported by +recent versions L<CPAN> and L<CPANPLUS> and is a standard feature +in the Perl core as of Perl 5.10.1. Module::Build now adds itself +to C<configure_requires> by default. + +The second way supports older Perls that have not upgraded CPAN or +CPANPLUS and involves bundling an entire copy of Module::Build +into the distribution's C<inc/> directory. This is the same approach +used by L<Module::Install>, a modern wrapper around ExtUtils::MakeMaker +for Makefile.PL based distributions. + +The "trick" to making this work for Module::Build is making sure the +highest version Module::Build is used, whether this is in C<inc/> or +already installed on the user's system. This ensures that all necessary +features are available as well as any new bug fixes. This is done using +the new L<inc::latest> module. + +A "normal" Build.PL looks like this (with only the minimum required +fields): + + use Module::Build; + + Module::Build->new( + module_name => 'Foo::Bar', + license => 'perl', + )->create_build_script; + +A "bundling" Build.PL replaces the initial "use" line with a nearly +transparent replacement: + + use lib '.'; + use inc::latest 'Module::Build'; + + Module::Build->new( + module_name => 'Foo::Bar', + license => 'perl', + )->create_build_script; + +The inital C<lib> line ensures that the top-level distribution directory is +added to C<@INC> so that C<inc::latest> loads from C<./inc/latest.pm>. You +SHOULD NOT add 'inc' to C<@INC> (unless you have other special reasons for +doing so) -- that's not how C<inc::latest> works. + +For I<authors>, when "Build dist" is run, Module::Build will be +automatically bundled into C<inc> according to the rules for +L<inc::latest>. + +For I<users>, inc::latest will load the latest Module::Build, whether +installed or bundled in C<inc/>. + +=head1 BUNDLING OTHER CONFIGURATION DEPENDENCIES + +The same approach works for other configuration dependencies -- modules +that I<must> be available for Build.PL to run. All other dependencies can +be specified as usual in the Build.PL and CPAN or CPANPLUS will install +them after Build.PL finishes. + +For example, to bundle the L<Devel::AssertOS::Unix> module (which ensures a +"Unix-like" operating system), one could do this: + + use inc::latest 'Devel::AssertOS::Unix'; + use inc::latest 'Module::Build'; + + Module::Build->new( + module_name => 'Foo::Bar', + license => 'perl', + )->create_build_script; + +The C<inc::latest> module creates bundled directories based on the packlist +file of an installed distribution. Even though C<inc::latest> takes module +name arguments, it is better to think of it as bundling and making +available entire I<distributions>. When a module is loaded through +C<inc::latest>, it looks in all bundled distributions in C<inc/> for a +newer module than can be found in the existing C<@INC> array. + +Thus, the module-name provided should usually be the "top-level" module +name of a distribution, though this is not strictly required. For example, +L<Module::Build> has a number of heuristics to map module names to +packlists, allowing users to do things like this: + + use inc::latest 'Devel::AssertOS::Unix'; + +even though Devel::AssertOS::Unix is contained within the Devel-CheckOS +distribution. + +At the current time, packlists are required. Thus, bundling dual-core +modules, I<including Module::Build>, may require a 'forced install' over +versions in the latest version of perl in order to create the necessary +packlist for bundling. This limitation will hopefully be addressed in a +future version of Module::Build. + +=head2 WARNING -- How to Manage Dependency Chains + +Before bundling a distribution you must ensure that all prerequisites are +also bundled and load in the correct order. For Module::Build itself, this +should not be necessary, but it is necessary for any other distribution. +(A future release of Module::Build will hopefully address this deficiency.) + +For example, if you need C<Wibble>, but C<Wibble> depends on C<Wobble>, +your Build.PL might look like this: + + use inc::latest 'Wobble'; + use inc::latest 'Wibble'; + use inc::latest 'Module::Build'; + + Module::Build->new( + module_name => 'Foo::Bar', + license => 'perl', + )->create_build_script; + +Authors are strongly suggested to limit the bundling of additional +dependencies if at all possible and to carefully test their distribution +tarballs on older versions of Perl before uploading to CPAN. + +=head1 AUTHOR + +David Golden <dagolden@cpan.org> + +Development questions, bug reports, and patches should be sent to the +Module-Build mailing list at <module-build@perl.org>. + +Bug reports are also welcome at +<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Module-Build>. + +=head1 SEE ALSO + +perl(1), L<inc::latest>, L<Module::Build>(3), L<Module::Build::API>(3), +L<Module::Build::Cookbook>(3), + +=cut + +# vim: tw=75 diff --git a/cpan/Module-Build/lib/Module/Build/Compat.pm b/cpan/Module-Build/lib/Module/Build/Compat.pm index dfe75d5e1a..ebe1b129cf 100644 --- a/cpan/Module-Build/lib/Module/Build/Compat.pm +++ b/cpan/Module-Build/lib/Module/Build/Compat.pm @@ -2,7 +2,7 @@ package Module::Build::Compat; use strict; use vars qw($VERSION); -$VERSION = '0.35'; +$VERSION = '0.35_08'; use File::Basename (); use File::Spec; @@ -18,7 +18,7 @@ my %convert_installdirs = ( VENDOR => 'vendor', ); -my %makefile_to_build = +my %makefile_to_build = ( TEST_VERBOSE => 'verbose', VERBINST => 'verbose', @@ -64,13 +64,50 @@ my %macro_to_build = %makefile_to_build; # "LIB=foo make" is not the same as "perl Makefile.PL LIB=foo" delete $macro_to_build{LIB}; +sub _simple_prereq { + return $_[0] =~ /^[0-9_]+\.?[0-9_]*$/; # crudly, a decimal literal +} + +sub _merge_prereq { + my ($req, $breq) = @_; + $req ||= {}; + $breq ||= {}; + + # validate formats + for my $p ( $req, $breq ) { + for my $k (keys %$p) { + die "Prereq '$p->{$k}' for '$k' is not supported by Module::Build::Compat\n" + unless _simple_prereq($p->{$k}); + } + } + # merge + my $merge = { %$req }; + for my $k ( keys %$breq ) { + my $v1 = $merge->{$k} || 0; + my $v2 = $breq->{$k}; + $merge->{$k} = $v1 > $v2 ? $v1 : $v2; + } + return %$merge; +} + sub create_makefile_pl { my ($package, $type, $build, %args) = @_; - + die "Don't know how to build Makefile.PL of type '$type'" unless $type =~ /^(small|passthrough|traditional)$/; + if ($type eq 'passthrough') { + $build->log_warn(<<"HERE"); + +IMPORTANT NOTE: The '$type' style of Makefile.PL is deprecated and +may be removed in a future version of Module::Build in favor of the +'configure_requires' property. See Module::Build::Compat +documentation for details. + +HERE + } + my $fh; if ($args{fh}) { $fh = $args{fh}; @@ -83,7 +120,7 @@ sub create_makefile_pl { print {$fh} "# Note: this file was auto-generated by ", __PACKAGE__, " version $VERSION\n"; - # Minimum perl version should be specified as "require 5.XXXXXX" in + # Minimum perl version should be specified as "require 5.XXXXXX" in # Makefile.PL my $requires = $build->requires; if ( my $minimum_perl = $requires->{perl} ) { @@ -123,41 +160,41 @@ EOF } elsif ($type eq 'passthrough') { printf {$fh} <<'EOF', $subclass_load, ref($build), ref($build); - + unless (eval "use Module::Build::Compat 0.02; 1" ) { print "This module requires Module::Build to install itself.\n"; - + require ExtUtils::MakeMaker; my $yn = ExtUtils::MakeMaker::prompt (' Install Module::Build now from CPAN?', 'y'); - + unless ($yn =~ /^y/i) { die " *** Cannot install without Module::Build. Exiting ...\n"; } - + require Cwd; require File::Spec; require CPAN; - + # Save this 'cause CPAN will chdir all over the place. my $cwd = Cwd::cwd(); - + CPAN::Shell->install('Module::Build::Compat'); CPAN::Shell->expand("Module", "Module::Build::Compat")->uptodate or die "Couldn't install Module::Build, giving up.\n"; - + chdir $cwd or die "Cannot chdir() back to $cwd: $!"; } eval "use Module::Build::Compat 0.02; 1" or die $@; %s Module::Build::Compat->run_build_pl(args => \@ARGV); - my $build_script = 'Build'; + my $build_script = 'Build'; $build_script .= '.com' if $^O eq 'VMS'; exit(0) unless(-e $build_script); # cpantesters convention require %s; Module::Build::Compat->write_makefile(build_class => '%s'); EOF - + } elsif ($type eq 'traditional') { my (%MM_Args, %prereq); @@ -165,37 +202,37 @@ EOF tie %MM_Args, 'Tie::IxHash'; # Don't care if it fails here tie %prereq, 'Tie::IxHash'; # Don't care if it fails here } - + my %name = ($build->module_name ? (NAME => $build->module_name) : (DISTNAME => $build->dist_name)); - + my %version = ($build->dist_version_from ? (VERSION_FROM => $build->dist_version_from) : (VERSION => $build->dist_version) ); %MM_Args = (%name, %version); - - %prereq = ( %{$build->requires}, %{$build->build_requires} ); + + %prereq = _merge_prereq( $build->requires, $build->build_requires ); %prereq = map {$_, $prereq{$_}} sort keys %prereq; - + delete $prereq{perl}; $MM_Args{PREREQ_PM} = \%prereq; - + $MM_Args{INSTALLDIRS} = $build->installdirs eq 'core' ? 'perl' : $build->installdirs; - + $MM_Args{EXE_FILES} = [ sort keys %{$build->script_files} ] if $build->script_files; - + $MM_Args{PL_FILES} = $build->PL_files || {}; if ($build->recursive_test_files) { - $MM_Args{TESTS} = join q{ }, $package->_test_globs($build); + $MM_Args{test} = { TESTS => join q{ }, $package->_test_globs($build) }; } local $Data::Dumper::Terse = 1; my $args = Data::Dumper::Dumper(\%MM_Args); $args =~ s/\{(.*)\}/($1)/s; - + print $fh <<"EOF"; use ExtUtils::MakeMaker; WriteMakefile @@ -213,7 +250,7 @@ sub _test_globs { sub subclass_dir { my ($self, $build) = @_; - + return (Module::Build::ModuleInfo->find_module_dir_by_name(ref $build) || File::Spec->catdir($build->config_dir, 'lib')); } @@ -228,7 +265,7 @@ sub makefile_to_build_args { my @out; foreach my $arg (@_) { next if $arg eq ''; - + my ($key, $val) = ($arg =~ /^(\w+)=(.+)/ ? ($1, $2) : die "Malformed argument '$arg'"); @@ -283,7 +320,7 @@ sub makefile_to_build_macros { } } } - push @out, (config => \%config) if %config; + push @out, (config => \%config) if %config; return @out; } @@ -342,19 +379,19 @@ $action : force_do_it $perl $Build $action EOF } - + if ($self->_is_vms_mms) { # Roll our own .EXPORT as MMS/MMK don't honor that directive. - $maketext .= "\n.FIRST\n\t\@ $noop\n"; + $maketext .= "\n.FIRST\n\t\@ $noop\n"; for my $macro (keys %macro_to_build) { $maketext .= ".IFDEF $macro\n\tDEFINE $macro \"\$($macro)\"\n.ENDIF\n"; } - $maketext .= "\n"; + $maketext .= "\n"; } else { $maketext .= "\n.EXPORT : " . join(' ', keys %macro_to_build) . "\n\n"; } - + return $maketext; } @@ -363,15 +400,13 @@ sub fake_prereqs { my $fh = IO::File->new("< $file") or die "Can't read $file: $!"; my $prereqs = eval do {local $/; <$fh>}; close $fh; - + + my %merged = _merge_prereq( $prereqs->{requires}, $prereqs->{build_requires} ); my @prereq; - foreach my $section (qw/build_requires requires/) { - foreach (keys %{$prereqs->{$section}}) { - next if $_ eq 'perl'; - push @prereq, "$_=>q[$prereqs->{$section}{$_}]"; - } + foreach (sort keys %merged) { + next if $_ eq 'perl'; + push @prereq, "$_=>q[$merged{$_}]"; } - return unless @prereq; return "# PREREQ_PM => { " . join(", ", @prereq) . " }\n\n"; } @@ -414,7 +449,7 @@ Module::Build::Compat - Compatibility with ExtUtils::MakeMaker my $build = Module::Build->new ( module_name => 'Foo::Bar', license => 'perl', - create_makefile_pl => 'passthrough' ); + create_makefile_pl => 'traditional' ); ... @@ -448,6 +483,18 @@ The currently supported styles are: =over 4 +=item traditional + +A F<Makefile.PL> will be created in the "traditional" style, i.e. it will +use C<ExtUtils::MakeMaker> and won't rely on C<Module::Build> at all. +In order to create the F<Makefile.PL>, we'll include the C<requires> and +C<build_requires> dependencies as the C<PREREQ_PM> parameter. + +You don't want to use this style if during the C<perl Build.PL> stage +you ask the user questions, or do some auto-sensing about the user's +environment, or if you subclass C<Module::Build> to do some +customization, because the vanilla F<Makefile.PL> won't do any of that. + =item small A small F<Makefile.PL> will be created that passes all functionality @@ -455,24 +502,22 @@ through to the F<Build.PL> script in the same directory. The user must already have C<Module::Build> installed in order to use this, or else they'll get a module-not-found error. -=item passthrough +=item passthrough (DEPRECATED) This is just like the C<small> option above, but if C<Module::Build> is not already installed on the user's system, the script will offer to use C<CPAN.pm> to download it and install it before continuing with the build. -=item traditional - -A F<Makefile.PL> will be created in the "traditional" style, i.e. it will -use C<ExtUtils::MakeMaker> and won't rely on C<Module::Build> at all. -In order to create the F<Makefile.PL>, we'll include the C<requires> and -C<build_requires> dependencies as the C<PREREQ_PM> parameter. +This option has been deprecated and may be removed in a future version +of Module::Build. Modern CPAN.pm and CPANPLUS will recognize the +C<configure_requires> metadata property and install Module::Build before +running Build.PL if Module::Build is listed and Module::Build now +adds itself to configure_requires by default. -You don't want to use this style if during the C<perl Build.PL> stage -you ask the user questions, or do some auto-sensing about the user's -environment, or if you subclass C<Module::Build> to do some -customization, because the vanilla F<Makefile.PL> won't do any of that. +Perl 5.10.1 includes C<configure_requires> support. In the future, when +C<configure_requires> support is deemed sufficiently widespread, the +C<passthrough> style will be removed. =back diff --git a/cpan/Module-Build/lib/Module/Build/Config.pm b/cpan/Module-Build/lib/Module/Build/Config.pm index de8b44d092..b833e2b183 100644 --- a/cpan/Module-Build/lib/Module/Build/Config.pm +++ b/cpan/Module-Build/lib/Module/Build/Config.pm @@ -2,7 +2,7 @@ package Module::Build::Config; use strict; use vars qw($VERSION); -$VERSION = '0.35'; +$VERSION = '0.35_08'; $VERSION = eval $VERSION; use Config; diff --git a/cpan/Module-Build/lib/Module/Build/Cookbook.pm b/cpan/Module-Build/lib/Module/Build/Cookbook.pm index 82c8e01d67..42054d1744 100644 --- a/cpan/Module-Build/lib/Module/Build/Cookbook.pm +++ b/cpan/Module-Build/lib/Module/Build/Cookbook.pm @@ -1,7 +1,7 @@ package Module::Build::Cookbook; use strict; use vars qw($VERSION); -$VERSION = '0.35'; +$VERSION = '0.35_08'; =head1 NAME @@ -487,7 +487,7 @@ Next, add this to the top of your F<Build.PL>. # Find out what version of Module::Build is installed or fail quietly. # This should be cross-platform. - my $Installed_MB = + 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. diff --git a/cpan/Module-Build/lib/Module/Build/Dumper.pm b/cpan/Module-Build/lib/Module/Build/Dumper.pm index 1cd8cd0e16..6f8ff7a616 100644 --- a/cpan/Module-Build/lib/Module/Build/Dumper.pm +++ b/cpan/Module-Build/lib/Module/Build/Dumper.pm @@ -1,7 +1,7 @@ package Module::Build::Dumper; use strict; use vars qw($VERSION); -$VERSION = '0.35'; +$VERSION = '0.35_08'; # This is just a split-out of a wrapper function to do Data::Dumper # stuff "the right way". See: diff --git a/cpan/Module-Build/lib/Module/Build/ModuleInfo.pm b/cpan/Module-Build/lib/Module/Build/ModuleInfo.pm index 4de09b4c68..12ffa1d711 100644 --- a/cpan/Module-Build/lib/Module/Build/ModuleInfo.pm +++ b/cpan/Module-Build/lib/Module/Build/ModuleInfo.pm @@ -8,13 +8,14 @@ package Module::Build::ModuleInfo; use strict; use vars qw($VERSION); -$VERSION = '0.35'; +$VERSION = '0.35_08'; $VERSION = eval $VERSION; use File::Spec; use IO::File; use Module::Build::Version; +my $V_NUM_REGEXP = qr{v?[0-9._]+}; # crudely, a v-string or decimal my $PKG_REGEXP = qr{ # match a package declaration ^[\s\{;]* # intro chars on a line @@ -22,6 +23,8 @@ my $PKG_REGEXP = qr{ # match a package declaration \s+ # whitespace ([\w:]+) # a package name \s* # optional whitespace + ($V_NUM_REGEXP)? # optional version number + \s* # optional whitesapce ; # semicolon line terminator }x; @@ -221,10 +224,10 @@ sub _parse_fh { $self->_parse_version_expression( $line ); if ( $line =~ $PKG_REGEXP ) { - $pkg = $1; - push( @pkgs, $pkg ) unless grep( $pkg eq $_, @pkgs ); - $vers{$pkg} = undef unless exists( $vers{$pkg} ); - $need_vers = 1; + $pkg = $1; + push( @pkgs, $pkg ) unless grep( $pkg eq $_, @pkgs ); + $vers{$pkg} = (defined $2 ? $2 : undef) unless exists( $vers{$pkg} ); + $need_vers = defined $2 ? 0 : 1; # VERSION defined with full package spec, i.e. $Module::VERSION } elsif ( $vers_fullname && $vers_pkg ) { @@ -232,7 +235,7 @@ sub _parse_fh { $need_vers = 0 if $vers_pkg eq $pkg; unless ( defined $vers{$vers_pkg} && length $vers{$vers_pkg} ) { - $vers{$vers_pkg} = + $vers{$vers_pkg} = $self->_evaluate_version_line( $vers_sig, $vers_fullname, $line ); } else { # Warn unless the user is using the "$VERSION = eval @@ -323,11 +326,22 @@ sub _evaluate_version_line { (ref($vsub) eq 'CODE') or die "failed to build version sub for $self->{filename}"; my $result = eval { $vsub->() }; + die "Could not get version from $self->{filename} by executing:\n$eval\n\nThe fatal error was: $@\n" + if $@; - die "Could not get version from $self->{filename} by executing:\n$eval\n\nThe fatal error was: $@\n" if $@; + # Activestate apparently creates custom versions like '1.23_45_01', which + # cause M::B::Version to think it's an invalid alpha. So check for that + # and strip them + my $num_dots = () = $result =~ m{\.}g; + my $num_unders = () = $result =~ m{_}g; + if ( substr($result,0,1) ne 'v' && $num_dots < 2 && $num_unders > 1 ) { + $result =~ s{_}{}g; + } # Bless it into our own version class - $result = Module::Build::Version->new($result); + eval { $result = Module::Build::Version->new($result) }; + die "Version '$result' from $self->{filename} does not appear to be valid:\n$eval\n\nThe fatal error was: $@\n" + if $@; return $result; } diff --git a/cpan/Module-Build/lib/Module/Build/Notes.pm b/cpan/Module-Build/lib/Module/Build/Notes.pm index fe98419759..a0506c64dc 100644 --- a/cpan/Module-Build/lib/Module/Build/Notes.pm +++ b/cpan/Module-Build/lib/Module/Build/Notes.pm @@ -4,7 +4,7 @@ package Module::Build::Notes; use strict; use vars qw($VERSION); -$VERSION = '0.35'; +$VERSION = '0.35_08'; $VERSION = eval $VERSION; use Data::Dumper; use IO::File; @@ -33,10 +33,10 @@ sub restore { sub access { my $self = shift; return $self->read() unless @_; - + my $key = shift; return $self->read($key) unless @_; - + my $value = shift; $self->write({ $key => $value }); return $self->read($key); @@ -61,7 +61,7 @@ sub read { return $self->{new}{$key} if exists $self->{new}{$key}; return $self->{disk}{$key}; } - + # Return all data my $out = (keys %{$self->{new}} ? {%{$self->{disk}}, %{$self->{new}}} @@ -79,7 +79,7 @@ sub _same { sub write { my ($self, $href) = @_; $href ||= {}; - + @{$self->{new}}{ keys %$href } = values %$href; # Merge # Do some optimization to avoid unnecessary writes @@ -88,17 +88,17 @@ sub write { next if ref $self->{disk}{$key} or !exists $self->{disk}{$key}; delete $self->{new}{$key} if $self->_same($self->{new}{$key}, $self->{disk}{$key}); } - + if (my $file = $self->{file}) { my ($vol, $dir, $base) = File::Spec->splitpath($file); $dir = File::Spec->catpath($vol, $dir, ''); return unless -e $dir && -d $dir; # The user needs to arrange for this return if -e $file and !keys %{ $self->{new} }; # Nothing to do - - @{$self->{disk}}{ keys %{$self->{new}} } = values %{$self->{new}}; # Merge + + @{$self->{disk}}{ keys %{$self->{new}} } = values %{$self->{new}}; # Merge $self->_dump($file, $self->{disk}); - + $self->{new} = {}; } return $self->read; @@ -106,18 +106,66 @@ sub write { sub _dump { my ($self, $file, $data) = @_; - + my $fh = IO::File->new("> $file") or die "Can't create '$file': $!"; print {$fh} Module::Build::Dumper->_data_dump($data); } +my $orig_template = do { local $/; <DATA> }; +close DATA; + sub write_config_data { my ($self, %args) = @_; + my $template = $orig_template; + $template =~ s/NOTES_NAME/$args{config_module}/g; + $template =~ s/MODULE_NAME/$args{module}/g; + $template =~ s/=begin private\n//; + $template =~ s/=end private/=cut/; + + # strip out private POD markers we use to keep pod from being + # recognized for *this* source file + $template =~ s{$_\n}{} for '=begin private', '=end private'; + my $fh = IO::File->new("> $args{file}") or die "Can't create '$args{file}': $!"; + print {$fh} $template; + print {$fh} "\n__DATA__\n"; + print {$fh} Module::Build::Dumper->_data_dump([$args{config_data}, $args{feature}, $args{auto_features}]); + +} + +1; + + +=head1 NAME + +Module::Build::Notes - Create persistent distribution configuration modules + +=head1 DESCRIPTION + +This module is used internally by Module::Build to create persistent +configuration files that can be installed with a distribution. See +L<Module::Build::ConfigData> for an example. + +=head1 AUTHOR - printf $fh <<'EOF', $args{config_module}; -package %s; +Ken Williams <kwilliams@cpan.org> + +=head1 COPYRIGHT + +Copyright (c) 2001-2006 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. + +=head1 SEE ALSO + +perl(1), L<Module::Build>(3) + +=cut + +__DATA__ +package NOTES_NAME; use strict; my $arrayref = eval do {local $/; <DATA>} or die "Couldn't load ConfigData data: $@"; @@ -129,14 +177,14 @@ sub config { $config->{$_[1]} } sub set_config { $config->{$_[1]} = $_[2] } sub set_feature { $features->{$_[1]} = 0+!!$_[2] } # Constrain to 1 or 0 -sub auto_feature_names { grep !exists $features->{$_}, keys %%$auto_features } +sub auto_feature_names { grep !exists $features->{$_}, keys %$auto_features } sub feature_names { - my @features = (keys %%$features, auto_feature_names()); + my @features = (keys %$features, auto_feature_names()); @features; } -sub config_names { keys %%$config } +sub config_names { keys %$config } sub write { my $me = __FILE__; @@ -170,20 +218,20 @@ sub write { sub feature { my ($package, $key) = @_; return $features->{$key} if exists $features->{$key}; - + my $info = $auto_features->{$key} or return 0; - - # Under perl 5.005, each(%%$foo) isn't working correctly when $foo + + # Under perl 5.005, each(%$foo) isn't working correctly when $foo # was reanimated with Data::Dumper and eval(). Not sure why, but # copying to a new hash seems to solve it. - my %%info = %%$info; - + my %info = %$info; + require Module::Build; # XXX should get rid of this - while (my ($type, $prereqs) = each %%info) { + while (my ($type, $prereqs) = each %info) { next if $type eq 'description' || $type eq 'recommends'; - - my %%p = %%$prereqs; # Ditto here. - while (my ($modname, $spec) = each %%p) { + + my %p = %$prereqs; # Ditto here. + while (my ($modname, $spec) = each %p) { my $status = Module::Build->check_installed_status($modname, $spec); if ((!$status->{ok}) xor ($type =~ /conflicts$/)) { return 0; } if ( ! eval "require $modname; 1" ) { return 0; } @@ -192,36 +240,32 @@ sub feature { return 1; } -EOF - - my ($module_name, $notes_name) = ($args{module}, $args{config_module}); - printf $fh <<"EOF", $notes_name, $module_name; +=begin private =head1 NAME -$notes_name - Configuration for $module_name - +NOTES_NAME - Configuration for MODULE_NAME =head1 SYNOPSIS - use $notes_name; - \$value = $notes_name->config('foo'); - \$value = $notes_name->feature('bar'); - - \@names = $notes_name->config_names; - \@names = $notes_name->feature_names; - - $notes_name->set_config(foo => \$new_value); - $notes_name->set_feature(bar => \$new_value); - $notes_name->write; # Save changes + use NOTES_NAME; + $value = NOTES_NAME->config('foo'); + $value = NOTES_NAME->feature('bar'); + + @names = NOTES_NAME->config_names; + @names = NOTES_NAME->feature_names; + + NOTES_NAME->set_config(foo => $new_value); + NOTES_NAME->set_feature(bar => $new_value); + NOTES_NAME->write; # Save changes =head1 DESCRIPTION -This module holds the configuration data for the C<$module_name> +This module holds the configuration data for the C<MODULE_NAME> module. It also provides a programmatic interface for getting or setting that configuration data. Note that in order to actually make -changes, you'll have to have write access to the C<$notes_name> +changes, you'll have to have write access to the C<NOTES_NAME> module, and you should attempt to understand the repercussions of your actions. @@ -230,17 +274,17 @@ actions. =over 4 -=item config(\$name) +=item config($name) Given a string argument, returns the value of the configuration item by that name, or C<undef> if no such item exists. -=item feature(\$name) +=item feature($name) Given a string argument, returns the value of the feature by that name, or C<undef> if no such feature exists. -=item set_config(\$name, \$value) +=item set_config($name, $value) Sets the configuration item with the given name to the given value. The value may be any Perl scalar that will serialize correctly using @@ -248,7 +292,7 @@ C<Data::Dumper>. This includes references, objects (usually), and complex data structures. It probably does not include transient things like filehandles or sockets. -=item set_feature(\$name, \$value) +=item set_feature($name, $value) Sets the feature with the given name to the given boolean value. The value will be converted to 0 or 1 automatically. @@ -256,12 +300,12 @@ value will be converted to 0 or 1 automatically. =item config_names() Returns a list of all the names of config items currently defined in -C<$notes_name>, or in scalar context the number of items. +C<NOTES_NAME>, or in scalar context the number of items. =item feature_names() Returns a list of all the names of features currently defined in -C<$notes_name>, or in scalar context the number of features. +C<NOTES_NAME>, or in scalar context the number of features. =item auto_feature_names() @@ -273,24 +317,16 @@ a fixed value. =item write() Commits any changes from C<set_config()> and C<set_feature()> to disk. -Requires write access to the C<$notes_name> module. +Requires write access to the C<NOTES_NAME> module. =back =head1 AUTHOR -C<$notes_name> was automatically created using C<Module::Build>. +C<NOTES_NAME> was automatically created using C<Module::Build>. C<Module::Build> was written by Ken Williams, but he holds no -authorship claim or copyright claim to the contents of C<$notes_name>. - -=cut +authorship claim or copyright claim to the contents of C<NOTES_NAME>. -__DATA__ - -EOF - - print {$fh} Module::Build::Dumper->_data_dump([$args{config_data}, $args{feature}, $args{auto_features}]); -} +=end private -1; diff --git a/cpan/Module-Build/lib/Module/Build/PPMMaker.pm b/cpan/Module-Build/lib/Module/Build/PPMMaker.pm index 35b5a75317..74a5a73b07 100644 --- a/cpan/Module-Build/lib/Module/Build/PPMMaker.pm +++ b/cpan/Module-Build/lib/Module/Build/PPMMaker.pm @@ -1,8 +1,9 @@ package Module::Build::PPMMaker; use strict; +use Config; use vars qw($VERSION); -$VERSION = '0.35'; +$VERSION = '0.35_08'; $VERSION = eval $VERSION; # This code is mostly borrowed from ExtUtils::MM_Unix 6.10_03, with a @@ -34,7 +35,6 @@ sub make_ppd { my $method = "dist_$info"; $dist{$info} = $build->$method() or die "Can't determine distribution's $info\n"; } - $dist{version} = $self->_ppd_version($dist{version}); $self->_simple_xml_escape($_) foreach $dist{abstract}, @{$dist{author}}; @@ -42,21 +42,17 @@ sub make_ppd { # various licenses my $ppd = <<"PPD"; <SOFTPKG NAME=\"$dist{name}\" VERSION=\"$dist{version}\"> - <TITLE>$dist{name}</TITLE> <ABSTRACT>$dist{abstract}</ABSTRACT> @{[ join "\n", map " <AUTHOR>$_</AUTHOR>", @{$dist{author}} ]} <IMPLEMENTATION> PPD - # TODO: We could set <IMPLTYPE VALUE="PERL" /> or maybe - # <IMPLTYPE VALUE="PERL/XS" /> ??? - # We don't include recommended dependencies because PPD has no way # to distinguish them from normal dependencies. We don't include # build_requires dependencies because the PPM installer doesn't # build or test before installing. And obviously we don't include # conflicts either. - + foreach my $type (qw(requires)) { my $prereq = $build->$type(); while (my ($modname, $spec) = each %$prereq) { @@ -73,27 +69,18 @@ PPD } } - # Another hack - dependencies are on modules, but PPD expects - # them to be on distributions (I think). - $modname =~ s/::/-/g; - - $ppd .= sprintf(<<'EOF', $modname, $self->_ppd_version($min_version)); - <DEPENDENCY NAME="%s" VERSION="%s" /> -EOF + # PPM4 spec requires a '::' for top level modules + $modname .= '::' unless $modname =~ /::/; + $ppd .= qq! <REQUIRE NAME="$modname" VERSION="$min_version" />\n!; } } # We only include these tags if this module involves XS, on the - # assumption that pure Perl modules will work on any OS. PERLCORE, - # unfortunately, seems to indicate that a module works with _only_ - # that version of Perl, and so is only appropriate when a module - # uses XS. + # assumption that pure Perl modules will work on any OS. if (keys %{$build->find_xs_files}) { my $perl_version = $self->_ppd_version($build->perl_version); - $ppd .= sprintf(<<'EOF', $perl_version, $^O, $self->_varchname($build->config) ); - <PERLCORE VERSION="%s" /> - <OS NAME="%s" /> + $ppd .= sprintf(<<'EOF', $self->_varchname($build->config) ); <ARCHITECTURE NAME="%s" /> EOF } @@ -113,7 +100,9 @@ EOF my $ppd_file = "$dist{name}.ppd"; my $fh = IO::File->new(">$ppd_file") or die "Cannot write to $ppd_file: $!"; - $fh->binmode(":utf8") if $fh->can("binmode"); + + $fh->binmode(":utf8") + if $fh->can('binmode') && $] >= 5.008 && $Config{useperlio}; print $fh $ppd; close $fh; @@ -148,7 +137,7 @@ sub _varchname { # Copied from PPM.pm '<' => '<', ); my $rx = join '|', keys %escapes; - + sub _simple_xml_escape { $_[1] =~ s/($rx)/$escapes{$1}/go; } diff --git a/cpan/Module-Build/lib/Module/Build/Platform/Amiga.pm b/cpan/Module-Build/lib/Module/Build/Platform/Amiga.pm index 5ce8cf58a2..b31a9635ec 100644 --- a/cpan/Module-Build/lib/Module/Build/Platform/Amiga.pm +++ b/cpan/Module-Build/lib/Module/Build/Platform/Amiga.pm @@ -2,7 +2,7 @@ package Module::Build::Platform::Amiga; use strict; use vars qw($VERSION); -$VERSION = '0.35'; +$VERSION = '0.35_08'; $VERSION = eval $VERSION; use Module::Build::Base; diff --git a/cpan/Module-Build/lib/Module/Build/Platform/Default.pm b/cpan/Module-Build/lib/Module/Build/Platform/Default.pm index df29af5f68..b0e83a3d73 100644 --- a/cpan/Module-Build/lib/Module/Build/Platform/Default.pm +++ b/cpan/Module-Build/lib/Module/Build/Platform/Default.pm @@ -2,7 +2,7 @@ package Module::Build::Platform::Default; use strict; use vars qw($VERSION); -$VERSION = '0.35'; +$VERSION = '0.35_08'; $VERSION = eval $VERSION; use Module::Build::Base; diff --git a/cpan/Module-Build/lib/Module/Build/Platform/EBCDIC.pm b/cpan/Module-Build/lib/Module/Build/Platform/EBCDIC.pm index d68836c1a3..4365b12b31 100644 --- a/cpan/Module-Build/lib/Module/Build/Platform/EBCDIC.pm +++ b/cpan/Module-Build/lib/Module/Build/Platform/EBCDIC.pm @@ -2,7 +2,7 @@ package Module::Build::Platform::EBCDIC; use strict; use vars qw($VERSION); -$VERSION = '0.35'; +$VERSION = '0.35_08'; $VERSION = eval $VERSION; use Module::Build::Base; diff --git a/cpan/Module-Build/lib/Module/Build/Platform/MPEiX.pm b/cpan/Module-Build/lib/Module/Build/Platform/MPEiX.pm index a835c30d49..c7353783dd 100644 --- a/cpan/Module-Build/lib/Module/Build/Platform/MPEiX.pm +++ b/cpan/Module-Build/lib/Module/Build/Platform/MPEiX.pm @@ -2,7 +2,7 @@ package Module::Build::Platform::MPEiX; use strict; use vars qw($VERSION); -$VERSION = '0.35'; +$VERSION = '0.35_08'; $VERSION = eval $VERSION; use Module::Build::Base; diff --git a/cpan/Module-Build/lib/Module/Build/Platform/MacOS.pm b/cpan/Module-Build/lib/Module/Build/Platform/MacOS.pm index 9c9281adac..2c74942857 100644 --- a/cpan/Module-Build/lib/Module/Build/Platform/MacOS.pm +++ b/cpan/Module-Build/lib/Module/Build/Platform/MacOS.pm @@ -2,7 +2,7 @@ package Module::Build::Platform::MacOS; use strict; use vars qw($VERSION); -$VERSION = '0.35'; +$VERSION = '0.35_08'; $VERSION = eval $VERSION; use Module::Build::Base; use vars qw(@ISA); @@ -15,17 +15,17 @@ sub have_forkpipe { 0 } sub new { my $class = shift; my $self = $class->SUPER::new(@_); - + # $Config{sitelib} and $Config{sitearch} are, unfortunately, missing. foreach ('sitelib', 'sitearch') { $self->config($_ => $self->config("install$_")) unless $self->config($_); } - + # For some reason $Config{startperl} is filled with a bunch of crap. (my $sp = $self->config('startperl')) =~ s/.*Exit \{Status\}\s//; $self->config(startperl => $sp); - + return $self; } @@ -42,7 +42,7 @@ sub dispatch { if( !@_ and !@ARGV ) { require MacPerl; - + # What comes first in the action list. my @action_list = qw(build test install); my %actions = map {+($_, 1)} $self->known_actions; @@ -53,17 +53,17 @@ sub dispatch { foreach (@action_list) { $_ .= ' *' if $toolserver{$_}; } - + my $cmd = MacPerl::Pick("What build command? ('*' requires ToolServer)", @action_list); return unless defined $cmd; $cmd =~ s/ \*$//; $ARGV[0] = ($cmd); - + my $args = MacPerl::Ask('Any extra arguments? (ie. verbose=1)', ''); return unless defined $args; push @ARGV, $self->split_like_shell($args); } - + $self->SUPER::dispatch(@_); } @@ -82,10 +82,10 @@ sub ACTION_realclean { sub ACTION_install { my $self = shift; - + return $self->SUPER::ACTION_install(@_) if eval {ExtUtils::Install->VERSION('1.30'); 1}; - + local $^W = 0; # Avoid a 'redefine' warning local *ExtUtils::Install::find = sub { my ($code, @dirs) = @_; @@ -94,7 +94,7 @@ sub ACTION_install { return File::Find::find($code, @dirs); }; - + return $self->SUPER::ACTION_install(@_); } diff --git a/cpan/Module-Build/lib/Module/Build/Platform/RiscOS.pm b/cpan/Module-Build/lib/Module/Build/Platform/RiscOS.pm index c240750c46..9deb097963 100644 --- a/cpan/Module-Build/lib/Module/Build/Platform/RiscOS.pm +++ b/cpan/Module-Build/lib/Module/Build/Platform/RiscOS.pm @@ -2,7 +2,7 @@ package Module::Build::Platform::RiscOS; use strict; use vars qw($VERSION); -$VERSION = '0.35'; +$VERSION = '0.35_08'; $VERSION = eval $VERSION; use Module::Build::Base; diff --git a/cpan/Module-Build/lib/Module/Build/Platform/Unix.pm b/cpan/Module-Build/lib/Module/Build/Platform/Unix.pm index 879ca3ad4e..43f585fd4f 100644 --- a/cpan/Module-Build/lib/Module/Build/Platform/Unix.pm +++ b/cpan/Module-Build/lib/Module/Build/Platform/Unix.pm @@ -2,7 +2,7 @@ package Module::Build::Platform::Unix; use strict; use vars qw($VERSION); -$VERSION = '0.35'; +$VERSION = '0.35_08'; $VERSION = eval $VERSION; use Module::Build::Base; diff --git a/cpan/Module-Build/lib/Module/Build/Platform/VMS.pm b/cpan/Module-Build/lib/Module/Build/Platform/VMS.pm index 3305154b2d..13d350d8ff 100644 --- a/cpan/Module-Build/lib/Module/Build/Platform/VMS.pm +++ b/cpan/Module-Build/lib/Module/Build/Platform/VMS.pm @@ -2,7 +2,7 @@ package Module::Build::Platform::VMS; use strict; use vars qw($VERSION); -$VERSION = '0.35'; +$VERSION = '0.35_08'; $VERSION = eval $VERSION; use Module::Build::Base; @@ -131,22 +131,22 @@ sub _quote_args { # or if we get a single arg that is an array reference, quote the # elements of it and return the reference. my ($self, @args) = @_; - my $got_arrayref = (scalar(@args) == 1 - && UNIVERSAL::isa($args[0], 'ARRAY')) - ? 1 + my $got_arrayref = (scalar(@args) == 1 + && UNIVERSAL::isa($args[0], 'ARRAY')) + ? 1 : 0; # Do not quote qualifiers that begin with '/'. - map { if (!/^\//) { + map { if (!/^\//) { $_ =~ s/\"/""/g; # escape C<"> by doubling $_ = q(").$_.q("); } } - ($got_arrayref ? @{$args[0]} + ($got_arrayref ? @{$args[0]} : @args ); - return $got_arrayref ? $args[0] + return $got_arrayref ? $args[0] : join(' ', @args); } @@ -173,6 +173,62 @@ sub _backticks { return `$cmd $args`; } +=item find_command + +Local an executable program + +=cut + +sub find_command { + my ($self, $command) = @_; + + # a lot of VMS executables have a symbol defined + # check those first + if ( $^O eq 'VMS' ) { + require VMS::DCLsym; + my $syms = VMS::DCLsym->new; + return $command if scalar $syms->getsym( uc $command ); + } + + $self->SUPER::find_command($command); +} + +# _maybe_command copied from ExtUtils::MM_VMS::maybe_command + +=item _maybe_command (override) + +Follows VMS naming conventions for executable files. +If the name passed in doesn't exactly match an executable file, +appends F<.Exe> (or equivalent) to check for executable image, and F<.Com> +to check for DCL procedure. If this fails, checks directories in DCL$PATH +and finally F<Sys$System:> for an executable file having the name specified, +with or without the F<.Exe>-equivalent suffix. + +=cut + +sub _maybe_command { + my($self,$file) = @_; + return $file if -x $file && ! -d _; + my(@dirs) = (''); + my(@exts) = ('',$Config{'exe_ext'},'.exe','.com'); + + if ($file !~ m![/:>\]]!) { + for (my $i = 0; defined $ENV{"DCL\$PATH;$i"}; $i++) { + my $dir = $ENV{"DCL\$PATH;$i"}; + $dir .= ':' unless $dir =~ m%[\]:]$%; + push(@dirs,$dir); + } + push(@dirs,'Sys$System:'); + foreach my $dir (@dirs) { + my $sysfile = "$dir$file"; + foreach my $ext (@exts) { + return $file if -x "$sysfile$ext" && ! -d _; + } + } + } + return; +} + =item do_system Override to ensure that we quote the arguments but not the command. @@ -182,7 +238,7 @@ Override to ensure that we quote the arguments but not the command. sub do_system { # The command must not be quoted but the arguments to it must be. my ($self, @cmd) = @_; - $self->log_info("@cmd\n"); + $self->log_verbose("@cmd\n"); my $cmd = shift @cmd; my $args = $self->_quote_args(@cmd); return !system("$cmd $args"); @@ -205,7 +261,7 @@ sub oneliner { =item _infer_xs_spec -Inherit the standard version but tweak the library file name to be +Inherit the standard version but tweak the library file name to be something Dynaloader can find. =cut @@ -250,7 +306,7 @@ sub rscan_dir { =item dist_dir -Inherit the standard version but replace embedded dots with underscores because +Inherit the standard version but replace embedded dots with underscores because a dot is the directory delimiter on VMS. =cut @@ -265,7 +321,7 @@ sub dist_dir { =item man3page_name -Inherit the standard version but chop the extra manpage delimiter off the front if +Inherit the standard version but chop the extra manpage delimiter off the front if there is one. The VMS version of splitdir('[.foo]') returns '', 'foo'. =cut @@ -367,7 +423,7 @@ sub _detildefy { $newdirs = File::Spec::Unix->catdir(@hdirs, @backup, @dirs); } - + # Now put the two cases back together $arg = File::Spec::Unix->catpath($hvol, $newdirs, $file); @@ -446,7 +502,7 @@ sub _unix_rpt { $unix_rpt = VMS::Feature::current("filename_unix_report"); } else { my $env_unix_rpt = $ENV{'DECC$FILENAME_UNIX_REPORT'} || ''; - $unix_rpt = $env_unix_rpt =~ /^[ET1]/i; + $unix_rpt = $env_unix_rpt =~ /^[ET1]/i; } return $unix_rpt; } @@ -459,7 +515,7 @@ sub _efs { $efs = VMS::Feature::current("efs_charset"); } else { my $env_efs = $ENV{'DECC$EFS_CHARSET'} || ''; - $efs = $env_efs =~ /^[ET1]/i; + $efs = $env_efs =~ /^[ET1]/i; } return $efs; } diff --git a/cpan/Module-Build/lib/Module/Build/Platform/VOS.pm b/cpan/Module-Build/lib/Module/Build/Platform/VOS.pm index be46a80416..2061b2cacb 100644 --- a/cpan/Module-Build/lib/Module/Build/Platform/VOS.pm +++ b/cpan/Module-Build/lib/Module/Build/Platform/VOS.pm @@ -2,7 +2,7 @@ package Module::Build::Platform::VOS; use strict; use vars qw($VERSION); -$VERSION = '0.35'; +$VERSION = '0.35_08'; $VERSION = eval $VERSION; use Module::Build::Base; diff --git a/cpan/Module-Build/lib/Module/Build/Platform/Windows.pm b/cpan/Module-Build/lib/Module/Build/Platform/Windows.pm index 6cf9da9cc3..fcaef5a409 100644 --- a/cpan/Module-Build/lib/Module/Build/Platform/Windows.pm +++ b/cpan/Module-Build/lib/Module/Build/Platform/Windows.pm @@ -2,7 +2,7 @@ package Module::Build::Platform::Windows; use strict; use vars qw($VERSION); -$VERSION = '0.35'; +$VERSION = '0.35_08'; $VERSION = eval $VERSION; use Config; @@ -39,7 +39,7 @@ sub ACTION_realclean { if ( lc $basename eq lc $self->build_script ) { if ( $self->build_bat ) { - $self->log_info("Deleting $basename.bat\n"); + $self->log_verbose("Deleting $basename.bat\n"); my $full_progname = $0; $full_progname =~ s/(?:\.bat)?$/.bat/i; @@ -207,22 +207,22 @@ sub split_like_shell { # into words. The algorithm below was bashed out by Randy and Ken # (mostly Randy), and there are a lot of regression tests, so we # should feel free to adjust if desired. - + (my $self, local $_) = @_; - + return @$_ if defined() && UNIVERSAL::isa($_, 'ARRAY'); - + my @argv; return @argv unless defined() && length(); - + my $arg = ''; my( $i, $quote_mode ) = ( 0, 0 ); - + while ( $i < length() ) { - + my $ch = substr( $_, $i , 1 ); my $next_ch = substr( $_, $i+1, 1 ); - + if ( $ch eq '\\' && $next_ch eq '"' ) { $arg .= '"'; $i++; @@ -249,10 +249,10 @@ sub split_like_shell { } else { $arg .= $ch; } - + $i++; } - + push( @argv, $arg ) if defined( $arg ) && length( $arg ); return @argv; } @@ -273,6 +273,27 @@ sub do_system { return !$status; } +# Copied from ExtUtils::MM_Win32 +sub _maybe_command { + my($self,$file) = @_; + my @e = exists($ENV{'PATHEXT'}) + ? split(/;/, $ENV{PATHEXT}) + : qw(.com .exe .bat .cmd); + my $e = ''; + for (@e) { $e .= "\Q$_\E|" } + chop $e; + # see if file ends in one of the known extensions + if ($file =~ /($e)$/i) { + return $file if -e $file; + } + else { + for (@e) { + return "$file$_" if -e "$file$_"; + } + } + return; +} + 1; diff --git a/cpan/Module-Build/lib/Module/Build/Platform/aix.pm b/cpan/Module-Build/lib/Module/Build/Platform/aix.pm index 45feb3cdd4..7ba3c322b6 100644 --- a/cpan/Module-Build/lib/Module/Build/Platform/aix.pm +++ b/cpan/Module-Build/lib/Module/Build/Platform/aix.pm @@ -2,7 +2,7 @@ package Module::Build::Platform::aix; use strict; use vars qw($VERSION); -$VERSION = '0.35'; +$VERSION = '0.35_08'; $VERSION = eval $VERSION; use Module::Build::Platform::Unix; diff --git a/cpan/Module-Build/lib/Module/Build/Platform/cygwin.pm b/cpan/Module-Build/lib/Module/Build/Platform/cygwin.pm index 62a6461ce2..8b882ed293 100644 --- a/cpan/Module-Build/lib/Module/Build/Platform/cygwin.pm +++ b/cpan/Module-Build/lib/Module/Build/Platform/cygwin.pm @@ -2,7 +2,7 @@ package Module::Build::Platform::cygwin; use strict; use vars qw($VERSION); -$VERSION = '0.35'; +$VERSION = '0.35_08'; $VERSION = eval $VERSION; use Module::Build::Platform::Unix; @@ -13,6 +13,22 @@ sub manpage_separator { '.' } +# Copied from ExtUtils::MM_Cygwin::maybe_command() +# If our path begins with F</cygdrive/> then we use C<ExtUtils::MM_Win32> +# to determine if it may be a command. Otherwise we use the tests +# from C<ExtUtils::MM_Unix>. + +sub _maybe_command { + my ($self, $file) = @_; + + if ($file =~ m{^/cygdrive/}i) { + require Module::Build::Platform::Win32; + return Module::Build::Platform::Win32->_maybe_command($file); + } + + return $self->SUPER::_maybe_command($file); +} + 1; __END__ diff --git a/cpan/Module-Build/lib/Module/Build/Platform/darwin.pm b/cpan/Module-Build/lib/Module/Build/Platform/darwin.pm index 39e9e36911..145933d478 100644 --- a/cpan/Module-Build/lib/Module/Build/Platform/darwin.pm +++ b/cpan/Module-Build/lib/Module/Build/Platform/darwin.pm @@ -2,7 +2,7 @@ package Module::Build::Platform::darwin; use strict; use vars qw($VERSION); -$VERSION = '0.35'; +$VERSION = '0.35_08'; $VERSION = eval $VERSION; use Module::Build::Platform::Unix; diff --git a/cpan/Module-Build/lib/Module/Build/Platform/os2.pm b/cpan/Module-Build/lib/Module/Build/Platform/os2.pm index ace01a3291..b6615c82c3 100644 --- a/cpan/Module-Build/lib/Module/Build/Platform/os2.pm +++ b/cpan/Module-Build/lib/Module/Build/Platform/os2.pm @@ -2,7 +2,7 @@ package Module::Build::Platform::os2; use strict; use vars qw($VERSION); -$VERSION = '0.35'; +$VERSION = '0.35_08'; $VERSION = eval $VERSION; use Module::Build::Platform::Unix; @@ -13,6 +13,16 @@ sub manpage_separator { '.' } sub have_forkpipe { 0 } +# Copied from ExtUtils::MM_OS2::maybe_command +sub _maybe_command { + my($self,$file) = @_; + $file =~ s,[/\\]+,/,g; + return $file if -x $file && ! -d _; + return "$file.exe" if -x "$file.exe" && ! -d _; + return "$file.cmd" if -x "$file.cmd" && ! -d _; + return; +} + 1; __END__ diff --git a/cpan/Module-Build/lib/Module/Build/PodParser.pm b/cpan/Module-Build/lib/Module/Build/PodParser.pm index b17b80b189..7a94e772ed 100644 --- a/cpan/Module-Build/lib/Module/Build/PodParser.pm +++ b/cpan/Module-Build/lib/Module/Build/PodParser.pm @@ -2,7 +2,7 @@ package Module::Build::PodParser; use strict; use vars qw($VERSION); -$VERSION = '0.35'; +$VERSION = '0.35_08'; $VERSION = eval $VERSION; use vars qw(@ISA); @@ -33,31 +33,31 @@ sub new { sub _myparse_from_filehandle { my ($self, $fh) = @_; - + local $_; while (<$fh>) { next unless /^=(?!cut)/ .. /^=cut/; # in POD last if ($self->{abstract}) = /^ (?: [a-z:]+ \s+ - \s+ ) (.*\S) /ix; } - + my @author; while (<$fh>) { - next unless /^=head1\s+AUTHORS?/ ... /^=/; + next unless /^=head1\s+AUTHORS?/i ... /^=/; next if /^=/; push @author, $_ if /\@/; } return unless @author; s/^\s+|\s+$//g foreach @author; - + $self->{author} = \@author; - + return; } sub get_abstract { my $self = shift; return $self->{abstract} if defined $self->{abstract}; - + $self->parse_from_filehandle($self->{fh}); return $self->{abstract}; @@ -66,7 +66,7 @@ sub get_abstract { sub get_author { my $self = shift; return $self->{author} if defined $self->{author}; - + $self->parse_from_filehandle($self->{fh}); return $self->{author} || []; @@ -92,10 +92,10 @@ sub textblock { my ($self, $text) = @_; $text =~ s/^\s+//; $text =~ s/\s+$//; - if ($self->{_head} eq 'NAME') { + if (uc $self->{_head} eq 'NAME') { my ($name, $abstract) = split( /\s+-\s+/, $text, 2 ); $self->{abstract} = $abstract; - } elsif ($self->{_head} =~ /^AUTHORS?$/) { + } elsif ($self->{_head} =~ /^AUTHORS?$/i) { push @{$self->{author}}, $text if $text =~ /\@/; } } diff --git a/cpan/Module-Build/lib/Module/Build/Version.pm b/cpan/Module-Build/lib/Module/Build/Version.pm index 0664d432ab..4a1b961fbd 100644 --- a/cpan/Module-Build/lib/Module/Build/Version.pm +++ b/cpan/Module-Build/lib/Module/Build/Version.pm @@ -81,7 +81,7 @@ sub import { map { $args{$_} = 1 } @_ } else { # no parameters at all on use line - %args = + args = ( qv => 1, 'UNIVERSAL::VERSION' => 1, @@ -89,9 +89,9 @@ sub import { } my $callpkg = caller(); - + if (exists($args{declare})) { - *{$callpkg."::declare"} = + *{$callpkg."::declare"} = sub {return $class->declare(shift) } unless defined(&{$callpkg.'::declare'}); } @@ -155,7 +155,7 @@ sub new { my ($class, $value) = @_; my $self = bless ({}, ref ($class) || $class); - + if ( ref($value) && eval('$value->isa("version")') ) { # Can copy the elements directly $self->{version} = [ @{$value->{version} } ]; @@ -193,7 +193,7 @@ sub new $value = sprintf("%.9f",$value); $value =~ s/(0+)$//; # trim trailing zeros } - + # This is not very efficient, but it is morally equivalent # to the XS code (as that is the reference implementation). # See vutil/vutil.c for details @@ -215,7 +215,7 @@ sub new } $start = $last = $pos = $s; - + # pre-scan the input string to check for decimals/underbars while ( substr($value,$pos,1) =~ /[._\d,]/ ) { if ( substr($value,$pos,1) eq '.' ) { @@ -300,7 +300,7 @@ sub new $orev = $rev; $rev += substr($value,$s,1) * $mult; $mult /= 10; - if ( abs($orev) > abs($rev) + if ( abs($orev) > abs($rev) || abs($rev) > abs($VERSION_MAX) ) { if ( warnings::enabled("overflow") ) { require Carp; @@ -320,7 +320,7 @@ sub new $orev = $rev; $rev += substr($value,$end,1) * $mult; $mult *= 10; - if ( abs($orev) > abs($rev) + if ( abs($orev) > abs($rev) || abs($rev) > abs($VERSION_MAX) ) { if ( warnings::enabled("overflow") ) { require Carp; @@ -335,15 +335,15 @@ sub new # Append revision push @{$self->{version}}, $rev; - if ( substr($value,$pos,1) eq '.' + if ( substr($value,$pos,1) eq '.' && substr($value,$pos+1,1) =~ /\d/ ) { $s = ++$pos; } - elsif ( substr($value,$pos,1) eq '_' + elsif ( substr($value,$pos,1) eq '_' && substr($value,$pos+1,1) =~ /\d/ ) { $s = ++$pos; } - elsif ( substr($value,$pos,1) eq ',' + elsif ( substr($value,$pos,1) eq ',' && substr($value,$pos+1,1) =~ /\d/ ) { $s = ++$pos; } @@ -400,7 +400,7 @@ sub new *parse = \&new; -sub numify +sub numify { my ($self) = @_; unless (_verify($self)) { @@ -441,7 +441,7 @@ sub numify return $string; } -sub normal +sub normal { my ($self) = @_; unless (_verify($self)) { @@ -484,9 +484,9 @@ sub stringify require Carp; Carp::croak("Invalid version object"); } - return exists $self->{original} - ? $self->{original} - : exists $self->{qv} + return exists $self->{original} + ? $self->{original} + : exists $self->{qv} ? $self->normal : $self->numify; } @@ -524,8 +524,8 @@ sub vcmp } # tiebreaker for alpha with identical terms - if ( $retval == 0 - && $l == $r + if ( $retval == 0 + && $l == $r && $left->{version}[$m] == $right->{version}[$m] && ( $lalpha || $ralpha ) ) { @@ -557,7 +557,7 @@ sub vcmp } } - return $retval; + return $retval; } sub vbool { @@ -565,8 +565,8 @@ sub vbool { return vcmp($self,$self->new("0"),1); } -sub vnoop { - require Carp; +sub vnoop { + require Carp; Carp::croak("operation not supported with version object"); } @@ -644,7 +644,7 @@ sub _VERSION { if ( defined $req ) { unless ( defined $version ) { require Carp; - my $msg = $] < 5.006 + my $msg = $] < 5.006 ? "$class version $req required--this is only version " : "$class does not define \$$class\::VERSION" ."--version check failed"; @@ -662,14 +662,14 @@ sub _VERSION { if ( $req > $version ) { require Carp; if ( $req->is_qv ) { - Carp::croak( + Carp::croak( sprintf ("%s version %s required--". "this is only version %s", $class, $req->normal, $version->normal) ); } else { - Carp::croak( + Carp::croak( sprintf ("%s version %s required--". "this is only version %s", $class, $req->stringify, $version->stringify) diff --git a/cpan/Module-Build/lib/Module/Build/YAML.pm b/cpan/Module-Build/lib/Module/Build/YAML.pm index 4a181ad1c9..2da91f2256 100644 --- a/cpan/Module-Build/lib/Module/Build/YAML.pm +++ b/cpan/Module-Build/lib/Module/Build/YAML.pm @@ -1,161 +1,600 @@ +# Adapted from YAML::Tiny 1.40 package Module::Build::YAML; use strict; -use vars qw($VERSION @EXPORT @EXPORT_OK); -$VERSION = "0.50"; -@EXPORT = (); -@EXPORT_OK = qw(Dump Load DumpFile LoadFile); +use Carp 'croak'; +# UTF Support? +sub HAVE_UTF8 () { $] >= 5.007003 } +BEGIN { + if ( HAVE_UTF8 ) { + # The string eval helps hide this from Test::MinimumVersion + eval "require utf8;"; + die "Failed to load UTF-8 support" if $@; + } + + # Class structure + require 5.004; + + $Module::Build::YAML::VERSION = '1.40'; + + # Error storage + $Module::Build::YAML::errstr = ''; +} + +# The character class of all characters we need to escape +# NOTE: Inlined, since it's only used once +# my $RE_ESCAPE = '[\\x00-\\x08\\x0b-\\x0d\\x0e-\\x1f\"\n]'; + +# Printed form of the unprintable characters in the lowest range +# of ASCII characters, listed by ASCII ordinal position. +my @UNPRINTABLE = qw( + z x01 x02 x03 x04 x05 x06 a + x08 t n v f r x0e x0f + x10 x11 x12 x13 x14 x15 x16 x17 + x18 x19 x1a e x1c x1d x1e x1f +); + +# Printable characters for escapes +my %UNESCAPES = ( + z => "\x00", a => "\x07", t => "\x09", + n => "\x0a", v => "\x0b", f => "\x0c", + r => "\x0d", e => "\x1b", '\\' => '\\', +); + +# Special magic boolean words +my %QUOTE = map { $_ => 1 } qw{ + null Null NULL + y Y yes Yes YES n N no No NO + true True TRUE false False FALSE + on On ON off Off OFF +}; + +##################################################################### +# Implementation + +# Create an empty Module::Build::YAML object sub new { - my $this = shift; - my $class = ref($this) || $this; - my $self = {}; - bless $self, $class; - return($self); + my $class = shift; + bless [ @_ ], $class; } -sub Dump { - shift if ($_[0] eq __PACKAGE__ || ref($_[0]) eq __PACKAGE__); - my $yaml = ""; - foreach my $item (@_) { - $yaml .= "---\n"; - $yaml .= &_yaml_chunk("", $item); - } - return $yaml; +# Create an object from a file +sub read { + my $class = ref $_[0] ? ref shift : shift; + + # Check the file + my $file = shift or return $class->_error( 'You did not specify a file name' ); + return $class->_error( "File '$file' does not exist" ) unless -e $file; + return $class->_error( "'$file' is a directory, not a file" ) unless -f _; + return $class->_error( "Insufficient permissions to read '$file'" ) unless -r _; + + # Slurp in the file + local $/ = undef; + local *CFG; + unless ( open(CFG, $file) ) { + return $class->_error("Failed to open file '$file': $!"); + } + my $contents = <CFG>; + unless ( close(CFG) ) { + return $class->_error("Failed to close file '$file': $!"); + } + + $class->read_string( $contents ); } -sub Load { - shift if ($_[0] eq __PACKAGE__ || ref($_[0]) eq __PACKAGE__); - die "not yet implemented"; +# Create an object from a string +sub read_string { + my $class = ref $_[0] ? ref shift : shift; + my $self = bless [], $class; + my $string = $_[0]; + unless ( defined $string ) { + return $self->_error("Did not provide a string to load"); + } + + # Byte order marks + # NOTE: Keeping this here to educate maintainers + # my %BOM = ( + # "\357\273\277" => 'UTF-8', + # "\376\377" => 'UTF-16BE', + # "\377\376" => 'UTF-16LE', + # "\377\376\0\0" => 'UTF-32LE' + # "\0\0\376\377" => 'UTF-32BE', + # ); + if ( $string =~ /^(?:\376\377|\377\376|\377\376\0\0|\0\0\376\377)/ ) { + return $self->_error("Stream has a non UTF-8 BOM"); + } else { + # Strip UTF-8 bom if found, we'll just ignore it + $string =~ s/^\357\273\277//; + } + + # Try to decode as utf8 + utf8::decode($string) if HAVE_UTF8; + + # Check for some special cases + return $self unless length $string; + unless ( $string =~ /[\012\015]+\z/ ) { + return $self->_error("Stream does not end with newline character"); + } + + # Split the file into lines + my @lines = grep { ! /^\s*(?:\#.*)?\z/ } + split /(?:\015{1,2}\012|\015|\012)/, $string; + + # Strip the initial YAML header + @lines and $lines[0] =~ /^\%YAML[: ][\d\.]+.*\z/ and shift @lines; + + # A nibbling parser + while ( @lines ) { + # Do we have a document header? + if ( $lines[0] =~ /^---\s*(?:(.+)\s*)?\z/ ) { + # Handle scalar documents + shift @lines; + if ( defined $1 and $1 !~ /^(?:\#.+|\%YAML[: ][\d\.]+)\z/ ) { + push @$self, $self->_read_scalar( "$1", [ undef ], \@lines ); + next; + } + } + + if ( ! @lines or $lines[0] =~ /^(?:---|\.\.\.)/ ) { + # A naked document + push @$self, undef; + while ( @lines and $lines[0] !~ /^---/ ) { + shift @lines; + } + + } elsif ( $lines[0] =~ /^\s*\-/ ) { + # An array at the root + my $document = [ ]; + push @$self, $document; + $self->_read_array( $document, [ 0 ], \@lines ); + + } elsif ( $lines[0] =~ /^(\s*)\S/ ) { + # A hash at the root + my $document = { }; + push @$self, $document; + $self->_read_hash( $document, [ length($1) ], \@lines ); + + } else { + croak("Module::Build::YAML failed to classify the line '$lines[0]'"); + } + } + + $self; } -# This is basically copied out of YAML.pm and simplified a little. -sub DumpFile { - shift if ($_[0] eq __PACKAGE__ || ref($_[0]) eq __PACKAGE__); - my $filename = shift; - local $/ = "\n"; # reset special to "sane" - my $mode = '>'; - if ($filename =~ /^\s*(>{1,2})\s*(.*)$/) { - ($mode, $filename) = ($1, $2); - } - open my $OUT, "$mode $filename" - or die "Can't open $filename for writing: $!"; - binmode($OUT, ':utf8') if $] >= 5.008; - print $OUT Dump(@_); - close $OUT; -} - -# This is basically copied out of YAML.pm and simplified a little. -sub LoadFile { - shift if ($_[0] eq __PACKAGE__ || ref($_[0]) eq __PACKAGE__); - my $filename = shift; - open my $IN, $filename - or die "Can't open $filename for reading: $!"; - binmode($IN, ':utf8') if $] >= 5.008; - return Load(do { local $/; <$IN> }); - close $IN; -} - -sub _yaml_chunk { - my ($indent, $values) = @_; - my $yaml_chunk = ""; - my $ref = ref($values); - my ($value, @allkeys, %keyseen); - if (!$ref) { # a scalar - $yaml_chunk .= &_yaml_value($values) . "\n"; - } - elsif ($ref eq "ARRAY") { - foreach $value (@$values) { - $yaml_chunk .= "$indent-"; - $ref = ref($value); - if (!$ref) { - $yaml_chunk .= " " . &_yaml_value($value) . "\n"; - } - else { - $yaml_chunk .= "\n"; - $yaml_chunk .= &_yaml_chunk("$indent ", $value); - } - } - } - else { # assume "HASH" - if ($values->{_order} && ref($values->{_order}) eq "ARRAY") { - @allkeys = @{$values->{_order}}; - $values = { %$values }; - delete $values->{_order}; - } - push(@allkeys, sort keys %$values); - foreach my $key (@allkeys) { - next if (!defined $key || $key eq "" || $keyseen{$key}); - $keyseen{$key} = 1; - $yaml_chunk .= "$indent$key:"; - $value = $values->{$key}; - $ref = ref($value); - if (!$ref) { - $yaml_chunk .= " " . &_yaml_value($value) . "\n"; - } - else { - $yaml_chunk .= "\n"; - $yaml_chunk .= &_yaml_chunk("$indent ", $value); - } - } - } - return($yaml_chunk); -} - -sub _yaml_value { - my ($value) = @_; - # undefs become ~ - return '~' if not defined $value; - - # empty strings will become empty strings - return '""' if $value eq ''; - - # allow simple scalars (without embedded quote chars) to be unquoted - # (includes $%_+=-\;:,./) - return $value if $value !~ /["'`~\n!\@\#^\&\*\(\)\{\}\[\]\|<>\?]/; - - # quote and escape strings with special values - return "'$value'" - if $value !~ /['`~\n!\#^\&\*\(\)\{\}\[\]\|\?]/; # nothing but " or @ or < or > (email addresses) - - $value =~ s/\n/\\n/g; # handle embedded newlines - $value =~ s/"/\\"/g; # handle embedded quotes - return qq{"$value"}; +# Deparse a scalar string to the actual scalar +sub _read_scalar { + my ($self, $string, $indent, $lines) = @_; + + # Trim trailing whitespace + $string =~ s/\s*\z//; + + # Explitic null/undef + return undef if $string eq '~'; + + # Quotes + if ( $string =~ /^\'(.*?)\'\z/ ) { + return '' unless defined $1; + $string = $1; + $string =~ s/\'\'/\'/g; + return $string; + } + if ( $string =~ /^\"((?:\\.|[^\"])*)\"\z/ ) { + # Reusing the variable is a little ugly, + # but avoids a new variable and a string copy. + $string = $1; + $string =~ s/\\"/"/g; + $string =~ s/\\([never\\fartz]|x([0-9a-fA-F]{2}))/(length($1)>1)?pack("H2",$2):$UNESCAPES{$1}/gex; + return $string; + } + + # Special cases + if ( $string =~ /^[\'\"!&]/ ) { + croak("Module::Build::YAML does not support a feature in line '$lines->[0]'"); + } + return {} if $string eq '{}'; + return [] if $string eq '[]'; + + # Regular unquoted string + return $string unless $string =~ /^[>|]/; + + # Error + croak("Module::Build::YAML failed to find multi-line scalar content") unless @$lines; + + # Check the indent depth + $lines->[0] =~ /^(\s*)/; + $indent->[-1] = length("$1"); + if ( defined $indent->[-2] and $indent->[-1] <= $indent->[-2] ) { + croak("Module::Build::YAML found bad indenting in line '$lines->[0]'"); + } + + # Pull the lines + my @multiline = (); + while ( @$lines ) { + $lines->[0] =~ /^(\s*)/; + last unless length($1) >= $indent->[-1]; + push @multiline, substr(shift(@$lines), length($1)); + } + + my $j = (substr($string, 0, 1) eq '>') ? ' ' : "\n"; + my $t = (substr($string, 1, 1) eq '-') ? '' : "\n"; + return join( $j, @multiline ) . $t; } -1; +# Parse an array +sub _read_array { + my ($self, $array, $indent, $lines) = @_; -__END__ + while ( @$lines ) { + # Check for a new document + if ( $lines->[0] =~ /^(?:---|\.\.\.)/ ) { + while ( @$lines and $lines->[0] !~ /^---/ ) { + shift @$lines; + } + return 1; + } + + # Check the indent level + $lines->[0] =~ /^(\s*)/; + if ( length($1) < $indent->[-1] ) { + return 1; + } elsif ( length($1) > $indent->[-1] ) { + croak("Module::Build::YAML found bad indenting in line '$lines->[0]'"); + } + + if ( $lines->[0] =~ /^(\s*\-\s+)[^\'\"]\S*\s*:(?:\s+|$)/ ) { + # Inline nested hash + my $indent2 = length("$1"); + $lines->[0] =~ s/-/ /; + push @$array, { }; + $self->_read_hash( $array->[-1], [ @$indent, $indent2 ], $lines ); + + } elsif ( $lines->[0] =~ /^\s*\-(\s*)(.+?)\s*\z/ ) { + # Array entry with a value + shift @$lines; + push @$array, $self->_read_scalar( "$2", [ @$indent, undef ], $lines ); -=head1 NAME + } elsif ( $lines->[0] =~ /^\s*\-\s*\z/ ) { + shift @$lines; + unless ( @$lines ) { + push @$array, undef; + return 1; + } + if ( $lines->[0] =~ /^(\s*)\-/ ) { + my $indent2 = length("$1"); + if ( $indent->[-1] == $indent2 ) { + # Null array entry + push @$array, undef; + } else { + # Naked indenter + push @$array, [ ]; + $self->_read_array( $array->[-1], [ @$indent, $indent2 ], $lines ); + } -Module::Build::YAML - Provides just enough YAML support so that Module::Build works even if YAML.pm is not installed + } elsif ( $lines->[0] =~ /^(\s*)\S/ ) { + push @$array, { }; + $self->_read_hash( $array->[-1], [ @$indent, length("$1") ], $lines ); -=head1 SYNOPSIS + } else { + croak("Module::Build::YAML failed to classify line '$lines->[0]'"); + } - use Module::Build::YAML; + } elsif ( defined $indent->[-2] and $indent->[-1] == $indent->[-2] ) { + # This is probably a structure like the following... + # --- + # foo: + # - list + # bar: value + # + # ... so lets return and let the hash parser handle it + return 1; - ... + } else { + croak("Module::Build::YAML failed to classify line '$lines->[0]'"); + } + } -=head1 DESCRIPTION + return 1; +} + +# Parse an array +sub _read_hash { + my ($self, $hash, $indent, $lines) = @_; + + while ( @$lines ) { + # Check for a new document + if ( $lines->[0] =~ /^(?:---|\.\.\.)/ ) { + while ( @$lines and $lines->[0] !~ /^---/ ) { + shift @$lines; + } + return 1; + } -Provides just enough YAML support so that Module::Build works even if YAML.pm is not installed. + # Check the indent level + $lines->[0] =~ /^(\s*)/; + if ( length($1) < $indent->[-1] ) { + return 1; + } elsif ( length($1) > $indent->[-1] ) { + croak("Module::Build::YAML found bad indenting in line '$lines->[0]'"); + } -Currently, this amounts to the ability to write META.yml files when C<perl Build distmeta> -is executed via the Dump() and DumpFile() functions/methods. + # Get the key + unless ( $lines->[0] =~ s/^\s*([^\'\" ][^\n]*?)\s*:(\s+|$)// ) { + if ( $lines->[0] =~ /^\s*[?\'\"]/ ) { + croak("Module::Build::YAML does not support a feature in line '$lines->[0]'"); + } + croak("Module::Build::YAML failed to classify line '$lines->[0]'"); + } + my $key = $1; -=head1 AUTHOR + # Do we have a value? + if ( length $lines->[0] ) { + # Yes + $hash->{$key} = $self->_read_scalar( shift(@$lines), [ @$indent, undef ], $lines ); + } else { + # An indent + shift @$lines; + unless ( @$lines ) { + $hash->{$key} = undef; + return 1; + } + if ( $lines->[0] =~ /^(\s*)-/ ) { + $hash->{$key} = []; + $self->_read_array( $hash->{$key}, [ @$indent, length($1) ], $lines ); + } elsif ( $lines->[0] =~ /^(\s*)./ ) { + my $indent2 = length("$1"); + if ( $indent->[-1] >= $indent2 ) { + # Null hash entry + $hash->{$key} = undef; + } else { + $hash->{$key} = {}; + $self->_read_hash( $hash->{$key}, [ @$indent, length($1) ], $lines ); + } + } + } + } -Stephen Adkins <spadkins@gmail.com> + return 1; +} + +# Save an object to a file +sub write { + my $self = shift; + my $file = shift or return $self->_error('No file name provided'); -=head1 COPYRIGHT + # Write it to the file + open( CFG, '>' . $file ) or return $self->_error( + "Failed to open file '$file' for writing: $!" + ); + print CFG $self->write_string; + close CFG; -Copyright (c) 2006. Stephen Adkins. All rights reserved. + return 1; +} -This program is free software; you can redistribute it and/or modify it -under the same terms as Perl itself. +# Save an object to a string +sub write_string { + my $self = shift; + return '' unless @$self; -See L<http://www.perl.com/perl/misc/Artistic.html> + # Iterate over the documents + my $indent = 0; + my @lines = (); + foreach my $cursor ( @$self ) { + push @lines, '---'; -=cut + # An empty document + if ( ! defined $cursor ) { + # Do nothing + + # A scalar document + } elsif ( ! ref $cursor ) { + $lines[-1] .= ' ' . $self->_write_scalar( $cursor, $indent ); + + # A list at the root + } elsif ( ref $cursor eq 'ARRAY' ) { + unless ( @$cursor ) { + $lines[-1] .= ' []'; + next; + } + push @lines, $self->_write_array( $cursor, $indent, {} ); + + # A hash at the root + } elsif ( ref $cursor eq 'HASH' ) { + unless ( %$cursor ) { + $lines[-1] .= ' {}'; + next; + } + push @lines, $self->_write_hash( $cursor, $indent, {} ); + + } else { + croak("Cannot serialize " . ref($cursor)); + } + } + + join '', map { "$_\n" } @lines; +} + +sub _write_scalar { + my $string = $_[1]; + return '~' unless defined $string; + return "''" unless length $string; + if ( $string =~ /[\x00-\x08\x0b-\x0d\x0e-\x1f\"\'\n]/ ) { + $string =~ s/\\/\\\\/g; + $string =~ s/"/\\"/g; + $string =~ s/\n/\\n/g; + $string =~ s/([\x00-\x1f])/\\$UNPRINTABLE[ord($1)]/g; + return qq|"$string"|; + } + if ( $string =~ /(?:^\W|\s)/ or $QUOTE{$string} ) { + return "'$string'"; + } + return $string; +} + +sub _write_array { + my ($self, $array, $indent, $seen) = @_; + if ( $seen->{refaddr($array)}++ ) { + die "Module::Build::YAML does not support circular references"; + } + my @lines = (); + foreach my $el ( @$array ) { + my $line = (' ' x $indent) . '-'; + my $type = ref $el; + if ( ! $type ) { + $line .= ' ' . $self->_write_scalar( $el, $indent + 1 ); + push @lines, $line; + + } elsif ( $type eq 'ARRAY' ) { + if ( @$el ) { + push @lines, $line; + push @lines, $self->_write_array( $el, $indent + 1, $seen ); + } else { + $line .= ' []'; + push @lines, $line; + } + + } elsif ( $type eq 'HASH' ) { + if ( keys %$el ) { + push @lines, $line; + push @lines, $self->_write_hash( $el, $indent + 1, $seen ); + } else { + $line .= ' {}'; + push @lines, $line; + } + + } else { + die "Module::Build::YAML does not support $type references"; + } + } + + @lines; +} + +sub _write_hash { + my ($self, $hash, $indent, $seen) = @_; + if ( $seen->{refaddr($hash)}++ ) { + die "Module::Build::YAML does not support circular references"; + } + my @lines = (); + foreach my $name ( sort keys %$hash ) { + my $el = $hash->{$name}; + my $line = (' ' x $indent) . "$name:"; + my $type = ref $el; + if ( ! $type ) { + $line .= ' ' . $self->_write_scalar( $el, $indent + 1 ); + push @lines, $line; + + } elsif ( $type eq 'ARRAY' ) { + if ( @$el ) { + push @lines, $line; + push @lines, $self->_write_array( $el, $indent + 1, $seen ); + } else { + $line .= ' []'; + push @lines, $line; + } + + } elsif ( $type eq 'HASH' ) { + if ( keys %$el ) { + push @lines, $line; + push @lines, $self->_write_hash( $el, $indent + 1, $seen ); + } else { + $line .= ' {}'; + push @lines, $line; + } + + } else { + die "Module::Build::YAML does not support $type references"; + } + } + + @lines; +} + +# Set error +sub _error { + $Module::Build::YAML::errstr = $_[1]; + undef; +} + +# Retrieve error +sub errstr { + $Module::Build::YAML::errstr; +} + +##################################################################### +# YAML Compatibility + +sub Dump { + Module::Build::YAML->new(@_)->write_string; +} + +sub Load { + my $self = Module::Build::YAML->read_string(@_); + unless ( $self ) { + croak("Failed to load YAML document from string"); + } + if ( wantarray ) { + return @$self; + } else { + # To match YAML.pm, return the last document + return $self->[-1]; + } +} + +BEGIN { + *freeze = *Dump; + *thaw = *Load; +} + +sub DumpFile { + my $file = shift; + Module::Build::YAML->new(@_)->write($file); +} + +sub LoadFile { + my $self = Module::Build::YAML->read($_[0]); + unless ( $self ) { + croak("Failed to load YAML document from '" . ($_[0] || '') . "'"); + } + if ( wantarray ) { + return @$self; + } else { + # Return only the last document to match YAML.pm, + return $self->[-1]; + } +} + +##################################################################### +# Use Scalar::Util if possible, otherwise emulate it + +BEGIN { + eval { + require Scalar::Util; + }; + if ( $@ ) { + # Failed to load Scalar::Util + eval <<'END_PERL'; +sub refaddr { + my $pkg = ref($_[0]) or return undef; + if (!!UNIVERSAL::can($_[0], 'can')) { + bless $_[0], 'Scalar::Util::Fake'; + } else { + $pkg = undef; + } + "$_[0]" =~ /0x(\w+)/; + my $i = do { local $^W; hex $1 }; + bless $_[0], $pkg if defined $pkg; + $i; +} +END_PERL + } else { + Scalar::Util->import('refaddr'); + } +} + +1; + +__END__ |