X-Git-Url: http://wagnertech.de/git?a=blobdiff_plain;f=SL%2FDBUpgrade2.pm;h=650258378af4a44875d578568116bfaaddc0e147;hb=b8ee6b6ed46e55095b955ee1800b8a4b8d8ccc3f;hp=cdfca9b740480d6434cbe5971f1f7daf730ca57d;hpb=841d44c00aae1166a0721e40dc2f9ffb7b9ac5b5;p=kivitendo-erp.git diff --git a/SL/DBUpgrade2.pm b/SL/DBUpgrade2.pm index cdfca9b74..650258378 100644 --- a/SL/DBUpgrade2.pm +++ b/SL/DBUpgrade2.pm @@ -81,9 +81,6 @@ sub parse_dbupdate_controls { next if ($control->{ignore}); - $control->{charset} = 'UTF-8' if $file =~ m/\.pl$/; - $control->{charset} = $control->{charset} || $control->{encoding} || Common::DEFAULT_CHARSET; - if (!$control->{"tag"}) { _control_error($form, $file_name, $locale->text("Missing 'tag' field.")) ; } @@ -133,29 +130,23 @@ sub parse_dbupdate_controls { sub process_query { $::lxdebug->enter_sub(); - my ($self, $dbh, $filename, $version_or_control, $db_charset) = @_; + my ($self, $dbh, $filename, $version_or_control) = @_; my $form = $self->{form}; - my $fh = IO::File->new($filename, "r") or $form->error("$filename : $!\n"); + my $fh = IO::File->new($filename, "r"); my $query = ""; my $sth; my @quote_chars; - my $file_charset = Common::DEFAULT_CHARSET; - while (<$fh>) { - last if !/^--/; - next if !/^--\s*\@(?:charset|encoding):\s*(.+)/; - $file_charset = $1; - last; + if (!$fh) { + return "No such file: $filename" if $self->{return_on_error}; + $form->error("$filename : $!\n"); } - $fh->seek(0, SEEK_SET); - - $db_charset ||= Common::DEFAULT_CHARSET; $dbh->begin_work(); while (<$fh>) { - $_ = SL::Iconv::convert($file_charset, $db_charset, $_); + $_ = SL::Iconv::convert('UTF-8', 'UTF-8', $_); # Remove DOS and Unix style line endings. chomp; @@ -196,6 +187,7 @@ sub process_query { $sth = $dbh->prepare($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. " . @@ -231,6 +223,9 @@ sub process_query { $fh->close(); $::lxdebug->leave_sub(); + + # Signal "no error" + return undef; } # Process a Perl script which updates the database. @@ -241,13 +236,14 @@ sub process_query { sub process_perl_script { $::lxdebug->enter_sub(); - my ($self, $dbh, $filename, $version_or_control, $db_charset) = @_; + my ($self, $dbh, $filename, $version_or_control) = @_; - my %form_values = map { $_ => $::form->{$_} } qw(dbconnect dbdefault dbhost dbmbkiviunstable dbname dboptions dbpasswd dbport dbupdate dbuser login template_object version); + my %form_values = map { $_ => $::form->{$_} } qw(dbconnect dbdefault dbhost dbname dboptions dbpasswd dbport dbupdate dbuser login template_object version); $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( @@ -260,8 +256,12 @@ 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(); @@ -275,7 +275,8 @@ sub process_perl_script { } elsif ($version_or_control) { $dbh->do("UPDATE defaults SET version = " . $dbh->quote($version_or_control)); } - $dbh->commit(); + + $dbh->commit if !$dbh->{AutoCommit} || $dbh->{BegunWork}; # Clear $::form of values that may have been set so that following # Perl upgrade scripts won't have to work with old data (think of @@ -285,28 +286,15 @@ sub process_perl_script { $::form->{$_} = $form_values{$_} for keys %form_values; $::lxdebug->leave_sub(); -} - -sub process_file { - my ($self, $dbh, $filename, $version_or_control, $db_charset) = @_; - if ($filename =~ m/sql$/) { - $self->process_query($dbh, $filename, $version_or_control, $db_charset); - } else { - $self->process_perl_script($dbh, $filename, $version_or_control, $db_charset); - } + return undef; } -sub update_available { - my ($self, $cur_version) = @_; - - local *SQLDIR; - - opendir SQLDIR, "sql/Pg-upgrade" || error("", "sql/Pg-upgrade: $!"); - my @upgradescripts = grep /Pg-upgrade-\Q$cur_version\E.*\.(sql|pl)$/, readdir SQLDIR; - closedir SQLDIR; +sub process_file { + my ($self, $dbh, $filename, $version_or_control) = @_; - return ($#upgradescripts > -1); + return $filename =~ m/sql$/ ? $self->process_query( $dbh, $filename, $version_or_control) + : $self->process_perl_script($dbh, $filename, $version_or_control); } sub update2_available { @@ -357,10 +345,9 @@ sub apply_admin_dbupgrade_scripts { return 0 if !@unapplied_scripts; - my $db_charset = $::lx_office_conf{system}->{dbcharset} || Common::DEFAULT_CHARSET; $self->{form}->{login} ||= 'admin'; - map { $_->{description} = SL::Iconv::convert($_->{charset}, $db_charset, $_->{description}) } values %{ $self->{all_controls} }; + 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'); @@ -373,7 +360,7 @@ sub apply_admin_dbupgrade_scripts { $::lxdebug->message(LXDebug->DEBUG2(), "Applying Update $control->{file}"); print $self->{form}->parse_html_template("dbupgrade/upgrade_message2", $control); - $self->process_file($dbh, "sql/Pg-upgrade2-auth/$control->{file}", $control, $db_charset); + $self->process_file($dbh, "sql/Pg-upgrade2-auth/$control->{file}", $control); } print $self->{form}->parse_html_template("dbupgrade/footer", { is_admin => 1 }) if $called_from_admin; @@ -449,8 +436,7 @@ __END__ =head1 NAME SL::DBUpgrade2 - Parse database upgrade files stored in -C and C (and also in -C) +C and C =head1 SYNOPSIS @@ -498,14 +484,8 @@ applied. Database upgrade files come in two flavours: SQL files and Perl files. For both there are control fields that determine the order in -which they're executed, what charset the scripts are written in -etc. The control fields are tag/value pairs contained in comments. - -=head1 OLD UPGRADE FILES - -The files in C are so old that I don't bother -documenting them. They're handled by this class, too, but new files -are only created as C files. +which they're executed etc. The control fields are tag/value pairs +contained in comments. =head1 CONTROL FIELDS @@ -550,13 +530,6 @@ A space-separated list of tags of scripts this particular script depends on. All other upgrades listed in C will be applied before the current one is applied. -=item charset - -=item encoding - -The charset this file uses. Defaults to C if -missing. Both terms are recognized. - =item priority Ordering the scripts by their dependencies alone produces a lot of @@ -617,25 +590,22 @@ are missing/wrong (e.g. a tag name listed in C is not found). Sets C<$Self->{all_controls}> to the list of database scripts. -=item C +=item C Applies a single database upgrade file. Calls L for Perl update files and C for SQL update files. Requires an open database handle(C<$dbh>), the file name -(C<$filename>), a hash structure of the file's control fields as -produced by L (C<$version_or_control>) and -the database charset (for on-the-fly charset recoding of the script if -required, C<$db_charset>). +(C<$filename>) and a hash structure of the file's control fields as +produced by L (C<$version_or_control>). Returns the result of the actual function called. -=item C +=item C Applies a single Perl database upgrade file. Requires an open database -handle(C<$dbh>), the file name (C<$filename>), a hash structure of the -file's control fields as produced by L -(C<$version_or_control>) and the database charset (for on-the-fly -charset recoding of the script if required, C<$db_charset>). +handle(C<$dbh>), the file name (C<$filename>) and a hash structure of +the file's control fields as produced by L +(C<$version_or_control>). Perl scripts are executed via L. If L returns falsish then an error is expected. There are two special return values: If the @@ -675,13 +645,12 @@ the following function: } } -=item C +=item C Applies a single SQL database upgrade file. Requires an open database -handle(C<$dbh>), the file name (C<$filename>), a hash structure of the -ofile's control fields as produced by L -(C<$version_or_control>) and the database charset (for on-the-fly -charset recoding of the script if required, C<$db_charset>). +handle(C<$dbh>), the file name (C<$filename>), and a hash structure of +the file's control fields as produced by L +(C<$version_or_control>). =item C