Update CPAN-Meta to CPAN version 2.142060
authorChris 'BinGOs' Williams <chris@bingosnet.co.uk>
Wed, 30 Jul 2014 08:05:06 +0000 (09:05 +0100)
committerChris 'BinGOs' Williams <chris@bingosnet.co.uk>
Wed, 30 Jul 2014 08:11:27 +0000 (09:11 +0100)
  [DELTA]

2.142060  2014-07-25 13:30:06-04:00 America/New_York

  [ADDED]

  - CPAN::Meta::Merge is a new class for merging two possibly overlapping
    instances of metadata. It will accept both CPAN::Meta objects and
    (possibly incomplete) hashrefs of metadata.

13 files changed:
MANIFEST
META.json
META.yml
Porting/Maintainers.pl
cpan/CPAN-Meta/lib/CPAN/Meta.pm
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 [new file with mode: 0644]
cpan/CPAN-Meta/lib/CPAN/Meta/Prereqs.pm
cpan/CPAN-Meta/lib/CPAN/Meta/Spec.pm
cpan/CPAN-Meta/lib/CPAN/Meta/Validator.pm
cpan/CPAN-Meta/t/merge.t [new file with mode: 0644]

index 1bb915f..47a0a8d 100644 (file)
--- 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
index d639e63..24a4d11 100644 (file)
--- 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"
    ],
index 474ba24..f521122 100644 (file)
--- 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
index 11aa1a9..b6cbbc3 100755 (executable)
@@ -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},
index 1b6723f..0c9048a 100644 (file)
@@ -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
 
index 0b2d83c..83b6c59 100644 (file)
@@ -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
 
index 52e3e93..db4f1ce 100644 (file)
@@ -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
 
index c28273a..9d6c660 100644 (file)
@@ -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 (file)
index 0000000..5648d77
--- /dev/null
@@ -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
index 0535f74..60248b9 100644 (file)
@@ -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
 
index ce5eafb..873580d 100644 (file)
@@ -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
 
index 21cf295..7f08de7 100644 (file)
@@ -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 (file)
index 0000000..77ae09f
--- /dev/null
@@ -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();