This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
fc05d8e6a6e7ffe0f1472997aaabb559dfb6c95c
[perl5.git] / cpan / CPAN-Meta / lib / CPAN / Meta / Converter.pm
1 use 5.006;
2 use strict;
3 use warnings;
4 package CPAN::Meta::Converter;
5 our $VERSION = '2.130880'; # VERSION
6
7
8 use CPAN::Meta::Validator;
9 use CPAN::Meta::Requirements;
10 use version 0.88 ();
11 use Parse::CPAN::Meta 1.4400 ();
12
13 sub _dclone {
14   my $ref = shift;
15
16   # if an object is in the data structure and doesn't specify how to
17   # turn itself into JSON, we just stringify the object.  That does the
18   # right thing for typical things that might be there, like version objects,
19   # Path::Class objects, etc.
20   no warnings 'once';
21   local *UNIVERSAL::TO_JSON = sub { return "$_[0]" };
22
23   my $backend = Parse::CPAN::Meta->json_backend();
24   return $backend->new->utf8->decode(
25     $backend->new->utf8->allow_blessed->convert_blessed->encode($ref)
26   );
27 }
28
29 my %known_specs = (
30     '2'   => 'http://search.cpan.org/perldoc?CPAN::Meta::Spec',
31     '1.4' => 'http://module-build.sourceforge.net/META-spec-v1.4.html',
32     '1.3' => 'http://module-build.sourceforge.net/META-spec-v1.3.html',
33     '1.2' => 'http://module-build.sourceforge.net/META-spec-v1.2.html',
34     '1.1' => 'http://module-build.sourceforge.net/META-spec-v1.1.html',
35     '1.0' => 'http://module-build.sourceforge.net/META-spec-v1.0.html'
36 );
37
38 my @spec_list = sort { $a <=> $b } keys %known_specs;
39 my ($LOWEST, $HIGHEST) = @spec_list[0,-1];
40
41 #--------------------------------------------------------------------------#
42 # converters
43 #
44 # called as $converter->($element, $field_name, $full_meta, $to_version)
45 #
46 # defined return value used for field
47 # undef return value means field is skipped
48 #--------------------------------------------------------------------------#
49
50 sub _keep { $_[0] }
51
52 sub _keep_or_one { defined($_[0]) ? $_[0] : 1 }
53
54 sub _keep_or_zero { defined($_[0]) ? $_[0] : 0 }
55
56 sub _keep_or_unknown { defined($_[0]) && length($_[0]) ? $_[0] : "unknown" }
57
58 sub _generated_by {
59   my $gen = shift;
60   my $sig = __PACKAGE__ . " version " . (__PACKAGE__->VERSION || "<dev>");
61
62   return $sig unless defined $gen and length $gen;
63   return $gen if $gen =~ /(, )\Q$sig/;
64   return "$gen, $sig";
65 }
66
67 sub _listify { ! defined $_[0] ? undef : ref $_[0] eq 'ARRAY' ? $_[0] : [$_[0]] }
68
69 sub _prefix_custom {
70   my $key = shift;
71   $key =~ s/^(?!x_)   # Unless it already starts with x_
72              (?:x-?)? # Remove leading x- or x (if present)
73            /x_/ix;    # and prepend x_
74   return $key;
75 }
76
77 sub _ucfirst_custom {
78   my $key = shift;
79   $key = ucfirst $key unless $key =~ /[A-Z]/;
80   return $key;
81 }
82
83 sub _change_meta_spec {
84   my ($element, undef, undef, $version) = @_;
85   $element->{version} = $version;
86   $element->{url} = $known_specs{$version};
87   return $element;
88 }
89
90 my @valid_licenses_1 = (
91   'perl',
92   'gpl',
93   'apache',
94   'artistic',
95   'artistic_2',
96   'lgpl',
97   'bsd',
98   'gpl',
99   'mit',
100   'mozilla',
101   'open_source',
102   'unrestricted',
103   'restrictive',
104   'unknown',
105 );
106
107 my %license_map_1 = (
108   ( map { $_ => $_ } @valid_licenses_1 ),
109   artistic2 => 'artistic_2',
110 );
111
112 sub _license_1 {
113   my ($element) = @_;
114   return 'unknown' unless defined $element;
115   if ( $license_map_1{lc $element} ) {
116     return $license_map_1{lc $element};
117   }
118   return 'unknown';
119 }
120
121 my @valid_licenses_2 = qw(
122   agpl_3
123   apache_1_1
124   apache_2_0
125   artistic_1
126   artistic_2
127   bsd
128   freebsd
129   gfdl_1_2
130   gfdl_1_3
131   gpl_1
132   gpl_2
133   gpl_3
134   lgpl_2_1
135   lgpl_3_0
136   mit
137   mozilla_1_0
138   mozilla_1_1
139   openssl
140   perl_5
141   qpl_1_0
142   ssleay
143   sun
144   zlib
145   open_source
146   restricted
147   unrestricted
148   unknown
149 );
150
151 # The "old" values were defined by Module::Build, and were often vague.  I have
152 # made the decisions below based on reading Module::Build::API and how clearly
153 # it specifies the version of the license.
154 my %license_map_2 = (
155   (map { $_ => $_ } @valid_licenses_2),
156   apache      => 'apache_2_0',  # clearly stated as 2.0
157   artistic    => 'artistic_1',  # clearly stated as 1
158   artistic2   => 'artistic_2',  # clearly stated as 2
159   gpl         => 'open_source', # we don't know which GPL; punt
160   lgpl        => 'open_source', # we don't know which LGPL; punt
161   mozilla     => 'open_source', # we don't know which MPL; punt
162   perl        => 'perl_5',      # clearly Perl 5
163   restrictive => 'restricted',
164 );
165
166 sub _license_2 {
167   my ($element) = @_;
168   return [ 'unknown' ] unless defined $element;
169   $element = [ $element ] unless ref $element eq 'ARRAY';
170   my @new_list;
171   for my $lic ( @$element ) {
172     next unless defined $lic;
173     if ( my $new = $license_map_2{lc $lic} ) {
174       push @new_list, $new;
175     }
176   }
177   return @new_list ? \@new_list : [ 'unknown' ];
178 }
179
180 my %license_downgrade_map = qw(
181   agpl_3            open_source
182   apache_1_1        apache
183   apache_2_0        apache
184   artistic_1        artistic
185   artistic_2        artistic_2
186   bsd               bsd
187   freebsd           open_source
188   gfdl_1_2          open_source
189   gfdl_1_3          open_source
190   gpl_1             gpl
191   gpl_2             gpl
192   gpl_3             gpl
193   lgpl_2_1          lgpl
194   lgpl_3_0          lgpl
195   mit               mit
196   mozilla_1_0       mozilla
197   mozilla_1_1       mozilla
198   openssl           open_source
199   perl_5            perl
200   qpl_1_0           open_source
201   ssleay            open_source
202   sun               open_source
203   zlib              open_source
204   open_source       open_source
205   restricted        restrictive
206   unrestricted      unrestricted
207   unknown           unknown
208 );
209
210 sub _downgrade_license {
211   my ($element) = @_;
212   if ( ! defined $element ) {
213     return "unknown";
214   }
215   elsif( ref $element eq 'ARRAY' ) {
216     if ( @$element == 1 ) {
217       return $license_downgrade_map{$element->[0]} || "unknown";
218     }
219   }
220   elsif ( ! ref $element ) {
221     return $license_downgrade_map{$element} || "unknown";
222   }
223   return "unknown";
224 }
225
226 my $no_index_spec_1_2 = {
227   'file' => \&_listify,
228   'dir' => \&_listify,
229   'package' => \&_listify,
230   'namespace' => \&_listify,
231 };
232
233 my $no_index_spec_1_3 = {
234   'file' => \&_listify,
235   'directory' => \&_listify,
236   'package' => \&_listify,
237   'namespace' => \&_listify,
238 };
239
240 my $no_index_spec_2 = {
241   'file' => \&_listify,
242   'directory' => \&_listify,
243   'package' => \&_listify,
244   'namespace' => \&_listify,
245   ':custom'  => \&_prefix_custom,
246 };
247
248 sub _no_index_1_2 {
249   my (undef, undef, $meta) = @_;
250   my $no_index = $meta->{no_index} || $meta->{private};
251   return unless $no_index;
252
253   # cleanup wrong format
254   if ( ! ref $no_index ) {
255     my $item = $no_index;
256     $no_index = { dir => [ $item ], file => [ $item ] };
257   }
258   elsif ( ref $no_index eq 'ARRAY' ) {
259     my $list = $no_index;
260     $no_index = { dir => [ @$list ], file => [ @$list ] };
261   }
262
263   # common mistake: files -> file
264   if ( exists $no_index->{files} ) {
265     $no_index->{file} = delete $no_index->{file};
266   }
267   # common mistake: modules -> module
268   if ( exists $no_index->{modules} ) {
269     $no_index->{module} = delete $no_index->{module};
270   }
271   return _convert($no_index, $no_index_spec_1_2);
272 }
273
274 sub _no_index_directory {
275   my ($element, $key, $meta, $version) = @_;
276   return unless $element;
277
278   # cleanup wrong format
279   if ( ! ref $element ) {
280     my $item = $element;
281     $element = { directory => [ $item ], file => [ $item ] };
282   }
283   elsif ( ref $element eq 'ARRAY' ) {
284     my $list = $element;
285     $element = { directory => [ @$list ], file => [ @$list ] };
286   }
287
288   if ( exists $element->{dir} ) {
289     $element->{directory} = delete $element->{dir};
290   }
291   # common mistake: files -> file
292   if ( exists $element->{files} ) {
293     $element->{file} = delete $element->{file};
294   }
295   # common mistake: modules -> module
296   if ( exists $element->{modules} ) {
297     $element->{module} = delete $element->{module};
298   }
299   my $spec = $version == 2 ? $no_index_spec_2 : $no_index_spec_1_3;
300   return _convert($element, $spec);
301 }
302
303 sub _is_module_name {
304   my $mod = shift;
305   return unless defined $mod && length $mod;
306   return $mod =~ m{^[A-Za-z][A-Za-z0-9_]*(?:::[A-Za-z0-9_]+)*$};
307 }
308
309 sub _clean_version {
310   my ($element) = @_;
311   return 0 if ! defined $element;
312
313   $element =~ s{^\s*}{};
314   $element =~ s{\s*$}{};
315   $element =~ s{^\.}{0.};
316
317   return 0 if ! length $element;
318   return 0 if ( $element eq 'undef' || $element eq '<undef>' );
319
320   my $v = eval { version->new($element) };
321   # XXX check defined $v and not just $v because version objects leak memory
322   # in boolean context -- dagolden, 2012-02-03
323   if ( defined $v ) {
324     return $v->is_qv ? $v->normal : $element;
325   }
326   else {
327     return 0;
328   }
329 }
330
331 sub _bad_version_hook {
332   my ($v) = @_;
333   $v =~ s{[a-z]+$}{}; # strip trailing alphabetics
334   my $vobj = eval { version->parse($v) };
335   return defined($vobj) ? $vobj : version->parse(0); # or give up
336 }
337
338 sub _version_map {
339   my ($element) = @_;
340   return unless defined $element;
341   if ( ref $element eq 'HASH' ) {
342     # XXX turn this into CPAN::Meta::Requirements with bad version hook
343     # and then turn it back into a hash
344     my $new_map = CPAN::Meta::Requirements->new(
345       { bad_version_hook => sub { version->new(0) } } # punt
346     );
347     while ( my ($k,$v) = each %$element ) {
348       next unless _is_module_name($k);
349       if ( !defined($v) || !length($v) || $v eq 'undef' || $v eq '<undef>'  ) {
350         $v = 0;
351       }
352       # some weird, old META have bad yml with module => module
353       # so check if value is like a module name and not like a version
354       if ( _is_module_name($v) && ! version::is_lax($v) ) {
355         $new_map->add_minimum($k => 0);
356         $new_map->add_minimum($v => 0);
357       }
358       $new_map->add_string_requirement($k => $v);
359     }
360     return $new_map->as_string_hash;
361   }
362   elsif ( ref $element eq 'ARRAY' ) {
363     my $hashref = { map { $_ => 0 } @$element };
364     return _version_map($hashref); # cleanup any weird stuff
365   }
366   elsif ( ref $element eq '' && length $element ) {
367     return { $element => 0 }
368   }
369   return;
370 }
371
372 sub _prereqs_from_1 {
373   my (undef, undef, $meta) = @_;
374   my $prereqs = {};
375   for my $phase ( qw/build configure/ ) {
376     my $key = "${phase}_requires";
377     $prereqs->{$phase}{requires} = _version_map($meta->{$key})
378       if $meta->{$key};
379   }
380   for my $rel ( qw/requires recommends conflicts/ ) {
381     $prereqs->{runtime}{$rel} = _version_map($meta->{$rel})
382       if $meta->{$rel};
383   }
384   return $prereqs;
385 }
386
387 my $prereqs_spec = {
388   configure => \&_prereqs_rel,
389   build     => \&_prereqs_rel,
390   test      => \&_prereqs_rel,
391   runtime   => \&_prereqs_rel,
392   develop   => \&_prereqs_rel,
393   ':custom'  => \&_prefix_custom,
394 };
395
396 my $relation_spec = {
397   requires   => \&_version_map,
398   recommends => \&_version_map,
399   suggests   => \&_version_map,
400   conflicts  => \&_version_map,
401   ':custom'  => \&_prefix_custom,
402 };
403
404 sub _cleanup_prereqs {
405   my ($prereqs, $key, $meta, $to_version) = @_;
406   return unless $prereqs && ref $prereqs eq 'HASH';
407   return _convert( $prereqs, $prereqs_spec, $to_version );
408 }
409
410 sub _prereqs_rel {
411   my ($relation, $key, $meta, $to_version) = @_;
412   return unless $relation && ref $relation eq 'HASH';
413   return _convert( $relation, $relation_spec, $to_version );
414 }
415
416
417 BEGIN {
418   my @old_prereqs = qw(
419     requires
420     configure_requires
421     recommends
422     conflicts
423   );
424
425   for ( @old_prereqs ) {
426     my $sub = "_get_$_";
427     my ($phase,$type) = split qr/_/, $_;
428     if ( ! defined $type ) {
429       $type = $phase;
430       $phase = 'runtime';
431     }
432     no strict 'refs';
433     *{$sub} = sub { _extract_prereqs($_[2]->{prereqs},$phase,$type) };
434   }
435 }
436
437 sub _get_build_requires {
438   my ($data, $key, $meta) = @_;
439
440   my $test_h  = _extract_prereqs($_[2]->{prereqs}, qw(test  requires)) || {};
441   my $build_h = _extract_prereqs($_[2]->{prereqs}, qw(build requires)) || {};
442
443   my $test_req  = CPAN::Meta::Requirements->from_string_hash($test_h);
444   my $build_req = CPAN::Meta::Requirements->from_string_hash($build_h);
445
446   $test_req->add_requirements($build_req)->as_string_hash;
447 }
448
449 sub _extract_prereqs {
450   my ($prereqs, $phase, $type) = @_;
451   return unless ref $prereqs eq 'HASH';
452   return scalar _version_map($prereqs->{$phase}{$type});
453 }
454
455 sub _downgrade_optional_features {
456   my (undef, undef, $meta) = @_;
457   return unless exists $meta->{optional_features};
458   my $origin = $meta->{optional_features};
459   my $features = {};
460   for my $name ( keys %$origin ) {
461     $features->{$name} = {
462       description => $origin->{$name}{description},
463       requires => _extract_prereqs($origin->{$name}{prereqs},'runtime','requires'),
464       configure_requires => _extract_prereqs($origin->{$name}{prereqs},'runtime','configure_requires'),
465       build_requires => _extract_prereqs($origin->{$name}{prereqs},'runtime','build_requires'),
466       recommends => _extract_prereqs($origin->{$name}{prereqs},'runtime','recommends'),
467       conflicts => _extract_prereqs($origin->{$name}{prereqs},'runtime','conflicts'),
468     };
469     for my $k (keys %{$features->{$name}} ) {
470       delete $features->{$name}{$k} unless defined $features->{$name}{$k};
471     }
472   }
473   return $features;
474 }
475
476 sub _upgrade_optional_features {
477   my (undef, undef, $meta) = @_;
478   return unless exists $meta->{optional_features};
479   my $origin = $meta->{optional_features};
480   my $features = {};
481   for my $name ( keys %$origin ) {
482     $features->{$name} = {
483       description => $origin->{$name}{description},
484       prereqs => _prereqs_from_1(undef, undef, $origin->{$name}),
485     };
486     delete $features->{$name}{prereqs}{configure};
487   }
488   return $features;
489 }
490
491 my $optional_features_2_spec = {
492   description => \&_keep,
493   prereqs => \&_cleanup_prereqs,
494   ':custom'  => \&_prefix_custom,
495 };
496
497 sub _feature_2 {
498   my ($element, $key, $meta, $to_version) = @_;
499   return unless $element && ref $element eq 'HASH';
500   _convert( $element, $optional_features_2_spec, $to_version );
501 }
502
503 sub _cleanup_optional_features_2 {
504   my ($element, $key, $meta, $to_version) = @_;
505   return unless $element && ref $element eq 'HASH';
506   my $new_data = {};
507   for my $k ( keys %$element ) {
508     $new_data->{$k} = _feature_2( $element->{$k}, $k, $meta, $to_version );
509   }
510   return unless keys %$new_data;
511   return $new_data;
512 }
513
514 sub _optional_features_1_4 {
515   my ($element) = @_;
516   return unless $element;
517   $element = _optional_features_as_map($element);
518   for my $name ( keys %$element ) {
519     for my $drop ( qw/requires_packages requires_os excluded_os/ ) {
520       delete $element->{$name}{$drop};
521     }
522   }
523   return $element;
524 }
525
526 sub _optional_features_as_map {
527   my ($element) = @_;
528   return unless $element;
529   if ( ref $element eq 'ARRAY' ) {
530     my %map;
531     for my $feature ( @$element ) {
532       my (@parts) = %$feature;
533       $map{$parts[0]} = $parts[1];
534     }
535     $element = \%map;
536   }
537   return $element;
538 }
539
540 sub _is_urlish { defined $_[0] && $_[0] =~ m{\A[-+.a-z0-9]+:.+}i }
541
542 sub _url_or_drop {
543   my ($element) = @_;
544   return $element if _is_urlish($element);
545   return;
546 }
547
548 sub _url_list {
549   my ($element) = @_;
550   return unless $element;
551   $element = _listify( $element );
552   $element = [ grep { _is_urlish($_) } @$element ];
553   return unless @$element;
554   return $element;
555 }
556
557 sub _author_list {
558   my ($element) = @_;
559   return [ 'unknown' ] unless $element;
560   $element = _listify( $element );
561   $element = [ map { defined $_ && length $_ ? $_ : 'unknown' } @$element ];
562   return [ 'unknown' ] unless @$element;
563   return $element;
564 }
565
566 my $resource2_upgrade = {
567   license    => sub { return _is_urlish($_[0]) ? _listify( $_[0] ) : undef },
568   homepage   => \&_url_or_drop,
569   bugtracker => sub {
570     my ($item) = @_;
571     return unless $item;
572     if ( $item =~ m{^mailto:(.*)$} ) { return { mailto => $1 } }
573     elsif( _is_urlish($item) ) { return { web => $item } }
574     else { return }
575   },
576   repository => sub { return _is_urlish($_[0]) ? { url => $_[0] } : undef },
577   ':custom'  => \&_prefix_custom,
578 };
579
580 sub _upgrade_resources_2 {
581   my (undef, undef, $meta, $version) = @_;
582   return unless exists $meta->{resources};
583   return _convert($meta->{resources}, $resource2_upgrade);
584 }
585
586 my $bugtracker2_spec = {
587   web => \&_url_or_drop,
588   mailto => \&_keep,
589   ':custom'  => \&_prefix_custom,
590 };
591
592 sub _repo_type {
593   my ($element, $key, $meta, $to_version) = @_;
594   return $element if defined $element;
595   return unless exists $meta->{url};
596   my $repo_url = $meta->{url};
597   for my $type ( qw/git svn/ ) {
598     return $type if $repo_url =~ m{\A$type};
599   }
600   return;
601 }
602
603 my $repository2_spec = {
604   web => \&_url_or_drop,
605   url => \&_url_or_drop,
606   type => \&_repo_type,
607   ':custom'  => \&_prefix_custom,
608 };
609
610 my $resources2_cleanup = {
611   license    => \&_url_list,
612   homepage   => \&_url_or_drop,
613   bugtracker => sub { ref $_[0] ? _convert( $_[0], $bugtracker2_spec ) : undef },
614   repository => sub { my $data = shift; ref $data ? _convert( $data, $repository2_spec ) : undef },
615   ':custom'  => \&_prefix_custom,
616 };
617
618 sub _cleanup_resources_2 {
619   my ($resources, $key, $meta, $to_version) = @_;
620   return unless $resources && ref $resources eq 'HASH';
621   return _convert($resources, $resources2_cleanup, $to_version);
622 }
623
624 my $resource1_spec = {
625   license    => \&_url_or_drop,
626   homepage   => \&_url_or_drop,
627   bugtracker => \&_url_or_drop,
628   repository => \&_url_or_drop,
629   ':custom'  => \&_keep,
630 };
631
632 sub _resources_1_3 {
633   my (undef, undef, $meta, $version) = @_;
634   return unless exists $meta->{resources};
635   return _convert($meta->{resources}, $resource1_spec);
636 }
637
638 *_resources_1_4 = *_resources_1_3;
639
640 sub _resources_1_2 {
641   my (undef, undef, $meta) = @_;
642   my $resources = $meta->{resources} || {};
643   if ( $meta->{license_url} && ! $resources->{license} ) {
644     $resources->{license} = $meta->license_url
645       if _is_urlish($meta->{license_url});
646   }
647   return unless keys %$resources;
648   return _convert($resources, $resource1_spec);
649 }
650
651 my $resource_downgrade_spec = {
652   license    => sub { return ref $_[0] ? $_[0]->[0] : $_[0] },
653   homepage   => \&_url_or_drop,
654   bugtracker => sub { return $_[0]->{web} },
655   repository => sub { return $_[0]->{url} || $_[0]->{web} },
656   ':custom'  => \&_ucfirst_custom,
657 };
658
659 sub _downgrade_resources {
660   my (undef, undef, $meta, $version) = @_;
661   return unless exists $meta->{resources};
662   return _convert($meta->{resources}, $resource_downgrade_spec);
663 }
664
665 sub _release_status {
666   my ($element, undef, $meta) = @_;
667   return $element if $element && $element =~ m{\A(?:stable|testing|unstable)\z};
668   return _release_status_from_version(undef, undef, $meta);
669 }
670
671 sub _release_status_from_version {
672   my (undef, undef, $meta) = @_;
673   my $version = $meta->{version} || '';
674   return ( $version =~ /_/ ) ? 'testing' : 'stable';
675 }
676
677 my $provides_spec = {
678   file => \&_keep,
679   version => \&_keep,
680 };
681
682 my $provides_spec_2 = {
683   file => \&_keep,
684   version => \&_keep,
685   ':custom'  => \&_prefix_custom,
686 };
687
688 sub _provides {
689   my ($element, $key, $meta, $to_version) = @_;
690   return unless defined $element && ref $element eq 'HASH';
691   my $spec = $to_version == 2 ? $provides_spec_2 : $provides_spec;
692   my $new_data = {};
693   for my $k ( keys %$element ) {
694     $new_data->{$k} = _convert($element->{$k}, $spec, $to_version);
695     $new_data->{$k}{version} = _clean_version($element->{$k}{version})
696       if exists $element->{$k}{version};
697   }
698   return $new_data;
699 }
700
701 sub _convert {
702   my ($data, $spec, $to_version) = @_;
703
704   my $new_data = {};
705   for my $key ( keys %$spec ) {
706     next if $key eq ':custom' || $key eq ':drop';
707     next unless my $fcn = $spec->{$key};
708     die "spec for '$key' is not a coderef"
709       unless ref $fcn && ref $fcn eq 'CODE';
710     my $new_value = $fcn->($data->{$key}, $key, $data, $to_version);
711     $new_data->{$key} = $new_value if defined $new_value;
712   }
713
714   my $drop_list   = $spec->{':drop'};
715   my $customizer  = $spec->{':custom'} || \&_keep;
716
717   for my $key ( keys %$data ) {
718     next if $drop_list && grep { $key eq $_ } @$drop_list;
719     next if exists $spec->{$key}; # we handled it
720     $new_data->{ $customizer->($key) } = $data->{$key};
721   }
722
723   return $new_data;
724 }
725
726 #--------------------------------------------------------------------------#
727 # define converters for each conversion
728 #--------------------------------------------------------------------------#
729
730 # each converts from prior version
731 # special ":custom" field is used for keys not recognized in spec
732 my %up_convert = (
733   '2-from-1.4' => {
734     # PRIOR MANDATORY
735     'abstract'            => \&_keep_or_unknown,
736     'author'              => \&_author_list,
737     'generated_by'        => \&_generated_by,
738     'license'             => \&_license_2,
739     'meta-spec'           => \&_change_meta_spec,
740     'name'                => \&_keep,
741     'version'             => \&_keep,
742     # CHANGED TO MANDATORY
743     'dynamic_config'      => \&_keep_or_one,
744     # ADDED MANDATORY
745     'release_status'      => \&_release_status_from_version,
746     # PRIOR OPTIONAL
747     'keywords'            => \&_keep,
748     'no_index'            => \&_no_index_directory,
749     'optional_features'   => \&_upgrade_optional_features,
750     'provides'            => \&_provides,
751     'resources'           => \&_upgrade_resources_2,
752     # ADDED OPTIONAL
753     'description'         => \&_keep,
754     'prereqs'             => \&_prereqs_from_1,
755
756     # drop these deprecated fields, but only after we convert
757     ':drop' => [ qw(
758         build_requires
759         configure_requires
760         conflicts
761         distribution_type
762         license_url
763         private
764         recommends
765         requires
766     ) ],
767
768     # other random keys need x_ prefixing
769     ':custom'              => \&_prefix_custom,
770   },
771   '1.4-from-1.3' => {
772     # PRIOR MANDATORY
773     'abstract'            => \&_keep_or_unknown,
774     'author'              => \&_author_list,
775     'generated_by'        => \&_generated_by,
776     'license'             => \&_license_1,
777     'meta-spec'           => \&_change_meta_spec,
778     'name'                => \&_keep,
779     'version'             => \&_keep,
780     # PRIOR OPTIONAL
781     'build_requires'      => \&_version_map,
782     'conflicts'           => \&_version_map,
783     'distribution_type'   => \&_keep,
784     'dynamic_config'      => \&_keep_or_one,
785     'keywords'            => \&_keep,
786     'no_index'            => \&_no_index_directory,
787     'optional_features'   => \&_optional_features_1_4,
788     'provides'            => \&_provides,
789     'recommends'          => \&_version_map,
790     'requires'            => \&_version_map,
791     'resources'           => \&_resources_1_4,
792     # ADDED OPTIONAL
793     'configure_requires'  => \&_keep,
794
795     # drop these deprecated fields, but only after we convert
796     ':drop' => [ qw(
797       license_url
798       private
799     )],
800
801     # other random keys are OK if already valid
802     ':custom'              => \&_keep
803   },
804   '1.3-from-1.2' => {
805     # PRIOR MANDATORY
806     'abstract'            => \&_keep_or_unknown,
807     'author'              => \&_author_list,
808     'generated_by'        => \&_generated_by,
809     'license'             => \&_license_1,
810     'meta-spec'           => \&_change_meta_spec,
811     'name'                => \&_keep,
812     'version'             => \&_keep,
813     # PRIOR OPTIONAL
814     'build_requires'      => \&_version_map,
815     'conflicts'           => \&_version_map,
816     'distribution_type'   => \&_keep,
817     'dynamic_config'      => \&_keep_or_one,
818     'keywords'            => \&_keep,
819     'no_index'            => \&_no_index_directory,
820     'optional_features'   => \&_optional_features_as_map,
821     'provides'            => \&_provides,
822     'recommends'          => \&_version_map,
823     'requires'            => \&_version_map,
824     'resources'           => \&_resources_1_3,
825
826     # drop these deprecated fields, but only after we convert
827     ':drop' => [ qw(
828       license_url
829       private
830     )],
831
832     # other random keys are OK if already valid
833     ':custom'              => \&_keep
834   },
835   '1.2-from-1.1' => {
836     # PRIOR MANDATORY
837     'version'             => \&_keep,
838     # CHANGED TO MANDATORY
839     'license'             => \&_license_1,
840     'name'                => \&_keep,
841     'generated_by'        => \&_generated_by,
842     # ADDED MANDATORY
843     'abstract'            => \&_keep_or_unknown,
844     'author'              => \&_author_list,
845     'meta-spec'           => \&_change_meta_spec,
846     # PRIOR OPTIONAL
847     'build_requires'      => \&_version_map,
848     'conflicts'           => \&_version_map,
849     'distribution_type'   => \&_keep,
850     'dynamic_config'      => \&_keep_or_one,
851     'recommends'          => \&_version_map,
852     'requires'            => \&_version_map,
853     # ADDED OPTIONAL
854     'keywords'            => \&_keep,
855     'no_index'            => \&_no_index_1_2,
856     'optional_features'   => \&_optional_features_as_map,
857     'provides'            => \&_provides,
858     'resources'           => \&_resources_1_2,
859
860     # drop these deprecated fields, but only after we convert
861     ':drop' => [ qw(
862       license_url
863       private
864     )],
865
866     # other random keys are OK if already valid
867     ':custom'              => \&_keep
868   },
869   '1.1-from-1.0' => {
870     # CHANGED TO MANDATORY
871     'version'             => \&_keep,
872     # IMPLIED MANDATORY
873     'name'                => \&_keep,
874     # PRIOR OPTIONAL
875     'build_requires'      => \&_version_map,
876     'conflicts'           => \&_version_map,
877     'distribution_type'   => \&_keep,
878     'dynamic_config'      => \&_keep_or_one,
879     'generated_by'        => \&_generated_by,
880     'license'             => \&_license_1,
881     'recommends'          => \&_version_map,
882     'requires'            => \&_version_map,
883     # ADDED OPTIONAL
884     'license_url'         => \&_url_or_drop,
885     'private'             => \&_keep,
886
887     # other random keys are OK if already valid
888     ':custom'              => \&_keep
889   },
890 );
891
892 my %down_convert = (
893   '1.4-from-2' => {
894     # MANDATORY
895     'abstract'            => \&_keep_or_unknown,
896     'author'              => \&_author_list,
897     'generated_by'        => \&_generated_by,
898     'license'             => \&_downgrade_license,
899     'meta-spec'           => \&_change_meta_spec,
900     'name'                => \&_keep,
901     'version'             => \&_keep,
902     # OPTIONAL
903     'build_requires'      => \&_get_build_requires,
904     'configure_requires'  => \&_get_configure_requires,
905     'conflicts'           => \&_get_conflicts,
906     'distribution_type'   => \&_keep,
907     'dynamic_config'      => \&_keep_or_one,
908     'keywords'            => \&_keep,
909     'no_index'            => \&_no_index_directory,
910     'optional_features'   => \&_downgrade_optional_features,
911     'provides'            => \&_provides,
912     'recommends'          => \&_get_recommends,
913     'requires'            => \&_get_requires,
914     'resources'           => \&_downgrade_resources,
915
916     # drop these unsupported fields (after conversion)
917     ':drop' => [ qw(
918       description
919       prereqs
920       release_status
921     )],
922
923     # custom keys will be left unchanged
924     ':custom'              => \&_keep
925   },
926   '1.3-from-1.4' => {
927     # MANDATORY
928     'abstract'            => \&_keep_or_unknown,
929     'author'              => \&_author_list,
930     'generated_by'        => \&_generated_by,
931     'license'             => \&_license_1,
932     'meta-spec'           => \&_change_meta_spec,
933     'name'                => \&_keep,
934     'version'             => \&_keep,
935     # OPTIONAL
936     'build_requires'      => \&_version_map,
937     'conflicts'           => \&_version_map,
938     'distribution_type'   => \&_keep,
939     'dynamic_config'      => \&_keep_or_one,
940     'keywords'            => \&_keep,
941     'no_index'            => \&_no_index_directory,
942     'optional_features'   => \&_optional_features_as_map,
943     'provides'            => \&_provides,
944     'recommends'          => \&_version_map,
945     'requires'            => \&_version_map,
946     'resources'           => \&_resources_1_3,
947
948     # drop these unsupported fields, but only after we convert
949     ':drop' => [ qw(
950       configure_requires
951     )],
952
953     # other random keys are OK if already valid
954     ':custom'              => \&_keep,
955   },
956   '1.2-from-1.3' => {
957     # MANDATORY
958     'abstract'            => \&_keep_or_unknown,
959     'author'              => \&_author_list,
960     'generated_by'        => \&_generated_by,
961     'license'             => \&_license_1,
962     'meta-spec'           => \&_change_meta_spec,
963     'name'                => \&_keep,
964     'version'             => \&_keep,
965     # OPTIONAL
966     'build_requires'      => \&_version_map,
967     'conflicts'           => \&_version_map,
968     'distribution_type'   => \&_keep,
969     'dynamic_config'      => \&_keep_or_one,
970     'keywords'            => \&_keep,
971     'no_index'            => \&_no_index_1_2,
972     'optional_features'   => \&_optional_features_as_map,
973     'provides'            => \&_provides,
974     'recommends'          => \&_version_map,
975     'requires'            => \&_version_map,
976     'resources'           => \&_resources_1_3,
977
978     # other random keys are OK if already valid
979     ':custom'              => \&_keep,
980   },
981   '1.1-from-1.2' => {
982     # MANDATORY
983     'version'             => \&_keep,
984     # IMPLIED MANDATORY
985     'name'                => \&_keep,
986     'meta-spec'           => \&_change_meta_spec,
987     # OPTIONAL
988     'build_requires'      => \&_version_map,
989     'conflicts'           => \&_version_map,
990     'distribution_type'   => \&_keep,
991     'dynamic_config'      => \&_keep_or_one,
992     'generated_by'        => \&_generated_by,
993     'license'             => \&_license_1,
994     'private'             => \&_keep,
995     'recommends'          => \&_version_map,
996     'requires'            => \&_version_map,
997
998     # drop unsupported fields
999     ':drop' => [ qw(
1000       abstract
1001       author
1002       provides
1003       no_index
1004       keywords
1005       resources
1006     )],
1007
1008     # other random keys are OK if already valid
1009     ':custom'              => \&_keep,
1010   },
1011   '1.0-from-1.1' => {
1012     # IMPLIED MANDATORY
1013     'name'                => \&_keep,
1014     'meta-spec'           => \&_change_meta_spec,
1015     'version'             => \&_keep,
1016     # PRIOR OPTIONAL
1017     'build_requires'      => \&_version_map,
1018     'conflicts'           => \&_version_map,
1019     'distribution_type'   => \&_keep,
1020     'dynamic_config'      => \&_keep_or_one,
1021     'generated_by'        => \&_generated_by,
1022     'license'             => \&_license_1,
1023     'recommends'          => \&_version_map,
1024     'requires'            => \&_version_map,
1025
1026     # other random keys are OK if already valid
1027     ':custom'              => \&_keep,
1028   },
1029 );
1030
1031 my %cleanup = (
1032   '2' => {
1033     # PRIOR MANDATORY
1034     'abstract'            => \&_keep_or_unknown,
1035     'author'              => \&_author_list,
1036     'generated_by'        => \&_generated_by,
1037     'license'             => \&_license_2,
1038     'meta-spec'           => \&_change_meta_spec,
1039     'name'                => \&_keep,
1040     'version'             => \&_keep,
1041     # CHANGED TO MANDATORY
1042     'dynamic_config'      => \&_keep_or_one,
1043     # ADDED MANDATORY
1044     'release_status'      => \&_release_status,
1045     # PRIOR OPTIONAL
1046     'keywords'            => \&_keep,
1047     'no_index'            => \&_no_index_directory,
1048     'optional_features'   => \&_cleanup_optional_features_2,
1049     'provides'            => \&_provides,
1050     'resources'           => \&_cleanup_resources_2,
1051     # ADDED OPTIONAL
1052     'description'         => \&_keep,
1053     'prereqs'             => \&_cleanup_prereqs,
1054
1055     # drop these deprecated fields, but only after we convert
1056     ':drop' => [ qw(
1057         build_requires
1058         configure_requires
1059         conflicts
1060         distribution_type
1061         license_url
1062         private
1063         recommends
1064         requires
1065     ) ],
1066
1067     # other random keys need x_ prefixing
1068     ':custom'              => \&_prefix_custom,
1069   },
1070   '1.4' => {
1071     # PRIOR MANDATORY
1072     'abstract'            => \&_keep_or_unknown,
1073     'author'              => \&_author_list,
1074     'generated_by'        => \&_generated_by,
1075     'license'             => \&_license_1,
1076     'meta-spec'           => \&_change_meta_spec,
1077     'name'                => \&_keep,
1078     'version'             => \&_keep,
1079     # PRIOR OPTIONAL
1080     'build_requires'      => \&_version_map,
1081     'conflicts'           => \&_version_map,
1082     'distribution_type'   => \&_keep,
1083     'dynamic_config'      => \&_keep_or_one,
1084     'keywords'            => \&_keep,
1085     'no_index'            => \&_no_index_directory,
1086     'optional_features'   => \&_optional_features_1_4,
1087     'provides'            => \&_provides,
1088     'recommends'          => \&_version_map,
1089     'requires'            => \&_version_map,
1090     'resources'           => \&_resources_1_4,
1091     # ADDED OPTIONAL
1092     'configure_requires'  => \&_keep,
1093
1094     # other random keys are OK if already valid
1095     ':custom'             => \&_keep
1096   },
1097   '1.3' => {
1098     # PRIOR MANDATORY
1099     'abstract'            => \&_keep_or_unknown,
1100     'author'              => \&_author_list,
1101     'generated_by'        => \&_generated_by,
1102     'license'             => \&_license_1,
1103     'meta-spec'           => \&_change_meta_spec,
1104     'name'                => \&_keep,
1105     'version'             => \&_keep,
1106     # PRIOR OPTIONAL
1107     'build_requires'      => \&_version_map,
1108     'conflicts'           => \&_version_map,
1109     'distribution_type'   => \&_keep,
1110     'dynamic_config'      => \&_keep_or_one,
1111     'keywords'            => \&_keep,
1112     'no_index'            => \&_no_index_directory,
1113     'optional_features'   => \&_optional_features_as_map,
1114     'provides'            => \&_provides,
1115     'recommends'          => \&_version_map,
1116     'requires'            => \&_version_map,
1117     'resources'           => \&_resources_1_3,
1118
1119     # other random keys are OK if already valid
1120     ':custom'             => \&_keep
1121   },
1122   '1.2' => {
1123     # PRIOR MANDATORY
1124     'version'             => \&_keep,
1125     # CHANGED TO MANDATORY
1126     'license'             => \&_license_1,
1127     'name'                => \&_keep,
1128     'generated_by'        => \&_generated_by,
1129     # ADDED MANDATORY
1130     'abstract'            => \&_keep_or_unknown,
1131     'author'              => \&_author_list,
1132     'meta-spec'           => \&_change_meta_spec,
1133     # PRIOR OPTIONAL
1134     'build_requires'      => \&_version_map,
1135     'conflicts'           => \&_version_map,
1136     'distribution_type'   => \&_keep,
1137     'dynamic_config'      => \&_keep_or_one,
1138     'recommends'          => \&_version_map,
1139     'requires'            => \&_version_map,
1140     # ADDED OPTIONAL
1141     'keywords'            => \&_keep,
1142     'no_index'            => \&_no_index_1_2,
1143     'optional_features'   => \&_optional_features_as_map,
1144     'provides'            => \&_provides,
1145     'resources'           => \&_resources_1_2,
1146
1147     # other random keys are OK if already valid
1148     ':custom'             => \&_keep
1149   },
1150   '1.1' => {
1151     # CHANGED TO MANDATORY
1152     'version'             => \&_keep,
1153     # IMPLIED MANDATORY
1154     'name'                => \&_keep,
1155     'meta-spec'           => \&_change_meta_spec,
1156     # PRIOR OPTIONAL
1157     'build_requires'      => \&_version_map,
1158     'conflicts'           => \&_version_map,
1159     'distribution_type'   => \&_keep,
1160     'dynamic_config'      => \&_keep_or_one,
1161     'generated_by'        => \&_generated_by,
1162     'license'             => \&_license_1,
1163     'recommends'          => \&_version_map,
1164     'requires'            => \&_version_map,
1165     # ADDED OPTIONAL
1166     'license_url'         => \&_url_or_drop,
1167     'private'             => \&_keep,
1168
1169     # other random keys are OK if already valid
1170     ':custom'             => \&_keep
1171   },
1172   '1.0' => {
1173     # IMPLIED MANDATORY
1174     'name'                => \&_keep,
1175     'meta-spec'           => \&_change_meta_spec,
1176     'version'             => \&_keep,
1177     # IMPLIED OPTIONAL
1178     'build_requires'      => \&_version_map,
1179     'conflicts'           => \&_version_map,
1180     'distribution_type'   => \&_keep,
1181     'dynamic_config'      => \&_keep_or_one,
1182     'generated_by'        => \&_generated_by,
1183     'license'             => \&_license_1,
1184     'recommends'          => \&_version_map,
1185     'requires'            => \&_version_map,
1186
1187     # other random keys are OK if already valid
1188     ':custom'             => \&_keep,
1189   },
1190 );
1191
1192 #--------------------------------------------------------------------------#
1193 # Code
1194 #--------------------------------------------------------------------------#
1195
1196
1197 sub new {
1198   my ($class,$data) = @_;
1199
1200   # create an attributes hash
1201   my $self = {
1202     'data'    => $data,
1203     'spec'    => $data->{'meta-spec'}{'version'} || "1.0",
1204   };
1205
1206   # create the object
1207   return bless $self, $class;
1208 }
1209
1210
1211 sub convert {
1212   my ($self, %args) = @_;
1213   my $args = { %args };
1214
1215   my $new_version = $args->{version} || $HIGHEST;
1216
1217   my ($old_version) = $self->{spec};
1218   my $converted = _dclone($self->{data});
1219
1220   if ( $old_version == $new_version ) {
1221     $converted = _convert( $converted, $cleanup{$old_version}, $old_version );
1222     my $cmv = CPAN::Meta::Validator->new( $converted );
1223     unless ( $cmv->is_valid ) {
1224       my $errs = join("\n", $cmv->errors);
1225       die "Failed to clean-up $old_version metadata. Errors:\n$errs\n";
1226     }
1227     return $converted;
1228   }
1229   elsif ( $old_version > $new_version )  {
1230     my @vers = sort { $b <=> $a } keys %known_specs;
1231     for my $i ( 0 .. $#vers-1 ) {
1232       next if $vers[$i] > $old_version;
1233       last if $vers[$i+1] < $new_version;
1234       my $spec_string = "$vers[$i+1]-from-$vers[$i]";
1235       $converted = _convert( $converted, $down_convert{$spec_string}, $vers[$i+1] );
1236       my $cmv = CPAN::Meta::Validator->new( $converted );
1237       unless ( $cmv->is_valid ) {
1238         my $errs = join("\n", $cmv->errors);
1239         die "Failed to downconvert metadata to $vers[$i+1]. Errors:\n$errs\n";
1240       }
1241     }
1242     return $converted;
1243   }
1244   else {
1245     my @vers = sort { $a <=> $b } keys %known_specs;
1246     for my $i ( 0 .. $#vers-1 ) {
1247       next if $vers[$i] < $old_version;
1248       last if $vers[$i+1] > $new_version;
1249       my $spec_string = "$vers[$i+1]-from-$vers[$i]";
1250       $converted = _convert( $converted, $up_convert{$spec_string}, $vers[$i+1] );
1251       my $cmv = CPAN::Meta::Validator->new( $converted );
1252       unless ( $cmv->is_valid ) {
1253         my $errs = join("\n", $cmv->errors);
1254         die "Failed to upconvert metadata to $vers[$i+1]. Errors:\n$errs\n";
1255       }
1256     }
1257     return $converted;
1258   }
1259 }
1260
1261 1;
1262
1263 # ABSTRACT: Convert CPAN distribution metadata structures
1264
1265 __END__
1266
1267 =pod
1268
1269 =encoding utf-8
1270
1271 =head1 NAME
1272
1273 CPAN::Meta::Converter - Convert CPAN distribution metadata structures
1274
1275 =head1 VERSION
1276
1277 version 2.130880
1278
1279 =head1 SYNOPSIS
1280
1281   my $struct = decode_json_file('META.json');
1282
1283   my $cmc = CPAN::Meta::Converter->new( $struct );
1284
1285   my $new_struct = $cmc->convert( version => "2" );
1286
1287 =head1 DESCRIPTION
1288
1289 This module converts CPAN Meta structures from one form to another.  The
1290 primary use is to convert older structures to the most modern version of
1291 the specification, but other transformations may be implemented in the
1292 future as needed.  (E.g. stripping all custom fields or stripping all
1293 optional fields.)
1294
1295 =head1 METHODS
1296
1297 =head2 new
1298
1299   my $cmc = CPAN::Meta::Converter->new( $struct );
1300
1301 The constructor should be passed a valid metadata structure but invalid
1302 structures are accepted.  If no meta-spec version is provided, version 1.0 will
1303 be assumed.
1304
1305 =head2 convert
1306
1307   my $new_struct = $cmc->convert( version => "2" );
1308
1309 Returns a new hash reference with the metadata converted to a different form.
1310 C<convert> will die if any conversion/standardization still results in an
1311 invalid structure.
1312
1313 Valid parameters include:
1314
1315 =over
1316
1317 =item *
1318
1319 C<version> -- Indicates the desired specification version (e.g. "1.0", "1.1" ... "1.4", "2").
1320 Defaults to the latest version of the CPAN Meta Spec.
1321
1322 =back
1323
1324 Conversion proceeds through each version in turn.  For example, a version 1.2
1325 structure might be converted to 1.3 then 1.4 then finally to version 2. The
1326 conversion process attempts to clean-up simple errors and standardize data.
1327 For example, if C<author> is given as a scalar, it will converted to an array
1328 reference containing the item. (Converting a structure to its own version will
1329 also clean-up and standardize.)
1330
1331 When data are cleaned and standardized, missing or invalid fields will be
1332 replaced with sensible defaults when possible.  This may be lossy or imprecise.
1333 For example, some badly structured META.yml files on CPAN have prerequisite
1334 modules listed as both keys and values:
1335
1336   requires => { 'Foo::Bar' => 'Bam::Baz' }
1337
1338 These would be split and each converted to a prerequisite with a minimum
1339 version of zero.
1340
1341 When some mandatory fields are missing or invalid, the conversion will attempt
1342 to provide a sensible default or will fill them with a value of 'unknown'.  For
1343 example a missing or unrecognized C<license> field will result in a C<license>
1344 field of 'unknown'.  Fields that may get an 'unknown' include:
1345
1346 =over 4
1347
1348 =item *
1349
1350 abstract
1351
1352 =item *
1353
1354 author
1355
1356 =item *
1357
1358 license
1359
1360 =back
1361
1362 =head1 BUGS
1363
1364 Please report any bugs or feature using the CPAN Request Tracker.
1365 Bugs can be submitted through the web interface at
1366 L<http://rt.cpan.org/Dist/Display.html?Queue=CPAN-Meta>
1367
1368 When submitting a bug or request, please include a test-file or a patch to an
1369 existing test-file that illustrates the bug or desired feature.
1370
1371 =head1 AUTHORS
1372
1373 =over 4
1374
1375 =item *
1376
1377 David Golden <dagolden@cpan.org>
1378
1379 =item *
1380
1381 Ricardo Signes <rjbs@cpan.org>
1382
1383 =back
1384
1385 =head1 CONTRIBUTORS
1386
1387 =over 4
1388
1389 =item *
1390
1391 Ansgar Burchardt <ansgar@cpan.org>
1392
1393 =item *
1394
1395 Michael G. Schwern <mschwern@cpan.org>
1396
1397 =item *
1398
1399 Randy Sims <randys@thepierianspring.org>
1400
1401 =item *
1402
1403 Ævar Arnfjörð Bjarmason <avar@cpan.org>
1404
1405 =item *
1406
1407 Christopher J. Madsen <cjm@cpan.org>
1408
1409 =item *
1410
1411 Cory G Watson <gphat@cpan.org>
1412
1413 =item *
1414
1415 Damyan Ivanov <dam@cpan.org>
1416
1417 =item *
1418
1419 Eric Wilhelm <ewilhelm@cpan.org>
1420
1421 =item *
1422
1423 Gregor Hermann <gregoa@debian.org>
1424
1425 =item *
1426
1427 Ken Williams <kwilliams@cpan.org>
1428
1429 =item *
1430
1431 Lars Dɪᴇᴄᴋᴏᴡ 迪拉斯 <daxim@cpan.org>
1432
1433 =item *
1434
1435 Leon Timmermans <leont@cpan.org>
1436
1437 =item *
1438
1439 Mark Fowler <markf@cpan.org>
1440
1441 =back
1442
1443 =head1 COPYRIGHT AND LICENSE
1444
1445 This software is copyright (c) 2010 by David Golden and Ricardo Signes.
1446
1447 This is free software; you can redistribute it and/or modify it under
1448 the same terms as the Perl 5 programming language system itself.
1449
1450 =cut