view release on metacpan or  search on metacpan

t/base.t  view on Meta::CPAN

##############################################################################
# Defaults.
$config->replace;
isa_ok $sqitch = $CLASS->new(config => $config), $CLASS, 'A new object';

is $sqitch->verbosity, 1, 'Default verbosity should be 1';
ok $sqitch->sysuser, 'Should have default sysuser from system';
ok $sqitch->user_name, 'Default user_name should be set from system';
is $sqitch->user_email, do {
    require Sys::Hostname;
    $sqitch->sysuser . '@' . Sys::Hostname::hostname();
}, 'Default user_email should be set from system';

##############################################################################
# User environment variables.
ENV: {
    # Try originating host variables.
    local $ENV{SQITCH_ORIG_SYSUSER} = "__kamala__";
    local $ENV{SQITCH_ORIG_FULLNAME} = 'Kamala Harris';
    local $ENV{SQITCH_ORIG_EMAIL} = 'kamala@whitehouse.gov';
    isa_ok $sqitch = $CLASS->new(config => $config), $CLASS, 'Another new object';
    is $sqitch->sysuser, $ENV{SQITCH_ORIG_SYSUSER},
        "SQITCH_ORIG_SYSUER should override system username";
    is $sqitch->user_name, $ENV{SQITCH_ORIG_FULLNAME},
        "SQITCH_ORIG_FULLNAME should override system user full name";
    is $sqitch->user_email, $ENV{SQITCH_ORIG_EMAIL},
        "SQITCH_ORIG_EMAIL should override system-derived email";

    # Local variables take precedence over originating host variables.
    local $ENV{SQITCH_FULLNAME} = 'Barack Obama';
    local $ENV{SQITCH_EMAIL} = 'barack@whitehouse.gov';
    isa_ok $sqitch = $CLASS->new, $CLASS, 'Another new object';
    is $sqitch->user_name, $ENV{SQITCH_FULLNAME},
        "SQITCH_FULLNAME should override originating host user full name";
    is $sqitch->user_email, $ENV{SQITCH_EMAIL},
        "SQITCH_EMAIL should override originating host email";
}

##############################################################################
# Test go().
GO: {
    local $ENV{SQITCH_ORIG_SYSUSER} = "__barack__";
    local $ENV{SQITCH_ORIG_FULLNAME} = 'Barack Obama';
    local $ENV{SQITCH_ORIG_EMAIL} = 'barack@whitehouse.gov';

    my $mock = Test::MockModule->new('App::Sqitch::Command::help');
    my ($cmd, @params);
    my $ret = 1;
    $mock->mock(execute => sub { ($cmd, @params) = @_; $ret });
    chdir 't';

    my $config = TestConfig->from(
        local => 'sqitch.conf',
        user  => 'user.conf',
    );

    my $mocker = Test::MockModule->new('App::Sqitch::Config');
    $mocker->mock(new => $config);

    local @ARGV = qw(help config);
    is +App::Sqitch->go, 0, 'Should get 0 from go()';

    isa_ok $cmd, 'App::Sqitch::Command::help', 'Command';
    is_deeply \@params, ['config'], 'Extra args should be passed to execute';

    isa_ok my $sqitch = $cmd->sqitch, 'App::Sqitch';
    ok $config = $sqitch->config, 'Get the Sqitch config';
    is $config->get(key => 'engine.pg.client'), '/usr/local/pgsql/bin/psql',
        'Should have local config overriding user';
    is $config->get(key => 'engine.pg.registry'), 'meta',
        'Should fall back on user config';
    is $sqitch->user_name, 'Michael Stonebraker',
        'Should have read user name from configuration';
    is $sqitch->user_email, 'michael@example.com',
        'Should have read user email from configuration';
    is_deeply $sqitch->options, { }, 'Should have no options';

    # Make sure USER_NAME and USER_EMAIL take precedence over configuration.
    local $ENV{SQITCH_FULLNAME} = 'Michelle Obama';
    local $ENV{SQITCH_EMAIL} = 'michelle@whitehouse.gov';
    is +App::Sqitch->go, 0, 'Should get 0 from go() again';
    isa_ok $sqitch = $cmd->sqitch, 'App::Sqitch';
    is $sqitch->user_name, 'Michelle Obama',
        'Should have read user name from environment';
    is $sqitch->user_email, 'michelle@whitehouse.gov',
        'Should have read user email from environment';

    # Mock outputs.
    my $sqitch_mock = Test::MockModule->new($CLASS);
    my @vented;
    $sqitch_mock->mock(vent => sub { shift; push @vented => @_ });
    my @traced;
    $sqitch_mock->mock(trace => sub { shift; push @traced => @_ });
    my @infoed;
    $sqitch_mock->mock(info => sub { shift; push @infoed => @_ });
    my @emitted;
    $sqitch_mock->mock(emit => sub { shift; push @emitted => @_ });

    # Now make it die.
    sub puke { App::Sqitch::X->new(@_) } # Ensures we have trace frames.
    my $ex = puke(ident => 'ohai', message => 'OMGWTF!');
    $mock->mock(execute => sub { die $ex });
    is $sqitch->go, 2, 'Go should return 2 on Sqitch exception';
    is_deeply \@vented, ['OMGWTF!'], 'The error should have been vented';
    is_deeply \@infoed, [], 'Should have no info output';
    is_deeply \@emitted, [], 'Should have no emitted output';
    is_deeply \@traced, [$ex->stack_trace->as_string],
        'The stack trace should have been sent to trace';

    # Make it die with a previous exception.
    $ex = puke(ident => 'yikes', message => 'Yikes!', previous_exception => 'Invalid snicker');
    @vented = @traced = ();
    is $sqitch->go, 2, 'Go should return 2 on next Sqitch exception';
    is_deeply \@vented, ['Yikes!'], 'The next error should have been vented';
    is_deeply \@infoed, [], 'Should have no info output';
    is_deeply \@emitted, [], 'Should have no emitted output';
    is_deeply \@traced, ["Invalid snicker\n" . $ex->stack_trace->as_string],
        'The previous exceptin and stack trace should have been sent to trace';

    # Make it die with a developer exception.