summaryrefslogtreecommitdiff
path: root/Master/tlpkg/tlperl/lib/CPAN
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/CPAN
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/CPAN')
-rw-r--r--Master/tlpkg/tlperl/lib/CPAN/Author.pm2
-rw-r--r--Master/tlpkg/tlperl/lib/CPAN/CacheMgr.pm16
-rw-r--r--Master/tlpkg/tlperl/lib/CPAN/Distribution.pm289
-rw-r--r--Master/tlpkg/tlperl/lib/CPAN/Exception/blocked_urllist.pm2
-rw-r--r--Master/tlpkg/tlperl/lib/CPAN/FTP.pm61
-rw-r--r--Master/tlpkg/tlperl/lib/CPAN/FTP/netrc.pm5
-rw-r--r--Master/tlpkg/tlperl/lib/CPAN/FirstTime.pm619
-rw-r--r--Master/tlpkg/tlperl/lib/CPAN/HTTP/Client.pm254
-rw-r--r--Master/tlpkg/tlperl/lib/CPAN/HTTP/Credentials.pm91
-rw-r--r--Master/tlpkg/tlperl/lib/CPAN/HandleConfig.pm307
-rw-r--r--Master/tlpkg/tlperl/lib/CPAN/Index.pm18
-rw-r--r--Master/tlpkg/tlperl/lib/CPAN/LWP/UserAgent.pm76
-rw-r--r--Master/tlpkg/tlperl/lib/CPAN/Meta.pm696
-rw-r--r--Master/tlpkg/tlperl/lib/CPAN/Meta/Converter.pm1365
-rw-r--r--Master/tlpkg/tlperl/lib/CPAN/Meta/Feature.pm116
-rw-r--r--Master/tlpkg/tlperl/lib/CPAN/Meta/History.pm315
-rw-r--r--Master/tlpkg/tlperl/lib/CPAN/Meta/Prereqs.pm277
-rw-r--r--Master/tlpkg/tlperl/lib/CPAN/Meta/Spec.pm1145
-rw-r--r--Master/tlpkg/tlperl/lib/CPAN/Meta/Validator.pm1002
-rw-r--r--Master/tlpkg/tlperl/lib/CPAN/Meta/YAML.pm714
-rw-r--r--Master/tlpkg/tlperl/lib/CPAN/Mirrors.pm36
-rw-r--r--Master/tlpkg/tlperl/lib/CPAN/Module.pm2
-rw-r--r--Master/tlpkg/tlperl/lib/CPAN/Queue.pm53
-rw-r--r--Master/tlpkg/tlperl/lib/CPAN/Shell.pm44
-rw-r--r--Master/tlpkg/tlperl/lib/CPAN/Tarzip.pm13
-rw-r--r--Master/tlpkg/tlperl/lib/CPAN/Version.pm6
26 files changed, 6982 insertions, 542 deletions
diff --git a/Master/tlpkg/tlperl/lib/CPAN/Author.pm b/Master/tlpkg/tlperl/lib/CPAN/Author.pm
index e9e9226be5d..64fe57f61bd 100644
--- a/Master/tlpkg/tlperl/lib/CPAN/Author.pm
+++ b/Master/tlpkg/tlperl/lib/CPAN/Author.pm
@@ -8,7 +8,7 @@ use CPAN::InfoObj;
use vars qw(
$VERSION
);
-$VERSION = "5.5";
+$VERSION = "5.5001";
package CPAN::Author;
use strict;
diff --git a/Master/tlpkg/tlperl/lib/CPAN/CacheMgr.pm b/Master/tlpkg/tlperl/lib/CPAN/CacheMgr.pm
index 827baeaefdb..b9b4eeb32bf 100644
--- a/Master/tlpkg/tlperl/lib/CPAN/CacheMgr.pm
+++ b/Master/tlpkg/tlperl/lib/CPAN/CacheMgr.pm
@@ -10,7 +10,7 @@ use File::Find;
use vars qw(
$VERSION
);
-$VERSION = "5.5";
+$VERSION = "5.5001";
package CPAN::CacheMgr;
use strict;
@@ -189,7 +189,8 @@ sub _clean_cache {
#-> sub CPAN::CacheMgr::new ;
sub new {
- my $class = shift;
+ my($class,$phase) = @_;
+ $phase ||= "atstart";
my $time = time;
my($debug,$t2);
$debug = "";
@@ -199,10 +200,12 @@ sub new {
SCAN => $CPAN::Config->{'scan_cache'} || 'atstart',
DU => 0
};
+ $CPAN::Frontend->mydie("Unknown scan_cache argument: $self->{SCAN}")
+ unless $self->{SCAN} =~ /never|atstart|atexit/;
File::Path::mkpath($self->{ID});
my $dh = DirHandle->new($self->{ID});
bless $self, $class;
- $self->scan_cache;
+ $self->scan_cache($phase);
$t2 = time;
$debug .= "timing of CacheMgr->new: ".($t2 - $time);
$time = $t2;
@@ -212,10 +215,9 @@ sub new {
#-> sub CPAN::CacheMgr::scan_cache ;
sub scan_cache {
- my $self = shift;
- return if $self->{SCAN} eq 'never';
- $CPAN::Frontend->mydie("Unknown scan_cache argument: $self->{SCAN}")
- unless $self->{SCAN} eq 'atstart';
+ my ($self, $phase) = @_;
+ $phase = '' unless defined $phase;
+ return unless $phase eq $self->{SCAN};
return unless $CPAN::META->{LOCK};
$CPAN::Frontend->myprint(
sprintf("Scanning cache %s for sizes\n",
diff --git a/Master/tlpkg/tlperl/lib/CPAN/Distribution.pm b/Master/tlpkg/tlperl/lib/CPAN/Distribution.pm
index ac8f873a130..637ab277d96 100644
--- a/Master/tlpkg/tlperl/lib/CPAN/Distribution.pm
+++ b/Master/tlpkg/tlperl/lib/CPAN/Distribution.pm
@@ -1,11 +1,14 @@
+# -*- Mode: cperl; coding: utf-8; cperl-indent-level: 4 -*-
+# vim: ts=4 sts=4 sw=4:
package CPAN::Distribution;
use strict;
use Cwd qw(chdir);
use CPAN::Distroprefs;
use CPAN::InfoObj;
+use File::Path ();
@CPAN::Distribution::ISA = qw(CPAN::InfoObj);
use vars qw($VERSION);
-$VERSION = "1.9456_01";
+$VERSION = "1.9602_01";
# Accessors
sub cpan_comment {
@@ -188,7 +191,7 @@ sub color_cmd_tmps {
my $premo;
unless ($premo = CPAN::Shell->expand("Module",$pre)) {
$CPAN::Frontend->mywarn("prerequisite module[$pre] not known\n");
- $CPAN::Frontend->mysleep(2);
+ $CPAN::Frontend->mysleep(0.2);
next PREREQ;
}
$premo->color_cmd_tmps($depth+1,$color,[@$ancestors, $self->id]);
@@ -501,6 +504,10 @@ See also http://rt.cpan.org/Ticket/Display.html?id=38932\n");
$from_dir = File::Spec->curdir;
@dirents = @readdir;
}
+ eval { File::Path::mkpath $builddir; };
+ if ($@) {
+ $CPAN::Frontend->mydie("Cannot create directory $builddir: $@");
+ }
$packagedir = File::Temp::tempdir(
"$tdir_base-XXXXXX",
DIR => $builddir,
@@ -575,6 +582,35 @@ EOF
return($packagedir,$local_file);
}
+#-> sub CPAN::Distribution::pick_meta_file ;
+sub pick_meta_file {
+ my($self, $filter) = @_;
+ $filter = '.' unless defined $filter;
+
+ my $build_dir;
+ unless ($build_dir = $self->{build_dir}) {
+ # maybe permission on build_dir was missing
+ $CPAN::Frontend->mywarn("Warning: cannot determine META.yml without a build_dir.\n");
+ return;
+ }
+
+ my $has_cm = $CPAN::META->has_usable("CPAN::Meta");
+ my $has_pcm = $CPAN::META->has_usable("Parse::CPAN::Meta");
+
+ my @choices;
+ push @choices, 'MYMETA.json' if $has_cm;
+ push @choices, 'MYMETA.yml' if $has_cm || $has_pcm;
+ push @choices, 'META.json' if $has_cm;
+ push @choices, 'META.yml' if $has_cm || $has_pcm;
+
+ for my $file ( grep { /$filter/ } @choices ) {
+ my $path = File::Spec->catdir( $build_dir, $file );
+ return $path if -f $path
+ }
+
+ return;
+}
+
#-> sub CPAN::Distribution::parse_meta_yml ;
sub parse_meta_yml {
my($self, $yaml) = @_;
@@ -586,6 +622,7 @@ sub parse_meta_yml {
my $early_yaml;
eval {
$CPAN::META->has_inst("Parse::CPAN::Meta") or die;
+ die "Parse::CPAN::Meta yaml too old" unless $Parse::CPAN::Meta::VERSION >= "1.40";
# P::C::M returns last document in scalar context
$early_yaml = Parse::CPAN::Meta::LoadFile($yaml);
};
@@ -638,20 +675,21 @@ sub satisfy_configure_requires {
# configure_requires simply fail, all others succeed
}
my @prereq = $self->unsat_prereq("configure_requires_later");
- $self->debug("configure_requires[@prereq]") if $CPAN::DEBUG;
+ $self->debug(sprintf "configure_requires[%s]", join(",",map {join "/",@$_} @prereq)) if $CPAN::DEBUG;
return 1 unless @prereq;
$self->debug(\@prereq) if $CPAN::DEBUG;
if ($self->{configure_requires_later}) {
for my $k (keys %{$self->{configure_requires_later_for}||{}}) {
if ($self->{configure_requires_later_for}{$k}>1) {
- # we must not come here a second time
- $CPAN::Frontend->mywarn("Panic: Some prerequisites is not available, please investigate...");
- require YAML::Syck;
- $CPAN::Frontend->mydie
- (
- YAML::Syck::Dump
- ({self=>$self, prereq=>\@prereq})
- );
+ my $type = "";
+ for my $p (@prereq) {
+ if ($p->[0] eq $k) {
+ $type = $p->[1];
+ }
+ }
+ $type = " $type" if $type;
+ $CPAN::Frontend->mywarn("Warning: unmanageable(?) prerequisite $k$type");
+ sleep 1;
}
}
}
@@ -844,12 +882,20 @@ sub try_download {
my $readfh = CPAN::Tarzip->TIEHANDLE($patch);
my $pcommand;
- my $ppp = $self->_patch_p_parameter($readfh);
+ my($ppp,$pfiles) = $self->_patch_p_parameter($readfh);
if ($ppp eq "applypatch") {
$pcommand = "$CPAN::Config->{applypatch} -verbose";
} else {
my $thispatchargs = join " ", $stdpatchargs, $ppp;
$pcommand = "$patchbin $thispatchargs";
+ require Config; # usually loaded from CPAN.pm
+ if ($Config::Config{osname} eq "solaris") {
+ # native solaris patch cannot patch readonly files
+ for my $file (@{$pfiles||[]}) {
+ my @stat = stat $file or next;
+ chmod $stat[2] | 0600, $file; # may fail
+ }
+ }
}
$readfh = CPAN::Tarzip->TIEHANDLE($patch); # open again
@@ -880,10 +926,14 @@ sub try_download {
}
}
+# may return
+# - "applypatch"
+# - ("-p0"|"-p1", $files)
sub _patch_p_parameter {
my($self,$fh) = @_;
my $cnt_files = 0;
my $cnt_p0files = 0;
+ my @files;
local($_);
while ($_ = $fh->READLINE) {
if (
@@ -895,13 +945,15 @@ sub _patch_p_parameter {
}
next unless /^[\*\+]{3}\s(\S+)/;
my $file = $1;
+ push @files, $file;
$cnt_files++;
$cnt_p0files++ if -f $file;
CPAN->debug("file[$file]cnt_files[$cnt_files]cnt_p0files[$cnt_p0files]")
if $CPAN::DEBUG;
}
return "-p1" unless $cnt_files;
- return $cnt_files==$cnt_p0files ? "-p0" : "-p1";
+ my $opt_p = $cnt_files==$cnt_p0files ? "-p0" : "-p1";
+ return ($opt_p, \@files);
}
#-> sub CPAN::Distribution::_edge_cases
@@ -2398,8 +2450,19 @@ sub follow_prereqs {
return unless @prereq_tuples;
my(@good_prereq_tuples);
for my $p (@prereq_tuples) {
- # XXX watch out for foul ones
- push @good_prereq_tuples, $p;
+ # promote if possible
+ if ($p->[1] =~ /^(r|c)$/) {
+ push @good_prereq_tuples, $p;
+ } elsif ($p->[1] =~ /^(b)$/) {
+ my $reqtype = CPAN::Queue->reqtype_of($p->[0]);
+ if ($reqtype =~ /^(r|c)$/) {
+ push @good_prereq_tuples, [$p->[0], $reqtype];
+ } else {
+ push @good_prereq_tuples, $p;
+ }
+ } else {
+ die "Panic: in follow_prereqs: reqtype[$p->[1]] seen, should never happen";
+ }
}
my $pretty_id = $self->pretty_id;
my %map = (
@@ -2436,7 +2499,7 @@ sub follow_prereqs {
of modules we are processing right now?", "yes");
$follow = $answer =~ /^\s*y/i;
} else {
- my @prereq = map { $_=>[0] } @good_prereq_tuples;
+ my @prereq = map { $_->[0] } @good_prereq_tuples;
local($") = ", ";
$CPAN::Frontend->
myprint(" Ignoring dependencies on modules @prereq\n");
@@ -2513,13 +2576,9 @@ sub unsat_prereq {
my $prefs_depends = $self->prefs->{depends}||{};
my $feature_depends = $self->_feature_depends();
if ($slot eq "configure_requires_later") {
- my $meta_yml = $self->parse_meta_yml();
- if (defined $meta_yml && (! ref $meta_yml || ref $meta_yml ne "HASH")) {
- $CPAN::Frontend->mywarn("The content of META.yml is defined but not a HASH reference. Cannot use it.\n");
- $meta_yml = +{};
- }
+ my $meta_configure_requires = $self->configure_requires();
%merged = (
- %{$meta_yml->{configure_requires}||{}},
+ %{$meta_configure_requires||{}},
%{$prefs_depends->{configure_requires}||{}},
%{$feature_depends->{configure_requires}||{}},
);
@@ -2576,10 +2635,9 @@ sub unsat_prereq {
or $need_version eq '0' # "==" would trigger warning when not numeric
or $need_version eq "undef"
)) {
- unless ($nmo->inst_deprecated) {
- next NEED;
- }
-
+ unless ($nmo->inst_deprecated) {
+ next NEED;
+ }
}
$available_version = $nmo->available_version;
@@ -2595,6 +2653,19 @@ sub unsat_prereq {
if ( $available_file ) {
if ( $inst_file && $available_file eq $inst_file && $nmo->inst_deprecated ) {
# continue installing as a prereq
+ } elsif ($self->{reqtype} =~ /^(r|c)$/ && exists $prereq_pm->{requires}{$need_module} && $nmo && !$inst_file) {
+ # continue installing as a prereq; this may be a
+ # distro we already used when it was a build_requires
+ # so we did not install it. But suddenly somebody
+ # wants it as a requires
+ my $need_distro = $nmo->distribution;
+ if ($need_distro->{install} && $need_distro->{install}->failed && $need_distro->{install}->text =~ /is only/) {
+ CPAN->debug("promotion from build_requires to requires") if $CPAN::DEBUG;
+ delete $need_distro->{install}; # promote to another installation attempt
+ $need_distro->{reqtype} = "r";
+ $need_distro->install;
+ next NEED;
+ }
}
else {
next NEED if $self->_fulfills_all_version_rqs(
@@ -2696,7 +2767,21 @@ sub unsat_prereq {
}
}
}
- my $needed_as = exists $prereq_pm->{requires}{$need_module} ? "r" : "b";
+ my $needed_as;
+ if (0) {
+ } elsif (exists $prereq_pm->{requires}{$need_module}) {
+ $needed_as = "r";
+ } elsif ($slot eq "configure_requires_later") {
+ # in ae872487d5 we said: C< we have not yet run the
+ # {Build,Makefile}.PL, we must presume "r" >; but the
+ # meta.yml standard says C< These dependencies are not
+ # required after the distribution is installed. >; so now
+ # we change it back to "b" and care for the proper
+ # promotion later.
+ $needed_as = "b";
+ } else {
+ $needed_as = "b";
+ }
push @need, [$need_module,$needed_as];
}
my @unfolded = map { "[".join(",",@$_)."]" } @need;
@@ -2758,27 +2843,38 @@ sub _fulfills_all_version_rqs {
return $ret;
}
+#-> sub CPAN::Distribution::read_meta
+# read any sort of meta files, return CPAN::Meta object if no errors
+sub read_meta {
+ my($self) = @_;
+ my $meta_file = $self->pick_meta_file
+ or return;
+
+ return unless $CPAN::META->has_usable("CPAN::Meta");
+ my $meta = eval { CPAN::Meta->load_file($meta_file)}
+ or return;
+
+ # Very old EU::MM could have wrong META
+ if ($meta_file eq 'META.yml'
+ && $meta->generated_by =~ /ExtUtils::MakeMaker version ([\d\._]+)/
+ ) {
+ my $eummv = do { local $^W = 0; $1+0; };
+ return if $eummv < 6.2501;
+ }
+
+ return $meta;
+}
+
#-> sub CPAN::Distribution::read_yaml ;
+# XXX This should be DEPRECATED -- dagolden, 2011-02-05
sub read_yaml {
my($self) = @_;
- my $build_dir;
- unless ($build_dir = $self->{build_dir}) {
- # maybe permission on build_dir was missing
- $CPAN::Frontend->mywarn("Warning: cannot determine META.yml without a build_dir.\n");
- return;
- }
- # if MYMETA.yml exists, that takes precedence over META.yml
- my $meta = File::Spec->catfile($build_dir,"META.yml");
- my $mymeta = File::Spec->catfile($build_dir,"MYMETA.yml");
- my $meta_file = -f $mymeta ? $mymeta : $meta;
+ my $meta_file = $self->pick_meta_file;
$self->debug("meta_file[$meta_file]") if $CPAN::DEBUG;
- return unless -f $meta_file;
+ return unless $meta_file;
my $yaml;
eval { $yaml = $self->parse_meta_yml($meta_file) };
if ($@ or ! $yaml) {
- $CPAN::Frontend->mywarnonce("Could not read ".
- "'$meta_file'. Falling back to other ".
- "methods to determine prerequisites\n");
return undef; # if we die, then we cannot read YAML's own META.yml
}
# not "authoritative"
@@ -2790,7 +2886,7 @@ sub read_yaml {
if $CPAN::DEBUG;
$self->debug($yaml) if $CPAN::DEBUG && $yaml;
# MYMETA.yml is static and authoritative by definition
- if ( $meta_file eq $mymeta ) {
+ if ( $meta_file =~ /MYMETA\.yml/ ) {
return $yaml;
}
# META.yml is authoritative only if dynamic_config is defined and false
@@ -2801,6 +2897,21 @@ sub read_yaml {
return undef;
}
+#-> sub CPAN::Distribution::configure_requires ;
+sub configure_requires {
+ my($self) = @_;
+ return unless my $meta_file = $self->pick_meta_file('^META');
+ if (my $meta_obj = $self->read_meta) {
+ my $prereqs = $meta_obj->effective_prereqs;
+ my $cr = $prereqs->requirements_for(qw/configure requires/);
+ return $cr ? $cr->as_string_hash : undef;
+ }
+ else {
+ my $yaml = eval { $self->parse_meta_yml($meta_file) };
+ return $yaml->{configure_requires};
+ }
+}
+
#-> sub CPAN::Distribution::prereq_pm ;
sub prereq_pm {
my($self) = @_;
@@ -2815,7 +2926,19 @@ sub prereq_pm {
$self->{modulebuild}||"",
) if $CPAN::DEBUG;
my($req,$breq);
- if (my $yaml = $self->read_yaml) { # often dynamic_config prevents a result here
+ my $meta_obj = $self->read_meta;
+ # META/MYMETA is only authoritative if dynamic_config is false
+ if ($meta_obj && ! $meta_obj->dynamic_config) {
+ my $prereqs = $meta_obj->effective_prereqs;
+ my $requires = $prereqs->requirements_for(qw/runtime requires/);
+ my $build_requires = $prereqs->requirements_for(qw/build requires/);
+ my $test_requires = $prereqs->requirements_for(qw/test requires/);
+ # XXX we don't yet distinguish build vs test, so merge them for now
+ $build_requires->add_requirements($test_requires);
+ $req = $requires->as_string_hash;
+ $breq = $build_requires->as_string_hash;
+ }
+ elsif (my $yaml = $self->read_yaml) { # often dynamic_config prevents a result here
$req = $yaml->{requires} || {};
$breq = $yaml->{build_requires} || {};
undef $req unless ref $req eq "HASH" && %$req;
@@ -2833,6 +2956,7 @@ sub prereq_pm {
my $areq;
my $do_replace;
while (my($k,$v) = each %{$req||{}}) {
+ next unless defined $v;
if ($v =~ /\d/) {
$areq->{$k} = $v;
} elsif ($k =~ /[A-Za-z]/ &&
@@ -2851,6 +2975,11 @@ sub prereq_pm {
$req = $areq if $do_replace;
}
}
+ else {
+ $CPAN::Frontend->mywarnonce("Could not read metadata file. Falling back to other ".
+ "methods to determine prerequisites\n");
+ }
+
unless ($req || $breq) {
my $build_dir;
unless ( $build_dir = $self->{build_dir} ) {
@@ -3122,8 +3251,42 @@ sub test {
$tests_ok = system($system) == 0;
}
$self->introduce_myself;
+ my $but = $self->_make_test_illuminate_prereqs();
if ( $tests_ok ) {
- {
+ if ($but) {
+ $CPAN::Frontend->mywarn("Tests succeeded but $but\n");
+ $self->{make_test} = CPAN::Distrostatus->new("NO $but");
+ $self->store_persistent_state;
+ return $self->goodbye("[dependencies] -- NA");
+ }
+ $CPAN::Frontend->myprint(" $system -- OK\n");
+ $self->{make_test} = CPAN::Distrostatus->new("YES");
+ $CPAN::META->is_tested($self->{build_dir},$self->{make_test}{TIME});
+ # probably impossible to need the next line because badtestcnt
+ # has a lifespan of one command
+ delete $self->{badtestcnt};
+ } else {
+ if ($but) {
+ $but .= "; additionally test harness failed";
+ $CPAN::Frontend->mywarn("$but\n");
+ $self->{make_test} = CPAN::Distrostatus->new("NO $but");
+ } else {
+ $self->{make_test} = CPAN::Distrostatus->new("NO");
+ }
+ $self->{badtestcnt}++;
+ $CPAN::Frontend->mywarn(" $system -- NOT OK\n");
+ CPAN::Shell->optprint
+ ("hint",
+ sprintf
+ ("//hint// to see the cpan-testers results for installing this module, try:
+ reports %s\n",
+ $self->pretty_id));
+ }
+ $self->store_persistent_state;
+}
+
+sub _make_test_illuminate_prereqs {
+ my($self) = @_;
my @prereq;
# local $CPAN::DEBUG = 16; # Distribution
@@ -3154,36 +3317,14 @@ sub test {
push @prereq, $m;
}
}
+ my $but;
if (@prereq) {
my $cnt = @prereq;
my $which = join ",", @prereq;
- my $but = $cnt == 1 ? "one dependency not OK ($which)" :
+ $but = $cnt == 1 ? "one dependency not OK ($which)" :
"$cnt dependencies missing ($which)";
- $CPAN::Frontend->mywarn("Tests succeeded but $but\n");
- $self->{make_test} = CPAN::Distrostatus->new("NO $but");
- $self->store_persistent_state;
- return $self->goodbye("[dependencies] -- NA");
}
- }
-
- $CPAN::Frontend->myprint(" $system -- OK\n");
- $self->{make_test} = CPAN::Distrostatus->new("YES");
- $CPAN::META->is_tested($self->{build_dir},$self->{make_test}{TIME});
- # probably impossible to need the next line because badtestcnt
- # has a lifespan of one command
- delete $self->{badtestcnt};
- } else {
- $self->{make_test} = CPAN::Distrostatus->new("NO");
- $self->{badtestcnt}++;
- $CPAN::Frontend->mywarn(" $system -- NOT OK\n");
- CPAN::Shell->optprint
- ("hint",
- sprintf
- ("//hint// to see the cpan-testers results for installing this module, try:
- reports %s\n",
- $self->pretty_id));
- }
- $self->store_persistent_state;
+ $but;
}
sub _prefs_with_expect {
@@ -3365,13 +3506,15 @@ sub install {
}
}
if (exists $self->{install}) {
- if (UNIVERSAL::can($self->{install},"text") ?
- $self->{install}->text eq "YES" :
- $self->{install} =~ /^YES/
- ) {
+ my $text = UNIVERSAL::can($self->{install},"text") ?
+ $self->{install}->text :
+ $self->{install};
+ if ($text =~ /^YES/) {
$CPAN::Frontend->myprint(" Already done\n");
$CPAN::META->is_installed($self->{build_dir});
return 1;
+ } elsif ($text =~ /is only/) {
+ push @e, $text;
} else {
# comment in Todo on 2006-02-11; maybe retry?
push @e, "Already tried without success";
diff --git a/Master/tlpkg/tlperl/lib/CPAN/Exception/blocked_urllist.pm b/Master/tlpkg/tlperl/lib/CPAN/Exception/blocked_urllist.pm
index 102c194e612..87d07d13f14 100644
--- a/Master/tlpkg/tlperl/lib/CPAN/Exception/blocked_urllist.pm
+++ b/Master/tlpkg/tlperl/lib/CPAN/Exception/blocked_urllist.pm
@@ -7,7 +7,7 @@ use overload '""' => "as_string";
use vars qw(
$VERSION
);
-$VERSION = "1.0";
+$VERSION = "1.001";
sub new {
diff --git a/Master/tlpkg/tlperl/lib/CPAN/FTP.pm b/Master/tlpkg/tlperl/lib/CPAN/FTP.pm
index 268ca284678..4f233814e54 100644
--- a/Master/tlpkg/tlperl/lib/CPAN/FTP.pm
+++ b/Master/tlpkg/tlperl/lib/CPAN/FTP.pm
@@ -14,7 +14,7 @@ use vars qw($connect_to_internet_ok $Ua $Thesite $ThesiteURL $Themethod);
use vars qw(
$VERSION
);
-$VERSION = "5.5004";
+$VERSION = "5.5005";
#-> sub CPAN::FTP::ftp_statistics
# if they want to rewrite, they need to pass in a filehandle
@@ -46,7 +46,11 @@ sub _ftp_statistics {
$CPAN::Frontend->myprint("Warning (usually harmless): $@\n");
return;
} elsif (ref $@ eq "CPAN::Exception::yaml_process_error") {
- $CPAN::Frontend->mydie($@);
+ my $time = time;
+ my $to = "$file.$time";
+ $CPAN::Frontend->myprint("Error reading '$file': $@\nStashing away as '$to' to prevent further interruptions. You may want to remove that file later.\n");
+ rename $file, $to or $CPAN::Frontend->mydie("Could not rename: $!");
+ return;
}
} else {
$CPAN::Frontend->mydie($@);
@@ -572,13 +576,16 @@ sub hostdleasy { #called from hostdlxxx
$ThesiteURL = $ro_url;
return $ungz;
}
- else {
+ elsif (-f $l && -r _) {
eval { CPAN::Tarzip->new($l)->gunzip($aslocal) };
- if ( -f $aslocal) {
+ if ( -f $aslocal && -s _) {
$ThesiteURL = $ro_url;
return $aslocal;
}
- else {
+ elsif (! -s $aslocal) {
+ unlink $aslocal;
+ }
+ elsif (-f $l) {
$CPAN::Frontend->mywarn("Error decompressing '$l': $@\n")
if $@;
return;
@@ -645,8 +652,46 @@ sub hostdleasy { #called from hostdlxxx
# Net::FTP can still succeed where LWP fails. So we do not
# skip Net::FTP anymore when LWP is available.
}
- } else {
- $CPAN::Frontend->mywarn(" LWP not available\n");
+ } elsif ($url =~ /^http:/ && $CPAN::META->has_usable('HTTP::Tiny')) {
+ require CPAN::HTTP::Client;
+ my $chc = CPAN::HTTP::Client->new(
+ proxy => $CPAN::Config->{http_proxy} || $ENV{http_proxy},
+ no_proxy => $CPAN::Config->{no_proxy} || $ENV{no_proxy},
+ );
+ for my $try ( $url, ( $url !~ /\.gz(?!\n)\Z/ ? "$url.gz" : () ) ) {
+ $CPAN::Frontend->myprint("Fetching with HTTP::Tiny:\n$try\n");
+ my $res = eval { $chc->mirror($try, $aslocal) };
+ if ( $res && $res->{success} ) {
+ $ThesiteURL = $ro_url;
+ my $now = time;
+ utime $now, $now, $aslocal; # download time is more
+ # important than upload
+ # time
+ return $aslocal;
+ }
+ elsif ( $res && $res->{status} ne '599') {
+ $CPAN::Frontend->myprint(sprintf(
+ "HTTP::Tiny failed with code[%s] message[%s]\n",
+ $res->{status},
+ $res->{reason},
+ )
+ );
+ }
+ elsif ( $res && $res->{status} eq '599') {
+ $CPAN::Frontend->myprint(sprintf(
+ "HTTP::Tiny failed with an internal error: %s\n",
+ $res->{content},
+ )
+ );
+ }
+ else {
+ my $err = $@ || 'Unknown error';
+ $CPAN::Frontend->myprint(sprintf(
+ "Error downloading with HTTP::Tiny: %s\n", $err
+ )
+ );
+ }
+ }
}
return if $CPAN::Signal;
if ($url =~ m|^ftp://(.*?)/(.*)/(.*)|) {
@@ -845,7 +890,7 @@ sub _proxy_vars {
}
if ($want_proxy) {
my($user, $pass) =
- &CPAN::LWP::UserAgent::get_proxy_credentials();
+ CPAN::HTTP::Credentials->get_proxy_credentials();
$ret = {
proxy_user => $user,
proxy_pass => $pass,
diff --git a/Master/tlpkg/tlperl/lib/CPAN/FTP/netrc.pm b/Master/tlpkg/tlperl/lib/CPAN/FTP/netrc.pm
index c05405e7ef6..0778e8adbcc 100644
--- a/Master/tlpkg/tlperl/lib/CPAN/FTP/netrc.pm
+++ b/Master/tlpkg/tlperl/lib/CPAN/FTP/netrc.pm
@@ -1,13 +1,12 @@
package CPAN::FTP::netrc;
use strict;
-$CPAN::FTP::netrc::VERSION = $CPAN::FTP::netrc::VERSION = "1.00";
+$CPAN::FTP::netrc::VERSION = $CPAN::FTP::netrc::VERSION = "1.01";
# package CPAN::FTP::netrc;
sub new {
my($class) = @_;
- my $home = CPAN::HandleConfig::home();
- my $file = File::Spec->catfile($home,".netrc");
+ my $file = File::Spec->catfile($ENV{HOME},".netrc");
my($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
$atime,$mtime,$ctime,$blksize,$blocks)
diff --git a/Master/tlpkg/tlperl/lib/CPAN/FirstTime.pm b/Master/tlpkg/tlperl/lib/CPAN/FirstTime.pm
index 53ffbf1ef04..667bdca2f9a 100644
--- a/Master/tlpkg/tlperl/lib/CPAN/FirstTime.pm
+++ b/Master/tlpkg/tlperl/lib/CPAN/FirstTime.pm
@@ -1,4 +1,5 @@
# -*- Mode: cperl; coding: utf-8; cperl-indent-level: 4 -*-
+# vim: ts=4 sts=4 sw=4:
package CPAN::FirstTime;
use strict;
@@ -8,8 +9,8 @@ use File::Basename ();
use File::Path ();
use File::Spec ();
use CPAN::Mirrors ();
-use vars qw($VERSION $silent);
-$VERSION = "5.5301";
+use vars qw($VERSION $auto_config);
+$VERSION = "5.5303";
=head1 NAME
@@ -63,7 +64,7 @@ directory between sessions. Since 1.88_58 CPAN.pm has a YAML-based
mechanism that makes it possible to share the contents of the
build_dir/ directory between different sessions with the same version
of perl. People who prefer to test things several days before
-installing will like this feature because it safes a lot of time.
+installing will like this feature because it saves a lot of time.
If you say yes to the following question, CPAN will try to store
enough information about the build process so that it can pick up in
@@ -200,7 +201,7 @@ Preferred method for determining the current working directory?
=item halt_on_failure
-Normaly, CPAN.pm continues processing the full list of targets and
+Normally, CPAN.pm continues processing the full list of targets and
dependencies, even if one of them fails. However, you can specify
that CPAN should halt after the first failure.
@@ -212,7 +213,7 @@ If you have one of the readline packages (Term::ReadLine::Perl,
Term::ReadLine::Gnu, possibly others) installed, the interactive CPAN
shell will have history support. The next two questions deal with the
filename of the history file and with its size. If you do not want to
-set this variable, please hit SPACE RETURN to the following question.
+set this variable, please hit SPACE ENTER to the following question.
File to save your history?
@@ -296,6 +297,7 @@ Parameters for the 'make install' command?
Typical frequently used setting:
UNINST=1 # to always uninstall potentially conflicting files
+ # (but do NOT use with local::lib or INSTALL_BASE)
Your choice:
@@ -338,6 +340,7 @@ Parameters for the './Build install' command? Typical frequently used
setting:
--uninst 1 # uninstall conflicting files
+ # (but do NOT use with local::lib or INSTALL_BASE)
Your choice:
@@ -386,7 +389,7 @@ default options for CPAN.pm and the environment can be overridden and
dialog sequences can be stored that can later be executed by an
Expect.pm object. The CPAN.pm distribution comes with some prefab YAML
files that cover sample distributions that can be used as blueprints
-to store one own prefs. Please check out the distroprefs/ directory of
+to store your own prefs. Please check out the distroprefs/ directory of
the CPAN.pm distribution to get a quick start into the prefs system.
Directory where to store default options/environment/dialogs for
@@ -420,10 +423,11 @@ Randomize parameter
=item scan_cache
By default, each time the CPAN module is started, cache scanning is
-performed to keep the cache size in sync. To prevent this, answer
-'never'.
+performed to keep the cache size in sync ('atstart'). Alternatively,
+scanning and cleanup can happen when CPAN exits ('atexit'). To prevent
+any cache cleanup, answer 'never'.
-Perform cache scanning (atstart or never)?
+Perform cache scanning ('atstart', 'atexit' or 'never')?
=item shell
@@ -468,7 +472,7 @@ Tar command verbosity level (none or v or vv)?
=item term_is_latin
-The next option deals with the charset (aka character set) your
+The next option deals with the charset (a.k.a. character set) your
terminal supports. In general, CPAN is English speaking territory, so
the charset does not matter much but some CPAN have names that are
outside the ASCII range. If your terminal supports UTF-8, you should
@@ -496,14 +500,14 @@ improves the overall quality and value of CPAN.
One way you can contribute is to send test results for each module
that you install. If you install the CPAN::Reporter module, you have
-the option to automatically generate and email test reports to CPAN
+the option to automatically generate and deliver test reports to CPAN
Testers whenever you run tests on a CPAN package.
See the CPAN::Reporter documentation for additional details and
-configuration settings. If your firewall blocks outgoing email,
-you will need to configure CPAN::Reporter before sending reports.
+configuration settings. If your firewall blocks outgoing traffic,
+you may need to configure CPAN::Reporter before sending reports.
-Email test reports if CPAN::Reporter is installed (yes/no)?
+Generate test reports if CPAN::Reporter is installed (yes/no)?
=item perl5lib_verbosity
@@ -513,6 +517,15 @@ added). Choose 'v' to get this message, 'none' to suppress it.
Verbosity level for PERL5LIB changes (none or v)?
+=item prefer_external_tar
+
+Per default all untar operations are done with the perl module
+Archive::Tar; by setting this variable to true the external tar
+command is used if available; on Unix this is usually preferred
+because they have a reliable and fast gnutar implementation.
+
+Use the external tar program instead of Archive::Tar?
+
=item trust_test_report_history
When a distribution has already been tested by CPAN::Reporter on
@@ -578,26 +591,16 @@ use vars qw( %prompts );
my @prompts = (
-manual_config => qq[
-CPAN is the world-wide archive of perl resources. It consists of about
-300 sites that all replicate the same contents around the globe. Many
-countries have at least one CPAN site already. The resources found on
-CPAN are easily accessible with the CPAN.pm module. If you want to use
-CPAN.pm, lots of things have to be configured. Fortunately, most of
-them can be determined automatically. If you prefer the automatic
-configuration, answer 'yes' below.
+auto_config => qq{
+CPAN.pm requires configuration, but most of it can be done automatically.
+If you answer 'no' below, you will enter an interactive dialog for each
+configuration option instead.
-If you prefer to enter a dialog instead, you can answer 'no' to this
-question and I'll let you configure in small steps one thing after the
-other. (Note: you can revisit this dialog anytime later by typing 'o
-conf init' at the cpan prompt.)
-
-],
+Would you like to configure as much as possible automatically?},
auto_pick => qq{
-Would you like me to automatically choose the best CPAN mirror
-sites for you? (This means connecting to the Internet and could
-take a couple minutes)},
+Would you like me to automatically choose some CPAN mirror
+sites for you? (This means connecting to the Internet)},
config_intro => qq{
@@ -636,7 +639,7 @@ the \$CPAN::Config takes precedence.
proxy_user => qq{
If your proxy is an authenticating proxy, you can store your username
-permanently. If you do not want that, just press RETURN. You will then
+permanently. If you do not want that, just press ENTER. You will then
be asked for your username in every future session.
},
@@ -645,7 +648,7 @@ proxy_pass => qq{
Your password for the authenticating proxy can also be stored
permanently on disk. If this violates your security policy, just press
-RETURN. You will then be asked for the password in every future
+ENTER. You will then be asked for the password in every future
session.
},
@@ -675,6 +678,24 @@ be echoed to the terminal!
},
+install_help => qq{
+Warning: You do not have write permission for Perl library directories.
+
+To install modules, you need to configure a local Perl library directory or
+escalate your privileges. CPAN can help you by bootstrapping the local::lib
+module or by configuring itself to use 'sudo' (if available). You may also
+resolve this problem manually if you need to customize your setup.
+
+What approach do you want? (Choose 'local::lib', 'sudo' or 'manual')
+},
+
+local_lib_installed => qq{
+local::lib is installed. You must now add the following environment variables
+to your shell configuration files (or registry, if you are on Windows) and
+then restart your command line shell and CPAN before installing modules:
+
+},
+
);
die "Coding error in \@prompts declaration. Odd number of elements, above"
@@ -756,33 +777,17 @@ sub init {
#= Files, directories
#
- unless ($matcher) {
- $CPAN::Frontend->myprint($prompts{manual_config});
- }
-
- my $manual_conf;
-
local *_real_prompt;
if ( $args{autoconfig} ) {
- $manual_conf = "no";
+ $auto_config = 1;
} elsif ($matcher) {
- $manual_conf = "yes";
- } else {
- my $_conf = prompt("Would you like me to configure as much as possible ".
- "automatically?", "yes");
- $manual_conf = ($_conf and $_conf =~ /^y/i) ? "no" : "yes";
- }
- CPAN->debug("manual_conf[$manual_conf]") if $CPAN::DEBUG;
- my $fastread;
- {
- if ($manual_conf =~ /^y/i) {
- $fastread = 0;
+ $auto_config = 0;
} else {
- $fastread = 1;
- $silent = 1;
- $CPAN::Config->{urllist} ||= [];
- $CPAN::Config->{connect_to_internet_ok} ||= 1;
-
+ my $_conf = prompt($prompts{auto_config}, "yes");
+ $auto_config = ($_conf and $_conf =~ /^y/i) ? 1 : 0;
+ }
+ CPAN->debug("auto_config[$auto_config]") if $CPAN::DEBUG;
+ if ( $auto_config ) {
local $^W = 0;
# prototype should match that of &MakeMaker::prompt
my $current_second = time;
@@ -791,7 +796,19 @@ sub init {
# silent prompting -- just quietly use default
*_real_prompt = sub { return $_[1] };
}
+
+ #
+ # bootstrap local::lib or sudo
+ #
+ unless ( $matcher
+ || _can_write_to_libdirs() || _using_installbase() || _using_sudo()
+ ) {
+ local $auto_config = 0; # We *must* ask, even under autoconfig
+ local *_real_prompt; # We *must* show prompt
+ my_prompt_loop(install_help => 'local::lib', $matcher,
+ 'local::lib|sudo|manual');
}
+ $CPAN::Config->{install_help} ||= ''; # Temporary to suppress warnings
if (!$matcher or q{
build_dir
@@ -800,7 +817,7 @@ sub init {
keep_source_where
prefs_dir
} =~ /$matcher/) {
- $CPAN::Frontend->myprint($prompts{config_intro}) unless $silent;
+ $CPAN::Frontend->myprint($prompts{config_intro}) unless $auto_config;
init_cpan_home($matcher);
@@ -831,7 +848,7 @@ sub init {
my_dflt_prompt(build_cache => 100, $matcher);
my_dflt_prompt(index_expire => 1, $matcher);
- my_prompt_loop(scan_cache => 'atstart', $matcher, 'atstart|never');
+ my_prompt_loop(scan_cache => 'atstart', $matcher, 'atstart|atexit|never');
#
#= cache_metadata
@@ -860,13 +877,12 @@ sub init {
if (!$matcher or 'test_report' =~ /$matcher/) {
my_yn_prompt(test_report => 0, $matcher);
if (
+ $matcher &&
$CPAN::Config->{test_report} &&
$CPAN::META->has_inst("CPAN::Reporter") &&
CPAN::Reporter->can('configure')
) {
- local *_real_prompt;
- *_real_prompt = \&CPAN::Shell::colorable_makemaker_prompt;
- my $_conf = prompt("Would you like me configure CPAN::Reporter now?", $silent ? "no" : "yes");
+ my $_conf = prompt("Would you like me configure CPAN::Reporter now?", "yes");
if ($_conf =~ /^y/i) {
$CPAN::Frontend->myprint("\nProceeding to configure CPAN::Reporter.\n");
CPAN::Reporter::configure();
@@ -884,7 +900,7 @@ sub init {
my_dflt_prompt(yaml_module => "YAML", $matcher);
my $old_v = $CPAN::Config->{load_module_verbosity};
$CPAN::Config->{load_module_verbosity} = q[none];
- if (!$silent && !$CPAN::META->has_inst($CPAN::Config->{yaml_module})) {
+ if (!$auto_config && !$CPAN::META->has_inst($CPAN::Config->{yaml_module})) {
$CPAN::Frontend->mywarn
("Warning (maybe harmless): '$CPAN::Config->{yaml_module}' not installed.\n");
$CPAN::Frontend->mysleep(3);
@@ -901,7 +917,18 @@ sub init {
#= External programs
#
my(@path) = split /$Config{'path_sep'}/, $ENV{'PATH'};
- _init_external_progs($matcher,\@path);
+ $CPAN::Frontend->myprint($prompts{external_progs})
+ if !$matcher && !$auto_config;
+ _init_external_progs($matcher, {
+ path => \@path,
+ progs => [ qw/make bzip2 gzip tar unzip gpg patch applypatch/ ],
+ shortcut => 0
+ });
+ _init_external_progs($matcher, {
+ path => \@path,
+ progs => [ qw/wget curl lynx ncftpget ncftp ftp/ ],
+ shortcut => 1
+ });
{
my $path = $CPAN::Config->{'pager'} ||
@@ -928,6 +955,22 @@ sub init {
}
}
+ {
+ my $tar = $CPAN::Config->{tar};
+ my $prefer_external_tar = $CPAN::Config->{prefer_external_tar}; # XXX not yet supported
+ unless (defined $prefer_external_tar) {
+ if ($^O =~ /(MSWin32|solaris)/) {
+ # both have a record of broken tars
+ $prefer_external_tar = 0;
+ } elsif ($tar) {
+ $prefer_external_tar = 1;
+ } else {
+ $prefer_external_tar = 0;
+ }
+ }
+ my_yn_prompt(prefer_external_tar => $prefer_external_tar, $matcher);
+ }
+
#
# verbosity
#
@@ -962,8 +1005,18 @@ sub init {
if (exists $CPAN::HandleConfig::keys{make_install_make_command}) {
# as long as Windows needs $self->_build_command, we cannot
# support sudo on windows :-)
- my_dflt_prompt(make_install_make_command => $CPAN::Config->{make} || "",
- $matcher);
+ my $default = $CPAN::Config->{make} || "";
+ if ( $default && $CPAN::Config->{install_help} eq 'sudo' ) {
+ if ( find_exe('sudo') ) {
+ $default = "sudo $default";
+ delete $CPAN::Config->{make_install_make_command}
+ unless $CPAN::Config->{make_install_make_command} =~ /sudo/;
+ }
+ else {
+ $CPAN::Frontend->mywarnonce("Could not find 'sudo' in PATH\n");
+ }
+ }
+ my_dflt_prompt(make_install_make_command => $default, $matcher);
}
my_dflt_prompt(make_install_arg => $CPAN::Config->{make_arg} || "",
@@ -976,7 +1029,18 @@ sub init {
and $^O ne "MSWin32") {
# as long as Windows needs $self->_build_command, we cannot
# support sudo on windows :-)
- my_dflt_prompt(mbuild_install_build_command => "./Build", $matcher);
+ my $default = "./Build";
+ if ( $CPAN::Config->{install_help} eq 'sudo' ) {
+ if ( find_exe('sudo') ) {
+ $default = "sudo $default";
+ delete $CPAN::Config->{mbuild_install_build_command}
+ unless $CPAN::Config->{mbuild_install_build_command} =~ /sudo/;
+ }
+ else {
+ $CPAN::Frontend->mywarnonce("Could not find 'sudo' in PATH\n");
+ }
+ }
+ my_dflt_prompt(mbuild_install_build_command => $default, $matcher);
}
my_dflt_prompt(mbuild_install_arg => "", $matcher);
@@ -1000,7 +1064,7 @@ sub init {
my @proxy_vars = qw/ftp_proxy http_proxy no_proxy/;
my @proxy_user_vars = qw/proxy_user proxy_pass/;
if (!$matcher or "@proxy_vars @proxy_user_vars" =~ /$matcher/) {
- $CPAN::Frontend->myprint($prompts{proxy_intro}) unless $silent;
+ $CPAN::Frontend->myprint($prompts{proxy_intro}) unless $auto_config;
for (@proxy_vars) {
$prompts{$_} = "Your $_?";
@@ -1012,21 +1076,21 @@ sub init {
$default = $CPAN::Config->{proxy_user} || $CPAN::LWP::UserAgent::USER || "";
- $CPAN::Frontend->myprint($prompts{proxy_user}) unless $silent;
+ $CPAN::Frontend->myprint($prompts{proxy_user}) unless $auto_config;
if ($CPAN::Config->{proxy_user} = prompt("Your proxy user id?",$default)) {
- $CPAN::Frontend->myprint($prompts{proxy_pass}) unless $silent;
+ $CPAN::Frontend->myprint($prompts{proxy_pass}) unless $auto_config;
if ($CPAN::META->has_inst("Term::ReadKey")) {
Term::ReadKey::ReadMode("noecho");
} else {
- $CPAN::Frontend->myprint($prompts{password_warn}) unless $silent;
+ $CPAN::Frontend->myprint($prompts{password_warn}) unless $auto_config;
}
$CPAN::Config->{proxy_pass} = prompt_no_strip("Your proxy password?");
if ($CPAN::META->has_inst("Term::ReadKey")) {
Term::ReadKey::ReadMode("restore");
}
- $CPAN::Frontend->myprint("\n\n") unless $silent;
+ $CPAN::Frontend->myprint("\n\n") unless $auto_config;
}
}
}
@@ -1056,24 +1120,24 @@ sub init {
if ($CPAN::META->has_inst("Term::ANSIColor")) {
my $T="gYw";
$CPAN::Frontend->myprint( " on_ on_y ".
- " on_ma on_\n") unless $silent;
+ " on_ma on_\n") unless $auto_config;
$CPAN::Frontend->myprint( " on_black on_red green ellow ".
- "on_blue genta on_cyan white\n") unless $silent;
+ "on_blue genta on_cyan white\n") unless $auto_config;
for my $FG ("", "bold",
map {$_,"bold $_"} "black","red","green",
"yellow","blue",
"magenta",
"cyan","white") {
- $CPAN::Frontend->myprint(sprintf( "%12s ", $FG)) unless $silent;
+ $CPAN::Frontend->myprint(sprintf( "%12s ", $FG)) unless $auto_config;
for my $BG ("",map {"on_$_"} qw(black red green yellow
blue magenta cyan white)) {
$CPAN::Frontend->myprint( $FG||$BG ?
- Term::ANSIColor::colored(" $T ","$FG $BG") : " $T ") unless $silent;
+ Term::ANSIColor::colored(" $T ","$FG $BG") : " $T ") unless $auto_config;
}
- $CPAN::Frontend->myprint( "\n" ) unless $silent;
+ $CPAN::Frontend->myprint( "\n" ) unless $auto_config;
}
- $CPAN::Frontend->myprint( "\n" ) unless $silent;
+ $CPAN::Frontend->myprint( "\n" ) unless $auto_config;
}
for my $tuple (
["colorize_print", "bold blue on_white"],
@@ -1103,7 +1167,7 @@ sub init {
#
if (!$matcher or 'histfile histsize' =~ /$matcher/) {
- $CPAN::Frontend->myprint($prompts{histfile_intro}) unless $silent;
+ $CPAN::Frontend->myprint($prompts{histfile_intro}) unless $auto_config;
defined($default = $CPAN::Config->{histfile}) or
$default = File::Spec->catfile($CPAN::Config->{cpan_home},"histfile");
my_dflt_prompt(histfile => $default, $matcher);
@@ -1126,7 +1190,6 @@ sub init {
or 'show_unparsable_versions' =~ /$matcher/
or 'show_zero_versions' =~ /$matcher/
) {
- $CPAN::Frontend->myprint($prompts{show_unparsable_or_zero_versions_intro});
my_yn_prompt(show_unparsable_versions => 0, $matcher);
my_yn_prompt(show_zero_versions => 0, $matcher);
}
@@ -1135,35 +1198,12 @@ sub init {
#= MIRRORED.BY and conf_sites()
#
- # remember, this is only triggered if no urllist is given, so 0 is
- # fair and protects the default site from being overloaded and
- # gives the user more chances to select his own urllist.
- my_yn_prompt("connect_to_internet_ok" => $fastread ? 1 : 0, $matcher);
- $CPAN::Config->{urllist} ||= [];
- if ($matcher) {
- if ("urllist" =~ $matcher) {
- $CPAN::Frontend->myprint($prompts{urls_intro});
-
- # conf_sites would go into endless loop with the smash prompt
- local *_real_prompt;
- *_real_prompt = \&CPAN::Shell::colorable_makemaker_prompt;
- my $_conf = prompt($prompts{auto_pick}, "yes");
+ # Let's assume they want to use the internet and make them turn it
+ # off if they really don't.
+ my_yn_prompt("connect_to_internet_ok" => 1, $matcher);
- if ( $_conf =~ /^y/i ) {
- conf_sites( auto_pick => 1 ) or bring_your_own();
- }
- else {
- my $_conf = prompt(
- "Would you like to pick from the CPAN mirror list?", "yes"
- );
-
- if ( $_conf =~ /^y/i ) {
- conf_sites();
- }
- bring_your_own();
- }
- _print_urllist();
- }
+ # Allow matching but don't show during manual config
+ if ($matcher) {
if ("randomize_urllist" =~ $matcher) {
my_dflt_prompt(randomize_urllist => 0, $matcher);
}
@@ -1173,70 +1213,213 @@ sub init {
if ("ftpstats_period" =~ $matcher) {
my_dflt_prompt(ftpstats_period => 14, $matcher);
}
- } elsif ($fastread) {
- $silent = 0;
- local *_real_prompt;
- *_real_prompt = \&CPAN::Shell::colorable_makemaker_prompt;
- if ( @{ $CPAN::Config->{urllist} } ) {
+ }
+
+ $CPAN::Config->{urllist} ||= [];
+
+ if ($auto_config) {
+ if(@{ $CPAN::Config->{urllist} }) {
$CPAN::Frontend->myprint(
- "\nYour 'urllist' is already configured. Type 'o conf init urllist' to change it.\n"
+ "Your 'urllist' is already configured. Type 'o conf init urllist' to change it.\n"
);
}
else {
$CPAN::Frontend->myprint(
"Autoconfigured everything but 'urllist'.\n"
);
+ _do_pick_mirrors();
+ }
+ }
+ elsif (!$matcher || "urllist" =~ $matcher) {
+ _do_pick_mirrors();
+ }
- $CPAN::Frontend->myprint($prompts{urls_intro});
-
- my $_conf = prompt($prompts{auto_pick}, "yes");
+ if ($auto_config) {
+ $CPAN::Frontend->myprint(
+ "\nAutoconfiguration complete.\n"
+ );
+ $auto_config = 0; # reset
+ }
- if ( $_conf =~ /^y/i ) {
- conf_sites( auto_pick => 1 ) or bring_your_own();
+ # bootstrap local::lib now if requested
+ if ( $CPAN::Config->{install_help} eq 'local::lib' ) {
+ if ( ! @{ $CPAN::Config->{urllist} } ) {
+ $CPAN::Frontend->myprint(
+ "Skipping local::lib bootstrap because 'urllist' is not configured.\n"
+ );
}
else {
- my $_conf = prompt(
- "Would you like to pick from the CPAN mirror list?", "yes"
+ $CPAN::Frontend->myprint("\nAttempting to bootstrap local::lib...\n");
+ $CPAN::Frontend->myprint("\nWriting $configpm for bootstrap...\n");
+ delete $CPAN::Config->{install_help}; # temporary only
+ CPAN::HandleConfig->commit;
+ my $dist;
+ if ( $dist = CPAN::Shell->expand('Module', 'local::lib')->distribution ) {
+ # this is a hack to force bootstrapping
+ $dist->{prefs}{pl}{commandline} = "$^X Makefile.PL --bootstrap";
+ # Set @INC for this process so we find things as they bootstrap
+ require lib;
+ lib->import(_local_lib_inc_path());
+ eval { $dist->install };
+ }
+ if ( ! $dist || (my $err = $@) ) {
+ $err ||= 'Could not locate local::lib in the CPAN index';
+ $CPAN::Frontend->mywarn("Error bootstrapping local::lib: $@\n");
+ $CPAN::Frontend->myprint("From the CPAN Shell, you might try 'look local::lib' and \n"
+ . "run 'perl Makefile --bootstrap' and see if that is successful. Then\n"
+ . "restart your CPAN client\n"
);
-
- if ( $_conf =~ /^y/i ) {
- conf_sites();
}
- bring_your_own();
+ else {
+ _local_lib_config();
}
- _print_urllist();
}
- $CPAN::Frontend->myprint(
- "\nAutoconfiguration complete.\n"
- );
}
- $silent = 0; # reset
+ # install_help is temporary for configuration and not saved
+ delete $CPAN::Config->{install_help};
$CPAN::Frontend->myprint("\n");
if ($matcher && !$CPAN::Config->{auto_commit}) {
$CPAN::Frontend->myprint("Please remember to call 'o conf commit' to ".
"make the config permanent!\n");
} else {
- CPAN::HandleConfig->commit($configpm);
+ CPAN::HandleConfig->commit;
+ }
+
+ if (! $matcher) {
+ $CPAN::Frontend->myprint(
+ "\nYou can re-run configuration any time with 'o conf init' in the CPAN shell\n"
+ );
}
+
}
-sub _init_external_progs {
- my($matcher,$PATH) = @_;
- my @external_progs = qw/bzip2 gzip tar unzip
+sub _local_lib_config {
+ # Set environment stuff for this process
+ require local::lib;
+ my %env = local::lib->build_environment_vars_for(_local_lib_path(), 1);
+ while ( my ($k, $v) = each %env ) {
+ $ENV{$k} = $v;
+ }
- make
+ # Tell user about environment vars to set
+ $CPAN::Frontend->myprint($prompts{local_lib_installed});
+ local $ENV{SHELL} = $CPAN::Config->{shell} || $ENV{SHELL};
+ my $shellvars = local::lib->environment_vars_string_for(_local_lib_path());
+ $CPAN::Frontend->myprint($shellvars);
+
+ # Offer to mangle the shell config
+ my $munged_rc;
+ if ( my $rc = _find_shell_config() ) {
+ local $auto_config = 0; # We *must* ask, even under autoconfig
+ local *_real_prompt; # We *must* show prompt
+ my $_conf = prompt(
+ "\nWould you like me to append that to $rc now?", "yes"
+ );
+ if ($_conf =~ /^y/i) {
+ open my $fh, ">>", $rc;
+ print {$fh} "\n$shellvars";
+ close $fh;
+ $munged_rc++;
+ }
+ }
- curl lynx wget ncftpget ncftp ftp
+ # Warn at exit time
+ if ($munged_rc) {
+ push @{$CPAN::META->_exit_messages}, << "HERE";
- gpg
+*** Remember to restart your shell before running cpan again ***
+HERE
+ }
+ else {
+ push @{$CPAN::META->_exit_messages}, << "HERE";
- patch applypatch
- /;
- if (!$matcher or "@external_progs" =~ /$matcher/) {
- $CPAN::Frontend->myprint($prompts{external_progs}) unless $silent;
+*** Remember to add these environment variables to your shell config
+ and restart your shell before running cpan again ***
+
+$shellvars
+HERE
+ }
+}
+
+{
+ my %shell_rc_map = (
+ map { $_ => ".${_}rc" } qw/ bash tcsh csh /,
+ map { $_ => ".profile" } qw/dash ash sh/,
+ zsh => ".zshenv",
+ );
+
+ sub _find_shell_config {
+ my $shell = File::Basename::basename($CPAN::Config->{shell});
+ if ( my $rc = $shell_rc_map{$shell} ) {
+ my $path = File::Spec->catfile($ENV{HOME}, $rc);
+ return $path if -w $path;
+ }
+ }
+}
+
+
+sub _local_lib_inc_path {
+ return File::Spec->catdir(_local_lib_path(), qw/lib perl5/);
+}
+
+sub _local_lib_path {
+ return File::Spec->catdir(_local_lib_home(), 'perl5');
+}
+
+# Adapted from resolve_home_path() in local::lib -- this is where
+# local::lib thinks the user's home is
+{
+ my $local_lib_home;
+ sub _local_lib_home {
+ $local_lib_home ||= File::Spec->rel2abs( do {
+ if ($CPAN::META->has_usable("File::HomeDir") && File::HomeDir->VERSION >= 0.65) {
+ File::HomeDir->my_home;
+ } elsif (defined $ENV{HOME}) {
+ $ENV{HOME};
+ } else {
+ (getpwuid $<)[7] || "~";
+ }
+ });
+ }
+}
+
+sub _do_pick_mirrors {
+ local *_real_prompt;
+ *_real_prompt = \&CPAN::Shell::colorable_makemaker_prompt;
+ $CPAN::Frontend->myprint($prompts{urls_intro});
+ # Only prompt for auto-pick if Net::Ping is new enough to do timings
+ my $_conf = 'n';
+ if ( $CPAN::META->has_usable("Net::Ping") && Net::Ping->VERSION gt '2.13') {
+ $_conf = prompt($prompts{auto_pick}, "yes");
+ }
+ my @old_list = @{ $CPAN::Config->{urllist} };
+ if ( $_conf =~ /^y/i ) {
+ conf_sites( auto_pick => 1 ) or bring_your_own();
+ }
+ else {
+ _print_urllist('Current') if @old_list;
+ my $msg = scalar @old_list
+ ? "\nWould you like to edit the urllist or pick new mirrors from a list?"
+ : "\nWould you like to pick from the CPAN mirror list?" ;
+ my $_conf = prompt($msg, "yes");
+ if ( $_conf =~ /^y/i ) {
+ conf_sites();
+ }
+ bring_your_own();
+ }
+ _print_urllist('New');
+}
+
+sub _init_external_progs {
+ my($matcher,$args) = @_;
+ my $PATH = $args->{path};
+ my @external_progs = @{ $args->{progs} };
+ my $shortcut = $args->{shortcut};
+ my $showed_make_warning;
+ if (!$matcher or "@external_progs" =~ /$matcher/) {
my $old_warn = $^W;
local $^W if $^O eq 'MacOS';
local $^W = $old_warn;
@@ -1276,15 +1459,64 @@ sub _init_external_progs {
$path ||= find_exe($progcall,$PATH);
unless ($path) { # not -e $path, because find_exe already checked that
local $"=";";
- $CPAN::Frontend->mywarn("Warning: $progcall not found in PATH[@$PATH]\n") unless $silent;
- if ($progname eq "make") {
- $CPAN::Frontend->mywarn("ALERT: 'make' is an essential tool for ".
- "building perl Modules. Please make sure you ".
- "have 'make' (or some equivalent) ".
- "working.\n"
- );
+ $CPAN::Frontend->mywarn("Warning: $progcall not found in PATH[@$PATH]\n") unless $auto_config;
+ _beg_for_make(), $showed_make_warning++ if $progname eq "make";
+ }
+ $prompts{$progname} = "Where is your $progname program?";
+ $path = my_dflt_prompt($progname,$path,$matcher,1); # 1 => no strip spaces
+ my $disabling = $path =~ m/^\s*$/;
+
+ # don't let them disable or misconfigure make without warning
+ if ( $progname eq "make" && ( $disabling || ! _check_found($path) ) ) {
+ if ( $disabling && $showed_make_warning ) {
+ next;
+ }
+ else {
+ _beg_for_make() unless $showed_make_warning++;
+ undef $CPAN::Config->{$progname};
+ $CPAN::Frontend->mywarn("Press SPACE and ENTER to disable make (NOT RECOMMENDED)\n");
+ redo;
+ }
+ }
+ elsif ( $disabling ) {
+ next;
+ }
+ elsif ( _check_found( $CPAN::Config->{$progname} ) ) {
+ last if $shortcut && !$matcher;
+ }
+ else {
+ undef $CPAN::Config->{$progname};
+ $CPAN::Frontend->mywarn("Press SPACE and ENTER to disable $progname\n");
+ redo;
+ }
+ }
+ }
+}
+
+sub _check_found {
+ my ($prog) = @_;
+ if ( ! -f $prog ) {
+ $CPAN::Frontend->mywarn("Warning: '$prog' does not exist\n")
+ unless $auto_config;
+ return;
+ }
+ elsif ( ! -x $prog ) {
+ $CPAN::Frontend->mywarn("Warning: '$prog' is not executable\n")
+ unless $auto_config;
+ return;
+ }
+ return 1;
+}
+
+sub _beg_for_make {
+ $CPAN::Frontend->mywarn(<<"HERE");
+
+ALERT: 'make' is an essential tool for building perl Modules.
+Please make sure you have 'make' (or some equivalent) working.
+
+HERE
if ($^O eq "MSWin32") {
- $CPAN::Frontend->mywarn("
+ $CPAN::Frontend->mywarn(<<"HERE");
Windows users may want to follow this procedure when back in the CPAN shell:
look YVES/scripts/alien_nmake.pl
@@ -1295,39 +1527,30 @@ substitute. You can then revisit this dialog with
o conf init make
-");
- }
- }
- }
- $prompts{$progname} = "Where is your $progname program?";
- my_dflt_prompt($progname,$path,$matcher);
- }
+HERE
}
}
sub init_cpan_home {
my($matcher) = @_;
if (!$matcher or 'cpan_home' =~ /$matcher/) {
- my $cpan_home = $CPAN::Config->{cpan_home}
- || File::Spec->catdir(CPAN::HandleConfig::home(), ".cpan");
-
+ my $cpan_home =
+ $CPAN::Config->{cpan_home} || CPAN::HandleConfig::cpan_home();
if (-d $cpan_home) {
- $CPAN::Frontend->myprint(qq{
-
-I see you already have a directory
- $cpan_home
-Shall we use it as the general CPAN build and cache directory?
-
-}) unless $silent;
+ $CPAN::Frontend->myprint(
+ "\nI see you already have a directory\n" .
+ "\n$cpan_home\n" .
+ "Shall we use it as the general CPAN build and cache directory?\n\n"
+ ) unless $auto_config;
} else {
# no cpan-home, must prompt and get one
- $CPAN::Frontend->myprint($prompts{cpan_home_where}) unless $silent;
+ $CPAN::Frontend->myprint($prompts{cpan_home_where}) unless $auto_config;
}
my $default = $cpan_home;
my $loop = 0;
my($last_ans,$ans);
- $CPAN::Frontend->myprint(" <cpan_home>\n") unless $silent;
+ $CPAN::Frontend->myprint(" <cpan_home>\n") unless $auto_config;
PROMPT: while ($ans = prompt("CPAN build and cache directory?",$default)) {
if (File::Spec->file_name_is_absolute($ans)) {
my @cpan_home = split /[\/\\]/, $ans;
@@ -1372,18 +1595,21 @@ Shall we use it as the general CPAN build and cache directory?
}
sub my_dflt_prompt {
- my ($item, $dflt, $m) = @_;
+ my ($item, $dflt, $m, $no_strip) = @_;
my $default = $CPAN::Config->{$item} || $dflt;
- if (!$silent && (!$m || $item =~ /$m/)) {
+ if (!$auto_config && (!$m || $item =~ /$m/)) {
if (my $intro = $prompts{$item . "_intro"}) {
$CPAN::Frontend->myprint($intro);
}
$CPAN::Frontend->myprint(" <$item>\n");
- $CPAN::Config->{$item} = prompt($prompts{$item}, $default);
+ $CPAN::Config->{$item} =
+ $no_strip ? prompt_no_strip($prompts{$item}, $default)
+ : prompt( $prompts{$item}, $default);
} else {
$CPAN::Config->{$item} = $default;
}
+ return $CPAN::Config->{$item};
}
sub my_yn_prompt {
@@ -1392,7 +1618,7 @@ sub my_yn_prompt {
defined($default = $CPAN::Config->{$item}) or $default = $dflt;
# $DB::single = 1;
- if (!$silent && (!$m || $item =~ /$m/)) {
+ if (!$auto_config && (!$m || $item =~ /$m/)) {
if (my $intro = $prompts{$item . "_intro"}) {
$CPAN::Frontend->myprint($intro);
}
@@ -1409,7 +1635,7 @@ sub my_prompt_loop {
my $default = $CPAN::Config->{$item} || $dflt;
my $ans;
- if (!$silent && (!$m || $item =~ /$m/)) {
+ if (!$auto_config && (!$m || $item =~ /$m/)) {
$CPAN::Frontend->myprint($prompts{$item . "_intro"});
$CPAN::Frontend->myprint(" <$item>\n");
do { $ans = prompt($prompts{$item}, $default);
@@ -1524,6 +1750,7 @@ HERE
sub find_exe {
my($exe,$path) = @_;
+ $path ||= [split /$Config{'path_sep'}/, $ENV{'PATH'}];
my($dir);
#warn "in find_exe exe[$exe] path[@$path]";
for $dir (@$path) {
@@ -1611,7 +1838,7 @@ sub display_some {
for my $item (@displayable) {
$CPAN::Frontend->myprint(sprintf "(%d) %s\n", ++$pos, $item);
}
- my $hit_what = $default ? "SPACE RETURN" : "RETURN";
+ my $hit_what = $default ? "SPACE ENTER" : "ENTER";
$CPAN::Frontend->myprint(sprintf("%d more items, hit %s to show them\n",
(@$items - $pos),
$hit_what,
@@ -1623,17 +1850,20 @@ sub display_some {
sub auto_mirrored_by {
my $local = shift or return;
local $|=1;
- $CPAN::Frontend->myprint("Searching for the best CPAN mirrors (please be patient) ...");
+ $CPAN::Frontend->myprint("Looking for CPAN mirrors near you (please be patient)\n");
my $mirrors = CPAN::Mirrors->new($local);
my $cnt = 0;
my @best = $mirrors->best_mirrors(
- how_many => 5,
- callback => sub { $CPAN::Frontend->myprint(".") },
+ how_many => 3,
+ callback => sub {
+ $CPAN::Frontend->myprint(".");
+ if ($cnt++>60) { $cnt=0; $CPAN::Frontend->myprint("\n"); }
+ },
);
- my $urllist = [ map { $_->ftp } @best ];
+ my $urllist = [ map { $_->http } @best ];
push @$urllist, grep { /^file:/ } @{$CPAN::Config->{urllist}};
$CPAN::Frontend->myprint(" done!\n\n");
- return $urllist;
+ return $urllist
}
sub choose_mirrored_by {
@@ -1704,7 +1934,7 @@ put them on one line, separated by blanks, hyphenated ranges allowed
if (@previous_urls) {
$default = join (' ', ((scalar @urls) - (scalar @previous_urls) + 1) ..
(scalar @urls));
- $prompt .= "\n(or just hit RETURN to keep your previous picks)";
+ $prompt .= "\n(or just hit ENTER to keep your previous picks)";
}
@urls = picklist (\@urls, $prompt, $default);
@@ -1718,13 +1948,12 @@ sub bring_your_own {
my($ans,@urls);
my $eacnt = 0; # empty answers
$CPAN::Frontend->myprint(<<'HERE');
-
Now you can enter your own CPAN URLs by hand. A local CPAN mirror can be
listed using a 'file:' URL like 'file:///path/to/cpan/'
HERE
do {
- my $prompt = "Enter another URL or RETURN to quit:";
+ my $prompt = "Enter another URL or ENTER to quit:";
unless (%seen) {
$prompt = qq{CPAN.pm needs at least one URL where it can fetch CPAN files from.
@@ -1767,12 +1996,33 @@ later if you\'re sure it\'s right.\n},
}
sub _print_urllist {
- $CPAN::Frontend->myprint("New urllist\n");
+ my ($which) = @_;
+ $CPAN::Frontend->myprint("$which urllist\n");
for ( @{$CPAN::Config->{urllist} || []} ) {
$CPAN::Frontend->myprint(" $_\n")
};
}
+sub _can_write_to_libdirs {
+ return -w $Config{installprivlib}
+ && -w $Config{installarchlib}
+ && -w $Config{installsitelib}
+ && -w $Config{installsitearch}
+}
+
+sub _using_installbase {
+ return 1 if $ENV{PERL_MM_OPT} && $ENV{PERL_MM_OPT} =~ /install_base/i;
+ return 1 if grep { ($CPAN::Config->{$_}||q{}) =~ /install_base/i }
+ qw(makepl_arg make_install_arg mbuildpl_arg mbuild_install_arg);
+ return;
+}
+
+sub _using_sudo {
+ return 1 if grep { ($CPAN::Config->{$_}||q{}) =~ /sudo/ }
+ qw(make_install_make_command mbuild_install_build_command);
+ return;
+}
+
sub _strip_spaces {
$_[0] =~ s/^\s+//; # no leading spaces
$_[0] =~ s/\s+\z//; # no trailing spaces
@@ -1785,13 +2035,16 @@ sub prompt ($;$) {
my $ans = _real_prompt(@_);
_strip_spaces($ans);
- $CPAN::Frontend->myprint("\n");
+ $CPAN::Frontend->myprint("\n") unless $auto_config;
return $ans;
}
sub prompt_no_strip ($;$) {
+ unless (defined &_real_prompt) {
+ *_real_prompt = \&CPAN::Shell::colorable_makemaker_prompt;
+ }
return _real_prompt(@_);
}
diff --git a/Master/tlpkg/tlperl/lib/CPAN/HTTP/Client.pm b/Master/tlpkg/tlperl/lib/CPAN/HTTP/Client.pm
new file mode 100644
index 00000000000..52de7fe237c
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/CPAN/HTTP/Client.pm
@@ -0,0 +1,254 @@
+# -*- Mode: cperl; coding: utf-8; cperl-indent-level: 4 -*-
+# vim: ts=4 sts=4 sw=4:
+package CPAN::HTTP::Client;
+use strict;
+use vars qw(@ISA);
+use CPAN::HTTP::Credentials;
+use HTTP::Tiny 0.005;
+
+$CPAN::HTTP::Client::VERSION = $CPAN::HTTP::Client::VERSION = "1.9600";
+
+# CPAN::HTTP::Client is adapted from parts of cpanm by Tatsuhiko Miyagawa
+# and parts of LWP by Gisle Aas
+
+sub new {
+ my $class = shift;
+ my %args = @_;
+ for my $k ( keys %args ) {
+ $args{$k} = '' unless defined $args{$k};
+ }
+ $args{no_proxy} = [split(",", $args{no_proxy}) ] if $args{no_proxy};
+ return bless \%args, $class;
+}
+
+# This executes a request with redirection (up to 5) and returns the
+# response structure generated by HTTP::Tiny
+#
+# If authentication fails, it will attempt to get new authentication
+# information and repeat up to 5 times
+
+sub mirror {
+ my($self, $uri, $path) = @_;
+
+ my $want_proxy = $self->_want_proxy($uri);
+ my $http = HTTP::Tiny->new(
+ $want_proxy ? (proxy => $self->{proxy}) : ()
+ );
+
+ my ($response, %headers);
+ my $retries = 0;
+ while ( $retries++ < 5 ) {
+ $response = $http->mirror( $uri, $path, {headers => \%headers} );
+ if ( $response->{status} eq '401' ) {
+ last unless $self->_get_auth_params( $response, 'non_proxy' );
+ }
+ elsif ( $response->{status} eq '407' ) {
+ last unless $self->_get_auth_params( $response, 'proxy' );
+ }
+ else {
+ last; # either success or failure
+ }
+ my %headers = (
+ $self->_auth_headers( $uri, 'non_proxy' ),
+ ( $want_proxy ? $self->_auth_headers($uri, 'proxy') : () ),
+ );
+ }
+
+ return $response;
+}
+
+sub _want_proxy {
+ my ($self, $uri) = @_;
+ return unless $self->{proxy};
+ my($host) = $uri =~ m|://([^/:]+)|;
+ return ! grep { $host =~ /\Q$_\E$/ } @{ $self->{no_proxy} || [] };
+}
+
+# Generates the authentication headers for a given mode
+# C<mode> is 'proxy' or 'non_proxy'
+# C<_${mode}_type> is 'basic' or 'digest'
+# C<_${mode}_params> will be the challenge parameters from the 401/407 headers
+sub _auth_headers {
+ my ($self, $uri, $mode) = @_;
+ # Get names for our mode-specific attributes
+ my ($type_key, $param_key) = map {"_" . $mode . $_} qw/_type _params/;
+
+ # If _prepare_auth has not been called, we can't prepare headers
+ return unless $self->{$type_key};
+
+ # Get user credentials for mode
+ my $cred_method = "get_" . ($mode ? "proxy" : "non_proxy") ."_credentials";
+ my ($user, $pass) = return CPAN::HTTP::Credentials->$cred_method;
+
+ # Generate the header for the mode & type
+ my $header = $mode eq 'proxy' ? 'Proxy-Authorization' : 'Authorization';
+ my $value_method = "_" . $self->{$type_key} . "_auth";
+ my $value = $self->$value_method($user, $pass, $self->{$param_key}, $uri);
+
+ # If we didn't get a value, we didn't have the right modules available
+ return $value ? ( $header, $value ) : ();
+}
+
+# Extract authentication parameters from headers, but clear any prior
+# credentials if we failed (so we might prompt user for password again)
+sub _get_auth_params {
+ my ($self, $response, $mode) = @_;
+ my $prefix = $mode eq 'proxy' ? 'Proxy' : 'WWW';
+ my ($type_key, $param_key) = map {"_" . $mode . $_} qw/_type _params/;
+ if ( ! $response->{success} ) { # auth failed
+ my $method = "clear_${mode}_credentials";
+ CPAN::HTTP::Credentials->$method;
+ delete $self->{$_} for $type_key, $param_key;
+ }
+ ($self->{$type_key}, $self->{$param_key}) =
+ $self->_get_challenge( $response, "${prefix}-Authenticate");
+ return $self->{$type_key};
+}
+
+# Extract challenge type and parameters for a challenge list
+sub _get_challenge {
+ my ($self, $response, $auth_header) = @_;
+
+ my $auth_list = $response->{headers}(lc $auth_header);
+ return unless defined $auth_list;
+ $auth_list = [$auth_list] unless ref $auth_list;
+
+ for my $challenge (@$auth_list) {
+ $challenge =~ tr/,/;/; # "," is used to separate auth-params!!
+ ($challenge) = $self->split_header_words($challenge);
+ my $scheme = shift(@$challenge);
+ shift(@$challenge); # no value
+ $challenge = { @$challenge }; # make rest into a hash
+
+ unless ($scheme =~ /^(basic|digest)$/) {
+ next; # bad scheme
+ }
+ $scheme = $1; # untainted now
+
+ return ($scheme, $challenge);
+ }
+ return;
+}
+
+# Generate a basic authentication header value
+sub _basic_auth {
+ my ($self, $user, $pass) = @_;
+ unless ( $CPAN::META->has_usable('MIME::Base64') ) {
+ $CPAN::Frontend->mywarn(
+ "MIME::Base64 is required for 'Basic' style authentication"
+ );
+ return;
+ }
+ return "Basic " . MIME::Base64::encode_base64("$user\:$pass", q{});
+}
+
+# Generate a digest authentication header value
+sub _digest_auth {
+ my ($self, $user, $pass, $auth_param, $uri) = @_;
+ unless ( $CPAN::META->has_usable('Digest::MD5') ) {
+ $CPAN::Frontend->mywarn(
+ "Digest::MD5 is required for 'Digest' style authentication"
+ );
+ return;
+ }
+
+ my $nc = sprintf "%08X", ++$self->{_nonce_count}{$auth_param->{nonce}};
+ my $cnonce = sprintf "%8x", time;
+
+ my ($path) = $uri =~ m{^\w+?://[^/]+(/.*)$};
+ $path = "/" unless defined $path;
+
+ my $md5 = Digest::MD5->new;
+
+ my(@digest);
+ $md5->add(join(":", $user, $auth_param->{realm}, $pass));
+ push(@digest, $md5->hexdigest);
+ $md5->reset;
+
+ push(@digest, $auth_param->{nonce});
+
+ if ($auth_param->{qop}) {
+ push(@digest, $nc, $cnonce, ($auth_param->{qop} =~ m|^auth[,;]auth-int$|) ? 'auth' : $auth_param->{qop});
+ }
+
+ $md5->add(join(":", 'GET', $path));
+ push(@digest, $md5->hexdigest);
+ $md5->reset;
+
+ $md5->add(join(":", @digest));
+ my($digest) = $md5->hexdigest;
+ $md5->reset;
+
+ my %resp = map { $_ => $auth_param->{$_} } qw(realm nonce opaque);
+ @resp{qw(username uri response algorithm)} = ($user, $path, $digest, "MD5");
+
+ if (($auth_param->{qop} || "") =~ m|^auth([,;]auth-int)?$|) {
+ @resp{qw(qop cnonce nc)} = ("auth", $cnonce, $nc);
+ }
+
+ my(@order) =
+ qw(username realm qop algorithm uri nonce nc cnonce response opaque);
+ my @pairs;
+ for (@order) {
+ next unless defined $resp{$_};
+ push(@pairs, "$_=" . qq("$resp{$_}"));
+ }
+
+ my $auth_value = "Digest " . join(", ", @pairs);
+ return $auth_value;
+}
+
+# split_header_words adapted from HTTP::Headers::Util
+sub split_header_words {
+ my ($self, @words) = @_;
+ my @res = $self->_split_header_words(@words);
+ for my $arr (@res) {
+ for (my $i = @$arr - 2; $i >= 0; $i -= 2) {
+ $arr->[$i] = lc($arr->[$i]);
+ }
+ }
+ return @res;
+}
+
+sub _split_header_words {
+ my($self, @val) = @_;
+ my @res;
+ for (@val) {
+ my @cur;
+ while (length) {
+ if (s/^\s*(=*[^\s=;,]+)//) { # 'token' or parameter 'attribute'
+ push(@cur, $1);
+ # a quoted value
+ if (s/^\s*=\s*\"([^\"\\]*(?:\\.[^\"\\]*)*)\"//) {
+ my $val = $1;
+ $val =~ s/\\(.)/$1/g;
+ push(@cur, $val);
+ # some unquoted value
+ }
+ elsif (s/^\s*=\s*([^;,\s]*)//) {
+ my $val = $1;
+ $val =~ s/\s+$//;
+ push(@cur, $val);
+ # no value, a lone token
+ }
+ else {
+ push(@cur, undef);
+ }
+ }
+ elsif (s/^\s*,//) {
+ push(@res, [@cur]) if @cur;
+ @cur = ();
+ }
+ elsif (s/^\s*;// || s/^\s+//) {
+ # continue
+ }
+ else {
+ die "This should not happen: '$_'";
+ }
+ }
+ push(@res, \@cur) if @cur;
+ }
+ @res;
+}
+
+1;
diff --git a/Master/tlpkg/tlperl/lib/CPAN/HTTP/Credentials.pm b/Master/tlpkg/tlperl/lib/CPAN/HTTP/Credentials.pm
new file mode 100644
index 00000000000..097c67d0ed7
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/CPAN/HTTP/Credentials.pm
@@ -0,0 +1,91 @@
+# -*- Mode: cperl; coding: utf-8; cperl-indent-level: 4 -*-
+# vim: ts=4 sts=4 sw=4:
+package CPAN::HTTP::Credentials;
+use strict;
+use vars qw($USER $PASSWORD $PROXY_USER $PROXY_PASSWORD);
+
+$CPAN::HTTP::Credentials::VERSION = $CPAN::HTTP::Credentials::VERSION = "1.9600";
+
+sub clear_credentials {
+ _clear_non_proxy_credentials();
+ _clear_proxy_credentials();
+}
+
+sub clear_non_proxy_credentials {
+ undef $USER;
+ undef $PASSWORD;
+}
+
+sub clear_proxy_credentials {
+ undef $PROXY_USER;
+ undef $PROXY_PASSWORD;
+}
+
+sub get_proxy_credentials {
+ my $self = shift;
+ if ($PROXY_USER && $PROXY_PASSWORD) {
+ return ($PROXY_USER, $PROXY_PASSWORD);
+ }
+ if ( defined $CPAN::Config->{proxy_user}
+ && $CPAN::Config->{proxy_user}
+ ) {
+ $PROXY_USER = $CPAN::Config->{proxy_user};
+ $PROXY_PASSWORD = $CPAN::Config->{proxy_pass} || "";
+ return ($PROXY_USER, $PROXY_PASSWORD);
+ }
+ my $username_prompt = "\nProxy authentication needed!
+ (Note: to permanently configure username and password run
+ o conf proxy_user your_username
+ o conf proxy_pass your_password
+ )\nUsername:";
+ ($PROXY_USER, $PROXY_PASSWORD) =
+ _get_username_and_password_from_user($username_prompt);
+ return ($PROXY_USER,$PROXY_PASSWORD);
+}
+
+sub get_non_proxy_credentials {
+ my $self = shift;
+ if ($USER && $PASSWORD) {
+ return ($USER, $PASSWORD);
+ }
+ if ( defined $CPAN::Config->{username} ) {
+ $USER = $CPAN::Config->{username};
+ $PASSWORD = $CPAN::Config->{password} || "";
+ return ($USER, $PASSWORD);
+ }
+ my $username_prompt = "\nAuthentication needed!
+ (Note: to permanently configure username and password run
+ o conf username your_username
+ o conf password your_password
+ )\nUsername:";
+
+ ($USER, $PASSWORD) =
+ _get_username_and_password_from_user($username_prompt);
+ return ($USER,$PASSWORD);
+}
+
+sub _get_username_and_password_from_user {
+ my $username_message = shift;
+ my ($username,$password);
+
+ ExtUtils::MakeMaker->import(qw(prompt));
+ $username = prompt($username_message);
+ if ($CPAN::META->has_inst("Term::ReadKey")) {
+ Term::ReadKey::ReadMode("noecho");
+ }
+ else {
+ $CPAN::Frontend->mywarn(
+ "Warning: Term::ReadKey seems not to be available, your password will be echoed to the terminal!\n"
+ );
+ }
+ $password = prompt("Password:");
+
+ if ($CPAN::META->has_inst("Term::ReadKey")) {
+ Term::ReadKey::ReadMode("restore");
+ }
+ $CPAN::Frontend->myprint("\n\n");
+ return ($username,$password);
+}
+
+1;
+
diff --git a/Master/tlpkg/tlperl/lib/CPAN/HandleConfig.pm b/Master/tlpkg/tlperl/lib/CPAN/HandleConfig.pm
index 76cd81eee8b..58ccbe50e5d 100644
--- a/Master/tlpkg/tlperl/lib/CPAN/HandleConfig.pm
+++ b/Master/tlpkg/tlperl/lib/CPAN/HandleConfig.pm
@@ -1,8 +1,12 @@
package CPAN::HandleConfig;
use strict;
use vars qw(%can %keys $loading $VERSION);
+use File::Path ();
+use File::Spec ();
+use File::Basename ();
+use Carp ();
-$VERSION = "5.5001"; # see also CPAN::Config::VERSION at end of file
+$VERSION = "5.5003"; # see also CPAN::Config::VERSION at end of file
%can = (
commit => "Commit changes to disk",
@@ -12,8 +16,8 @@ $VERSION = "5.5001"; # see also CPAN::Config::VERSION at end of file
);
# Q: where is the "How do I add a new config option" HOWTO?
-# A1: svn diff -r 757:758 # where dagolden added test_report
-# A2: svn diff -r 985:986 # where andk added yaml_module
+# A1: svn diff -r 757:758 # where dagolden added test_report [git e997b71de88f1019a1472fc13cb97b1b7f96610f]
+# A2: svn diff -r 985:986 # where andk added yaml_module [git 312b6d9b12b1bdec0b6e282d853482145475021f]
# A3: 1. add new config option to %keys below
# 2. add a Pod description in CPAN::FirstTime; it should include a
# prompt line; see others for examples
@@ -78,6 +82,7 @@ $VERSION = "5.5001"; # see also CPAN::Config::VERSION at end of file
"patch",
"patches_dir",
"perl5lib_verbosity",
+ "prefer_external_tar",
"prefer_installer",
"prefs_dir",
"prerequisites_policy",
@@ -254,6 +259,8 @@ sub prettyprint {
}
}
+# generally, this should be called without arguments so that the currently
+# loaded config file is where changes are committed.
sub commit {
my($self,@args) = @_;
CPAN->debug("args[@args]") if $CPAN::DEBUG;
@@ -264,7 +271,9 @@ sub commit {
" !undef \$CPAN::RUN_DEGRADED\n"
);
}
- my $configpm;
+ my ($configpm, $must_reload);
+
+ # XXX does anything do this? can it be simplified? -- dagolden, 2011-01-19
if (@args) {
if ($args[0] eq "args") {
# we have not signed that contract
@@ -272,31 +281,50 @@ sub commit {
$configpm = $args[0];
}
}
- unless (defined $configpm) {
- $configpm ||= $INC{"CPAN/MyConfig.pm"};
- $configpm ||= $INC{"CPAN/Config.pm"};
- $configpm || Carp::confess(q{
-CPAN::Config::commit called without an argument.
-Please specify a filename where to save the configuration or try
-"o conf init" to have an interactive course through configing.
-});
+
+ # use provided name or the current config or create a new MyConfig
+ $configpm ||= require_myconfig_or_config() || make_new_config();
+
+ # commit to MyConfig if we can't write to Config
+ if ( ! -w $configpm && $configpm =~ m{CPAN/Config\.pm} ) {
+ my $myconfig = _new_config_name();
+ $CPAN::Frontend->mywarn(
+ "Your $configpm file\n".
+ "is not writable. I will attempt to write your configuration to\n" .
+ "$myconfig instead.\n\n"
+ );
+ $configpm = make_new_config();
+ $must_reload++; # so it gets loaded as $INC{'CPAN/MyConfig.pm'}
}
+
+ # XXX why not just "-w $configpm"? -- dagolden, 2011-01-19
my($mode);
if (-f $configpm) {
$mode = (stat $configpm)[2];
if ($mode && ! -w _) {
- Carp::confess("$configpm is not writable");
+ _die_cant_write_config($configpm);
}
}
+ $self->_write_config_file($configpm);
+ require_myconfig_or_config() if $must_reload;
+
+ #$mode = 0444 | ( $mode & 0111 ? 0111 : 0 );
+ #chmod $mode, $configpm;
+###why was that so? $self->defaults;
+ $CPAN::Frontend->myprint("commit: wrote '$configpm'\n");
+ $CPAN::CONFIG_DIRTY = 0;
+ 1;
+}
+
+sub _write_config_file {
+ my ($self, $configpm) = @_;
my $msg;
- my $home = home();
- $msg = <<EOF unless $configpm =~ /MyConfig/;
+ $msg = <<EOF if $configpm =~ m{CPAN/Config\.pm};
# This is CPAN.pm's systemwide configuration file. This file provides
# defaults for users, and the values can be changed in a per-user
-# configuration file. The user-config file is being looked for as
-# $home/.cpan/CPAN/MyConfig.pm.
+# configuration file.
EOF
$msg ||= "\n";
@@ -317,18 +345,13 @@ EOF
",\n"
);
}
-
$fh->print("};\n1;\n__END__\n");
close $fh;
- #$mode = 0444 | ( $mode & 0111 ? 0111 : 0 );
- #chmod $mode, $configpm;
-###why was that so? $self->defaults;
- $CPAN::Frontend->myprint("commit: wrote '$configpm'\n");
- $CPAN::CONFIG_DIRTY = 0;
- 1;
+ return;
}
+
# stolen from MakeMaker; not taking the original because it is buggy;
# bugreport will have to say: keys of hashes remain unquoted and can
# produce syntax errors
@@ -438,154 +461,177 @@ else: quote it with the correct quote type for the box we're on
sub init {
my($self,@args) = @_;
CPAN->debug("self[$self]args[".join(",",@args)."]");
- $self->load(doit => 1, @args);
+ $self->load(do_init => 1, @args);
1;
}
-# This is a piece of repeated code that is abstracted here for
-# maintainability. RMB
+# Loads CPAN::MyConfig or fall-back to CPAN::Config. Will not reload a file
+# if already loaded. Returns the path to the file %INC or else the empty string
#
-sub _configpmtest {
- my($configpmdir, $configpmtest) = @_;
- if (-w $configpmtest) {
- return $configpmtest;
- } elsif (-w $configpmdir) {
- #_#_# following code dumped core on me with 5.003_11, a.k.
- my $configpm_bak = "$configpmtest.bak";
- unlink $configpm_bak if -f $configpm_bak;
- if( -f $configpmtest ) {
- if( rename $configpmtest, $configpm_bak ) {
- $CPAN::Frontend->mywarn(<<END);
-Old configuration file $configpmtest
- moved to $configpm_bak
-END
+# Note -- if CPAN::Config were loaded and CPAN::MyConfig subsequently
+# created, calling this again will leave *both* in %INC
+
+sub require_myconfig_or_config () {
+ if ( $INC{"CPAN/MyConfig.pm"} || _try_loading("CPAN::MyConfig", cpan_home())) {
+ return $INC{"CPAN/MyConfig.pm"};
}
+ elsif ( $INC{"CPAN/Config.pm"} || _try_loading("CPAN::Config") ) {
+ return $INC{"CPAN/Config.pm"};
}
- my $fh = FileHandle->new;
- if ($fh->open(">$configpmtest")) {
- $fh->print("1;\n");
- return $configpmtest;
- } else {
- # Should never happen
- Carp::confess("Cannot open >$configpmtest");
+ else {
+ return q{};
}
- } else { return }
}
-sub require_myconfig_or_config () {
- return if $INC{"CPAN/MyConfig.pm"};
+# Load a module, but ignore "can't locate..." errors
+# Optionally take a list of directories to add to @INC for the load
+sub _try_loading {
+ my ($module, @dirs) = @_;
+ (my $file = $module) =~ s{::}{/}g;
+ $file .= ".pm";
+
local @INC = @INC;
- my $home = home();
- unshift @INC, File::Spec->catdir($home,'.cpan');
- eval { require CPAN::MyConfig };
- my $err_myconfig = $@;
- if ($err_myconfig and $err_myconfig !~ m#locate CPAN/MyConfig\.pm#) {
- die "Error while requiring CPAN::MyConfig:\n$err_myconfig";
+ for my $dir ( @dirs ) {
+ if ( -f File::Spec->catfile($dir, $file) ) {
+ unshift @INC, $dir;
+ last;
}
- unless ($INC{"CPAN/MyConfig.pm"}) { # this guy has settled his needs already
- eval {require CPAN::Config;}; # not everybody has one
- my $err_config = $@;
- if ($err_config and $err_config !~ m#locate CPAN/Config\.pm#) {
- die "Error while requiring CPAN::Config:\n$err_config";
}
+
+ eval { require $file };
+ my $err_myconfig = $@;
+ if ($err_myconfig and $err_myconfig !~ m#locate \Q$file\E#) {
+ die "Error while requiring ${module}:\n$err_myconfig";
}
+ return $INC{$file};
}
-sub home () {
- my $home;
- # Suppress load messages until we load the config and know whether
- # load messages are desired. Otherwise, it's unexpected and odd
- # why one load message pops up even when verbosity is turned off.
- # This means File::HomeDir load messages are never seen, but I
- # think that's probably OK -- DAGOLDEN
-
- # 5.6.2 seemed to segfault localizing a value in a hashref
- # so do it manually instead
+# prioritized list of possible places for finding "CPAN/MyConfig.pm"
+sub cpan_home_dir_candidates {
+ my @dirs;
my $old_v = $CPAN::Config->{load_module_verbosity};
$CPAN::Config->{load_module_verbosity} = q[none];
- if ($CPAN::META->has_usable("File::HomeDir")) {
- if ($^O eq 'darwin') {
- $home = File::HomeDir->my_home; # my_data is ~/Library/Application Support on darwin,
+ if ($CPAN::META->has_usable('File::HomeDir')) {
+ if ($^O ne 'darwin') {
+ push @dirs, File::HomeDir->my_data;
+ # my_data is ~/Library/Application Support on darwin,
# which causes issues in the toolchain.
}
- else {
- $home = File::HomeDir->my_data || File::HomeDir->my_home;
- }
- }
- unless (defined $home) {
- $home = $ENV{HOME};
+ push @dirs, File::HomeDir->my_home;
}
+ # Windows might not have HOME, so check it first
+ push @dirs, $ENV{HOME} if $ENV{HOME};
+ # Windows might have these instead
+ push( @dirs, File::Spec->catpath($ENV{HOMEDRIVE}, $ENV{HOMEPATH}, '') )
+ if $ENV{HOMEDRIVE} && $ENV{HOMEPATH};
+ push @dirs, $ENV{USERPROFILE} if $ENV{USERPROFILE};
+
$CPAN::Config->{load_module_verbosity} = $old_v;
- $home;
+ @dirs = map { "$_/.cpan" } grep { defined } @dirs;
+ return wantarray ? @dirs : $dirs[0];
}
sub load {
my($self, %args) = @_;
- $CPAN::Be_Silent++ if $args{be_silent};
- my $doit;
- $doit = delete $args{doit} || 0;
+ $CPAN::Be_Silent+=0; # protect against 'used only once'
+ $CPAN::Be_Silent++ if $args{be_silent}; # do not use; planned to be removed in 2011
+ my $do_init = delete $args{do_init} || 0;
+ my $make_myconfig = delete $args{make_myconfig};
$loading = 0 unless defined $loading;
- use Carp;
- require_myconfig_or_config;
+ my $configpm = require_myconfig_or_config;
my @miss = $self->missing_config_data;
- CPAN->debug("doit[$doit]loading[$loading]miss[@miss]") if $CPAN::DEBUG;
- return unless $doit || @miss;
+ CPAN->debug("do_init[$do_init]loading[$loading]miss[@miss]") if $CPAN::DEBUG;
+ return unless $do_init || @miss;
+
+ # I'm not how we'd ever wind up in a recursive loop, but I'm leaving
+ # this here for safety's sake -- dagolden, 2011-01-19
return if $loading;
local $loading = ($loading||0) + 1;
- require CPAN::FirstTime;
- my($redo,$configpm,$fh);
- if (defined $INC{"CPAN/Config.pm"} && -w $INC{"CPAN/Config.pm"}) {
- $configpm = $INC{"CPAN/Config.pm"};
- $redo++;
- } elsif (defined $INC{"CPAN/MyConfig.pm"} && -w $INC{"CPAN/MyConfig.pm"}) {
- $configpm = $INC{"CPAN/MyConfig.pm"};
- $redo++;
- } else {
- my($path_to_cpan) = File::Basename::dirname($INC{"CPAN.pm"});
- my($configpmdir) = File::Spec->catdir($path_to_cpan,"CPAN");
- my($configpmtest) = File::Spec->catfile($configpmdir,"Config.pm");
- my $inc_key;
- if (-d $configpmdir or File::Path::mkpath($configpmdir)) {
- $configpm = _configpmtest($configpmdir,$configpmtest);
- $inc_key = "CPAN/Config.pm";
- }
- unless ($configpm) {
- $configpmdir = File::Spec->catdir(home,".cpan","CPAN");
- File::Path::mkpath($configpmdir);
- $configpmtest = File::Spec->catfile($configpmdir,"MyConfig.pm");
- $configpm = _configpmtest($configpmdir,$configpmtest);
- $inc_key = "CPAN/MyConfig.pm";
+ # Warn if we have a config file, but things were found missing
+ if ($configpm && @miss && !$do_init) {
+ if ($make_myconfig || ( ! -w $configpm && $configpm =~ m{CPAN/Config\.pm})) {
+ $configpm = make_new_config();
+ $CPAN::Frontend->myprint(<<END);
+The system CPAN configuration file has provided some default values,
+but you need to complete the configuration dialog for CPAN.pm.
+Configuration will be written to
+ <<$configpm>>
+END
}
- if ($configpm) {
- $INC{$inc_key} = $configpm;
- } else {
- my $myconfigpm = File::Spec->catfile(home,".cpan","CPAN","MyConfig.pm");
- $CPAN::Frontend->mydie(<<"END");
-WARNING: CPAN.pm is unable to write a configuration file. You need write
-access to your default perl library directories or you must be able to
-create and write to '$myconfigpm'.
+ else {
+ $CPAN::Frontend->myprint(<<END);
+Sorry, we have to rerun the configuration dialog for CPAN.pm due to
+some missing parameters. Configuration will be written to
+ <<$configpm>>
-Aborting configuration.
END
}
+ }
+ require CPAN::FirstTime;
+ return CPAN::FirstTime::init($configpm || make_new_config(), %args);
+}
+
+# Creates a new, empty config file at the preferred location
+# Any existing will be renamed with a ".bak" suffix if possible
+# If the file cannot be created, an exception is thrown
+sub make_new_config {
+ my $configpm = _new_config_name();
+ my $configpmdir = File::Basename::dirname( $configpm );
+ File::Path::mkpath($configpmdir) unless -d $configpmdir;
+
+ if ( -w $configpmdir ) {
+ #_#_# following code dumped core on me with 5.003_11, a.k.
+ if( -f $configpm ) {
+ my $configpm_bak = "$configpm.bak";
+ unlink $configpm_bak if -f $configpm_bak;
+ if( rename $configpm, $configpm_bak ) {
+ $CPAN::Frontend->mywarn(<<END);
+Old configuration file $configpm
+ moved to $configpm_bak
+END
}
- local($") = ", ";
- if ($redo && !$doit) {
- $CPAN::Frontend->myprint(<<END);
-Sorry, we have to rerun the configuration dialog for CPAN.pm due to
-some missing parameters... Will write to
- <<$configpm>>
+ }
+ my $fh = FileHandle->new;
+ if ($fh->open(">$configpm")) {
+ $fh->print("1;\n");
+ return $configpm;
+ }
+ }
+ _die_cant_write_config($configpm);
+}
+
+sub _die_cant_write_config {
+ my ($configpm) = @_;
+ $CPAN::Frontend->mydie(<<"END");
+WARNING: CPAN.pm is unable to write a configuration file. You
+must be able to create and write to '$configpm'.
+Aborting configuration.
END
- $args{args} = \@miss;
+
+}
+
+# From candidate directories, we would like (in descending preference order):
+# * the one that contains a MyConfig file
+# * one that exists (even without MyConfig)
+# * the first one on the list
+sub cpan_home {
+ my @dirs = cpan_home_dir_candidates();
+ for my $d (@dirs) {
+ return $d if -f "$d/CPAN/MyConfig.pm";
}
- my $initialized = CPAN::FirstTime::init($configpm, %args);
- return $initialized;
+ for my $d (@dirs) {
+ return $d if -d $d;
+ }
+ return $dirs[0];
}
+sub _new_config_name {
+ return File::Spec->catfile(cpan_home(), 'CPAN', 'MyConfig.pm');
+}
# returns mandatory but missing entries in the Config
sub missing_config_data {
@@ -739,3 +785,4 @@ modify it under the same terms as Perl itself.
# mode: cperl
# cperl-indent-level: 4
# End:
+# vim: ts=4 sts=4 sw=4:
diff --git a/Master/tlpkg/tlperl/lib/CPAN/Index.pm b/Master/tlpkg/tlperl/lib/CPAN/Index.pm
index 9df757de706..4fcde8c390d 100644
--- a/Master/tlpkg/tlperl/lib/CPAN/Index.pm
+++ b/Master/tlpkg/tlperl/lib/CPAN/Index.pm
@@ -1,7 +1,7 @@
package CPAN::Index;
use strict;
use vars qw($LAST_TIME $DATE_OF_02 $DATE_OF_03 $HAVE_REANIMATED $VERSION);
-$VERSION = "1.94";
+$VERSION = "1.9600";
@CPAN::Index::ISA = qw(CPAN::Debug);
$LAST_TIME ||= 0;
$DATE_OF_03 ||= 0;
@@ -292,6 +292,7 @@ sub rd_modpacks {
$shift =~ /^Last-Updated:\s+(.+)/ and $last_updated = $1;
}
CPAN->debug("line_count[$line_count]last_updated[$last_updated]") if $CPAN::DEBUG;
+ my $errors = 0;
if (not defined $line_count) {
$CPAN::Frontend->mywarn(qq{Warning: Your $index_target does not contain a Line-Count header.
@@ -299,7 +300,7 @@ Please check the validity of the index file by comparing it to more
than one CPAN mirror. I'll continue but problems seem likely to
happen.\a
});
-
+ $errors++;
$CPAN::Frontend->mysleep(5);
} elsif ($line_count != scalar @lines) {
@@ -317,7 +318,7 @@ Please check the validity of the index file by comparing it to more
than one CPAN mirror. I'll continue but problems seem likely to
happen.\a
});
-
+ $errors++;
$CPAN::Frontend->mysleep(5);
} else {
@@ -371,14 +372,19 @@ happen.\a
my(%exists);
my $i = 0;
my $painted = 0;
- foreach (@lines) {
+ LINE: foreach (@lines) {
# before 1.56 we split into 3 and discarded the rest. From
# 1.57 we assign remaining text to $comment thus allowing to
# influence isa_perl
my($mod,$version,$dist,$comment) = split " ", $_, 4;
unless ($mod && defined $version && $dist) {
- $CPAN::Frontend->mywarn("Could not split line[$_]\n");
- next;
+ require Dumpvalue;
+ my $dv = Dumpvalue->new(tick => '"');
+ $CPAN::Frontend->mywarn(sprintf "Could not split line[%s]\n", $dv->stringify($_));
+ if ($errors++ >= 5){
+ $CPAN::Frontend->mydie("Giving up parsing your $index_target, too many errors");
+ }
+ next LINE;
}
my($bundle,$id,$userid);
diff --git a/Master/tlpkg/tlperl/lib/CPAN/LWP/UserAgent.pm b/Master/tlpkg/tlperl/lib/CPAN/LWP/UserAgent.pm
index 7bb86f9a15d..e9fbc7bcded 100644
--- a/Master/tlpkg/tlperl/lib/CPAN/LWP/UserAgent.pm
+++ b/Master/tlpkg/tlperl/lib/CPAN/LWP/UserAgent.pm
@@ -3,9 +3,11 @@
package CPAN::LWP::UserAgent;
use strict;
use vars qw(@ISA $USER $PASSWD $SETUPDONE);
+use CPAN::HTTP::Credentials;
# we delay requiring LWP::UserAgent and setting up inheritance until we need it
-$CPAN::LWP::UserAgent::VERSION = $CPAN::LWP::UserAgent::VERSION = "1.94";
+$CPAN::LWP::UserAgent::VERSION = $CPAN::LWP::UserAgent::VERSION = "1.9600";
+
sub config {
return if $SETUPDONE;
@@ -20,75 +22,16 @@ sub config {
sub get_basic_credentials {
my($self, $realm, $uri, $proxy) = @_;
- if ($USER && $PASSWD) {
- return ($USER, $PASSWD);
- }
if ( $proxy ) {
- ($USER,$PASSWD) = $self->get_proxy_credentials();
+ return CPAN::HTTP::Credentials->get_proxy_credentials();
} else {
- ($USER,$PASSWD) = $self->get_non_proxy_credentials();
- }
- return($USER,$PASSWD);
-}
-
-sub get_proxy_credentials {
- my $self = shift;
- my ($user, $password);
- if ( defined $CPAN::Config->{proxy_user} ) {
- $user = $CPAN::Config->{proxy_user};
- $password = $CPAN::Config->{proxy_pass} || "";
- return ($user, $password);
- }
- my $username_prompt = "\nProxy authentication needed!
- (Note: to permanently configure username and password run
- o conf proxy_user your_username
- o conf proxy_pass your_password
- )\nUsername:";
- ($user, $password) =
- _get_username_and_password_from_user($username_prompt);
- return ($user,$password);
-}
-
-sub get_non_proxy_credentials {
- my $self = shift;
- my ($user,$password);
- if ( defined $CPAN::Config->{username} ) {
- $user = $CPAN::Config->{username};
- $password = $CPAN::Config->{password} || "";
- return ($user, $password);
+ return CPAN::HTTP::Credentials->get_non_proxy_credentials();
}
- my $username_prompt = "\nAuthentication needed!
- (Note: to permanently configure username and password run
- o conf username your_username
- o conf password your_password
- )\nUsername:";
-
- ($user, $password) =
- _get_username_and_password_from_user($username_prompt);
- return ($user,$password);
}
-sub _get_username_and_password_from_user {
- my $username_message = shift;
- my ($username,$password);
-
- ExtUtils::MakeMaker->import(qw(prompt));
- $username = prompt($username_message);
- if ($CPAN::META->has_inst("Term::ReadKey")) {
- Term::ReadKey::ReadMode("noecho");
- }
- else {
- $CPAN::Frontend->mywarn(
- "Warning: Term::ReadKey seems not to be available, your password will be echoed to the terminal!\n"
- );
- }
- $password = prompt("Password:");
-
- if ($CPAN::META->has_inst("Term::ReadKey")) {
- Term::ReadKey::ReadMode("restore");
- }
- $CPAN::Frontend->myprint("\n\n");
- return ($username,$password);
+sub no_proxy {
+ my ( $self, $no_proxy ) = @_;
+ return $self->SUPER::no_proxy( split(',',$no_proxy) );
}
# mirror(): Its purpose is to deal with proxy authentication. When we
@@ -125,8 +68,7 @@ sub mirror {
my($self,$url,$aslocal) = @_;
my $result = $self->SUPER::mirror($url,$aslocal);
if ($result->code == 407) {
- undef $USER;
- undef $PASSWD;
+ CPAN::HTTP::Credentials->clear_credentials;
$result = $self->SUPER::mirror($url,$aslocal);
}
$result;
diff --git a/Master/tlpkg/tlperl/lib/CPAN/Meta.pm b/Master/tlpkg/tlperl/lib/CPAN/Meta.pm
new file mode 100644
index 00000000000..ef798559fb4
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/CPAN/Meta.pm
@@ -0,0 +1,696 @@
+use 5.006;
+use strict;
+use warnings;
+package CPAN::Meta;
+BEGIN {
+ $CPAN::Meta::VERSION = '2.110440';
+}
+# ABSTRACT: the distribution metadata for a CPAN dist
+
+
+use Carp qw(carp croak);
+use CPAN::Meta::Feature;
+use CPAN::Meta::Prereqs;
+use CPAN::Meta::Converter;
+use CPAN::Meta::Validator;
+use Parse::CPAN::Meta 1.44 ();
+
+
+BEGIN {
+ my @STRING_READERS = qw(
+ abstract
+ description
+ dynamic_config
+ generated_by
+ name
+ release_status
+ version
+ );
+
+ no strict 'refs';
+ for my $attr (@STRING_READERS) {
+ *$attr = sub { $_[0]{ $attr } };
+ }
+}
+
+
+BEGIN {
+ my @LIST_READERS = qw(
+ author
+ keywords
+ license
+ );
+
+ no strict 'refs';
+ for my $attr (@LIST_READERS) {
+ *$attr = sub {
+ my $value = $_[0]{ $attr };
+ croak "$attr must be called in list context"
+ unless wantarray;
+ return @{ Storable::dclone($value) } if ref $value;
+ return $value;
+ };
+ }
+}
+
+sub authors { $_[0]->author }
+sub licenses { $_[0]->license }
+
+
+BEGIN {
+ my @MAP_READERS = qw(
+ meta-spec
+ resources
+ provides
+ no_index
+
+ prereqs
+ optional_features
+ );
+
+ no strict 'refs';
+ for my $attr (@MAP_READERS) {
+ (my $subname = $attr) =~ s/-/_/;
+ *$subname = sub {
+ my $value = $_[0]{ $attr };
+ return Storable::dclone($value) if $value;
+ return {};
+ };
+ }
+}
+
+
+sub custom_keys {
+ return grep { /^x_/i } keys %{$_[0]};
+}
+
+sub custom {
+ my ($self, $attr) = @_;
+ my $value = $self->{$attr};
+ return Storable::dclone($value) if ref $value;
+ return $value;
+}
+
+
+sub _new {
+ my ($class, $struct, $options) = @_;
+ my $self;
+
+ if ( $options->{lazy_validation} ) {
+ # try to convert to a valid structure; if succeeds, then return it
+ my $cmc = CPAN::Meta::Converter->new( $struct );
+ $self = $cmc->convert( version => 2 ); # valid or dies
+ return bless $self, $class;
+ }
+ else {
+ # validate original struct
+ my $cmv = CPAN::Meta::Validator->new( $struct );
+ unless ( $cmv->is_valid) {
+ die "Invalid metadata structure. Errors: "
+ . join(", ", $cmv->errors) . "\n";
+ }
+ }
+
+ # up-convert older spec versions
+ my $version = $struct->{'meta-spec'}{version} || '1.0';
+ if ( $version == 2 ) {
+ $self = $struct;
+ }
+ else {
+ my $cmc = CPAN::Meta::Converter->new( $struct );
+ $self = $cmc->convert( version => 2 );
+ }
+
+ return bless $self, $class;
+}
+
+sub new {
+ my ($class, $struct, $options) = @_;
+ my $self = eval { $class->_new($struct, $options) };
+ croak($@) if $@;
+ return $self;
+}
+
+
+sub create {
+ my ($class, $struct, $options) = @_;
+ my $version = __PACKAGE__->VERSION || 2;
+ $struct->{generated_by} ||= __PACKAGE__ . " version $version" ;
+ $struct->{'meta-spec'}{version} ||= int($version);
+ my $self = eval { $class->_new($struct, $options) };
+ croak ($@) if $@;
+ return $self;
+}
+
+
+sub load_file {
+ my ($class, $file, $options) = @_;
+ $options->{lazy_validation} = 1 unless exists $options->{lazy_validation};
+
+ croak "load_file() requires a valid, readable filename"
+ unless -r $file;
+
+ my $self;
+ eval {
+ my $struct = Parse::CPAN::Meta->load_file( $file );
+ $self = $class->_new($struct, $options);
+ };
+ croak($@) if $@;
+ return $self;
+}
+
+
+sub load_yaml_string {
+ my ($class, $yaml, $options) = @_;
+ $options->{lazy_validation} = 1 unless exists $options->{lazy_validation};
+
+ my $self;
+ eval {
+ my ($struct) = Parse::CPAN::Meta->load_yaml_string( $yaml );
+ $self = $class->_new($struct, $options);
+ };
+ croak($@) if $@;
+ return $self;
+}
+
+
+sub load_json_string {
+ my ($class, $json, $options) = @_;
+ $options->{lazy_validation} = 1 unless exists $options->{lazy_validation};
+
+ my $self;
+ eval {
+ my $struct = Parse::CPAN::Meta->load_json_string( $json );
+ $self = $class->_new($struct, $options);
+ };
+ croak($@) if $@;
+ return $self;
+}
+
+
+sub save {
+ my ($self, $file, $options) = @_;
+
+ my $version = $options->{version} || '2';
+ my $layer = $] ge '5.008001' ? ':utf8' : '';
+
+ if ( $version ge '2' ) {
+ carp "'$file' should end in '.json'"
+ unless $file =~ m{\.json$};
+ }
+ else {
+ carp "'$file' should end in '.yml'"
+ unless $file =~ m{\.yml$};
+ }
+
+ my $data = $self->as_string( $options );
+ open my $fh, ">$layer", $file
+ or die "Error opening '$file' for writing: $!\n";
+
+ print {$fh} $data;
+ close $fh
+ or die "Error closing '$file': $!\n";
+
+ return 1;
+}
+
+
+# XXX Do we need this if we always upconvert? -- dagolden, 2010-04-14
+sub meta_spec_version {
+ my ($self) = @_;
+ return $self->meta_spec->{version};
+}
+
+
+sub effective_prereqs {
+ my ($self, $features) = @_;
+ $features ||= [];
+
+ my $prereq = CPAN::Meta::Prereqs->new($self->prereqs);
+
+ return $prereq unless @$features;
+
+ my @other = map {; $self->feature($_)->prereqs } @$features;
+
+ return $prereq->with_merged_prereqs(\@other);
+}
+
+
+sub should_index_file {
+ my ($self, $filename) = @_;
+
+ for my $no_index_file (@{ $self->no_index->{file} || [] }) {
+ return if $filename eq $no_index_file;
+ }
+
+ for my $no_index_dir (@{ $self->no_index->{directory} }) {
+ $no_index_dir =~ s{$}{/} unless $no_index_dir =~ m{/\z};
+ return if index($filename, $no_index_dir) == 0;
+ }
+
+ return 1;
+}
+
+
+sub should_index_package {
+ my ($self, $package) = @_;
+
+ for my $no_index_pkg (@{ $self->no_index->{package} || [] }) {
+ return if $package eq $no_index_pkg;
+ }
+
+ for my $no_index_ns (@{ $self->no_index->{namespace} }) {
+ return if index($package, "${no_index_ns}::") == 0;
+ }
+
+ return 1;
+}
+
+
+sub features {
+ my ($self) = @_;
+
+ my $opt_f = $self->optional_features;
+ my @features = map {; CPAN::Meta::Feature->new($_ => $opt_f->{ $_ }) }
+ keys %$opt_f;
+
+ return @features;
+}
+
+
+sub feature {
+ my ($self, $ident) = @_;
+
+ croak "no feature named $ident"
+ unless my $f = $self->optional_features->{ $ident };
+
+ return CPAN::Meta::Feature->new($ident, $f);
+}
+
+
+sub as_struct {
+ my ($self, $options) = @_;
+ my $backend = Parse::CPAN::Meta->json_backend();
+ my $struct = $backend->new->decode(
+ $backend->new->convert_blessed->encode($self)
+ );
+ if ( $options->{version} ) {
+ my $cmc = CPAN::Meta::Converter->new( $struct );
+ $struct = $cmc->convert( version => $options->{version} );
+ }
+ return $struct;
+}
+
+
+sub as_string {
+ my ($self, $options) = @_;
+
+ my $version = $options->{version} || '2';
+
+ my $struct;
+ if ( $self->version ne $version ) {
+ my $cmc = CPAN::Meta::Converter->new( $self->as_struct );
+ $struct = $cmc->convert( version => $version );
+ }
+ else {
+ $struct = $self->as_struct;
+ }
+
+ my ($data, $backend);
+ if ( $version ge '2' ) {
+ $backend = Parse::CPAN::Meta->json_backend();
+ $data = $backend->new->pretty->canonical->encode($struct);
+ }
+ else {
+ $backend = Parse::CPAN::Meta->yaml_backend();
+ $data = eval { no strict 'refs'; &{"$backend\::Dump"}($struct) };
+ if ( $@ ) {
+ croak $backend->can('errstr') ? $backend->errstr : $@
+ }
+ }
+
+ return $data;
+}
+
+# Used by JSON::PP, etc. for "convert_blessed"
+sub TO_JSON {
+ return { %{ $_[0] } };
+}
+
+1;
+
+
+
+=pod
+
+=head1 NAME
+
+CPAN::Meta - the distribution metadata for a CPAN dist
+
+=head1 VERSION
+
+version 2.110440
+
+=head1 SYNOPSIS
+
+ my $meta = CPAN::Meta->load_file('META.json');
+
+ printf "testing requirements for %s version %s\n",
+ $meta->name,
+ $meta->version;
+
+ my $prereqs = $meta->requirements_for('configure');
+
+ for my $module ($prereqs->required_modules) {
+ my $version = get_local_version($module);
+
+ die "missing required module $module" unless defined $version;
+ die "version for $module not in range"
+ unless $prereqs->accepts_module($module, $version);
+ }
+
+=head1 DESCRIPTION
+
+Software distributions released to the CPAN include a F<META.json> or, for
+older distributions, F<META.yml>, which describes the distribution, its
+contents, and the requirements for building and installing the distribution.
+The data structure stored in the F<META.json> file is described in
+L<CPAN::Meta::Spec>.
+
+CPAN::Meta provides a simple class to represent this distribution metadata (or
+I<distmeta>), along with some helpful methods for interrogating that data.
+
+The documentation below is only for the methods of the CPAN::Meta object. For
+information on the meaning of individual fields, consult the spec.
+
+=head1 METHODS
+
+=head2 new
+
+ my $meta = CPAN::Meta->new($distmeta_struct, \%options);
+
+Returns a valid CPAN::Meta object or dies if the supplied metadata hash
+reference fails to validate. Older-format metadata will be up-converted to
+version 2 if they validate against the original stated specification.
+
+It takes an optional hashref of options. Valid options include:
+
+=over
+
+=item *
+
+lazy_validation -- if true, new will attempt to convert the given metadata
+to version 2 before attempting to validate it. This means than any
+fixable errors will be handled by CPAN::Meta::Converter before validation.
+(Note that this might result in invalid optional data being silently
+dropped.) The default is false.
+
+=back
+
+=head2 create
+
+ my $meta = CPAN::Meta->create($distmeta_struct, \%options);
+
+This is same as C<new()>, except that C<generated_by> and C<meta-spec> fields
+will be generated if not provided. This means the metadata structure is
+assumed to otherwise follow the latest L<CPAN::Meta::Spec>.
+
+=head2 load_file
+
+ my $meta = CPAN::Meta->load_file($distmeta_file, \%options);
+
+Given a pathname to a file containing metadata, this deserializes the file
+according to its file suffix and constructs a new C<CPAN::Meta> object, just
+like C<new()>. It will die if the deserialized version fails to validate
+against its stated specification version.
+
+It takes the same options as C<new()> but C<lazy_validation> defaults to
+true.
+
+=head2 load_yaml_string
+
+ my $meta = CPAN::Meta->load_yaml_string($yaml, \%options);
+
+This method returns a new CPAN::Meta object using the first document in the
+given YAML string. In other respects it is identical to C<load_file()>.
+
+=head2 load_json_string
+
+ my $meta = CPAN::Meta->load_json_string($json, \%options);
+
+This method returns a new CPAN::Meta object using the structure represented by
+the given JSON string. In other respects it is identical to C<load_file()>.
+
+=head2 save
+
+ $meta->save($distmeta_file, \%options);
+
+Serializes the object as JSON and writes it to the given file. The only valid
+option is C<version>, which defaults to '2'. On Perl 5.8.1 or later, the file
+is saved with UTF-8 encoding.
+
+For C<version> 2 (or higher), the filename should end in '.json'. L<JSON::PP>
+is the default JSON backend. Using another JSON backend requires L<JSON> 2.5 or
+later and you must set the C<$ENV{PERL_JSON_BACKEND}> to a supported alternate
+backend like L<JSON::XS>.
+
+For C<version> less than 2, the filename should end in '.yml'.
+L<CPAN::Meta::Converter> is used to generate an older metadata structure, which
+is serialized to YAML. CPAN::Meta::YAML is the default YAML backend. You may
+set the C<$ENV{PERL_YAML_BACKEND}> to a supported alternative backend, though
+this is not recommended due to subtle incompatibilities between YAML parsers on
+CPAN.
+
+=head2 meta_spec_version
+
+This method returns the version part of the C<meta_spec> entry in the distmeta
+structure. It is equivalent to:
+
+ $meta->meta_spec->{version};
+
+=head2 effective_prereqs
+
+ my $prereqs = $meta->effective_prereqs;
+
+ my $prereqs = $meta->effective_prereqs( \@feature_identifiers );
+
+This method returns a L<CPAN::Meta::Prereqs> object describing all the
+prereqs for the distribution. If an arrayref of feature identifiers is given,
+the prereqs for the identified features are merged together with the
+distribution's core prereqs before the CPAN::Meta::Prereqs object is returned.
+
+=head2 should_index_file
+
+ ... if $meta->should_index_file( $filename );
+
+This method returns true if the given file should be indexed. It decides this
+by checking the C<file> and C<directory> keys in the C<no_index> property of
+the distmeta structure.
+
+C<$filename> should be given in unix format.
+
+=head2 should_index_package
+
+ ... if $meta->should_index_package( $package );
+
+This method returns true if the given package should be indexed. It decides
+this by checking the C<package> and C<namespace> keys in the C<no_index>
+property of the distmeta structure.
+
+=head2 features
+
+ my @feature_objects = $meta->features;
+
+This method returns a list of L<CPAN::Meta::Feature> objects, one for each
+optional feature described by the distribution's metadata.
+
+=head2 feature
+
+ my $feature_object = $meta->feature( $identifier );
+
+This method returns a L<CPAN::Meta::Feature> object for the optional feature
+with the given identifier. If no feature with that identifier exists, an
+exception will be raised.
+
+=head2 as_struct
+
+ my $copy = $meta->as_struct( \%options );
+
+This method returns a deep copy of the object's metadata as an unblessed has
+reference. It takes an optional hashref of options. If the hashref contains
+a C<version> argument, the copied metadata will be converted to the version
+of the specification and returned. For example:
+
+ my $old_spec = $meta->as_struct( {version => "1.4"} );
+
+=head2 as_string
+
+ my $string = $meta->as_string( \%options );
+
+This method returns a serialized copy of the object's metadata as a character
+string. (The strings are B<not> UTF-8 encoded.) It takes an optional hashref
+of options. If the hashref contains a C<version> argument, the copied metadata
+will be converted to the version of the specification and returned. For
+example:
+
+ my $string = $meta->as_struct( {version => "1.4"} );
+
+For C<version> greater than or equal to 2, the string will be serialized as
+JSON. For C<version> less than 2, the string will be serialized as YAML. In
+both cases, the same rules are followed as in the C<save()> method for choosing
+a serialization backend.
+
+=head1 STRING DATA
+
+The following methods return a single value, which is the value for the
+corresponding entry in the distmeta structure. Values should be either undef
+or strings.
+
+=over 4
+
+=item *
+
+abstract
+
+=item *
+
+description
+
+=item *
+
+dynamic_config
+
+=item *
+
+generated_by
+
+=item *
+
+name
+
+=item *
+
+release_status
+
+=item *
+
+version
+
+=back
+
+=head1 LIST DATA
+
+These methods return lists of string values, which might be represented in the
+distmeta structure as arrayrefs or scalars:
+
+=over 4
+
+=item *
+
+authors
+
+=item *
+
+keywords
+
+=item *
+
+licenses
+
+=back
+
+The C<authors> and C<licenses> methods may also be called as C<author> and
+C<license>, respectively, to match the field name in the distmeta structure.
+
+=head1 MAP DATA
+
+These readers return hashrefs of arbitrary unblessed data structures, each
+described more fully in the specification:
+
+=over 4
+
+=item *
+
+meta_spec
+
+=item *
+
+resources
+
+=item *
+
+provides
+
+=item *
+
+no_index
+
+=item *
+
+prereqs
+
+=item *
+
+optional_features
+
+=back
+
+=head1 CUSTOM DATA
+
+A list of custom keys are available from the C<custom_keys> method and
+particular keys may be retrieved with the C<custom> method.
+
+ say $meta->custom($_) for $meta->custom_keys;
+
+If a custom key refers to a data structure, a deep clone is returned.
+
+=head1 BUGS
+
+Please report any bugs or feature using the CPAN Request Tracker.
+Bugs can be submitted through the web interface at
+L<http://rt.cpan.org/Dist/Display.html?Queue=CPAN-Meta>
+
+When submitting a bug or request, please include a test-file or a patch to an
+existing test-file that illustrates the bug or desired feature.
+
+=head1 SEE ALSO
+
+=over 4
+
+=item *
+
+L<CPAN::Meta::Converter>
+
+=item *
+
+L<CPAN::Meta::Validator>
+
+=back
+
+=head1 AUTHORS
+
+=over 4
+
+=item *
+
+David Golden <dagolden@cpan.org>
+
+=item *
+
+Ricardo Signes <rjbs@cpan.org>
+
+=back
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is copyright (c) 2010 by David Golden and Ricardo Signes.
+
+This is free software; you can redistribute it and/or modify it under
+the same terms as the Perl 5 programming language system itself.
+
+=cut
+
+
+__END__
+
+
diff --git a/Master/tlpkg/tlperl/lib/CPAN/Meta/Converter.pm b/Master/tlpkg/tlperl/lib/CPAN/Meta/Converter.pm
new file mode 100644
index 00000000000..2c6ce857d3d
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/CPAN/Meta/Converter.pm
@@ -0,0 +1,1365 @@
+use 5.006;
+use strict;
+use warnings;
+package CPAN::Meta::Converter;
+BEGIN {
+ $CPAN::Meta::Converter::VERSION = '2.110440';
+}
+# ABSTRACT: Convert CPAN distribution metadata structures
+
+
+use CPAN::Meta::Validator;
+use Storable qw/dclone/;
+use version 0.82 ();
+
+my %known_specs = (
+ '2' => 'http://search.cpan.org/perldoc?CPAN::Meta::Spec',
+ '1.4' => 'http://module-build.sourceforge.net/META-spec-v1.4.html',
+ '1.3' => 'http://module-build.sourceforge.net/META-spec-v1.3.html',
+ '1.2' => 'http://module-build.sourceforge.net/META-spec-v1.2.html',
+ '1.1' => 'http://module-build.sourceforge.net/META-spec-v1.1.html',
+ '1.0' => 'http://module-build.sourceforge.net/META-spec-v1.0.html'
+);
+
+my @spec_list = sort { $a <=> $b } keys %known_specs;
+my ($LOWEST, $HIGHEST) = @spec_list[0,-1];
+
+#--------------------------------------------------------------------------#
+# converters
+#
+# called as $converter->($element, $field_name, $full_meta, $to_version)
+#
+# defined return value used for field
+# undef return value means field is skipped
+#--------------------------------------------------------------------------#
+
+sub _keep { $_[0] }
+
+sub _keep_or_one { defined($_[0]) ? $_[0] : 1 }
+
+sub _keep_or_zero { defined($_[0]) ? $_[0] : 0 }
+
+sub _keep_or_unknown { defined($_[0]) && length($_[0]) ? $_[0] : "unknown" }
+
+sub _generated_by {
+ my $gen = shift;
+ my $sig = __PACKAGE__ . " version " . (__PACKAGE__->VERSION || "<dev>");
+
+ return $sig unless defined $gen and length $gen;
+ return $gen if $gen =~ /(, )\Q$sig/;
+ return "$gen, $sig";
+}
+
+sub _listify { ! defined $_[0] ? undef : ref $_[0] eq 'ARRAY' ? $_[0] : [$_[0]] }
+
+sub _prefix_custom {
+ my $key = shift;
+ $key =~ s/^(?!x_) # Unless it already starts with x_
+ (?:x-?)? # Remove leading x- or x (if present)
+ /x_/ix; # and prepend x_
+ return $key;
+}
+
+sub _ucfirst_custom {
+ my $key = shift;
+ $key = ucfirst $key unless $key =~ /[A-Z]/;
+ return $key;
+}
+
+sub _change_meta_spec {
+ my ($element, undef, undef, $version) = @_;
+ $element->{version} = $version;
+ $element->{url} = $known_specs{$version};
+ return $element;
+}
+
+my @valid_licenses_1 = (
+ 'perl',
+ 'gpl',
+ 'apache',
+ 'artistic',
+ 'artistic_2',
+ 'lgpl',
+ 'bsd',
+ 'gpl',
+ 'mit',
+ 'mozilla',
+ 'open_source',
+ 'unrestricted',
+ 'restrictive',
+ 'unknown',
+);
+
+my %license_map_1 = (
+ ( map { $_ => $_ } @valid_licenses_1 ),
+ artistic2 => 'artistic_2',
+);
+
+sub _license_1 {
+ my ($element) = @_;
+ return 'unknown' unless defined $element;
+ if ( $license_map_1{lc $element} ) {
+ return $license_map_1{lc $element};
+ }
+ return 'unknown';
+}
+
+my @valid_licenses_2 = qw(
+ agpl_3
+ apache_1_1
+ apache_2_0
+ artistic_1
+ artistic_2
+ bsd
+ freebsd
+ gfdl_1_2
+ gfdl_1_3
+ gpl_1
+ gpl_2
+ gpl_3
+ lgpl_2_1
+ lgpl_3_0
+ mit
+ mozilla_1_0
+ mozilla_1_1
+ openssl
+ perl_5
+ qpl_1_0
+ ssleay
+ sun
+ zlib
+ open_source
+ restricted
+ unrestricted
+ unknown
+);
+
+my %license_map_2 = (
+ ( map { $_ => $_ } @valid_licenses_2 ),
+ apache => 'apache_2_0',
+ artistic => 'artistic_1',
+ artistic2 => 'artistic_2',
+ gpl => 'gpl_1',
+ lgpl => 'lgpl_2_1',
+ mozilla => 'mozilla_1_0',
+ perl => 'perl_5',
+ restrictive => 'restricted',
+);
+
+sub _license_2 {
+ my ($element) = @_;
+ return [ 'unknown' ] unless defined $element;
+ $element = [ $element ] unless ref $element eq 'ARRAY';
+ my @new_list;
+ for my $lic ( @$element ) {
+ next unless defined $lic;
+ if ( my $new = $license_map_2{lc $lic} ) {
+ push @new_list, $new;
+ }
+ }
+ return @new_list ? \@new_list : [ 'unknown' ];
+}
+
+my %license_downgrade_map = qw(
+ agpl_3 open_source
+ apache_1_1 apache
+ apache_2_0 apache
+ artistic_1 artistic
+ artistic_2 artistic_2
+ bsd bsd
+ freebsd open_source
+ gfdl_1_2 open_source
+ gfdl_1_3 open_source
+ gpl_1 gpl
+ gpl_2 gpl
+ gpl_3 gpl
+ lgpl_2_1 lgpl
+ lgpl_3_0 lgpl
+ mit mit
+ mozilla_1_0 mozilla
+ mozilla_1_1 mozilla
+ openssl open_source
+ perl_5 perl
+ qpl_1_0 open_source
+ ssleay open_source
+ sun open_source
+ zlib open_source
+ open_source open_source
+ restricted restrictive
+ unrestricted unrestricted
+ unknown unknown
+);
+
+sub _downgrade_license {
+ my ($element) = @_;
+ if ( ! defined $element ) {
+ return "unknown";
+ }
+ elsif( ref $element eq 'ARRAY' ) {
+ if ( @$element == 1 ) {
+ return $license_downgrade_map{$element->[0]} || "unknown";
+ }
+ }
+ elsif ( ! ref $element ) {
+ return $license_downgrade_map{$element} || "unknown";
+ }
+ return "unknown";
+}
+
+my $no_index_spec_1_2 = {
+ 'file' => \&_listify,
+ 'dir' => \&_listify,
+ 'package' => \&_listify,
+ 'namespace' => \&_listify,
+};
+
+my $no_index_spec_1_3 = {
+ 'file' => \&_listify,
+ 'directory' => \&_listify,
+ 'package' => \&_listify,
+ 'namespace' => \&_listify,
+};
+
+my $no_index_spec_2 = {
+ 'file' => \&_listify,
+ 'directory' => \&_listify,
+ 'package' => \&_listify,
+ 'namespace' => \&_listify,
+ ':custom' => \&_prefix_custom,
+};
+
+sub _no_index_1_2 {
+ my (undef, undef, $meta) = @_;
+ my $no_index = $meta->{no_index} || $meta->{private};
+ return unless $no_index;
+
+ # cleanup wrong format
+ if ( ! ref $no_index ) {
+ my $item = $no_index;
+ $no_index = { dir => [ $item ], file => [ $item ] };
+ }
+ elsif ( ref $no_index eq 'ARRAY' ) {
+ my $list = $no_index;
+ $no_index = { dir => [ @$list ], file => [ @$list ] };
+ }
+
+ # common mistake: files -> file
+ if ( exists $no_index->{files} ) {
+ $no_index->{file} = delete $no_index->{file};
+ }
+ # common mistake: modules -> module
+ if ( exists $no_index->{modules} ) {
+ $no_index->{module} = delete $no_index->{module};
+ }
+ return _convert($no_index, $no_index_spec_1_2);
+}
+
+sub _no_index_directory {
+ my ($element, $key, $meta, $version) = @_;
+ return unless $element;
+
+ # cleanup wrong format
+ if ( ! ref $element ) {
+ my $item = $element;
+ $element = { directory => [ $item ], file => [ $item ] };
+ }
+ elsif ( ref $element eq 'ARRAY' ) {
+ my $list = $element;
+ $element = { directory => [ @$list ], file => [ @$list ] };
+ }
+
+ if ( exists $element->{dir} ) {
+ $element->{directory} = delete $element->{dir};
+ }
+ # common mistake: files -> file
+ if ( exists $element->{files} ) {
+ $element->{file} = delete $element->{file};
+ }
+ # common mistake: modules -> module
+ if ( exists $element->{modules} ) {
+ $element->{module} = delete $element->{module};
+ }
+ my $spec = $version == 2 ? $no_index_spec_2 : $no_index_spec_1_3;
+ return _convert($element, $spec);
+}
+
+sub _is_module_name {
+ my $mod = shift;
+ return unless defined $mod && length $mod;
+ return $mod =~ m{^[A-Za-z][A-Za-z0-9_]*(?:::[A-Za-z0-9_]+)*$};
+}
+
+sub _clean_version {
+ my ($element, $key, $meta, $to_version) = @_;
+ return 0 if ! defined $element;
+
+ $element =~ s{^\s*}{};
+ $element =~ s{\s*$}{};
+ $element =~ s{^\.}{0.};
+
+ return 0 if ! length $element;
+ return 0 if ( $element eq 'undef' || $element eq '<undef>' );
+
+ if ( my $v = eval { version->new($element) } ) {
+ return $v->is_qv ? $v->normal : $element;
+ }
+ else {
+ return 0;
+ }
+}
+
+sub _version_map {
+ my ($element) = @_;
+ return undef unless defined $element;
+ if ( ref $element eq 'HASH' ) {
+ my $new_map = {};
+ for my $k ( keys %$element ) {
+ next unless _is_module_name($k);
+ my $value = $element->{$k};
+ if ( ! ( defined $value && length $value ) ) {
+ $new_map->{$k} = 0;
+ }
+ elsif ( $value eq 'undef' || $value eq '<undef>' ) {
+ $new_map->{$k} = 0;
+ }
+ elsif ( _is_module_name( $value ) ) { # some weird, old META have this
+ $new_map->{$k} = 0;
+ $new_map->{$value} = 0;
+ }
+ else {
+ $new_map->{$k} = _clean_version($value);
+ }
+ }
+ return $new_map;
+ }
+ elsif ( ref $element eq 'ARRAY' ) {
+ my $hashref = { map { $_ => 0 } @$element };
+ return _version_map($hashref); # cleanup any weird stuff
+ }
+ elsif ( ref $element eq '' && length $element ) {
+ return { $element => 0 }
+ }
+ return;
+}
+
+sub _prereqs_from_1 {
+ my (undef, undef, $meta) = @_;
+ my $prereqs = {};
+ for my $phase ( qw/build configure/ ) {
+ my $key = "${phase}_requires";
+ $prereqs->{$phase}{requires} = _version_map($meta->{$key})
+ if $meta->{$key};
+ }
+ for my $rel ( qw/requires recommends conflicts/ ) {
+ $prereqs->{runtime}{$rel} = _version_map($meta->{$rel})
+ if $meta->{$rel};
+ }
+ return $prereqs;
+}
+
+my $prereqs_spec = {
+ configure => \&_prereqs_rel,
+ build => \&_prereqs_rel,
+ test => \&_prereqs_rel,
+ runtime => \&_prereqs_rel,
+ develop => \&_prereqs_rel,
+ ':custom' => \&_prefix_custom,
+};
+
+my $relation_spec = {
+ requires => \&_version_map,
+ recommends => \&_version_map,
+ suggests => \&_version_map,
+ conflicts => \&_version_map,
+ ':custom' => \&_prefix_custom,
+};
+
+sub _cleanup_prereqs {
+ my ($prereqs, $key, $meta, $to_version) = @_;
+ return unless $prereqs && ref $prereqs eq 'HASH';
+ return _convert( $prereqs, $prereqs_spec, $to_version );
+}
+
+sub _prereqs_rel {
+ my ($relation, $key, $meta, $to_version) = @_;
+ return unless $relation && ref $relation eq 'HASH';
+ return _convert( $relation, $relation_spec, $to_version );
+}
+
+
+BEGIN {
+ my @old_prereqs = qw(
+ requires
+ configure_requires
+ recommends
+ conflicts
+ );
+
+ for ( @old_prereqs ) {
+ my $sub = "_get_$_";
+ my ($phase,$type) = split qr/_/, $_;
+ if ( ! defined $type ) {
+ $type = $phase;
+ $phase = 'runtime';
+ }
+ no strict 'refs';
+ *{$sub} = sub { _extract_prereqs($_[2]->{prereqs},$phase,$type) };
+ }
+}
+
+sub _get_build_requires {
+ my ($data, $key, $meta) = @_;
+
+ my $test_h = _extract_prereqs($_[2]->{prereqs}, qw(test requires)) || {};
+ my $build_h = _extract_prereqs($_[2]->{prereqs}, qw(build requires)) || {};
+
+ require Version::Requirements;
+ my $test_req = Version::Requirements->from_string_hash($test_h);
+ my $build_req = Version::Requirements->from_string_hash($build_h);
+
+ $test_req->add_requirements($build_req)->as_string_hash;
+}
+
+sub _extract_prereqs {
+ my ($prereqs, $phase, $type) = @_;
+ return unless ref $prereqs eq 'HASH';
+ return $prereqs->{$phase}{$type};
+}
+
+sub _downgrade_optional_features {
+ my (undef, undef, $meta) = @_;
+ return undef unless exists $meta->{optional_features};
+ my $origin = $meta->{optional_features};
+ my $features = {};
+ for my $name ( keys %$origin ) {
+ $features->{$name} = {
+ description => $origin->{$name}{description},
+ requires => _extract_prereqs($origin->{$name}{prereqs},'runtime','requires'),
+ configure_requires => _extract_prereqs($origin->{$name}{prereqs},'runtime','configure_requires'),
+ build_requires => _extract_prereqs($origin->{$name}{prereqs},'runtime','build_requires'),
+ recommends => _extract_prereqs($origin->{$name}{prereqs},'runtime','recommends'),
+ conflicts => _extract_prereqs($origin->{$name}{prereqs},'runtime','conflicts'),
+ };
+ for my $k (keys %{$features->{$name}} ) {
+ delete $features->{$name}{$k} unless defined $features->{$name}{$k};
+ }
+ }
+ return $features;
+}
+
+sub _upgrade_optional_features {
+ my (undef, undef, $meta) = @_;
+ return undef unless exists $meta->{optional_features};
+ my $origin = $meta->{optional_features};
+ my $features = {};
+ for my $name ( keys %$origin ) {
+ $features->{$name} = {
+ description => $origin->{$name}{description},
+ prereqs => _prereqs_from_1(undef, undef, $origin->{$name}),
+ };
+ delete $features->{$name}{prereqs}{configure};
+ }
+ return $features;
+}
+
+my $optional_features_2_spec = {
+ description => \&_keep,
+ prereqs => \&_cleanup_prereqs,
+ ':custom' => \&_prefix_custom,
+};
+
+sub _feature_2 {
+ my ($element, $key, $meta, $to_version) = @_;
+ return unless $element && ref $element eq 'HASH';
+ _convert( $element, $optional_features_2_spec, $to_version );
+}
+
+sub _cleanup_optional_features_2 {
+ my ($element, $key, $meta, $to_version) = @_;
+ return unless $element && ref $element eq 'HASH';
+ my $new_data = {};
+ for my $k ( keys %$element ) {
+ $new_data->{$k} = _feature_2( $element->{$k}, $k, $meta, $to_version );
+ }
+ return unless keys %$new_data;
+ return $new_data;
+}
+
+sub _optional_features_1_4 {
+ my ($element) = @_;
+ return unless $element;
+ $element = _optional_features_as_map($element);
+ for my $name ( keys %$element ) {
+ for my $drop ( qw/requires_packages requires_os excluded_os/ ) {
+ delete $element->{$name}{$drop};
+ }
+ }
+ return $element;
+}
+
+sub _optional_features_as_map {
+ my ($element) = @_;
+ return unless $element;
+ if ( ref $element eq 'ARRAY' ) {
+ my %map;
+ for my $feature ( @$element ) {
+ my (@parts) = %$feature;
+ $map{$parts[0]} = $parts[1];
+ }
+ $element = \%map;
+ }
+ return $element;
+}
+
+sub _is_urlish { defined $_[0] && $_[0] =~ m{\A[-+.a-z0-9]+:.+}i }
+
+sub _url_or_drop {
+ my ($element) = @_;
+ return $element if _is_urlish($element);
+ return;
+}
+
+sub _url_list {
+ my ($element) = @_;
+ return unless $element;
+ $element = _listify( $element );
+ $element = [ grep { _is_urlish($_) } @$element ];
+ return unless @$element;
+ return $element;
+}
+
+sub _author_list {
+ my ($element) = @_;
+ return [ 'unknown' ] unless $element;
+ $element = _listify( $element );
+ $element = [ map { defined $_ && length $_ ? $_ : 'unknown' } @$element ];
+ return [ 'unknown' ] unless @$element;
+ return $element;
+}
+
+my $resource2_upgrade = {
+ license => sub { return _is_urlish($_[0]) ? _listify( $_[0] ) : undef },
+ homepage => \&_url_or_drop,
+ bugtracker => sub {
+ my ($item) = @_;
+ return unless $item;
+ if ( $item =~ m{^mailto:(.*)$} ) { return { mailto => $1 } }
+ elsif( _is_urlish($item) ) { return { web => $item } }
+ else { return undef }
+ },
+ repository => sub { return _is_urlish($_[0]) ? { url => $_[0] } : undef },
+ ':custom' => \&_prefix_custom,
+};
+
+sub _upgrade_resources_2 {
+ my (undef, undef, $meta, $version) = @_;
+ return undef unless exists $meta->{resources};
+ return _convert($meta->{resources}, $resource2_upgrade);
+}
+
+my $bugtracker2_spec = {
+ web => \&_url_or_drop,
+ mailto => \&_keep,
+ ':custom' => \&_prefix_custom,
+};
+
+sub _repo_type {
+ my ($element, $key, $meta, $to_version) = @_;
+ return $element if defined $element;
+ return unless exists $meta->{url};
+ my $repo_url = $meta->{url};
+ for my $type ( qw/git svn/ ) {
+ return $type if $repo_url =~ m{\A$type};
+ }
+ return;
+}
+
+my $repository2_spec = {
+ web => \&_url_or_drop,
+ url => \&_url_or_drop,
+ type => \&_repo_type,
+ ':custom' => \&_prefix_custom,
+};
+
+my $resources2_cleanup = {
+ license => \&_url_list,
+ homepage => \&_url_or_drop,
+ bugtracker => sub { ref $_[0] ? _convert( $_[0], $bugtracker2_spec ) : undef },
+ repository => sub { my $data = shift; ref $data ? _convert( $data, $repository2_spec ) : undef },
+ ':custom' => \&_prefix_custom,
+};
+
+sub _cleanup_resources_2 {
+ my ($resources, $key, $meta, $to_version) = @_;
+ return undef unless $resources && ref $resources eq 'HASH';
+ return _convert($resources, $resources2_cleanup, $to_version);
+}
+
+my $resource1_spec = {
+ license => \&_url_or_drop,
+ homepage => \&_url_or_drop,
+ bugtracker => \&_url_or_drop,
+ repository => \&_url_or_drop,
+ ':custom' => \&_keep,
+};
+
+sub _resources_1_3 {
+ my (undef, undef, $meta, $version) = @_;
+ return undef unless exists $meta->{resources};
+ return _convert($meta->{resources}, $resource1_spec);
+}
+
+*_resources_1_4 = *_resources_1_3;
+
+sub _resources_1_2 {
+ my (undef, undef, $meta) = @_;
+ my $resources = $meta->{resources} || {};
+ if ( $meta->{license_url} && ! $resources->{license} ) {
+ $resources->{license} = $meta->license_url
+ if _is_urlish($meta->{license_url});
+ }
+ return undef unless keys %$resources;
+ return _convert($resources, $resource1_spec);
+}
+
+my $resource_downgrade_spec = {
+ license => sub { return ref $_[0] ? $_[0]->[0] : $_[0] },
+ homepage => \&_url_or_drop,
+ bugtracker => sub { return $_[0]->{web} },
+ repository => sub { return $_[0]->{url} || $_[0]->{web} },
+ ':custom' => \&_ucfirst_custom,
+};
+
+sub _downgrade_resources {
+ my (undef, undef, $meta, $version) = @_;
+ return undef unless exists $meta->{resources};
+ return _convert($meta->{resources}, $resource_downgrade_spec);
+}
+
+sub _release_status {
+ my ($element, undef, $meta) = @_;
+ return $element if $element && $element =~ m{\A(?:stable|testing|unstable)\z};
+ return _release_status_from_version(undef, undef, $meta);
+}
+
+sub _release_status_from_version {
+ my (undef, undef, $meta) = @_;
+ my $version = $meta->{version} || '';
+ return ( $version =~ /_/ ) ? 'testing' : 'stable';
+}
+
+my $provides_spec = {
+ file => \&_keep,
+ version => \&_clean_version,
+};
+
+my $provides_spec_2 = {
+ file => \&_keep,
+ version => \&_clean_version,
+ ':custom' => \&_prefix_custom,
+};
+
+sub _provides {
+ my ($element, $key, $meta, $to_version) = @_;
+ return unless defined $element && ref $element eq 'HASH';
+ my $spec = $to_version == 2 ? $provides_spec_2 : $provides_spec;
+ my $new_data = {};
+ for my $k ( keys %$element ) {
+ $new_data->{$k} = _convert($element->{$k}, $spec, $to_version);
+ }
+ return $new_data;
+}
+
+sub _convert {
+ my ($data, $spec, $to_version) = @_;
+
+ my $new_data = {};
+ for my $key ( keys %$spec ) {
+ next if $key eq ':custom' || $key eq ':drop';
+ next unless my $fcn = $spec->{$key};
+ die "spec for '$key' is not a coderef"
+ unless ref $fcn && ref $fcn eq 'CODE';
+ my $new_value = $fcn->($data->{$key}, $key, $data, $to_version);
+ $new_data->{$key} = $new_value if defined $new_value;
+ }
+
+ my $drop_list = $spec->{':drop'};
+ my $customizer = $spec->{':custom'} || \&_keep;
+
+ for my $key ( keys %$data ) {
+ next if $drop_list && grep { $key eq $_ } @$drop_list;
+ next if exists $spec->{$key}; # we handled it
+ $new_data->{ $customizer->($key) } = $data->{$key};
+ }
+
+ return $new_data;
+}
+
+#--------------------------------------------------------------------------#
+# define converters for each conversion
+#--------------------------------------------------------------------------#
+
+# each converts from prior version
+# special ":custom" field is used for keys not recognized in spec
+my %up_convert = (
+ '2-from-1.4' => {
+ # PRIOR MANDATORY
+ 'abstract' => \&_keep_or_unknown,
+ 'author' => \&_author_list,
+ 'generated_by' => \&_generated_by,
+ 'license' => \&_license_2,
+ 'meta-spec' => \&_change_meta_spec,
+ 'name' => \&_keep,
+ 'version' => \&_keep,
+ # CHANGED TO MANDATORY
+ 'dynamic_config' => \&_keep_or_one,
+ # ADDED MANDATORY
+ 'release_status' => \&_release_status_from_version,
+ # PRIOR OPTIONAL
+ 'keywords' => \&_keep,
+ 'no_index' => \&_no_index_directory,
+ 'optional_features' => \&_upgrade_optional_features,
+ 'provides' => \&_provides,
+ 'resources' => \&_upgrade_resources_2,
+ # ADDED OPTIONAL
+ 'description' => \&_keep,
+ 'prereqs' => \&_prereqs_from_1,
+
+ # drop these deprecated fields, but only after we convert
+ ':drop' => [ qw(
+ build_requires
+ configure_requires
+ conflicts
+ distribution_type
+ license_url
+ private
+ recommends
+ requires
+ ) ],
+
+ # other random keys need x_ prefixing
+ ':custom' => \&_prefix_custom,
+ },
+ '1.4-from-1.3' => {
+ # PRIOR MANDATORY
+ 'abstract' => \&_keep_or_unknown,
+ 'author' => \&_author_list,
+ 'generated_by' => \&_generated_by,
+ 'license' => \&_license_1,
+ 'meta-spec' => \&_change_meta_spec,
+ 'name' => \&_keep,
+ 'version' => \&_keep,
+ # PRIOR OPTIONAL
+ 'build_requires' => \&_version_map,
+ 'conflicts' => \&_version_map,
+ 'distribution_type' => \&_keep,
+ 'dynamic_config' => \&_keep_or_one,
+ 'keywords' => \&_keep,
+ 'no_index' => \&_no_index_directory,
+ 'optional_features' => \&_optional_features_1_4,
+ 'provides' => \&_provides,
+ 'recommends' => \&_version_map,
+ 'requires' => \&_version_map,
+ 'resources' => \&_resources_1_4,
+ # ADDED OPTIONAL
+ 'configure_requires' => \&_keep,
+
+ # drop these deprecated fields, but only after we convert
+ ':drop' => [ qw(
+ license_url
+ private
+ )],
+
+ # other random keys are OK if already valid
+ ':custom' => \&_keep
+ },
+ '1.3-from-1.2' => {
+ # PRIOR MANDATORY
+ 'abstract' => \&_keep_or_unknown,
+ 'author' => \&_author_list,
+ 'generated_by' => \&_generated_by,
+ 'license' => \&_license_1,
+ 'meta-spec' => \&_change_meta_spec,
+ 'name' => \&_keep,
+ 'version' => \&_keep,
+ # PRIOR OPTIONAL
+ 'build_requires' => \&_version_map,
+ 'conflicts' => \&_version_map,
+ 'distribution_type' => \&_keep,
+ 'dynamic_config' => \&_keep_or_one,
+ 'keywords' => \&_keep,
+ 'no_index' => \&_no_index_directory,
+ 'optional_features' => \&_optional_features_as_map,
+ 'provides' => \&_provides,
+ 'recommends' => \&_version_map,
+ 'requires' => \&_version_map,
+ 'resources' => \&_resources_1_3,
+
+ # drop these deprecated fields, but only after we convert
+ ':drop' => [ qw(
+ license_url
+ private
+ )],
+
+ # other random keys are OK if already valid
+ ':custom' => \&_keep
+ },
+ '1.2-from-1.1' => {
+ # PRIOR MANDATORY
+ 'version' => \&_keep,
+ # CHANGED TO MANDATORY
+ 'license' => \&_license_1,
+ 'name' => \&_keep,
+ 'generated_by' => \&_generated_by,
+ # ADDED MANDATORY
+ 'abstract' => \&_keep_or_unknown,
+ 'author' => \&_author_list,
+ 'meta-spec' => \&_change_meta_spec,
+ # PRIOR OPTIONAL
+ 'build_requires' => \&_version_map,
+ 'conflicts' => \&_version_map,
+ 'distribution_type' => \&_keep,
+ 'dynamic_config' => \&_keep_or_one,
+ 'recommends' => \&_version_map,
+ 'requires' => \&_version_map,
+ # ADDED OPTIONAL
+ 'keywords' => \&_keep,
+ 'no_index' => \&_no_index_1_2,
+ 'optional_features' => \&_optional_features_as_map,
+ 'provides' => \&_provides,
+ 'resources' => \&_resources_1_2,
+
+ # drop these deprecated fields, but only after we convert
+ ':drop' => [ qw(
+ license_url
+ private
+ )],
+
+ # other random keys are OK if already valid
+ ':custom' => \&_keep
+ },
+ '1.1-from-1.0' => {
+ # CHANGED TO MANDATORY
+ 'version' => \&_keep,
+ # IMPLIED MANDATORY
+ 'name' => \&_keep,
+ # PRIOR OPTIONAL
+ 'build_requires' => \&_version_map,
+ 'conflicts' => \&_version_map,
+ 'distribution_type' => \&_keep,
+ 'dynamic_config' => \&_keep_or_one,
+ 'generated_by' => \&_generated_by,
+ 'license' => \&_license_1,
+ 'recommends' => \&_version_map,
+ 'requires' => \&_version_map,
+ # ADDED OPTIONAL
+ 'license_url' => \&_url_or_drop,
+ 'private' => \&_keep,
+
+ # other random keys are OK if already valid
+ ':custom' => \&_keep
+ },
+);
+
+my %down_convert = (
+ '1.4-from-2' => {
+ # MANDATORY
+ 'abstract' => \&_keep_or_unknown,
+ 'author' => \&_author_list,
+ 'generated_by' => \&_generated_by,
+ 'license' => \&_downgrade_license,
+ 'meta-spec' => \&_change_meta_spec,
+ 'name' => \&_keep,
+ 'version' => \&_keep,
+ # OPTIONAL
+ 'build_requires' => \&_get_build_requires,
+ 'configure_requires' => \&_get_configure_requires,
+ 'conflicts' => \&_get_conflicts,
+ 'distribution_type' => \&_keep,
+ 'dynamic_config' => \&_keep_or_one,
+ 'keywords' => \&_keep,
+ 'no_index' => \&_no_index_directory,
+ 'optional_features' => \&_downgrade_optional_features,
+ 'provides' => \&_provides,
+ 'recommends' => \&_get_recommends,
+ 'requires' => \&_get_requires,
+ 'resources' => \&_downgrade_resources,
+
+ # drop these unsupported fields (after conversion)
+ ':drop' => [ qw(
+ description
+ prereqs
+ release_status
+ )],
+
+ # custom keys will be left unchanged
+ ':custom' => \&_keep
+ },
+ '1.3-from-1.4' => {
+ # MANDATORY
+ 'abstract' => \&_keep_or_unknown,
+ 'author' => \&_author_list,
+ 'generated_by' => \&_generated_by,
+ 'license' => \&_license_1,
+ 'meta-spec' => \&_change_meta_spec,
+ 'name' => \&_keep,
+ 'version' => \&_keep,
+ # OPTIONAL
+ 'build_requires' => \&_version_map,
+ 'conflicts' => \&_version_map,
+ 'distribution_type' => \&_keep,
+ 'dynamic_config' => \&_keep_or_one,
+ 'keywords' => \&_keep,
+ 'no_index' => \&_no_index_directory,
+ 'optional_features' => \&_optional_features_as_map,
+ 'provides' => \&_provides,
+ 'recommends' => \&_version_map,
+ 'requires' => \&_version_map,
+ 'resources' => \&_resources_1_3,
+
+ # drop these unsupported fields, but only after we convert
+ ':drop' => [ qw(
+ configure_requires
+ )],
+
+ # other random keys are OK if already valid
+ ':custom' => \&_keep,
+ },
+ '1.2-from-1.3' => {
+ # MANDATORY
+ 'abstract' => \&_keep_or_unknown,
+ 'author' => \&_author_list,
+ 'generated_by' => \&_generated_by,
+ 'license' => \&_license_1,
+ 'meta-spec' => \&_change_meta_spec,
+ 'name' => \&_keep,
+ 'version' => \&_keep,
+ # OPTIONAL
+ 'build_requires' => \&_version_map,
+ 'conflicts' => \&_version_map,
+ 'distribution_type' => \&_keep,
+ 'dynamic_config' => \&_keep_or_one,
+ 'keywords' => \&_keep,
+ 'no_index' => \&_no_index_1_2,
+ 'optional_features' => \&_optional_features_as_map,
+ 'provides' => \&_provides,
+ 'recommends' => \&_version_map,
+ 'requires' => \&_version_map,
+ 'resources' => \&_resources_1_3,
+
+ # other random keys are OK if already valid
+ ':custom' => \&_keep,
+ },
+ '1.1-from-1.2' => {
+ # MANDATORY
+ 'version' => \&_keep,
+ # IMPLIED MANDATORY
+ 'name' => \&_keep,
+ 'meta-spec' => \&_change_meta_spec,
+ # OPTIONAL
+ 'build_requires' => \&_version_map,
+ 'conflicts' => \&_version_map,
+ 'distribution_type' => \&_keep,
+ 'dynamic_config' => \&_keep_or_one,
+ 'generated_by' => \&_generated_by,
+ 'license' => \&_license_1,
+ 'private' => \&_keep,
+ 'recommends' => \&_version_map,
+ 'requires' => \&_version_map,
+
+ # drop unsupported fields
+ ':drop' => [ qw(
+ abstract
+ author
+ provides
+ no_index
+ keywords
+ resources
+ )],
+
+ # other random keys are OK if already valid
+ ':custom' => \&_keep,
+ },
+ '1.0-from-1.1' => {
+ # IMPLIED MANDATORY
+ 'name' => \&_keep,
+ 'meta-spec' => \&_change_meta_spec,
+ 'version' => \&_keep,
+ # PRIOR OPTIONAL
+ 'build_requires' => \&_version_map,
+ 'conflicts' => \&_version_map,
+ 'distribution_type' => \&_keep,
+ 'dynamic_config' => \&_keep_or_one,
+ 'generated_by' => \&_generated_by,
+ 'license' => \&_license_1,
+ 'recommends' => \&_version_map,
+ 'requires' => \&_version_map,
+
+ # other random keys are OK if already valid
+ ':custom' => \&_keep,
+ },
+);
+
+my %cleanup = (
+ '2' => {
+ # PRIOR MANDATORY
+ 'abstract' => \&_keep_or_unknown,
+ 'author' => \&_author_list,
+ 'generated_by' => \&_generated_by,
+ 'license' => \&_license_2,
+ 'meta-spec' => \&_change_meta_spec,
+ 'name' => \&_keep,
+ 'version' => \&_keep,
+ # CHANGED TO MANDATORY
+ 'dynamic_config' => \&_keep_or_one,
+ # ADDED MANDATORY
+ 'release_status' => \&_release_status,
+ # PRIOR OPTIONAL
+ 'keywords' => \&_keep,
+ 'no_index' => \&_no_index_directory,
+ 'optional_features' => \&_cleanup_optional_features_2,
+ 'provides' => \&_provides,
+ 'resources' => \&_cleanup_resources_2,
+ # ADDED OPTIONAL
+ 'description' => \&_keep,
+ 'prereqs' => \&_cleanup_prereqs,
+
+ # drop these deprecated fields, but only after we convert
+ ':drop' => [ qw(
+ build_requires
+ configure_requires
+ conflicts
+ distribution_type
+ license_url
+ private
+ recommends
+ requires
+ ) ],
+
+ # other random keys need x_ prefixing
+ ':custom' => \&_prefix_custom,
+ },
+ '1.4' => {
+ # PRIOR MANDATORY
+ 'abstract' => \&_keep_or_unknown,
+ 'author' => \&_author_list,
+ 'generated_by' => \&_generated_by,
+ 'license' => \&_license_1,
+ 'meta-spec' => \&_change_meta_spec,
+ 'name' => \&_keep,
+ 'version' => \&_keep,
+ # PRIOR OPTIONAL
+ 'build_requires' => \&_version_map,
+ 'conflicts' => \&_version_map,
+ 'distribution_type' => \&_keep,
+ 'dynamic_config' => \&_keep_or_one,
+ 'keywords' => \&_keep,
+ 'no_index' => \&_no_index_directory,
+ 'optional_features' => \&_optional_features_1_4,
+ 'provides' => \&_provides,
+ 'recommends' => \&_version_map,
+ 'requires' => \&_version_map,
+ 'resources' => \&_resources_1_4,
+ # ADDED OPTIONAL
+ 'configure_requires' => \&_keep,
+
+ # other random keys are OK if already valid
+ ':custom' => \&_keep
+ },
+ '1.3' => {
+ # PRIOR MANDATORY
+ 'abstract' => \&_keep_or_unknown,
+ 'author' => \&_author_list,
+ 'generated_by' => \&_generated_by,
+ 'license' => \&_license_1,
+ 'meta-spec' => \&_change_meta_spec,
+ 'name' => \&_keep,
+ 'version' => \&_keep,
+ # PRIOR OPTIONAL
+ 'build_requires' => \&_version_map,
+ 'conflicts' => \&_version_map,
+ 'distribution_type' => \&_keep,
+ 'dynamic_config' => \&_keep_or_one,
+ 'keywords' => \&_keep,
+ 'no_index' => \&_no_index_directory,
+ 'optional_features' => \&_optional_features_as_map,
+ 'provides' => \&_provides,
+ 'recommends' => \&_version_map,
+ 'requires' => \&_version_map,
+ 'resources' => \&_resources_1_3,
+
+ # other random keys are OK if already valid
+ ':custom' => \&_keep
+ },
+ '1.2' => {
+ # PRIOR MANDATORY
+ 'version' => \&_keep,
+ # CHANGED TO MANDATORY
+ 'license' => \&_license_1,
+ 'name' => \&_keep,
+ 'generated_by' => \&_generated_by,
+ # ADDED MANDATORY
+ 'abstract' => \&_keep_or_unknown,
+ 'author' => \&_author_list,
+ 'meta-spec' => \&_change_meta_spec,
+ # PRIOR OPTIONAL
+ 'build_requires' => \&_version_map,
+ 'conflicts' => \&_version_map,
+ 'distribution_type' => \&_keep,
+ 'dynamic_config' => \&_keep_or_one,
+ 'recommends' => \&_version_map,
+ 'requires' => \&_version_map,
+ # ADDED OPTIONAL
+ 'keywords' => \&_keep,
+ 'no_index' => \&_no_index_1_2,
+ 'optional_features' => \&_optional_features_as_map,
+ 'provides' => \&_provides,
+ 'resources' => \&_resources_1_2,
+
+ # other random keys are OK if already valid
+ ':custom' => \&_keep
+ },
+ '1.1' => {
+ # CHANGED TO MANDATORY
+ 'version' => \&_keep,
+ # IMPLIED MANDATORY
+ 'name' => \&_keep,
+ 'meta-spec' => \&_change_meta_spec,
+ # PRIOR OPTIONAL
+ 'build_requires' => \&_version_map,
+ 'conflicts' => \&_version_map,
+ 'distribution_type' => \&_keep,
+ 'dynamic_config' => \&_keep_or_one,
+ 'generated_by' => \&_generated_by,
+ 'license' => \&_license_1,
+ 'recommends' => \&_version_map,
+ 'requires' => \&_version_map,
+ # ADDED OPTIONAL
+ 'license_url' => \&_url_or_drop,
+ 'private' => \&_keep,
+
+ # other random keys are OK if already valid
+ ':custom' => \&_keep
+ },
+ '1.0' => {
+ # IMPLIED MANDATORY
+ 'name' => \&_keep,
+ 'meta-spec' => \&_change_meta_spec,
+ 'version' => \&_keep,
+ # IMPLIED OPTIONAL
+ 'build_requires' => \&_version_map,
+ 'conflicts' => \&_version_map,
+ 'distribution_type' => \&_keep,
+ 'dynamic_config' => \&_keep_or_one,
+ 'generated_by' => \&_generated_by,
+ 'license' => \&_license_1,
+ 'recommends' => \&_version_map,
+ 'requires' => \&_version_map,
+
+ # other random keys are OK if already valid
+ ':custom' => \&_keep,
+ },
+);
+
+#--------------------------------------------------------------------------#
+# Code
+#--------------------------------------------------------------------------#
+
+
+sub new {
+ my ($class,$data) = @_;
+
+ # create an attributes hash
+ my $self = {
+ 'data' => $data,
+ 'spec' => $data->{'meta-spec'}{'version'} || "1.0",
+ };
+
+ # create the object
+ return bless $self, $class;
+}
+
+
+sub convert {
+ my ($self, %args) = @_;
+ my $args = { %args };
+
+ my $new_version = $args->{version} || $HIGHEST;
+
+ my ($old_version) = $self->{spec};
+ my $converted = dclone $self->{data};
+
+ if ( $old_version == $new_version ) {
+ $converted = _convert( $converted, $cleanup{$old_version}, $old_version );
+ my $cmv = CPAN::Meta::Validator->new( $converted );
+ unless ( $cmv->is_valid ) {
+ my $errs = join("\n", $cmv->errors);
+ die "Failed to clean-up $old_version metadata. Errors:\n$errs\n";
+ }
+ return $converted;
+ }
+ elsif ( $old_version > $new_version ) {
+ my @vers = sort { $b <=> $a } keys %known_specs;
+ for my $i ( 0 .. $#vers-1 ) {
+ next if $vers[$i] > $old_version;
+ last if $vers[$i+1] < $new_version;
+ my $spec_string = "$vers[$i+1]-from-$vers[$i]";
+ $converted = _convert( $converted, $down_convert{$spec_string}, $vers[$i+1] );
+ my $cmv = CPAN::Meta::Validator->new( $converted );
+ unless ( $cmv->is_valid ) {
+ my $errs = join("\n", $cmv->errors);
+ die "Failed to downconvert metadata to $vers[$i+1]. Errors:\n$errs\n";
+ }
+ }
+ return $converted;
+ }
+ else {
+ my @vers = sort { $a <=> $b } keys %known_specs;
+ for my $i ( 0 .. $#vers-1 ) {
+ next if $vers[$i] < $old_version;
+ last if $vers[$i+1] > $new_version;
+ my $spec_string = "$vers[$i+1]-from-$vers[$i]";
+ $converted = _convert( $converted, $up_convert{$spec_string}, $vers[$i+1] );
+ my $cmv = CPAN::Meta::Validator->new( $converted );
+ unless ( $cmv->is_valid ) {
+ my $errs = join("\n", $cmv->errors);
+ die "Failed to upconvert metadata to $vers[$i+1]. Errors:\n$errs\n";
+ }
+ }
+ return $converted;
+ }
+}
+
+1;
+
+
+
+=pod
+
+=head1 NAME
+
+CPAN::Meta::Converter - Convert CPAN distribution metadata structures
+
+=head1 VERSION
+
+version 2.110440
+
+=head1 SYNOPSIS
+
+ my $struct = decode_json_file('META.json');
+
+ my $cmc = CPAN::Meta::Converter->new( $struct );
+
+ my $new_struct = $cmc->convert( version => "2" );
+
+=head1 DESCRIPTION
+
+This module converts CPAN Meta structures from one form to another. The
+primary use is to convert older structures to the most modern version of
+the specification, but other transformations may be implemented in the
+future as needed. (E.g. stripping all custom fields or stripping all
+optional fields.)
+
+=head1 METHODS
+
+=head2 new
+
+ my $cmc = CPAN::Meta::Converter->new( $struct );
+
+The constructor should be passed a valid metadata structure but invalid
+structures are accepted. If no meta-spec version is provided, version 1.0 will
+be assumed.
+
+=head2 convert
+
+ my $new_struct = $cmc->convert( version => "2" );
+
+Returns a new hash reference with the metadata converted to a different form.
+C<convert> will die if any conversion/standardization still results in an
+invalid structure.
+
+Valid parameters include:
+
+=over
+
+=item *
+
+C<version> -- Indicates the desired specification version (e.g. "1.0", "1.1" ... "1.4", "2").
+Defaults to the latest version of the CPAN Meta Spec.
+
+=back
+
+Conversion proceeds through each version in turn. For example, a version 1.2
+structure might be converted to 1.3 then 1.4 then finally to version 2. The
+conversion process attempts to clean-up simple errors and standardize data.
+For example, if C<author> is given as a scalar, it will converted to an array
+reference containing the item. (Converting a structure to its own version will
+also clean-up and standardize.)
+
+When data are cleaned and standardized, missing or invalid fields will be
+replaced with sensible defaults when possible. This may be lossy or imprecise.
+For example, some badly structured META.yml files on CPAN have prerequisite
+modules listed as both keys and values:
+
+ requires => { 'Foo::Bar' => 'Bam::Baz' }
+
+These would be split and each converted to a prerequisite with a minimum
+version of zero.
+
+When some mandatory fields are missing or invalid, the conversion will attempt
+to provide a sensible default or will fill them with a value of 'unknown'. For
+example a missing or unrecognized C<license> field will result in a C<license>
+field of 'unknown'. Fields that may get an 'unknown' include:
+
+=over 4
+
+=item *
+
+abstract
+
+=item *
+
+author
+
+=item *
+
+license
+
+=back
+
+=head1 BUGS
+
+Please report any bugs or feature using the CPAN Request Tracker.
+Bugs can be submitted through the web interface at
+L<http://rt.cpan.org/Dist/Display.html?Queue=CPAN-Meta>
+
+When submitting a bug or request, please include a test-file or a patch to an
+existing test-file that illustrates the bug or desired feature.
+
+=head1 AUTHORS
+
+=over 4
+
+=item *
+
+David Golden <dagolden@cpan.org>
+
+=item *
+
+Ricardo Signes <rjbs@cpan.org>
+
+=back
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is copyright (c) 2010 by David Golden and Ricardo Signes.
+
+This is free software; you can redistribute it and/or modify it under
+the same terms as the Perl 5 programming language system itself.
+
+=cut
+
+
+__END__
+
+
diff --git a/Master/tlpkg/tlperl/lib/CPAN/Meta/Feature.pm b/Master/tlpkg/tlperl/lib/CPAN/Meta/Feature.pm
new file mode 100644
index 00000000000..d3575e5e7e8
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/CPAN/Meta/Feature.pm
@@ -0,0 +1,116 @@
+use 5.006;
+use strict;
+use warnings;
+package CPAN::Meta::Feature;
+BEGIN {
+ $CPAN::Meta::Feature::VERSION = '2.110440';
+}
+# ABSTRACT: an optional feature provided by a CPAN distribution
+
+use CPAN::Meta::Prereqs;
+
+
+sub new {
+ my ($class, $identifier, $spec) = @_;
+
+ my %guts = (
+ identifier => $identifier,
+ description => $spec->{description},
+ prereqs => CPAN::Meta::Prereqs->new($spec->{prereqs}),
+ );
+
+ bless \%guts => $class;
+}
+
+
+sub identifier { $_[0]{identifier} }
+
+
+sub description { $_[0]{description} }
+
+
+sub prereqs { $_[0]{prereqs} }
+
+1;
+
+
+
+=pod
+
+=head1 NAME
+
+CPAN::Meta::Feature - an optional feature provided by a CPAN distribution
+
+=head1 VERSION
+
+version 2.110440
+
+=head1 DESCRIPTION
+
+A CPAN::Meta::Feature object describes an optional feature offered by a CPAN
+distribution and specified in the distribution's F<META.json> (or F<META.yml>)
+file.
+
+For the most part, this class will only be used when operating on the result of
+the C<feature> or C<features> methods on a L<CPAN::Meta> object.
+
+=head1 METHODS
+
+=head2 new
+
+ my $feature = CPAN::Meta::Feature->new( $identifier => \%spec );
+
+This returns a new Feature object. The C<%spec> argument to the constructor
+should be the same as the value of the C<optional_feature> entry in the
+distmeta. It must contain entries for C<description> and C<prereqs>.
+
+=head2 identifier
+
+This method returns the feature's identifier.
+
+=head2 description
+
+This method returns the feature's long description.
+
+=head2 prereqs
+
+This method returns the feature's prerequisites as a L<CPAN::Meta::Prereqs>
+object.
+
+=head1 BUGS
+
+Please report any bugs or feature using the CPAN Request Tracker.
+Bugs can be submitted through the web interface at
+L<http://rt.cpan.org/Dist/Display.html?Queue=CPAN-Meta>
+
+When submitting a bug or request, please include a test-file or a patch to an
+existing test-file that illustrates the bug or desired feature.
+
+=head1 AUTHORS
+
+=over 4
+
+=item *
+
+David Golden <dagolden@cpan.org>
+
+=item *
+
+Ricardo Signes <rjbs@cpan.org>
+
+=back
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is copyright (c) 2010 by David Golden and Ricardo Signes.
+
+This is free software; you can redistribute it and/or modify it under
+the same terms as the Perl 5 programming language system itself.
+
+=cut
+
+
+__END__
+
+
+
diff --git a/Master/tlpkg/tlperl/lib/CPAN/Meta/History.pm b/Master/tlpkg/tlperl/lib/CPAN/Meta/History.pm
new file mode 100644
index 00000000000..ab036907a49
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/CPAN/Meta/History.pm
@@ -0,0 +1,315 @@
+# vi:tw=72
+use 5.006;
+use strict;
+use warnings;
+package CPAN::Meta::History;
+BEGIN {
+ $CPAN::Meta::History::VERSION = '2.110440';
+}
+# ABSTRACT: history of CPAN Meta Spec changes
+1;
+
+
+
+__END__
+=pod
+
+=head1 NAME
+
+CPAN::Meta::History - history of CPAN Meta Spec changes
+
+=head1 VERSION
+
+version 2.110440
+
+=head1 DESCRIPTION
+
+The CPAN Meta Spec has gone through several iterations. It was
+originally written in HTML and later revised into POD (though published
+in HTML generated from the POD). Fields were added, removed or changed,
+sometimes by design and sometimes to reflect real-world usage after the
+fact.
+
+This document reconstructs the history of the CPAN Meta Spec based on
+change logs, repository commit messages and the published HTML files.
+In some cases, particularly prior to version 1.2, the exact version
+when certain fields were introduced or changed is inconsistent between
+sources. When in doubt, the published HTML files for versions 1.0 to
+1.4 as they existed when version 2 was developed are used as the
+definitive source.
+
+Starting with version 2, the specification document is part of the
+CPAN-Meta distribution and will be published on CPAN as
+L<CPAN::Meta::Spec>.
+
+Going forward, specification version numbers will be integers and
+decimal portions will correspond to a release date for the CPAN::Meta
+library.
+
+=head1 HISTORY
+
+=head2 Version 2
+
+April 2010
+
+=over
+
+=item *
+
+Revised spec examples as perl data structures rather than YAML
+
+=item *
+
+Switched to JSON serialization from YAML
+
+=item *
+
+Specified allowed version number formats
+
+=item *
+
+Replaced 'requires', 'build_requires', 'configure_requires',
+'recommends' and 'conflicts' with new 'prereqs' data structure divided
+by I<phase> (configure, build, test, runtime, etc.) and I<relationship>
+(requires, recommends, suggests, conflicts)
+
+=item *
+
+Added support for 'develop' phase for requirements for maintaining
+a list of authoring tools
+
+=item *
+
+Changed 'license' to a list and revised the set of valid licenses
+
+=item *
+
+Made 'dynamic_config' mandatory to reduce confusion
+
+=item *
+
+Changed 'resources' subkey 'repository' to a hash that clarifies
+repository type, url for browsing and url for checkout
+
+=item *
+
+Changed 'resources' subkey 'bugtracker' to a hash for either web
+or mailto resource
+
+=item *
+
+Changed specification of 'optional_features':
+
+=over
+
+=item *
+
+Added formal specification and usage guide instead of just example
+
+=item *
+
+Changed to use new prereqs data structure instead of individual keys
+
+=back
+
+=item *
+
+Clarified intended use of 'author' as generalized contact list
+
+=item *
+
+Added 'release_status' field to indicate stable, testing or unstable
+status to provide hints to indexers
+
+=item *
+
+Added 'description' field for a longer description of the distribution
+
+=item *
+
+Formalized use of "x_" or "X_" for all custom keys not listed in the
+official spec
+
+=back
+
+=head2 Version 1.4
+
+June 2008
+
+=over
+
+=item *
+
+Noted explicit support for 'perl' in prerequisites
+
+=item *
+
+Added 'configure_requires' prerequisite type
+
+=item *
+
+Changed 'optional_features'
+
+=over
+
+=item *
+
+Example corrected to show map of maps instead of list of maps
+(though descriptive text said 'map' even in v1.3)
+
+=item *
+
+Removed 'requires_packages', 'requires_os' and 'excluded_os'
+as valid subkeys
+
+=back
+
+=back
+
+=head2 Version 1.3
+
+November 2006
+
+=over
+
+=item *
+
+Clarified that all prerequisites take version range specifications
+
+=item *
+
+Added 'no_index' subkey 'directory' and removed 'dir' to match actual
+usage in the wild
+
+=item *
+
+Added a 'repository' subkey to 'resources'
+
+=back
+
+=head2 Version 1.2
+
+August 2005
+
+=over
+
+=item *
+
+Re-wrote and restructured spec in POD syntax
+
+=item *
+
+Changed 'name' to be mandatory
+
+=item *
+
+Changed 'generated_by' to be mandatory
+
+=item *
+
+Changed 'license' to be mandatory
+
+=item *
+
+Added required 'abstract' field
+
+=item *
+
+Added required 'author' field
+
+=item *
+
+Added required 'meta-spec' field to define 'version' (and 'url') of the
+CPAN Meta Spec used for metadata
+
+=item *
+
+Added 'provides' field
+
+=item *
+
+Added 'no_index' field and deprecated 'private' field. 'no_index'
+subkeys include 'file', 'dir', 'package' and 'namespace'
+
+=item *
+
+Added 'keywords' field
+
+=item *
+
+Added 'resources' field with subkeys 'homepage', 'license', and
+'bugtracker'
+
+=item *
+
+Added 'optional_features' field as an alterate under 'recommends'.
+Includes 'description', 'requires', 'build_requires', 'conflicts',
+'requires_packages', 'requires_os' and 'excluded_os' as valid subkeys
+
+=item *
+
+Removed 'license_uri' field
+
+=back
+
+=head2 Version 1.1
+
+May 2003
+
+=over
+
+=item *
+
+Changed 'version' to be mandatory
+
+=item *
+
+Added 'private' field
+
+=item *
+
+Added 'license_uri' field
+
+=back
+
+=head2 Version 1.0
+
+March 2003
+
+=over
+
+=item *
+
+Original release (in HTML format only)
+
+=item *
+
+Included 'name', 'version', 'license', 'distribution_type', 'requires',
+'recommends', 'build_requires', 'conflicts', 'dynamic_config',
+'generated_by'
+
+=back
+
+=head1 AUTHORS
+
+=over 4
+
+=item *
+
+David Golden <dagolden@cpan.org>
+
+=item *
+
+Ricardo Signes <rjbs@cpan.org>
+
+=back
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is copyright (c) 2010 by David Golden and Ricardo Signes.
+
+This is free software; you can redistribute it and/or modify it under
+the same terms as the Perl 5 programming language system itself.
+
+=cut
+
diff --git a/Master/tlpkg/tlperl/lib/CPAN/Meta/Prereqs.pm b/Master/tlpkg/tlperl/lib/CPAN/Meta/Prereqs.pm
new file mode 100644
index 00000000000..4fc20939abd
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/CPAN/Meta/Prereqs.pm
@@ -0,0 +1,277 @@
+use 5.006;
+use strict;
+use warnings;
+package CPAN::Meta::Prereqs;
+BEGIN {
+ $CPAN::Meta::Prereqs::VERSION = '2.110440';
+}
+# ABSTRACT: a set of distribution prerequisites by phase and type
+
+
+use Carp qw(confess);
+use Scalar::Util qw(blessed);
+use Version::Requirements 0.101020; # finalize
+
+
+sub __legal_phases { qw(configure build test runtime develop) }
+sub __legal_types { qw(requires recommends suggests conflicts) }
+
+# expect a prereq spec from META.json -- rjbs, 2010-04-11
+sub new {
+ my ($class, $prereq_spec) = @_;
+ $prereq_spec ||= {};
+
+ my %is_legal_phase = map {; $_ => 1 } $class->__legal_phases;
+ my %is_legal_type = map {; $_ => 1 } $class->__legal_types;
+
+ my %guts;
+ PHASE: for my $phase (keys %$prereq_spec) {
+ next PHASE unless $phase =~ /\Ax_/i or $is_legal_phase{$phase};
+
+ my $phase_spec = $prereq_spec->{ $phase };
+ next PHASE unless keys %$phase_spec;
+
+ TYPE: for my $type (keys %$phase_spec) {
+ next TYPE unless $type =~ /\Ax_/i or $is_legal_type{$type};
+
+ my $spec = $phase_spec->{ $type };
+
+ next TYPE unless keys %$spec;
+
+ $guts{prereqs}{$phase}{$type} = Version::Requirements->from_string_hash(
+ $spec
+ );
+ }
+ }
+
+ return bless \%guts => $class;
+}
+
+
+sub requirements_for {
+ my ($self, $phase, $type) = @_;
+
+ confess "requirements_for called without phase" unless defined $phase;
+ confess "requirements_for called without type" unless defined $type;
+
+ unless ($phase =~ /\Ax_/i or grep { $phase eq $_ } $self->__legal_phases) {
+ confess "requested requirements for unknown phase: $phase";
+ }
+
+ unless ($type =~ /\Ax_/i or grep { $type eq $_ } $self->__legal_types) {
+ confess "requested requirements for unknown type: $type";
+ }
+
+ my $req = ($self->{prereqs}{$phase}{$type} ||= Version::Requirements->new);
+
+ $req->finalize if $self->is_finalized;
+
+ return $req;
+}
+
+
+sub with_merged_prereqs {
+ my ($self, $other) = @_;
+
+ my @other = blessed($other) ? $other : @$other;
+
+ my @prereq_objs = ($self, @other);
+
+ my %new_arg;
+
+ for my $phase ($self->__legal_phases) {
+ for my $type ($self->__legal_types) {
+ my $req = Version::Requirements->new;
+
+ for my $prereq (@prereq_objs) {
+ my $this_req = $prereq->requirements_for($phase, $type);
+ next unless $this_req->required_modules;
+
+ $req->add_requirements($this_req);
+ }
+
+ next unless $req->required_modules;
+
+ $new_arg{ $phase }{ $type } = $req->as_string_hash;
+ }
+ }
+
+ return (ref $self)->new(\%new_arg);
+}
+
+
+sub as_string_hash {
+ my ($self) = @_;
+
+ my %hash;
+
+ for my $phase ($self->__legal_phases) {
+ for my $type ($self->__legal_types) {
+ my $req = $self->requirements_for($phase, $type);
+ next unless $req->required_modules;
+
+ $hash{ $phase }{ $type } = $req->as_string_hash;
+ }
+ }
+
+ return \%hash;
+}
+
+
+sub is_finalized { $_[0]{finalized} }
+
+
+sub finalize {
+ my ($self) = @_;
+
+ $self->{finalized} = 1;
+
+ for my $phase (keys %{ $self->{prereqs} }) {
+ $_->finalize for values %{ $self->{prereqs}{$phase} };
+ }
+}
+
+
+sub clone {
+ my ($self) = @_;
+
+ my $clone = (ref $self)->new( $self->as_string_hash );
+}
+
+1;
+
+
+
+=pod
+
+=head1 NAME
+
+CPAN::Meta::Prereqs - a set of distribution prerequisites by phase and type
+
+=head1 VERSION
+
+version 2.110440
+
+=head1 DESCRIPTION
+
+A CPAN::Meta::Prereqs object represents the prerequisites for a CPAN
+distribution or one of its optional features. Each set of prereqs is
+organized by phase and type, as described in L<CPAN::Meta::Prereqs>.
+
+=head1 METHODS
+
+=head2 new
+
+ my $prereq = CPAN::Meta::Prereqs->new( \%prereq_spec );
+
+This method returns a new set of Prereqs. The input should look like the
+contents of the C<prereqs> field described in L<CPAN::Meta::Spec>, meaning
+something more or less like this:
+
+ my $prereq = CPAN::Meta::Prereqs->new({
+ runtime => {
+ requires => {
+ 'Some::Module' => '1.234',
+ ...,
+ },
+ ...,
+ },
+ ...,
+ });
+
+You can also construct an empty set of prereqs with:
+
+ my $prereqs = CPAN::Meta::Prereqs->new;
+
+This empty set of prereqs is useful for accumulating new prereqs before finally
+dumping the whole set into a structure or string.
+
+=head2 requirements_for
+
+ my $requirements = $prereqs->requirements_for( $phase, $type );
+
+This method returns a L<Version::Requirements> object for the given phase/type
+combination. If no prerequisites are registered for that combination, a new
+Version::Requirements object will be returned, and it may be added to as
+needed.
+
+If C<$phase> or C<$type> are undefined or otherwise invalid, an exception will
+be raised.
+
+=head2 with_merged_prereqs
+
+ my $new_prereqs = $prereqs->with_merged_prereqs( $other_prereqs );
+
+ my $new_prereqs = $prereqs->with_merged_prereqs( \@other_prereqs );
+
+This method returns a new CPAN::Meta::Prereqs objects in which all the
+other prerequisites given are merged into the current set. This is primarily
+provided for combining a distribution's core prereqs with the prereqs of one of
+its optional features.
+
+The new prereqs object has no ties to the originals, and altering it further
+will not alter them.
+
+=head2 as_string_hash
+
+This method returns a hashref containing structures suitable for dumping into a
+distmeta data structure. It is made up of hashes and strings, only; there will
+be no Prereqs, Version::Requirements, or C<version> objects inside it.
+
+=head2 is_finalized
+
+This method returns true if the set of prereqs has been marked "finalized," and
+cannot be altered.
+
+=head2 finalize
+
+Calling C<finalize> on a Prereqs object will close it for further modification.
+Attempting to make any changes that would actually alter the prereqs will
+result in an exception being thrown.
+
+=head2 clone
+
+ my $cloned_prereqs = $prereqs->clone;
+
+This method returns a Prereqs object that is identical to the original object,
+but can be altered without affecting the original object. Finalization does
+not survive cloning, meaning that you may clone a finalized set of prereqs and
+then modify the clone.
+
+=head1 BUGS
+
+Please report any bugs or feature using the CPAN Request Tracker.
+Bugs can be submitted through the web interface at
+L<http://rt.cpan.org/Dist/Display.html?Queue=CPAN-Meta>
+
+When submitting a bug or request, please include a test-file or a patch to an
+existing test-file that illustrates the bug or desired feature.
+
+=head1 AUTHORS
+
+=over 4
+
+=item *
+
+David Golden <dagolden@cpan.org>
+
+=item *
+
+Ricardo Signes <rjbs@cpan.org>
+
+=back
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is copyright (c) 2010 by David Golden and Ricardo Signes.
+
+This is free software; you can redistribute it and/or modify it under
+the same terms as the Perl 5 programming language system itself.
+
+=cut
+
+
+__END__
+
+
+
diff --git a/Master/tlpkg/tlperl/lib/CPAN/Meta/Spec.pm b/Master/tlpkg/tlperl/lib/CPAN/Meta/Spec.pm
new file mode 100644
index 00000000000..8f94c718cb4
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/CPAN/Meta/Spec.pm
@@ -0,0 +1,1145 @@
+# vi:tw=72
+use 5.006;
+use strict;
+use warnings;
+package CPAN::Meta::Spec;
+BEGIN {
+ $CPAN::Meta::Spec::VERSION = '2.110440';
+}
+# ABSTRACT: specification for CPAN distribution metadata
+1;
+
+
+
+__END__
+=pod
+
+=head1 NAME
+
+CPAN::Meta::Spec - specification for CPAN distribution metadata
+
+=head1 VERSION
+
+version 2.110440
+
+=head1 SYNOPSIS
+
+ my $distmeta = {
+ name => 'Module-Build',
+ abstract => 'Build and install Perl modules',
+ description => "Module::Build is a system for "
+ . "building, testing, and installing Perl modules. "
+ . "It is meant to ... blah blah blah ...",
+ version => '0.36',
+ author => [
+ 'Ken Williams <kwilliams@cpan.org>',
+ 'Module-Build List <module-build@perl.org>', # additional contact
+ ],
+ license => [ 'perl_5' ],
+ prereqs => {
+ runtime => {
+ requires => {
+ 'perl' => '5.006',
+ 'ExtUtils::Install' => '0',
+ 'File::Basename' => '0',
+ 'File::Compare' => '0',
+ 'IO::File' => '0',
+ },
+ recommends => {
+ 'Archive::Tar' => '1.00',
+ 'ExtUtils::Install' => '0.3',
+ 'ExtUtils::ParseXS' => '2.02',
+ },
+ },
+ build => {
+ requires => {
+ 'Test::More' => '0',
+ },
+ }
+ },
+ resources => {
+ license => ['http://dev.perl.org/licenses/'],
+ },
+ optional_features => {
+ domination => {
+ description => 'Take over the world',
+ prereqs => {
+ develop => { requires => { 'Genius::Evil' => '1.234' } },
+ runtime => { requires => { 'Machine::Weather' => '2.0' } },
+ },
+ },
+ },
+ dynamic_config => 1,
+ keywords => [ qw/ toolchain cpan dual-life / ],
+ 'meta-spec' => {
+ version => '2',
+ url => 'http://search.cpan.org/perldoc?CPAN::Meta::Spec',
+ },
+ generated_by => 'Module::Build version 0.36',
+ };
+
+=head1 DESCRIPTION
+
+This document describes version 2 of the CPAN distribution metadata
+specification, also known as the "CPAN Meta Spec".
+
+Revisions of this specification for typo corrections and prose
+clarifications may be issued as CPAN::Meta::Spec 2.I<x>. These
+revisions will never change semantics or add or remove specified
+behavior.
+
+Distribution metadata describe important properties of Perl
+distributions. Distribution building tools like Module::Build,
+Module::Install, ExtUtils::MakeMaker or Dist::Zilla should create a
+metadata file in accordance with this specification and include it with
+the distribution for use by automated tools that index, examine, package
+or install Perl distributions.
+
+=head1 TERMINOLOGY
+
+=over 4
+
+=item distribution
+
+This is the primary object described by the metadata. In the context of
+this document it usually refers to a collection of modules, scripts,
+and/or documents that are distributed together for other developers to
+use. Examples of distributions are C<Class-Container>, C<libwww-perl>,
+or C<DBI>.
+
+=item module
+
+This refers to a reusable library of code contained in a single file.
+Modules usually contain one or more packages and are often referred
+to by the name of a primary package that can be mapped to the file
+name. For example, one might refer to C<File::Spec> instead of
+F<File/Spec.pm>
+
+=item package
+
+This refers to a namespace declared with the Perl C<package> statement.
+In Perl, packages often have a version number property given by the
+C<$VERSION> variable in the namespace.
+
+=item consumer
+
+This refers to code that reads a metadata file, deserializes it into a
+data structure in memory, or interprets a data structure of metadata
+elements.
+
+=item producer
+
+This refers to code that constructs a metadata data structure,
+serializes into a bytestream and/or writes it to disk.
+
+=item must, should, may, etc.
+
+These terms are interpreted as described in IETF RFC 2119.
+
+=back
+
+=head1 DATA TYPES
+
+Fields in the L</STRUCTURE> section describe data elements, each of
+which has an associated data type as described herein. There are four
+primitive types: Boolean, String, List and Map. Other types are
+subtypes of primitives and define compound data structures or define
+constraints on the values of a data element.
+
+=head2 Boolean
+
+A I<Boolean> is used to provide a true or false value. It B<must> be
+represented as a defined value.
+
+=head2 String
+
+A I<String> is data element containing a non-zero length sequence of
+Unicode characters, such as an ordinary Perl scalar that is not a
+reference.
+
+=head2 List
+
+A I<List> is an ordered collection of zero or more data elements.
+Elements of a List may be of mixed types.
+
+Producers B<must> represent List elements using a data structure which
+unambiguously indicates that multiple values are possible, such as a
+reference to a Perl array (an "arrayref").
+
+Consumers expecting a List B<must> consider a String as equivalent to a
+List of length 1.
+
+=head2 Map
+
+A I<Map> is an unordered collection of zero or more data elements
+("values"), indexed by associated String elements ("keys"). The Map's
+value elements may be of mixed types.
+
+=head2 License String
+
+A I<License String> is a subtype of String with a restricted set of
+values. Valid values are described in detail in the description of
+the L</license> field.
+
+=head2 URL
+
+I<URL> is a subtype of String containing a Uniform Resource Locator or
+Identifier. [ This type is called URL and not URI for historical reasons. ]
+
+=head2 Version
+
+A I<Version> is a subtype of String containing a value that describes
+the version number of packages or distributions. Restrictions on format
+are described in detail in the L</Version Formats> section.
+
+=head2 Version Range
+
+The I<Version Range> type is a subtype of String. It describes a range
+of Versions that may be present or installed to fulfill prerequisites.
+It is specified in detail in the L</Version Ranges> section.
+
+=head1 STRUCTURE
+
+The metadata structure is a data element of type Map. This section
+describes valid keys within the Map.
+
+Any keys not described in this specification document (whether top-level
+or within compound data structures described herein) are considered
+I<custom keys> and B<must> begin with an "x" or "X" and be followed by an
+underscore; i.e. they must match the pattern: C<< qr{\Ax_}i >>. If a
+custom key refers to a compound data structure, subkeys within it do not
+need an "x_" or "X_" prefix.
+
+Consumers of metadata may ignore any or all custom keys. All other keys
+not described herein are invalid and should be ignored by consumers.
+Producers must not generate or output invalid keys.
+
+For each key, an example is provided followed by a description. The
+description begins with the version of spec in which the key was added
+or in which the definition was modified, whether the key is I<required>
+or I<optional> and the data type of the corresponding data element.
+These items are in parentheses, brackets and braces, respectively.
+
+If a data type is a Map or Map subtype, valid subkeys will be described
+as well.
+
+Some fields are marked I<Deprecated>. These are shown for historical
+context and must not be produced in or consumed from any metadata structure
+of version 2 or higher.
+
+=head2 REQUIRED FIELDS
+
+=head3 abstract
+
+Example:
+
+ abstract => 'Build and install Perl modules'
+
+(Spec 1.2) [required] {String}
+
+This is a short description of the purpose of the distribution.
+
+=head3 author
+
+Example:
+
+ author => [ 'Ken Williams <kwilliams@cpan.org>' ]
+
+(Spec 1.2) [required] {List of one or more Strings}
+
+This List indicates the person(s) to contact concerning the
+distribution. The preferred form of the contact string is:
+
+ contact-name <email-address>
+
+This field provides a general contact list independent of other
+structured fields provided within the L</resources> field, such as
+C<bugtracker>. The addressee(s) can be contacted for any purpose
+including but not limited to (security) problems with the distribution,
+questions about the distribution or bugs in the distribution.
+
+A distribution's original author is usually the contact listed within
+this field. Co-maintainers, successor maintainers or mailing lists
+devoted to the distribution may also be listed in addition to or instead
+of the original author.
+
+=head3 dynamic_config
+
+Example:
+
+ dynamic_config => 1
+
+(Spec 2) [required] {Boolean}
+
+A boolean flag indicating whether a F<Build.PL> or F<Makefile.PL> (or
+similar) must be executed to determine prerequisites.
+
+This field should be set to a true value if the distribution performs
+some dynamic configuration (asking questions, sensing the environment,
+etc.) as part of its configuration. This field should be set to a false
+value to indicate that prerequisites included in metadata may be
+considered final and valid for static analysis.
+
+This field explicitly B<does not> indicate whether installation may be
+safely performed without using a Makefile or Build file, as there may be
+special files to install or custom installation targets (e.g. for
+dual-life modules that exist on CPAN as well as in the Perl core). This
+field only defines whether prerequisites are complete as given in the
+metadata.
+
+=head3 generated_by
+
+Example:
+
+ generated_by => 'Module::Build version 0.36'
+
+(Spec 1.0) [required] {String}
+
+This field indicates the tool that was used to create this metadata.
+There are no defined semantics for this field, but it is traditional to
+use a string in the form "Generating::Package version 1.23" or the
+author's name, if the file was generated by hand.
+
+=head3 license
+
+Example:
+
+ license => [ 'perl_5' ]
+
+ license => [ 'apache_2', 'mozilla_1_0' ]
+
+(Spec 2) [required] {List of one or more License Strings}
+
+One or more licenses that apply to some or all of the files in the
+distribution. If multiple licenses are listed, the distribution
+documentation should be consulted to clarify the interpretation of
+multiple licenses.
+
+The following list of license strings are valid:
+
+ string description
+ ------------- -----------------------------------------------
+ agpl_3 GNU Affero General Public License, Version 3
+ apache_1_1 Apache Software License, Version 1.1
+ apache_2_0 Apache License, Version 2.0
+ artistic_1 Artistic License, (Version 1)
+ artistic_2 Artistic License, Version 2.0
+ bsd BSD License (three-clause)
+ freebsd FreeBSD License (two-clause)
+ gfdl_1_2 GNU Free Documentation License, Version 1.2
+ gfdl_1_3 GNU Free Documentation License, Version 1.3
+ gpl_1 GNU General Public License, Version 1
+ gpl_2 GNU General Public License, Version 2
+ gpl_3 GNU General Public License, Version 3
+ lgpl_2_1 GNU Lesser General Public License, Version 2.1
+ lgpl_3_0 GNU Lesser General Public License, Version 3.0
+ mit MIT (aka X11) License
+ mozilla_1_0 Mozilla Public License, Version 1.0
+ mozilla_1_1 Mozilla Public License, Version 1.1
+ openssl OpenSSL License
+ perl_5 The Perl 5 License (Artistic 1 & GPL 1 or later)
+ qpl_1_0 Q Public License, Version 1.0
+ ssleay Original SSLeay License
+ sun Sun Internet Standards Source License (SISSL)
+ zlib zlib License
+
+The following license strings are also valid and indicate other
+licensing not described above:
+
+ string description
+ ------------- -----------------------------------------------
+ open_source Other Open Source Initiative (OSI) approved license
+ restricted Requires special permission from copyright holder
+ unrestricted Not an OSI approved license, but not restricted
+ unknown License not provided in metadata
+
+All other strings are invalid in the license field.
+
+=head3 meta-spec
+
+Example:
+
+ 'meta-spec' => {
+ version => '2',
+ url => 'http://search.cpan.org/perldoc?CPAN::Meta::Spec',
+ }
+
+(Spec 1.2) [required] {Map}
+
+This field indicates the version of the CPAN Meta Spec that should be
+used to interpret the metadata. Consumers must check this key as soon
+as possible and abort further metadata processing if the meta-spec
+version is not supported by the consumer.
+
+The following keys are valid, but only C<version> is required.
+
+=over
+
+=item version
+
+This subkey gives the integer I<Version> of the CPAN Meta Spec against
+which the document was generated.
+
+=item url
+
+This is a I<URL> of the metadata specification document corresponding to
+the given version. This is strictly for human-consumption and should
+not impact the interpretation of the document.
+
+=back
+
+=head3 name
+
+Example:
+
+ name => 'Module-Build'
+
+(Spec 1.0) [required] {String}
+
+This field is the name of the distribution. This is often created by
+taking the "main package" in the distribution and changing C<::> to
+C<->, but the name may be completely unrelated to the packages within
+the distribution. C.f. L<http://search.cpan.org/dist/libwww-perl/>.
+
+=head3 release_status
+
+Example:
+
+ release_status => 'stable'
+
+(Spec 2) [required] {String}
+
+This field provides the release status of this distribution. If the
+C<version> field contains an underscore character, then
+C<release_status> B<must not> be "stable."
+
+The C<release_status> field B<must> have one of the following values:
+
+=over
+
+=item stable
+
+This indicates an ordinary, "final" release that should be indexed by PAUSE
+or other indexers.
+
+=item testing
+
+This indicates a "beta" release that is substantially complete, but has an
+elevated risk of bugs and requires additional testing. The distribution
+should not be installed over a stable release without an explicit request
+or other confirmation from a user. This release status may also be used
+for "release candidate" versions of a distribution.
+
+=item unstable
+
+This indicates an "alpha" release that is under active development, but has
+been released for early feedback or testing and may be missing features or
+may have serious bugs. The distribution should not be installed over a
+stable release without an explicit request or other confirmation from a
+user.
+
+=back
+
+Consumers B<may> use this field to determine how to index the
+distribution for CPAN or other repositories in addition to or in
+replacement of heuristics based on version number or file name.
+
+=head3 version
+
+Example:
+
+ version => '0.36'
+
+(Spec 1.0) [required] {Version}
+
+This field gives the version of the distribution to which the metadata
+structure refers.
+
+=head2 OPTIONAL FIELDS
+
+=head3 description
+
+Example:
+
+ description => "Module::Build is a system for "
+ . "building, testing, and installing Perl modules. "
+ . "It is meant to ... blah blah blah ...",
+
+(Spec 2) [optional] {String}
+
+A longer, more complete description of the purpose or intended use of
+the distribution than the one provided by the C<abstract> key.
+
+=head3 keywords
+
+Example:
+
+ keywords => [ qw/ toolchain cpan dual-life / ]
+
+(Spec 1.1) [optional] {List of zero or more Strings}
+
+A List of keywords that describe this distribution. Keywords
+B<must not> include whitespace.
+
+=head3 no_index
+
+Example:
+
+ no_index => {
+ file => [ 'My/Module.pm' ],
+ directory => [ 'My/Private' ],
+ package => [ 'My::Module::Secret' ],
+ namespace => [ 'My::Module::Sample' ],
+ }
+
+(Spec 1.2) [optional] {Map}
+
+This Map describes any files, directories, packages, and namespaces that
+are private to the packaging or implementation of the distribution and
+should be ignored by indexing or search tools.
+
+Valid subkeys are as follows:
+
+=over
+
+=item file
+
+A I<List> of relative paths to files. Paths B<must be> specified with
+unix convetions.
+
+=item directory
+
+A I<List> of relative paths to directories. Paths B<must be> specified
+with unix convetions.
+
+[ Note: previous editions of the spec had C<dir> instead of C<directory> ]
+
+=item package
+
+A I<List> of package names.
+
+=item namespace
+
+A I<List> of package namespaces, where anything below the namespace
+must be ignored, but I<not> the namespace itself.
+
+In the example above for C<no_index>, C<My::Module::Sample::Foo> would
+be ignored, but C<My::Module::Sample> would not.
+
+=back
+
+=head3 optional_features
+
+Example:
+
+ optional_features => {
+ sqlite => {
+ description => 'Provides SQLite support',
+ prereqs => {
+ runtime => {
+ requires => {
+ 'DBD::SQLite' => '1.25'
+ }
+ }
+ }
+ }
+ }
+
+(Spec 2) [optional] {Map}
+
+This Map describes optional features with incremental prerequisites.
+Each key of the C<optional_features> Map is a String used to identify
+the feature and each value is a Map with additional information about
+the feature. Valid subkeys include:
+
+=over
+
+=item description
+
+This is a String describing the feature. Every optional feature
+should provide a description
+
+=item prereqs
+
+This entry is required and has the same structure as that of the
+C<L</prereqs>> key. It provides a list of package requirements
+that must be satisfied for the feature to be supported or enabled.
+
+There is one crucial restriction: the preqreqs of an optional feature
+B<must not> include C<configure> phase prereqs.
+
+=back
+
+Consumers B<must not> include optional features as prerequisites without
+explict instruction from users (whether via interactive prompting,
+a function parameter or a configuration value, etc. ).
+
+If an optional feature is used by a consumer to add additional
+prerequisites, the consumer should merge the optional feature
+prerequisites into those given by the C<prereqs> key using the same
+semantics. See L</Merging and Resolving Prerequisites> for details on
+merging prerequisites.
+
+I<Suggestion for disuse:> Because there is currently no way for a
+distribution to specify a dependency on an optional feature of another
+dependency, the use of C<optional_feature> is discouraged. Instead,
+create a separate, installable distribution that ensures the desired
+feature is available. For example, if C<Foo::Bar> has a "Baz" feature,
+release a separate C<Foo-Bar-Baz> distribution that satisfies
+requirements for the feature.
+
+=head3 prereqs
+
+Example:
+
+ prereqs => {
+ runtime => {
+ requires => {
+ 'perl' => '5.006',
+ 'File::Spec' => '0.86',
+ 'JSON' => '2.16',
+ },
+ recommends => {
+ 'JSON::XS' => '2.26',
+ },
+ suggests => {
+ 'Archive::Tar' => '0',
+ },
+ },
+ build => {
+ requires => {
+ 'Alien::SDL' => '1.00',
+ },
+ },
+ test => {
+ recommends => {
+ 'Test::Deep' => '0.10',
+ },
+ }
+ }
+
+(Spec 2) [optional] {Map}
+
+This is a Map that describes all the prerequisites of the distribution.
+The keys are phases of activity, such as C<configure>, C<build>, C<test>
+or C<runtime>. Values are Maps in which the keys name the type of
+prerequisite relationship such as C<requires>, C<recommends>, or
+C<suggests> and the value provides a set of prerequisite relations. The
+set of relations B<must> be specified as a Map of package names to
+version ranges.
+
+The full definition for this field is given in the L</Prereq Spec>
+section.
+
+=head3 provides
+
+Example:
+
+ provides => {
+ 'Foo::Bar' => {
+ file => 'lib/Foo/Bar.pm',
+ version => 0.27_02
+ },
+ 'Foo::Bar::Blah' => {
+ file => 'lib/Foo/Bar/Blah.pm',
+ },
+ 'Foo::Bar::Baz' => {
+ file => 'lib/Foo/Bar/Baz.pm',
+ version => 0.3,
+ },
+ }
+
+(Spec 1.2) [optional] {Map}
+
+This describes all packages provided by this distribution. This
+information is used by distribution and automation mechanisms like
+PAUSE, CPAN, and search.cpan.org to build indexes saying in which
+distribution various packages can be found.
+
+The keys of C<provides> are package names that can be found within
+the distribution. The values are Maps with the following valid subkeys:
+
+=over
+
+=item file
+
+This field is required. The value must contain a relative file path
+from the root of the distribution to the module containing the package.
+
+=item version
+
+This field contains a I<Version> String for the package, if one exists.
+
+=back
+
+=head3 resources
+
+Example:
+
+ resources => {
+ license => [ 'http://dev.perl.org/licenses/' ],
+ homepage => 'http://sourceforge.net/projects/module-build',
+ bugtracker => {
+ web => 'http://github.com/dagolden/cpan-meta-spec/issues',
+ mailto => 'meta-bugs@example.com',
+ },
+ repository => {
+ url => 'git://github.com/dagolden/cpan-meta-spec.git',
+ web => 'http://github.com/dagolden/cpan-meta-spec',
+ type => 'git',
+ },
+ x_twitter => 'http://twitter.com/cpan_linked/',
+ }
+
+(Spec 2) [optional] {Map}
+
+This field describes resources related to this distribution.
+
+Valid subkeys include:
+
+=over
+
+=item homepage
+
+The official home of this project on the web.
+
+=item license
+
+A List of I<URL>'s that relate to this distribution's license. As with the
+top-level C<license> field, distribution documentation should be consulted
+to clarify the interpretation of multiple licenses provided here.
+
+=item bugtracker
+
+This entry describes the bug tracking system for this distribution. It
+is a Map with the following valid keys:
+
+ web - a URL pointing to a web front-end for the bug tracker
+ mailto - an email address to which bugs can be sent
+
+=item repository
+
+This entry describes the source control repository for this distribution. It
+is a Map with the following valid keys:
+
+ url - a URL pointing to the repository itself
+ web - a URL pointing to a web front-end for the repository
+ type - a lowercase string indicating the VCS used
+
+Because a url like C<http://myrepo.example.com/> is ambiguous as to
+type, producers should provide a C<type> whenever a C<url> key is given.
+The C<type> field should be the name of the most common program used
+to work with the repository, e.g. git, svn, cvs, darcs, bzr or hg.
+
+=back
+
+=head2 DEPRECATED FIELDS
+
+=head3 build_requires
+
+I<(Deprecated in Spec 2)> [optional] {String}
+
+Replaced by C<prereqs>
+
+=head3 configure_requires
+
+I<(Deprecated in Spec 2)> [optional] {String}
+
+Replaced by C<prereqs>
+
+=head3 conflicts
+
+I<(Deprecated in Spec 2)> [optional] {String}
+
+Replaced by C<prereqs>
+
+=head3 distribution_type
+
+I<(Deprecated in Spec 2)> [optional] {String}
+
+This field indicated 'module' or 'script' but was considered
+meaningless, since many distributions are hybrids of several kinds of
+things.
+
+=head3 license_uri
+
+I<(Deprecated in Spec 1.2)> [optional] {URL}
+
+Replaced by C<license> in C<resources>
+
+=head3 private
+
+I<(Deprecated in Spec 1.2)> [optional] {Map}
+
+This field has been renamed to L</"no_index">.
+
+=head3 recommends
+
+I<(Deprecated in Spec 2)> [optional] {String}
+
+Replaced by C<prereqs>
+
+=head3 requires
+
+I<(Deprecated in Spec 2)> [optional] {String}
+
+Replaced by C<prereqs>
+
+=head1 VERSION NUMBERS
+
+=head2 Version Formats
+
+This section defines the Version type, used by several fields in the
+CPAN Meta Spec.
+
+Version numbers must be treated as strings, not numbers. For
+example, C<1.200> B<must not> be serialized as C<1.2>. Version
+comparison should be delegated to the Perl L<version> module, version
+0.80 or newer.
+
+Unless otherwise specified, version numbers B<must> appear in one of two
+formats:
+
+=over
+
+=item Decimal versions
+
+Decimal versions are regular "decimal numbers", with some limitations.
+They B<must> be non-negative and B<must> begin and end with a digit. A
+single underscore B<may> be included, but B<must> be between two digits.
+They B<must not> use exponential notation ("1.23e-2").
+
+ version => '1.234' # OK
+ version => '1.23_04' # OK
+
+ version => '1.23_04_05' # Illegal
+ version => '1.' # Illegal
+ version => '.1' # Illegal
+
+=item Dotted-integer versions
+
+Dotted-integer (also known as dotted-decimal) versions consist of
+positive integers separated by full stop characters (i.e. "dots",
+"periods" or "decimal points"). This are equivalent in format to Perl
+"v-strings", with some additional restrictions on form. They must be
+given in "normal" form, which has a leading "v" character and at least
+three integer components. To retain a one-to-one mapping with decimal
+versions, all components after the first B<should> be restricted to the
+range 0 to 999. The final component B<may> be separated by an
+underscore character instead of a period.
+
+ version => 'v1.2.3' # OK
+ version => 'v1.2_3' # OK
+ version => 'v1.2.3.4' # OK
+ version => 'v1.2.3_4' # OK
+ version => 'v2009.10.31' # OK
+
+ version => 'v1.2' # Illegal
+ version => '1.2.3' # Illegal
+ version => 'v1.2_3_4' # Illegal
+ version => 'v1.2009.10.31' # Not recommended
+
+=back
+
+=head2 Version Ranges
+
+Some fields (prereq, optional_features) indicate the particular
+version(s) of some other module that may be required as a prerequisite.
+This section details the Version Range type used to provide this
+information.
+
+The simplest format for a Version Range is just the version
+number itself, e.g. C<2.4>. This means that B<at least> version 2.4
+must be present. To indicate that B<any> version of a prerequisite is
+okay, even if the prerequisite doesn't define a version at all, use
+the version C<0>.
+
+Alternatively, a version range B<may> use the operators E<lt> (less than),
+E<lt>= (less than or equal), E<gt> (greater than), E<gt>= (greater than
+or equal), == (equal), and != (not equal). For example, the
+specification C<E<lt> 2.0> means that any version of the prerequisite
+less than 2.0 is suitable.
+
+For more complicated situations, version specifications B<may> be AND-ed
+together using commas. The specification C<E<gt>= 1.2, != 1.5, E<lt>
+2.0> indicates a version that must be B<at least> 1.2, B<less than> 2.0,
+and B<not equal to> 1.5.
+
+=head1 PREREQUISITES
+
+=head2 Prereq Spec
+
+The C<prereqs> key in the top-level metadata and within
+C<optional_features> define the relationship between a distribution and
+other packages. The prereq spec structure is a hierarchical data
+structure which divides prerequisites into I<Phases> of activity in the
+installation process and I<Relationships> that indicate how
+prerequisites should be resolved.
+
+For example, to specify that C<Data::Dumper> is C<required> during the
+C<test> phase, this entry would appear in the distribution metadata:
+
+ prereqs => {
+ test => {
+ requires => {
+ 'Data::Dumper' => '2.00'
+ }
+ }
+ }
+
+=head3 Phases
+
+Requirements for regular use must be listed in the C<runtime> phase.
+Other requirements should be listed in the earliest stage in which they
+are required and consumers must accumulate and satisfy requirements
+across phases before executing the activity. For example, C<build>
+requirements must also be available during the C<test> phase.
+
+ before action requirements that must be met
+ ---------------- --------------------------------
+ perl Build.PL configure
+ perl Makefile.PL
+
+ make configure, runtime, build
+ Build
+
+ make test configure, runtime, build, test
+ Build test
+
+Consumers that install the distribution must ensure that
+I<runtime> requirements are also installed and may install
+dependencies from other phases.
+
+ after action requirements that must be met
+ ---------------- --------------------------------
+ make install runtime
+ Build install
+
+=over
+
+=item configure
+
+The configure phase occurs before any dynamic configuration has been
+attempted. Libraries required by the configure phase B<must> be
+available for use before the distribution building tool has been
+executed.
+
+=item build
+
+The build phase is when the distribution's source code is compiled (if
+necessary) and otherwise made ready for installation.
+
+=item test
+
+The test phase is when the distribution's automated test suite is run.
+Any library that is needed only for testing and not for subsequent use
+should be listed here.
+
+=item runtime
+
+The runtime phase refers not only to when the distribution's contents
+are installed, but also to its continued use. Any library that is a
+prerequisite for regular use of this distribution should be indicated
+here.
+
+=item develop
+
+The develop phase's prereqs are libraries needed to work on the
+distribution's source code as its author does. These tools might be
+needed to build a release tarball, to run author-only tests, or to
+perform other tasks related to developing new versions of the
+distribution.
+
+=back
+
+=head3 Relationships
+
+=over
+
+=item requires
+
+These dependencies B<must> be installed for proper completion of the
+phase.
+
+=item recommends
+
+Recommended dependencies are I<strongly> encouraged and should be
+satisfied except in resource constrained environments.
+
+=item suggests
+
+These dependencies are optional, but are suggested for enhanced operation
+of the described distribution.
+
+=item conflicts
+
+These libraries cannot be installed when the phase is in operation.
+This is a very rare situation, and the C<conflicts> relationship should
+be used with great caution, or not at all.
+
+=back
+
+=head2 Merging and Resolving Prerequisites
+
+Whenever metadata consumers merge prerequisites, either from different
+phases or from C<optional_features>, they should merged in a way which
+preserves the intended semantics of the prerequisite structure. Generally,
+this means concatenating the version specifications using commas, as
+described in the L<Version Ranges> section.
+
+Another subtle error that can occur in resolving prerequisites comes from
+the way that modules in prerequisites are indexed to distribution files on
+CPAN. When a module is deleted from a distribution, prerequisites calling
+for that module could indicate an older distribution should installed,
+potentially overwriting files from a newer distribution.
+
+For example, as of Oct 31, 2009, the CPAN index file contained these
+module-distribution mappings:
+
+ Class::MOP 0.94 D/DR/DROLSKY/Class-MOP-0.94.tar.gz
+ Class::MOP::Class 0.94 D/DR/DROLSKY/Class-MOP-0.94.tar.gz
+ Class::MOP::Class::Immutable 0.04 S/ST/STEVAN/Class-MOP-0.36.tar.gz
+
+Consider the case where "Class::MOP" 0.94 is installed. If a
+distribution specified "Class::MOP::Class::Immutable" as a prerequisite,
+it could result in Class-MOP-0.36.tar.gz being installed, overwriting
+any files from Class-MOP-0.94.tar.gz.
+
+Consumers of metadata B<should> test whether prerequisites would result
+in installed module files being "downgraded" to an older version and
+B<may> warn users or ignore the prerequisite that would cause such a
+result.
+
+=head1 SERIALIZATION
+
+Distribution metadata should be serialized (as a hashref) as
+JSON-encoded data and packaged with distributions as the file
+F<META.json>.
+
+In the past, the distribution metadata structure had been packed with
+distributions as F<META.yml>, a file in the YAML Tiny format (for which,
+see L<YAML::Tiny>). Tools that consume distribution metadata from disk
+should be capable of loading F<META.yml>, but should prefer F<META.json>
+if both are found.
+
+=head1 NOTES FOR IMPLEMENTORS
+
+=head2 Extracting Version Numbers from Perl Modules
+
+To get the version number from a Perl module, consumers should use the
+C<< MM->parse_version($file) >> method provided by L<ExtUtils::MakeMaker> or
+the L<Module::Build::ModuleInfo> module provided with L<Module::Build>. For
+example, for the module given by C<$mod>, the version may be retrieved in one
+of the following ways:
+
+ # via ExtUtils::MakeMaker
+ my $file = MM->_installed_file_for_module($mod);
+ my $version = MM->parse_version($file)
+
+The private C<_installed_file_for_module> method may be replaced with
+other methods for locating a module in C<@INC>.
+
+ # via Module::Build
+ my $info = Module::Build::ModuleInfo->new_from_module($mod);
+ my $version = $info->version;
+
+If only a filename is available, the following approach may be used:
+
+ # via Module::Build
+ my $info = Module::Build::ModuleInfo->new_from_file($file);
+ my $version = $info->version;
+
+=head2 Comparing Version Numbers
+
+The L<version> module provides the most reliable way to compare version
+numbers in all the various ways they might be provided or might exist
+within modules. Given two strings containing version numbers, C<$v1> and
+C<$v2>, they should be converted to C<version> objects before using
+ordinary comparison operators. For example:
+
+ use version;
+ if ( version->new($v1) <=> version->new($v2) ) {
+ print "Versions are not equal\n";
+ }
+
+If the only comparison needed is whether an installed module is of a
+sufficiently high version, a direct test may be done using the string
+form of C<eval> and the C<use> function. For example, for module C<$mod>
+and version prerequisite C<$prereq>:
+
+ if ( eval "use $mod $prereq (); 1" ) {
+ print "Module $mod version is OK.\n";
+ }
+
+If the values of C<$mod> and C<$prereq> have not been scrubbed, however,
+this presents security implications.
+
+=head1 SEE ALSO
+
+CPAN, L<http://www.cpan.org/>
+
+CPAN.pm, L<http://search.cpan.org/dist/CPAN/>
+
+CPANPLUS, L<http://search.cpan.org/dist/CPANPLUS/>
+
+ExtUtils::MakeMaker, L<http://search.cpan.org/dist/ExtUtils-MakeMaker/>
+
+Module::Build, L<http://search.cpan.org/dist/Module-Build/>
+
+Module::Install, L<http://search.cpan.org/dist/Module-Install/>
+
+JSON, L<http://json.org/>
+
+YAML, L<http://www.yaml.org/>
+
+=head1 CONTRIBUTORS
+
+Ken Williams wrote the original CPAN Meta Spec (also known as the
+"META.yml spec") in 2003 and maintained it through several revisions
+with input from various members of the community. In 2005, Randy
+Sims redrafted it from HTML to POD for the version 1.2 release. Ken
+continued to maintain the spec through version 1.4.
+
+In late 2009, David Golden organized the version 2 proposal review
+process. David and Ricardo Signes drafted the final version 2 spec
+in April 2010 based on the version 1.4 spec and patches contributed
+during the proposal process.
+
+Several others have contributed patches over the years. The full list
+of contributors in the repository history currently includes:
+
+ 2shortplanks
+ Avar Arnfjord Bjarmason
+ Christopher J. Madsen
+ Damyan Ivanov
+ David Golden
+ Eric Wilhelm
+ Ken Williams
+ Lars DIECKOW
+ Michael G. Schwern
+ Randy Sims
+ Ricardo Signes
+
+=head1 AUTHORS
+
+=over 4
+
+=item *
+
+David Golden <dagolden@cpan.org>
+
+=item *
+
+Ricardo Signes <rjbs@cpan.org>
+
+=back
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is copyright (c) 2010 by David Golden and Ricardo Signes.
+
+This is free software; you can redistribute it and/or modify it under
+the same terms as the Perl 5 programming language system itself.
+
+=cut
+
diff --git a/Master/tlpkg/tlperl/lib/CPAN/Meta/Validator.pm b/Master/tlpkg/tlperl/lib/CPAN/Meta/Validator.pm
new file mode 100644
index 00000000000..a203621ab8f
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/CPAN/Meta/Validator.pm
@@ -0,0 +1,1002 @@
+use 5.006;
+use strict;
+use warnings;
+package CPAN::Meta::Validator;
+BEGIN {
+ $CPAN::Meta::Validator::VERSION = '2.110440';
+}
+# ABSTRACT: validate CPAN distribution metadata structures
+
+
+#--------------------------------------------------------------------------#
+# This code copied and adapted from Test::CPAN::Meta
+# by Barbie, <barbie@cpan.org> for Miss Barbell Productions,
+# L<http://www.missbarbell.co.uk>
+#--------------------------------------------------------------------------#
+
+#--------------------------------------------------------------------------#
+# Specification Definitions
+#--------------------------------------------------------------------------#
+
+my %known_specs = (
+ '1.4' => 'http://module-build.sourceforge.net/META-spec-v1.4.html',
+ '1.3' => 'http://module-build.sourceforge.net/META-spec-v1.3.html',
+ '1.2' => 'http://module-build.sourceforge.net/META-spec-v1.2.html',
+ '1.1' => 'http://module-build.sourceforge.net/META-spec-v1.1.html',
+ '1.0' => 'http://module-build.sourceforge.net/META-spec-v1.0.html'
+);
+my %known_urls = map {$known_specs{$_} => $_} keys %known_specs;
+
+my $module_map1 = { 'map' => { ':key' => { name => \&module, value => \&exversion } } };
+
+my $module_map2 = { 'map' => { ':key' => { name => \&module, value => \&version } } };
+
+my $no_index_2 = {
+ 'map' => { file => { list => { value => \&string } },
+ directory => { list => { value => \&string } },
+ 'package' => { list => { value => \&string } },
+ namespace => { list => { value => \&string } },
+ ':key' => { name => \&custom_2, value => \&anything },
+ }
+};
+
+my $no_index_1_3 = {
+ 'map' => { file => { list => { value => \&string } },
+ directory => { list => { value => \&string } },
+ 'package' => { list => { value => \&string } },
+ namespace => { list => { value => \&string } },
+ ':key' => { name => \&string, value => \&anything },
+ }
+};
+
+my $no_index_1_2 = {
+ 'map' => { file => { list => { value => \&string } },
+ dir => { list => { value => \&string } },
+ 'package' => { list => { value => \&string } },
+ namespace => { list => { value => \&string } },
+ ':key' => { name => \&string, value => \&anything },
+ }
+};
+
+my $no_index_1_1 = {
+ 'map' => { ':key' => { name => \&string, list => { value => \&string } },
+ }
+};
+
+my $prereq_map = {
+ map => {
+ ':key' => {
+ name => \&phase,
+ 'map' => {
+ ':key' => {
+ name => \&relation,
+ %$module_map1,
+ },
+ },
+ }
+ },
+};
+
+my %definitions = (
+ '2' => {
+ # REQUIRED
+ 'abstract' => { mandatory => 1, value => \&string },
+ 'author' => { mandatory => 1, lazylist => { value => \&string } },
+ 'dynamic_config' => { mandatory => 1, value => \&boolean },
+ 'generated_by' => { mandatory => 1, value => \&string },
+ 'license' => { mandatory => 1, lazylist => { value => \&license } },
+ 'meta-spec' => {
+ mandatory => 1,
+ 'map' => {
+ version => { mandatory => 1, value => \&version},
+ url => { value => \&url },
+ ':key' => { name => \&custom_2, value => \&anything },
+ }
+ },
+ 'name' => { mandatory => 1, value => \&string },
+ 'release_status' => { mandatory => 1, value => \&release_status },
+ 'version' => { mandatory => 1, value => \&version },
+
+ # OPTIONAL
+ 'description' => { value => \&string },
+ 'keywords' => { lazylist => { value => \&string } },
+ 'no_index' => $no_index_2,
+ 'optional_features' => {
+ 'map' => {
+ ':key' => {
+ name => \&string,
+ 'map' => {
+ description => { value => \&string },
+ prereqs => $prereq_map,
+ ':key' => { name => \&custom_2, value => \&anything },
+ }
+ }
+ }
+ },
+ 'prereqs' => $prereq_map,
+ 'provides' => {
+ 'map' => {
+ ':key' => {
+ name => \&module,
+ 'map' => {
+ file => { mandatory => 1, value => \&file },
+ version => { value => \&version },
+ ':key' => { name => \&custom_2, value => \&anything },
+ }
+ }
+ }
+ },
+ 'resources' => {
+ 'map' => {
+ license => { lazylist => { value => \&url } },
+ homepage => { value => \&url },
+ bugtracker => {
+ 'map' => {
+ web => { value => \&url },
+ mailto => { value => \&string},
+ ':key' => { name => \&custom_2, value => \&anything },
+ }
+ },
+ repository => {
+ 'map' => {
+ web => { value => \&url },
+ url => { value => \&url },
+ type => { value => \&string },
+ ':key' => { name => \&custom_2, value => \&anything },
+ }
+ },
+ ':key' => { value => \&string, name => \&custom_2 },
+ }
+ },
+
+ # CUSTOM -- additional user defined key/value pairs
+ # note we can only validate the key name, as the structure is user defined
+ ':key' => { name => \&custom_2, value => \&anything },
+ },
+
+'1.4' => {
+ 'meta-spec' => {
+ mandatory => 1,
+ 'map' => {
+ version => { mandatory => 1, value => \&version},
+ url => { mandatory => 1, value => \&urlspec },
+ ':key' => { name => \&string, value => \&anything },
+ },
+ },
+
+ 'name' => { mandatory => 1, value => \&string },
+ 'version' => { mandatory => 1, value => \&version },
+ 'abstract' => { mandatory => 1, value => \&string },
+ 'author' => { mandatory => 1, list => { value => \&string } },
+ 'license' => { mandatory => 1, value => \&license },
+ 'generated_by' => { mandatory => 1, value => \&string },
+
+ 'distribution_type' => { value => \&string },
+ 'dynamic_config' => { value => \&boolean },
+
+ 'requires' => $module_map1,
+ 'recommends' => $module_map1,
+ 'build_requires' => $module_map1,
+ 'configure_requires' => $module_map1,
+ 'conflicts' => $module_map2,
+
+ 'optional_features' => {
+ 'map' => {
+ ':key' => { name => \&string,
+ 'map' => { description => { value => \&string },
+ requires => $module_map1,
+ recommends => $module_map1,
+ build_requires => $module_map1,
+ conflicts => $module_map2,
+ ':key' => { name => \&string, value => \&anything },
+ }
+ }
+ }
+ },
+
+ 'provides' => {
+ 'map' => {
+ ':key' => { name => \&module,
+ 'map' => {
+ file => { mandatory => 1, value => \&file },
+ version => { value => \&version },
+ ':key' => { name => \&string, value => \&anything },
+ }
+ }
+ }
+ },
+
+ 'no_index' => $no_index_1_3,
+ 'private' => $no_index_1_3,
+
+ 'keywords' => { list => { value => \&string } },
+
+ 'resources' => {
+ 'map' => { license => { value => \&url },
+ homepage => { value => \&url },
+ bugtracker => { value => \&url },
+ repository => { value => \&url },
+ ':key' => { value => \&string, name => \&custom_1 },
+ }
+ },
+
+ # additional user defined key/value pairs
+ # note we can only validate the key name, as the structure is user defined
+ ':key' => { name => \&string, value => \&anything },
+},
+
+'1.3' => {
+ 'meta-spec' => {
+ mandatory => 1,
+ 'map' => {
+ version => { mandatory => 1, value => \&version},
+ url => { mandatory => 1, value => \&urlspec },
+ ':key' => { name => \&string, value => \&anything },
+ },
+ },
+
+ 'name' => { mandatory => 1, value => \&string },
+ 'version' => { mandatory => 1, value => \&version },
+ 'abstract' => { mandatory => 1, value => \&string },
+ 'author' => { mandatory => 1, list => { value => \&string } },
+ 'license' => { mandatory => 1, value => \&license },
+ 'generated_by' => { mandatory => 1, value => \&string },
+
+ 'distribution_type' => { value => \&string },
+ 'dynamic_config' => { value => \&boolean },
+
+ 'requires' => $module_map1,
+ 'recommends' => $module_map1,
+ 'build_requires' => $module_map1,
+ 'conflicts' => $module_map2,
+
+ 'optional_features' => {
+ 'map' => {
+ ':key' => { name => \&string,
+ 'map' => { description => { value => \&string },
+ requires => $module_map1,
+ recommends => $module_map1,
+ build_requires => $module_map1,
+ conflicts => $module_map2,
+ ':key' => { name => \&string, value => \&anything },
+ }
+ }
+ }
+ },
+
+ 'provides' => {
+ 'map' => {
+ ':key' => { name => \&module,
+ 'map' => {
+ file => { mandatory => 1, value => \&file },
+ version => { value => \&version },
+ ':key' => { name => \&string, value => \&anything },
+ }
+ }
+ }
+ },
+
+
+ 'no_index' => $no_index_1_3,
+ 'private' => $no_index_1_3,
+
+ 'keywords' => { list => { value => \&string } },
+
+ 'resources' => {
+ 'map' => { license => { value => \&url },
+ homepage => { value => \&url },
+ bugtracker => { value => \&url },
+ repository => { value => \&url },
+ ':key' => { value => \&string, name => \&custom_1 },
+ }
+ },
+
+ # additional user defined key/value pairs
+ # note we can only validate the key name, as the structure is user defined
+ ':key' => { name => \&string, value => \&anything },
+},
+
+# v1.2 is misleading, it seems to assume that a number of fields where created
+# within v1.1, when they were created within v1.2. This may have been an
+# original mistake, and that a v1.1 was retro fitted into the timeline, when
+# v1.2 was originally slated as v1.1. But I could be wrong ;)
+'1.2' => {
+ 'meta-spec' => {
+ mandatory => 1,
+ 'map' => {
+ version => { mandatory => 1, value => \&version},
+ url => { mandatory => 1, value => \&urlspec },
+ ':key' => { name => \&string, value => \&anything },
+ },
+ },
+
+
+ 'name' => { mandatory => 1, value => \&string },
+ 'version' => { mandatory => 1, value => \&version },
+ 'license' => { mandatory => 1, value => \&license },
+ 'generated_by' => { mandatory => 1, value => \&string },
+ 'author' => { mandatory => 1, list => { value => \&string } },
+ 'abstract' => { mandatory => 1, value => \&string },
+
+ 'distribution_type' => { value => \&string },
+ 'dynamic_config' => { value => \&boolean },
+
+ 'keywords' => { list => { value => \&string } },
+
+ 'private' => $no_index_1_2,
+ '$no_index' => $no_index_1_2,
+
+ 'requires' => $module_map1,
+ 'recommends' => $module_map1,
+ 'build_requires' => $module_map1,
+ 'conflicts' => $module_map2,
+
+ 'optional_features' => {
+ 'map' => {
+ ':key' => { name => \&string,
+ 'map' => { description => { value => \&string },
+ requires => $module_map1,
+ recommends => $module_map1,
+ build_requires => $module_map1,
+ conflicts => $module_map2,
+ ':key' => { name => \&string, value => \&anything },
+ }
+ }
+ }
+ },
+
+ 'provides' => {
+ 'map' => {
+ ':key' => { name => \&module,
+ 'map' => {
+ file => { mandatory => 1, value => \&file },
+ version => { value => \&version },
+ ':key' => { name => \&string, value => \&anything },
+ }
+ }
+ }
+ },
+
+ 'resources' => {
+ 'map' => { license => { value => \&url },
+ homepage => { value => \&url },
+ bugtracker => { value => \&url },
+ repository => { value => \&url },
+ ':key' => { value => \&string, name => \&custom_1 },
+ }
+ },
+
+ # additional user defined key/value pairs
+ # note we can only validate the key name, as the structure is user defined
+ ':key' => { name => \&string, value => \&anything },
+},
+
+# note that the 1.1 spec only specifies 'version' as mandatory
+'1.1' => {
+ 'name' => { value => \&string },
+ 'version' => { mandatory => 1, value => \&version },
+ 'license' => { value => \&license },
+ 'generated_by' => { value => \&string },
+
+ 'license_uri' => { value => \&url },
+ 'distribution_type' => { value => \&string },
+ 'dynamic_config' => { value => \&boolean },
+
+ 'private' => $no_index_1_1,
+
+ 'requires' => $module_map1,
+ 'recommends' => $module_map1,
+ 'build_requires' => $module_map1,
+ 'conflicts' => $module_map2,
+
+ # additional user defined key/value pairs
+ # note we can only validate the key name, as the structure is user defined
+ ':key' => { name => \&string, value => \&anything },
+},
+
+# note that the 1.0 spec doesn't specify optional or mandatory fields
+# but we will treat version as mandatory since otherwise META 1.0 is
+# completely arbitrary and pointless
+'1.0' => {
+ 'name' => { value => \&string },
+ 'version' => { mandatory => 1, value => \&version },
+ 'license' => { value => \&license },
+ 'generated_by' => { value => \&string },
+
+ 'license_uri' => { value => \&url },
+ 'distribution_type' => { value => \&string },
+ 'dynamic_config' => { value => \&boolean },
+
+ 'requires' => $module_map1,
+ 'recommends' => $module_map1,
+ 'build_requires' => $module_map1,
+ 'conflicts' => $module_map2,
+
+ # additional user defined key/value pairs
+ # note we can only validate the key name, as the structure is user defined
+ ':key' => { name => \&string, value => \&anything },
+},
+);
+
+#--------------------------------------------------------------------------#
+# Code
+#--------------------------------------------------------------------------#
+
+
+sub new {
+ my ($class,$data) = @_;
+
+ # create an attributes hash
+ my $self = {
+ 'data' => $data,
+ 'spec' => $data->{'meta-spec'}{'version'} || "1.0",
+ 'errors' => undef,
+ };
+
+ # create the object
+ return bless $self, $class;
+}
+
+
+sub is_valid {
+ my $self = shift;
+ my $data = $self->{data};
+ my $spec_version = $self->{spec};
+ $self->check_map($definitions{$spec_version},$data);
+ return ! $self->errors;
+}
+
+
+sub errors {
+ my $self = shift;
+ return () unless(defined $self->{errors});
+ return @{$self->{errors}};
+}
+
+
+my $spec_error = "Missing validation action in specification. "
+ . "Must be one of 'map', 'list', 'lazylist', or 'value'";
+
+sub check_map {
+ my ($self,$spec,$data) = @_;
+
+ if(ref($spec) ne 'HASH') {
+ $self->_error( "Unknown META specification, cannot validate." );
+ return;
+ }
+
+ if(ref($data) ne 'HASH') {
+ $self->_error( "Expected a map structure from string or file." );
+ return;
+ }
+
+ for my $key (keys %$spec) {
+ next unless($spec->{$key}->{mandatory});
+ next if(defined $data->{$key});
+ push @{$self->{stack}}, $key;
+ $self->_error( "Missing mandatory field, '$key'" );
+ pop @{$self->{stack}};
+ }
+
+ for my $key (keys %$data) {
+ push @{$self->{stack}}, $key;
+ if($spec->{$key}) {
+ if($spec->{$key}{value}) {
+ $spec->{$key}{value}->($self,$key,$data->{$key});
+ } elsif($spec->{$key}{'map'}) {
+ $self->check_map($spec->{$key}{'map'},$data->{$key});
+ } elsif($spec->{$key}{'list'}) {
+ $self->check_list($spec->{$key}{'list'},$data->{$key});
+ } elsif($spec->{$key}{'lazylist'}) {
+ $self->check_lazylist($spec->{$key}{'lazylist'},$data->{$key});
+ } else {
+ $self->_error( "$spec_error for '$key'" );
+ }
+
+ } elsif ($spec->{':key'}) {
+ $spec->{':key'}{name}->($self,$key,$key);
+ if($spec->{':key'}{value}) {
+ $spec->{':key'}{value}->($self,$key,$data->{$key});
+ } elsif($spec->{':key'}{'map'}) {
+ $self->check_map($spec->{':key'}{'map'},$data->{$key});
+ } elsif($spec->{':key'}{'list'}) {
+ $self->check_list($spec->{':key'}{'list'},$data->{$key});
+ } elsif($spec->{':key'}{'lazylist'}) {
+ $self->check_lazylist($spec->{':key'}{'lazylist'},$data->{$key});
+ } else {
+ $self->_error( "$spec_error for ':key'" );
+ }
+
+
+ } else {
+ $self->_error( "Unknown key, '$key', found in map structure" );
+ }
+ pop @{$self->{stack}};
+ }
+}
+
+# if it's a string, make it into a list and check the list
+sub check_lazylist {
+ my ($self,$spec,$data) = @_;
+
+ if ( defined $data && ! ref($data) ) {
+ $data = [ $data ];
+ }
+
+ $self->check_list($spec,$data);
+}
+
+sub check_list {
+ my ($self,$spec,$data) = @_;
+
+ if(ref($data) ne 'ARRAY') {
+ $self->_error( "Expected a list structure" );
+ return;
+ }
+
+ if(defined $spec->{mandatory}) {
+ if(!defined $data->[0]) {
+ $self->_error( "Missing entries from mandatory list" );
+ }
+ }
+
+ for my $value (@$data) {
+ push @{$self->{stack}}, $value || "<undef>";
+ if(defined $spec->{value}) {
+ $spec->{value}->($self,'list',$value);
+ } elsif(defined $spec->{'map'}) {
+ $self->check_map($spec->{'map'},$value);
+ } elsif(defined $spec->{'list'}) {
+ $self->check_list($spec->{'list'},$value);
+ } elsif(defined $spec->{'lazylist'}) {
+ $self->check_lazylist($spec->{'lazylist'},$value);
+ } elsif ($spec->{':key'}) {
+ $self->check_map($spec,$value);
+ } else {
+ $self->_error( "$spec_error associated with '$self->{stack}[-2]'" );
+ }
+ pop @{$self->{stack}};
+ }
+}
+
+
+sub header {
+ my ($self,$key,$value) = @_;
+ if(defined $value) {
+ return 1 if($value && $value =~ /^--- #YAML:1.0/);
+ }
+ $self->_error( "file does not have a valid YAML header." );
+ return 0;
+}
+
+sub release_status {
+ my ($self,$key,$value) = @_;
+ if(defined $value) {
+ my $version = $self->{data}{version} || '';
+ if ( $version =~ /_/ ) {
+ return 1 if ( $value =~ /\A(?:testing|unstable)\z/ );
+ $self->_error( "'$value' for '$key' is invalid for version '$version'" );
+ }
+ else {
+ return 1 if ( $value =~ /\A(?:stable|testing|unstable)\z/ );
+ $self->_error( "'$value' for '$key' is invalid" );
+ }
+ }
+ else {
+ $self->_error( "'$key' is not defined" );
+ }
+ return 0;
+}
+
+# _uri_split taken from URI::Split by Gisle Aas, Copyright 2003
+sub _uri_split {
+ return $_[0] =~ m,(?:([^:/?#]+):)?(?://([^/?#]*))?([^?#]*)(?:\?([^#]*))?(?:#(.*))?,;
+}
+
+sub url {
+ my ($self,$key,$value) = @_;
+ if(defined $value) {
+ my ($scheme, $auth, $path, $query, $frag) = _uri_split($value);
+ unless ( defined $scheme && length $scheme ) {
+ $self->_error( "'$value' for '$key' does not have a URL scheme" );
+ return 0;
+ }
+ unless ( defined $auth && length $auth ) {
+ $self->_error( "'$value' for '$key' does not have a URL authority" );
+ return 0;
+ }
+ return 1;
+ }
+ $value ||= '';
+ $self->_error( "'$value' for '$key' is not a valid URL." );
+ return 0;
+}
+
+sub urlspec {
+ my ($self,$key,$value) = @_;
+ if(defined $value) {
+ return 1 if($value && $known_specs{$self->{spec}} eq $value);
+ if($value && $known_urls{$value}) {
+ $self->_error( 'META specification URL does not match version' );
+ return 0;
+ }
+ }
+ $self->_error( 'Unknown META specification' );
+ return 0;
+}
+
+sub anything { return 1 }
+
+sub string {
+ my ($self,$key,$value) = @_;
+ if(defined $value) {
+ return 1 if($value || $value =~ /^0$/);
+ }
+ $self->_error( "value is an undefined string" );
+ return 0;
+}
+
+sub string_or_undef {
+ my ($self,$key,$value) = @_;
+ return 1 unless(defined $value);
+ return 1 if($value || $value =~ /^0$/);
+ $self->_error( "No string defined for '$key'" );
+ return 0;
+}
+
+sub file {
+ my ($self,$key,$value) = @_;
+ return 1 if(defined $value);
+ $self->_error( "No file defined for '$key'" );
+ return 0;
+}
+
+sub exversion {
+ my ($self,$key,$value) = @_;
+ if(defined $value && ($value || $value =~ /0/)) {
+ my $pass = 1;
+ for(split(",",$value)) { $self->version($key,$_) or ($pass = 0); }
+ return $pass;
+ }
+ $value = '<undef>' unless(defined $value);
+ $self->_error( "'$value' for '$key' is not a valid version." );
+ return 0;
+}
+
+sub version {
+ my ($self,$key,$value) = @_;
+ if(defined $value) {
+ return 0 unless($value || $value =~ /0/);
+ return 1 if($value =~ /^\s*((<|<=|>=|>|!=|==)\s*)?v?\d+((\.\d+((_|\.)\d+)?)?)/);
+ } else {
+ $value = '<undef>';
+ }
+ $self->_error( "'$value' for '$key' is not a valid version." );
+ return 0;
+}
+
+sub boolean {
+ my ($self,$key,$value) = @_;
+ if(defined $value) {
+ return 1 if($value =~ /^(0|1|true|false)$/);
+ } else {
+ $value = '<undef>';
+ }
+ $self->_error( "'$value' for '$key' is not a boolean value." );
+ return 0;
+}
+
+my %v1_licenses = (
+ 'perl' => 'http://dev.perl.org/licenses/',
+ 'gpl' => 'http://www.opensource.org/licenses/gpl-license.php',
+ 'apache' => 'http://apache.org/licenses/LICENSE-2.0',
+ 'artistic' => 'http://opensource.org/licenses/artistic-license.php',
+ 'artistic_2' => 'http://opensource.org/licenses/artistic-license-2.0.php',
+ 'lgpl' => 'http://www.opensource.org/licenses/lgpl-license.phpt',
+ 'bsd' => 'http://www.opensource.org/licenses/bsd-license.php',
+ 'gpl' => 'http://www.opensource.org/licenses/gpl-license.php',
+ 'mit' => 'http://opensource.org/licenses/mit-license.php',
+ 'mozilla' => 'http://opensource.org/licenses/mozilla1.1.php',
+ 'open_source' => undef,
+ 'unrestricted' => undef,
+ 'restrictive' => undef,
+ 'unknown' => undef,
+);
+
+my %v2_licenses = map { $_ => 1 } qw(
+ agpl_3
+ apache_1_1
+ apache_2_0
+ artistic_1
+ artistic_2
+ bsd
+ freebsd
+ gfdl_1_2
+ gfdl_1_3
+ gpl_1
+ gpl_2
+ gpl_3
+ lgpl_2_1
+ lgpl_3_0
+ mit
+ mozilla_1_0
+ mozilla_1_1
+ openssl
+ perl_5
+ qpl_1_0
+ ssleay
+ sun
+ zlib
+ open_source
+ restricted
+ unrestricted
+ unknown
+);
+
+sub license {
+ my ($self,$key,$value) = @_;
+ my $licenses = $self->{spec} < 2 ? \%v1_licenses : \%v2_licenses;
+ if(defined $value) {
+ return 1 if($value && exists $licenses->{$value});
+ } else {
+ $value = '<undef>';
+ }
+ $self->_error( "License '$value' is invalid" );
+ return 0;
+}
+
+sub custom_1 {
+ my ($self,$key) = @_;
+ if(defined $key) {
+ # a valid user defined key should be alphabetic
+ # and contain at least one capital case letter.
+ return 1 if($key && $key =~ /^[_a-z]+$/i && $key =~ /[A-Z]/);
+ } else {
+ $key = '<undef>';
+ }
+ $self->_error( "Custom resource '$key' must be in CamelCase." );
+ return 0;
+}
+
+sub custom_2 {
+ my ($self,$key) = @_;
+ if(defined $key) {
+ return 1 if($key && $key =~ /^x_/i); # user defined
+ } else {
+ $key = '<undef>';
+ }
+ $self->_error( "Custom key '$key' must begin with 'x_' or 'X_'." );
+ return 0;
+}
+
+sub identifier {
+ my ($self,$key) = @_;
+ if(defined $key) {
+ return 1 if($key && $key =~ /^([a-z][_a-z]+)$/i); # spec 2.0 defined
+ } else {
+ $key = '<undef>';
+ }
+ $self->_error( "Key '$key' is not a legal identifier." );
+ return 0;
+}
+
+sub module {
+ my ($self,$key) = @_;
+ if(defined $key) {
+ return 1 if($key && $key =~ /^[A-Za-z0-9_]+(::[A-Za-z0-9_]+)*$/);
+ } else {
+ $key = '<undef>';
+ }
+ $self->_error( "Key '$key' is not a legal module name." );
+ return 0;
+}
+
+my @valid_phases = qw/ configure build test runtime develop /;
+sub phase {
+ my ($self,$key) = @_;
+ if(defined $key) {
+ return 1 if( length $key && grep { $key eq $_ } @valid_phases );
+ return 1 if $key =~ /x_/i;
+ } else {
+ $key = '<undef>';
+ }
+ $self->_error( "Key '$key' is not a legal phase." );
+ return 0;
+}
+
+my @valid_relations = qw/ requires recommends suggests conflicts /;
+sub relation {
+ my ($self,$key) = @_;
+ if(defined $key) {
+ return 1 if( length $key && grep { $key eq $_ } @valid_relations );
+ return 1 if $key =~ /x_/i;
+ } else {
+ $key = '<undef>';
+ }
+ $self->_error( "Key '$key' is not a legal prereq relationship." );
+ return 0;
+}
+
+sub _error {
+ my $self = shift;
+ my $mess = shift;
+
+ $mess .= ' ('.join(' -> ',@{$self->{stack}}).')' if($self->{stack});
+ $mess .= " [Validation: $self->{spec}]";
+
+ push @{$self->{errors}}, $mess;
+}
+
+1;
+
+
+
+=pod
+
+=head1 NAME
+
+CPAN::Meta::Validator - validate CPAN distribution metadata structures
+
+=head1 VERSION
+
+version 2.110440
+
+=head1 SYNOPSIS
+
+ my $struct = decode_json_file('META.json');
+
+ my $cmv = CPAN::Meta::Validator->new( $struct );
+
+ unless ( $cmv->is_valid ) {
+ my $msg = "Invalid META structure. Errors found:\n";
+ $msg .= join( "\n", $cmv->errors );
+ die $msg;
+ }
+
+=head1 DESCRIPTION
+
+This module validates a CPAN Meta structure against the version of the
+the specification claimed in the C<meta-spec> field of the structure.
+
+=head1 METHODS
+
+=head2 new
+
+ my $cmv = CPAN::Meta::Validator->new( $struct )
+
+The constructor must be passed a metadata structure.
+
+=head2 is_valid
+
+ if ( $cmv->is_valid ) {
+ ...
+ }
+
+Returns a boolean value indicating whether the metadata provided
+is valid.
+
+=head2 errors
+
+ warn( join "\n", $cmv->errors );
+
+Returns a list of errors seen during validation.
+
+=begin internals
+
+=head2 Check Methods
+
+=over
+
+=item * check_map($spec,$data)
+
+Checks whether a map (or hash) part of the data structure conforms to the
+appropriate specification definition.
+=item * check_list($spec,$data)
+
+Checks whether a list (or array) part of the data structure conforms to
+the appropriate specification definition.
+=item * check_lazylist($spec,$data)
+
+Checks whether a list conforms, but converts strings to a single-element list
+=back
+
+=head2 Validator Methods
+
+=over
+
+=item * header($self,$key,$value)
+
+Validates that the header is valid.
+
+Note: No longer used as we now read the data structure, not the file.=item * url($self,$key,$value)
+
+Validates that a given value is in an acceptable URL format
+=item * urlspec($self,$key,$value)
+
+Validates that the URL to a META specification is a known one.
+=item * string_or_undef($self,$key,$value)
+
+Validates that the value is either a string or an undef value. Bit of a
+catchall function for parts of the data structure that are completely user
+defined.
+=item * string($self,$key,$value)
+
+Validates that a string exists for the given key.
+=item * file($self,$key,$value)
+
+Validate that a file is passed for the given key. This may be made more
+thorough in the future. For now it acts like \&string.
+=item * exversion($self,$key,$value)
+
+Validates a list of versions, e.g. '<= 5, >=2, ==3, !=4, >1, <6, 0'.
+=item * version($self,$key,$value)
+
+Validates a single version string. Versions of the type '5.8.8' and '0.00_00'
+are both valid. A leading 'v' like 'v1.2.3' is also valid.
+=item * boolean($self,$key,$value)
+
+Validates for a boolean value. Currently these values are '1', '0', 'true',
+'false', however the latter 2 may be removed.
+=item * license($self,$key,$value)
+
+Validates that a value is given for the license. Returns 1 if an known license
+type, or 2 if a value is given but the license type is not a recommended one.
+=item * custom_1($self,$key,$value)
+
+Validates that the given key is in CamelCase, to indicate a user defined
+keyword and only has characters in the class [-_a-zA-Z]. In version 1.X
+of the spec, this was only explicitly stated for 'resources'.
+=item * custom_2($self,$key,$value)
+
+Validates that the given key begins with 'x_' or 'X_', to indicate a user
+defined keyword and only has characters in the class [-_a-zA-Z]
+=item * identifier($self,$key,$value)
+
+Validates that key is in an acceptable format for the META specification,
+for an identifier, i.e. any that matches the regular expression
+qr/[a-z][a-z_]/i.
+=item * module($self,$key,$value)
+
+Validates that a given key is in an acceptable module name format, e.g.
+'Test::CPAN::Meta::Version'.
+=back
+
+=end internals
+
+=head1 BUGS
+
+Please report any bugs or feature using the CPAN Request Tracker.
+Bugs can be submitted through the web interface at
+L<http://rt.cpan.org/Dist/Display.html?Queue=CPAN-Meta>
+
+When submitting a bug or request, please include a test-file or a patch to an
+existing test-file that illustrates the bug or desired feature.
+
+=head1 AUTHORS
+
+=over 4
+
+=item *
+
+David Golden <dagolden@cpan.org>
+
+=item *
+
+Ricardo Signes <rjbs@cpan.org>
+
+=back
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is copyright (c) 2010 by David Golden and Ricardo Signes.
+
+This is free software; you can redistribute it and/or modify it under
+the same terms as the Perl 5 programming language system itself.
+
+=cut
+
+
+__END__
+
+
+
diff --git a/Master/tlpkg/tlperl/lib/CPAN/Meta/YAML.pm b/Master/tlpkg/tlperl/lib/CPAN/Meta/YAML.pm
new file mode 100644
index 00000000000..2e94a180840
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/CPAN/Meta/YAML.pm
@@ -0,0 +1,714 @@
+package CPAN::Meta::YAML;
+BEGIN {
+ $CPAN::Meta::YAML::VERSION = '0.003';
+}
+
+use strict;
+
+# 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;
+ require Exporter;
+ require Carp;
+ @CPAN::Meta::YAML::ISA = qw{ Exporter };
+ @CPAN::Meta::YAML::EXPORT = qw{ Load Dump };
+ @CPAN::Meta::YAML::EXPORT_OK = qw{ LoadFile DumpFile freeze thaw };
+
+ # Error storage
+ $CPAN::Meta::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 CPAN::Meta::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];
+ eval {
+ unless ( defined $string ) {
+ die \"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)/ ) {
+ die \"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/ ) {
+ die \"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 {
+ die \"CPAN::Meta::YAML failed to classify the line '$lines[0]'";
+ }
+ }
+ };
+ if ( ref $@ eq 'SCALAR' ) {
+ return $self->_error(${$@});
+ } elsif ( $@ ) {
+ require Carp;
+ Carp::croak($@);
+ }
+
+ return $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 '~';
+
+ # Single quote
+ if ( $string =~ /^\'(.*?)\'(?:\s+\#.*)?\z/ ) {
+ return '' unless defined $1;
+ $string = $1;
+ $string =~ s/\'\'/\'/g;
+ return $string;
+ }
+
+ # Double quote.
+ # The commented out form is simpler, but overloaded the Perl regex
+ # engine due to recursion and backtracking problems on strings
+ # larger than 32,000ish characters. Keep it for reference purposes.
+ # if ( $string =~ /^\"((?:\\.|[^\"])*)\"\z/ ) {
+ if ( $string =~ /^\"([^\\"]*(?:\\.[^\\"]*)*)\"(?:\s+\#.*)?\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 =~ /^[\'\"!&]/ ) {
+ die \"CPAN::Meta::YAML does not support a feature in line '$string'";
+ }
+ return {} if $string =~ /^{}(?:\s+\#.*)?\z/;
+ return [] if $string =~ /^\[\](?:\s+\#.*)?\z/;
+
+ # Regular unquoted string
+ if ( $string !~ /^[>|]/ ) {
+ if (
+ $string =~ /^(?:-(?:\s|$)|[\@\%\`])/
+ or
+ $string =~ /:(?:\s|$)/
+ ) {
+ die \"CPAN::Meta::YAML found illegal characters in plain scalar: '$string'";
+ }
+ $string =~ s/\s+#.*\z//;
+ return $string;
+ }
+
+ # Error
+ die \"CPAN::Meta::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] ) {
+ die \"CPAN::Meta::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] ) {
+ die \"CPAN::Meta::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 {
+ die \"CPAN::Meta::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 {
+ die \"CPAN::Meta::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] ) {
+ die \"CPAN::Meta::YAML found bad indenting in line '$lines->[0]'";
+ }
+
+ # Get the key
+ unless ( $lines->[0] =~ s/^\s*([^\'\" ][^\n]*?)\s*:(\s+(?:\#.*)?|$)// ) {
+ if ( $lines->[0] =~ /^\s*[?\'\"]/ ) {
+ die \"CPAN::Meta::YAML does not support a feature in line '$lines->[0]'";
+ }
+ die \"CPAN::Meta::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 {
+ Carp::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 "CPAN::Meta::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 "CPAN::Meta::YAML does not support $type references";
+ }
+ }
+
+ @lines;
+}
+
+sub _write_hash {
+ my ($self, $hash, $indent, $seen) = @_;
+ if ( $seen->{refaddr($hash)}++ ) {
+ die "CPAN::Meta::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 "CPAN::Meta::YAML does not support $type references";
+ }
+ }
+
+ @lines;
+}
+
+# Set error
+sub _error {
+ $CPAN::Meta::YAML::errstr = $_[1];
+ undef;
+}
+
+# Retrieve error
+sub errstr {
+ $CPAN::Meta::YAML::errstr;
+}
+
+
+
+
+
+#####################################################################
+# YAML Compatibility
+
+sub Dump {
+ CPAN::Meta::YAML->new(@_)->write_string;
+}
+
+sub Load {
+ my $self = CPAN::Meta::YAML->read_string(@_);
+ unless ( $self ) {
+ Carp::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;
+ CPAN::Meta::YAML->new(@_)->write($file);
+}
+
+sub LoadFile {
+ my $self = CPAN::Meta::YAML->read($_[0]);
+ unless ( $self ) {
+ Carp::croak("Failed to load YAML document from '" . ($_[0] || '') . "'");
+ }
+ if ( wantarray ) {
+ return @$self;
+ } else {
+ # Return only the last document to match YAML.pm,
+ return $self->[-1];
+ }
+}
+
+
+
+
+
+#####################################################################
+# Use Scalar::Util if possible, otherwise emulate it
+
+BEGIN {
+ eval {
+ require Scalar::Util;
+ *refaddr = *Scalar::Util::refaddr;
+ };
+ eval <<'END_PERL' if $@;
+# Failed to load Scalar::Util
+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
+
+}
+
+1;
+
+
+
+=pod
+
+=head1 NAME
+
+CPAN::Meta::YAML - Read and write a subset of YAML for CPAN Meta files
+
+=head1 VERSION
+
+version 0.003
+
+=head1 SYNOPSIS
+
+ use CPAN::Meta::YAML;
+
+ # methods for files
+ $yaml = CPAN::Meta::YAML->read('META.yml');
+ $yaml->write('MYMETA.yml');
+
+ # methods for strings
+ $yaml_text = $yaml->write_string;
+ $yaml = CPAN::Meta::YAML->read_string($yaml_text);
+
+ # finding the metadata
+ my $meta = $yaml->[0];
+
+ # handling errors
+ $yaml->write($file)
+ or die CPAN::Meta::YAML->errstr;
+
+=head1 DESCRIPTION
+
+This module implements a subset of the YAML specification for use in reading
+and writing CPAN metadata files like F<META.yml> and F<MYMETA.yml>. It should
+not be used for any other general YAML parsing or generation task.
+
+=head1 SUPPORT
+
+This module is currently derived from L<YAML::Tiny> by Adam Kennedy. If
+there are bugs in how it parses a particular META.yml file, please file
+a bug report in the YAML::Tiny bugtracker:
+L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=YAML-Tiny>
+
+=head1 SEE ALSO
+
+L<YAML::Tiny>, L<YAML>, L<YAML::XS>
+
+=head1 AUTHORS
+
+=over 4
+
+=item *
+
+Adam Kennedy <adamk@cpan.org>
+
+=item *
+
+David Golden <dagolden@cpan.org>
+
+=back
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is copyright (c) 2010 by Adam Kennedy.
+
+This is free software; you can redistribute it and/or modify it under
+the same terms as the Perl 5 programming language system itself.
+
+=cut
+
+
+__END__
+
+
+# ABSTRACT: Read and write a subset of YAML for CPAN Meta files
+
+
diff --git a/Master/tlpkg/tlperl/lib/CPAN/Mirrors.pm b/Master/tlpkg/tlperl/lib/CPAN/Mirrors.pm
index 1a3402e8de5..3582b0acb4c 100644
--- a/Master/tlpkg/tlperl/lib/CPAN/Mirrors.pm
+++ b/Master/tlpkg/tlperl/lib/CPAN/Mirrors.pm
@@ -3,11 +3,12 @@
package CPAN::Mirrors;
use strict;
use vars qw($VERSION $urllist $silent);
-$VERSION = "1.77";
+$VERSION = "1.9600";
use Carp;
use FileHandle;
use Fcntl ":flock";
+use Net::Ping ();
sub new {
my ($class, $file) = @_;
@@ -63,27 +64,38 @@ sub best_mirrors {
my $conts = $args{continents} || [];
$conts = [$conts] unless ref $conts;
+ # Old Net::Ping did not do timings at all
+ return "http://www.cpan.org/" unless Net::Ping->VERSION gt '2.13';
+
my $seen = {};
if ( ! @$conts ) {
print "Searching for the best continent ...\n" if $verbose;
my @best = $self->_find_best_continent($seen, $verbose, $callback);
- # how many continents to find enough mirrors? We should scan
- # more than we need -- arbitrarily, we'll say x2
+ # Only add enough continents to find enough mirrors
my $count = 0;
for my $c ( @best ) {
push @$conts, $c;
$count += $self->mirrors( $self->countries($c) );
- last if $count >= 2 * $how_many;
+ last if $count >= $how_many;
}
}
print "Scanning " . join(", ", @$conts) . " ...\n" if $verbose;
my @timings;
- for my $m ($self->mirrors($self->countries(@$conts))) {
- next unless $m->ftp;
+ my @long_list = $self->mirrors($self->countries(@$conts));
+ my $long_list_size = ( $how_many > 10 ? $how_many : 10 );
+ if ( @long_list > $long_list_size ) {
+ @long_list = map {$_->[0]}
+ sort {$a->[1] <=> $b->[1]}
+ map {[$_, rand]} @long_list;
+ splice @long_list, $long_list_size; # truncate
+ }
+
+ for my $m ( @long_list ) {
+ next unless $m->http;
my $hostname = $m->hostname;
if ( $seen->{$hostname} ) {
push @timings, $seen->{$hostname}
@@ -97,6 +109,7 @@ sub best_mirrors {
}
}
return unless @timings;
+
$how_many = @timings if $how_many > @timings;
my @best =
map { $_->[0] }
@@ -112,7 +125,7 @@ sub _find_best_continent {
CONT: for my $c ( $self->continents ) {
my @mirrors = $self->mirrors( $self->countries($c) );
next CONT unless @mirrors;
- my $sample = 9;
+ my $sample = 3;
my $n = (@mirrors < $sample) ? @mirrors : $sample;
my @tests;
RANDOM: while ( @mirrors && @tests < $n ) {
@@ -240,7 +253,7 @@ sub rsync { shift->{rsync} || '' }
sub url {
my $self = shift;
- return $self->{ftp} || $self->{http};
+ return $self->{http} || $self->{ftp};
}
sub ping {
@@ -249,8 +262,13 @@ sub ping {
my ($proto) = $self->url =~ m{^([^:]+)};
my $port = $proto eq 'http' ? 80 : 21;
return unless $port;
+ if ( $ping->can('port_number') ) {
$ping->port_number($port);
- $ping->hires(1);
+ }
+ else {
+ $ping->{'port_num'} = $port;
+ }
+ $ping->hires(1) if $ping->can('hires');
my ($alive,$rtt) = $ping->ping($self->hostname);
return $alive ? $rtt : undef;
}
diff --git a/Master/tlpkg/tlperl/lib/CPAN/Module.pm b/Master/tlpkg/tlperl/lib/CPAN/Module.pm
index 43c42bf1049..2c0c71ae7d1 100644
--- a/Master/tlpkg/tlperl/lib/CPAN/Module.pm
+++ b/Master/tlpkg/tlperl/lib/CPAN/Module.pm
@@ -7,7 +7,7 @@ use strict;
use vars qw(
$VERSION
);
-$VERSION = "5.5";
+$VERSION = "5.5001";
BEGIN {
# alarm() is not implemented in perl 5.6.x and earlier under Windows
diff --git a/Master/tlpkg/tlperl/lib/CPAN/Queue.pm b/Master/tlpkg/tlperl/lib/CPAN/Queue.pm
index b60f57c1cfe..e5d88ce2d83 100644
--- a/Master/tlpkg/tlperl/lib/CPAN/Queue.pm
+++ b/Master/tlpkg/tlperl/lib/CPAN/Queue.pm
@@ -67,7 +67,7 @@ package CPAN::Queue;
# in CPAN::Distribution::rematein.
use vars qw{ @All $VERSION };
-$VERSION = "5.5";
+$VERSION = "5.5001";
# CPAN::Queue::queue_item ;
sub queue_item {
@@ -109,9 +109,9 @@ sub jumpqueue {
my $class = shift;
my @what = @_;
CPAN->debug(sprintf("before jumpqueue All[%s] what[%s]",
- join("",
- map {sprintf " %s\[%s]\n",$_->{qmod},$_->{reqtype}} @All, @what
- ))) if $CPAN::DEBUG;
+ join("",map {sprintf " %s\[%s]\n",$_->{qmod},$_->{reqtype}} @All),
+ join("",map {sprintf " %s\[%s]\n",$_->{qmod},$_->{reqtype}} @what),
+ )) if $CPAN::DEBUG;
unless (defined $what[0]{reqtype}) {
# apparently it was not the Shell that sent us this enquiry,
# treat it as commandline
@@ -119,7 +119,7 @@ sub jumpqueue {
}
my $inherit_reqtype = $what[0]{reqtype} =~ /^(c|r)$/ ? "r" : "b";
WHAT: for my $what_tuple (@what) {
- my($what,$reqtype) = @$what_tuple{qw(qmod reqtype)};
+ my($qmod,$reqtype) = @$what_tuple{qw(qmod reqtype)};
if ($reqtype eq "r"
&&
$inherit_reqtype eq "b"
@@ -128,26 +128,16 @@ sub jumpqueue {
}
my $jumped = 0;
for (my $i=0; $i<$#All;$i++) { #prevent deep recursion
- # CPAN->debug("i[$i]this[$All[$i]{qmod}]what[$what]") if $CPAN::DEBUG;
- if ($All[$i]{qmod} eq $what) {
+ if ($All[$i]{qmod} eq $qmod) {
$jumped++;
- if ($jumped >= 50) {
- die "PANIC: object[$what] 50 instances on the queue, looks like ".
- "some recursiveness has hit";
- } elsif ($jumped > 25) { # one's OK if e.g. just processing
- # now; more are OK if user typed
- # it several times
- my $sleep = sprintf "%.1f", $jumped/10;
- $CPAN::Frontend->mywarn(
-qq{Warning: Object [$what] queued $jumped times, sleeping $sleep secs!\n}
- );
- $CPAN::Frontend->mysleep($sleep);
- # next WHAT;
- }
}
}
+ # high jumped values are normal for popular modules when
+ # dealing with large bundles: XML::Simple,
+ # namespace::autoclean, UNIVERSAL::require
+ CPAN->debug("qmod[$qmod]jumped[$jumped]") if $CPAN::DEBUG;
my $obj = "$class\::Item"->new(
- qmod => $what,
+ qmod => $qmod,
reqtype => $reqtype
);
unshift @All, $obj;
@@ -186,6 +176,27 @@ sub size {
return scalar @All;
}
+sub reqtype_of {
+ my($self,$mod) = @_;
+ my $best = "";
+ for my $item (grep { $_->{qmod} eq $mod } @All) {
+ my $c = $item->{reqtype};
+ if ($c eq "c") {
+ $best = $c;
+ last;
+ } elsif ($c eq "r") {
+ $best = $c;
+ } elsif ($c eq "b") {
+ if ($best eq "") {
+ $best = $c;
+ }
+ } else {
+ die "Panic: in reqtype_of: reqtype[$c] seen, should never happen";
+ }
+ }
+ return $best;
+}
+
1;
__END__
diff --git a/Master/tlpkg/tlperl/lib/CPAN/Shell.pm b/Master/tlpkg/tlperl/lib/CPAN/Shell.pm
index 91cbdd22ac8..9effb0d2e70 100644
--- a/Master/tlpkg/tlperl/lib/CPAN/Shell.pm
+++ b/Master/tlpkg/tlperl/lib/CPAN/Shell.pm
@@ -47,7 +47,7 @@ use vars qw(
"CPAN/Tarzip.pm",
"CPAN/Version.pm",
);
-$VERSION = "5.5001";
+$VERSION = "5.5002";
# record the initial timestamp for reload.
$reload = { map {$INC{$_} ? ($_,(stat $INC{$_})[9]) : ()} @relo };
@CPAN::Shell::ISA = qw(CPAN::Debug);
@@ -375,16 +375,8 @@ sub o {
$cfilter ||= "";
my $qrfilter = eval 'qr/$cfilter/';
my($k,$v);
- $CPAN::Frontend->myprint("\$CPAN::Config options from ");
- my @from;
- if (exists $INC{'CPAN/Config.pm'}) {
- push @from, $INC{'CPAN/Config.pm'};
- }
- if (exists $INC{'CPAN/MyConfig.pm'}) {
- push @from, $INC{'CPAN/MyConfig.pm'};
- }
- $CPAN::Frontend->myprint(join " and ", map {"'$_'"} @from);
- $CPAN::Frontend->myprint(":\n");
+ my $configpm = CPAN::HandleConfig->require_myconfig_or_config;
+ $CPAN::Frontend->myprint("\$CPAN::Config options from $configpm\:\n");
for $k (sort keys %CPAN::HandleConfig::can) {
next unless $k =~ /$qrfilter/;
$v = $CPAN::HandleConfig::can{$k};
@@ -655,22 +647,21 @@ sub _reload_this {
#-> sub CPAN::Shell::mkmyconfig ;
sub mkmyconfig {
- my($self, $cpanpm, %args) = @_;
+ my($self) = @_;
+ if ( my $configpm = $INC{'CPAN/MyConfig.pm'} ) {
+ $CPAN::Frontend->myprint(
+ "CPAN::MyConfig already exists as $configpm.\n" .
+ "Running configuration again...\n"
+ );
require CPAN::FirstTime;
- my $home = CPAN::HandleConfig::home();
- $cpanpm = $INC{'CPAN/MyConfig.pm'} ||
- File::Spec->catfile(split /\//, "$home/.cpan/CPAN/MyConfig.pm");
- File::Path::mkpath(File::Basename::dirname($cpanpm)) unless -e $cpanpm;
- CPAN::HandleConfig::require_myconfig_or_config();
- $CPAN::Config ||= {};
- $CPAN::Config = {
- %$CPAN::Config,
- build_dir => undef,
- cpan_home => undef,
- keep_source_where => undef,
- histfile => undef,
- };
- CPAN::FirstTime::init($cpanpm, %args);
+ CPAN::FirstTime::init($configpm);
+ }
+ else {
+ # force some missing values to be filled in with defaults
+ delete $CPAN::Config->{$_}
+ for qw/build_dir cpan_home keep_source_where histfile/;
+ CPAN::HandleConfig->load( make_myconfig => 1 );
+ }
}
#-> sub CPAN::Shell::_binary_extensions ;
@@ -1456,6 +1447,7 @@ sub print_ornamented {
local $| = 1; # Flush immediately
if ( $CPAN::Be_Silent ) {
+ # WARNING: variable Be_Silent is poisoned and must be eliminated.
print {report_fh()} $what;
return;
}
diff --git a/Master/tlpkg/tlperl/lib/CPAN/Tarzip.pm b/Master/tlpkg/tlperl/lib/CPAN/Tarzip.pm
index 63451e7450d..972df6ca06f 100644
--- a/Master/tlpkg/tlperl/lib/CPAN/Tarzip.pm
+++ b/Master/tlpkg/tlperl/lib/CPAN/Tarzip.pm
@@ -253,14 +253,21 @@ sub untar {
if (0) { # makes changing order easier
} elsif ($BUGHUNTING) {
$prefer=2;
- } elsif ($exttar && $extgzip && $file =~ /\.(?:bz2|tbz)$/i) {
- # until Archive::Tar handles bzip2
+ } elsif ($CPAN::Config->{prefer_external_tar}) {
$prefer = 1;
} elsif (
$CPAN::META->has_usable("Archive::Tar")
&&
$CPAN::META->has_inst("Compress::Zlib") ) {
- $prefer = 2;
+ my $prefer_external_tar = $CPAN::Config->{prefer_external_tar};
+ unless (defined $prefer_external_tar) {
+ if ($^O =~ /(MSWin32|solaris)/) {
+ $prefer_external_tar = 0;
+ } else {
+ $prefer_external_tar = 1;
+ }
+ }
+ $prefer = $prefer_external_tar ? 1 : 2;
} elsif ($exttar && $extgzip) {
# no modules and not bz2
$prefer = 1;
diff --git a/Master/tlpkg/tlperl/lib/CPAN/Version.pm b/Master/tlpkg/tlperl/lib/CPAN/Version.pm
index da876aac2d7..43aaa1ce911 100644
--- a/Master/tlpkg/tlperl/lib/CPAN/Version.pm
+++ b/Master/tlpkg/tlperl/lib/CPAN/Version.pm
@@ -2,7 +2,7 @@ package CPAN::Version;
use strict;
use vars qw($VERSION);
-$VERSION = "5.5";
+$VERSION = "5.5001";
# CPAN::Version::vcmp courtesy Jost Krieger
sub vcmp {
@@ -57,7 +57,7 @@ sub vgt {
sub vlt {
my($self,$l,$r) = @_;
- 0 + ($self->vcmp($l,$r) < 0);
+ $self->vcmp($l,$r) < 0;
}
sub vge {
@@ -67,7 +67,7 @@ sub vge {
sub vle {
my($self,$l,$r) = @_;
- 0 + ($self->vcmp($l,$r) <= 0);
+ $self->vcmp($l,$r) <= 0;
}
sub vstring {