This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
core-cpan-diff: improve detection of version mismatches
[perl5.git] / Porting / core-cpan-diff
CommitLineData
cb097e7a
DM
1#!/usr/bin/env perl
2
3# core-cpan-diff: Compare CPAN modules with their equivalent in core
4
5# Originally based on App::DualLivedDiff by Steffen Mueller.
e66db76d 6
cb097e7a
DM
7use strict;
8use warnings;
9
10use 5.010;
11
12use Getopt::Long;
a08d2aad 13use File::Basename ();
333797b2
DG
14use File::Copy ();
15use File::Temp ();
16use File::Path ();
c4940a93 17use File::Spec::Functions;
cb097e7a
DM
18use Archive::Extract;
19use IO::Uncompress::Gunzip ();
333797b2 20use File::Compare ();
cb097e7a 21use ExtUtils::Manifest;
c4940a93 22use ExtUtils::MakeMaker ();
cb097e7a
DM
23
24BEGIN { die "Must be run from root of perl source tree\n" unless -d 'Porting' }
25use lib 'Porting';
26use Maintainers ();
27
28# if running from blead, we may be doing -Ilib, which means when we
29# 'chdir /tmp/foo', Archive::Extract may not find Archive::Tar etc.
30# So preload the things we need, and tell it to check %INC first:
31
32use Archive::Tar;
33use IPC::Open3;
34use IO::Select;
35$Module::Load::Conditional::CHECK_INC_HASH = 1;
333797b2 36
cb097e7a
DM
37# stop Archive::Extract whinging about lack of Archive::Zip
38$Archive::Extract::WARN = 0;
39
c4940a93 40# where, under the cache dir, to download tarballs to
333797b2
DG
41use constant SRC_DIR => 'tarballs';
42
cb097e7a 43# where, under the cache dir, to untar stuff to
cb097e7a
DM
44use constant UNTAR_DIR => 'untarred';
45
333797b2
DG
46use constant DIFF_CMD => 'diff';
47use constant WGET_CMD => 'wget';
cb097e7a
DM
48
49sub usage {
50 print STDERR "\n@_\n\n" if @_;
51 print STDERR <<HERE;
52Usage: $0 [opts] [ -d | -v | -x ] [ -a | module ... ]
53
54-a/--all Scan all dual-life modules.
55
56-c/--cachedir Where to save downloaded CPAN tarball files
57 (defaults to /tmp/something/ with deletion after each run).
58
59-d/--diff Display file differences using diff(1), rather than just
60 listing which files have changed.
61 The diff(1) command is assumed to be in your PATH.
62
63--diffopts Options to pass to the diff command. Defaults to '-u'.
64
65-f|force Force download from CPAN of new 02packages.details.txt file
66 (with --crosscheck only).
67
10be9a51
DG
68-m|mirror Preferred CPAN mirror URI (http:// or file:///)
69 (Local mirror must be a complete mirror, not minicpan)
70
cb097e7a
DM
71-o/--output File name to write output to (defaults to STDOUT).
72
73-r/--reverse Reverses the diff (perl to CPAN).
74
2908b263
RS
75-u/--upstream only print modules with the given upstream (defaults to all)
76
cb097e7a
DM
77-v/--verbose List the fate of *all* files in the tarball, not just those
78 that differ or are missing.
79
80-x|crosscheck List the distributions whose current CPAN version differs from
81 that in blead (i.e. the DISTRIBUTION field in Maintainers.pl).
82
83By default (i.e. without the --crosscheck option), for each listed module
84(or with -a, all CPAN modules listed in Maintainers.pl), grab the tarball
85from CPAN associated with that module, and compare the files in it with
86those in the perl source tree.
87
88Must be run from the root of the perl source tree.
89Module names must match the keys of %Modules in Maintainers.pl.
90HERE
91 exit(1);
92}
93
cb097e7a
DM
94sub run {
95 my $scan_all;
96 my $diff_opts;
333797b2 97 my $reverse = 0;
2908b263 98 my @wanted_upstreams;
cb097e7a 99 my $cache_dir;
10be9a51 100 my $mirror_url = "http://www.cpan.org/";
cb097e7a
DM
101 my $use_diff;
102 my $output_file;
103 my $verbose;
104 my $force;
105 my $do_crosscheck;
106
107 GetOptions(
333797b2
DG
108 'a|all' => \$scan_all,
109 'c|cachedir=s' => \$cache_dir,
110 'd|diff' => \$use_diff,
111 'diffopts:s' => \$diff_opts,
112 'f|force' => \$force,
113 'h|help' => \&usage,
114 'm|mirror=s' => \$mirror_url,
115 'o|output=s' => \$output_file,
116 'r|reverse' => \$reverse,
117 'u|upstream=s@' => \@wanted_upstreams,
118 'v|verbose' => \$verbose,
119 'x|crosscheck' => \$do_crosscheck,
cb097e7a
DM
120 ) or usage;
121
cb097e7a
DM
122 my @modules;
123
124 usage("Cannot mix -a with module list") if $scan_all && @ARGV;
125
126 if ($do_crosscheck) {
333797b2
DG
127 usage("can't use -r, -d, --diffopts, -v with --crosscheck")
128 if ( $reverse || $use_diff || $diff_opts || $verbose );
cb097e7a
DM
129 }
130 else {
333797b2
DG
131 $diff_opts = '-u' unless defined $diff_opts;
132 usage("can't use -f without --crosscheck") if $force;
cb097e7a
DM
133 }
134
333797b2
DG
135 @modules =
136 $scan_all
137 ? grep $Maintainers::Modules{$_}{CPAN},
138 ( sort { lc $a cmp lc $b } keys %Maintainers::Modules )
139 : @ARGV;
cb097e7a
DM
140 usage("No modules specified") unless @modules;
141
cb097e7a 142 my $outfh;
333797b2
DG
143 if ( defined $output_file ) {
144 open $outfh, '>', $output_file
145 or die "ERROR: could not open file '$output_file' for writing: $!\n";
cb097e7a
DM
146 }
147 else {
333797b2
DG
148 open $outfh, ">&STDOUT"
149 or die "ERROR: can't dup STDOUT: $!\n";
cb097e7a
DM
150 }
151
333797b2
DG
152 if ( defined $cache_dir ) {
153 die "ERROR: no such directory: '$cache_dir'\n" unless -d $cache_dir;
cb097e7a 154 }
c4940a93 155 else {
333797b2 156 $cache_dir = File::Temp::tempdir( CLEANUP => 1 );
c4940a93 157 }
cb097e7a 158
333797b2 159 $mirror_url .= "/" unless substr( $mirror_url, -1 ) eq "/";
10be9a51 160 my $test_file = "modules/07mirror.yml";
333797b2
DG
161 my_getstore(
162 cpan_url( $mirror_url, $test_file ),
163 catfile( $cache_dir, $test_file )
164 ) or die "ERROR: not a CPAN mirror '$mirror_url'\n";
10be9a51 165
cb097e7a 166 if ($do_crosscheck) {
333797b2 167 do_crosscheck( $outfh, $cache_dir, $mirror_url, $force, \@modules );
cb097e7a
DM
168 }
169 else {
333797b2
DG
170 do_compare(
171 \@modules, $outfh, $output_file,
172 $cache_dir, $mirror_url, $verbose,
173 $use_diff, $reverse, $diff_opts,
174 \@wanted_upstreams
175 );
cb097e7a
DM
176 }
177}
178
10be9a51 179# construct a CPAN url
cb097e7a 180
10be9a51 181sub cpan_url {
333797b2 182 my ( $mirror_url, @path ) = @_;
10be9a51
DG
183 return $mirror_url unless @path;
184 my $cpan_path = join( "/", map { split "/", $_ } @path );
333797b2 185 $cpan_path =~ s{\A/}{}; # remove leading slash since url has one trailing
10be9a51
DG
186 return $mirror_url . $cpan_path;
187}
cb097e7a
DM
188
189# compare a list of modules against their CPAN equivalents
190
191sub do_compare {
333797b2
DG
192 my (
193 $modules, $outfh, $output_file, $cache_dir,
194 $mirror_url, $verbose, $use_diff, $reverse,
195 $diff_opts, $wanted_upstreams
196 ) = @_;
cb097e7a
DM
197
198 # first, make sure we have a directory where they can all be untarred,
199 # and if its a permanent directory, clear any previous content
333797b2
DG
200 my $untar_dir = catdir( $cache_dir, UNTAR_DIR );
201 my $src_dir = catdir( $cache_dir, SRC_DIR );
c4940a93 202 for my $d ( $src_dir, $untar_dir ) {
333797b2
DG
203 next if -d $d;
204 mkdir $d or die "mkdir $d: $!\n";
cb097e7a
DM
205 }
206
333797b2 207 my %ignorable = map { ( $_ => 1 ) } @Maintainers::IGNORABLE;
cb097e7a
DM
208
209 my %seen_dist;
210 for my $module (@$modules) {
333797b2 211 warn "Processing $module ...\n" if defined $output_file;
cb097e7a 212
333797b2
DG
213 my $m = $Maintainers::Modules{$module}
214 or die "ERROR: No such module in Maintainers.pl: '$module'\n";
cb097e7a 215
333797b2
DG
216 unless ( $m->{CPAN} ) {
217 print $outfh "WARNING: $module is not dual-life; skipping\n";
218 next;
219 }
cb097e7a 220
333797b2
DG
221 my $dist = $m->{DISTRIBUTION};
222 die "ERROR: $module has no DISTRIBUTION entry\n" unless defined $dist;
cb097e7a 223
333797b2
DG
224 if ( $seen_dist{$dist}++ ) {
225 warn "WARNING: duplicate entry for $dist in $module\n";
226 }
d55832d0 227
333797b2
DG
228 my $upstream = $m->{UPSTREAM} || 'UNKNOWN';
229 next if @$wanted_upstreams and !( $upstream ~~ $wanted_upstreams );
d55832d0 230
333797b2
DG
231 print $outfh "\n$module - "
232 . $Maintainers::Modules{$module}->{DISTRIBUTION} . "\n";
233 print $outfh " upstream is: "
234 . ( $m->{UPSTREAM} || 'UNKNOWN!' ) . "\n";
cb097e7a 235
333797b2
DG
236 my $cpan_dir;
237 eval {
238 $cpan_dir =
239 get_distribution( $src_dir, $mirror_url, $untar_dir, $module,
240 $dist );
241 };
242 if ($@) {
243 print $outfh " ", $@;
244 print $outfh " (skipping)\n";
245 next;
246 }
cb097e7a 247
333797b2 248 my @perl_files = Maintainers::get_module_files($module);
cb097e7a 249
333797b2
DG
250 my $manifest = catfile( $cpan_dir, 'MANIFEST' );
251 die "ERROR: no such file: $manifest\n" unless -f $manifest;
cb097e7a 252
333797b2
DG
253 my $cpan_files = ExtUtils::Manifest::maniread($manifest);
254 my @cpan_files = sort keys %$cpan_files;
cb097e7a 255
333797b2 256 ( my $main_pm = $module ) =~ s{::}{/}g;
c4940a93
DG
257 $main_pm .= ".pm";
258
333797b2
DG
259 my ( $excluded, $map ) = get_map( $m, $module, \@perl_files );
260
261 my %perl_unseen;
262 @perl_unseen{@perl_files} = ();
263 my %perl_files = %perl_unseen;
264
265 foreach my $cpan_file (@cpan_files) {
266 my $mapped_file = cpan_to_perl( $excluded, $map, $cpan_file );
267 unless ( defined $mapped_file ) {
268 print $outfh " Excluded: $cpan_file\n" if $verbose;
269 next;
270 }
271
272 if ( exists $perl_files{$mapped_file} ) {
273 delete $perl_unseen{$mapped_file};
274 }
275 else {
276
277 # some CPAN files foo are stored in core as foo.packed,
278 # which are then unpacked by 'make test_prep'
279 my $packed_file = "$mapped_file.packed";
280 if ( exists $perl_files{$packed_file} ) {
281 if ( !-f $mapped_file and -f $packed_file ) {
282 print $outfh <<EOF;
cb097e7a
DM
283WARNING: $mapped_file not found, but .packed variant exists.
284Perhaps you need to run 'make test_prep'?
285EOF
333797b2
DG
286 next;
287 }
288 delete $perl_unseen{$packed_file};
289 }
290 else {
291 if ( $ignorable{$cpan_file} ) {
292 print $outfh " Ignored: $cpan_file\n" if $verbose;
293 next;
294 }
295
296 unless ($use_diff) {
297 print $outfh " CPAN only: $cpan_file",
298 ( $cpan_file eq $mapped_file )
299 ? "\n"
300 : " (expected $mapped_file)\n";
301 }
302 next;
303 }
304 }
305
306 my $abs_cpan_file = catfile( $cpan_dir, $cpan_file );
307
308 # should never happen
309 die "ERROR: can't find file $abs_cpan_file\n"
310 unless -f $abs_cpan_file;
311
312 # might happen if the FILES entry in Maintainers.pl is wrong
313 unless ( -f $mapped_file ) {
314 print $outfh "WARNING: perl file not found: $mapped_file\n";
315 next;
316 }
cb097e7a 317
c4940a93
DG
318 my $relative_mapped_file = $mapped_file;
319 $relative_mapped_file =~ s/^(cpan|dist|ext)\/.*?\///;
320
360b8560 321 for my $f ( catfile( 'lib', $main_pm ), File::Basename::basename($main_pm) ) {
333797b2
DG
322 next unless $f eq $relative_mapped_file;
323 my $pv = MM->parse_version($mapped_file) || '(unknown)';
324 my $cv = MM->parse_version($abs_cpan_file) || '(unknown)';
325 if ( $pv ne $cv ) {
326 print $outfh
327 " Version mismatch: $cv (cpan) vs $pv (perl)\n";
328 }
c4940a93 329 }
cb097e7a 330
333797b2
DG
331 if ( File::Compare::compare( $abs_cpan_file, $mapped_file ) ) {
332
333 if ($use_diff) {
334 file_diff( $outfh, $abs_cpan_file, $mapped_file, $reverse,
335 $diff_opts );
336 }
337 else {
338 if ( $cpan_file eq $relative_mapped_file ) {
339 print $outfh " Modified: $relative_mapped_file\n";
340 }
341 else {
342 print $outfh
343 " Modified: $cpan_file $relative_mapped_file\n";
344 }
345 }
346 }
347 elsif ($verbose) {
348 if ( $cpan_file eq $relative_mapped_file ) {
349 print $outfh " Unchanged: $cpan_file\n";
350 }
351 else {
352 print $outfh
353 " Unchanged: $cpan_file $relative_mapped_file\n";
354 }
355 }
356 }
357 for ( sort keys %perl_unseen ) {
358 print $outfh " Perl only: $_\n" unless $use_diff;
359 }
cb097e7a
DM
360 }
361}
362
363# given FooBar-1.23_45.tar.gz, return FooBar
364
365sub distro_base {
366 my $d = shift;
367 $d =~ s/\.tar\.gz$//;
368 $d =~ s/\.gip$//;
369 $d =~ s/[\d\-_\.]+$//;
370 return $d;
371}
372
373# process --crosscheck action:
374# ie list all distributions whose CPAN versions differ from that listed in
375# Maintainers.pl
376
377sub do_crosscheck {
333797b2 378 my ( $outfh, $cache_dir, $mirror_url, $force, $modules ) = @_;
cb097e7a 379
333797b2 380 my $file = '02packages.details.txt';
cb097e7a 381 my $download_dir = $cache_dir || File::Temp::tempdir( CLEANUP => 1 );
333797b2
DG
382 my $path = catfile( $download_dir, $file );
383 my $gzfile = "$path.gz";
cb097e7a
DM
384
385 # grab 02packages.details.txt
386
333797b2 387 my $url = cpan_url( $mirror_url, "modules/02packages.details.txt.gz" );
cb097e7a 388
333797b2
DG
389 if ( !-f $gzfile or $force ) {
390 unlink $gzfile;
391 my_getstore( $url, $gzfile );
cb097e7a
DM
392 }
393 unlink $path;
333797b2
DG
394 IO::Uncompress::Gunzip::gunzip( $gzfile, $path )
395 or die
396 "ERROR: failed to ungzip $gzfile: $IO::Uncompress::Gunzip::GunzipError\n";
cb097e7a
DM
397
398 # suck in the data from it
e66db76d 399
cb097e7a 400 open my $fh, '<', $path
333797b2 401 or die "ERROR: open: $file: $!\n";
cb097e7a
DM
402
403 my %distros;
404 my %modules;
405
406 while (<$fh>) {
333797b2
DG
407 next if 1 .. /^$/;
408 chomp;
409 my @f = split ' ', $_;
410 if ( @f != 3 ) {
411 warn
412 "WARNING: $file:$.: line doesn't have three fields (skipping)\n";
413 next;
414 }
415 my $distro = $f[2];
416 $distro =~ s{^[A-Z]/[A-Z]{2}/}{}; # strip leading A/AB/
417 $modules{ $f[0] } = $distro;
418
419 ( my $short_distro = $distro ) =~ s{^.*/}{};
420
421 $distros{ distro_base($short_distro) }{$distro} = 1;
cb097e7a
DM
422 }
423
424 for my $module (@$modules) {
333797b2
DG
425 my $m = $Maintainers::Modules{$module}
426 or die "ERROR: No such module in Maintainers.pl: '$module'\n";
427
428 unless ( $m->{CPAN} ) {
429 print $outfh "\nWARNING: $module is not dual-life; skipping\n";
430 next;
431 }
432
433 # given an entry like
434 # Foo::Bar 1.23 foo-bar-1.23.tar.gz,
435 # first compare the module name against Foo::Bar, and failing that,
436 # against foo-bar
437
438 my $pdist = $m->{DISTRIBUTION};
439 die "ERROR: $module has no DISTRIBUTION entry\n" unless defined $pdist;
440
441 my $cdist = $modules{$module};
442 ( my $short_pdist = $pdist ) =~ s{^.*/}{};
443
444 unless ( defined $cdist ) {
445 my $d = $distros{ distro_base($short_pdist) };
446 unless ( defined $d ) {
447 print $outfh "\n$module: Can't determine current CPAN entry\n";
448 next;
449 }
450 if ( keys %$d > 1 ) {
451 print $outfh
452 "\n$module: (found more than one CPAN candidate):\n";
453 print $outfh " perl: $pdist\n";
454 print $outfh " CPAN: $_\n" for sort keys %$d;
455 next;
456 }
457 $cdist = ( keys %$d )[0];
458 }
459
460 if ( $cdist ne $pdist ) {
461 print $outfh "\n$module:\n Perl: $pdist\n CPAN: $cdist\n";
462 }
cb097e7a
DM
463 }
464}
465
cb097e7a
DM
466# get the EXCLUDED and MAP entries for this module, or
467# make up defauts if they don't exist
468
469sub get_map {
333797b2 470 my ( $m, $module_name, $perl_files ) = @_;
cb097e7a 471
333797b2 472 my ( $excluded, $map ) = @$m{qw(EXCLUDED MAP)};
cb097e7a
DM
473
474 $excluded ||= [];
475
476 return $excluded, $map if $map;
477
478 # all files under ext/foo-bar (plus maybe some under t/lib)???
479
480 my $ext;
481 for (@$perl_files) {
333797b2
DG
482 if (m{^((?:ext|dist|cpan)/[^/]+/)}) {
483 if ( defined $ext and $ext ne $1 ) {
484
485 # more than one ext/$ext/
486 undef $ext;
487 last;
488 }
489 $ext = $1;
490 }
491 elsif (m{^t/lib/}) {
492 next;
493 }
494 else {
495 undef $ext;
496 last;
497 }
cb097e7a 498 }
e66db76d 499
333797b2
DG
500 if ( defined $ext ) {
501 $map = { '' => $ext },;
cb097e7a
DM
502 }
503 else {
333797b2
DG
504 ( my $base = $module_name ) =~ s{::}{/}g;
505 $base = "lib/$base";
506 $map = {
507 'lib/' => 'lib/',
508 '' => "$base/",
509 };
cb097e7a
DM
510 }
511 return $excluded, $map;
512}
513
cb097e7a
DM
514# Given an exclude list and a mapping hash, convert a CPAN filename
515# (eg 't/bar.t') to the equivalent perl filename (eg 'lib/Foo/Bar/t/bar.t').
516# Returns an empty list for an excluded file
517
518sub cpan_to_perl {
333797b2 519 my ( $excluded, $map, $cpan_file ) = @_;
cb097e7a
DM
520
521 for my $exclude (@$excluded) {
333797b2
DG
522
523 # may be a simple string to match exactly, or a pattern
524 if ( ref $exclude ) {
525 return if $cpan_file =~ $exclude;
526 }
527 else {
528 return if $cpan_file eq $exclude;
529 }
cb097e7a
DM
530 }
531
532 my $perl_file = $cpan_file;
533
534 # try longest prefix first, then alphabetically on tie-break
333797b2
DG
535 for
536 my $prefix ( sort { length($b) <=> length($a) || $a cmp $b } keys %$map )
cb097e7a 537 {
333797b2 538 last if $perl_file =~ s/^\Q$prefix/$map->{$prefix}/;
cb097e7a
DM
539 }
540 return $perl_file;
541}
542
cb097e7a
DM
543# do LWP::Simple::getstore, possibly without LWP::Simple being available
544
545my $lwp_simple_available;
546
547sub my_getstore {
333797b2
DG
548 my ( $url, $file ) = @_;
549 File::Path::mkpath( File::Basename::dirname($file) );
550 unless ( defined $lwp_simple_available ) {
551 eval { require LWP::Simple };
552 $lwp_simple_available = $@ eq '';
cb097e7a
DM
553 }
554 if ($lwp_simple_available) {
333797b2 555 return LWP::Simple::is_success( LWP::Simple::getstore( $url, $file ) );
cb097e7a 556 }
a08d2aad 557 elsif ( $url =~ qr{\Afile://(?:localhost)?/} ) {
333797b2 558 ( my $local_path = $url ) =~ s{\Afile://(?:localhost)?}{};
a08d2aad
DG
559 File::Copy::copy( $local_path, $file );
560 }
cb097e7a 561 else {
333797b2 562 return system( WGET_CMD, "-O", $file, $url ) == 0;
cb097e7a
DM
563 }
564}
565
cb097e7a
DM
566# download and unpack a distribution
567# Returns the full pathname of the extracted directory
568# (eg '/tmp/XYZ/Foo_bar-1.23')
569
10be9a51
DG
570# cache_dir: where to download the .tar.gz file to
571# mirror_url: CPAN mirror to download from
e66db76d 572# untar_dir: where to untar or unzup the file
10be9a51
DG
573# module: name of module
574# dist: name of the distribution
cb097e7a
DM
575
576sub get_distribution {
333797b2 577 my ( $src_dir, $mirror_url, $untar_dir, $module, $dist ) = @_;
cb097e7a
DM
578
579 $dist =~ m{.+/([^/]+)$}
333797b2
DG
580 or die
581 "ERROR: $module: invalid DISTRIBUTION name (no AUTHOR/ prefix): $dist\n";
cb097e7a
DM
582 my $filename = $1;
583
333797b2 584 my $download_file = catfile( $src_dir, $filename );
cb097e7a
DM
585
586 # download distribution
587
333797b2
DG
588 if ( -f $download_file and !-s $download_file ) {
589
590 # wget can leave a zero-length file on failed download
591 unlink $download_file;
cb097e7a
DM
592 }
593
333797b2 594 unless ( -f $download_file ) {
cb097e7a 595
333797b2
DG
596 # not cached
597 $dist =~ /^([A-Z])([A-Z])/
598 or die
599"ERROR: $module: invalid DISTRIBUTION name (not /^[A-Z]{2}/): $dist\n";
600
601 my $url =
602 cpan_url( $mirror_url, "modules/by-authors/id/$1/$1$2/$dist" );
603 my_getstore( $url, $download_file )
604 or die "ERROR: Could not fetch '$url'\n";
cb097e7a
DM
605 }
606
c4940a93 607 # get the expected name of the extracted distribution dir
cb097e7a 608
333797b2 609 my $path = catfile( $untar_dir, $filename );
cb097e7a 610
333797b2
DG
611 $path =~ s/\.tar\.gz$//
612 or $path =~ s/\.zip$//
613 or die
614 "ERROR: downloaded file does not have a recognised suffix: $path\n";
cb097e7a 615
c4940a93 616 # extract it unless we already have it cached or tarball is newer
333797b2
DG
617 if ( !-d $path || ( -M $download_file < -M $path ) ) {
618 my $ae = Archive::Extract->new( archive => $download_file );
619 $ae->extract( to => $untar_dir )
620 or die
621 "ERROR: failed to extract distribution '$download_file to temp. dir: "
622 . $ae->error() . "\n";
c4940a93
DG
623 }
624
cb097e7a
DM
625 die "ERROR: Extracted tarball does not appear as $path\n" unless -d $path;
626
627 return $path;
628}
629
cb097e7a
DM
630# produce the diff of a single file
631sub file_diff {
632 my $outfh = shift;
633 my $cpan_file = shift;
634 my $perl_file = shift;
635 my $reverse = shift;
636 my $diff_opts = shift;
637
333797b2 638 my @cmd = ( DIFF_CMD, split ' ', $diff_opts );
cb097e7a 639 if ($reverse) {
333797b2 640 push @cmd, $perl_file, $cpan_file;
cb097e7a
DM
641 }
642 else {
333797b2 643 push @cmd, $cpan_file, $perl_file;
cb097e7a
DM
644 }
645 my $result = `@cmd`;
646
647 $result =~ s{^(--- |\+\+\+ )/tmp/[^/]+/}{$1}gm;
648
649 print $outfh $result;
650}
651
cb097e7a
DM
652run();
653