DBI transaction handling ...

I have updated to the latest version of DBI/DBD.
I have no idea why DBI performs an implicit ROLLBACK since I want to
perform a COMMIT.
I have compiled the code below. The INSERT stuff seems to work but the
UPDATE stuff won't be visible at the end of the transactions. My COMMIT
statement does not bomb out an error but performs a ROLLBACK instead.
Maybe somebody has similar problems with DBI/DBD. Maybe it is a bug
somewhere.
Can anybody help me? Two of us had a closer at it but nobody has found
the error so far. Maybe it is a bug inside the DBI/DBD stuff.

Hans

#!/usr/bin/perl -I/usr/local/shoppingnet/lib/

# www.postgresql.at, Schönig 2003

use strict;
use DBI;
use debug;
use config;
use database;
use helper;

# Verbinde zur Datenbank ...
my $config = config->new();
my $proddb = database->new(db => $config->{DB},
parameter => $config->{PGCONNECT}, autocommit => 0 );
my $proddb2 = database->new(db => $config->{DB},
parameter => $config->{PGCONNECT}, autocommit => 0 );

$proddb->dbi_begin();
$proddb->dbi_do("SET TRANSACTION ISOLATION LEVEL SERIALIZABLE");

# $proddb2->dbi_begin();
$proddb2->dbi_do("SET TRANSACTION ISOLATION LEVEL SERIALIZABLE");

