view release on metacpan or  search on metacpan

t/app.t  view on Meta::CPAN

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;