use strict;
use warnings;
use Test::More;
use CPAN::Mini::App;
use File::Spec;
use File::Temp qw(tempdir);
my $TARGET = tempdir(CLEANUP => 1);
my @LR_ARGS = (qw(--offline -r http://example.tld/cpan -l), $TARGET);
delete $ENV{CPAN_MINI_CONFIG};
{
no warnings 'redefine';
*File::HomeDir::my_home = sub { $ENV{HOME} };
}
sub config_dir {
my ($config) = @_;
my $tempdir = tempdir(CLEANUP => 1);
return $tempdir unless defined $config;
my $filename = File::Spec->catfile($tempdir, '.minicpanrc');
open my $config_fh, '>', $filename or die "can't write to $filename: $!";
for my $key (keys %$config) {
print {$config_fh} "$key: $config->{$key}\n";
}
close $config_fh or die "error closing $filename: $!";
return $tempdir;
}
subtest "defaults" => sub {
local $ENV{HOME} = config_dir;
local @ARGV = @LR_ARGS;
my $minicpan = CPAN::Mini::App->initialize_minicpan;
isa_ok($minicpan, 'CPAN::Mini');
is($minicpan->log_level, 'info', "default log level is info");
};
subtest "--debug" => sub {
local $ENV{HOME} = config_dir;
local @ARGV = (qw(--debug), @LR_ARGS);
my $minicpan = CPAN::Mini::App->initialize_minicpan;
isa_ok($minicpan, 'CPAN::Mini');
is($minicpan->log_level, 'debug', "--debug to get log level debug");
};
subtest "config: log_level" => sub {
local $ENV{HOME} = config_dir({ log_level => 'debug' });
local @ARGV = @LR_ARGS;
my $minicpan = CPAN::Mini::App->initialize_minicpan;
isa_ok($minicpan, 'CPAN::Mini');
is($minicpan->log_level, 'debug', "debug from config file");
};
subtest "--debug overrides config" => sub {
local $ENV{HOME} = config_dir({ log_level => 'fatal' });
local @ARGV = (qw(--debug), @LR_ARGS);
my $minicpan = CPAN::Mini::App->initialize_minicpan;
isa_ok($minicpan, 'CPAN::Mini');
is($minicpan->log_level, 'debug', "--debug overrides config file");
};
subtest "--log-level" => sub {
local $ENV{HOME} = config_dir;
local @ARGV = (qw(--log-level debug), @LR_ARGS);
my $minicpan = CPAN::Mini::App->initialize_minicpan;
isa_ok($minicpan, 'CPAN::Mini');
is($minicpan->log_level, 'debug', "--debug to get log level debug");
};
subtest "only one log-level-like switch allowed" => sub {
for my $combo (
[ qw(--debug -q) ],
[ qw(--debug --log-level debug) ],
) {
local $ENV{HOME} = config_dir;
local @ARGV = (@$combo, @LR_ARGS);
my $minicpan = eval { CPAN::Mini::App->initialize_minicpan };
like($@, qr/can't mix/, "can't use @$combo together");
};
};
for my $switch (qw(-qq --qq)) {
subtest "extra quiet with $switch" => sub {
local $ENV{HOME} = config_dir;
local @ARGV = ($switch, @LR_ARGS);
my $minicpan = CPAN::Mini::App->initialize_minicpan;
isa_ok($minicpan, 'CPAN::Mini');
is($minicpan->log_level, 'fatal', "$switch gets us log level 'fatal'");
};
}
subtest "-perl switch" => sub {
local $ENV{HOME} = config_dir;
local @ARGV = @LR_ARGS;
my $minicpan = CPAN::Mini::App->initialize_minicpan;
isa_ok($minicpan, 'CPAN::Mini');
is($minicpan->{skip_perl}, 1, "'skip_perl' is true without -perl switch");
local @ARGV = ('-perl', @LR_ARGS);
$minicpan = CPAN::Mini::App->initialize_minicpan;
isa_ok($minicpan, 'CPAN::Mini');
is($minicpan->{skip_perl}, q{}, "'skip_perl' is false with -perl switch");
};
done_testing;
1;