Mercurial > hg > monetdb-perl

changeset 50:96edc4137944

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
When processing query results, check all lines to see if a line contains an error message (i.e. starts with a '!'). This solves the problem that when an UPDATE is aborted due to transaction conflict, existing code only processes the first line of result, which contains <N> affected rows, but fails to process the second line, which contains the transaction aborted error. Added two conditions to guard against "Use of uninitialized value" errors, one due to index-out-of-band, the other due to already closed connection. Replaces '\t' with '\ \ '
author Ying Zhang <y.zhang@cwi.nl>
date Wed, 14 Jul 2021 22:07:16 +0200 (2021-07-14)
parents 44da5de4a725
children 91ec04bb88c6
files DBD/monetdb.pm MonetDB-CLI-MapiPP/MonetDB/CLI/Mapi.pm MonetDB-CLI-MapiPP/MonetDB/CLI/MapiPP.pm
diffstat 3 files changed, 19 insertions(+), 4 deletions(-) [+]
line wrap: on
line diff
--- a/DBD/monetdb.pm
+++ b/DBD/monetdb.pm
@@ -457,7 +457,7 @@ SQL
     $sql .= " order by uk_table_schem, uk_table_name, fk_table_schem, fk_table_name, ordinal_position\n";
     my $sth = $dbh->prepare($sql) or return;
     $sth->execute(@bv) or return;
-	$dbh->set_err(0,"Catalog parameters c1 and c2 have to be an empty strings, as MonetDB does not support multiple catalogs") if $c1 ne "" || $c2 ne "";
+    $dbh->set_err(0,"Catalog parameters c1 and c2 have to be an empty strings, as MonetDB does not support multiple catalogs") if $c1 ne "" || $c2 ne "";
     return $sth;
 }
 
--- a/MonetDB-CLI-MapiPP/MonetDB/CLI/Mapi.pm
+++ b/MonetDB-CLI-MapiPP/MonetDB/CLI/Mapi.pm
@@ -233,7 +233,7 @@ sub getRow {
   if ($chars[0] eq '!') {
     $self->error($row);
     my $i = 1;
-    while ($self->{lines}[$i] =~ '!') {
+    while (defined $self->{lines}[$i] and $self->{lines}[$i] =~ '!') {
       $self->error($self->{lines}[$i]);
       $i++;
     }
@@ -288,6 +288,19 @@ sub getBlock {
   $self->{hdrs} = [];
 
   if ($chars[0] eq '&') {
+    # check for any line containing an error message in this block
+    my $founderr = 0;
+    foreach (@{$self->{lines}}) {
+      if (substr($_, 0, 1) eq "!"){
+        $self->error($_);
+        $founderr++;
+      }
+    }
+    if ($founderr > 0) {
+      $self->{active} = 0;
+      return -1;
+    }
+
     if ($chars[1] eq '1' || $chars[1] eq 6) {
       if ($chars[1] eq '1') {
         # &1 id result-count nr-cols rows-in-this-block
--- a/MonetDB-CLI-MapiPP/MonetDB/CLI/MapiPP.pm
+++ b/MonetDB-CLI-MapiPP/MonetDB/CLI/MapiPP.pm
@@ -27,7 +27,7 @@ sub connect
   my ($class, $host, $port, $user, $pass, $lang, $db) = @_;
 
   my $h = new MonetDB::CLI::Mapi($host, $port, $user, $pass, $lang, $db, 0)
-  	or die "Making connection failed: $@";
+    or die "Making connection failed: $@";
 
   bless { h => $h },'MonetDB::CLI::MapiPP::Cxn';
 }
@@ -56,7 +56,9 @@ sub DESTROY
 {
   my ($self) = @_;
 
-  $self->{h}->disconnect();
+  if (defined $self->{h}) {
+    $self->{h}->disconnect();
+  }
 
   return;
 }