This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Update CPAN-Meta to CPAN version 2.120351
[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.120351'; # 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->utf8->decode(
24     $backend->new->utf8->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   my $v = eval { version->new($element) };
320   # XXX check defined $v and not just $v because version objects leak memory
321   # in boolean context -- dagolden, 2012-02-03
322   if ( defined $v ) {
323     return $v->is_qv ? $v->normal : $element;
324   }
325   else {
326     return 0;
327   }
328 }
329
330 sub _version_map {
331   my ($element) = @_;
332   return unless defined $element;
333   if ( ref $element eq 'HASH' ) {
334     my $new_map = {};
335     for my $k ( keys %$element ) {
336       next unless _is_module_name($k);
337       my $value = $element->{$k};
338       if ( ! ( defined $value && length $value ) ) {
339         $new_map->{$k} = 0;
340       }
341       elsif ( $value eq 'undef' || $value eq '<undef>' ) {
342         $new_map->{$k} = 0;
343       }
344       elsif ( _is_module_name( $value ) ) { # some weird, old META have this
345         $new_map->{$k} = 0;
346         $new_map->{$value} = 0;
347       }
348       else {
349         $new_map->{$k} = _clean_version($value);
350       }
351     }
352     return $new_map;
353   }
354   elsif ( ref $element eq 'ARRAY' ) {
355     my $hashref = { map { $_ => 0 } @$element };
356     return _version_map($hashref); # cleanup any weird stuff
357   }
358   elsif ( ref $element eq '' && length $element ) {
359     return { $element => 0 }
360   }
361   return;
362 }
363
364 sub _prereqs_from_1 {
365   my (undef, undef, $meta) = @_;
366   my $prereqs = {};
367   for my $phase ( qw/build configure/ ) {
368     my $key = "${phase}_requires";
369     $prereqs->{$phase}{requires} = _version_map($meta->{$key})
370       if $meta->{$key};
371   }
372   for my $rel ( qw/requires recommends conflicts/ ) {
373     $prereqs->{runtime}{$rel} = _version_map($meta->{$rel})
374       if $meta->{$rel};
375   }
376   return $prereqs;
377 }
378
379 my $prereqs_spec = {
380   configure => \&_prereqs_rel,
381   build     => \&_prereqs_rel,
382   test      => \&_prereqs_rel,
383   runtime   => \&_prereqs_rel,
384   develop   => \&_prereqs_rel,
385   ':custom'  => \&_prefix_custom,
386 };
387
388 my $relation_spec = {
389   requires   => \&_version_map,
390   recommends => \&_version_map,
391   suggests   => \&_version_map,
392   conflicts  => \&_version_map,
393   ':custom'  => \&_prefix_custom,
394 };
395
396 sub _cleanup_prereqs {
397   my ($prereqs, $key, $meta, $to_version) = @_;
398   return unless $prereqs && ref $prereqs eq 'HASH';
399   return _convert( $prereqs, $prereqs_spec, $to_version );
400 }
401
402 sub _prereqs_rel {
403   my ($relation, $key, $meta, $to_version) = @_;
404   return unless $relation && ref $relation eq 'HASH';
405   return _convert( $relation, $relation_spec, $to_version );
406 }
407
408
409 BEGIN {
410   my @old_prereqs = qw(
411     requires
412     configure_requires
413     recommends
414     conflicts
415   );
416
417   for ( @old_prereqs ) {
418     my $sub = "_get_$_";
419     my ($phase,$type) = split qr/_/, $_;
420     if ( ! defined $type ) {
421       $type = $phase;
422       $phase = 'runtime';
423     }
424     no strict 'refs';
425     *{$sub} = sub { _extract_prereqs($_[2]->{prereqs},$phase,$type) };
426   }
427 }
428
429 sub _get_build_requires {
430   my ($data, $key, $meta) = @_;
431
432   my $test_h  = _extract_prereqs($_[2]->{prereqs}, qw(test  requires)) || {};
433   my $build_h = _extract_prereqs($_[2]->{prereqs}, qw(build requires)) || {};
434
435   require CPAN::Meta::Requirements;
436   my $test_req  = CPAN::Meta::Requirements->from_string_hash($test_h);
437   my $build_req = CPAN::Meta::Requirements->from_string_hash($build_h);
438
439   $test_req->add_requirements($build_req)->as_string_hash;
440 }
441
442 sub _extract_prereqs {
443   my ($prereqs, $phase, $type) = @_;
444   return unless ref $prereqs eq 'HASH';
445   return $prereqs->{$phase}{$type};
446 }
447
448 sub _downgrade_optional_features {
449   my (undef, undef, $meta) = @_;
450   return unless exists $meta->{optional_features};
451   my $origin = $meta->{optional_features};
452   my $features = {};
453   for my $name ( keys %$origin ) {
454     $features->{$name} = {
455       description => $origin->{$name}{description},
456       requires => _extract_prereqs($origin->{$name}{prereqs},'runtime','requires'),
457       configure_requires => _extract_prereqs($origin->{$name}{prereqs},'runtime','configure_requires'),
458       build_requires => _extract_prereqs($origin->{$name}{prereqs},'runtime','build_requires'),
459       recommends => _extract_prereqs($origin->{$name}{prereqs},'runtime','recommends'),
460       conflicts => _extract_prereqs($origin->{$name}{prereqs},'runtime','conflicts'),
461     };
462     for my $k (keys %{$features->{$name}} ) {
463       delete $features->{$name}{$k} unless defined $features->{$name}{$k};
464     }
465   }
466   return $features;
467 }
468
469 sub _upgrade_optional_features {
470   my (undef, undef, $meta) = @_;
471   return unless exists $meta->{optional_features};
472   my $origin = $meta->{optional_features};
473   my $features = {};
474   for my $name ( keys %$origin ) {
475     $features->{$name} = {
476       description => $origin->{$name}{description},
477       prereqs => _prereqs_from_1(undef, undef, $origin->{$name}),
478     };
479     delete $features->{$name}{prereqs}{configure};
480   }
481   return $features;
482 }
483
484 my $optional_features_2_spec = {
485   description => \&_keep,
486   prereqs => \&_cleanup_prereqs,
487   ':custom'  => \&_prefix_custom,
488 };
489
490 sub _feature_2 {
491   my ($element, $key, $meta, $to_version) = @_;
492   return unless $element && ref $element eq 'HASH';
493   _convert( $element, $optional_features_2_spec, $to_version );
494 }
495
496 sub _cleanup_optional_features_2 {
497   my ($element, $key, $meta, $to_version) = @_;
498   return unless $element && ref $element eq 'HASH';
499   my $new_data = {};
500   for my $k ( keys %$element ) {
501     $new_data->{$k} = _feature_2( $element->{$k}, $k, $meta, $to_version );
502   }
503   return unless keys %$new_data;
504   return $new_data;
505 }
506
507 sub _optional_features_1_4 {
508   my ($element) = @_;
509   return unless $element;
510   $element = _optional_features_as_map($element);
511   for my $name ( keys %$element ) {
512     for my $drop ( qw/requires_packages requires_os excluded_os/ ) {
513       delete $element->{$name}{$drop};
514     }
515   }
516   return $element;
517 }
518
519 sub _optional_features_as_map {
520   my ($element) = @_;
521   return unless $element;
522   if ( ref $element eq 'ARRAY' ) {
523     my %map;
524     for my $feature ( @$element ) {
525       my (@parts) = %$feature;
526       $map{$parts[0]} = $parts[1];
527     }
528     $element = \%map;
529   }
530   return $element;
531 }
532
533 sub _is_urlish { defined $_[0] && $_[0] =~ m{\A[-+.a-z0-9]+:.+}i }
534
535 sub _url_or_drop {
536   my ($element) = @_;
537   return $element if _is_urlish($element);
538   return;
539 }
540
541 sub _url_list {
542   my ($element) = @_;
543   return unless $element;
544   $element = _listify( $element );
545   $element = [ grep { _is_urlish($_) } @$element ];
546   return unless @$element;
547   return $element;
548 }
549
550 sub _author_list {
551   my ($element) = @_;
552   return [ 'unknown' ] unless $element;
553   $element = _listify( $element );
554   $element = [ map { defined $_ && length $_ ? $_ : 'unknown' } @$element ];
555   return [ 'unknown' ] unless @$element;
556   return $element;
557 }
558
559 my $resource2_upgrade = {
560   license    => sub { return _is_urlish($_[0]) ? _listify( $_[0] ) : undef },
561   homepage   => \&_url_or_drop,
562   bugtracker => sub {
563     my ($item) = @_;
564     return unless $item;
565     if ( $item =~ m{^mailto:(.*)$} ) { return { mailto => $1 } }
566     elsif( _is_urlish($item) ) { return { web => $item } }
567     else { return }
568   },
569   repository => sub { return _is_urlish($_[0]) ? { url => $_[0] } : undef },
570   ':custom'  => \&_prefix_custom,
571 };
572
573 sub _upgrade_resources_2 {
574   my (undef, undef, $meta, $version) = @_;
575   return unless exists $meta->{resources};
576   return _convert($meta->{resources}, $resource2_upgrade);
577 }
578
579 my $bugtracker2_spec = {
580   web => \&_url_or_drop,
581   mailto => \&_keep,
582   ':custom'  => \&_prefix_custom,
583 };
584
585 sub _repo_type {
586   my ($element, $key, $meta, $to_version) = @_;
587   return $element if defined $element;
588   return unless exists $meta->{url};
589   my $repo_url = $meta->{url};
590   for my $type ( qw/git svn/ ) {
591     return $type if $repo_url =~ m{\A$type};
592   }
593   return;
594 }
595
596 my $repository2_spec = {
597   web => \&_url_or_drop,
598   url => \&_url_or_drop,
599   type => \&_repo_type,
600   ':custom'  => \&_prefix_custom,
601 };
602
603 my $resources2_cleanup = {
604   license    => \&_url_list,
605   homepage   => \&_url_or_drop,
606   bugtracker => sub { ref $_[0] ? _convert( $_[0], $bugtracker2_spec ) : undef },
607   repository => sub { my $data = shift; ref $data ? _convert( $data, $repository2_spec ) : undef },
608   ':custom'  => \&_prefix_custom,
609 };
610
611 sub _cleanup_resources_2 {
612   my ($resources, $key, $meta, $to_version) = @_;
613   return unless $resources && ref $resources eq 'HASH';
614   return _convert($resources, $resources2_cleanup, $to_version);
615 }
616
617 my $resource1_spec = {
618   license    => \&_url_or_drop,
619   homepage   => \&_url_or_drop,
620   bugtracker => \&_url_or_drop,
621   repository => \&_url_or_drop,
622   ':custom'  => \&_keep,
623 };
624
625 sub _resources_1_3 {
626   my (undef, undef, $meta, $version) = @_;
627   return unless exists $meta->{resources};
628   return _convert($meta->{resources}, $resource1_spec);
629 }
630
631 *_resources_1_4 = *_resources_1_3;
632
633 sub _resources_1_2 {
634   my (undef, undef, $meta) = @_;
635   my $resources = $meta->{resources} || {};
636   if ( $meta->{license_url} && ! $resources->{license} ) {
637     $resources->{license} = $meta->license_url
638       if _is_urlish($meta->{license_url});
639   }
640   return unless keys %$resources;
641   return _convert($resources, $resource1_spec);
642 }
643
644 my $resource_downgrade_spec = {
645   license    => sub { return ref $_[0] ? $_[0]->[0] : $_[0] },
646   homepage   => \&_url_or_drop,
647   bugtracker => sub { return $_[0]->{web} },
648   repository => sub { return $_[0]->{url} || $_[0]->{web} },
649   ':custom'  => \&_ucfirst_custom,
650 };
651
652 sub _downgrade_resources {
653   my (undef, undef, $meta, $version) = @_;
654   return unless exists $meta->{resources};
655   return _convert($meta->{resources}, $resource_downgrade_spec);
656 }
657
658 sub _release_status {
659   my ($element, undef, $meta) = @_;
660   return $element if $element && $element =~ m{\A(?:stable|testing|unstable)\z};
661   return _release_status_from_version(undef, undef, $meta);
662 }
663
664 sub _release_status_from_version {
665   my (undef, undef, $meta) = @_;
666   my $version = $meta->{version} || '';
667   return ( $version =~ /_/ ) ? 'testing' : 'stable';
668 }
669
670 my $provides_spec = {
671   file => \&_keep,
672   version => \&_clean_version,
673 };
674
675 my $provides_spec_2 = {
676   file => \&_keep,
677   version => \&_clean_version,
678   ':custom'  => \&_prefix_custom,
679 };
680
681 sub _provides {
682   my ($element, $key, $meta, $to_version) = @_;
683   return unless defined $element && ref $element eq 'HASH';
684   my $spec = $to_version == 2 ? $provides_spec_2 : $provides_spec;
685   my $new_data = {};
686   for my $k ( keys %$element ) {
687     $new_data->{$k} = _convert($element->{$k}, $spec, $to_version);
688   }
689   return $new_data;
690 }
691
692 sub _convert {
693   my ($data, $spec, $to_version) = @_;
694
695   my $new_data = {};
696   for my $key ( keys %$spec ) {
697     next if $key eq ':custom' || $key eq ':drop';
698     next unless my $fcn = $spec->{$key};
699     die "spec for '$key' is not a coderef"
700       unless ref $fcn && ref $fcn eq 'CODE';
701     my $new_value = $fcn->($data->{$key}, $key, $data, $to_version);
702     $new_data->{$key} = $new_value if defined $new_value;
703   }
704
705   my $drop_list   = $spec->{':drop'};
706   my $customizer  = $spec->{':custom'} || \&_keep;
707
708   for my $key ( keys %$data ) {
709     next if $drop_list && grep { $key eq $_ } @$drop_list;
710     next if exists $spec->{$key}; # we handled it
711     $new_data->{ $customizer->($key) } = $data->{$key};
712   }
713
714   return $new_data;
715 }
716
717 #--------------------------------------------------------------------------#
718 # define converters for each conversion
719 #--------------------------------------------------------------------------#
720
721 # each converts from prior version
722 # special ":custom" field is used for keys not recognized in spec
723 my %up_convert = (
724   '2-from-1.4' => {
725     # PRIOR MANDATORY
726     'abstract'            => \&_keep_or_unknown,
727     'author'              => \&_author_list,
728     'generated_by'        => \&_generated_by,
729     'license'             => \&_license_2,
730     'meta-spec'           => \&_change_meta_spec,
731     'name'                => \&_keep,
732     'version'             => \&_keep,
733     # CHANGED TO MANDATORY
734     'dynamic_config'      => \&_keep_or_one,
735     # ADDED MANDATORY
736     'release_status'      => \&_release_status_from_version,
737     # PRIOR OPTIONAL
738     'keywords'            => \&_keep,
739     'no_index'            => \&_no_index_directory,
740     'optional_features'   => \&_upgrade_optional_features,
741     'provides'            => \&_provides,
742     'resources'           => \&_upgrade_resources_2,
743     # ADDED OPTIONAL
744     'description'         => \&_keep,
745     'prereqs'             => \&_prereqs_from_1,
746
747     # drop these deprecated fields, but only after we convert
748     ':drop' => [ qw(
749         build_requires
750         configure_requires
751         conflicts
752         distribution_type
753         license_url
754         private
755         recommends
756         requires
757     ) ],
758
759     # other random keys need x_ prefixing
760     ':custom'              => \&_prefix_custom,
761   },
762   '1.4-from-1.3' => {
763     # PRIOR MANDATORY
764     'abstract'            => \&_keep_or_unknown,
765     'author'              => \&_author_list,
766     'generated_by'        => \&_generated_by,
767     'license'             => \&_license_1,
768     'meta-spec'           => \&_change_meta_spec,
769     'name'                => \&_keep,
770     'version'             => \&_keep,
771     # PRIOR OPTIONAL
772     'build_requires'      => \&_version_map,
773     'conflicts'           => \&_version_map,
774     'distribution_type'   => \&_keep,
775     'dynamic_config'      => \&_keep_or_one,
776     'keywords'            => \&_keep,
777     'no_index'            => \&_no_index_directory,
778     'optional_features'   => \&_optional_features_1_4,
779     'provides'            => \&_provides,
780     'recommends'          => \&_version_map,
781     'requires'            => \&_version_map,
782     'resources'           => \&_resources_1_4,
783     # ADDED OPTIONAL
784     'configure_requires'  => \&_keep,
785
786     # drop these deprecated fields, but only after we convert
787     ':drop' => [ qw(
788       license_url
789       private
790     )],
791
792     # other random keys are OK if already valid
793     ':custom'              => \&_keep
794   },
795   '1.3-from-1.2' => {
796     # PRIOR MANDATORY
797     'abstract'            => \&_keep_or_unknown,
798     'author'              => \&_author_list,
799     'generated_by'        => \&_generated_by,
800     'license'             => \&_license_1,
801     'meta-spec'           => \&_change_meta_spec,
802     'name'                => \&_keep,
803     'version'             => \&_keep,
804     # PRIOR OPTIONAL
805     'build_requires'      => \&_version_map,
806     'conflicts'           => \&_version_map,
807     'distribution_type'   => \&_keep,
808     'dynamic_config'      => \&_keep_or_one,
809     'keywords'            => \&_keep,
810     'no_index'            => \&_no_index_directory,
811     'optional_features'   => \&_optional_features_as_map,
812     'provides'            => \&_provides,
813     'recommends'          => \&_version_map,
814     'requires'            => \&_version_map,
815     'resources'           => \&_resources_1_3,
816
817     # drop these deprecated fields, but only after we convert
818     ':drop' => [ qw(
819       license_url
820       private
821     )],
822
823     # other random keys are OK if already valid
824     ':custom'              => \&_keep
825   },
826   '1.2-from-1.1' => {
827     # PRIOR MANDATORY
828     'version'             => \&_keep,
829     # CHANGED TO MANDATORY
830     'license'             => \&_license_1,
831     'name'                => \&_keep,
832     'generated_by'        => \&_generated_by,
833     # ADDED MANDATORY
834     'abstract'            => \&_keep_or_unknown,
835     'author'              => \&_author_list,
836     'meta-spec'           => \&_change_meta_spec,
837     # PRIOR OPTIONAL
838     'build_requires'      => \&_version_map,
839     'conflicts'           => \&_version_map,
840     'distribution_type'   => \&_keep,
841     'dynamic_config'      => \&_keep_or_one,
842     'recommends'          => \&_version_map,
843     'requires'            => \&_version_map,
844     # ADDED OPTIONAL
845     'keywords'            => \&_keep,
846     'no_index'            => \&_no_index_1_2,
847     'optional_features'   => \&_optional_features_as_map,
848     'provides'            => \&_provides,
849     'resources'           => \&_resources_1_2,
850
851     # drop these deprecated fields, but only after we convert
852     ':drop' => [ qw(
853       license_url
854       private
855     )],
856
857     # other random keys are OK if already valid
858     ':custom'              => \&_keep
859   },
860   '1.1-from-1.0' => {
861     # CHANGED TO MANDATORY
862     'version'             => \&_keep,
863     # IMPLIED MANDATORY
864     'name'                => \&_keep,
865     # PRIOR OPTIONAL
866     'build_requires'      => \&_version_map,
867     'conflicts'           => \&_version_map,
868     'distribution_type'   => \&_keep,
869     'dynamic_config'      => \&_keep_or_one,
870     'generated_by'        => \&_generated_by,
871     'license'             => \&_license_1,
872     'recommends'          => \&_version_map,
873     'requires'            => \&_version_map,
874     # ADDED OPTIONAL
875     'license_url'         => \&_url_or_drop,
876     'private'             => \&_keep,
877
878     # other random keys are OK if already valid
879     ':custom'              => \&_keep
880   },
881 );
882
883 my %down_convert = (
884   '1.4-from-2' => {
885     # MANDATORY
886     'abstract'            => \&_keep_or_unknown,
887     'author'              => \&_author_list,
888     'generated_by'        => \&_generated_by,
889     'license'             => \&_downgrade_license,
890     'meta-spec'           => \&_change_meta_spec,
891     'name'                => \&_keep,
892     'version'             => \&_keep,
893     # OPTIONAL
894     'build_requires'      => \&_get_build_requires,
895     'configure_requires'  => \&_get_configure_requires,
896     'conflicts'           => \&_get_conflicts,
897     'distribution_type'   => \&_keep,
898     'dynamic_config'      => \&_keep_or_one,
899     'keywords'            => \&_keep,
900     'no_index'            => \&_no_index_directory,
901     'optional_features'   => \&_downgrade_optional_features,
902     'provides'            => \&_provides,
903     'recommends'          => \&_get_recommends,
904     'requires'            => \&_get_requires,
905     'resources'           => \&_downgrade_resources,
906
907     # drop these unsupported fields (after conversion)
908     ':drop' => [ qw(
909       description
910       prereqs
911       release_status
912     )],
913
914     # custom keys will be left unchanged
915     ':custom'              => \&_keep
916   },
917   '1.3-from-1.4' => {
918     # MANDATORY
919     'abstract'            => \&_keep_or_unknown,
920     'author'              => \&_author_list,
921     'generated_by'        => \&_generated_by,
922     'license'             => \&_license_1,
923     'meta-spec'           => \&_change_meta_spec,
924     'name'                => \&_keep,
925     'version'             => \&_keep,
926     # OPTIONAL
927     'build_requires'      => \&_version_map,
928     'conflicts'           => \&_version_map,
929     'distribution_type'   => \&_keep,
930     'dynamic_config'      => \&_keep_or_one,
931     'keywords'            => \&_keep,
932     'no_index'            => \&_no_index_directory,
933     'optional_features'   => \&_optional_features_as_map,
934     'provides'            => \&_provides,
935     'recommends'          => \&_version_map,
936     'requires'            => \&_version_map,
937     'resources'           => \&_resources_1_3,
938
939     # drop these unsupported fields, but only after we convert
940     ':drop' => [ qw(
941       configure_requires
942     )],
943
944     # other random keys are OK if already valid
945     ':custom'              => \&_keep,
946   },
947   '1.2-from-1.3' => {
948     # MANDATORY
949     'abstract'            => \&_keep_or_unknown,
950     'author'              => \&_author_list,
951     'generated_by'        => \&_generated_by,
952     'license'             => \&_license_1,
953     'meta-spec'           => \&_change_meta_spec,
954     'name'                => \&_keep,
955     'version'             => \&_keep,
956     # OPTIONAL
957     'build_requires'      => \&_version_map,
958     'conflicts'           => \&_version_map,
959     'distribution_type'   => \&_keep,
960     'dynamic_config'      => \&_keep_or_one,
961     'keywords'            => \&_keep,
962     'no_index'            => \&_no_index_1_2,
963     'optional_features'   => \&_optional_features_as_map,
964     'provides'            => \&_provides,
965     'recommends'          => \&_version_map,
966     'requires'            => \&_version_map,
967     'resources'           => \&_resources_1_3,
968
969     # other random keys are OK if already valid
970     ':custom'              => \&_keep,
971   },
972   '1.1-from-1.2' => {
973     # MANDATORY
974     'version'             => \&_keep,
975     # IMPLIED MANDATORY
976     'name'                => \&_keep,
977     'meta-spec'           => \&_change_meta_spec,
978     # OPTIONAL
979     'build_requires'      => \&_version_map,
980     'conflicts'           => \&_version_map,
981     'distribution_type'   => \&_keep,
982     'dynamic_config'      => \&_keep_or_one,
983     'generated_by'        => \&_generated_by,
984     'license'             => \&_license_1,
985     'private'             => \&_keep,
986     'recommends'          => \&_version_map,
987     'requires'            => \&_version_map,
988
989     # drop unsupported fields
990     ':drop' => [ qw(
991       abstract
992       author
993       provides
994       no_index
995       keywords
996       resources
997     )],
998
999     # other random keys are OK if already valid
1000     ':custom'              => \&_keep,
1001   },
1002   '1.0-from-1.1' => {
1003     # IMPLIED MANDATORY
1004     'name'                => \&_keep,
1005     'meta-spec'           => \&_change_meta_spec,
1006     'version'             => \&_keep,
1007     # PRIOR OPTIONAL
1008     'build_requires'      => \&_version_map,
1009     'conflicts'           => \&_version_map,
1010     'distribution_type'   => \&_keep,
1011     'dynamic_config'      => \&_keep_or_one,
1012     'generated_by'        => \&_generated_by,
1013     'license'             => \&_license_1,
1014     'recommends'          => \&_version_map,
1015     'requires'            => \&_version_map,
1016
1017     # other random keys are OK if already valid
1018     ':custom'              => \&_keep,
1019   },
1020 );
1021
1022 my %cleanup = (
1023   '2' => {
1024     # PRIOR MANDATORY
1025     'abstract'            => \&_keep_or_unknown,
1026     'author'              => \&_author_list,
1027     'generated_by'        => \&_generated_by,
1028     'license'             => \&_license_2,
1029     'meta-spec'           => \&_change_meta_spec,
1030     'name'                => \&_keep,
1031     'version'             => \&_keep,
1032     # CHANGED TO MANDATORY
1033     'dynamic_config'      => \&_keep_or_one,
1034     # ADDED MANDATORY
1035     'release_status'      => \&_release_status,
1036     # PRIOR OPTIONAL
1037     'keywords'            => \&_keep,
1038     'no_index'            => \&_no_index_directory,
1039     'optional_features'   => \&_cleanup_optional_features_2,
1040     'provides'            => \&_provides,
1041     'resources'           => \&_cleanup_resources_2,
1042     # ADDED OPTIONAL
1043     'description'         => \&_keep,
1044     'prereqs'             => \&_cleanup_prereqs,
1045
1046     # drop these deprecated fields, but only after we convert
1047     ':drop' => [ qw(
1048         build_requires
1049         configure_requires
1050         conflicts
1051         distribution_type
1052         license_url
1053         private
1054         recommends
1055         requires
1056     ) ],
1057
1058     # other random keys need x_ prefixing
1059     ':custom'              => \&_prefix_custom,
1060   },
1061   '1.4' => {
1062     # PRIOR MANDATORY
1063     'abstract'            => \&_keep_or_unknown,
1064     'author'              => \&_author_list,
1065     'generated_by'        => \&_generated_by,
1066     'license'             => \&_license_1,
1067     'meta-spec'           => \&_change_meta_spec,
1068     'name'                => \&_keep,
1069     'version'             => \&_keep,
1070     # PRIOR OPTIONAL
1071     'build_requires'      => \&_version_map,
1072     'conflicts'           => \&_version_map,
1073     'distribution_type'   => \&_keep,
1074     'dynamic_config'      => \&_keep_or_one,
1075     'keywords'            => \&_keep,
1076     'no_index'            => \&_no_index_directory,
1077     'optional_features'   => \&_optional_features_1_4,
1078     'provides'            => \&_provides,
1079     'recommends'          => \&_version_map,
1080     'requires'            => \&_version_map,
1081     'resources'           => \&_resources_1_4,
1082     # ADDED OPTIONAL
1083     'configure_requires'  => \&_keep,
1084
1085     # other random keys are OK if already valid
1086     ':custom'             => \&_keep
1087   },
1088   '1.3' => {
1089     # PRIOR MANDATORY
1090     'abstract'            => \&_keep_or_unknown,
1091     'author'              => \&_author_list,
1092     'generated_by'        => \&_generated_by,
1093     'license'             => \&_license_1,
1094     'meta-spec'           => \&_change_meta_spec,
1095     'name'                => \&_keep,
1096     'version'             => \&_keep,
1097     # PRIOR OPTIONAL
1098     'build_requires'      => \&_version_map,
1099     'conflicts'           => \&_version_map,
1100     'distribution_type'   => \&_keep,
1101     'dynamic_config'      => \&_keep_or_one,
1102     'keywords'            => \&_keep,
1103     'no_index'            => \&_no_index_directory,
1104     'optional_features'   => \&_optional_features_as_map,
1105     'provides'            => \&_provides,
1106     'recommends'          => \&_version_map,
1107     'requires'            => \&_version_map,
1108     'resources'           => \&_resources_1_3,
1109
1110     # other random keys are OK if already valid
1111     ':custom'             => \&_keep
1112   },
1113   '1.2' => {
1114     # PRIOR MANDATORY
1115     'version'             => \&_keep,
1116     # CHANGED TO MANDATORY
1117     'license'             => \&_license_1,
1118     'name'                => \&_keep,
1119     'generated_by'        => \&_generated_by,
1120     # ADDED MANDATORY
1121     'abstract'            => \&_keep_or_unknown,
1122     'author'              => \&_author_list,
1123     'meta-spec'           => \&_change_meta_spec,
1124     # PRIOR OPTIONAL
1125     'build_requires'      => \&_version_map,
1126     'conflicts'           => \&_version_map,
1127     'distribution_type'   => \&_keep,
1128     'dynamic_config'      => \&_keep_or_one,
1129     'recommends'          => \&_version_map,
1130     'requires'            => \&_version_map,
1131     # ADDED OPTIONAL
1132     'keywords'            => \&_keep,
1133     'no_index'            => \&_no_index_1_2,
1134     'optional_features'   => \&_optional_features_as_map,
1135     'provides'            => \&_provides,
1136     'resources'           => \&_resources_1_2,
1137
1138     # other random keys are OK if already valid
1139     ':custom'             => \&_keep
1140   },
1141   '1.1' => {
1142     # CHANGED TO MANDATORY
1143     'version'             => \&_keep,
1144     # IMPLIED MANDATORY
1145     'name'                => \&_keep,
1146     'meta-spec'           => \&_change_meta_spec,
1147     # PRIOR OPTIONAL
1148     'build_requires'      => \&_version_map,
1149     'conflicts'           => \&_version_map,
1150     'distribution_type'   => \&_keep,
1151     'dynamic_config'      => \&_keep_or_one,
1152     'generated_by'        => \&_generated_by,
1153     'license'             => \&_license_1,
1154     'recommends'          => \&_version_map,
1155     'requires'            => \&_version_map,
1156     # ADDED OPTIONAL
1157     'license_url'         => \&_url_or_drop,
1158     'private'             => \&_keep,
1159
1160     # other random keys are OK if already valid
1161     ':custom'             => \&_keep
1162   },
1163   '1.0' => {
1164     # IMPLIED MANDATORY
1165     'name'                => \&_keep,
1166     'meta-spec'           => \&_change_meta_spec,
1167     'version'             => \&_keep,
1168     # IMPLIED OPTIONAL
1169     'build_requires'      => \&_version_map,
1170     'conflicts'           => \&_version_map,
1171     'distribution_type'   => \&_keep,
1172     'dynamic_config'      => \&_keep_or_one,
1173     'generated_by'        => \&_generated_by,
1174     'license'             => \&_license_1,
1175     'recommends'          => \&_version_map,
1176     'requires'            => \&_version_map,
1177
1178     # other random keys are OK if already valid
1179     ':custom'             => \&_keep,
1180   },
1181 );
1182
1183 #--------------------------------------------------------------------------#
1184 # Code
1185 #--------------------------------------------------------------------------#
1186
1187
1188 sub new {
1189   my ($class,$data) = @_;
1190
1191   # create an attributes hash
1192   my $self = {
1193     'data'    => $data,
1194     'spec'    => $data->{'meta-spec'}{'version'} || "1.0",
1195   };
1196
1197   # create the object
1198   return bless $self, $class;
1199 }
1200
1201
1202 sub convert {
1203   my ($self, %args) = @_;
1204   my $args = { %args };
1205
1206   my $new_version = $args->{version} || $HIGHEST;
1207
1208   my ($old_version) = $self->{spec};
1209   my $converted = _dclone($self->{data});
1210
1211   if ( $old_version == $new_version ) {
1212     $converted = _convert( $converted, $cleanup{$old_version}, $old_version );
1213     my $cmv = CPAN::Meta::Validator->new( $converted );
1214     unless ( $cmv->is_valid ) {
1215       my $errs = join("\n", $cmv->errors);
1216       die "Failed to clean-up $old_version metadata. Errors:\n$errs\n";
1217     }
1218     return $converted;
1219   }
1220   elsif ( $old_version > $new_version )  {
1221     my @vers = sort { $b <=> $a } keys %known_specs;
1222     for my $i ( 0 .. $#vers-1 ) {
1223       next if $vers[$i] > $old_version;
1224       last if $vers[$i+1] < $new_version;
1225       my $spec_string = "$vers[$i+1]-from-$vers[$i]";
1226       $converted = _convert( $converted, $down_convert{$spec_string}, $vers[$i+1] );
1227       my $cmv = CPAN::Meta::Validator->new( $converted );
1228       unless ( $cmv->is_valid ) {
1229         my $errs = join("\n", $cmv->errors);
1230         die "Failed to downconvert metadata to $vers[$i+1]. Errors:\n$errs\n";
1231       }
1232     }
1233     return $converted;
1234   }
1235   else {
1236     my @vers = sort { $a <=> $b } keys %known_specs;
1237     for my $i ( 0 .. $#vers-1 ) {
1238       next if $vers[$i] < $old_version;
1239       last if $vers[$i+1] > $new_version;
1240       my $spec_string = "$vers[$i+1]-from-$vers[$i]";
1241       $converted = _convert( $converted, $up_convert{$spec_string}, $vers[$i+1] );
1242       my $cmv = CPAN::Meta::Validator->new( $converted );
1243       unless ( $cmv->is_valid ) {
1244         my $errs = join("\n", $cmv->errors);
1245         die "Failed to upconvert metadata to $vers[$i+1]. Errors:\n$errs\n";
1246       }
1247     }
1248     return $converted;
1249   }
1250 }
1251
1252 1;
1253
1254 # ABSTRACT: Convert CPAN distribution metadata structures
1255
1256
1257
1258 =pod
1259
1260 =head1 NAME
1261
1262 CPAN::Meta::Converter - Convert CPAN distribution metadata structures
1263
1264 =head1 VERSION
1265
1266 version 2.120351
1267
1268 =head1 SYNOPSIS
1269
1270   my $struct = decode_json_file('META.json');
1271
1272   my $cmc = CPAN::Meta::Converter->new( $struct );
1273
1274   my $new_struct = $cmc->convert( version => "2" );
1275
1276 =head1 DESCRIPTION
1277
1278 This module converts CPAN Meta structures from one form to another.  The
1279 primary use is to convert older structures to the most modern version of
1280 the specification, but other transformations may be implemented in the
1281 future as needed.  (E.g. stripping all custom fields or stripping all
1282 optional fields.)
1283
1284 =head1 METHODS
1285
1286 =head2 new
1287
1288   my $cmc = CPAN::Meta::Converter->new( $struct );
1289
1290 The constructor should be passed a valid metadata structure but invalid
1291 structures are accepted.  If no meta-spec version is provided, version 1.0 will
1292 be assumed.
1293
1294 =head2 convert
1295
1296   my $new_struct = $cmc->convert( version => "2" );
1297
1298 Returns a new hash reference with the metadata converted to a different form.
1299 C<convert> will die if any conversion/standardization still results in an
1300 invalid structure.
1301
1302 Valid parameters include:
1303
1304 =over
1305
1306 =item *
1307
1308 C<version> -- Indicates the desired specification version (e.g. "1.0", "1.1" ... "1.4", "2").
1309 Defaults to the latest version of the CPAN Meta Spec.
1310
1311 =back
1312
1313 Conversion proceeds through each version in turn.  For example, a version 1.2
1314 structure might be converted to 1.3 then 1.4 then finally to version 2. The
1315 conversion process attempts to clean-up simple errors and standardize data.
1316 For example, if C<author> is given as a scalar, it will converted to an array
1317 reference containing the item. (Converting a structure to its own version will
1318 also clean-up and standardize.)
1319
1320 When data are cleaned and standardized, missing or invalid fields will be
1321 replaced with sensible defaults when possible.  This may be lossy or imprecise.
1322 For example, some badly structured META.yml files on CPAN have prerequisite
1323 modules listed as both keys and values:
1324
1325   requires => { 'Foo::Bar' => 'Bam::Baz' }
1326
1327 These would be split and each converted to a prerequisite with a minimum
1328 version of zero.
1329
1330 When some mandatory fields are missing or invalid, the conversion will attempt
1331 to provide a sensible default or will fill them with a value of 'unknown'.  For
1332 example a missing or unrecognized C<license> field will result in a C<license>
1333 field of 'unknown'.  Fields that may get an 'unknown' include:
1334
1335 =over 4
1336
1337 =item *
1338
1339 abstract
1340
1341 =item *
1342
1343 author
1344
1345 =item *
1346
1347 license
1348
1349 =back
1350
1351 =head1 BUGS
1352
1353 Please report any bugs or feature using the CPAN Request Tracker.
1354 Bugs can be submitted through the web interface at
1355 L<http://rt.cpan.org/Dist/Display.html?Queue=CPAN-Meta>
1356
1357 When submitting a bug or request, please include a test-file or a patch to an
1358 existing test-file that illustrates the bug or desired feature.
1359
1360 =head1 AUTHORS
1361
1362 =over 4
1363
1364 =item *
1365
1366 David Golden <dagolden@cpan.org>
1367
1368 =item *
1369
1370 Ricardo Signes <rjbs@cpan.org>
1371
1372 =back
1373
1374 =head1 COPYRIGHT AND LICENSE
1375
1376 This software is copyright (c) 2010 by David Golden and Ricardo Signes.
1377
1378 This is free software; you can redistribute it and/or modify it under
1379 the same terms as the Perl 5 programming language system itself.
1380
1381 =cut
1382
1383
1384 __END__
1385
1386