Porting/core-cpan-diff

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