view release on metacpan or  search on metacpan

t/firebird.t  view on Meta::CPAN

##############################################################################
# Test various database connection and error-handling logic.
DBH: {
    # Need to mock DBH.
    my $dbh = DBI->connect('dbi:Mem:', undef, undef, {});
    my $mock_engine = Test::MockModule->new($CLASS);
    $mock_engine->mock(dbh => $dbh);
    $mock_engine->mock(registry_uri => URI->new('db:firebird:foo.fdb'));
    my $mock_dbd = Test::MockModule->new(ref $dbh, no_auto => 1);
    my ($disconnect, $clear);
    $mock_dbd->mock(disconnect => sub { $disconnect = 1 });
    $mock_engine->mock(_clear_dbh => sub { $clear = 1 });
    my $run;
    $mock_sqitch->mock(run => sub { $run = 1 });

    # Test that upgrading disconnects from a local database before upgrading.
    ok $fb->run_upgrade('somefile'), 'Run the upgrade';
    ok $disconnect, 'Should have disconnected';
    ok $clear, 'Should have cleared the database handle';
    ok $run, 'Should have run a command';
    $mock_sqitch->unmock('run');

    # Test that _cid propagates an unexpected error from DBI.
    local *DBI::err;
    $DBI::err = 0;
    $mock_engine->mock(dbh => sub { die 'Oops' });
    throws_ok { $fb->_cid('ASC', 0, 'foo') } qr/^Oops/,
        '_cid should propagate unexpected error';

    # But it should just return for error code -902.
    $DBI::err = -902;
    lives_ok { $fb->_cid('ASC', 0, 'foo') }
        '_cid should just return on error code -902';

    # Test that current_state returns on no table error.
    local *DBI::errstr;
    $DBI::errstr = '-Table unknown';
    $mock_engine->mock(initialized => 0);
    lives_ok { $fb->current_state('foo') }
        'current_state should return on no table error';

    # But it should die if it's not a table error.
    $DBI::errstr = 'Some other error';
    throws_ok { $fb->current_state('foo') } qr/^Oops/,
        'current_state should propagate unexpected error';

    # Make sure change_id_for returns undef when no useful params.
    $mock_engine->mock(dbh => $dbh);
    is $fb->change_id_for(project => 'foo'), undef,
        'Should get undef from change_id_for when no useful params';
}

# Make sure default_client croaks when it finds no client.
FSPEC: {
    # Give it an invalid fbsql file to find.
    my $tmpdir = tempdir(CLEANUP => 1);
    my $tmp = Path::Class::Dir->new("$tmpdir");
    my $iswin = App::Sqitch::ISWIN || $^O eq 'cygwin';
    my $fbsql = $tmp->file('fbsql' . ($iswin ? '.exe' : ''));
    $fbsql->touch;
    chmod 0755, $fbsql unless $iswin;

    my $fs_mock = Test::MockModule->new('File::Spec');
    $fs_mock->mock(path => sub { $tmp });
    throws_ok { $fb->default_client } 'App::Sqitch::X',
        'Should get error when no client found';
    is $@->ident, 'firebird', 'Client exception ident should be "firebird"';
    is $@->message, __x(
        'Unable to locate {cli} client; set "engine.{eng}.client" via sqitch config',
        cli => 'Firebird ISQL',
        eng => 'firebird',
    ), 'Client exception message should be correct';
}

# Make sure we have templates.
DBIEngineTest->test_templates_for($fb->key);

##############################################################################
# Can we do live tests?
my ($data_dir, $fb_version, @cleanup) = ($tmpdir);
my $id = DBIEngineTest->randstr;
my ($reg1, $reg2) = map { $_ . $id } qw(__sqitchreg_ __metasqitch_);
my $err = try {
    return unless $have_fb_driver;
    if ($uri->dbname) {
        $data_dir = dirname $uri->dbname; # Assumes local OS semantics.
    } else {
        # Assume we're running locally and create the database.
        my $dbpath = catfile($tmpdir, "__sqitchtest__$id");
        $data_dir = $tmpdir;
        $uri->dbname($dbpath);
        DBD::Firebird->create_database({
            db_path       => $dbpath,
            user          => $uri->user,
            password      => $uri->password,
            character_set => 'UTF8',
            page_size     => 16384,
        });
        # We created this database, we need to clean it up.
        @cleanup = ($dbpath);
    }

    # Try to connect.
    my $dbh = DBI->connect($uri->dbi_dsn, $uri->user, $uri->password, {
        PrintError  => 0,
        RaiseError  => 0,
        AutoCommit  => 1,
        HandleError => $fb->error_handler,
    });
    $fb_version = $dbh->selectcol_arrayref(q{
        SELECT rdb$get_context('SYSTEM', 'ENGINE_VERSION')
          FROM rdb$database
    })->[0];

    # We will need to clean up the registry DBs we create.
    push @cleanup => map { catfile $data_dir, $_ } $reg1, $reg2;
    return undef;
} catch {
    return $_ if blessed $_ && $_->isa('App::Sqitch::X');
    return App::Sqitch::X->new(
        message            => 'Failed to connect to Firebird',