# Auslesen der Lieferanten, die unfertige Bestellungen haben
$proddb->dbi_select("SELECT DISTINCT lief_nr
FROM t_bestell_arch
WHERE abgeholt IS NULL OR abgeholt = 'f' ");

my @xarray;
for (my $i = 0; $i < $proddb->{rows}; $i++)
{
push @xarray, $proddb->{data}->[$i][0];
}

foreach my $lief_nr (@xarray)
{
my $kundendb = "K".$lief_nr;
my $newdbh = database->new(db => "dbname=$kundendb",
parameter => $config->{KUNDENCONNECT}, autocommit => 0 );
# $newdbh->dbi_begin();

my @line;
$proddb->dbi_select("SELECT transakt_nr, kd_nr_lief, name1,
name2, strasse1, strasse2, land_iso, plz,
telefon, fax, email
FROM t_bestell_arch
WHERE t_bestell_arch.lief_nr = '$lief_nr' AND
(abgeholt IS NULL OR abgeholt = 'f') ");

my $xa = '';

# durchgehen der bestellungen
for (my $j = 0; $j < $proddb->{rows}; $j++)
{
# setzen der spalten
for (my $m = 0; $m <= 10; $m++)
{
$line[$m] = $proddb->{data}->[$j][$m];
}

&debug::debug("Verarbeite Transaktionsnummer: $line[0]");
$newdbh->dbi_do("INSERT INTO t_bestell_arch
(transakt_nr, kd_nr_lief,
name1, name2, strasse1,
strasse2, land_iso, plz, telefon,
fax, email)
VALUES ('$line[0]', '$line[1]',
'$line[2]', '$line[3]',
'$line[4]', '$line[5]',
'$line[6]', '$line[7]', '$line[8]',
'$line[9]', '$line[10]' )");

$proddb2->dbi_select("SELECT datum_zeit, transakt_nr,
art_nr_lief, prodcode, kurz_text,
lang_text, vp_einh, vp_menge, vp_druck,
bestellmenge, preis, mwst
FROM t_bestell_detail_arch
WHERE t_bestell_detail_arch.lief_nr = '$lief_nr'
AND t_bestell_detail_arch.transakt_nr =
'$line[0]'; ");
# Durchgehen der Bestellpositionen
for (my $n = 0; $n < $proddb2->{rows}; $n++)
{
my ($cpreis, $cmwst);
if (length $proddb2->{data}->[$n][10] eq 0)
{
$cpreis = "NULL";
}
else
{
$cpreis =
"'".$proddb2->{data}->[$n][10]."'";
}

if (length $proddb2->{data}->[$n][11] eq 0)
{
$cmwst = "NULL";
}
else
{
$cmwst = "'".$proddb2->{data}->[$n][11]."'";
}

my $pinsert = "INSERT INTO t_bestell_detail_arch
(datum_zeit, transakt_nr,
art_nr_lief, prodcode,
kurz_text, lang_text, vp_einh,
vp_menge, vp_druck,
bestellmenge, preis, mwst)
VALUES ('$proddb2->{data}->[$n][0]',
'$proddb2->{data}->[$n][1]',
'$proddb2->{data}->[$n][2]',
'$proddb2->{data}->[$n][3]',
'$proddb2->{data}->[$n][4]',
'$proddb2->{data}->[$n][5]',
'$proddb2->{data}->[$n][6]',
'$proddb2->{data}->[$n][7]',
'$proddb2->{data}->[$n][8]',
'$proddb2->{data}->[$n][9]',
$cpreis, $cmwst) ";
$newdbh->dbi_do($pinsert);
}

$proddb->dbi_do("UPDATE t_bestell_arch SET abgeholt = 't'
WHERE transakt_nr = '$line[0]' ");
}

# $newdbh->dbi_begin();
$newdbh->dbi_commit();
$newdbh->dbi_disconnect();
}

$proddb->dbi_commit();
$proddb->dbi_disconnect();

$proddb2->dbi_commit();
$proddb2->dbi_disconnect();

-----------------------------------------------
Here is the interface I am using.
I have been using this code for a long time and it seems to work.

package database;
use strict;
use config;
use DBI;

# Cybertec Geschwinde &. Schönig OEG 2002

push @INC, ".";

my $self;

# Konstruktor
sub new
{
$self = {};
my ($class, %args) = @_;
my $connect = $args{db};
my $parameter = $args{parameter};
my $autocommit = $args{autocommit};

if (length $autocommit eq 0)
{
$autocommit = 0;
}

# $self->{dbh} = DBI->connect("dbi:Pg:$config->{DB}",
# $config->{PGCONNECT}, "", {'AutoCommit' => 0}) or

# $self->{dbh} = DBI->connect("dbi:Pg:$connect",
# $parameter, "", {'AutoCommit' => 0}) or
# &debug::dblog("cannot connect to database:
".$self->{dbh}->errstr(), 1);

$self->{dbh} = DBI->connect("dbi:Pg:$connect",
$parameter, "", {'AutoCommit' => $autocommit}) or
&debug::dblog("cannot connect to database:
".$self->{dbh}->errstr(), 1);

&debug::dblog("connection ready ...");
bless($self);
return $self;
}

# funktion zur abfrage von daten
sub dbi_select
{
my $self = shift;
my $sql = $_[0];
&debug::debug("SELECT: $sql");
my $sth = $self->{dbh}->prepare($sql) or
&debug::dblog("cannot prepare query ($sql):
".$self->{dbh}->errstr, 1);
my $rv = $sth->execute() or
&debug::dblog("cannot execute query ($sql):
".$self->{dbh}->errstr, 1);
my $count = 0;
my @row;
my @data;
$self->{rows} = $sth->rows;
&debug::debug("SELECT ROWS: $self->{rows} --- ".$sth->rows);
my $tab = $sth->fetchall_arrayref;
$self->{data} = $tab;

bless($self);
return $self;
}

sub dbi_do
{
my $self = shift;
my $sql = shift;
&debug::debug("G: $sql");
my $rv = $self->{dbh}->do($sql) or
&debug::dblog("cannot perform SQL statement (".
$sql.") - ".$self->{dbh}->errstr, "dblog.log", 1);
return 0;
}

sub dbi_begin
{
my $rv = $self->{dbh}->begin_work() or
&debug::dblog("cannot begin transaction", 1);
return 0;
}

sub dbi_commit
{
&debug::dblog("trying to commit transaction");
my $rv = $self->{dbh}->commit() or
$self->{dbh}->rollback();
# &debug::dblog("cannot commit transaction:
".$self->{dbh}->errstr() , 1);
&debug::dblog("commit successful");
return 0;
}
sub dbi_selectone
{
my $sql = $_[1];
&debug::debug("SELECTONE: $sql");
my $sth = $self->{dbh}->prepare($sql) or
&debug::dblog("cannot compute ($sql): $!", 1);
my $rv = $sth->execute() or
&debug::dblog("cannot compute ($sql): $!", 1);
my @tab = $sth->fetchrow_array();
return $tab[0];
}

sub dbi_selectline
{
my $sql = $_[1];
&debug::debug("SELECTLINE: $sql");
my $sth = $self->{dbh}->prepare($sql) or
&debug::dblog("cannot compute ($sql): $!", 1);
my $rv = $sth->execute() or
&debug::dblog("cannot compute ($sql): $!", 1);
return $sth->fetchrow_array();
}

sub dbi_selectlinehash
{
my $sql = $_[1];
&debug::debug("SELECTLINEHASH: $sql");
my $sth = $self->{dbh}->prepare($sql) or
&debug::dblog("cannot compute ($sql): $!", 1);
my $rv = $sth->execute() or
&debug::dblog("cannot compute ($sql): $!", 1);
return $sth->fetchrow_hashref();
}

# ausführen der query
sub dbi_execute
{
my $self = shift;
my $list = $_[0];

my $sth = $self->{dbh}->prepare($list) or
&debug::makelog("cannot prepare query ($list): $!", 1);
my $rv = $sth->execute() or
&debug::makelog("cannot execute query ($list): $!", 1);
my $count = 0;
my @row;
my @data;
$self->{rows} = $sth->rows;
&debug::debug("SELECT (rows): $self->{rows}");
my $tab = $sth->fetchall_arrayref;
$self->{data} = $tab;

bless($self);
return $self;
}

# vorbereiten einer query
sub dbi_prepare
{
$self->{dbh}->do("DEALLOCATE $_[2]");
&debug::debug("START_PREPARE: $_[1] ");
my $rv = $self->{dbh}->do($_[1]) or
&debug::makelog("cannot perform SQL statement
(".$_[1].")", 1);
return 0;
}

# disconnect from database
sub dbi_disconnect
{
my $self = shift;
&debug::debug("Trenne Verbindung ...");
$self->{dbh}->disconnect()
or &debug::dblog("cannot disconnect from database", 1);
return 0;
}

---------------------------------

Here is the PostgreSQL log file:

2003-02-10 12:12:26 [20812] LOG: connection received: host=[local]
2003-02-10 12:12:26 [20812] LOG: connection authorized: user=hs
database=contec
2003-02-10 12:12:26 [20812] LOG: query: select getdatabaseencoding()
2003-02-10 12:12:26 [20812] LOG: duration: 0.003739 sec
2003-02-10 12:12:26 [20812] LOG: query: begin
2003-02-10 12:12:26 [20812] LOG: duration: 0.000263 sec
2003-02-10 12:12:26 [20813] LOG: connection received: host=[local]
2003-02-10 12:12:26 [20813] LOG: connection authorized: user=hs
database=contec
2003-02-10 12:12:26 [20813] LOG: query: select getdatabaseencoding()
2003-02-10 12:12:26 [20813] LOG: duration: 0.003197 sec
2003-02-10 12:12:26 [20813] LOG: query: begin
2003-02-10 12:12:26 [20813] LOG: duration: 0.000247 sec
2003-02-10 12:12:26 [20812] LOG: query: SET TRANSACTION ISOLATION
LEVEL SERIALIZABLE
2003-02-10 12:12:26 [20812] LOG: duration: 0.001518 sec
2003-02-10 12:12:26 [20813] LOG: query: SET TRANSACTION ISOLATION
LEVEL SERIALIZABLE
2003-02-10 12:12:26 [20813] LOG: duration: 0.000319 sec
2003-02-10 12:12:26 [20812] LOG: query: SELECT DISTINCT lief_nr
FROM t_bestell_arch
WHERE abgeholt IS NULL OR abgeholt = 'f'
2003-02-10 12:12:26 [20812] LOG: duration: 0.017677 sec
2003-02-10 12:12:26 [20814] LOG: connection received: host=[local]
2003-02-10 12:12:26 [20814] LOG: connection authorized: user=hs
database=K4020
2003-02-10 12:12:26 [20814] LOG: query: select getdatabaseencoding()
2003-02-10 12:12:26 [20814] LOG: duration: 0.003623 sec
2003-02-10 12:12:26 [20814] LOG: query: begin
2003-02-10 12:12:26 [20814] LOG: duration: 0.000243 sec
2003-02-10 12:12:26 [20812] LOG: query: SELECT transakt_nr,
kd_nr_lief, name1,
name2, strasse1, strasse2, land_iso, plz,
telefon, fax, email
FROM t_bestell_arch
WHERE t_bestell_arch.lief_nr = '4020' AND
(abgeholt IS NULL OR abgeholt = 'f')
2003-02-10 12:12:26 [20812] LOG: duration: 0.003892 sec
2003-02-10 12:12:26 [20814] LOG: query: INSERT INTO t_bestell_arch
(transakt_nr, kd_nr_lief,
name1, name2, strasse1,
strasse2, land_iso, plz, telefon,
fax, email)
VALUES ('195', '0', 'Cybertec',
'Geschwinde und Schönig',
'Fünfhausgasse 20/1',
'Fünfhaus', 'AT', '6020', '019136809',
'', 'debug(at)cybertec(dot)at' )
2003-02-10 12:12:26 [20814] LOG: duration: 0.010127 sec
2003-02-10 12:12:26 [20813] LOG: query: SELECT datum_zeit,
transakt_nr, art_nr_lief, prodcode, kurz_text,
lang_text, vp_einh, vp_menge, vp_druck,
bestellmenge, preis, mwst
FROM t_bestell_detail_arch
WHERE t_bestell_detail_arch.lief_nr = '4020'
AND t_bestell_detail_arch.transakt_nr =
'195';
2003-02-10 12:12:26 [20813] LOG: duration: 0.045449 sec
2003-02-10 12:12:26 [20814] LOG: query: INSERT INTO
t_bestell_detail_arch (datum_zeit, transakt_nr,
art_nr_lief, prodcode,
kurz_text, lang_text, vp_einh,
vp_menge, vp_druck,
bestellmenge, preis, mwst)
VALUES ('2003-02-02 14:20:46.97793', '195',
'297140', '4020297140',
'DM 60 V W213 re-297140', 'DM 60
Verschl. W213 re Nr.361163',
'Stk.', '1',
'', '1',
NULL, NULL)
2003-02-10 12:12:26 [20814] LOG: query: SELECT 1 FROM ONLY
"public"."t_bestell_arch" x WHERE "transakt_nr" = $1 FOR UPDATE OF x
2003-02-10 12:12:26 [20814] LOG: duration: 0.012557 sec
2003-02-10 12:12:26 [20814] LOG: query: INSERT INTO
t_bestell_detail_arch (datum_zeit, transakt_nr,
art_nr_lief, prodcode,
kurz_text, lang_text, vp_einh,
vp_menge, vp_druck,
bestellmenge, preis, mwst)
VALUES ('2003-02-02 14:20:46.97793', '195',
'297139', '4020297139',
'DM 60 V W196 2flg. li-297139',
'DM 60 Verschl. W196 2flg. li Nr.322706',
'Stk.', '1',
'', '700',
NULL, NULL)
2003-02-10 12:12:26 [20814] LOG: duration: 0.001308 sec
2003-02-10 12:12:26 [20812] LOG: query: UPDATE t_bestell_arch SET
abgeholt = 't'
WHERE transakt_nr = '195'
2003-02-10 12:12:26 [20812] LOG: duration: 0.005513 sec
2003-02-10 12:12:26 [20814] LOG: query: INSERT INTO t_bestell_arch
(transakt_nr, kd_nr_lief,
name1, name2, strasse1,
strasse2, land_iso, plz, telefon,
fax, email)
VALUES ('196', '0', 'Cybertec',
'Geschwinde und Schönig',
'Fünfhausgasse 20/1',
'Fünfhaus', 'AT', '6020', '019136809',
'', 'debug(at)cybertec(dot)at' )
2003-02-10 12:12:26 [20814] LOG: duration: 0.001105 sec
2003-02-10 12:12:26 [20813] LOG: query: SELECT datum_zeit,
transakt_nr, art_nr_lief, prodcode, kurz_text,
lang_text, vp_einh, vp_menge, vp_druck,
bestellmenge, preis, mwst
FROM t_bestell_detail_arch
WHERE t_bestell_detail_arch.lief_nr = '4020'
AND t_bestell_detail_arch.transakt_nr =
'196';
2003-02-10 12:12:26 [20813] LOG: duration: 0.001403 sec
2003-02-10 12:12:26 [20814] LOG: query: INSERT INTO
t_bestell_detail_arch (datum_zeit, transakt_nr,
art_nr_lief, prodcode,
kurz_text, lang_text, vp_einh,
vp_menge, vp_druck,
bestellmenge, preis, mwst)
VALUES ('2003-02-02 20:36:35.541052', '196',
'297139', '4020297139',
'DM 60 V W196 2flg. li-297139',
'DM 60 Verschl. W196 2flg. li Nr.322706',
'Stk.', '1',
'', '400',
NULL, NULL)
2003-02-10 12:12:26 [20814] LOG: duration: 0.001254 sec
2003-02-10 12:12:26 [20812] LOG: query: UPDATE t_bestell_arch SET
abgeholt = 't'
WHERE transakt_nr = '196'
2003-02-10 12:12:26 [20812] LOG: duration: 0.001365 sec
2003-02-10 12:12:26 [20814] LOG: query: INSERT INTO t_bestell_arch
(transakt_nr, kd_nr_lief,
name1, name2, strasse1,
strasse2, land_iso, plz, telefon,
fax, email)
VALUES ('197', '0', 'Shopping Net ',
'Testkunde',
'An-der-Lan-Str. 18 / 36', '',
'AT', '6020', '0512 260097',
'051226009722',
'office(at)shoppingnet(dot)at' )
2003-02-10 12:12:26 [20814] LOG: duration: 0.001139 sec
2003-02-10 12:12:26 [20813] LOG: query: SELECT datum_zeit,
transakt_nr, art_nr_lief, prodcode, kurz_text,
lang_text, vp_einh, vp_menge, vp_druck,
bestellmenge, preis, mwst
FROM t_bestell_detail_arch
WHERE t_bestell_detail_arch.lief_nr = '4020'
AND t_bestell_detail_arch.transakt_nr =
'197';
2003-02-10 12:12:26 [20813] LOG: duration: 0.001490 sec
2003-02-10 12:12:26 [20814] LOG: query: INSERT INTO
t_bestell_detail_arch (datum_zeit, transakt_nr,
art_nr_lief, prodcode,
kurz_text, lang_text, vp_einh,
vp_menge, vp_druck,
bestellmenge, preis, mwst)
VALUES ('2003-03-02 08:43:57.134697', '197',
'SDH661', '4020SDH661',
'DM 80 TV W196-SDH661', 'DM 80
Türverschluss W196 Nr.375969',
'Stk.', '1',
'', '1',
NULL, NULL)
2003-02-10 12:12:26 [20814] LOG: duration: 0.001284 sec
2003-02-10 12:12:26 [20814] LOG: query: INSERT INTO
t_bestell_detail_arch (datum_zeit, transakt_nr,
art_nr_lief, prodcode,
kurz_text, lang_text, vp_einh,
vp_menge, vp_druck,
bestellmenge, preis, mwst)
VALUES ('2003-03-02 08:43:57.134697', '197',
'SDH663', '4020SDH663',
'DM 80 TV W196TF-SDH663', 'DM 80
Türverschluss W196TF Nr.385957',
'Stk.', '1',
'', '1',
NULL, NULL)
2003-02-10 12:12:26 [20814] LOG: duration: 0.001246 sec
2003-02-10 12:12:26 [20814] LOG: query: INSERT INTO
t_bestell_detail_arch (datum_zeit, transakt_nr,
art_nr_lief, prodcode,
kurz_text, lang_text, vp_einh,
vp_menge, vp_druck,
bestellmenge, preis, mwst)
VALUES ('2003-03-02 08:43:57.134697', '197',
'SDH665', '4020SDH665',
'DM 80 TV W197TF-SDH665', 'DM 80
Türverschluss W197TF Nr.393696',
'Stk.', '1',
'', '1',
NULL, NULL)
2003-02-10 12:12:26 [20814] LOG: duration: 0.001285 sec
2003-02-10 12:12:26 [20812] LOG: query: UPDATE t_bestell_arch SET
abgeholt = 't'
WHERE transakt_nr = '197'
2003-02-10 12:12:26 [20812] LOG: duration: 0.001401 sec
2003-02-10 12:12:26 [20814] LOG: query: commit
2003-02-10 12:12:26 [20814] LOG: duration: 0.004005 sec
2003-02-10 12:12:26 [20814] LOG: query: begin
2003-02-10 12:12:26 [20814] LOG: duration: 0.000166 sec
2003-02-10 12:12:26 [20814] LOG: query: rollback
2003-02-10 12:12:26 [20814] LOG: duration: 0.000387 sec
2003-02-10 12:12:26 [20812] LOG: query: rollback
2003-02-10 12:12:26 [20812] LOG: duration: 0.000442 sec
2003-02-10 12:12:26 [20813] LOG: query: rollback
2003-02-10 12:12:26 [20813] LOG: duration: 0.000399 sec

--
*Cybertec Geschwinde u Schoenig*
Ludo-Hartmannplatz 1/14, A-1160 Vienna, Austria
Tel: +43/1/913 68 09; +43/664/233 90 75
www.postgresql.at <http://www.postgresql.at>, cluster.postgresql.at
<http://cluster.postgresql.at>, www.cybertec.at
<http://www.cybertec.at>, kernel.cybertec.at <http://kernel.cybertec.at>