diff options
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__ |