5 our $VERSION = "1.03-20110907";
11 use List
::Util
qw( first );
12 use Encode
qw( encode decode );
13 use Test
::CPAN
::Meta
::YAML
::Version
;
14 use CPAN
::Meta
::Converter
;
15 use Test
::MinimumVersion
;
17 use Parse
::CPAN
::Meta
;
27 return bless { @_ }, $package;
32 my ($self, $src) = @_;
35 if (open my $mh, "<", "Makefile.PL") {
36 my $mf = do { local $/; <$mh> };
38 if ($mf =~ m{\b NAME \s*=>\s* ["'] (\S+) ['"]}x) {
40 $self->{name
} =~ m/-/ and
41 warn "NAME in Makefile.PL contains a -\n";
42 $self->{name
} =~ s/::/-/g;
44 if ($mf =~ m{\b DISTNAME \s*=>\s* ["'] (\S+) ['"]}x) {
48 if ($mf =~ m{\b VERSION_FROM \s*=>\s* ["'] (\S+) ['"]}x) {
50 -f
$from or die "Makefile wants version from nonexisten $from\n";
51 $self->{from
} //= $from;
52 $from eq $self->{from
} or die "VERSION_FROM mismatch Makefile.PL / YAML\n";
55 if ($mf =~ m
[\b PREREQ_PM \s
*=>\s
* \
{ ( [^}]+ ) \
}]x
) {
56 my @pr = split m/\n/ => $1;
57 $self->{mfpr
} = { map { (m{ \b ["']? (\S+?) ['"]? \s*=>\s* ["']? ([-0-9._]+) ['"]? }x) } grep !m/^\s*#/ => @pr };
61 $src //= $self->{from
} or croak
"No file to extract version from";
64 open my $pm, "<", $src or croak
"Cannot read $src";
66 m/^(?:our\s+)? \$VERSION \s*=\s* ["']? ([-0-9._]+) ['"]? \s*;\s*$/x or next;
71 $version or croak
"Cannot extract VERSION from $src\n";
72 $self->{version
} = $version;
78 my ($self, @data) = @_;
79 $self->{version
} or $self->version_from ();
80 s/VERSION/$self->{version}/g for @data;
81 $self->{yml
} = \
@data;
89 my @tf = grep m{^(?: change | readme | .*\.pod )}ix => glob "*";
90 (my $tf = join ", " => @tf) =~ s/.*\K, / and /;
92 print "Check if $tf are still valid UTF8 ...\n";
93 foreach my $tf (@tf) {
94 open my $fh, "<", $tf or croak
"$tf: $!\n";
96 my $c = join "" => @c;
98 my $s = decode
("utf-8", $c, sub { push @e, shift; });
104 eval { decode
("utf-8", $_, 1) };
106 $@
=~ s{ at /\S+ line \d+.*}{};
107 print "$tf:$n\t$_\t$@";
109 croak
"$tf is not valid UTF-8\n";
111 my $u = encode
("utf-8", $s);
115 $n = 1; $c =~ s/^/$n++ . "\t"/gem;
116 $n = 1; $u =~ s/^/$n++ . "\t"/gem;
117 croak
"$tf: recode makes content differ\n". diff \
$c, \
$u;
125 my $yml = $self->{h
} or croak
"No YAML to check";
127 print STDERR
"Check required and recommended module versions ...\n";
128 BEGIN { $V::NO_EXIT
= $V::NO_EXIT
= 1 } require V
;
129 my %req = map { %{$yml->{$_}} } grep m/requires/ => keys %{$yml};
130 my %rec = map { %{$yml->{$_}} } grep m/recommends/ => keys %{$yml};
131 if (my $of = $yml->{optional_features
}) {
132 foreach my $f (values %{$of}) {
133 my %q = map { %{$f->{$_}} } grep m/requires/ => keys %{$f};
134 my %c = map { %{$f->{$_}} } grep m/recommends/ => keys %{$f};
135 @req{keys %q} = values %q;
136 @rec{keys %c} = values %c;
139 my %vsn = ( %req, %rec );
140 delete @vsn{qw( perl version )};
141 for (sort keys %vsn) {
142 if (my $mfv = delete $self->{mfpr
}{$_}) {
144 die "PREREQ mismatch for $_ Makefile.PL ($mfv) / YAML ($req{$_})\n";
146 $vsn{$_} eq "0" and next;
147 my $v = V
::get_version
($_);
148 $v eq $vsn{$_} and next;
149 printf STDERR
"%-35s %-6s => %s\n", $_, $vsn{$_}, $v;
151 if (my @mfpr = sort keys %{$self->{mfpr
}}) {
152 die "Makefile.PL requires @mfpr, YAML does not\n";
156 $File::Find
::dir
=~ m{^blib\b} and return;
157 $File::Find
::name
=~ m{(?:^|/)Bundle/.*\.pm} or return;
158 if (open my $bh, "<", $_) {
159 print STDERR
"Check bundle module versions $File::Find::name ...\n";
161 my ($m, $dv) = m/^([A-Za-z_:]+)\s+([0-9.]+)\s*$/ or next;
162 my $v = $m eq $self->{name
} ?
$self->{version
} : V
::get_version
($m);
164 printf STDERR
"%-35s %-6s => %s\n", $m, $dv, $v;
169 if (ref $self->{h
}{provides
}) {
170 print "Check distribution module versions ...\n";
171 foreach my $m (sort keys %{$self->{h
}{provides
}}) {
172 $m eq $self->{name
} and next;
173 my $ev = $self->{h
}{provides
}{$m}{version
};
174 printf " Expect %5s for %-32s ", $ev, $m;
175 my $fn = $self->{h
}{provides
}{$m}{file
};
176 if (open my $fh, "<", $fn) {
179 m/\bVERSION\s*=\s*["']?([-0-9.]+)/ or next;
181 print $fv eq $ev ?
"ok\n" : " mismatch, module has $1\n";
184 defined $fv or print " .. no version defined\n";
187 print " .. cannot open $fn: $!\n";
197 my @yml = @
{$self->{yml
}} or croak
"No YAML to check";
199 print STDERR
"Checking generated YAML ...\n";
201 my $yml = join "", @yml;
202 eval { $h = Load
($yml) };
204 $self->{name
} //= $h->{name
};
205 $self->{name
} eq $h->{name
} or die "NAME mismatch Makefile.PL / YAML\n";
206 $self->{name
} =~ s/-/::/g;
207 print STDERR
"Checking for $self->{name}-$self->{version}\n";
209 $self->{verbose
} and print Dump
$h;
211 my $t = Test
::CPAN
::Meta
::YAML
::Version
->new (data
=> $h);
213 croak
join "\n", "Test::CPAN::Meta::YAML reported failure:", $t->errors, "";
215 eval { Parse
::CPAN
::Meta
::Load
($yml) };
219 $self->{yaml
} = $yml;
225 my $reqv = $self->{h
}{requires
}{perl
};
229 if (ref $_ eq "ARRAY") {
230 $locs = { paths
=> $_ };
232 elsif (ref $_ eq "HASH") {
239 my $paths = (join ", " => @
{($locs // {})->{paths
} // []}) || "default paths";
241 $reqv or croak
"No minimal required version for perl";
242 print "Checking if $reqv is still OK as minimal version for $paths\n";
243 # All other minimum version checks done in xt
244 Test
::More
::subtest
"Minimum perl version $reqv" => sub {
245 all_minimum_version_ok
($reqv, $locs);
252 print @
{$self->{yml
}};
259 # Convert to meta-spec version 2
260 # licenses are lists now
261 my $jsn = $self->{h
};
262 $jsn->{"meta-spec"} = {
264 url
=> "https://metacpan.org/module/CPAN::Meta::Spec?#meta-spec",
266 exists $jsn->{resources
}{license
} and
267 $jsn->{resources
}{license
} = [ $jsn->{resources
}{license
} ];
268 delete $jsn->{distribution_type
};
269 if (exists $jsn->{license
}) {
270 $jsn->{license
} =~ s/^perl$/perl_5/;
271 $jsn->{license
} = [ $jsn->{license
} ];
273 if (exists $jsn->{resources
}{repository
}) {
274 my $url = $jsn->{resources
}{repository
};
276 $url =~ s{repo.or.cz/w/}{repo.or.cz/r/};
277 $web =~ s{repo.or.cz/r/}{repo.or.cz/w/};
278 $jsn->{resources
}{repository
} = {
284 foreach my $sct ("", "configure_", "build_", "test_") {
285 (my $x = $sct || "runtime") =~ s/_$//;
286 for (qw( requires recommends suggests )) {
287 exists $jsn->{"$sct$_"} and
288 $jsn->{prereqs
}{$x}{$_} = delete $jsn->{"$sct$_"};
291 $jsn = CPAN
::Meta
::Converter
->new ($jsn)->convert (version
=> "2");
292 my $yml = CPAN
::Meta
::Converter
->new ($jsn)->convert (version
=> "1.4");
293 $_->{generated_by
} = "Author" for $jsn, $yml;
295 my @my = glob <*/META
.yml
> or croak
"No META files";
297 @my == 1 && open my $my, ">", $yf or croak
"Cannot update $yf\n";
298 print $my Dump
$yml; # @{$self->{yml}};
302 open $my, ">", $yf or croak
"Cannot update $yf\n";
303 #rint JSON::PP->new->utf8 (1)->pretty (1)->encode ($jsn);
304 print $my JSON
::PP
->new->utf8 (1)->pretty (1)->encode ($jsn);
307 chmod 0644, glob "*/META.*";
308 unlink glob "MYMETA*";