5 our $VERSION = "1.04-20130212";
11 use List
::Util
qw( first );
12 use Encode
qw( encode decode );
13 use Term
::ANSIColor
qw(:constants);
14 use Test
::CPAN
::Meta
::YAML
::Version
;
15 use CPAN
::Meta
::Converter
;
16 use Test
::MinimumVersion
;
18 use Parse
::CPAN
::Meta
;
28 return bless { @_ }, $package;
33 my ($self, $src) = @_;
36 if (open my $mh, "<", "Makefile.PL") {
37 my $mf = do { local $/; <$mh> };
39 if ($mf =~ m{\b NAME \s*=>\s* ["'] (\S+) ['"]}x) {
41 $self->{name
} =~ m/-/ and
42 warn RED
, "NAME in Makefile.PL contains a -", RESET
, "\n";
43 $self->{name
} =~ s/::/-/g;
45 if ($mf =~ m{\b DISTNAME \s*=>\s* ["'] (\S+) ['"]}x) {
49 if ($mf =~ m{\b VERSION_FROM \s*=>\s* ["'] (\S+) ['"]}x) {
52 die RED
, "Makefile wants version from nonexisten $from", RESET
, "\n";
53 $self->{from
} //= $from;
54 $from eq $self->{from
} or
55 die RED
, "VERSION_FROM mismatch Makefile.PL / YAML", RESET
, "\n";
58 if ($mf =~ m
[\b PREREQ_PM \s
*=>\s
* \
{ ( [^}]+ ) \
}]x
) {
59 my @pr = split m/\n/ => $1;
60 $self->{mfpr
} = { map { (m{ \b ["']? (\S+?) ['"]? \s*=>\s* ["']? ([-0-9._]+) ['"]? }x) } grep !m/^\s*#/ => @pr };
63 $mf =~ m{--format=ustar} or
64 warn RED
, "TARFLAGS macro is missing", RESET
, "\n";
67 $src //= $self->{from
} or croak
"No file to extract version from";
70 open my $pm, "<", $src or croak
"Cannot read $src";
72 m/^(?:our\s+)? \$VERSION \s*=\s* ["']? ([-0-9._]+) ['"]? \s*;\s*$/x or next;
77 $version or croak
"Cannot extract VERSION from $src\n";
78 $self->{version
} = $version;
84 my ($self, @data) = @_;
85 $self->{version
} or $self->version_from ();
86 s/VERSION/$self->{version}/g for @data;
87 $self->{yml
} = \
@data;
95 my @tf = grep m{^(?: change | readme | .*\.pod )}ix => glob "*";
96 (my $tf = join ", " => @tf) =~ s/.*\K, / and /;
98 print "Check if $tf are still valid UTF8 ...\n";
99 foreach my $tf (@tf) {
100 open my $fh, "<", $tf or croak
"$tf: $!\n";
102 my $c = join "" => @c;
104 my $s = decode
("utf-8", $c, sub { push @e, shift; });
110 eval { decode
("utf-8", $_, 1) };
112 $@
=~ s{ at /\S+ line \d+.*}{};
113 print BLUE
, "$tf:$n\t$_\t$@", RESET
;
115 croak
"$tf is not valid UTF-8\n";
117 my $u = encode
("utf-8", $s);
121 $n = 1; $c =~ s/^/$n++ . "\t"/gem;
122 $n = 1; $u =~ s/^/$n++ . "\t"/gem;
123 croak
"$tf: recode makes content differ\n". diff \
$c, \
$u;
131 my $yml = $self->{h
} or croak
"No YAML to check";
133 warn "Check required and recommended module versions ...\n";
134 BEGIN { $V::NO_EXIT
= $V::NO_EXIT
= 1 } require V
;
135 my %req = map { %{$yml->{$_}} } grep m/requires/ => keys %{$yml};
136 my %rec = map { %{$yml->{$_}} } grep m/recommends/ => keys %{$yml};
137 if (my $of = $yml->{optional_features
}) {
138 foreach my $f (values %{$of}) {
139 my %q = map { %{$f->{$_}} } grep m/requires/ => keys %{$f};
140 my %c = map { %{$f->{$_}} } grep m/recommends/ => keys %{$f};
141 @req{keys %q} = values %q;
142 @rec{keys %c} = values %c;
145 my %vsn = ( %req, %rec );
146 delete @vsn{qw( perl version )};
147 for (sort keys %vsn) {
148 if (my $mfv = delete $self->{mfpr
}{$_}) {
150 die RED
, "PREREQ mismatch for $_ Makefile.PL ($mfv) / YAML ($req{$_})", RESET
, "\n";
152 $vsn{$_} eq "0" and next;
153 my $v = V
::get_version
($_);
154 $v eq $vsn{$_} and next;
155 printf STDERR
"%s%-35s %-6s => %s%s%s\n", BLUE
, $_, $vsn{$_}, GREEN
, $v, RESET
;
157 if (my @mfpr = sort keys %{$self->{mfpr
}}) {
158 die RED
, "Makefile.PL requires @mfpr, YAML does not", RESET
, "\n";
162 $File::Find
::dir
=~ m{^blib\b} and return;
163 $File::Find
::name
=~ m{(?:^|/)Bundle/.*\.pm} or return;
164 if (open my $bh, "<", $_) {
165 warn "Check bundle module versions $File::Find::name ...\n";
167 my ($m, $dv) = m/^([A-Za-z_:]+)\s+([0-9.]+)\s*$/ or next;
168 my $v = $m eq $self->{name
} ?
$self->{version
} : V
::get_version
($m);
170 printf STDERR
"%s%-35s %-6s => %s%s%s\n", BLUE
, $m, $dv, GREEN
, $v, RESET
;
175 if (ref $self->{h
}{provides
}) {
176 print "Check distribution module versions ...\n";
177 foreach my $m (sort keys %{$self->{h
}{provides
}}) {
178 $m eq $self->{name
} and next;
179 my $ev = $self->{h
}{provides
}{$m}{version
};
180 printf " Expect %5s for %-32s ", $ev, $m;
181 my $fn = $self->{h
}{provides
}{$m}{file
};
182 if (open my $fh, "<", $fn) {
185 m/\bVERSION\s*=\s*["']?([-0-9.]+)/ or next;
187 print $fv eq $ev ?
"ok\n" : RED
." mismatch, module has $1".RESET
."\n";
190 defined $fv or print " .. no version defined\n";
193 print " .. cannot open $fn: $!\n";
203 my @yml = @
{$self->{yml
}} or croak
"No YAML to check";
205 warn "Checking generated YAML ...\n";
207 my $yml = join "", @yml;
208 eval { $h = Load
($yml) };
210 $self->{name
} //= $h->{name
};
211 $self->{name
} eq $h->{name
} or
212 die RED
, "NAME mismatch Makefile.PL / YAML", RESET
, "\n";
213 $self->{name
} =~ s/-/::/g;
214 warn "Checking for $self->{name}-$self->{version}\n";
216 $self->{verbose
} and print Dump
$h;
218 my $t = Test
::CPAN
::Meta
::YAML
::Version
->new (data
=> $h);
220 croak
join "\n", "Test::CPAN::Meta::YAML reported failure:", $t->errors, "";
222 eval { Parse
::CPAN
::Meta
::Load
($yml) };
226 $self->{yaml
} = $yml;
232 my $reqv = $self->{h
}{requires
}{perl
};
236 if (ref $_ eq "ARRAY") {
237 $locs = { paths
=> $_ };
239 elsif (ref $_ eq "HASH") {
246 my $paths = (join ", " => @
{($locs // {})->{paths
} // []}) || "default paths";
248 $reqv or croak
"No minimal required version for perl";
249 print "Checking if $reqv is still OK as minimal version for $paths\n";
250 # All other minimum version checks done in xt
251 Test
::More
::subtest
"Minimum perl version $reqv" => sub {
252 all_minimum_version_ok
($reqv, $locs);
253 } or warn RED
, "\n### Use 'perlver --blame' on the failing file(s)\n\n", RESET
;
259 print @
{$self->{yml
}};
266 # Convert to meta-spec version 2
267 # licenses are lists now
268 my $jsn = $self->{h
};
269 $jsn->{"meta-spec"} = {
271 url
=> "https://metacpan.org/module/CPAN::Meta::Spec?#meta-spec",
273 exists $jsn->{resources
}{license
} and
274 $jsn->{resources
}{license
} = [ $jsn->{resources
}{license
} ];
275 delete $jsn->{distribution_type
};
276 if (exists $jsn->{license
}) {
277 $jsn->{license
} =~ s/^perl$/perl_5/;
278 $jsn->{license
} = [ $jsn->{license
} ];
280 if (exists $jsn->{resources
}{repository
}) {
281 my $url = $jsn->{resources
}{repository
};
283 $url =~ s{repo.or.cz/w/}{repo.or.cz/r/};
284 $web =~ s{repo.or.cz/r/}{repo.or.cz/w/};
285 $jsn->{resources
}{repository
} = {
291 foreach my $sct ("", "configure_", "build_", "test_") {
292 (my $x = $sct || "runtime") =~ s/_$//;
293 for (qw( requires recommends suggests )) {
294 exists $jsn->{"$sct$_"} and
295 $jsn->{prereqs
}{$x}{$_} = delete $jsn->{"$sct$_"};
299 # optional features do not yet know about requires and/or recommends diirectly
300 if (my $of = $jsn->{optional_features
}) {
301 foreach my $f (keys %$of) {
302 if (my $r = delete $of->{$f}{requires
}) {
303 #$jsn->{prereqs}{runtime}{recommends}{$_} //= $r->{$_} for keys %$r;
304 $of->{$f}{prereqs
}{runtime
}{requires
} = $r;
306 if (my $r = delete $of->{$f}{recommends
}) {
307 #$jsn->{prereqs}{runtime}{recommends}{$_} //= $r->{$_} for keys %$r;
308 $of->{$f}{prereqs
}{runtime
}{recommends
} = $r;
313 $jsn = CPAN
::Meta
::Converter
->new ($jsn)->convert (version
=> "2");
314 $jsn->{generated_by
} = "Author";
316 my @my = glob <*/META
.yml
> or croak
"No META files";
318 (my $jf = $yf) =~ s/yml$/json/;
319 open my $jh, ">", $jf or croak
"Cannot update $jf\n";
320 print $jh JSON
::PP
->new->utf8 (1)->pretty (1)->encode ($jsn);
323 # Now that 2.0 JSON is corrrect, create a 1.4 YAML back from the modified stuff
325 # 1.4 does not know about test_*, move them to *
326 if (my $tp = delete $yml->{prereqs
}{test
}) {
327 foreach my $phase (keys %{$tp}) {
328 my $p = $tp->{$phase};
329 #DDumper { $phase => $p };
330 $yml->{prereqs
}{runtime
}{$phase}{$_} //= $p->{$_} for keys %{$p};
334 # Optional features in 1.4 knows requires, but not recommends.
335 # The Lancaster Consensus moves 2.0 optional recommends promote to
337 if (my $of = $yml->{optional_features
}) {
338 foreach my $f (keys %$of) {
339 if (my $r = delete $of->{$f}{prereqs
}{runtime
}{recommends
}) {
340 $of->{$f}{requires
} = $r;
344 # runtime and test_requires are unknown as top-level in 1.4
345 foreach my $phase (qw( xuntime test_requires )) {
346 if (my $p = delete $yml->{$phase}) {
347 foreach my $f (keys %$p) {
348 $yml->{$f}{$_} ||= $p->{$f}{$_} for keys %{$p->{$f}};
354 # This does NOT create a correct YAML id the source does not comply!
355 $yml = CPAN
::Meta
::Converter
->new ($yml)->convert (version
=> "1.4");
356 $yml->{requires
}{perl
} //= $jsn->{prereqs
}{runtime
}{requires
}{perl
}
357 // $self->{h
}{requires
}{perl
}
359 $yml->{build_requires
} && !keys %{$yml->{build_requires
}} and
360 delete $yml->{build_requires
};
364 @my == 1 && open my $my, ">", $yf or croak
"Cannot update $yf\n";
365 print $my Dump
$yml; # @{$self->{yml}};
368 chmod 0644, glob "*/META.*";
369 unlink glob "MYMETA*";