1use strict; 2use warnings; 3use Test::More 0.88; 4use utf8; 5 6use CPAN::Meta; 7use CPAN::Meta::Validator; 8use CPAN::Meta::Converter; 9use File::Spec; 10use File::Basename qw/basename/; 11use IO::Dir; 12use Parse::CPAN::Meta 1.4400; 13use version; 14 15delete $ENV{$_} for qw/PERL_JSON_BACKEND PERL_YAML_BACKEND/; # use defaults 16 17# mock file object 18package 19 File::StringObject; 20 21use overload q{""} => sub { ${$_[0]} }, fallback => 1; 22 23sub new { 24 my ($class, $file) = @_; 25 bless \$file, $class; 26} 27 28package main; 29 30my $data_dir = IO::Dir->new( 't/data-test' ); 31my @files = sort grep { /^\w/ } $data_dir->read; 32 33*_spec_version = \&CPAN::Meta::Converter::_extract_spec_version; 34 35#use Data::Dumper; 36 37for my $f ( reverse sort @files ) { 38 my $path = File::Spec->catfile('t','data-test',$f); 39 my $original = Parse::CPAN::Meta->load_file( $path ); 40 ok( $original, "loaded $f" ); 41 my $original_v = _spec_version($original); 42 # UPCONVERSION 43 { 44 my $cmc = CPAN::Meta::Converter->new( $original ); 45 my $converted = $cmc->convert( version => 2 ); 46 is ( _spec_version($converted), 2, "up converted spec version $original_v to spec version 2"); 47 my $cmv = CPAN::Meta::Validator->new( $converted ); 48 ok ( $cmv->is_valid, "up converted META is valid" ) 49 or diag( "ERRORS:\n" . join( "\n", $cmv->errors ) 50# . "\nMETA:\n" . Dumper($converted) 51 ); 52 } 53 # UPCONVERSION - partial 54 if ( _spec_version( $original ) < 2 ) { 55 my $cmc = CPAN::Meta::Converter->new( $original ); 56 my $converted = $cmc->convert( version => '1.4' ); 57 is ( _spec_version($converted), 1.4, "up converted spec version $original_v to spec version 1.4"); 58 my $cmv = CPAN::Meta::Validator->new( $converted ); 59 ok ( $cmv->is_valid, "up converted META is valid" ) 60 or diag( "ERRORS:\n" . join( "\n", $cmv->errors ) 61# . "\nMETA:\n" . Dumper($converted) 62 ); 63 } 64 # DOWNCONVERSION - partial 65 if ( _spec_version( $original ) >= 1.2 ) { 66 my $cmc = CPAN::Meta::Converter->new( $original ); 67 my $converted = $cmc->convert( version => '1.2' ); 68 is ( _spec_version($converted), '1.2', "down converted spec version $original_v to spec version 1.2"); 69 my $cmv = CPAN::Meta::Validator->new( $converted ); 70 ok ( $cmv->is_valid, "down converted META is valid" ) 71 or diag( "ERRORS:\n" . join( "\n", $cmv->errors ) 72# . "\nMETA:\n" . Dumper($converted) 73 ); 74 75 if (_spec_version( $original ) == 2) { 76 is_deeply( 77 $converted->{build_requires}, 78 { 79 'Test::More' => '0.88', 80 'Build::Requires' => '1.1', 81 'Test::Requires' => '1.2', 82 }, 83 "downconversion from 2 merge test and build requirements", 84 ); 85 } 86 } 87 # DOWNCONVERSION 88 { 89 my $cmc = CPAN::Meta::Converter->new( $original ); 90 my $converted = $cmc->convert( version => '1.0' ); 91 is ( _spec_version($converted), '1.0', "down converted spec version $original_v to spec version 1.0"); 92 my $cmv = CPAN::Meta::Validator->new( $converted ); 93 ok ( $cmv->is_valid, "down converted META is valid" ) 94 or diag( "ERRORS:\n" . join( "\n", $cmv->errors ) 95# . "\nMETA:\n" . Dumper($converted) 96 ); 97 98 unless ($original_v eq '1.0') { 99 like ( $converted->{generated_by}, 100 qr(\Q$original->{generated_by}\E, CPAN::Meta::Converter version \S+$), 101 "added converter mark to generated_by", 102 ); 103 } 104 } 105} 106 107# specific test for custom key handling 108{ 109 my $path = File::Spec->catfile('t','data-test','META-1_4.yml'); 110 my $original = Parse::CPAN::Meta->load_file( $path ); 111 ok( $original, "loaded META-1_4.yml" ); 112 my $cmc = CPAN::Meta::Converter->new( $original ); 113 my $up_converted = $cmc->convert( version => 2 ); 114 ok ( $up_converted->{x_whatever} && ! $up_converted->{'x-whatever'}, 115 "up converted 'x-' to 'x_'" 116 ); 117 ok ( $up_converted->{x_whatelse}, 118 "up converted 'x_' as 'x_'" 119 ); 120 ok ( $up_converted->{x_WhatNow} && ! $up_converted->{XWhatNow}, 121 "up converted 'XFoo' to 'x_Foo'" 122 ) or diag join("\n", keys %$up_converted); 123} 124 125# specific test for custom key handling 126{ 127 my $path = File::Spec->catfile('t','data-test','META-2.json'); 128 my $original = Parse::CPAN::Meta->load_file( $path ); 129 ok( $original, "loaded META-2.json" ); 130 my $cmc = CPAN::Meta::Converter->new( $original ); 131 my $down_converted = $cmc->convert( version => 1.4 ); 132 ok ( $down_converted->{x_whatever}, 133 "down converted 'x_' as 'x_'" 134 ); 135} 136 137# specific test for generalization of unclear licenses 138{ 139 my $path = File::Spec->catfile('t','data-test','gpl-1_4.yml'); 140 my $original = Parse::CPAN::Meta->load_file( $path ); 141 ok( $original, "loaded gpl-1_4.yml" ); 142 my $cmc = CPAN::Meta::Converter->new( $original ); 143 my $up_converted = $cmc->convert( version => 2 ); 144 is_deeply ( $up_converted->{license}, 145 [ "open_source" ], 146 "up converted 'gpl' to 'open_source'" 147 ); 148} 149 150# specific test for upconverting resources 151{ 152 my $path = File::Spec->catfile('t','data-test','resources.yml'); 153 my $original = Parse::CPAN::Meta->load_file( $path ); 154 ok( $original, "loaded resources.yml" ); 155 my $cmc = CPAN::Meta::Converter->new( $original ); 156 my $converted = $cmc->convert( version => 2 ); 157 is_deeply( 158 $converted->{resources}, 159 { x_MailingList => 'http://groups.google.com/group/www-mechanize-users', 160 x_Repository => 'http://code.google.com/p/www-mechanize/source', 161 homepage => 'http://code.google.com/p/www-mechanize/', 162 bugtracker => {web => 'http://code.google.com/p/www-mechanize/issues/list',}, 163 license => ['http://dev.perl.org/licenses/'], 164 }, 165 "upconversion of resources" 166 ); 167} 168 169# specific test for round-tripping resources 170{ 171 my $path = File::Spec->catfile('t','data-test','resources.yml'); 172 my $original = Parse::CPAN::Meta->load_file( $path ); 173 ok( $original, "loaded resources.yml" ); 174 my $cmc1 = CPAN::Meta::Converter->new( $original ); 175 my $converted = $cmc1->convert( version => 2 ); 176 my $cmc2 = CPAN::Meta::Converter->new( $converted ); 177 my $roundtrip = $cmc2->convert( version => 1.4 ); 178 is_deeply( 179 $roundtrip->{resources}, 180 $original->{resources}, 181 "round-trip of resources (1.4->2->1.4)" 182 ); 183} 184 185# specific test for object conversion 186{ 187 my $path = File::Spec->catfile('t','data-test','resources.yml'); 188 my $original = Parse::CPAN::Meta->load_file( $path ); 189 ok( $original, "loaded resources.yml" ); 190 $original->{version} = version->new("1.64"); 191 $original->{no_index}{file} = File::StringObject->new(".gitignore"); 192 pass( "replaced some data fields with objects" ); 193 my $cmc = CPAN::Meta::Converter->new( $original ); 194 ok( my $converted = $cmc->convert( version => 2 ), "conversion successful" ); 195} 196 197# specific test for UTF-8 handling 198{ 199 my $path = File::Spec->catfile('t','data-test','unicode.yml'); 200 my $original = CPAN::Meta->load_file( $path ) 201 or die "Couldn't load $path"; 202 ok( $original, "unicode.yml" ); 203 my @authors = $original->authors; 204 like( $authors[0], qr/Williåms/, "Unicode characters preserved in authors" ); 205} 206 207# specific test for version ranges 208{ 209 my @prereq_keys = qw( 210 prereqs requires build_requires configure_requires 211 recommends conflicts 212 ); 213 for my $case ( qw/ 2 1_4 / ) { 214 my $suffix = $case eq 2 ? "$case.json" : "$case.yml"; 215 my $version = $case; 216 $version =~ tr[_][.]; 217 my $path = File::Spec->catfile('t','data-test','version-ranges-' . $suffix); 218 my $original = Parse::CPAN::Meta->load_file( $path ); 219 ok( $original, "loaded " . basename $path ); 220 my $cmc = CPAN::Meta::Converter->new( $original ); 221 my $converted = $cmc->convert( version => $version ); 222 for my $h ( $original, $converted ) { 223 delete $h->{generated_by}; 224 delete $h->{'meta-spec'}{url}; 225 for my $k ( @prereq_keys ) { 226 _normalize_reqs($h->{$k}) if exists $h->{$k}; 227 } 228 } 229 is_deeply( $converted, $original, "version ranges preserved in conversion" ); 230 } 231} 232 233# specific test for version numbers 234{ 235 my $path = File::Spec->catfile('t','data-test','version-not-normal.json'); 236 my $original = Parse::CPAN::Meta->load_file( $path ); 237 ok( $original, "loaded " . basename $path ); 238 my $cmc = CPAN::Meta::Converter->new( $original ); 239 my $converted = $cmc->convert( version => 2 ); 240 is( $converted->{prereqs}{runtime}{requires}{'File::Find'}, "v0.1.0", "normalize v0.1"); 241 is( $converted->{prereqs}{runtime}{requires}{'File::Path'}, "v1.0.0", "normalize v1.0.0"); 242} 243 244# specific test for missing provides version 245{ 246 my $path = File::Spec->catfile('t','data-test','provides-version-missing.json'); 247 my $original = Parse::CPAN::Meta->load_file( $path ); 248 ok( $original, "loaded " . basename $path ); 249 my $cmc = CPAN::Meta::Converter->new( $original ); 250 my $converted = $cmc->convert( version => 2 ); 251 is_deeply( $converted->{provides}{"Foo::Bar"}, { file => "lib/Foo/Bar.pm", version => "0.27_02" }, 252 "Foo::Bar provides correct" 253 ); 254 is_deeply( $converted->{provides}{"Foo::Bar::Blah"}, { file => "lib/Foo/Bar/Blah.pm" }, 255 "Foo::Bar::Blah provides correct" 256 ); 257 is_deeply( $converted->{provides}{"Foo::Bar::Baz"}, { file => "lib/Foo/Bar/Baz.pm", version => "0.3" }, 258 "Foo::Bar provides correct" 259 ); 260} 261 262# CMR standardizes stuff in a way that makes it hard to test original vs final 263# so we remove spaces and >= to make them compare the same 264sub _normalize_reqs { 265 my $hr = shift; 266 for my $k ( keys %$hr ) { 267 if (ref $hr->{$k} eq 'HASH') { 268 _normalize_reqs($hr->{$k}); 269 } 270 elsif ( ! ref $hr->{$k} ) { 271 $hr->{$k} =~ s{\s+}{}g; 272 $hr->{$k} =~ s{>=\s*}{}g; 273 } 274 } 275} 276 277# specific test for multiple licenses 278{ 279 my $path = File::Spec->catfile('t','data-test','META-2.json'); 280 my $original = Parse::CPAN::Meta->load_file( $path ); 281 ok( $original, "loaded META-2.json" ); 282 my $cmc = CPAN::Meta::Converter->new( $original ); 283 my $cleaned_up = $cmc->convert( version => "2" ); 284 is_deeply( 285 $cleaned_up->{license}, 286 [ 'perl_5', 'bsd' ], 287 "multiple license preserved (v2)" 288 ); 289 290 $cleaned_up = $cmc->convert( version => "1.4" ); 291 is( 292 $cleaned_up->{license}, 293 'open_source', 294 "multiple license converted to open_source (v1.4)" 295 ); 296} 297 298done_testing; 299