From cfcaa3f52a9a77057feea3c3258624b1c2f8cca6 Mon Sep 17 00:00:00 2001 From: Jonathan Druart Date: Mon, 5 Jan 2015 17:03:23 +0100 Subject: [PATCH] Bug 13068: Raise an error if a pl script has a sql error Signed-off-by: Marcel de Rooy Tested with some perl and sql dev updates. Checked the list of dev updates for the TRACK mode. Slightly amended the patch for printing the error message. Also the message now may tell you that a dev update failed. Signed-off-by: Jonathan Druart --- installer/data/mysql/updatedatabase.pl | 12 ++++++++---- 1 file changed, 8 insertions(+), 4 deletions(-) diff --git a/installer/data/mysql/updatedatabase.pl b/installer/data/mysql/updatedatabase.pl index 08cb721..e5d10c7 100755 --- a/installer/data/mysql/updatedatabase.pl +++ b/installer/data/mysql/updatedatabase.pl @@ -9732,12 +9732,16 @@ sub ExecDBRev { $rv = 1; } elsif( $file =~ /\.pl$/ ) { #Run perl script + my $dbh = C4::Context->dbh; + $dbh->{RaiseError} = 1; $rv = do $atomicupd->{location}. "/$file"; if( !$rv ) { - print "ERROR: $@\n" if $@; - print "ERROR: $!\n" if $! && !$@; - $rv = 1 if !$! && !$@; #apparently, the file does not end with 1; + my $msg= $@? "ERROR: $@": ($!? "ERROR: $!\n": ''); + chomp $msg; + print "$msg\n" if $msg; + $rv = 1 if !$msg; #apparently, the file does not end with 1; } + $dbh->{RaiseError} = 0; } elsif( $file =~ /\.sql$/ ) { #Run sql file via installer my $installer = C4::Installer->new(); @@ -9749,7 +9753,7 @@ sub ExecDBRev { } if( $devrun ) { - print "Dev upgrade $file done\n"; + print "Dev upgrade $file ".( $rv? 'done': 'failed' )."\n"; _atomic_memory( $atomicupd, $file ) if $rv; } else { _atomic_memory( $atomicupd ); #Official dbrev may clear atomic pref -- 2.1.0