view release on metacpan or  search on metacpan

Porting/core-cpan-diff  view on Meta::CPAN

            $diff_opts = ($^O =~ m/bsd$/i) ? '-u' : '-u --text';
        };
        usage("can't use -f without --crosscheck") if $force;
    }

    @modules =
      $scan_all
      ? grep $Maintainers::Modules{$_}{CPAN},
      ( sort { lc $a cmp lc $b } keys %Maintainers::Modules )
      : @ARGV;
    usage("No modules specified") unless @modules;

    my $outfh;
    if ( defined $output_file ) {
        open $outfh, '>', $output_file
          or die "ERROR: could not open file '$output_file' for writing: $!\n";
    }
    else {
        open $outfh, ">&STDOUT"
          or die "ERROR: can't dup STDOUT: $!\n";
    }

    if ( defined $cache_dir ) {
        die "ERROR: not a directory: '$cache_dir'\n"
            if !-d $cache_dir && -e $cache_dir;
        File::Path::mkpath($cache_dir);
    }
    else {
        $cache_dir = File::Temp::tempdir( CLEANUP => 1 );
    }

    $mirror_url .= "/" unless substr( $mirror_url, -1 ) eq "/";
    my $test_file = "modules/03modlist.data.gz";
    my_getstore(
        cpan_url( $mirror_url, $test_file ),
        catfile( $cache_dir, $test_file )
    ) or die "ERROR: not a CPAN mirror '$mirror_url'\n";

    if ($do_crosscheck) {
        do_crosscheck(
            $outfh, $cache_dir, $mirror_url, $verbose,
            $force, \@modules,  \@wanted_upstreams
        );
    }
    else {
        $verbose > 2 and $use_diff++;
        do_compare(
            \@modules,  $outfh,      $output_file,
            $cache_dir, $mirror_url, $verbose,
            $use_diff,  $reverse,    $diff_opts,
            \@wanted_upstreams
        );
    }
}

# construct a CPAN url

sub cpan_url {
    my ( $mirror_url, @path ) = @_;
    return $mirror_url unless @path;
    my $cpan_path = join( "/", map { split "/", $_ } @path );
    $cpan_path =~ s{\A/}{};    # remove leading slash since url has one trailing
    return $mirror_url . $cpan_path;
}

# construct a CPAN URL for a author/distribution string like:
# BINGOS/Archive-Extract-0.52.tar.gz

sub cpan_url_distribution {
    my ( $mirror_url, $distribution ) = @_;
    $distribution =~ /^([A-Z])([A-Z])/
        or die "ERROR: invalid DISTRIBUTION name (not /^[A-Z]{2}/): $distribution\n";
    my $path = "authors/id/$1/$1$2/$distribution";
    return cpan_url( $mirror_url, $path );
}

# compare a list of modules against their CPAN equivalents

sub do_compare {
    my (
        $modules,    $outfh,   $output_file, $cache_dir,
        $mirror_url, $verbose, $use_diff,    $reverse,
        $diff_opts,  $wanted_upstreams
    ) = @_;

    # first, make sure we have a directory where they can all be untarred,
    # and if its a permanent directory, clear any previous content
    my $untar_dir = catdir( $cache_dir, UNTAR_DIR );
    my $src_dir   = catdir( $cache_dir, SRC_DIR );
    for my $d ( $src_dir, $untar_dir ) {
        next if -d $d;
        mkdir $d or die "mkdir $d: $!\n";
    }

    my %ignorable = map { ( $_ => 1 ) } @Maintainers::IGNORABLE;
    my %wanted_upstream = map { ( $_ => 1 ) } @$wanted_upstreams;

    my %seen_dist;
    for my $module (@$modules) {
        warn "Processing $module ...\n" if defined $output_file;

        my $m = $Maintainers::Modules{$module}
          or die "ERROR: No such module in Maintainers.pl: '$module'\n";

        unless ( $m->{CPAN} ) {
            print $outfh "WARNING: $module is not dual-life; skipping\n";
            next;
        }

        my $dist = $m->{DISTRIBUTION};
        die "ERROR: $module has no DISTRIBUTION entry\n" unless defined $dist;

        if ( $seen_dist{$dist}++ ) {
            warn "WARNING: duplicate entry for $dist in $module\n";
        }

        my $upstream = $m->{UPSTREAM} // 'undef';
        next if @$wanted_upstreams and !$wanted_upstream{$upstream};

        print $outfh "\n$module - "
          . $Maintainers::Modules{$module}->{DISTRIBUTION} . "\n";
        print $outfh "  upstream is: "
          . ( $m->{UPSTREAM} // 'UNKNOWN!' ) . "\n";