summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--MANIFEST2
-rw-r--r--META.json2
-rw-r--r--META.yml2
-rwxr-xr-xPorting/Maintainers.pl3
-rw-r--r--cpan/CPAN-Meta/lib/CPAN/Meta.pm4
-rw-r--r--cpan/CPAN-Meta/lib/CPAN/Meta/Converter.pm24
-rw-r--r--cpan/CPAN-Meta/lib/CPAN/Meta/Feature.pm4
-rw-r--r--cpan/CPAN-Meta/lib/CPAN/Meta/History.pm4
-rw-r--r--cpan/CPAN-Meta/lib/CPAN/Meta/Merge.pm248
-rw-r--r--cpan/CPAN-Meta/lib/CPAN/Meta/Prereqs.pm4
-rw-r--r--cpan/CPAN-Meta/lib/CPAN/Meta/Spec.pm4
-rw-r--r--cpan/CPAN-Meta/lib/CPAN/Meta/Validator.pm4
-rw-r--r--cpan/CPAN-Meta/t/merge.t118
13 files changed, 398 insertions, 25 deletions
diff --git a/MANIFEST b/MANIFEST
index 1bb915fa85..47a0a8df1c 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -232,6 +232,7 @@ cpan/CPAN/lib/CPAN/Version.pm Simple math with different flavors of version str
cpan/CPAN-Meta/lib/CPAN/Meta/Converter.pm
cpan/CPAN-Meta/lib/CPAN/Meta/Feature.pm
cpan/CPAN-Meta/lib/CPAN/Meta/History.pm
+cpan/CPAN-Meta/lib/CPAN/Meta/Merge.pm
cpan/CPAN-Meta/lib/CPAN/Meta.pm
cpan/CPAN-Meta/lib/CPAN/Meta/Prereqs.pm
cpan/CPAN-Meta/lib/CPAN/Meta/Spec.pm
@@ -296,6 +297,7 @@ cpan/CPAN-Meta/t/data-valid/META-1_0.yml
cpan/CPAN-Meta/t/data-valid/META-1_1.yml
cpan/CPAN-Meta/t/data-valid/scalar-meta-spec.yml
cpan/CPAN-Meta/t/load-bad.t
+cpan/CPAN-Meta/t/merge.t
cpan/CPAN-Meta/t/meta-obj.t
cpan/CPAN-Meta/t/no-index.t
cpan/CPAN-Meta/t/prereqs-finalize.t
diff --git a/META.json b/META.json
index d639e63b1d..24a4d11ae8 100644
--- a/META.json
+++ b/META.json
@@ -4,7 +4,7 @@
"perl5-porters@perl.org"
],
"dynamic_config" : 1,
- "generated_by" : "CPAN::Meta version 2.141520",
+ "generated_by" : "CPAN::Meta version 2.142060",
"license" : [
"perl_5"
],
diff --git a/META.yml b/META.yml
index 474ba24e22..f521122a4e 100644
--- a/META.yml
+++ b/META.yml
@@ -4,7 +4,7 @@ author:
- perl5-porters@perl.org
build_requires: {}
dynamic_config: 1
-generated_by: 'CPAN::Meta version 2.141520, CPAN::Meta::Converter version 2.141520'
+generated_by: 'CPAN::Meta version 2.142060, CPAN::Meta::Converter version 2.142060'
license: perl
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.4.html
diff --git a/Porting/Maintainers.pl b/Porting/Maintainers.pl
index 11aa1a9f68..b6cbbc3b1f 100755
--- a/Porting/Maintainers.pl
+++ b/Porting/Maintainers.pl
@@ -282,10 +282,11 @@ use File::Glob qw(:case);
# Note: When updating CPAN-Meta the META.* files will need to be regenerated
# perl -Icpan/CPAN-Meta/lib Porting/makemeta
'CPAN::Meta' => {
- 'DISTRIBUTION' => 'DAGOLDEN/CPAN-Meta-2.141520.tar.gz',
+ 'DISTRIBUTION' => 'DAGOLDEN/CPAN-Meta-2.142060.tar.gz',
'FILES' => q[cpan/CPAN-Meta],
'EXCLUDED' => [
qw[t/00-report-prereqs.t],
+ qw[t/00-report-prereqs.dd],
qr{t/README-data.txt},
qr{^xt},
qr{^history},
diff --git a/cpan/CPAN-Meta/lib/CPAN/Meta.pm b/cpan/CPAN-Meta/lib/CPAN/Meta.pm
index 1b6723f1ce..0c9048aa9f 100644
--- a/cpan/CPAN-Meta/lib/CPAN/Meta.pm
+++ b/cpan/CPAN-Meta/lib/CPAN/Meta.pm
@@ -2,7 +2,7 @@ use 5.006;
use strict;
use warnings;
package CPAN::Meta;
-our $VERSION = '2.141520'; # VERSION
+our $VERSION = '2.142060'; # VERSION
#pod =head1 SYNOPSIS
#pod
@@ -641,7 +641,7 @@ CPAN::Meta - the distribution metadata for a CPAN dist
=head1 VERSION
-version 2.141520
+version 2.142060
=head1 SYNOPSIS
diff --git a/cpan/CPAN-Meta/lib/CPAN/Meta/Converter.pm b/cpan/CPAN-Meta/lib/CPAN/Meta/Converter.pm
index 0b2d83c4be..83b6c59616 100644
--- a/cpan/CPAN-Meta/lib/CPAN/Meta/Converter.pm
+++ b/cpan/CPAN-Meta/lib/CPAN/Meta/Converter.pm
@@ -2,7 +2,7 @@ use 5.006;
use strict;
use warnings;
package CPAN::Meta::Converter;
-our $VERSION = '2.141520'; # VERSION
+our $VERSION = '2.142060'; # VERSION
#pod =head1 SYNOPSIS
#pod
@@ -741,12 +741,15 @@ sub _provides {
}
sub _convert {
- my ($data, $spec, $to_version) = @_;
+ my ($data, $spec, $to_version, $is_fragment) = @_;
my $new_data = {};
for my $key ( keys %$spec ) {
next if $key eq ':custom' || $key eq ':drop';
next unless my $fcn = $spec->{$key};
+ if ( $is_fragment && $key eq 'generated_by' ) {
+ $fcn = \&_keep;
+ }
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);
@@ -1384,13 +1387,14 @@ sub convert {
my $args = { %args };
my $new_version = $args->{version} || $HIGHEST;
+ my $is_fragment = $args->{is_fragment};
my ($old_version) = $self->{spec};
my $converted = _dclone($self->{data});
if ( $old_version == $new_version ) {
- $converted = _convert( $converted, $cleanup{$old_version}, $old_version );
- unless ( $args->{no_validation} ) {
+ $converted = _convert( $converted, $cleanup{$old_version}, $old_version, $is_fragment );
+ unless ( $args->{is_fragment} ) {
my $cmv = CPAN::Meta::Validator->new( $converted );
unless ( $cmv->is_valid ) {
my $errs = join("\n", $cmv->errors);
@@ -1405,8 +1409,8 @@ sub convert {
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] );
- unless ( $args->{no_validation} ) {
+ $converted = _convert( $converted, $down_convert{$spec_string}, $vers[$i+1], $is_fragment );
+ unless ( $args->{is_fragment} ) {
my $cmv = CPAN::Meta::Validator->new( $converted );
unless ( $cmv->is_valid ) {
my $errs = join("\n", $cmv->errors);
@@ -1422,8 +1426,8 @@ sub convert {
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] );
- unless ( $args->{no_validation} ) {
+ $converted = _convert( $converted, $up_convert{$spec_string}, $vers[$i+1], $is_fragment );
+ unless ( $args->{is_fragment} ) {
my $cmv = CPAN::Meta::Validator->new( $converted );
unless ( $cmv->is_valid ) {
my $errs = join("\n", $cmv->errors);
@@ -1453,7 +1457,7 @@ sub upgrade_fragment {
grep { defined }
map { $fragments_generate{$old_version}{$_} }
keys %{ $self->{data} };
- my $converted = $self->convert( version => $HIGHEST, no_validation => 1 );
+ my $converted = $self->convert( version => $HIGHEST, is_fragment => 1 );
for my $key ( keys %$converted ) {
next if $key =~ /^x_/i || $key eq 'meta-spec';
delete $converted->{$key} unless $expected{$key};
@@ -1475,7 +1479,7 @@ CPAN::Meta::Converter - Convert CPAN distribution metadata structures
=head1 VERSION
-version 2.141520
+version 2.142060
=head1 SYNOPSIS
diff --git a/cpan/CPAN-Meta/lib/CPAN/Meta/Feature.pm b/cpan/CPAN-Meta/lib/CPAN/Meta/Feature.pm
index 52e3e93b54..db4f1ce255 100644
--- a/cpan/CPAN-Meta/lib/CPAN/Meta/Feature.pm
+++ b/cpan/CPAN-Meta/lib/CPAN/Meta/Feature.pm
@@ -2,7 +2,7 @@ use 5.006;
use strict;
use warnings;
package CPAN::Meta::Feature;
-our $VERSION = '2.141520'; # VERSION
+our $VERSION = '2.142060'; # VERSION
use CPAN::Meta::Prereqs;
@@ -78,7 +78,7 @@ CPAN::Meta::Feature - an optional feature provided by a CPAN distribution
=head1 VERSION
-version 2.141520
+version 2.142060
=head1 DESCRIPTION
diff --git a/cpan/CPAN-Meta/lib/CPAN/Meta/History.pm b/cpan/CPAN-Meta/lib/CPAN/Meta/History.pm
index c28273a731..9d6c660820 100644
--- a/cpan/CPAN-Meta/lib/CPAN/Meta/History.pm
+++ b/cpan/CPAN-Meta/lib/CPAN/Meta/History.pm
@@ -3,7 +3,7 @@ use 5.006;
use strict;
use warnings;
package CPAN::Meta::History;
-our $VERSION = '2.141520'; # VERSION
+our $VERSION = '2.142060'; # VERSION
1;
@@ -21,7 +21,7 @@ CPAN::Meta::History - history of CPAN Meta Spec changes
=head1 VERSION
-version 2.141520
+version 2.142060
=head1 DESCRIPTION
diff --git a/cpan/CPAN-Meta/lib/CPAN/Meta/Merge.pm b/cpan/CPAN-Meta/lib/CPAN/Meta/Merge.pm
new file mode 100644
index 0000000000..5648d77647
--- /dev/null
+++ b/cpan/CPAN-Meta/lib/CPAN/Meta/Merge.pm
@@ -0,0 +1,248 @@
+package CPAN::Meta::Merge;
+
+use strict;
+use warnings;
+
+our $VERSION = '2.142060'; # VERSION
+
+use Carp qw/croak/;
+use Scalar::Util qw/blessed/;
+use CPAN::Meta::Converter;
+
+sub _identical {
+ my ($left, $right, $path) = @_;
+ croak "Can't merge attribute " . join '.', @{$path} unless $left eq $right;
+ return $left;
+}
+
+sub _merge {
+ my ($current, $next, $mergers, $path) = @_;
+ for my $key (keys %{$next}) {
+ if (not exists $current->{$key}) {
+ $current->{$key} = $next->{$key};
+ }
+ elsif (my $merger = $mergers->{$key}) {
+ $current->{$key} = $merger->($current->{$key}, $next->{$key}, [ @{$path}, $key ]);
+ }
+ elsif ($merger = $mergers->{':default'}) {
+ $current->{$key} = $merger->($current->{$key}, $next->{$key}, [ @{$path}, $key ]);
+ }
+ else {
+ croak sprintf "Can't merge unknown attribute '%s'", join '.', @{$path}, $key;
+ }
+ }
+ return $current;
+}
+
+sub _uniq {
+ my %seen = ();
+ return grep { not $seen{$_}++ } @_;
+}
+
+sub _set_addition {
+ my ($left, $right) = @_;
+ return [ +_uniq(@{$left}, @{$right}) ];
+}
+
+sub _uniq_map {
+ my ($left, $right, $path) = @_;
+ for my $key (keys %{$right}) {
+ if (not exists $left->{$key}) {
+ $left->{$key} = $right->{$key};
+ }
+ else {
+ croak 'Duplication of element ' . join '.', @{$path}, $key;
+ }
+ }
+ return $left;
+}
+
+sub _improvize {
+ my ($left, $right, $path) = @_;
+ my ($name) = reverse @{$path};
+ if ($name =~ /^x_/) {
+ if (ref($left) eq 'ARRAY') {
+ return _set_addition($left, $right, $path);
+ }
+ elsif (ref($left) eq 'HASH') {
+ return _uniq_map($left, $right, $path);
+ }
+ else {
+ return _identical($left, $right, $path);
+ }
+ }
+ croak sprintf "Can't merge '%s'", join '.', @{$path};
+}
+
+my %default = (
+ abstract => \&_identical,
+ author => \&_set_addition,
+ dynamic_config => sub {
+ my ($left, $right) = @_;
+ return $left || $right;
+ },
+ generated_by => sub {
+ my ($left, $right) = @_;
+ return join ', ', _uniq(split(/, /, $left), split(/, /, $right));
+ },
+ license => \&_set_addition,
+ 'meta-spec' => {
+ version => \&_identical,
+ url => \&_identical
+ },
+ name => \&_identical,
+ release_status => \&_identical,
+ version => \&_identical,
+ description => \&_identical,
+ keywords => \&_set_addition,
+ no_index => { map { ($_ => \&_set_addition) } qw/file directory package namespace/ },
+ optional_features => \&_uniq_map,
+ prereqs => sub {
+ require CPAN::Meta::Prereqs;
+ my ($left, $right) = map { CPAN::Meta::Prereqs->new($_) } @_[0,1];
+ return $left->with_merged_prereqs($right)->as_string_hash;
+ },
+ provides => \&_uniq_map,
+ resources => {
+ license => \&_set_addition,
+ homepage => \&_identical,
+ bugtracker => \&_uniq_map,
+ repository => \&_uniq_map,
+ ':default' => \&_improvize,
+ },
+ ':default' => \&_improvize,
+);
+
+sub new {
+ my ($class, %arguments) = @_;
+ croak 'default version required' if not exists $arguments{default_version};
+ my %mapping = %default;
+ my %extra = %{ $arguments{extra_mappings} || {} };
+ for my $key (keys %extra) {
+ if (ref($mapping{$key}) eq 'HASH') {
+ $mapping{$key} = { %{ $mapping{$key} }, %{ $extra{$key} } };
+ }
+ else {
+ $mapping{$key} = $extra{$key};
+ }
+ }
+ return bless {
+ default_version => $arguments{default_version},
+ mapping => _coerce_mapping(\%mapping, []),
+ }, $class;
+}
+
+my %coderef_for = (
+ set_addition => \&_set_addition,
+ uniq_map => \&_uniq_map,
+ identical => \&_identical,
+ improvize => \&_improvize,
+);
+
+sub _coerce_mapping {
+ my ($orig, $map_path) = @_;
+ my %ret;
+ for my $key (keys %{$orig}) {
+ my $value = $orig->{$key};
+ if (ref($orig->{$key}) eq 'CODE') {
+ $ret{$key} = $value;
+ }
+ elsif (ref($value) eq 'HASH') {
+ my $mapping = _coerce_mapping($value, [ @{$map_path}, $key ]);
+ $ret{$key} = sub {
+ my ($left, $right, $path) = @_;
+ return _merge($left, $right, $mapping, [ @{$path}, $key ]);
+ };
+ }
+ elsif ($coderef_for{$value}) {
+ $ret{$key} = $coderef_for{$value};
+ }
+ else {
+ croak "Don't know what to do with " . join '.', @{$map_path}, $key;
+ }
+ }
+ return \%ret;
+}
+
+sub merge {
+ my ($self, @items) = @_;
+ my $current = {};
+ for my $next (@items) {
+ if ( blessed($next) && $next->isa('CPAN::Meta') ) {
+ $next = $next->as_string_hash;
+ }
+ elsif ( ref($next) eq 'HASH' ) {
+ my $cmc = CPAN::Meta::Converter->new(
+ $next, default_version => $self->{default_version}
+ );
+ $next = $cmc->upgrade_fragment;
+ }
+ else {
+ croak "Don't know how to merge '$next'";
+ }
+ $current = _merge($current, $next, $self->{mapping}, []);
+ }
+ return $current;
+}
+
+1;
+
+# ABSTRACT: Merging CPAN Meta fragments
+
+__END__
+
+=pod
+
+=encoding UTF-8
+
+=head1 NAME
+
+CPAN::Meta::Merge - Merging CPAN Meta fragments
+
+=head1 VERSION
+
+version 2.142060
+
+=head1 SYNOPSIS
+
+ my $merger = CPAN::Meta::Merge->new(default_version => "2");
+ my $meta = $merger->merge($base, @additional);
+
+=head1 DESCRIPTION
+
+=head1 METHODS
+
+=head2 new
+
+This creates a CPAN::Meta::Merge object. It takes one mandatory named
+argument, C<version>, declaring the version of the meta-spec that must be
+used for the merge. It can optionally take an C<extra_mappings> argument
+that allows one to add additional merging functions for specific elements.
+
+=head2 merge(@fragments)
+
+Merge all C<@fragments> together. It will accept both CPAN::Meta objects and
+(possibly incomplete) hashrefs of metadata.
+
+=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/cpan/CPAN-Meta/lib/CPAN/Meta/Prereqs.pm b/cpan/CPAN-Meta/lib/CPAN/Meta/Prereqs.pm
index 0535f7489f..60248b9f11 100644
--- a/cpan/CPAN-Meta/lib/CPAN/Meta/Prereqs.pm
+++ b/cpan/CPAN-Meta/lib/CPAN/Meta/Prereqs.pm
@@ -2,7 +2,7 @@ use 5.006;
use strict;
use warnings;
package CPAN::Meta::Prereqs;
-our $VERSION = '2.141520'; # VERSION
+our $VERSION = '2.142060'; # VERSION
#pod =head1 DESCRIPTION
#pod
@@ -286,7 +286,7 @@ CPAN::Meta::Prereqs - a set of distribution prerequisites by phase and type
=head1 VERSION
-version 2.141520
+version 2.142060
=head1 DESCRIPTION
diff --git a/cpan/CPAN-Meta/lib/CPAN/Meta/Spec.pm b/cpan/CPAN-Meta/lib/CPAN/Meta/Spec.pm
index ce5eafb288..873580da9d 100644
--- a/cpan/CPAN-Meta/lib/CPAN/Meta/Spec.pm
+++ b/cpan/CPAN-Meta/lib/CPAN/Meta/Spec.pm
@@ -7,7 +7,7 @@ use 5.006;
use strict;
use warnings;
package CPAN::Meta::Spec;
-our $VERSION = '2.141520'; # VERSION
+our $VERSION = '2.142060'; # VERSION
1;
@@ -28,7 +28,7 @@ CPAN::Meta::Spec - specification for CPAN distribution metadata
=head1 VERSION
-version 2.141520
+version 2.142060
=head1 SYNOPSIS
diff --git a/cpan/CPAN-Meta/lib/CPAN/Meta/Validator.pm b/cpan/CPAN-Meta/lib/CPAN/Meta/Validator.pm
index 21cf2951a6..7f08de7091 100644
--- a/cpan/CPAN-Meta/lib/CPAN/Meta/Validator.pm
+++ b/cpan/CPAN-Meta/lib/CPAN/Meta/Validator.pm
@@ -2,7 +2,7 @@ use 5.006;
use strict;
use warnings;
package CPAN::Meta::Validator;
-our $VERSION = '2.141520'; # VERSION
+our $VERSION = '2.142060'; # VERSION
#pod =head1 SYNOPSIS
#pod
@@ -997,7 +997,7 @@ CPAN::Meta::Validator - validate CPAN distribution metadata structures
=head1 VERSION
-version 2.141520
+version 2.142060
=head1 SYNOPSIS
diff --git a/cpan/CPAN-Meta/t/merge.t b/cpan/CPAN-Meta/t/merge.t
new file mode 100644
index 0000000000..77ae09f8be
--- /dev/null
+++ b/cpan/CPAN-Meta/t/merge.t
@@ -0,0 +1,118 @@
+#! perl
+
+use strict;
+use warnings;
+
+use Test::More;
+use CPAN::Meta::Merge;
+
+my %base = (
+ abstract => 'This is a test',
+ author => ['A.U. Thor'],
+ generated_by => 'Myself',
+ license => [ 'perl_5' ],
+ resources => {
+ license => [ 'http://dev.perl.org/licenses/' ],
+ },
+ prereqs => {
+ runtime => {
+ requires => {
+ Foo => '0',
+ },
+ },
+ },
+ dynamic_config => 0,
+ provides => {
+ Baz => {
+ file => 'lib/Baz.pm',
+ },
+ },
+ 'meta-spec' => {
+ url => "http://search.cpan.org/perldoc?CPAN::Meta::Spec",
+ version => 2,
+ },
+);
+
+my %first = (
+ author => [ 'I.M. Poster' ],
+ generated_by => 'Some other guy',
+ license => [ 'bsd' ],
+ resources => {
+ license => [ 'http://opensource.org/licenses/bsd-license.php' ],
+ },
+ prereqs => {
+ runtime => {
+ requires => {
+ Foo => '< 1',
+ },
+ recommends => {
+ Bar => '3.14',
+ },
+ },
+ test => {
+ requires => {
+ 'Test::Bar' => 0,
+ },
+ },
+ },
+ dynamic_config => 1,
+ provides => {
+ Quz => {
+ file => 'lib/Quz.pm',
+ },
+ },
+);
+my %first_expected = (
+ abstract => 'This is a test',
+ author => [ 'A.U. Thor', 'I.M. Poster' ],
+ generated_by => 'Myself, Some other guy',
+ license => [ 'perl_5', 'bsd' ],
+ resources => {
+ license => [ 'http://dev.perl.org/licenses/', 'http://opensource.org/licenses/bsd-license.php' ],
+ },
+ prereqs => {
+ runtime => {
+ requires => {
+ Foo => '>= 0, < 1',
+ },
+ recommends => {
+ Bar => '3.14',
+ },
+ },
+ test => {
+ requires => {
+ 'Test::Bar' => 0,
+ },
+ },
+ },
+ provides => {
+ Baz => {
+ file => 'lib/Baz.pm',
+ },
+ Quz => {
+ file => 'lib/Quz.pm',
+ },
+ },
+ dynamic_config => 1,
+ 'meta-spec' => {
+ url => "http://search.cpan.org/perldoc?CPAN::Meta::Spec",
+ version => 2,
+ },
+);
+
+my $merger = CPAN::Meta::Merge->new(default_version => '2');
+
+my $first_result = $merger->merge(\%base, \%first);
+
+is_deeply($first_result, \%first_expected, 'First result is as expected');
+
+is_deeply($merger->merge(\%base, { abstract => 'This is a test' }), \%base, 'Can merge in identical abstract');
+my $failure = eval { $merger->merge(\%base, { abstract => 'And now for something else' }) };
+is($failure, undef, 'Trying to merge different author gives an exception');
+like $@, qr/^Can't merge attribute abstract /, 'Exception looks right';
+
+my $failure2 = eval { $merger->merge(\%base, { provides => { Baz => { file => 'Baz.pm' } } }) };
+is($failure2, undef, 'Trying to merge different author gives an exception');
+like $@, qr/^Duplication of element provides\.Baz /, 'Exception looks right';
+
+done_testing();
View Lorry Controller Status