X-Git-Url: http://wagnertech.de/git?a=blobdiff_plain;f=SL%2FDBUpgrade2.pm;h=bd65a1ac74eefe77451451837f12503aa275efb8;hb=387386532c892b89f5c765a65ac2fe1482028d44;hp=4fb1ba9e20b3aa2733f05ceeeb59fa8f8882b7c8;hpb=1804652ed41bd1252959dccfe00175c625134d56;p=kivitendo-erp.git diff --git a/SL/DBUpgrade2.pm b/SL/DBUpgrade2.pm index 4fb1ba9e2..bd65a1ac7 100644 --- a/SL/DBUpgrade2.pm +++ b/SL/DBUpgrade2.pm @@ -7,6 +7,7 @@ use List::MoreUtils qw(any); use SL::Common; use SL::DBUpgrade2::Base; use SL::DBUtils; +use SL::System::Process; use strict; @@ -26,7 +27,7 @@ sub init { $params{path_suffix} ||= ''; $params{schema} ||= ''; - $params{path} ||= "sql/Pg-upgrade2" . $params{path_suffix}; + $params{path} ||= SL::System::Process->exe_dir . "/sql/Pg-upgrade2" . $params{path_suffix}; map { $self->{$_} = $params{$_} } keys %params; @@ -147,9 +148,6 @@ sub process_query { # Remove DOS and Unix style line endings. chomp; - # remove comments - s/--.*$//; - for (my $i = 0; $i < length($_); $i++) { my $char = substr($_, $i, 1); @@ -176,6 +174,11 @@ sub process_query { && $tag =~ /^ (?= [A-Za-z_] [A-Za-z0-9_]* | ) $/x) { # tag is identifier push @quote_chars, $char = '$' . $tag . '$'; $i = $tag_end; + } elsif ($char eq "-") { + if ( substr($_, $i+1, 1) eq "-") { + # found a comment outside quote + last; + } } elsif ($char eq ";") { # Query is complete. Send it. @@ -186,11 +189,13 @@ sub process_query { return $errstr // '' if $self->{return_on_error}; $sth->finish(); $dbh->rollback(); - $form->dberror("The database update/creation did not succeed. " . - "The file ${filename} containing the following " . - "query failed:
${query}
" . - "The error message was: ${errstr}
" . - "All changes in that file have been reverted."); + if (!ref $version_or_control || ref $version_or_control ne 'HASH' || !$version_or_control->{may_fail}) { + $form->dberror("The database update/creation did not succeed. " . + "The file ${filename} containing the following " . + "query failed:
${query}
" . + "The error message was: ${errstr}
" . + "All changes in that file have been reverted.") + } } $sth->finish(); @@ -234,12 +239,11 @@ sub process_perl_script { my ($self, $dbh, $filename, $version_or_control) = @_; - my %form_values = map { $_ => $::form->{$_} } qw(dbconnect dbdefault dbhost dbname dboptions dbpasswd dbport dbupdate dbuser login template_object version); + my %form_values = %$::form; $dbh->begin_work; # setup dbup_ export vars & run script - my $old_dbh = $::form->set_standard_dbh($dbh); my %dbup_myconfig = map { ($_ => $::form->{$_}) } qw(dbname dbuser dbpasswd dbhost dbport dbconnect); my $result = eval { SL::DBUpgrade2::Base::execute_script( @@ -252,18 +256,16 @@ sub process_perl_script { my $error = $EVAL_ERROR; - $::form->set_standard_dbh($old_dbh); - $dbh->rollback if 1 != ($result // -1); return $error if $self->{return_on_error} && (1 != ($result // -1)); if (!defined($result)) { print $::form->parse_html_template("dbupgrade/error", { file => $filename, error => $error }); - ::end_of_request(); + $::dispatcher->end_request; } elsif (1 != $result) { SL::System::InstallationLock->unlock if 2 == $result; - ::end_of_request(); + $::dispatcher->end_request; } if (ref($version_or_control) eq "HASH") { @@ -608,7 +610,7 @@ The global C object. =back A Perl script can actually implement queries that fail while -continueing the process by handling the transaction itself, e.g. with +continuing the process by handling the transaction itself, e.g. with the following function: sub do_query {