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.")) ;
}
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;
$sth = $dbh->prepare($query);
if (!$sth->execute()) {
my $errstr = $dbh->errstr;
+ return $errstr // '<unknown database error>' if $self->{return_on_error};
$sth->finish();
$dbh->rollback();
$form->dberror("The database update/creation did not succeed. " .
$fh->close();
$::lxdebug->leave_sub();
+
+ # Signal "no error"
+ return undef;
}
# Process a Perl script which updates the database.
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(
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();
} 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
$::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 {
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');
$::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;
=head1 NAME
SL::DBUpgrade2 - Parse database upgrade files stored in
-C<sql/Pg-upgrade2> and C<sql/Pg-upgrade2-auth> (and also in
-C<SQL/Pg-upgrade>)
+C<sql/Pg-upgrade2> and C<sql/Pg-upgrade2-auth>
=head1 SYNOPSIS
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<sql/Pg-upgrade> 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<Pg-upgrade2> files.
+which they're executed etc. The control fields are tag/value pairs
+contained in comments.
=head1 CONTROL FIELDS
depends on. All other upgrades listed in C<depends> will be applied
before the current one is applied.
-=item charset
-
-=item encoding
-
-The charset this file uses. Defaults to C<ISO-8859-15> if
-missing. Both terms are recognized.
-
=item priority
Ordering the scripts by their dependencies alone produces a lot of
found). Sets C<$Self->{all_controls}> to the list of database
scripts.
-=item C<process_file $dbh, $filename, $version_or_control, $db_charset>
+=item C<process_file $dbh, $filename, $version_or_control>
Applies a single database upgrade file. Calls L<process_perl_script>
for Perl update files and C<process_query> 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<parse_dbupdate_controls> (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<parse_dbupdate_controls> (C<$version_or_control>).
Returns the result of the actual function called.
-=item C<process_perl_script $dbh, $filename, $version_or_control, $db_charset>
+=item C<process_perl_script $dbh, $filename, $version_or_control>
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<parse_dbupdate_controls>
-(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<parse_dbupdate_controls>
+(C<$version_or_control>).
Perl scripts are executed via L<eval>. If L<eval> returns falsish then
an error is expected. There are two special return values: If the
}
}
-=item C<process_query $dbh, $filename, $version_or_control, $db_charset>
+=item C<process_query $dbh, $filename, $version_or_control>
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<parse_dbupdate_controls>
-(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<parse_dbupdate_controls>
+(C<$version_or_control>).
=item C<sort_dbupdate_controls>
projects / kivitendo-erp.git / blobdiff