stderr results from the CPAN

stderr

App-CPAN-Mini-Visit

view release on metacpan or search on metacpan

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


sub _visit {
    my ( $archive, @cmd_line ) = @_;

    my $tempd = tempd;

    my $ae = Archive::Extract->new( archive => $archive );

    my $olderr;

    # stderr > /dev/null if quiet
    if ( !$Archive::Extract::WARN ) {
        open $olderr, ">&STDERR";
        open STDERR, ">", File::Spec->devnull;
    }

    my $extract_ok = $ae->extract;

    # restore stderr if quiet
    if ( !$Archive::Extract::WARN ) {
        open STDERR, ">&", $olderr;
        close $olderr;
    }

    if ( !$extract_ok ) {
        warn "Couldn't extract '$archive'\n" if $Archive::Extract::WARN;
        return;
    }

t/01-App-CPAN-Mini-Visit.t view on Meta::CPAN


plan tests => 30;

require_ok('App::CPAN::Mini::Visit');

#--------------------------------------------------------------------------#
# fixtures
#--------------------------------------------------------------------------#

my $exe = basename $0;
my ( $stdout, $stderr );
my $tempdir    = tempdir( CLEANUP => 1 );
my $minicpan   = dir(qw/t CPAN/);
my $archive_re = qr{\.(?:tar\.(?:bz2|gz|Z)|t(?:gz|bz)|zip|pm\.gz)$}i;

my @files;
find(
    {
        follow   => 0,
        no_chdir => 1,
        wanted   => sub { push @files, $_ if -f && /\.tar\.gz$/ },

t/01-App-CPAN-Mini-Visit.t view on Meta::CPAN


#--------------------------------------------------------------------------#
# Option: version
#--------------------------------------------------------------------------#

for my $opt (qw/ --version -V /) {
    try eval {
        capture sub {
            App::CPAN::Mini::Visit->run($opt);
          } => \$stdout,
          \$stderr;
    };
    catch my $err;
    is( $stderr, "$exe: $App::CPAN::Mini::Visit::VERSION\n", "[$opt] correct" )
      or diag $err;
}

#--------------------------------------------------------------------------#
# Option: help
#--------------------------------------------------------------------------#

for my $opt (qw/ --help -h /) {
    try eval {
        capture sub {
            App::CPAN::Mini::Visit->run($opt);
          } => \$stdout,
          \$stderr;
    };
    catch my $err;
    like( $stderr, qr/^Usage:/, "[$opt] correct" ) or diag $err;
}

#--------------------------------------------------------------------------#
# minicpan -- no minicpanrc and no --minicpan should fail with error
#--------------------------------------------------------------------------#

# homedir for testing
local $ENV{HOME} = $tempdir;

# should have error here
{
    my $label = "no minicpan config";
    try eval {
        capture sub {
            App::CPAN::Mini::Visit->run();
          } => \$stdout,
          \$stderr;
    };
    catch my $err;
    like( $stderr, qr/^No minicpan configured/, "[$label] error message correct" )
      or diag $err;
}

# missing minicpan directory should have error
my $bad_minicpan = 'doesntexist';
_create_minicpanrc("local: $bad_minicpan");
{
    my $label = "missing minicpan dir";
    try eval {
        capture sub {
            App::CPAN::Mini::Visit->run();
          } => \$stdout,
          \$stderr;
    };
    catch my $err;
    like(
        $stderr,
        qr/^Directory '$bad_minicpan' does not appear to be a CPAN repository/,
        "[$label] error message correct"
    ) or diag $err;
}

# badly structured minicpan directory should have error
$bad_minicpan = dir( $tempdir, 'CPAN' );
mkdir $bad_minicpan;
_create_minicpanrc("local: $bad_minicpan");
{
    my $label = "bad minicpan dir";
    try eval {
        capture sub {
            App::CPAN::Mini::Visit->run();
          } => \$stdout,
          \$stderr;
    };
    catch my $err;
    like(
        $stderr,
        qr/^Directory '\Q$bad_minicpan\E' does not appear to be a CPAN repository/,
        "[$label] error message correct"
    ) or diag $err;
}

# good minicpan directory (from options -- overrides bad config)
for my $opt (qw/ --minicpan -m /) {
    my $label = "good $opt=...";
    try eval {
        capture sub {
            App::CPAN::Mini::Visit->run("$opt=$minicpan");
          } => \$stdout,
          \$stderr;
    };
    catch my $err;
    is( $stderr, "", "[$label] no error message" ) or diag $err;
}

# good minicpan directory (from config only)
_create_minicpanrc("local: $minicpan");
{
    my $label = "good minicpan from config";
    try eval {
        capture sub {
            App::CPAN::Mini::Visit->run();
          } => \$stdout,
          \$stderr;
    };
    catch my $err;
    is( $stderr, "", "[$label] no error message" ) or diag $err;
}

# bad minicpan directory (from options -- overrides bad config)
{
    my $label = "bad -m=...";
    try eval {
        capture sub {
            App::CPAN::Mini::Visit->run("-m=$bad_minicpan");
          } => \$stdout,
          \$stderr;
    };
    catch my $err;
    like(
        $stderr,
        qr/^Directory '\Q$bad_minicpan\E' does not appear to be a CPAN repository/,
        "[$label] error message correct"
    ) or diag $err;
}

#--------------------------------------------------------------------------#
# default behavior -- list files
#--------------------------------------------------------------------------#

{
    my $label = "list files";
    try eval {
        capture sub {
            App::CPAN::Mini::Visit->run();
          } => \$stdout,
          \$stderr;
    };
    catch my $err;
    my @found = split /\n/, $stdout;
    is_deeply( \@found, \@files, "[$label] listing correct" );
}

#--------------------------------------------------------------------------#
# run program
#--------------------------------------------------------------------------#

{
    my $label = "pwd";
    try eval {
        capture sub {
            App::CPAN::Mini::Visit->run( "--", $^X, '-e',
                'use Cwd qw/abs_path/; print abs_path(".") . "\n"' );
          } => \$stdout,
          \$stderr;
    };
    catch my $err;
    my @found =
      map { dir($_)->relative( dir($_)->parent ) } split /\n/, $stdout;
    my @expect = map {
        my $base = file($_)->basename;
        $base =~ s{$archive_re}{};
        $base;
    } @files;
    ok( length $stdout, "[$label] got stdout" ) or diag $err;
    is_deeply( \@found, \@expect, "[$label] listing correct" )
      or diag "STDOUT:\n$stdout\nSTDERR:\n$stderr\n";
}

#--------------------------------------------------------------------------#
# run perl -e
#--------------------------------------------------------------------------#

{
    my $label = "perl-e";
    try eval {
        capture sub {
            App::CPAN::Mini::Visit->run( '-e',
                'use Cwd qw/abs_path/; print abs_path(".") . "\n"' );
          } => \$stdout,
          \$stderr;
    };
    catch my $err;
    my @found =
      map { dir($_)->relative( dir($_)->parent ) } split /\n/, $stdout;
    my @expect = map {
        my $base = file($_)->basename;
        $base =~ s{$archive_re}{};
        $base;
    } @files;
    ok( length $stdout, "[$label] got stdout" ) or diag $err;
    is_deeply( \@found, \@expect, "[$label] listing correct" )
      or diag "STDOUT:\n$stdout\nSTDERR:\n$stderr\n";
}

#--------------------------------------------------------------------------#
# run perl -E
#--------------------------------------------------------------------------#

{
    my $label = "perl-E";
    try eval {
        capture sub {
            App::CPAN::Mini::Visit->run( '-E',
                'use Cwd qw/abs_path/; print abs_path(".") . "\n"' );
          } => \$stdout,
          \$stderr;
    };
    catch my $err;
    my @found =
      map { dir($_)->relative( dir($_)->parent ) } split /\n/, $stdout;
    my @expect = map {
        my $base = file($_)->basename;
        $base =~ s{$archive_re}{};
        $base;
    } @files;
    ok( length $stdout, "[$label] got stdout" ) or diag $err;
    is_deeply( \@found, \@expect, "[$label] listing correct" )
      or diag "STDOUT:\n$stdout\nSTDERR:\n$stderr\n";
}

#--------------------------------------------------------------------------#
# --append path
#--------------------------------------------------------------------------#

{
    my $label = "path";
    for my $opt (qw/ --append -a /) {
        try eval {
            capture sub {
                App::CPAN::Mini::Visit->run( "$opt=path", "--", $^X, '-e',
                    'print shift(@ARGV) . "\n"' );
              } => \$stdout,
              \$stderr;
        };
        catch my $err;
        my @found = split /\n/, $stdout;
        my @expect = @files;
        ok( length $stdout, "[$label] ($opt) got stdout" ) or diag $err;
        is_deeply( \@found, \@expect, "[$label] ($opt) listing correct" )
          or diag "STDOUT:\n$stdout\nSTDERR:\n$stderr\n";
    }
}

#--------------------------------------------------------------------------#
# --append dist
#--------------------------------------------------------------------------#

{
    my $label = "dist";
    for my $opt (qw/ --append -a /) {
        try eval {
            capture sub {
                App::CPAN::Mini::Visit->run( "$opt=dist", "--", $^X, '-e',
                    'print shift(@ARGV) . "\n"' );
              } => \$stdout,
              \$stderr;
        };
        catch my $err;
        my @found = split /\n/, $stdout;
        my $prefix = dir( $minicpan, qw/ authors id / )->absolute;
        my @expect = map {
            ( my $file = $_ ) =~ s{$prefix[/\\].[/\\]..[/\\]}{};
            $file;
        } @files;
        ok( length $stdout, "[$label] ($opt) got stdout" ) or diag $err;
        is_deeply( \@found, \@expect, "[$label] ($opt) listing correct" )
          or diag "STDOUT:\n$stdout\nSTDERR:\n$stderr\n";
    }
}

#--------------------------------------------------------------------------#
# --output file
#--------------------------------------------------------------------------#

{
    my $label    = "output";
    my $tempfile = tmpnam();
    try eval {
        capture sub {
            App::CPAN::Mini::Visit->run("--output=$tempfile");
          } => \$stdout,
          \$stderr;
    };
    catch my $err;
    ok( -f $tempfile, "[$label] output file created" );
    my @found = map { chomp; $_ } do { local @ARGV = ($tempfile); <> };
    is( $stdout, '', "[$label] saw no output on terminal" );
    is_deeply( \@found, \@files, "[$label] listing correct" );
}

xt/author/00-compile.t view on Meta::CPAN

use File::Spec;
use IPC::Open3;
use IO::Handle;

open my $stdin, '<', File::Spec->devnull or die "can't open devnull: $!";

my @warnings;
for my $lib (@module_files)
{
    # see L<perlfaq8/How can I capture STDERR from an external command?>
    my $stderr = IO::Handle->new;

    my $pid = open3($stdin, '>&STDERR', $stderr, $^X, $inc_switch, '-e', "require q[$lib]");
    binmode $stderr, ':crlf' if $^O eq 'MSWin32';
    my @_warnings = <$stderr>;
    waitpid($pid, 0);
    is($?, 0, "$lib loaded ok");

    if (@_warnings)
    {
        warn @_warnings;
        push @warnings, @_warnings;
    }
}

foreach my $file (@scripts)
{ SKIP: {
    open my $fh, '<', $file or warn("Unable to open $file: $!"), next;
    my $line = <$fh>;
    close $fh and skip("$file isn't perl", 1) unless $line =~ /^#!.*?\bperl\b\s*(.*)$/;

    my @flags = $1 ? split(/\s+/, $1) : ();

    my $stderr = IO::Handle->new;

    my $pid = open3($stdin, '>&STDERR', $stderr, $^X, $inc_switch, @flags, '-c', $file);
    binmode $stderr, ':crlf' if $^O eq 'MSWin32';
    my @_warnings = <$stderr>;
    waitpid($pid, 0);
    is($?, 0, "$file compiled ok");

   # in older perls, -c output is simply the file portion of the path being tested
    if (@_warnings = grep { !/\bsyntax OK$/ }
        grep { chomp; $_ ne (File::Spec->splitpath($file))[2] } @_warnings)
    {
        warn @_warnings;
        push @warnings, @_warnings;
    }

( run in 1.130 second using v1.01-cache-2.11-cpan-49f99fa48dc )