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