view release on metacpan or  search on metacpan

t/03_config_file.t  view on Meta::CPAN

);

for my $c ( @id_file_cases ) {
  is( CPAN::Reporter::Config::_normalize_id_file( $c->[0] ), $c->[1],
    "normalize id_file: $c->[0]"
  );
}

ok( ! -f $config_file,
    "no config file yet"
);

my $ret;
($stdout, $stderr) = capture {
    $ret = CPAN::Reporter::Config::_open_config_file();
};
is( $ret, undef, "opening non-existent file returns undef" );

like( $stdout, "/couldn't read configuration file/ms",
    "opening non-existent file gives a warning"
);

{
    local $ENV{PERL_MM_USE_DEFAULT} = 1;  # use prompt defaults
    eval {
        ( $stdout, $stderr ) = capture { $rc = CPAN::Reporter::configure() };
        ok( $rc, "configure() returned true" );
    };
    diag "STDOUT:\n$stdout\nSTDERR:$stderr\n" if $@; 
}

for my $option ( keys %$default_options, @additional_prompts) {
    like( $stdout, "/$option/",
        "saw '$option' configuration prompt"
    );
}

is( ref $rc, 'HASH',
    "configure() returned a hash reference"
);

is_deeply( $rc, $default_options,
    "configure return value has expected defaults"
);

ok( -f $config_file,
    "configuration successfully created a config file"
);

my $new_config = Config::Tiny->read( $config_file );
is_deeply( $new_config->{_}, $default_options,
    "newly created config file has expected defaults"
);


#--------------------------------------------------------------------------#
# check error handling if not readable
#--------------------------------------------------------------------------#

my $original_mode = (stat $config_file)[2] & 07777;
chmod 0, $config_file ;

SKIP:
{
    skip "Couldn't set config file unreadable; skipping related tests", 2
        if -r $config_file;

    {
        local $ENV{PERL_MM_USE_DEFAULT} = 1;  # use prompt defaults

        my $ret;
        ($stdout, $stderr) = capture { $ret = CPAN::Reporter::configure() };

        is( $ret, undef, "configure() is undef if file not readable" );
    }

    like( $stdout, "/couldn't read configuration file/",
        "opening non-readable file gives a warning"
    );
}

chmod $original_mode, $config_file;
ok( -r $config_file,
    "config file reset to readable"
);

#--------------------------------------------------------------------------#
# check error handling if not writeable 
#--------------------------------------------------------------------------#

chmod 0444, $config_file;

SKIP:
{
    skip "Couldn't set config file unwritable; skipping related tests", 2
        if -w $config_file;

    {
        local $ENV{PERL_MM_USE_DEFAULT} = 1;  # use prompt defaults

        my $ret;
        ($stdout, $stderr) = capture { $ret = CPAN::Reporter::configure() };

        is( $ret, undef, "configure() is undef if file not writeable" );
    }

    like( $stdout, "/error writing config file/",
        "opening non-writeable file gives a warning"
    );
}

chmod $original_mode, $config_file;
ok( -w $config_file,
    "config file reset to writeable"
);

#--------------------------------------------------------------------------#
# confirm configure() preserves existing
#--------------------------------------------------------------------------#

SKIP:
{
    skip "Couldn't set config file writable again; skipping related tests", 8
        if ! -w $config_file;

    my $bogus_email = 'nobody@nowhere.com';
    my $bogus_smtp = 'mail.mail.com';
    my $bogus_debug = 1;

    my $tiny = Config::Tiny->read( $config_file );
    $tiny->{_}{email_from} = $bogus_email;
    $tiny->{_}{smtp_server} = $bogus_smtp;
    $tiny->{_}{debug} = $bogus_debug;

    ok( $tiny->write( $config_file ),
        "updated config file with a new email address and smtp server"
    );

    {
        local $ENV{PERL_MM_USE_DEFAULT} = 1;  # use prompt defaults

        my $ret;
        ($stdout, $stderr) = capture { $ret = CPAN::Reporter::configure() };

        ok( $ret, "configure() ran again successfully" );
    }

    like( $stdout, "/$bogus_email/",
        "pre-existing email address was seen during configuration prompts"
    );

    like( $stdout, "/$bogus_smtp/",
        "pre-existing smtp server was seen during configuration prompts"
    );

    like( $stdout, "/debug/",
        "pre-existing debug prompt was seen during configuration prompts"
    );

    is( $tiny->{_}{email_from}, $bogus_email,
        "updated config file preserved email address"
    );

    is( $tiny->{_}{smtp_server}, $bogus_smtp,
        "updated config file preserved smtp server"
    );

    is( $tiny->{_}{debug}, $bogus_debug,
        "updated config file preserved debug value"
    );
}