03_config_file.t

#!perl
use strict;
BEGIN{ if (not $] < 5.006) { require warnings; warnings->import } }

select(STDERR); $|=1;
select(STDOUT); $|=1;

use Test::More;
use Config::Tiny;
use IO::CaptureOutput qw/capture/;
use File::Basename qw/basename/;
use File::Spec;
use File::Temp qw/tempdir/;
use File::Path qw/mkpath/;
use t::Frontend;
use t::MockHomeDir;

plan tests => 62;
#plan 'no_plan';

#--------------------------------------------------------------------------#
# Fixtures
#--------------------------------------------------------------------------#

my $config_dir = File::Spec->catdir( t::MockHomeDir::home_dir, ".cpanreporter" );
my $config_file = File::Spec->catfile( $config_dir, "config.ini" );
my $metabase_file = File::Spec->catfile( $config_dir, 'metabase_id.json' );
my $default_options = {
    email_from => '',
    edit_report => 'default:ask/no pass/na:no',
    send_report => 'default:ask/yes pass/na:yes',
    transport   => "Metabase uri https://metabase.cpantesters.org/api/v1/ id_file metabase_id.json",
#    send_duplicates => 'default:no',
};
my @additional_prompts = ();

my ($rc, $stdout, $stderr);


#--------------------------------------------------------------------------#
# Mocking -- override support/system functions
#--------------------------------------------------------------------------#
{
    # touch our mock metabase_id.json file
    mkpath $config_dir;
    # 2-args open with bare descriptor to work in older perls
    open METABASE, ">$metabase_file";
    close METABASE;
    ok -r $metabase_file, 'created mock metabase file for testing';
}

#--------------------------------------------------------------------------#

require_ok('CPAN::Reporter');
require_ok('CPAN::Reporter::Config');

is( CPAN::Reporter::Config::_get_config_dir(), $config_dir,
    "get config dir path"
);

is( CPAN::Reporter::Config::_get_config_file(), $config_file,
    "get config file path"
);

# id_file normalizations
my @id_file_cases = (
  [ $metabase_file        => $metabase_file ],
  [ 'metabase_id.json'    => $metabase_file ],
  [ '/other/path.json'    => File::Spec->catfile( '/other/', 'path.json' )],
  [ 'other.json'          => File::Spec->catfile( $config_dir, 'other.json' )],
  [ '~/other.json'        => File::Spec->catfile( File::HomeDir->my_home, 'other.json' )],
);

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"
);

is( capture(sub{CPAN::Reporter::Config::_open_config_file()}, \$stdout, \$stderr),
    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 {
        ok( $rc = capture(sub{CPAN::Reporter::configure()}, \$stdout, \$stderr),
            "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
        is( capture(sub{CPAN::Reporter::configure()}, \$stdout, \$stderr),
            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
        is( capture(sub{CPAN::Reporter::configure()}, \$stdout, \$stderr),
            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
        ok( capture(sub{CPAN::Reporter::configure()}, \$stdout, \$stderr),
            "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"
    );
}

#--------------------------------------------------------------------------#
# confirm _get_config_options handles bad action pair validation
#--------------------------------------------------------------------------#

SKIP:
{
    skip "Couldn't set config file writable again; skipping additional tests", 4
        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->{_}{edit_report} = "invalid:invalid";

    ok( $tiny->write( $config_file ),
        "updated config file with a bad edit_report setting"
    );

    $tiny = Config::Tiny->read( $config_file );
    my $parsed_config;
    capture sub{         
        $parsed_config = CPAN::Reporter::Config::_get_config_options( $tiny );
    }, \$stdout, \$stderr;

    like( $stdout, "/invalid option 'invalid:invalid' in 'edit_report'. Using default instead./",
        "bad option warning seen"
    );

    is( $parsed_config->{edit_report}, "default:ask/no pass/na:no",
        "edit_report default returned"
    );

    $tiny = Config::Tiny->read( $config_file );
    is( $tiny->{_}{edit_report}, "invalid:invalid",
        "bad edit_report preserved in config.ini"
    );
    delete $tiny->{_}{edit_report};
    $tiny->write( $config_file );
}

#--------------------------------------------------------------------------#
# Test skipfile validation
#--------------------------------------------------------------------------#

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

    for my $skip_type ( qw/ send_skipfile cc_skipfile / ) {
        my $tiny = Config::Tiny->read( $config_file );
        $tiny->{_}{$skip_type} = 'bogus.skipfile';

        ok( $tiny->write( $config_file ),
            "updated config file with a bad $skip_type"
        );

        $tiny = Config::Tiny->read( $config_file );
        my $parsed_config;
        capture sub{         
            $parsed_config = CPAN::Reporter::Config::_get_config_options( $tiny );
        }, \$stdout, \$stderr;

        like( $stdout, "/invalid option 'bogus.skipfile' in '$skip_type'. Using default instead./",
            "bad $skip_type option warning seen"
        );

        is( $parsed_config->{skipfile}, undef,
            "$skip_type default returned"
        );

        $tiny = Config::Tiny->read( $config_file );
        is( $tiny->{_}{$skip_type}, "bogus.skipfile",
            "bogus $skip_type preserved in config.ini"
        );

        my $skipfile = File::Temp->new(
            TEMPLATE => "CPAN-Reporter-testskip-XXXXXXXX",
            DIR => File::Spec->tmpdir(),
        );
        ok( -r $skipfile, "generated a $skip_type in the temp directory" );
        $tiny->{_}{$skip_type} = "$skipfile";
        ok( $tiny->write( $config_file ),
            "updated config file with an absolute $skip_type path"
        );

        $tiny = Config::Tiny->read( $config_file );
        capture sub{         
            $parsed_config = CPAN::Reporter::Config::_get_config_options( $tiny );
        }, \$stdout, \$stderr;

        is( $stdout, q{},
            "absolute $skip_type ok"
        );

        $skipfile = File::Temp->new( 
            TEMPLATE => "CPAN-Reporter-testskip-XXXXXXXX",
            DIR => $config_dir,
        );
        ok( -r $skipfile, "generated a $skip_type in the config directory" );

        my $relative_skipfile = basename($skipfile);
        ok( ! File::Spec->file_name_is_absolute( $relative_skipfile ),
            "generated a relative $skip_type name"
        );
        $tiny->{_}{$skip_type} = $relative_skipfile;
        ok( $tiny->write( $config_file ),
            "updated config file with a relative $skip_type path"
        );

        $tiny = Config::Tiny->read( $config_file );
        capture sub{         
            $parsed_config = CPAN::Reporter::Config::_get_config_options( $tiny );
        }, \$stdout, \$stderr;

        is( $stdout, q{},
            "relative $skip_type ok"
        );

        delete $tiny->{_}{$skip_type};
        $tiny->write( $config_file );
    }
}