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