X-Git-Url: http://wagnertech.de/git?a=blobdiff_plain;f=SL%2FDBUpgrade2.pm;h=82bd27f259ad644d7880af4ae26a55a04f6e661e;hb=cc978962a88cd9f1cf15ac9d4a28db76432f8542;hp=0fd18b59c082c3621886a0936b3ef1345a501e31;hpb=132592c6ef62c4c15072b1188b0d5415a3d10510;p=kivitendo-erp.git diff --git a/SL/DBUpgrade2.pm b/SL/DBUpgrade2.pm index 0fd18b59c..82bd27f25 100644 --- a/SL/DBUpgrade2.pm +++ b/SL/DBUpgrade2.pm @@ -7,7 +7,7 @@ use List::MoreUtils qw(any); use SL::Common; use SL::DBUpgrade2::Base; use SL::DBUtils; -use SL::Iconv; +use SL::System::Process; use strict; @@ -27,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; @@ -39,8 +39,6 @@ sub path { } sub parse_dbupdate_controls { - $::lxdebug->enter_sub(); - my ($self) = @_; my $form = $self->{form}; @@ -52,7 +50,7 @@ sub parse_dbupdate_controls { my $path = $self->path; foreach my $file_name (<$path/*.sql>, <$path/*.pl>) { - next unless (open(IN, $file_name)); + next unless (open(IN, "<:encoding(UTF-8)", $file_name)); my $file = $file_name; $file =~ s|.*/||; @@ -60,6 +58,7 @@ sub parse_dbupdate_controls { my $control = { "priority" => 1000, "depends" => [], + "locales" => [], }; while () { @@ -74,6 +73,8 @@ sub parse_dbupdate_controls { if ($fields[0] eq "depends") { push(@{$control->{"depends"}}, split(/\s+/, $fields[1])); + } elsif ($fields[0] eq "locales") { + push @{$control->{locales}}, $fields[1]; } else { $control->{$fields[0]} = $fields[1]; } @@ -122,8 +123,6 @@ sub parse_dbupdate_controls { $self->{all_controls} = \%all_controls; - $::lxdebug->leave_sub(); - return $self; } @@ -133,7 +132,7 @@ sub process_query { my ($self, $dbh, $filename, $version_or_control) = @_; my $form = $self->{form}; - my $fh = IO::File->new($filename, "r"); + my $fh = IO::File->new($filename, "<:encoding(UTF-8)"); my $query = ""; my $sth; my @quote_chars; @@ -146,14 +145,9 @@ sub process_query { $dbh->begin_work(); while (<$fh>) { - $_ = SL::Iconv::convert('UTF-8', 'UTF-8', $_); - # Remove DOS and Unix style line endings. chomp; - # remove comments - s/--.*$//; - for (my $i = 0; $i < length($_); $i++) { my $char = substr($_, $i, 1); @@ -180,22 +174,28 @@ 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. $sth = $dbh->prepare($query); - $::lxdebug->dump(0, "bb: query: ", $query); if (!$sth->execute()) { my $errstr = $dbh->errstr; 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(); @@ -239,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( @@ -257,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") { @@ -294,30 +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); -} - -sub update2_available { - $::lxdebug->enter_sub(); - - my ($self, $dbh) = @_; - - map { $_->{applied} = 0; } values %{ $self->{all_controls} }; - - my $sth = $dbh->prepare(qq|SELECT tag FROM | . $self->{schema} . qq|schema_info|); - if ($sth->execute) { - while (my ($tag) = $sth->fetchrow_array) { - $self->{all_controls}->{$tag}->{applied} = 1 if defined $self->{all_controls}->{$tag}; - } - } - $sth->finish(); + my $result = $filename =~ m/sql$/ ? $self->process_query( $dbh, $filename, $version_or_control) + : $self->process_perl_script($dbh, $filename, $version_or_control); - my $needs_update = any { !$_->{applied} } values %{ $self->{all_controls} }; - - $::lxdebug->leave_sub(); + $::lxdebug->log_time("DB upgrade script '${filename}' finished"); - return $needs_update; + return $result; } sub unapplied_upgrade_scripts { @@ -336,6 +315,14 @@ sub unapplied_upgrade_scripts { return grep { !$_->{applied} } @all_scripts; } +sub update2_available { + my ($self, $dbh) = @_; + + my @unapplied_scripts = $self->unapplied_upgrade_scripts($dbh); + + return !!@unapplied_scripts; +} + sub apply_admin_dbupgrade_scripts { my ($self, $called_from_admin) = @_; @@ -348,8 +335,6 @@ sub apply_admin_dbupgrade_scripts { $self->{form}->{login} ||= 'admin'; - map { $_->{description} = SL::Iconv::convert('UTF-8', 'UTF-8', $_->{description}) } values %{ $self->{all_controls} }; - if ($called_from_admin) { $self->{form}->{title} = $::locale->text('Dataset upgrade'); $self->{form}->header; @@ -357,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); @@ -364,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; @@ -398,13 +387,11 @@ sub _control_error { } sub _dbupdate2_calculate_depth { - $::lxdebug->enter_sub(2); - my ($tree, $tag) = @_; my $node = $tree->{$tag}; - return $::lxdebug->leave_sub(2) if (defined($node->{"depth"})); + return if (defined($node->{"depth"})); my $max_depth = 0; @@ -415,8 +402,6 @@ sub _dbupdate2_calculate_depth { } $node->{"depth"} = $max_depth + 1; - - $::lxdebug->leave_sub(2); } sub sort_dbupdate_controls { @@ -633,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 {