#!/usr/bin/perl -w
#
#
# This is a test for ib_set_tx_param() private method.
#
# 2011-01-29 stefan(s. bv)
# New version based on t/testlib.pl and Firebird.dbtest
# Note: set_tx_param() is obsoleted by ib_set_tx_param().
#
# Transaction behavior default parameter values:
# Access mode: read_write
# Isolation level: snapshot
# Lock resolution: wait
use strict;
use warnings;
use Test::More;
use DBI;
use lib 't','.';
use TestFirebird;
my $T = TestFirebird->new;
my ( $dbh1, $error_str1 ) =
$T->connect_to_database( { ChopBlanks => 1 } );
if ($error_str1) {
BAIL_OUT("Unknown: $error_str1!");
}
else {
plan tests => 22;
}
unless ( $dbh1->isa('DBI::db') ) {
plan skip_all => 'Connection to database failed, cannot continue testing';
}
ok($dbh1, 'Connected to the database (1)');
my ( $dbh2, $error_str2 ) =
$T->connect_to_database( { ChopBlanks => 1 } );
ok($dbh2, 'Connected to the database (2)');
# DBI->trace(4, "trace.txt");
# ------- TESTS ------------------------------------------------------------- #
#
# Find a possible new table name
#
my $table = find_new_table($dbh1);
ok($table, "TABLE is '$table'");
#
# Create a new table
#
my $def =<<"DEF";
CREATE TABLE $table (
id INTEGER PRIMARY KEY,
name VARCHAR(20)
)
DEF
ok( $dbh1->do($def), qq{CREATE TABLE '$table'} );
#
# Changes transaction params
#
ok(
$dbh1->func(
-access_mode => 'read_write',
-isolation_level => 'read_committed',
-lock_resolution => 'wait',
'ib_set_tx_param'
),
'SET tx param for dbh 1'
);
ok(
$dbh2->func(
-access_mode => 'read_only',
-lock_resolution => 'no_wait',
'ib_set_tx_param'
),
'SET tx param for dbh 2'
);
SCOPE: {
local $dbh1->{AutoCommit} = 0;
local $dbh2->{PrintError} = 0;
my $insert_stmt = qq{ INSERT INTO $table VALUES(?, 'Yustina') };
my $select_stmt = qq{ SELECT * FROM $table WHERE 1 = 0 };
ok(my $sth2 = $dbh2->prepare($select_stmt), 'PREPARE SELECT');
ok($dbh1->do($insert_stmt, undef, 1), 'DO INSERT (1)');
#- Expected failure ( -access_mode => 'read_only' )
eval {
$dbh2->do($insert_stmt, undef, 2);
};
ok($@, "DO INSERT (2) Expected failure ('read_only' )");
#- Reading should be ok here
ok($sth2->execute, 'EXECUTE sth 2');
ok($sth2->finish, 'FINISH sth 2');
#- Committing the first trans
ok($dbh1->commit, 'COMMIT dbh 1');
ok(
$dbh1->func(
-access_mode => 'read_write',
-isolation_level => 'read_committed',
-lock_resolution => 'wait',
-reserving => {
$table => {
lock => 'write',
access => 'protected',
},
},
'ib_set_tx_param'
),
'CHANGE tx param for dbh 1'
);
ok(
$dbh2->func(
-lock_resolution => 'no_wait',
'ib_set_tx_param'
),
'CHANGE tx param for dbh 2'
);
ok($dbh1->do($insert_stmt, undef, 3), 'DO INSERT (2)');
#- Expected failure ( -lock_resolution => 'no_wait' )
eval {
$dbh2->do($insert_stmt, undef, 4);
};
ok($@, "DO INSERT (3) Expected failure ('no_wait')");
# Committing the first trans
ok($dbh1->commit, 'COMMIT dbh 1');
}
#
# Drop the test table
#
isa_ok( $dbh1, 'DBI::db' );
isa_ok( $dbh2, 'DBI::db' );
#
# Disconnect 2
ok($dbh2->disconnect, 'DISCONNECT 2');
# AutoCommit is on
ok( $dbh1->do("DROP TABLE $table"), "DROP TABLE '$table'" );
#
# Finally disconnect 1
#
ok($dbh1->disconnect, 'DISCONNECT 1');