X-Git-Url: http://wagnertech.de/git?a=blobdiff_plain;ds=sidebyside;f=SL%2FDBUpgrade2.pm;h=82bd27f259ad644d7880af4ae26a55a04f6e661e;hb=e18af94c0dc72def3629a352dbf048baa0dfd72d;hp=753783c99c6a35957a32b603ac5c87bfffb694a4;hpb=53cbf0de16033a5d035feb9dc678e3cecb4d39b9;p=kivitendo-erp.git diff --git a/SL/DBUpgrade2.pm b/SL/DBUpgrade2.pm index 753783c99..82bd27f25 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; @@ -243,7 +244,6 @@ sub process_perl_script { $dbh->begin_work; # setup dbup_ export vars & run script - my $old_dbh = SL::DB->client->dbh($dbh); my %dbup_myconfig = map { ($_ => $::form->{$_}) } qw(dbname dbuser dbpasswd dbhost dbport dbconnect); my $result = eval { SL::DBUpgrade2::Base::execute_script( @@ -256,8 +256,6 @@ 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)); @@ -293,8 +291,12 @@ sub process_perl_script { sub process_file { my ($self, $dbh, $filename, $version_or_control) = @_; - return $filename =~ m/sql$/ ? $self->process_query( $dbh, $filename, $version_or_control) - : $self->process_perl_script($dbh, $filename, $version_or_control); + my $result = $filename =~ m/sql$/ ? $self->process_query( $dbh, $filename, $version_or_control) + : $self->process_perl_script($dbh, $filename, $version_or_control); + + $::lxdebug->log_time("DB upgrade script '${filename}' finished"); + + return $result; } sub unapplied_upgrade_scripts { @@ -340,6 +342,8 @@ sub apply_admin_dbupgrade_scripts { print $self->{form}->parse_html_template("dbupgrade/header", { dbname => $::auth->{DB_config}->{db} }); + $::lxdebug->log_time("DB upgrades commencing"); + foreach my $control (@unapplied_scripts) { $::lxdebug->message(LXDebug->DEBUG2(), "Applying Update $control->{file}"); print $self->{form}->parse_html_template("dbupgrade/upgrade_message2", $control); @@ -347,6 +351,8 @@ sub apply_admin_dbupgrade_scripts { $self->process_file($dbh, "sql/Pg-upgrade2-auth/$control->{file}", $control); } + $::lxdebug->log_time("DB upgrades finished"); + print $self->{form}->parse_html_template("dbupgrade/footer", { is_admin => 1 }) if $called_from_admin; return 1; @@ -612,7 +618,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 {