summaryrefslogtreecommitdiff
path: root/Master/tlpkg/tlperl/lib/CPAN/Meta/Converter.pm
diff options
context:
space:
mode:
Diffstat (limited to 'Master/tlpkg/tlperl/lib/CPAN/Meta/Converter.pm')
-rw-r--r--Master/tlpkg/tlperl/lib/CPAN/Meta/Converter.pm118
1 files changed, 73 insertions, 45 deletions
diff --git a/Master/tlpkg/tlperl/lib/CPAN/Meta/Converter.pm b/Master/tlpkg/tlperl/lib/CPAN/Meta/Converter.pm
index 2c6ce857d3d..0348e55504e 100644
--- a/Master/tlpkg/tlperl/lib/CPAN/Meta/Converter.pm
+++ b/Master/tlpkg/tlperl/lib/CPAN/Meta/Converter.pm
@@ -2,15 +2,29 @@ use 5.006;
use strict;
use warnings;
package CPAN::Meta::Converter;
-BEGIN {
- $CPAN::Meta::Converter::VERSION = '2.110440';
-}
-# ABSTRACT: Convert CPAN distribution metadata structures
+our $VERSION = '2.120630'; # VERSION
use CPAN::Meta::Validator;
-use Storable qw/dclone/;
-use version 0.82 ();
+use CPAN::Meta::Requirements;
+use version 0.88 ();
+use Parse::CPAN::Meta 1.4400 ();
+
+sub _dclone {
+ my $ref = shift;
+
+ # if an object is in the data structure and doesn't specify how to
+ # turn itself into JSON, we just stringify the object. That does the
+ # right thing for typical things that might be there, like version objects,
+ # Path::Class objects, etc.
+ no warnings 'once';
+ local *UNIVERSAL::TO_JSON = sub { return "$_[0]" };
+
+ my $backend = Parse::CPAN::Meta->json_backend();
+ return $backend->new->utf8->decode(
+ $backend->new->utf8->allow_blessed->convert_blessed->encode($ref)
+ );
+}
my %known_specs = (
'2' => 'http://search.cpan.org/perldoc?CPAN::Meta::Spec',
@@ -134,15 +148,18 @@ my @valid_licenses_2 = qw(
unknown
);
+# The "old" values were defined by Module::Build, and were often vague. I have
+# made the decisions below based on reading Module::Build::API and how clearly
+# it specifies the version of the license.
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',
+ (map { $_ => $_ } @valid_licenses_2),
+ apache => 'apache_2_0', # clearly stated as 2.0
+ artistic => 'artistic_1', # clearly stated as 1
+ artistic2 => 'artistic_2', # clearly stated as 2
+ gpl => 'open_source', # we don't know which GPL; punt
+ lgpl => 'open_source', # we don't know which LGPL; punt
+ mozilla => 'open_source', # we don't know which MPL; punt
+ perl => 'perl_5', # clearly Perl 5
restrictive => 'restricted',
);
@@ -300,7 +317,10 @@ sub _clean_version {
return 0 if ! length $element;
return 0 if ( $element eq 'undef' || $element eq '<undef>' );
- if ( my $v = eval { version->new($element) } ) {
+ my $v = eval { version->new($element) };
+ # XXX check defined $v and not just $v because version objects leak memory
+ # in boolean context -- dagolden, 2012-02-03
+ if ( defined $v ) {
return $v->is_qv ? $v->normal : $element;
}
else {
@@ -308,29 +328,36 @@ sub _clean_version {
}
}
+sub _bad_version_hook {
+ my ($v) = @_;
+ $v =~ s{[a-z]+$}{}; # strip trailing alphabetics
+ my $vobj = eval { version->parse($v) };
+ return defined($vobj) ? $vobj : version->parse(0); # or give up
+}
+
sub _version_map {
my ($element) = @_;
- return undef unless defined $element;
+ return unless defined $element;
if ( ref $element eq 'HASH' ) {
- my $new_map = {};
- for my $k ( keys %$element ) {
+ # XXX turn this into CPAN::Meta::Requirements with bad version hook
+ # and then turn it back into a hash
+ my $new_map = CPAN::Meta::Requirements->new(
+ { bad_version_hook => sub { version->new(0) } } # punt
+ );
+ while ( my ($k,$v) = each %$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;
+ if ( !defined($v) || !length($v) || $v eq 'undef' || $v eq '<undef>' ) {
+ $v = 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);
+ # some weird, old META have bad yml with module => module
+ # so check if value is like a module name and not like a version
+ if ( _is_module_name($v) && ! version::is_lax($v) ) {
+ $new_map->add_minimum($k => 0);
+ $new_map->add_minimum($v => 0);
}
+ $new_map->add_string_requirement($k => $v);
}
- return $new_map;
+ return $new_map->as_string_hash;
}
elsif ( ref $element eq 'ARRAY' ) {
my $hashref = { map { $_ => 0 } @$element };
@@ -413,9 +440,8 @@ sub _get_build_requires {
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);
+ my $test_req = CPAN::Meta::Requirements->from_string_hash($test_h);
+ my $build_req = CPAN::Meta::Requirements->from_string_hash($build_h);
$test_req->add_requirements($build_req)->as_string_hash;
}
@@ -423,12 +449,12 @@ sub _get_build_requires {
sub _extract_prereqs {
my ($prereqs, $phase, $type) = @_;
return unless ref $prereqs eq 'HASH';
- return $prereqs->{$phase}{$type};
+ return scalar _version_map($prereqs->{$phase}{$type});
}
sub _downgrade_optional_features {
my (undef, undef, $meta) = @_;
- return undef unless exists $meta->{optional_features};
+ return unless exists $meta->{optional_features};
my $origin = $meta->{optional_features};
my $features = {};
for my $name ( keys %$origin ) {
@@ -449,7 +475,7 @@ sub _downgrade_optional_features {
sub _upgrade_optional_features {
my (undef, undef, $meta) = @_;
- return undef unless exists $meta->{optional_features};
+ return unless exists $meta->{optional_features};
my $origin = $meta->{optional_features};
my $features = {};
for my $name ( keys %$origin ) {
@@ -545,7 +571,7 @@ my $resource2_upgrade = {
return unless $item;
if ( $item =~ m{^mailto:(.*)$} ) { return { mailto => $1 } }
elsif( _is_urlish($item) ) { return { web => $item } }
- else { return undef }
+ else { return }
},
repository => sub { return _is_urlish($_[0]) ? { url => $_[0] } : undef },
':custom' => \&_prefix_custom,
@@ -553,7 +579,7 @@ my $resource2_upgrade = {
sub _upgrade_resources_2 {
my (undef, undef, $meta, $version) = @_;
- return undef unless exists $meta->{resources};
+ return unless exists $meta->{resources};
return _convert($meta->{resources}, $resource2_upgrade);
}
@@ -591,7 +617,7 @@ my $resources2_cleanup = {
sub _cleanup_resources_2 {
my ($resources, $key, $meta, $to_version) = @_;
- return undef unless $resources && ref $resources eq 'HASH';
+ return unless $resources && ref $resources eq 'HASH';
return _convert($resources, $resources2_cleanup, $to_version);
}
@@ -605,7 +631,7 @@ my $resource1_spec = {
sub _resources_1_3 {
my (undef, undef, $meta, $version) = @_;
- return undef unless exists $meta->{resources};
+ return unless exists $meta->{resources};
return _convert($meta->{resources}, $resource1_spec);
}
@@ -618,7 +644,7 @@ sub _resources_1_2 {
$resources->{license} = $meta->license_url
if _is_urlish($meta->{license_url});
}
- return undef unless keys %$resources;
+ return unless keys %$resources;
return _convert($resources, $resource1_spec);
}
@@ -632,7 +658,7 @@ my $resource_downgrade_spec = {
sub _downgrade_resources {
my (undef, undef, $meta, $version) = @_;
- return undef unless exists $meta->{resources};
+ return unless exists $meta->{resources};
return _convert($meta->{resources}, $resource_downgrade_spec);
}
@@ -1187,7 +1213,7 @@ sub convert {
my $new_version = $args->{version} || $HIGHEST;
my ($old_version) = $self->{spec};
- my $converted = dclone $self->{data};
+ my $converted = _dclone($self->{data});
if ( $old_version == $new_version ) {
$converted = _convert( $converted, $cleanup{$old_version}, $old_version );
@@ -1232,6 +1258,8 @@ sub convert {
1;
+# ABSTRACT: Convert CPAN distribution metadata structures
+
=pod
@@ -1242,7 +1270,7 @@ CPAN::Meta::Converter - Convert CPAN distribution metadata structures
=head1 VERSION
-version 2.110440
+version 2.120630
=head1 SYNOPSIS