view release on metacpan or  search on metacpan

lib/App/CPAN/Mini/Visit.pm  view on Meta::CPAN

# ABSTRACT: explore each distribution in a minicpan repository
our $VERSION = '0.008'; # VERSION

use CPAN::Mini 0.572 ();
use Exception::Class::TryCatch 1.12 qw/ try catch /;
use File::Basename qw/ basename /;
use File::Find qw/ find /;
use File::pushd qw/ tempd /;
use Path::Class qw/ dir file /;
use Getopt::Lucid 0.16 qw/ :all /;
use Pod::Usage 1.35 qw/ pod2usage /;

use Archive::Extract 0.28 ();

my @option_spec = (
    Switch("help|h"), Switch("version|V"),
    Switch("quiet|q"), Param( "append|a", qr/(?:^$|(?:^path|dist$))/ )->default(''),
    Param("e|E"),      Param("minicpan|m"),
    Param("output|o"),
);

sub run {
    my ( $self, @args ) = @_;

    # get command line options
    my $opt = try eval { Getopt::Lucid->getopt( \@option_spec, \@args ) };
    for (catch) {
        if ( $_->isa('Getopt::Lucid::Exception::ARGV') ) {
            print "$_\n";
            # usage stuff
            return 1;
        }
        else {
            die $_;
        }
    }

    # handle "help" and "version" options
    return _exit_usage()   if $opt->get_help;
    return _exit_version() if $opt->get_version;

    # Set Archive::Extract globals
    # if quiet suppress warnings from Archive::Tar, etc.
    local $Archive::Extract::DEBUG      = 0;
    local $Archive::Extract::PREFER_BIN = 1;
    local $Archive::Extract::WARN       = $opt->get_quiet ? 0 : 1;

    # if -e/-E, then prepend to command
    if ( $opt->get_e ) {
        unshift @args, $^X, ( $^X > 5.009 ? '-E' : '-e' ), $opt->get_e;
    }

    # locate minicpan directory
    if ( !$opt->get_minicpan ) {
        my %config = CPAN::Mini->read_config;
        if ( $config{local} ) {
            $opt->merge_defaults( { minicpan => $config{local} } );
        }
    }

    # confirm minicpan directory that looks like minicpan
    return _exit_no_minicpan() if !$opt->get_minicpan;
    return _exit_bad_minicpan( $opt->get_minicpan ) if !-d $opt->get_minicpan;

    my $id_dir = dir( $opt->get_minicpan, qw/authors id/ );
    return _exit_bad_minicpan( $opt->get_minicpan ) if !-d $id_dir;

    # process all distribution tarballs in authors/id/...
    my $archive_re = qr{\.(?:tar\.(?:bz2|gz|Z)|t(?:gz|bz)|zip|pm\.gz)$}i;

    my $minicpan = dir( $opt->get_minicpan )->absolute;

    # save output by redirecting STDOUT if requested
    my ( $out_fh, $orig_stdout );
    if ( $opt->get_output ) {
        open $out_fh, ">", $opt->get_output;
        open $orig_stdout, "<&=STDOUT";
        open STDOUT, ">&=" . fileno $out_fh;
    }

    find(
        {
            no_chdir   => 1,
            follow     => 0,
            preprocess => sub { my @files = sort @_; return @files },
            wanted     => sub {
                return unless /$archive_re/;
                # run code if program/args given otherwise print name
                if (@args) {
                    return if $_ =~ /pm\.gz$/io; # not an archive, just a file
                    my @cmd = @args;
                    if ( $opt->get_append ) {
                        if ( $opt->get_append eq 'dist' ) {
                            my $distname = $_;
                            my $prefix = dir( $minicpan, qw/authors id/ );
                            $distname =~ s{^$prefix[\\/].[\\/]..[\\/]}{};
                            push @cmd, $distname;
                        }
                        else {
                            push @cmd, $_;
                        }
                    }
                    _visit( $_, @cmd );
                }
                else {
                    print "$_\n";
                }
            },
        },
        $minicpan
    );

    # restore STDOUT and close output file
    if ( $opt->get_output ) {
        open STDOUT, ">&=" . fileno $orig_stdout;
        close $out_fh;
    }

    return 0; # exit code
}