summaryrefslogtreecommitdiff
path: root/Master/tlpkg/tlperl/lib/Module/Build
diff options
context:
space:
mode:
authorKarl Berry <karl@freefriends.org>2012-05-21 00:15:27 +0000
committerKarl Berry <karl@freefriends.org>2012-05-21 00:15:27 +0000
commita4c42bfb2337d37da89d789cb8cc226367994e32 (patch)
treec3eabdef5d565a4e515d2be0d9d4d0540bde0250 /Master/tlpkg/tlperl/lib/Module/Build
parent8274475057f024d35332ac47c2e2f23ea156e6ed (diff)
perl 5.14.2 from siep
git-svn-id: svn://tug.org/texlive/trunk@26525 c570f23f-e606-0410-a88d-b1316a301751
Diffstat (limited to 'Master/tlpkg/tlperl/lib/Module/Build')
-rw-r--r--Master/tlpkg/tlperl/lib/Module/Build/API.pod223
-rw-r--r--Master/tlpkg/tlperl/lib/Module/Build/Authoring.pod9
-rw-r--r--Master/tlpkg/tlperl/lib/Module/Build/Base.pm797
-rw-r--r--Master/tlpkg/tlperl/lib/Module/Build/Compat.pm23
-rw-r--r--Master/tlpkg/tlperl/lib/Module/Build/Config.pm2
-rw-r--r--Master/tlpkg/tlperl/lib/Module/Build/ConfigData.pm6
-rw-r--r--Master/tlpkg/tlperl/lib/Module/Build/Cookbook.pm2
-rw-r--r--Master/tlpkg/tlperl/lib/Module/Build/Dumper.pm2
-rw-r--r--Master/tlpkg/tlperl/lib/Module/Build/ModuleInfo.pm473
-rw-r--r--Master/tlpkg/tlperl/lib/Module/Build/Notes.pm2
-rw-r--r--Master/tlpkg/tlperl/lib/Module/Build/PPMMaker.pm3
-rw-r--r--Master/tlpkg/tlperl/lib/Module/Build/Platform/Amiga.pm2
-rw-r--r--Master/tlpkg/tlperl/lib/Module/Build/Platform/Default.pm2
-rw-r--r--Master/tlpkg/tlperl/lib/Module/Build/Platform/EBCDIC.pm2
-rw-r--r--Master/tlpkg/tlperl/lib/Module/Build/Platform/MPEiX.pm2
-rw-r--r--Master/tlpkg/tlperl/lib/Module/Build/Platform/MacOS.pm2
-rw-r--r--Master/tlpkg/tlperl/lib/Module/Build/Platform/RiscOS.pm2
-rw-r--r--Master/tlpkg/tlperl/lib/Module/Build/Platform/Unix.pm2
-rw-r--r--Master/tlpkg/tlperl/lib/Module/Build/Platform/VMS.pm23
-rw-r--r--Master/tlpkg/tlperl/lib/Module/Build/Platform/VOS.pm2
-rw-r--r--Master/tlpkg/tlperl/lib/Module/Build/Platform/Windows.pm2
-rw-r--r--Master/tlpkg/tlperl/lib/Module/Build/Platform/aix.pm2
-rw-r--r--Master/tlpkg/tlperl/lib/Module/Build/Platform/cygwin.pm6
-rw-r--r--Master/tlpkg/tlperl/lib/Module/Build/Platform/darwin.pm2
-rw-r--r--Master/tlpkg/tlperl/lib/Module/Build/Platform/os2.pm2
-rw-r--r--Master/tlpkg/tlperl/lib/Module/Build/PodParser.pm2
-rw-r--r--Master/tlpkg/tlperl/lib/Module/Build/Version.pm681
-rw-r--r--Master/tlpkg/tlperl/lib/Module/Build/YAML.pm603
28 files changed, 887 insertions, 1994 deletions
diff --git a/Master/tlpkg/tlperl/lib/Module/Build/API.pod b/Master/tlpkg/tlperl/lib/Module/Build/API.pod
index 146d28ec2b9..29d2f359c8e 100644
--- a/Master/tlpkg/tlperl/lib/Module/Build/API.pod
+++ b/Master/tlpkg/tlperl/lib/Module/Build/API.pod
@@ -181,6 +181,11 @@ files in the directory will be compiled to object files. The
directory will be added to the search path during the compilation and
linking phases of any C or XS files.
+[version 0.3604]
+
+A list of directories can be supplied using an anonymous array
+reference of strings.
+
=item conflicts
[version 0.07]
@@ -261,6 +266,25 @@ a reasonable default. However, some agglomerative distributions like
C<libwww-perl> or C<bioperl> have names that don't correspond directly
to a module name, so C<dist_name> can be set independently.
+=item dist_suffix
+
+[version 0.37]
+
+Specifies an optional suffix to include after the version number
+in the distribution directory (and tarball) name. The only suffix
+currently recognized by PAUSE is 'TRIAL', which indicates that the
+distribution should not be indexed. For example:
+
+ Foo-Bar-1.23-TRIAL.tar.gz
+
+This will automatically do the "right thing" depending on C<dist_version> and
+C<release_status>. When C<dist_version> does not have an underscore and
+C<release_status> is not 'stable', then C<dist_suffix> will default to 'TRIAL'.
+Otherwise it will default to the empty string, disabling the suffix.
+
+In general, authors should only set this if they B<must> override the default
+behavior for some particular purpose.
+
=item dist_version
[version 0.11]
@@ -447,8 +471,12 @@ L<Module::Build/"INSTALL PATHS">
[version 0.07]
-Specifies the licensing terms of your distribution. Valid options include:
+Specifies the licensing terms of your distribution.
+
+As of Module::Build version 0.36_14, you may use a L<Software::License>
+subclass name (e.g. 'Apache_2_0') instead of one of the keys below.
+The legacy list of valid license values include:
=over 4
@@ -525,9 +553,9 @@ restrictions.
=back
-
Note that you must still include the terms of your license in your
-documentation - this field only lets automated tools figure out your
+code and documentation - this field only sets the information that is included
+in distribution metadata to let automated tools figure out your
licensing restrictions. Humans still need something to read. If you
choose to provide this field, you should make sure that you keep it in
sync with your written documentation if you ever change your licensing
@@ -536,13 +564,7 @@ terms.
You may also use a license type of C<unknown> if you don't wish to
specify your terms in the metadata.
-It is a fatal error to use a license other than the ones mentioned
-above. This is not because I wish to impose licensing terms on you -
-please let me know if you would like another license option to be
-added to the list. I just started out with a small set of licenses to
-keep things simple, figuring I'd let people with actual working
-knowledge in this area tell me what to do. So if that's you, drop me
-a line.
+Also see the C<create_license> parameter.
=item meta_add
@@ -711,6 +733,22 @@ Normally, C<Module::Build> does not search subdirectories when looking
for tests to run. When this options is set it will search recursively
in all subdirectories of the standard 't' test directory.
+=item release_status
+
+[version 0.37]
+
+The CPAN Meta Spec version 2 adds C<release_status> to allow authors
+to specify how a distribution should be indexed. Consistent with the
+spec, this parameter can only have one three values: 'stable',
+'testing' or 'unstable'.
+
+Unless explicitly set by the author, C<release_status> will default
+to 'stable' unless C<dist_version> contains an underscore, in which
+case it will default to 'testing'.
+
+It is an error to specify a C<release_status> of 'stable' when
+C<dist_version> contains an underscore character.
+
=item requires
[version 0.07]
@@ -1588,11 +1626,24 @@ of F<META.yml>. E.g.
return $data;
}
-The only valid argument is C<fatal>, which indicates whether missing required
+Valid arguments include:
+
+=over
+
+=item *
+
+C<fatal> -- indicates whether missing required
metadata fields should be a fatal error or not. For META creation, it
generally should, but for MYMETA creation for end-users, it should not be
fatal.
+=item *
+
+C<auto> -- indicates whether any necessary configure_requires should be
+automatically added. This is used in META creation.
+
+=back
+
This method is a wrapper around the old prepare_metadata API now that we
no longer use YAML::Node to hold metadata.
@@ -1667,8 +1718,8 @@ Examples:
[version 0.32]
Returns a reference to a hash describing all prerequisites. The keys of the
-hash will the various prerequisite types ('requires', 'build_requires',
-'configure_requires', 'recommends', or 'conflicts') and the values will
+hash will be the various prerequisite types ('requires', 'build_requires',
+'configure_requires', 'recommends', or 'conflicts') and the values will be
references to hashes of module names and version numbers. Only prerequisites
types that are defined will be included. The C<prereq_data> action is just a
thin wrapper around the C<prereq_data()> method and dumps the hash as a string
@@ -1827,18 +1878,144 @@ accessor methods for the following properties:
=over 4
-<autogenerated_accessors>
+=item PL_files()
-=back
+=item allow_mb_mismatch()
+
+=item auto_configure_requires()
+
+=item autosplit()
+
+=item base_dir()
+
+=item bindoc_dirs()
+
+=item blib()
+
+=item build_bat()
+
+=item build_class()
+
+=item build_elements()
+
+=item build_requires()
+
+=item build_script()
+
+=item bundle_inc()
+
+=item bundle_inc_preload()
+
+=item c_source()
+
+=item config_dir()
+
+=item configure_requires()
+
+=item conflicts()
+
+=item cpan_client()
+
+=item create_license()
+
+=item create_makefile_pl()
+
+=item create_packlist()
+
+=item create_readme()
+=item debug()
+
+=item debugger()
+
+=item destdir()
+
+=item dynamic_config()
+
+=item get_options()
+
+=item html_css()
+
+=item include_dirs()
+
+=item install_base()
+
+=item installdirs()
+
+=item libdoc_dirs()
+
+=item license()
+
+=item magic_number()
+
+=item mb_version()
+
+=item meta_add()
+
+=item meta_merge()
+
+=item metafile()
+
+=item metafile2()
+
+=item module_name()
+
+=item mymetafile()
+
+=item mymetafile2()
+
+=item needs_compiler()
+
+=item orig_dir()
+
+=item perl()
+
+=item pm_files()
+
+=item pod_files()
+
+=item pollute()
+
+=item prefix()
+
+=item prereq_action_types()
+
+=item program_name()
+
+=item quiet()
+
+=item recommends()
+
+=item recurse_into()
+
+=item recursive_test_files()
+
+=item requires()
+
+=item scripts()
+
+=item sign()
+
+=item tap_harness_args()
+
+=item test_file_exts()
+
+=item use_rcfile()
+
+=item use_tap_harness()
+
+=item verbose()
+
+=item xs_files()
+
+=back
=head1 MODULE METADATA
If you would like to add other useful metadata, C<Module::Build>
supports this with the C<meta_add> and C<meta_merge> arguments to
-L</new>. The authoritative list of supported metadata can be found at
-L<http://module-build.sourceforge.net/META-spec-current.html>, but for
-convenience - here are a few of the more useful ones:
+L</new()>. The authoritative list of supported metadata can be found at
+L<CPAN::META::Spec> but for convenience - here are a few of the more useful ones:
=over 4
@@ -1847,17 +2024,13 @@ convenience - here are a few of the more useful ones:
For describing the distribution using keyword (or "tags") in order to
make CPAN.org indexing and search more efficient and useful.
-See L<http://module-build.sourceforge.net/META-spec-current.html#keywords>.
-
=item resources
A list of additional resources available for users of the
distribution. This can include links to a homepage on the web, a
-bug tracker, the repository location, a even subscription page for the
+bug tracker, the repository location, and even a subscription page for the
distribution mailing list.
-See L<http://module-build.sourceforge.net/META-spec-current.html#resources>.
-
=back
@@ -1877,9 +2050,9 @@ 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::Tiny>(3)
+L<Module::Build::Cookbook>(3), L<ExtUtils::MakeMaker>(3)
F<META.yml> Specification:
-L<http://module-build.sourceforge.net/META-spec-current.html>
+L<CPAN::META::Spec>
=cut
diff --git a/Master/tlpkg/tlperl/lib/Module/Build/Authoring.pod b/Master/tlpkg/tlperl/lib/Module/Build/Authoring.pod
index 38fb3f089a6..92164df9211 100644
--- a/Master/tlpkg/tlperl/lib/Module/Build/Authoring.pod
+++ b/Master/tlpkg/tlperl/lib/Module/Build/Authoring.pod
@@ -2,7 +2,6 @@
Module::Build::Authoring - Authoring Module::Build modules
-
=head1 DESCRIPTION
When creating a C<Build.PL> script for a module, something like the
@@ -104,7 +103,7 @@ C<@INC> (including the C</nonstandard/library/path>) is propagated to
the Build script, so that My::Builder can be found when running build
actions. If you find that you need to C<chdir> into a different directories
in your subclass methods or actions, be sure to always return to the original
-directory (available via the C<base_dir()> method before returning control
+directory (available via the C<base_dir()> method) before returning control
to the parent class. This is important to avoid data serialization problems.
For very small additions, Module::Build provides a C<subclass()>
@@ -304,8 +303,8 @@ 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>.
-The latest development version is available from the Subversion
-repository at <https://svn.perl.org/modules/Module-Build/trunk/>
+The latest development version is available from the Git
+repository at <https://github.com/dagolden/module-build/>
=head1 SEE ALSO
@@ -314,7 +313,7 @@ perl(1), L<Module::Build>(3), L<Module::Build::API>(3),
L<Module::Build::Cookbook>(3), L<ExtUtils::MakeMaker>(3), L<YAML>(3)
F<META.yml> Specification:
-L<http://module-build.sourceforge.net/META-spec-current.html>
+L<CPAN::META::Spec>
L<http://www.dsmit.com/cons/>
diff --git a/Master/tlpkg/tlperl/lib/Module/Build/Base.pm b/Master/tlpkg/tlperl/lib/Module/Build/Base.pm
index 5bd8ec72a55..fba916ad267 100644
--- a/Master/tlpkg/tlperl/lib/Module/Build/Base.pm
+++ b/Master/tlpkg/tlperl/lib/Module/Build/Base.pm
@@ -4,7 +4,7 @@ package Module::Build::Base;
use strict;
use vars qw($VERSION);
-$VERSION = '0.3603';
+$VERSION = '0.3800';
$VERSION = eval $VERSION;
BEGIN { require 5.00503 }
@@ -62,6 +62,7 @@ EOF
$self->dist_name;
$self->dist_version;
+ $self->release_status;
$self->_guess_module_name unless $self->module_name;
$self->_find_nested_builds;
@@ -95,8 +96,12 @@ sub resume {
unless ($self->_perl_is_same($self->{properties}{perl})) {
my $perl = $self->find_perl_interpreter;
- $self->log_warn(" * WARNING: Configuration was initially created with '$self->{properties}{perl}',\n".
- " but we are now using '$perl'.\n");
+ die(<<"DIEFATAL");
+* FATAL ERROR: Perl interpreter mismatch. Configuration was initially
+ created with '$self->{properties}{perl}'
+ but we are now using '$perl'. You must
+ run 'Build realclean' or 'make realclean' and re-configure.
+DIEFATAL
}
$self->cull_args(@ARGV);
@@ -105,7 +110,7 @@ sub resume {
my $mb_version = $Module::Build::VERSION;
if ( $mb_version ne $self->{properties}{mb_version} ) {
$self->log_warn(<<"MISMATCH");
-* WARNING: Configuration was initially created with Module::Build
+* WARNING: Configuration was initially created with Module::Build
version '$self->{properties}{mb_version}' but we are now using version '$mb_version'.
If errors occur, you must re-run the Build.PL or Makefile.PL script.
MISMATCH
@@ -201,15 +206,15 @@ sub _construct {
sub log_info {
my $self = shift;
- print @_ unless(ref($self) and $self->quiet);
+ print @_ if ref($self) && ( $self->verbose || ! $self->quiet );
}
sub log_verbose {
my $self = shift;
- $self->log_info(@_) if(ref($self) and $self->verbose);
+ print @_ if ref($self) && $self->verbose;
}
sub log_debug {
my $self = shift;
- print @_ if ref $self && $self->debug;
+ print @_ if ref($self) && $self->debug;
}
sub log_warn {
@@ -897,10 +902,13 @@ __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(dynamic_config => 1);
__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(metafile2 => 'META.json');
+__PACKAGE__->add_property(mymetafile2 => 'MYMETA.json');
__PACKAGE__->add_property(recurse_into => []);
__PACKAGE__->add_property(use_rcfile => 1);
__PACKAGE__->add_property(create_packlist => 1);
@@ -926,8 +934,7 @@ __PACKAGE__->add_property(
);
{
- my $Is_ActivePerl = eval {require ActivePerl::DocTools};
- __PACKAGE__->add_property(html_css => $Is_ActivePerl ? 'Active.css' : '');
+ __PACKAGE__->add_property(html_css => '');
}
{
@@ -964,6 +971,7 @@ __PACKAGE__->add_property($_) for qw(
dist_abstract
dist_author
dist_name
+ dist_suffix
dist_version
dist_version_from
extra_compiler_flags
@@ -984,6 +992,7 @@ __PACKAGE__->add_property($_) for qw(
program_name
quiet
recursive_test_files
+ release_status
script_files
scripts
share_dir
@@ -1124,6 +1133,41 @@ sub dist_name {
return $p->{dist_name};
}
+sub release_status {
+ my ($self) = @_;
+ my $p = $self->{properties};
+
+ if ( ! defined $p->{release_status} ) {
+ $p->{release_status} = $self->_is_dev_version ? 'testing' : 'stable';
+ }
+
+ unless ( $p->{release_status} =~ qr/\A(?:stable|testing|unstable)\z/ ) {
+ die "Illegal value '$p->{release_status}' for release_status\n";
+ }
+
+ if ( $p->{release_status} eq 'stable' && $self->_is_dev_version ) {
+ my $version = $self->dist_version;
+ die "Illegal value '$p->{release_status}' with version '$version'\n";
+ }
+ return $p->{release_status};
+}
+
+sub dist_suffix {
+ my ($self) = @_;
+ my $p = $self->{properties};
+ return $p->{dist_suffix} if defined $p->{dist_suffix};
+
+ if ( $self->release_status eq 'stable' ) {
+ $p->{dist_suffix} = "";
+ }
+ else {
+ # non-stable release but non-dev version number needs '-TRIAL' appended
+ $p->{dist_suffix} = $self->_is_dev_version ? "" : "TRIAL" ;
+ }
+
+ return $p->{dist_suffix};
+}
+
sub dist_version_from {
my ($self) = @_;
my $p = $self->{properties};
@@ -1144,7 +1188,11 @@ sub dist_version {
my $version_from = File::Spec->catfile( split( qr{/}, $dist_version_from ) );
my $pm_info = Module::Build::ModuleInfo->new_from_file( $version_from )
or die "Can't find file $version_from to determine version";
+ #$p->{dist_version} is undef here
$p->{dist_version} = $self->normalize_version( $pm_info->version() );
+ unless (defined $p->{dist_version}) {
+ die "Can't determine distribution version from $version_from";
+ }
}
die ("Can't determine distribution version, must supply either 'dist_version',\n".
@@ -1154,6 +1202,16 @@ sub dist_version {
return $p->{dist_version};
}
+sub _is_dev_version {
+ my ($self) = @_;
+ my $dist_version = $self->dist_version;
+ my $version_obj = eval { Module::Build::Version->new( $dist_version ) };
+ # assume it's normal if the version string is fatal -- in this case
+ # the author might be doing something weird so should play along and
+ # assume they'll specify all necessary behavior
+ return $@ ? 0 : $version_obj->is_alpha;
+}
+
sub dist_author { shift->_pod_parse('author') }
sub dist_abstract { shift->_pod_parse('abstract') }
@@ -1182,6 +1240,26 @@ sub find_module_by_name { # Method provided for backwards compatibility
return Module::Build::ModuleInfo->find_module_by_name(@_[1,2]);
}
+{
+ # $unlink_list_for_pid{$$} = [ ... ]
+ my %unlink_list_for_pid;
+
+ sub _unlink_on_exit {
+ my $self = shift;
+ for my $f ( @_ ) {
+ push @{$unlink_list_for_pid{$$}}, $f if -f $f;
+ }
+ return 1;
+ }
+
+ END {
+ for my $f ( map glob($_), @{ $unlink_list_for_pid{$$} || [] } ) {
+ next unless -e $f;
+ File::Path::rmtree($f, 0, 0);
+ }
+ }
+}
+
sub add_to_cleanup {
my $self = shift;
my %files = map {$self->localize_file_path($_), 1} @_;
@@ -1389,8 +1467,8 @@ sub _feature_deps_msg {
return $log_text;
}
-# Automatically detect and add prerequisites based on configuration
-sub auto_require {
+# Automatically detect configure_requires prereqs
+sub auto_config_requires {
my ($self) = @_;
my $p = $self->{properties};
@@ -1401,6 +1479,10 @@ sub auto_require {
&& ! exists $p->{configure_requires}{'Module::Build'}
) {
(my $ver = $VERSION) =~ s/^(\d+\.\d\d).*$/$1/; # last major release only
+ $self->log_warn(<<EOM);
+Module::Build was not found in configure_requires! Adding it now
+automatically as: configure_requires => { 'Module::Build' => $ver }
+EOM
$self->_add_prereq('configure_requires', 'Module::Build', $ver);
}
@@ -1415,6 +1497,14 @@ sub auto_require {
}
}
+ return;
+}
+
+# Automatically detect and add prerequisites based on configuration
+sub auto_require {
+ my ($self) = @_;
+ my $p = $self->{properties};
+
# 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;
@@ -1555,6 +1645,24 @@ sub _parse_conditions {
}
}
+sub try_require {
+ my ($self, $modname, $spec) = @_;
+ my $status = $self->check_installed_status($modname, defined($spec) ? $spec : 0);
+ return unless $status->{ok};
+ my $path = $modname;
+ $path =~ s{::}{/}g;
+ $path .= ".pm";
+ if ( defined $INC{$path} ) {
+ return 1;
+ }
+ elsif ( exists $INC{$path} ) { # failed before, don't try again
+ return;
+ }
+ else {
+ return eval "require $modname";
+ }
+}
+
sub check_installed_status {
my ($self, $modname, $spec) = @_;
my %status = (need => $spec);
@@ -1572,7 +1680,7 @@ sub check_installed_status {
return \%status;
}
- $status{have} = $pm_info->version();
+ $status{have} = eval { $pm_info->version() };
if ($spec and !defined($status{have})) {
@status{ qw(have message) } = (undef, "Couldn't find a \$VERSION in prerequisite $modname");
return \%status;
@@ -1684,11 +1792,15 @@ sub print_build_script {
my $closedata="";
+ my $config_requires;
+ if ( -f $self->metafile ) {
+ my $meta = eval { $self->read_metafile( $self->metafile ) };
+ $config_requires = $meta && $meta->{configure_requires}{'Module::Build'};
+ }
+ $config_requires ||= 0;
+
my %q = map {$_, $self->$_()} qw(config_dir base_dir);
- my $case_tolerant = 0+(File::Spec->can('case_tolerant')
- && File::Spec->case_tolerant);
- $q{base_dir} = uc $q{base_dir} if $case_tolerant;
$q{base_dir} = Win32::GetShortPathName($q{base_dir}) if $self->is_windowsish;
$q{magic_numfile} = $self->config_file('magicnum');
@@ -1744,6 +1856,7 @@ $quoted_INC
close(*DATA) unless eof(*DATA); # ensure no open handles to this script
use $build_package;
+Module::Build->VERSION(q{$config_requires});
# Some platforms have problems setting \$^X in shebang contexts, fix it up here
\$^X = Module::Build->find_perl_interpreter;
@@ -1766,38 +1879,72 @@ EOF
sub create_mymeta {
my ($self) = @_;
- my $mymetafile = $self->mymetafile;
- my $metafile = $self->metafile;
- # cleanup
- if ( $self->delete_filetree($mymetafile) ) {
- $self->log_verbose("Removed previous '$mymetafile'\n");
+ my ($meta_obj, $mymeta);
+ my @metafiles = ( $self->metafile, $self->metafile2 );
+ my @mymetafiles = ( $self->mymetafile, $self->mymetafile2 );
+
+ # cleanup old MYMETA
+ for my $f ( @mymetafiles ) {
+ if ( $self->delete_filetree($f) ) {
+ $self->log_verbose("Removed previous '$f'\n");
+ }
}
- $self->log_info("Creating new '$mymetafile' with configuration results\n");
- # use old meta and update prereqs, if possible
- my $mymeta;
- if ( -f $metafile ) {
- $mymeta = eval { $self->read_metafile( $self->metafile ) };
+ # Try loading META.json or META.yml
+ if ( $self->try_require("CPAN::Meta", "2.110420") ) {
+ for my $file ( @metafiles ) {
+ next unless -f $file;
+ $meta_obj = eval { CPAN::Meta->load_file($file) };
+ last if $meta_obj;
+ }
}
- # if we read META OK, just update it
+
+ # maybe get a copy in spec v2 format (regardless of original source)
+ $mymeta = $meta_obj->as_struct
+ if $meta_obj;
+
+ # if we have metadata, just update it
if ( defined $mymeta ) {
my $prereqs = $self->_normalize_prereqs;
- for my $t ( keys %$prereqs ) {
- $mymeta->{$t} = $prereqs->{$t};
+ # XXX refactor this mapping somewhere
+ $mymeta->{prereqs}{runtime}{requires} = $prereqs->{requires};
+ $mymeta->{prereqs}{build}{requires} = $prereqs->{build_requires};
+ $mymeta->{prereqs}{runtime}{recommends} = $prereqs->{recommends};
+ $mymeta->{prereqs}{runtime}{conflicts} = $prereqs->{conflicts};
+ # delete empty entries
+ for my $phase ( keys %{$mymeta->{prereqs}} ) {
+ if ( ref $mymeta->{prereqs}{$phase} eq 'HASH' ) {
+ for my $type ( keys %{$mymeta->{prereqs}{$phase}} ) {
+ if ( ! defined $mymeta->{prereqs}{$phase}{$type}
+ || ! keys %{$mymeta->{prereqs}{$phase}{$type}}
+ ) {
+ delete $mymeta->{prereqs}{$phase}{$type};
+ }
+ }
+ }
+ if ( ! defined $mymeta->{prereqs}{$phase}
+ || ! keys %{$mymeta->{prereqs}{$phase}}
+ ) {
+ delete $mymeta->{prereqs}{$phase};
+ }
}
+ $mymeta->{dynamic_config} = 0;
+ $mymeta->{generated_by} = "Module::Build version $Module::Build::VERSION";
+ eval { $meta_obj = CPAN::Meta->new( $mymeta, { lazy_validation => 1 } ) }
}
- # but generate from scratch, ignoring errors if META doesn't exist
+ # or generate from scratch, ignoring errors if META doesn't exist
else {
- $mymeta = $self->get_metadata( fatal => 0 );
+ $meta_obj = $self->_get_meta_object(
+ quiet => 0, dynamic => 0, fatal => 0, auto => 0
+ );
}
- # MYMETA is always static
- $mymeta->{dynamic_config} = 0;
- # Note which M::B created it
- $mymeta->{generated_by} = "Module::Build version $Module::Build::VERSION";
+ my @created = $self->_write_meta_files( $meta_obj, 'MYMETA' );
+
+ $self->log_warn("Could not create MYMETA files\n")
+ unless @created;
- $self->write_metafile( $mymetafile, $mymeta );
return 1;
}
@@ -1958,7 +2105,6 @@ sub _translate_option {
create_readme
extra_compiler_flags
extra_linker_flags
- html_css
install_base
install_path
meta_add
@@ -2068,7 +2214,7 @@ sub read_args {
$args{$_} ||= [];
$args{$_} = [ $args{$_} ] unless ref $args{$_};
foreach my $arg ( @{$args{$_}} ) {
- $arg =~ /(\w+)=(.*)/
+ $arg =~ /($opt_re)=(.*)/
or die "Malformed '$_' argument: '$arg' should be something like 'foo=bar'";
$hash{$1} = $2;
}
@@ -2208,6 +2354,11 @@ sub read_modulebuildrc {
my ($global_opts) =
$self->read_args( $self->split_like_shell( $options{'*'} || '' ) );
+
+ # let fakeinstall act like install if not provided
+ if ( $action eq 'fakeinstall' && ! exists $options{fakeinstall} ) {
+ $action = 'install';
+ }
my ($action_opts) =
$self->read_args( $self->split_like_shell( $options{$action} || '' ) );
@@ -2552,6 +2703,8 @@ sub do_tests {
my $tests = $self->find_test_files;
+ local $ENV{PERL_DL_NONLAZY} = 1;
+
if(@$tests) {
my $args = $self->tap_harness_args;
if($self->use_tap_harness or ($args and %$args)) {
@@ -2667,7 +2820,7 @@ sub ACTION_testcover {
# testcover was run. If so, start over.
if (-e 'cover_db') {
my $pm_files = $self->rscan_dir
- (File::Spec->catdir($self->blib, 'lib'), file_qr('\.pm$') );
+ (File::Spec->catdir($self->blib, 'lib'), $self->file_qr('\.pm$') );
my $cover_files = $self->rscan_dir('cover_db', sub {-f $_ and not /\.html$/});
$self->do_system(qw(cover -delete))
@@ -2728,11 +2881,19 @@ sub process_support_files {
my $p = $self->{properties};
return unless $p->{c_source};
- push @{$p->{include_dirs}}, $p->{c_source};
+ my $files;
+ if (ref($p->{c_source}) eq "ARRAY") {
+ push @{$p->{include_dirs}}, @{$p->{c_source}};
+ for my $path (@{$p->{c_source}}) {
+ push @$files, @{ $self->rscan_dir($path, $self->file_qr('\.c(c|p|pp|xx|\+\+)?$')) };
+ }
+ } else {
+ push @{$p->{include_dirs}}, $p->{c_source};
+ $files = $self->rscan_dir($p->{c_source}, $self->file_qr('\.c(c|p|pp|xx|\+\+)?$'));
+ }
- 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);
+ push @{$p->{objects}}, $self->compile_c($file);
}
}
@@ -2852,8 +3013,10 @@ sub find_PL_files {
}
return unless -d 'lib';
- return { map {$_, [/^(.*)\.PL$/i ]} @{ $self->rscan_dir('lib',
- file_qr('\.PL$')) } };
+ return {
+ map {$_, [/^(.*)\.PL$/i ]}
+ @{ $self->rscan_dir('lib', $self->file_qr('\.PL$')) }
+ };
}
sub find_pm_files { shift->_find_file_by_type('pm', 'lib') }
@@ -2906,7 +3069,7 @@ sub _find_file_by_type {
return { map {$_, $_}
map $self->localize_file_path($_),
grep !/\.\#/,
- @{ $self->rscan_dir($dir, file_qr("\\.$type\$")) } };
+ @{ $self->rscan_dir($dir, $self->file_qr("\\.$type\$")) } };
}
sub localize_file_path {
@@ -2934,7 +3097,7 @@ sub fix_shebang_line { # Adapted from fixin() in ExtUtils::MM_Unix 1.35
next unless $cmd =~ /perl/i;
my $interpreter = $self->{properties}{perl};
- $self->log_verbose("Changing sharpbang in $file to $interpreter");
+ $self->log_verbose("Changing sharpbang in $file to $interpreter\n");
my $shb = '';
$shb .= $c->get('sharpbang')."$interpreter $arg\n" if $does_shbang;
@@ -2979,7 +3142,7 @@ sub ACTION_testpod {
my @files = sort keys %{$self->_find_pods($self->libdoc_dirs)},
keys %{$self->_find_pods
($self->bindoc_dirs,
- exclude => [ file_qr('\.bat$') ])}
+ exclude => [ $self->file_qr('\.bat$') ])}
or die "Couldn't find any POD files to test\n";
{ package # hide from PAUSE
@@ -3033,6 +3196,24 @@ sub _is_default_installable {
) ? 1 : 0;
}
+sub _is_ActivePerl {
+# return 0;
+ my $self = shift;
+ unless (exists($self->{_is_ActivePerl})) {
+ $self->{_is_ActivePerl} = (eval { require ActivePerl::DocTools; } || 0);
+ }
+ return $self->{_is_ActivePerl};
+}
+
+sub _is_ActivePPM {
+# return 0;
+ my $self = shift;
+ unless (exists($self->{_is_ActivePPM})) {
+ $self->{_is_ActivePPM} = (eval { require ActivePerl::PPM; } || 0);
+ }
+ return $self->{_is_ActivePPM};
+}
+
sub ACTION_manpages {
my $self = shift;
@@ -3041,27 +3222,21 @@ sub ACTION_manpages {
$self->depends_on('code');
foreach my $type ( qw(bin lib) ) {
+ next unless ( $self->invoked_action eq 'manpages' || $self->_is_default_installable("${type}doc"));
my $files = $self->_find_pods( $self->{properties}{"${type}doc_dirs"},
- exclude => [ file_qr('\.bat$') ] );
+ exclude => [ $self->file_qr('\.bat$') ] );
next unless %$files;
my $sub = $self->can("manify_${type}_pods");
- next unless defined( $sub );
-
- if ( $self->invoked_action eq 'manpages' ) {
- $self->$sub();
- } elsif ( $self->_is_default_installable("${type}doc") ) {
- $self->$sub();
- }
+ $self->$sub() if defined( $sub );
}
-
}
sub manify_bin_pods {
my $self = shift;
my $files = $self->_find_pods( $self->{properties}{bindoc_dirs},
- exclude => [ file_qr('\.bat$') ] );
+ exclude => [ $self->file_qr('\.bat$') ] );
return unless keys %$files;
my $mandir = File::Spec->catdir( $self->blib, 'bindoc' );
@@ -3145,21 +3320,11 @@ sub ACTION_html {
$self->depends_on('code');
foreach my $type ( qw(bin lib) ) {
- my $files = $self->_find_pods( $self->{properties}{"${type}doc_dirs"},
- exclude =>
- [ file_qr('\.(?:bat|com|html)$') ] );
- next unless %$files;
-
- if ( $self->invoked_action eq 'html' ) {
- $self->htmlify_pods( $type );
- } elsif ( $self->_is_default_installable("${type}html") ) {
- $self->htmlify_pods( $type );
- }
+ next unless ( $self->invoked_action eq 'html' || $self->_is_default_installable("${type}html"));
+ $self->htmlify_pods( $type );
}
-
}
-
# 1) If it's an ActiveState perl install, we need to run
# ActivePerl::DocTools->UpdateTOC;
# 2) Links to other modules are not being generated
@@ -3168,13 +3333,10 @@ sub htmlify_pods {
my $type = shift;
my $htmldir = shift || File::Spec->catdir($self->blib, "${type}html");
- require Module::Build::PodParser;
- require Pod::Html;
-
$self->add_to_cleanup('pod2htm*');
my $pods = $self->_find_pods( $self->{properties}{"${type}doc_dirs"},
- exclude => [ file_qr('\.(?:bat|com|html)$') ] );
+ exclude => [ $self->file_qr('\.(?:bat|com|html)$') ] );
return unless %$pods; # nothing to do
unless ( -d $htmldir ) {
@@ -3184,21 +3346,54 @@ sub htmlify_pods {
my @rootdirs = ($type eq 'bin') ? qw(bin) :
$self->installdirs eq 'core' ? qw(lib) : qw(site lib);
+ my $podroot = $ENV{PERL_CORE}
+ ? File::Basename::dirname($ENV{PERL_CORE})
+ : $self->original_prefix('core');
+
+ my $htmlroot = $self->install_sets('core')->{libhtml};
+ my @podpath = (map { File::Spec->abs2rel($_ ,$podroot) } grep { -d }
+ ( $self->install_sets('core', 'lib'), # lib
+ $self->install_sets('core', 'bin'), # bin
+ $self->install_sets('site', 'lib'), # site/lib
+ ) ), File::Spec->rel2abs($self->blib);
+
+ my $podpath = $ENV{PERL_CORE}
+ ? File::Spec->catdir($podroot, 'lib')
+ : join(":", map { tr,:\\,|/,; $_ } @podpath);
+
+ my $blibdir = join('/', File::Spec->splitdir(
+ (File::Spec->splitpath(File::Spec->rel2abs($htmldir),1))[1]),''
+ );
- my $podpath = join ':',
- map $_->[1],
- grep -e $_->[0],
- map [File::Spec->catdir($self->blib, $_), $_],
- qw( script lib );
+ my ($with_ActiveState, $htmltool);
+ if ( $with_ActiveState = $self->_is_ActivePerl
+ && eval { require ActivePerl::DocTools::Pod; 1 }
+ ) {
+ my $tool_v = ActiveState::DocTools::Pod->VERSION;
+ $htmltool = "ActiveState::DocTools::Pod";
+ $htmltool .= " $tool_v" if $tool_v && length $tool_v;
+ }
+ else {
+ require Module::Build::PodParser;
+ require Pod::Html;
+ $htmltool = "Pod::Html " . Pod::Html->VERSION;
+ }
+ $self->log_verbose("Converting Pod to HTML with $htmltool\n");
+
+ my $errors = 0;
+
+ POD:
foreach my $pod ( keys %$pods ) {
my ($name, $path) = File::Basename::fileparse($pods->{$pod},
- file_qr('\.(?:pm|plx?|pod)$'));
+ $self->file_qr('\.(?:pm|plx?|pod)$')
+ );
my @dirs = File::Spec->splitdir( File::Spec->canonpath( $path ) );
pop( @dirs ) if scalar(@dirs) && $dirs[-1] eq File::Spec->curdir;
- my $fulldir = File::Spec->catfile($htmldir, @rootdirs, @dirs);
+ my $fulldir = File::Spec->catdir($htmldir, @rootdirs, @dirs);
+ my $tmpfile = File::Spec->catfile($fulldir, "${name}.tmp");
my $outfile = File::Spec->catfile($fulldir, "${name}.html");
my $infile = File::Spec->abs2rel($pod);
@@ -3209,38 +3404,82 @@ sub htmlify_pods {
or die "Couldn't mkdir $fulldir: $!";
}
- my $path2root = join( '/', ('..') x (@rootdirs+@dirs) );
- my $htmlroot = join( '/',
- ($path2root,
- $self->installdirs eq 'core' ? () : qw(site) ) );
-
- my $fh = IO::File->new($infile) or die "Can't read $infile: $!";
- my $abstract = Module::Build::PodParser->new(fh => $fh)->get_abstract();
-
- my $title = join( '::', (@dirs, $name) );
- $title .= " - $abstract" if $abstract;
-
- my @opts = (
- '--flush',
- "--title=$title",
- "--podpath=$podpath",
- "--infile=$infile",
- "--outfile=$outfile",
- '--podroot=' . $self->blib,
- "--htmlroot=$htmlroot",
- );
-
- if ( eval{Pod::Html->VERSION(1.03)} ) {
- push( @opts, ('--header', '--backlink=Back to Top') );
- push( @opts, "--css=$path2root/" . $self->html_css) if $self->html_css;
+ $self->log_verbose("HTMLifying $infile -> $outfile\n");
+ if ( $with_ActiveState ) {
+ my $depth = @rootdirs + @dirs;
+ my %opts = ( infile => $infile,
+ outfile => $tmpfile,
+ podpath => $podpath,
+ podroot => $podroot,
+ index => 1,
+ depth => $depth,
+ );
+ eval {
+ ActivePerl::DocTools::Pod::pod2html(%opts);
+ 1;
+ } or $self->log_warn("[$htmltool] pod2html (" .
+ join(", ", map { "q{$_} => q{$opts{$_}}" } (keys %opts)) . ") failed: $@");
+ } else {
+ my $path2root = join( '/', ('..') x (@rootdirs+@dirs) );
+ my $fh = IO::File->new($infile) or die "Can't read $infile: $!";
+ my $abstract = Module::Build::PodParser->new(fh => $fh)->get_abstract();
+
+ my $title = join( '::', (@dirs, $name) );
+ $title .= " - $abstract" if $abstract;
+
+ my @opts = (
+ '--flush',
+ "--title=$title",
+ "--podpath=$podpath",
+ "--infile=$infile",
+ "--outfile=$tmpfile",
+ "--podroot=$podroot",
+ "--htmlroot=$path2root",
+ );
+
+ if ( eval{Pod::Html->VERSION(1.03)} ) {
+ push( @opts, ('--header', '--backlink=Back to Top') );
+ }
+
+ $self->log_verbose("P::H::pod2html @opts\n");
+ {
+ my $orig = Cwd::getcwd();
+ eval { Pod::Html::pod2html(@opts); 1 }
+ or $self->log_warn("[$htmltool] pod2html( " .
+ join(", ", map { "q{$_}" } @opts) . ") failed: $@");
+ chdir($orig);
+ }
+ }
+ # We now have to cleanup the resulting html file
+ if ( ! -r $tmpfile ) {
+ $errors++;
+ next POD;
}
+ my $fh = IO::File->new($tmpfile) or die "Can't read $tmpfile: $!";
+ my $html = join('',<$fh>);
+ $fh->close;
+ if (!$self->_is_ActivePerl) {
+ # These fixups are already done by AP::DT:P:pod2html
+ # The output from pod2html is NOT XHTML!
+ # IE6+ will display content that is not valid for DOCTYPE
+ $html =~ s#^<!DOCTYPE .*?>#<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN">#im;
+ $html =~ s#<html xmlns="http://www.w3.org/1999/xhtml">#<html>#i;
+
+ # IE6+ will not display local HTML files with strict
+ # security without this comment
+ $html =~ s#<head>#<head>\n<!-- saved from url=(0017)http://localhost/ -->#i;
+ }
+ # Fixup links that point to our temp blib
+ $html =~ s/\Q$blibdir\E//g;
- $self->log_verbose("HTMLifying $infile -> $outfile\n");
- $self->log_verbose("pod2html @opts\n");
- eval { Pod::Html::pod2html(@opts); 1 }
- or $self->log_warn("pod2html @opts failed: $@");
+ $fh = IO::File->new(">$outfile") or die "Can't write $outfile: $!";
+ print $fh $html;
+ $fh->close;
+ unlink($tmpfile);
}
+ return ! $errors;
+
}
# Adapted from ExtUtils::MM_Unix
@@ -3285,7 +3524,7 @@ sub ACTION_diff {
delete $installmap->{read};
delete $installmap->{write};
- my $text_suffix = file_qr('\.(pm|pod)$');
+ my $text_suffix = $self->file_qr('\.(pm|pod)$');
while (my $localdir = each %$installmap) {
my @localparts = File::Spec->splitdir($localdir);
@@ -3323,7 +3562,35 @@ sub ACTION_install {
my ($self) = @_;
require ExtUtils::Install;
$self->depends_on('build');
- ExtUtils::Install::install($self->install_map, $self->verbose, 0, $self->{args}{uninst}||0);
+ # RT#63003 suggest that odd cirmstances that we might wind up
+ # in a different directory than we started, so wrap with _do_in_dir to
+ # ensure we get back to where we started; hope this fixes it!
+ $self->_do_in_dir( ".", sub {
+ ExtUtils::Install::install(
+ $self->install_map, $self->verbose, 0, $self->{args}{uninst}||0
+ );
+ });
+ if ($self->_is_ActivePerl && $self->{_completed_actions}{html}) {
+ $self->log_info("Building ActivePerl Table of Contents\n");
+ eval { ActivePerl::DocTools::WriteTOC(verbose => $self->verbose ? 1 : 0); 1; }
+ or $self->log_warn("AP::DT:: WriteTOC() failed: $@");
+ }
+ if ($self->_is_ActivePPM) {
+ # We touch 'lib/perllocal.pod'. There is an existing logic in subroutine _init_db()
+ # of 'ActivePerl/PPM/InstallArea.pm' that says that if 'lib/perllocal.pod' has a 'date-last-touched'
+ # greater than that of the PPM SQLite databases ('etc/ppm-perl-area.db' and/or
+ # 'site/etc/ppm-site-area.db') then the PPM SQLite databases are rebuilt from scratch.
+
+ # in the following line, 'perllocal.pod' this is *always* 'lib/perllocal.pod', never 'site/lib/perllocal.pod'
+ my $F_perllocal = File::Spec->catfile($self->install_sets('core', 'lib'), 'perllocal.pod');
+ my $dt_stamp = time;
+
+ $self->log_info("For ActivePerl's PPM: touch '$F_perllocal'\n");
+
+ open my $perllocal, ">>", $F_perllocal;
+ close $perllocal;
+ utime($dt_stamp, $dt_stamp, $F_perllocal);
+ }
}
sub ACTION_fakeinstall {
@@ -3390,8 +3657,13 @@ sub ACTION_installdeps {
# relative command should be relative to our active Perl
# so we need to locate that command
if ( ! File::Spec->file_name_is_absolute( $command ) ) {
+ # prefer site to vendor to core
+ my @loc = ( 'site', 'vendor', '' );
my @bindirs = File::Basename::dirname($self->perl);
- push @bindirs, map {$self->config->{"install${_}bin"}} '','site','vendor';
+ push @bindirs,
+ map {
+ ($self->config->{"install${_}bin"}, $self->config->{"install${_}script"})
+ } @loc;
for my $d ( @bindirs ) {
my $abs_cmd = $self->find_command(File::Spec->catfile( $d, $command ));
if ( defined $abs_cmd ) {
@@ -3421,7 +3693,7 @@ sub ACTION_realclean {
$self->depends_on('clean');
$self->log_info("Cleaning up configuration files\n");
$self->delete_filetree(
- $self->config_dir, $self->mymetafile, $self->build_script
+ $self->config_dir, $self->mymetafile, $self->mymetafile2, $self->build_script
);
}
@@ -3476,7 +3748,6 @@ sub ACTION_ppmdist {
}
foreach my $type ( qw(bin lib) ) {
- local $self->{properties}{html_css} = 'Active.css';
$self->htmlify_pods( $type, File::Spec->catdir($ppm, 'blib', 'html') );
}
@@ -3513,7 +3784,8 @@ sub ACTION_pardist {
sub ACTION_dist {
my ($self) = @_;
- $self->depends_on('distdir');
+ # MUST dispatch() and not depends_ok() so we generate a clean distdir
+ $self->dispatch('distdir');
my $dist_dir = $self->dist_dir;
@@ -3553,9 +3825,12 @@ sub _check_mymeta_skip {
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);
+ for my $file ( $self->mymetafile, $self->mymetafile2 ) {
+ unless ( $skip_factory && $skip_factory->($maniskip)->($file) ) {
+ $self->log_warn("File '$maniskip' does not include '$file'. Adding it now.\n");
+ my $safe = quotemeta($file);
+ $self->_append_maniskip("^$safe\$", $maniskip);
+ }
}
}
@@ -3609,7 +3884,7 @@ sub _sign_dir {
sub _do_in_dir {
my ($self, $dir, $do) = @_;
- my $start_dir = $self->cwd;
+ my $start_dir = File::Spec->rel2abs($self->cwd);
chdir $dir or die "Can't chdir() to $dir: $!";
eval {$do->()};
my @err = $@ ? ($@) : ();
@@ -3645,7 +3920,11 @@ sub do_create_makefile_pl {
my $self = shift;
require Module::Build::Compat;
$self->log_info("Creating Makefile.PL\n");
- Module::Build::Compat->create_makefile_pl($self->create_makefile_pl, $self, @_);
+ eval { Module::Build::Compat->create_makefile_pl($self->create_makefile_pl, $self, @_) };
+ if ( $@ ) {
+ 1 while unlink 'Makefile.PL';
+ die "$@\n";
+ }
$self->_add_to_manifest('MANIFEST', 'Makefile.PL');
}
@@ -3659,19 +3938,16 @@ sub do_create_license {
}
my $l = $self->license
- or die "No license specified";
-
- my $key = $self->valid_licenses->{$l}
- or die "'$l' isn't a license key we know about";
- my $class = "Software::License::$key";
+ or die "Can't create LICENSE file: No license specified\n";
- eval "use $class; 1"
- or die "Can't load Software::License::$key to create LICENSE file: $@";
+ my $license = $self->_software_license_object
+ or die << "HERE";
+Can't create LICENSE file: '$l' is not a valid license key
+or Software::License subclass;
+HERE
$self->delete_filetree('LICENSE');
- my $author = join " & ", @{ $self->dist_author };
- my $license = $class->new({holder => $author});
my $fh = IO::File->new('> LICENSE')
or die "Can't write LICENSE file: $!";
print $fh $license->fulltext;
@@ -3770,9 +4046,6 @@ sub ACTION_distdir {
$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.\n";
delete $dist_files->{SIGNATURE}; # Don't copy, create a fresh one
@@ -3788,6 +4061,7 @@ sub ACTION_distdir {
$self->add_to_cleanup($dist_dir);
foreach my $file (keys %$dist_files) {
+ next if $file =~ m{^MYMETA\.}; # Double check that we skip MYMETA.*
my $new = $self->copy_if_modified(from => $file, to_dir => $dist_dir, verbose => 0);
}
@@ -3815,6 +4089,22 @@ sub ACTION_disttest {
});
}
+sub ACTION_distinstall {
+ my ($self, @args) = @_;
+
+ $self->depends_on('distdir');
+
+ $self->_do_in_dir ( $self->dist_dir,
+ sub {
+ $self->run_perl_script('Build.PL')
+ or die "Error executing 'Build.PL' in dist directory: $!";
+ $self->run_perl_script('Build')
+ or die "Error executing 'Build' in dist directory: $!";
+ $self->run_perl_script('Build', [], ['install'])
+ or die "Error executing 'Build install' in dist directory";
+ }
+ );
+}
=begin private
@@ -3873,12 +4163,33 @@ Reads $file and returns the $content.
sub _slurp {
my $self = shift;
my $file = shift;
- open my $fh, "<", $file or croak "Can't open $file: $!";
+ my $mode = shift || "";
+ open my $fh, "<$mode", $file or croak "Can't open $file for reading: $!";
local $/;
return <$fh>;
}
+sub _spew {
+ my $self = shift;
+ my $file = shift;
+ my $content = shift || "";
+ my $mode = shift || "";
+ open my $fh, ">$mode", $file or croak "Can't open $file for writing: $!";
+ print {$fh} $content;
+ close $fh;
+}
+sub _case_tolerant {
+ my $self = shift;
+ if ( ref $self ) {
+ $self->{_case_tolerant} = File::Spec->case_tolerant
+ unless defined($self->{_case_tolerant});
+ return $self->{_case_tolerant};
+ }
+ else {
+ return File::Spec->case_tolerant;
+ }
+}
sub _append_maniskip {
my $self = shift;
@@ -3933,7 +4244,7 @@ sub _check_manifest_skip {
if ( ! -e $maniskip ) {
$self->log_warn("File '$maniskip' does not exist: Creating a temporary '$maniskip'\n");
$self->_write_default_maniskip($maniskip);
- $self->add_to_cleanup($maniskip);
+ $self->_unlink_on_exit($maniskip);
}
else {
# MYMETA must not be added to MANIFEST, so always confirm the skip
@@ -3953,14 +4264,28 @@ sub ACTION_manifest {
ExtUtils::Manifest::mkmanifest();
}
+sub ACTION_manifest_skip {
+ my ($self) = @_;
+
+ if ( -e 'MANIFEST.SKIP' ) {
+ $self->log_warn("MANIFEST.SKIP already exists.\n");
+ return 0;
+ }
+ $self->log_info("Creating a new MANIFEST.SKIP file\n");
+ return $self->_write_default_maniskip;
+ return -e 'MANIFEST.SKIP'
+}
+
# Case insensitive regex for files
sub file_qr {
- return File::Spec->case_tolerant ? qr($_[0])i : qr($_[0]);
+ return shift->{_case_tolerant} ? qr($_[0])i : qr($_[0]);
}
sub dist_dir {
my ($self) = @_;
- return join "-", $self->dist_name, $self->dist_version;
+ my $dir = join "-", $self->dist_name, $self->dist_version;
+ $dir .= "-" . $self->dist_suffix if $self->dist_suffix;
+ return $dir;
}
sub ppm_name {
@@ -4058,13 +4383,13 @@ sub script_files {
}
my %pl_files = map {
- File::Spec->canonpath( File::Spec->case_tolerant ? uc $_ : $_ ) => 1
+ File::Spec->canonpath( $_ ) => 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( $_ )
} @bin_files;
return $_ = { map {$_ => 1} grep !$pl_files{$bin_map{$_}}, @bin_files };
@@ -4123,6 +4448,32 @@ BEGIN { *scripts = \&script_files; }
}
}
+# use mapping or license name directly
+sub _software_license_object {
+ my ($self) = @_;
+ return unless defined( my $license = $self->license );
+
+ my $class;
+ LICENSE: for my $l ( $self->valid_licenses->{ $license }, $license ) {
+ next unless defined $l;
+ my $trial = "Software::License::" . $l;
+ if ( eval "require Software::License; Software::License->VERSION(0.014); require $trial; 1" ) {
+ $class = $trial;
+ last LICENSE;
+ }
+ }
+ return unless defined $class;
+
+ # Software::License requires a 'holder' argument
+ my $author = join( " & ", @{ $self->dist_author }) || 'unknown';
+ my $sl = eval { $class->new({holder=>$author}) };
+ if ( $@ ) {
+ $self->log_warn( "Error getting '$class' object: $@" );
+ }
+
+ return $sl;
+}
+
sub _hash_merge {
my ($self, $h, $k, $v) = @_;
if (ref $h->{$k} eq 'ARRAY') {
@@ -4136,7 +4487,6 @@ sub _hash_merge {
sub ACTION_distmeta {
my ($self) = @_;
-
$self->do_create_makefile_pl if $self->create_makefile_pl;
$self->do_create_readme if $self->create_readme;
$self->do_create_license if $self->create_license;
@@ -4148,19 +4498,15 @@ sub do_create_metafile {
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';
}
- unless (exists $self->valid_licenses->{ $p->{license} }) {
- die "Unknown license type '$p->{license}'";
- }
+ my @metafiles = ( $self->metafile, $self->metafile2 );
# If we're in the distdir, the metafile may exist and be non-writable.
- $self->delete_filetree($metafile);
- $self->log_info("Creating $metafile\n");
+ $self->delete_filetree($_) for @metafiles;
# Since we're building ourself, we have to do some special stuff
# here: the ConfigData module is found in blib/lib.
@@ -4170,49 +4516,85 @@ sub do_create_metafile {
push @INC, File::Spec->catdir($self->blib, 'lib');
}
- if ($self->write_metafile($self->metafile,$self->get_metadata(fatal=>1))){
+ my $meta_obj = $self->_get_meta_object(
+ quiet => 1, fatal => 1, auto => 1
+ );
+ my @created = $self->_write_meta_files( $meta_obj, 'META' );
+ if ( @created ) {
$self->{wrote_metadata} = 1;
- $self->_add_to_manifest('MANIFEST', $metafile);
+ $self->_add_to_manifest('MANIFEST', $_) for @created;
}
-
return 1;
}
-sub read_metafile {
+sub _write_meta_files {
my $self = shift;
- my ($metafile) = @_;
- my $yaml;
+ my ($meta, $file) = @_;
+ $file =~ s{\.(?:yml|json)$}{};
+
+ my @created;
+ push @created, "$file\.yml"
+ if $meta && $meta->save( "$file\.yml", {version => "1.4"} );
+ push @created, "$file\.json"
+ if $meta && $meta->save( "$file\.json" );
+
+ if ( @created ) {
+ $self->log_info("Created " . join(" and ", @created) . "\n");
+ }
+ return @created;
+}
+
+sub _get_meta_object {
+ my $self = shift;
+ my %args = @_;
+ return unless $self->try_require("CPAN::Meta", "2.110420");
+
+ my $meta;
+ eval {
+ my $data = $self->get_metadata(
+ fatal => $args{fatal},
+ auto => $args{auto},
+ );
+ $data->{dynamic_config} = $args{dynamic} if defined $args{dynamic};
+ $meta = CPAN::Meta->create( $data );
+ };
+ if ($@ && ! $args{quiet}) {
+ $self->log_warn(
+ "Could not get valid metadata. Error is: $@\n"
+ );
+ }
- my $class = $self->_mb_feature('YAML_support')
- ? 'YAML::Tiny' : 'Module::Build::YAML' ;
+ return $meta;
+}
- eval "require $class; 1" or die $@;
- my $meta = $class->read($metafile)
- or $self->log_warn( "Error reading '$metafile': " . $class->errstr . "\n");
+# We return a version 1.4 structure for backwards compatibility
+sub read_metafile {
+ my $self = shift;
+ my ($metafile) = @_;
- return $meta->[0] || {};
+ return unless $self->try_require("CPAN::Meta", "2.110420");
+ my $meta = CPAN::Meta->load_file($metafile);
+ return $meta->as_struct( {version => "1.4"} );
}
+# For legacy compatibility, we upconvert a 1.4 data structure, ensuring
+# validity, and then downconvert it back to save it.
+#
+# generally, this code should no longer be used
sub write_metafile {
my $self = shift;
- my ($metafile, $node) = @_;
- my $yaml;
+ my ($metafile, $struct) = @_;
- if ($self->_mb_feature('YAML_support')) {
- # XXX this is probably redundant, but stick with it
- require YAML::Tiny;
- $yaml = YAML::Tiny->new($node);
- } else {
- require Module::Build::YAML;
- $yaml = Module::Build::YAML->new($node);
- }
- my $result = $yaml->write($metafile)
- or $self->log_warn( "Error writing '$metafile': " . $yaml->errstr . "\n");
- return $result;
+ return unless $self->try_require("CPAN::Meta", "2.110420");
+
+ my $meta = CPAN::Meta->new( $struct );
+ return $meta->save( $metafile, { version => "1.4" } );
}
sub normalize_version {
my ($self, $version) = @_;
+ $version = 0 unless defined $version and length $version;
+
if ( $version =~ /[=<>!,]/ ) { # logic, not just version
# take as is without modification
}
@@ -4247,7 +4629,6 @@ sub _normalize_prereqs {
return \%prereq_types;
}
-
# wrapper around old prepare_metadata API;
sub get_metadata {
my ($self, %args) = @_;
@@ -4270,6 +4651,8 @@ sub prepare_metadata {
my $fatal = $args->{fatal} || 0;
my $p = $self->{properties};
+ $self->auto_config_requires if $args->{auto};
+
# A little helper sub
my $add_node = sub {
my ($name, $val) = @_;
@@ -4277,11 +4660,11 @@ sub prepare_metadata {
push @$keys, $name if $keys;
};
- foreach (qw(dist_name dist_version dist_author dist_abstract license)) {
- (my $name = $_) =~ s/^dist_//;
- $add_node->($name, $self->$_());
- unless ( defined($node->{$name}) && length($node->{$name}) ) {
- my $err = "ERROR: Missing required field '$_' for metafile\n";
+ # validate required fields
+ foreach my $f (qw(dist_name dist_version dist_author dist_abstract license)) {
+ my $field = $self->$f();
+ unless ( defined $field and length $field ) {
+ my $err = "ERROR: Missing required field '$f' for metafile\n";
if ( $fatal ) {
die $err;
}
@@ -4290,33 +4673,46 @@ sub prepare_metadata {
}
}
}
+
+
+ # add dist_* fields
+ foreach my $f (qw(dist_name dist_version dist_author dist_abstract)) {
+ (my $name = $f) =~ s/^dist_//;
+ $add_node->($name, $self->$f());
+ }
+
+ # normalize version
$node->{version} = $self->normalize_version($node->{version});
- if (defined( my $l = $self->license )) {
- unless ( exists $self->valid_licenses->{ $l } ) {
- my $err = "Unknown license string '$l'";
- if ( $fatal ) {
- die $err;
- }
- else {
- $self->log_warn($err);
- }
- }
+ # validate license information
+ my $license = $self->license;
+ my ($meta_license, $meta_license_url);
- if (my $key = $self->valid_licenses->{ $l }) {
- my $class = "Software::License::$key";
- if (eval "require Software::License; require $class; 1") {
- # S::L requires a 'holder' key
- $node->{resources}{license} = $class->new({holder=>"nobody"})->url;
- }
- else {
- $node->{resources}{license} = $self->_license_url($l);
- }
- }
- # XXX we are silently omitting the url for any unknown license
+ # XXX this is still meta spec version 1 stuff
+
+ # if Software::License::* exists, then we can use it to get normalized name
+ # for META files
+
+ if ( my $sl = $self->_software_license_object ) {
+ $meta_license = $sl->meta_name;
+ $meta_license_url = $sl->url;
+ }
+ elsif ( exists $self->valid_licenses()->{$license} ) {
+ $meta_license = $license;
+ $meta_license_url = $self->_license_url( $license );
+ }
+ else {
+ # if we didn't find a license from a Software::License class,
+ # then treat it as unknown
+ $self->log_warn( "Can not determine license type for '" . $self->license
+ . "'\nSetting META license field to 'unknown'.\n");
+ $meta_license = 'unknown';
}
+ $node->{license} = $meta_license;
+ $node->{resources}{license} = $meta_license_url if defined $meta_license_url;
+ # add prerequisite data
my $prereqs = $self->_normalize_prereqs;
for my $t ( keys %$prereqs ) {
$add_node->($t, $prereqs->{$t});
@@ -4385,6 +4781,8 @@ sub find_dist_packages {
return $self->find_packages_in_files(\@pm_files, \%dist_files);
}
+# XXX Do not document this function; mst wrote it and now says the API is
+# stupid and needs to be fixed and it shouldn't become a public API until then
sub find_packages_in_files {
my ($self, $file_list, $filename_map) = @_;
@@ -4791,6 +5189,13 @@ sub install_map {
my $localdir = File::Spec->catdir( $blib, $type );
next unless -e $localdir;
+ # the line "...next if (($type eq 'bindoc'..." was one of many changes introduced for
+ # improving HTML generation on ActivePerl, see https://rt.cpan.org/Public/Bug/Display.html?id=53478
+ # Most changes were ok, but this particular line caused test failures in t/manifypods.t on windows,
+ # therefore it is commented out.
+
+ # ********* next if (($type eq 'bindoc' || $type eq 'libdoc') && not $self->is_unixish);
+
if (my $dest = $self->install_destination($type)) {
$map{$localdir} = $dest;
} else {
@@ -5234,7 +5639,7 @@ sub dir_contains {
return 0 if @second_dirs < @first_dirs;
- my $is_same = ( File::Spec->case_tolerant
+ my $is_same = ( $self->_case_tolerant
? sub {lc(shift()) eq lc(shift())}
: sub {shift() eq shift()} );
diff --git a/Master/tlpkg/tlperl/lib/Module/Build/Compat.pm b/Master/tlpkg/tlperl/lib/Module/Build/Compat.pm
index 95d695f6f56..1863b55ab75 100644
--- a/Master/tlpkg/tlperl/lib/Module/Build/Compat.pm
+++ b/Master/tlpkg/tlperl/lib/Module/Build/Compat.pm
@@ -2,7 +2,7 @@ package Module::Build::Compat;
use strict;
use vars qw($VERSION);
-$VERSION = '0.3603';
+$VERSION = '0.3800';
use File::Basename ();
use File::Spec;
@@ -65,10 +65,6 @@ 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 ||= {};
@@ -78,8 +74,18 @@ sub _merge_prereq {
for my $p ( $req, $breq ) {
for my $k (keys %$p) {
next if $k eq 'perl';
- die "Prereq '$p->{$k}' for '$k' is not supported by Module::Build::Compat\n"
- unless _simple_prereq($p->{$k});
+
+ my $v_obj = eval { Module::Build::Version->new($p->{$k}) };
+ if ( ! defined $v_obj ) {
+ die "A prereq of the form '$p->{$k}' for '$k' is not supported by Module::Build::Compat ( use a simpler version like '0.05' or 'v1.4.25' )\n";
+ }
+
+ # It seems like a lot of people trip over "0.1.2" stuff, so we help them here...
+ if ( $v_obj->is_qv ) {
+ my $proper_ver = $v_obj->numify;
+ warn "Dotted-decimal prereq '$p->{$k}' for '$k' is not portable - converting it to '$proper_ver'\n";
+ $p->{$k} = $proper_ver;
+ }
}
}
# merge
@@ -201,7 +207,7 @@ EOF
} elsif ($type eq 'traditional') {
my (%MM_Args, %prereq);
- if (eval "use Tie::IxHash; 1") {
+ if (eval "use Tie::IxHash 1.2; 1") {
tie %MM_Args, 'Tie::IxHash'; # Don't care if it fails here
tie %prereq, 'Tie::IxHash'; # Don't care if it fails here
}
@@ -444,7 +450,6 @@ __END__
Module::Build::Compat - Compatibility with ExtUtils::MakeMaker
-
=head1 SYNOPSIS
# In a Build.PL :
diff --git a/Master/tlpkg/tlperl/lib/Module/Build/Config.pm b/Master/tlpkg/tlperl/lib/Module/Build/Config.pm
index 997960073fd..b36e76798fe 100644
--- a/Master/tlpkg/tlperl/lib/Module/Build/Config.pm
+++ b/Master/tlpkg/tlperl/lib/Module/Build/Config.pm
@@ -2,7 +2,7 @@ package Module::Build::Config;
use strict;
use vars qw($VERSION);
-$VERSION = '0.3603';
+$VERSION = '0.3800';
$VERSION = eval $VERSION;
use Config;
diff --git a/Master/tlpkg/tlperl/lib/Module/Build/ConfigData.pm b/Master/tlpkg/tlperl/lib/Module/Build/ConfigData.pm
index 15114ee072b..85fa28d869b 100644
--- a/Master/tlpkg/tlperl/lib/Module/Build/ConfigData.pm
+++ b/Master/tlpkg/tlperl/lib/Module/Build/ConfigData.pm
@@ -181,12 +181,6 @@ do{ my $x = [
},
'description' => 'Bundle Module::Build in inc/'
},
- 'YAML_support' => {
- 'requires' => {
- 'YAML::Tiny' => '1.38'
- },
- 'description' => 'Use YAML::Tiny to write META.yml files'
- },
'manpage_support' => {
'requires' => {
'Pod::Man' => 0
diff --git a/Master/tlpkg/tlperl/lib/Module/Build/Cookbook.pm b/Master/tlpkg/tlperl/lib/Module/Build/Cookbook.pm
index a68dca540ab..9ead1653a50 100644
--- a/Master/tlpkg/tlperl/lib/Module/Build/Cookbook.pm
+++ b/Master/tlpkg/tlperl/lib/Module/Build/Cookbook.pm
@@ -1,7 +1,7 @@
package Module::Build::Cookbook;
use strict;
use vars qw($VERSION);
-$VERSION = '0.3603';
+$VERSION = '0.3800';
=head1 NAME
diff --git a/Master/tlpkg/tlperl/lib/Module/Build/Dumper.pm b/Master/tlpkg/tlperl/lib/Module/Build/Dumper.pm
index 2a9bad1b637..df459859985 100644
--- a/Master/tlpkg/tlperl/lib/Module/Build/Dumper.pm
+++ b/Master/tlpkg/tlperl/lib/Module/Build/Dumper.pm
@@ -1,7 +1,7 @@
package Module::Build::Dumper;
use strict;
use vars qw($VERSION);
-$VERSION = '0.3603';
+$VERSION = '0.3800';
# This is just a split-out of a wrapper function to do Data::Dumper
# stuff "the right way". See:
diff --git a/Master/tlpkg/tlperl/lib/Module/Build/ModuleInfo.pm b/Master/tlpkg/tlperl/lib/Module/Build/ModuleInfo.pm
index 053ae18d523..e15c010166b 100644
--- a/Master/tlpkg/tlperl/lib/Module/Build/ModuleInfo.pm
+++ b/Master/tlpkg/tlperl/lib/Module/Build/ModuleInfo.pm
@@ -2,390 +2,13 @@
# vim:ts=8:sw=2:et:sta:sts=2
package Module::Build::ModuleInfo;
-# This module provides routines to gather information about
-# perl modules (assuming this may be expanded in the distant
-# parrot future to look at other types of modules).
-
use strict;
use vars qw($VERSION);
-$VERSION = '0.3603';
+$VERSION = '0.3800';
$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
- package # the word 'package'
- \s+ # whitespace
- ([\w:]+) # a package name
- \s* # optional whitespace
- ($V_NUM_REGEXP)? # optional version number
- \s* # optional whitesapce
- ; # semicolon line terminator
-}x;
-
-my $VARNAME_REGEXP = qr{ # match fully-qualified VERSION name
- ([\$*]) # sigil - $ or *
- (
- ( # optional leading package name
- (?:::|\')? # possibly starting like just :: (Ì la $::VERSION)
- (?:\w+(?:::|\'))* # Foo::Bar:: ...
- )?
- VERSION
- )\b
-}x;
-
-my $VERS_REGEXP = qr{ # match a VERSION definition
- (?:
- \(\s*$VARNAME_REGEXP\s*\) # with parens
- |
- $VARNAME_REGEXP # without parens
- )
- \s*
- =[^=~] # = but not ==, nor =~
-}x;
-
-
-sub new_from_file {
- my $class = shift;
- my $filename = File::Spec->rel2abs( shift );
-
- return undef unless defined( $filename ) && -f $filename;
- return $class->_init(undef, $filename, @_);
-}
-
-sub new_from_module {
- my $class = shift;
- my $module = shift;
- my %props = @_;
-
- $props{inc} ||= \@INC;
- my $filename = $class->find_module_by_name( $module, $props{inc} );
- return undef unless defined( $filename ) && -f $filename;
- return $class->_init($module, $filename, %props);
-}
-
-sub _init {
- my $class = shift;
- my $module = shift;
- my $filename = shift;
- my %props = @_;
-
- my( %valid_props, @valid_props );
- @valid_props = qw( collect_pod inc );
- @valid_props{@valid_props} = delete( @props{@valid_props} );
- warn "Unknown properties: @{[keys %props]}\n" if scalar( %props );
-
- my %data = (
- module => $module,
- filename => $filename,
- version => undef,
- packages => [],
- versions => {},
- pod => {},
- pod_headings => [],
- collect_pod => 0,
-
- %valid_props,
- );
-
- my $self = bless(\%data, $class);
-
- $self->_parse_file();
-
- unless($self->{module} and length($self->{module})) {
- my ($v, $d, $f) = File::Spec->splitpath($self->{filename});
- if($f =~ /\.pm$/) {
- $f =~ s/\..+$//;
- my @candidates = grep /$f$/, @{$self->{packages}};
- $self->{module} = shift(@candidates); # punt
- }
- else {
- if(grep /main/, @{$self->{packages}}) {
- $self->{module} = 'main';
- }
- else {
- $self->{module} = $self->{packages}[0] || '';
- }
- }
- }
-
- $self->{version} = $self->{versions}{$self->{module}}
- if defined( $self->{module} );
-
- return $self;
-}
-
-# class method
-sub _do_find_module {
- my $class = shift;
- my $module = shift || die 'find_module_by_name() requires a package name';
- my $dirs = shift || \@INC;
-
- my $file = File::Spec->catfile(split( /::/, $module));
- foreach my $dir ( @$dirs ) {
- my $testfile = File::Spec->catfile($dir, $file);
- return [ File::Spec->rel2abs( $testfile ), $dir ]
- if -e $testfile and !-d _; # For stuff like ExtUtils::xsubpp
- return [ File::Spec->rel2abs( "$testfile.pm" ), $dir ]
- if -e "$testfile.pm";
- }
- return;
-}
-
-# class method
-sub find_module_by_name {
- my $found = shift()->_do_find_module(@_) or return;
- return $found->[0];
-}
-
-# class method
-sub find_module_dir_by_name {
- my $found = shift()->_do_find_module(@_) or return;
- return $found->[1];
-}
-
-
-# given a line of perl code, attempt to parse it if it looks like a
-# $VERSION assignment, returning sigil, full name, & package name
-sub _parse_version_expression {
- my $self = shift;
- my $line = shift;
-
- my( $sig, $var, $pkg );
- if ( $line =~ $VERS_REGEXP ) {
- ( $sig, $var, $pkg ) = $2 ? ( $1, $2, $3 ) : ( $4, $5, $6 );
- if ( $pkg ) {
- $pkg = ($pkg eq '::') ? 'main' : $pkg;
- $pkg =~ s/::$//;
- }
- }
-
- return ( $sig, $var, $pkg );
-}
-
-sub _parse_file {
- my $self = shift;
-
- my $filename = $self->{filename};
- my $fh = IO::File->new( $filename )
- or die( "Can't open '$filename': $!" );
-
- $self->_parse_fh($fh);
-}
-
-sub _parse_fh {
- my ($self, $fh) = @_;
-
- my( $in_pod, $seen_end, $need_vers ) = ( 0, 0, 0 );
- my( @pkgs, %vers, %pod, @pod );
- my $pkg = 'main';
- my $pod_sect = '';
- my $pod_data = '';
-
- while (defined( my $line = <$fh> )) {
- my $line_num = $.;
-
- chomp( $line );
- next if $line =~ /^\s*#/;
-
- $in_pod = ($line =~ /^=(?!cut)/) ? 1 : ($line =~ /^=cut/) ? 0 : $in_pod;
-
- # Would be nice if we could also check $in_string or something too
- last if !$in_pod && $line =~ /^__(?:DATA|END)__$/;
-
- if ( $in_pod || $line =~ /^=cut/ ) {
-
- if ( $line =~ /^=head\d\s+(.+)\s*$/ ) {
- push( @pod, $1 );
- if ( $self->{collect_pod} && length( $pod_data ) ) {
- $pod{$pod_sect} = $pod_data;
- $pod_data = '';
- }
- $pod_sect = $1;
-
-
- } elsif ( $self->{collect_pod} ) {
- $pod_data .= "$line\n";
-
- }
-
- } else {
-
- $pod_sect = '';
- $pod_data = '';
-
- # parse $line to see if it's a $VERSION declaration
- my( $vers_sig, $vers_fullname, $vers_pkg ) =
- $self->_parse_version_expression( $line );
-
- if ( $line =~ $PKG_REGEXP ) {
- $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 ) {
- push( @pkgs, $vers_pkg ) unless grep( $vers_pkg eq $_, @pkgs );
- $need_vers = 0 if $vers_pkg eq $pkg;
-
- unless ( defined $vers{$vers_pkg} && length $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
- # $VERSION" idiom (though there are probably other idioms
- # that we should watch out for...)
- warn <<"EOM" unless $line =~ /=\s*eval/;
-Package '$vers_pkg' already declared with version '$vers{$vers_pkg}',
-ignoring subsequent declaration on line $line_num.
-EOM
- }
-
- # first non-comment line in undeclared package main is VERSION
- } elsif ( !exists($vers{main}) && $pkg eq 'main' && $vers_fullname ) {
- $need_vers = 0;
- my $v =
- $self->_evaluate_version_line( $vers_sig, $vers_fullname, $line );
- $vers{$pkg} = $v;
- push( @pkgs, 'main' );
-
- # first non-comment line in undeclared package defines package main
- } elsif ( !exists($vers{main}) && $pkg eq 'main' && $line =~ /\w+/ ) {
- $need_vers = 1;
- $vers{main} = '';
- push( @pkgs, 'main' );
-
- # only keep if this is the first $VERSION seen
- } elsif ( $vers_fullname && $need_vers ) {
- $need_vers = 0;
- my $v =
- $self->_evaluate_version_line( $vers_sig, $vers_fullname, $line );
-
-
- unless ( defined $vers{$pkg} && length $vers{$pkg} ) {
- $vers{$pkg} = $v;
- } else {
- warn <<"EOM";
-Package '$pkg' already declared with version '$vers{$pkg}'
-ignoring new version '$v' on line $line_num.
-EOM
- }
-
- }
-
- }
-
- }
-
- if ( $self->{collect_pod} && length($pod_data) ) {
- $pod{$pod_sect} = $pod_data;
- }
-
- $self->{versions} = \%vers;
- $self->{packages} = \@pkgs;
- $self->{pod} = \%pod;
- $self->{pod_headings} = \@pod;
-}
-
-{
-my $pn = 0;
-sub _evaluate_version_line {
- my $self = shift;
- my( $sigil, $var, $line ) = @_;
-
- # Some of this code came from the ExtUtils:: hierarchy.
-
- # We compile into $vsub because 'use version' would cause
- # compiletime/runtime issues with local()
- my $vsub;
- $pn++; # everybody gets their own package
- my $eval = qq{BEGIN { q# Hide from _packages_inside()
- #; package Module::Build::ModuleInfo::_version::p$pn;
- use Module::Build::Version;
- no strict;
-
- local $sigil$var;
- \$$var=undef;
- \$vsub = sub {
- $line;
- \$$var
- };
- }};
-
- local $^W;
- # Try to get the $VERSION
- eval $eval;
- # some modules say $VERSION = $Foo::Bar::VERSION, but Foo::Bar isn't
- # installed, so we need to hunt in ./lib for it
- if ( $@ =~ /Can't locate/ && -d 'lib' ) {
- local @INC = ('lib',@INC);
- eval $eval;
- }
- warn "Error evaling version line '$eval' in $self->{filename}: $@\n"
- if $@;
- (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 $@;
-
- # 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
- 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;
-}
-}
-
-
-############################################################
-
-# accessors
-sub name { $_[0]->{module} }
-
-sub filename { $_[0]->{filename} }
-sub packages_inside { @{$_[0]->{packages}} }
-sub pod_inside { @{$_[0]->{pod_headings}} }
-sub contains_pod { $#{$_[0]->{pod_headings}} }
-
-sub version {
- my $self = shift;
- my $mod = shift || $self->{module};
- my $vers;
- if ( defined( $mod ) && length( $mod ) &&
- exists( $self->{versions}{$mod} ) ) {
- return $self->{versions}{$mod};
- } else {
- return undef;
- }
-}
-
-sub pod {
- my $self = shift;
- my $sect = shift;
- if ( defined( $sect ) && length( $sect ) &&
- exists( $self->{pod}{$sect} ) ) {
- return $self->{pod}{$sect};
- } else {
- return undef;
- }
-}
+require Module::Metadata;
+our @ISA = qw/Module::Metadata/;
1;
@@ -395,97 +18,17 @@ __END__
=head1 NAME
-ModuleInfo - Gather package and POD information from a perl module file
-
+Module::Build::ModuleInfo - DEPRECATED
=head1 DESCRIPTION
-=over 4
-
-=item new_from_file($filename, collect_pod => 1)
-
-Construct a C<ModuleInfo> object given the path to a file. Takes an optional
-argument C<collect_pod> which is a boolean that determines whether
-POD data is collected and stored for reference. POD data is not
-collected by default. POD headings are always collected.
-
-=item new_from_module($module, collect_pod => 1, inc => \@dirs)
-
-Construct a C<ModuleInfo> object given a module or package name. In addition
-to accepting the C<collect_pod> argument as described above, this
-method accepts a C<inc> argument which is a reference to an array of
-of directories to search for the module. If none are given, the
-default is @INC.
-
-=item name()
-
-Returns the name of the package represented by this module. If there
-are more than one packages, it makes a best guess based on the
-filename. If it's a script (i.e. not a *.pm) the package name is
-'main'.
-
-=item version($package)
-
-Returns the version as defined by the $VERSION variable for the
-package as returned by the C<name> method if no arguments are
-given. If given the name of a package it will attempt to return the
-version of that package if it is specified in the file.
-
-=item filename()
-
-Returns the absolute path to the file.
-
-=item packages_inside()
-
-Returns a list of packages.
-
-=item pod_inside()
-
-Returns a list of POD sections.
-
-=item contains_pod()
-
-Returns true if there is any POD in the file.
-
-=item pod($section)
-
-Returns the POD data in the given section.
-
-=item find_module_by_name($module, \@dirs)
-
-Returns the path to a module given the module or package name. A list
-of directories can be passed in as an optional parameter, otherwise
-@INC is searched.
-
-Can be called as either an object or a class method.
-
-=item find_module_dir_by_name($module, \@dirs)
-
-Returns the entry in C<@dirs> (or C<@INC> by default) that contains
-the module C<$module>. A list of directories can be passed in as an
-optional parameter, otherwise @INC is searched.
-
-Can be called as either an object or a class method.
-
-=back
-
-
-=head1 AUTHOR
-
-Ken Williams <kwilliams@cpan.org>, Randy W. Sims <RandyS@ThePierianSpring.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.
-
+This module has been extracted into a separate distribution and renamed
+L<Module::Metadata>. This module is kept as a subclass wrapper for
+compatibility.
=head1 SEE ALSO
-perl(1), L<Module::Build>(3)
+perl(1), L<Module::Build>, L<Module::Metadata>
=cut
diff --git a/Master/tlpkg/tlperl/lib/Module/Build/Notes.pm b/Master/tlpkg/tlperl/lib/Module/Build/Notes.pm
index cf85d4ee3d3..1165799da41 100644
--- a/Master/tlpkg/tlperl/lib/Module/Build/Notes.pm
+++ b/Master/tlpkg/tlperl/lib/Module/Build/Notes.pm
@@ -4,7 +4,7 @@ package Module::Build::Notes;
use strict;
use vars qw($VERSION);
-$VERSION = '0.3603';
+$VERSION = '0.3800';
$VERSION = eval $VERSION;
use Data::Dumper;
use IO::File;
diff --git a/Master/tlpkg/tlperl/lib/Module/Build/PPMMaker.pm b/Master/tlpkg/tlperl/lib/Module/Build/PPMMaker.pm
index 977b4370d91..20f0b61ccdf 100644
--- a/Master/tlpkg/tlperl/lib/Module/Build/PPMMaker.pm
+++ b/Master/tlpkg/tlperl/lib/Module/Build/PPMMaker.pm
@@ -5,7 +5,7 @@ use Config;
use vars qw($VERSION);
use IO::File;
-$VERSION = '0.3603';
+$VERSION = '0.3800';
$VERSION = eval $VERSION;
# This code is mostly borrowed from ExtUtils::MM_Unix 6.10_03, with a
@@ -154,7 +154,6 @@ __END__
Module::Build::PPMMaker - Perl Package Manager file creation
-
=head1 SYNOPSIS
On the command line, builds a .ppd file:
diff --git a/Master/tlpkg/tlperl/lib/Module/Build/Platform/Amiga.pm b/Master/tlpkg/tlperl/lib/Module/Build/Platform/Amiga.pm
index 9356325c9f4..a4b95414f84 100644
--- a/Master/tlpkg/tlperl/lib/Module/Build/Platform/Amiga.pm
+++ b/Master/tlpkg/tlperl/lib/Module/Build/Platform/Amiga.pm
@@ -2,7 +2,7 @@ package Module::Build::Platform::Amiga;
use strict;
use vars qw($VERSION);
-$VERSION = '0.3603';
+$VERSION = '0.3800';
$VERSION = eval $VERSION;
use Module::Build::Base;
diff --git a/Master/tlpkg/tlperl/lib/Module/Build/Platform/Default.pm b/Master/tlpkg/tlperl/lib/Module/Build/Platform/Default.pm
index 8d46fc47d56..b4d2ca2f4a4 100644
--- a/Master/tlpkg/tlperl/lib/Module/Build/Platform/Default.pm
+++ b/Master/tlpkg/tlperl/lib/Module/Build/Platform/Default.pm
@@ -2,7 +2,7 @@ package Module::Build::Platform::Default;
use strict;
use vars qw($VERSION);
-$VERSION = '0.3603';
+$VERSION = '0.3800';
$VERSION = eval $VERSION;
use Module::Build::Base;
diff --git a/Master/tlpkg/tlperl/lib/Module/Build/Platform/EBCDIC.pm b/Master/tlpkg/tlperl/lib/Module/Build/Platform/EBCDIC.pm
index 140e27872aa..a030ba9573b 100644
--- a/Master/tlpkg/tlperl/lib/Module/Build/Platform/EBCDIC.pm
+++ b/Master/tlpkg/tlperl/lib/Module/Build/Platform/EBCDIC.pm
@@ -2,7 +2,7 @@ package Module::Build::Platform::EBCDIC;
use strict;
use vars qw($VERSION);
-$VERSION = '0.3603';
+$VERSION = '0.3800';
$VERSION = eval $VERSION;
use Module::Build::Base;
diff --git a/Master/tlpkg/tlperl/lib/Module/Build/Platform/MPEiX.pm b/Master/tlpkg/tlperl/lib/Module/Build/Platform/MPEiX.pm
index 66bbdc95da6..33fae1c5a7f 100644
--- a/Master/tlpkg/tlperl/lib/Module/Build/Platform/MPEiX.pm
+++ b/Master/tlpkg/tlperl/lib/Module/Build/Platform/MPEiX.pm
@@ -2,7 +2,7 @@ package Module::Build::Platform::MPEiX;
use strict;
use vars qw($VERSION);
-$VERSION = '0.3603';
+$VERSION = '0.3800';
$VERSION = eval $VERSION;
use Module::Build::Base;
diff --git a/Master/tlpkg/tlperl/lib/Module/Build/Platform/MacOS.pm b/Master/tlpkg/tlperl/lib/Module/Build/Platform/MacOS.pm
index b80781bd955..fc205d3610d 100644
--- a/Master/tlpkg/tlperl/lib/Module/Build/Platform/MacOS.pm
+++ b/Master/tlpkg/tlperl/lib/Module/Build/Platform/MacOS.pm
@@ -2,7 +2,7 @@ package Module::Build::Platform::MacOS;
use strict;
use vars qw($VERSION);
-$VERSION = '0.3603';
+$VERSION = '0.3800';
$VERSION = eval $VERSION;
use Module::Build::Base;
use vars qw(@ISA);
diff --git a/Master/tlpkg/tlperl/lib/Module/Build/Platform/RiscOS.pm b/Master/tlpkg/tlperl/lib/Module/Build/Platform/RiscOS.pm
index 95e31515876..94f84580e1d 100644
--- a/Master/tlpkg/tlperl/lib/Module/Build/Platform/RiscOS.pm
+++ b/Master/tlpkg/tlperl/lib/Module/Build/Platform/RiscOS.pm
@@ -2,7 +2,7 @@ package Module::Build::Platform::RiscOS;
use strict;
use vars qw($VERSION);
-$VERSION = '0.3603';
+$VERSION = '0.3800';
$VERSION = eval $VERSION;
use Module::Build::Base;
diff --git a/Master/tlpkg/tlperl/lib/Module/Build/Platform/Unix.pm b/Master/tlpkg/tlperl/lib/Module/Build/Platform/Unix.pm
index 0be5fc7df07..956c64e4e7a 100644
--- a/Master/tlpkg/tlperl/lib/Module/Build/Platform/Unix.pm
+++ b/Master/tlpkg/tlperl/lib/Module/Build/Platform/Unix.pm
@@ -2,7 +2,7 @@ package Module::Build::Platform::Unix;
use strict;
use vars qw($VERSION);
-$VERSION = '0.3603';
+$VERSION = '0.3800';
$VERSION = eval $VERSION;
use Module::Build::Base;
diff --git a/Master/tlpkg/tlperl/lib/Module/Build/Platform/VMS.pm b/Master/tlpkg/tlperl/lib/Module/Build/Platform/VMS.pm
index f406b7afb6f..bf2118b23b2 100644
--- a/Master/tlpkg/tlperl/lib/Module/Build/Platform/VMS.pm
+++ b/Master/tlpkg/tlperl/lib/Module/Build/Platform/VMS.pm
@@ -2,7 +2,7 @@ package Module::Build::Platform::VMS;
use strict;
use vars qw($VERSION);
-$VERSION = '0.3603';
+$VERSION = '0.3800';
$VERSION = eval $VERSION;
use Module::Build::Base;
use Config;
@@ -77,10 +77,29 @@ Prefixify taking into account VMS' filepath syntax.
=cut
# Translated from ExtUtils::MM_VMS::prefixify()
+
+sub _catprefix {
+ my($self, $rprefix, $default) = @_;
+
+ my($rvol, $rdirs) = File::Spec->splitpath($rprefix);
+ if( $rvol ) {
+ return File::Spec->catpath($rvol,
+ File::Spec->catdir($rdirs, $default),
+ ''
+ )
+ }
+ else {
+ return File::Spec->catdir($rdirs, $default);
+ }
+}
+
+
sub _prefixify {
my($self, $path, $sprefix, $type) = @_;
my $rprefix = $self->prefix;
+ return '' unless defined $path;
+
$self->log_verbose(" prefixify $path from $sprefix to $rprefix\n");
# Translate $(PERLPREFIX) to a real path.
@@ -90,7 +109,7 @@ sub _prefixify {
$self->log_verbose(" rprefix translated to $rprefix\n".
" sprefix translated to $sprefix\n");
- if( length $path == 0 ) {
+ if( length($path) == 0 ) {
$self->log_verbose(" no path to prefixify.\n")
}
elsif( !File::Spec->file_name_is_absolute($path) ) {
diff --git a/Master/tlpkg/tlperl/lib/Module/Build/Platform/VOS.pm b/Master/tlpkg/tlperl/lib/Module/Build/Platform/VOS.pm
index 001a9507d44..fd809c0163b 100644
--- a/Master/tlpkg/tlperl/lib/Module/Build/Platform/VOS.pm
+++ b/Master/tlpkg/tlperl/lib/Module/Build/Platform/VOS.pm
@@ -2,7 +2,7 @@ package Module::Build::Platform::VOS;
use strict;
use vars qw($VERSION);
-$VERSION = '0.3603';
+$VERSION = '0.3800';
$VERSION = eval $VERSION;
use Module::Build::Base;
diff --git a/Master/tlpkg/tlperl/lib/Module/Build/Platform/Windows.pm b/Master/tlpkg/tlperl/lib/Module/Build/Platform/Windows.pm
index 1e248a75c5f..2924f9d0007 100644
--- a/Master/tlpkg/tlperl/lib/Module/Build/Platform/Windows.pm
+++ b/Master/tlpkg/tlperl/lib/Module/Build/Platform/Windows.pm
@@ -2,7 +2,7 @@ package Module::Build::Platform::Windows;
use strict;
use vars qw($VERSION);
-$VERSION = '0.3603';
+$VERSION = '0.3800';
$VERSION = eval $VERSION;
use Config;
diff --git a/Master/tlpkg/tlperl/lib/Module/Build/Platform/aix.pm b/Master/tlpkg/tlperl/lib/Module/Build/Platform/aix.pm
index dab064805d3..59eec0d36d0 100644
--- a/Master/tlpkg/tlperl/lib/Module/Build/Platform/aix.pm
+++ b/Master/tlpkg/tlperl/lib/Module/Build/Platform/aix.pm
@@ -2,7 +2,7 @@ package Module::Build::Platform::aix;
use strict;
use vars qw($VERSION);
-$VERSION = '0.3603';
+$VERSION = '0.3800';
$VERSION = eval $VERSION;
use Module::Build::Platform::Unix;
diff --git a/Master/tlpkg/tlperl/lib/Module/Build/Platform/cygwin.pm b/Master/tlpkg/tlperl/lib/Module/Build/Platform/cygwin.pm
index eb45b62f0e6..7b7680488c9 100644
--- a/Master/tlpkg/tlperl/lib/Module/Build/Platform/cygwin.pm
+++ b/Master/tlpkg/tlperl/lib/Module/Build/Platform/cygwin.pm
@@ -2,7 +2,7 @@ package Module::Build::Platform::cygwin;
use strict;
use vars qw($VERSION);
-$VERSION = '0.360301'; # patched in bleadperl
+$VERSION = '0.3800';
$VERSION = eval $VERSION;
use Module::Build::Platform::Unix;
@@ -14,9 +14,9 @@ sub manpage_separator {
}
# Copied from ExtUtils::MM_Cygwin::maybe_command()
-# If our path begins with F</cygdrive/> then we use M::B::Platform::Windows
+# If our path begins with F</cygdrive/> then we use the Windows version
# to determine if it may be a command. Otherwise we use the tests
-# from M::B::Platform::Unix.
+# from C<ExtUtils::MM_Unix>.
sub _maybe_command {
my ($self, $file) = @_;
diff --git a/Master/tlpkg/tlperl/lib/Module/Build/Platform/darwin.pm b/Master/tlpkg/tlperl/lib/Module/Build/Platform/darwin.pm
index c2f3126c440..5c9a1770bb4 100644
--- a/Master/tlpkg/tlperl/lib/Module/Build/Platform/darwin.pm
+++ b/Master/tlpkg/tlperl/lib/Module/Build/Platform/darwin.pm
@@ -2,7 +2,7 @@ package Module::Build::Platform::darwin;
use strict;
use vars qw($VERSION);
-$VERSION = '0.3603';
+$VERSION = '0.3800';
$VERSION = eval $VERSION;
use Module::Build::Platform::Unix;
diff --git a/Master/tlpkg/tlperl/lib/Module/Build/Platform/os2.pm b/Master/tlpkg/tlperl/lib/Module/Build/Platform/os2.pm
index be164ae980b..b78d153ee04 100644
--- a/Master/tlpkg/tlperl/lib/Module/Build/Platform/os2.pm
+++ b/Master/tlpkg/tlperl/lib/Module/Build/Platform/os2.pm
@@ -2,7 +2,7 @@ package Module::Build::Platform::os2;
use strict;
use vars qw($VERSION);
-$VERSION = '0.3603';
+$VERSION = '0.3800';
$VERSION = eval $VERSION;
use Module::Build::Platform::Unix;
diff --git a/Master/tlpkg/tlperl/lib/Module/Build/PodParser.pm b/Master/tlpkg/tlperl/lib/Module/Build/PodParser.pm
index 225450c6b98..5bba10aae38 100644
--- a/Master/tlpkg/tlperl/lib/Module/Build/PodParser.pm
+++ b/Master/tlpkg/tlperl/lib/Module/Build/PodParser.pm
@@ -2,7 +2,7 @@ package Module::Build::PodParser;
use strict;
use vars qw($VERSION);
-$VERSION = '0.3603';
+$VERSION = '0.3800';
$VERSION = eval $VERSION;
use vars qw(@ISA);
diff --git a/Master/tlpkg/tlperl/lib/Module/Build/Version.pm b/Master/tlpkg/tlperl/lib/Module/Build/Version.pm
index 21abe00cbe0..e659712ddb1 100644
--- a/Master/tlpkg/tlperl/lib/Module/Build/Version.pm
+++ b/Master/tlpkg/tlperl/lib/Module/Build/Version.pm
@@ -1,684 +1,21 @@
package Module::Build::Version;
use strict;
-
use vars qw($VERSION);
-$VERSION = 0.77;
-
-eval "use version $VERSION";
-if ($@) { # can't locate version files, use our own
-
- # Avoid redefined warnings if an old version.pm was available
- delete $version::{$_} foreach keys %version::;
-
- # first we get the stub version module
- my $version;
- while (<DATA>) {
- s/(\$VERSION)\s=\s\d+/\$VERSION = 0/;
- $version .= $_ if $_;
- last if /^1;$/;
- }
-
- # and now get the current version::vpp code
- my $vpp;
- while (<DATA>) {
- s/(\$VERSION)\s=\s\d+/\$VERSION = 0/;
- $vpp .= $_ if $_;
- last if /^1;$/;
- }
-
- # but we eval them in reverse order since version depends on
- # version::vpp to already exist
- eval $vpp; die $@ if $@;
- $INC{'version/vpp.pm'} = 'inside Module::Build::Version';
- eval $version; die $@ if $@;
- $INC{'version.pm'} = 'inside Module::Build::Version';
-}
-
-# now we can safely subclass version, installed or not
-use vars qw(@ISA);
-@ISA = qw(version);
-
-1;
-__DATA__
-# stub version module to make everything else happy
-package version;
-
-use 5.005_04;
-use strict;
-
-use vars qw(@ISA $VERSION $CLASS *declare *qv);
-
-$VERSION = 0.77;
-
-$CLASS = 'version';
-
-push @ISA, "version::vpp";
-local $^W;
-*version::qv = \&version::vpp::qv;
-*version::declare = \&version::vpp::declare;
-*version::_VERSION = \&version::vpp::_VERSION;
-if ($] > 5.009001 && $] <= 5.010000) {
- no strict 'refs';
- *{'version::stringify'} = \*version::vpp::stringify;
- *{'version::(""'} = \*version::vpp::stringify;
- *{'version::new'} = \*version::vpp::new;
-}
-
-# Preloaded methods go here.
-sub import {
- no strict 'refs';
- my ($class) = shift;
-
- # Set up any derived class
- unless ($class eq 'version') {
- local $^W;
- *{$class.'::declare'} = \&version::declare;
- *{$class.'::qv'} = \&version::qv;
- }
-
- my %args;
- if (@_) { # any remaining terms are arguments
- map { $args{$_} = 1 } @_
- }
- else { # no parameters at all on use line
- %args =
- (
- qv => 1,
- 'UNIVERSAL::VERSION' => 1,
- );
- }
-
- my $callpkg = caller();
-
- if (exists($args{declare})) {
- *{$callpkg."::declare"} =
- sub {return $class->declare(shift) }
- unless defined(&{$callpkg.'::declare'});
- }
-
- if (exists($args{qv})) {
- *{$callpkg."::qv"} =
- sub {return $class->qv(shift) }
- unless defined(&{"$callpkg\::qv"});
- }
-
- if (exists($args{'UNIVERSAL::VERSION'})) {
- local $^W;
- *UNIVERSAL::VERSION = \&version::_VERSION;
- }
+$VERSION = '0.87'; ### XXX sync with version of version.pm below
- if (exists($args{'VERSION'})) {
- *{$callpkg."::VERSION"} = \&version::_VERSION;
- }
-}
+use version 0.87;
+our @ISA = qw(version);
1;
-# replace everything from here to the end with the current version/vpp.pm
-package version::vpp;
-use strict;
-
-use POSIX qw/locale_h/;
-use locale;
-use vars qw ($VERSION @ISA @REGEXS);
-$VERSION = '0.77';
-$VERSION = eval $VERSION;
-
-push @REGEXS, qr/
- ^v? # optional leading 'v'
- (\d*) # major revision not required
- \. # requires at least one decimal
- (?:(\d+)\.?){1,}
- /x;
-
-use overload (
- '""' => \&stringify,
- '0+' => \&numify,
- 'cmp' => \&vcmp,
- '<=>' => \&vcmp,
- 'bool' => \&vbool,
- 'nomethod' => \&vnoop,
-);
-
-my $VERSION_MAX = 0x7FFFFFFF;
-
-eval "use warnings";
-if ($@) {
- eval '
- package warnings;
- sub enabled {return $^W;}
- 1;
- ';
-}
-
-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} } ];
- $self->{qv} = 1 if $value->{qv};
- $self->{alpha} = 1 if $value->{alpha};
- $self->{original} = ''.$value->{original};
- return $self;
- }
-
- my $currlocale = setlocale(LC_ALL);
-
- # if the current locale uses commas for decimal points, we
- # just replace commas with decimal places, rather than changing
- # locales
- if ( localeconv()->{decimal_point} eq ',' ) {
- $value =~ tr/,/./;
- }
-
- if ( not defined $value or $value =~ /^undef$/ ) {
- # RT #19517 - special case for undef comparison
- # or someone forgot to pass a value
- push @{$self->{version}}, 0;
- $self->{original} = "0";
- return ($self);
- }
-
- if ( $#_ == 2 ) { # must be CVS-style
- $value = 'v'.$_[2];
- }
-
- $value = _un_vstring($value);
-
- # exponential notation
- if ( $value =~ /\d+.?\d*e[-+]?\d+/ ) {
- $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
- my $qv = 0;
- my $alpha = 0;
- my $width = 3;
- my $saw_period = 0;
- my $vinf = 0;
- my ($start, $last, $pos, $s);
- $s = 0;
-
- while ( substr($value,$s,1) =~ /\s/ ) { # leading whitespace is OK
- $s++;
- }
-
- if (substr($value,$s,1) eq 'v') {
- $s++; # get past 'v'
- $qv = 1; # force quoted version processing
- }
-
- $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 '.' ) {
- if ($alpha) {
- Carp::croak("Invalid version format ".
- "(underscores before decimal)");
- }
- $saw_period++;
- $last = $pos;
- }
- elsif ( substr($value,$pos,1) eq '_' ) {
- if ($alpha) {
- require Carp;
- Carp::croak("Invalid version format ".
- "(multiple underscores)");
- }
- $alpha = 1;
- $width = $pos - $last - 1; # natural width of sub-version
- }
- elsif ( substr($value,$pos,1) eq ','
- and substr($value,$pos+1,1) =~ /[0-9]/ ) {
- # looks like an unhandled locale
- $saw_period++;
- $last = $pos;
- }
- $pos++;
- }
-
- if ( $alpha && !$saw_period ) {
- require Carp;
- Carp::croak("Invalid version format ".
- "(alpha without decimal)");
- }
-
- if ( $alpha && $saw_period && $width == 0 ) {
- require Carp;
- Carp::croak("Invalid version format ".
- "(misplaced _ in number)");
- }
-
- if ( $saw_period > 1 ) {
- $qv = 1; # force quoted version processing
- }
-
- $last = $pos;
- $pos = $s;
-
- if ( $qv ) {
- $self->{qv} = 1;
- }
-
- if ( $alpha ) {
- $self->{alpha} = 1;
- }
-
- if ( !$qv && $width < 3 ) {
- $self->{width} = $width;
- }
-
- while ( substr($value,$pos,1) =~ /\d/ ) {
- $pos++;
- }
-
- if ( substr($value,$pos,1) !~ /[a-z]/ ) { ### FIX THIS ###
- my $rev;
-
- while (1) {
- $rev = 0;
- {
-
- # this is atoi() that delimits on underscores
- my $end = $pos;
- my $mult = 1;
- my $orev;
-
- # the following if() will only be true after the decimal
- # point of a version originally created with a bare
- # floating point number, i.e. not quoted in any way
- if ( !$qv && $s > $start && $saw_period == 1 ) {
- $mult *= 100;
- while ( $s < $end ) {
- $orev = $rev;
- $rev += substr($value,$s,1) * $mult;
- $mult /= 10;
- if ( abs($orev) > abs($rev)
- || abs($rev) > abs($VERSION_MAX) ) {
- if ( warnings::enabled("overflow") ) {
- require Carp;
- Carp::carp("Integer overflow in version");
- }
- $s = $end - 1;
- $rev = $VERSION_MAX;
- }
- $s++;
- if ( substr($value,$s,1) eq '_' ) {
- $s++;
- }
- }
- }
- else {
- while (--$end >= $s) {
- $orev = $rev;
- $rev += substr($value,$end,1) * $mult;
- $mult *= 10;
- if ( abs($orev) > abs($rev)
- || abs($rev) > abs($VERSION_MAX) ) {
- if ( warnings::enabled("overflow") ) {
- require Carp;
- Carp::carp("Integer overflow in version");
- }
- $end = $s - 1;
- $rev = $VERSION_MAX;
- }
- }
- }
- }
-
- # Append revision
- push @{$self->{version}}, $rev;
- if ( substr($value,$pos,1) eq '.'
- && substr($value,$pos+1,1) =~ /\d/ ) {
- $s = ++$pos;
- }
- elsif ( substr($value,$pos,1) eq '_'
- && substr($value,$pos+1,1) =~ /\d/ ) {
- $s = ++$pos;
- }
- elsif ( substr($value,$pos,1) eq ','
- && substr($value,$pos+1,1) =~ /\d/ ) {
- $s = ++$pos;
- }
- elsif ( substr($value,$pos,1) =~ /\d/ ) {
- $s = $pos;
- }
- else {
- $s = $pos;
- last;
- }
- if ( $qv ) {
- while ( substr($value,$pos,1) =~ /\d/ ) {
- $pos++;
- }
- }
- else {
- my $digits = 0;
- while (substr($value,$pos,1) =~ /[\d_]/ && $digits < 3) {
- if ( substr($value,$pos,1) ne '_' ) {
- $digits++;
- }
- $pos++;
- }
- }
- }
- }
- if ( $qv ) { # quoted versions always get at least three terms
- my $len = scalar @{$self->{version}};
- $len = 3 - $len;
- while ($len-- > 0) {
- push @{$self->{version}}, 0;
- }
- }
-
- if ( substr($value,$pos) ) { # any remaining text
- if ( warnings::enabled("misc") ) {
- require Carp;
- Carp::carp("Version string '$value' contains invalid data; ".
- "ignoring: '".substr($value,$pos)."'");
- }
- }
-
- # cache the original value for use when stringification
- if ( $vinf ) {
- $self->{vinf} = 1;
- $self->{original} = 'v.Inf';
- }
- else {
- $self->{original} = substr($value,0,$pos);
- }
-
- return ($self);
-}
-
-*parse = \&new;
-
-sub numify
-{
- my ($self) = @_;
- unless (_verify($self)) {
- require Carp;
- Carp::croak("Invalid version object");
- }
- my $width = $self->{width} || 3;
- my $alpha = $self->{alpha} || "";
- my $len = $#{$self->{version}};
- my $digit = $self->{version}[0];
- my $string = sprintf("%d.", $digit );
-
- for ( my $i = 1 ; $i < $len ; $i++ ) {
- $digit = $self->{version}[$i];
- if ( $width < 3 ) {
- my $denom = 10**(3-$width);
- my $quot = int($digit/$denom);
- my $rem = $digit - ($quot * $denom);
- $string .= sprintf("%0".$width."d_%d", $quot, $rem);
- }
- else {
- $string .= sprintf("%03d", $digit);
- }
- }
-
- if ( $len > 0 ) {
- $digit = $self->{version}[$len];
- if ( $alpha && $width == 3 ) {
- $string .= "_";
- }
- $string .= sprintf("%0".$width."d", $digit);
- }
- else # $len = 0
- {
- $string .= sprintf("000");
- }
-
- return $string;
-}
-
-sub normal
-{
- my ($self) = @_;
- unless (_verify($self)) {
- require Carp;
- Carp::croak("Invalid version object");
- }
- my $alpha = $self->{alpha} || "";
- my $len = $#{$self->{version}};
- my $digit = $self->{version}[0];
- my $string = sprintf("v%d", $digit );
-
- for ( my $i = 1 ; $i < $len ; $i++ ) {
- $digit = $self->{version}[$i];
- $string .= sprintf(".%d", $digit);
- }
-
- if ( $len > 0 ) {
- $digit = $self->{version}[$len];
- if ( $alpha ) {
- $string .= sprintf("_%0d", $digit);
- }
- else {
- $string .= sprintf(".%0d", $digit);
- }
- }
-
- if ( $len <= 2 ) {
- for ( $len = 2 - $len; $len != 0; $len-- ) {
- $string .= sprintf(".%0d", 0);
- }
- }
-
- return $string;
-}
-
-sub stringify
-{
- my ($self) = @_;
- unless (_verify($self)) {
- require Carp;
- Carp::croak("Invalid version object");
- }
- return exists $self->{original}
- ? $self->{original}
- : exists $self->{qv}
- ? $self->normal
- : $self->numify;
-}
-
-sub vcmp
-{
- require UNIVERSAL;
- my ($left,$right,$swap) = @_;
- my $class = ref($left);
- unless ( UNIVERSAL::isa($right, $class) ) {
- $right = $class->new($right);
- }
-
- if ( $swap ) {
- ($left, $right) = ($right, $left);
- }
- unless (_verify($left)) {
- require Carp;
- Carp::croak("Invalid version object");
- }
- unless (_verify($right)) {
- require Carp;
- Carp::croak("Invalid version object");
- }
- my $l = $#{$left->{version}};
- my $r = $#{$right->{version}};
- my $m = $l < $r ? $l : $r;
- my $lalpha = $left->is_alpha;
- my $ralpha = $right->is_alpha;
- my $retval = 0;
- my $i = 0;
- while ( $i <= $m && $retval == 0 ) {
- $retval = $left->{version}[$i] <=> $right->{version}[$i];
- $i++;
- }
-
- # tiebreaker for alpha with identical terms
- if ( $retval == 0
- && $l == $r
- && $left->{version}[$m] == $right->{version}[$m]
- && ( $lalpha || $ralpha ) ) {
-
- if ( $lalpha && !$ralpha ) {
- $retval = -1;
- }
- elsif ( $ralpha && !$lalpha) {
- $retval = +1;
- }
- }
-
- # possible match except for trailing 0's
- if ( $retval == 0 && $l != $r ) {
- if ( $l < $r ) {
- while ( $i <= $r && $retval == 0 ) {
- if ( $right->{version}[$i] != 0 ) {
- $retval = -1; # not a match after all
- }
- $i++;
- }
- }
- else {
- while ( $i <= $l && $retval == 0 ) {
- if ( $left->{version}[$i] != 0 ) {
- $retval = +1; # not a match after all
- }
- $i++;
- }
- }
- }
-
- return $retval;
-}
-
-sub vbool {
- my ($self) = @_;
- return vcmp($self,$self->new("0"),1);
-}
-
-sub vnoop {
- require Carp;
- Carp::croak("operation not supported with version object");
-}
-
-sub is_alpha {
- my ($self) = @_;
- return (exists $self->{alpha});
-}
-
-sub qv {
- my $value = shift;
- my $class = 'version';
- if (@_) {
- $class = ref($value) || $value;
- $value = shift;
- }
-
- $value = _un_vstring($value);
- $value = 'v'.$value unless $value =~ /(^v|\d+\.\d+\.\d)/;
- my $version = $class->new($value);
- return $version;
-}
-
-*declare = \&qv;
-
-sub is_qv {
- my ($self) = @_;
- return (exists $self->{qv});
-}
-
-
-sub _verify {
- my ($self) = @_;
- if ( ref($self)
- && eval { exists $self->{version} }
- && ref($self->{version}) eq 'ARRAY'
- ) {
- return 1;
- }
- else {
- return 0;
- }
-}
-
-sub _un_vstring {
- my $value = shift;
- # may be a v-string
- if ( $] >= 5.006_000 && length($value) >= 3 && $value !~ /[._]/ ) {
- my $tvalue = sprintf("v%vd",$value);
- if ( $tvalue =~ /^v\d+\.\d+\.\d+$/ ) {
- # must be a v-string
- $value = $tvalue;
- }
- }
- return $value;
-}
-
-sub _VERSION {
- my ($obj, $req) = @_;
- my $class = ref($obj) || $obj;
-
- no strict 'refs';
- if ( exists $INC{"$class.pm"} and not %{"$class\::"} and $] >= 5.008) {
- # file but no package
- require Carp;
- Carp::croak( "$class defines neither package nor VERSION"
- ."--version check failed");
- }
-
- my $version = eval "\$$class\::VERSION";
- if ( defined $version ) {
- local $^W if $] <= 5.008;
- $version = version::vpp->new($version);
- }
-
- if ( defined $req ) {
- unless ( defined $version ) {
- require Carp;
- my $msg = $] < 5.006
- ? "$class version $req required--this is only version "
- : "$class does not define \$$class\::VERSION"
- ."--version check failed";
+=head1 NAME
- if ( $ENV{VERSION_DEBUG} ) {
- Carp::confess($msg);
- }
- else {
- Carp::croak($msg);
- }
- }
+Module::Build::Version - DEPRECATED
- $req = version::vpp->new($req);
+=head1 DESCRIPTION
- if ( $req > $version ) {
- require Carp;
- if ( $req->is_qv ) {
- Carp::croak(
- sprintf ("%s version %s required--".
- "this is only version %s", $class,
- $req->normal, $version->normal)
- );
- }
- else {
- Carp::croak(
- sprintf ("%s version %s required--".
- "this is only version %s", $class,
- $req->stringify, $version->stringify)
- );
- }
- }
- }
+Module::Build now lists L<version> as a C<configure_requires> dependency
+and no longer installs a copy.
- return defined $version ? $version->stringify : undef;
-}
+=cut
-1; #this line is important and will help the module return a true value
diff --git a/Master/tlpkg/tlperl/lib/Module/Build/YAML.pm b/Master/tlpkg/tlperl/lib/Module/Build/YAML.pm
index 2da91f22563..133dee54274 100644
--- a/Master/tlpkg/tlperl/lib/Module/Build/YAML.pm
+++ b/Master/tlpkg/tlperl/lib/Module/Build/YAML.pm
@@ -1,600 +1,19 @@
-# Adapted from YAML::Tiny 1.40
package Module::Build::YAML;
-
use strict;
-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 $class = shift;
- bless [ @_ ], $class;
-}
-
-# 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 );
-}
-
-# 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;
-}
-
-# 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;
-}
-
-# Parse an array
-sub _read_array {
- my ($self, $array, $indent, $lines) = @_;
-
- 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 );
-
- } 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 );
- }
-
- } elsif ( $lines->[0] =~ /^(\s*)\S/ ) {
- push @$array, { };
- $self->_read_hash( $array->[-1], [ @$indent, length("$1") ], $lines );
-
- } else {
- croak("Module::Build::YAML failed to classify line '$lines->[0]'");
- }
-
- } 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]'");
- }
- }
-
- 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;
- }
-
- # 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]'");
- }
-
- # 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;
-
- # 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 );
- }
- }
- }
- }
-
- return 1;
-}
-
-# Save an object to a file
-sub write {
- my $self = shift;
- my $file = shift or return $self->_error('No file name provided');
-
- # 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;
-
- return 1;
-}
-
-# Save an object to a string
-sub write_string {
- my $self = shift;
- return '' unless @$self;
-
- # Iterate over the documents
- my $indent = 0;
- my @lines = ();
- foreach my $cursor ( @$self ) {
- push @lines, '---';
-
- # 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);
-}
+use CPAN::Meta::YAML 0.002 ();
+our @ISA = qw(CPAN::Meta::YAML);
+our $VERSION = '1.41';
+1;
-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];
- }
-}
+=head1 NAME
-#####################################################################
-# Use Scalar::Util if possible, otherwise emulate it
+Module::Build::YAML - DEPRECATED
-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');
- }
-}
+=head1 DESCRIPTION
-1;
+This module was originally an inline copy of L<YAML::Tiny>. It has been
+deprecated in favor of using L<CPAN::Meta::YAML> directly. This module is kept
+as a subclass wrapper for compatibility.
-__END__
+=cut