Projekt

Allgemein

Profil

Herunterladen (20 KB) Statistiken
| Zweig: | Markierung: | Revision:

kivitendo/SL/DBUpgrade2.pm @ aa1a40e9

4fd8bdbf Moritz Bunkus
package SL::DBUpgrade2;

a1d1605e Moritz Bunkus
use IO::File;
38a2e789 Moritz Bunkus
use List::MoreUtils qw(any);
a1d1605e Moritz Bunkus
faef45c2 Moritz Bunkus
use SL::Common;
347f2cff Moritz Bunkus
use SL::DBUpgrade2::Base;
bdc79264 Moritz Bunkus
use SL::DBUtils;
a1d1605e Moritz Bunkus
use SL::Iconv;
faef45c2 Moritz Bunkus
76c486e3 Sven Schöling
use strict;
4fd8bdbf Moritz Bunkus
7e0ad798 Moritz Bunkus
sub new {
0b6cb3b8 Moritz Bunkus
my $package = shift;

return bless({}, $package)->init(@_);
7e0ad798 Moritz Bunkus
}

0b6cb3b8 Moritz Bunkus
sub init {
my ($self, %params) = @_;

d0fb3d4d Moritz Bunkus
if ($params{auth}) {
$params{path_suffix} = "-auth";
$params{schema} = "auth.";
}

$params{path_suffix} ||= '';
5c41c19b Moritz Bunkus
$params{schema} ||= '';
00cfe3f2 Sven Schöling
$params{path} = "sql/" . $params{dbdriver} . "-upgrade2" . $params{path_suffix};
d0fb3d4d Moritz Bunkus
0b6cb3b8 Moritz Bunkus
map { $self->{$_} = $params{$_} } keys %params;

a1d1605e Moritz Bunkus
return $self;
}

00cfe3f2 Sven Schöling
sub path {
$_[0]{path};
}

4fd8bdbf Moritz Bunkus
sub parse_dbupdate_controls {
dbcd72ed Moritz Bunkus
$::lxdebug->enter_sub();
4fd8bdbf Moritz Bunkus
7e0ad798 Moritz Bunkus
my ($self) = @_;
4fd8bdbf Moritz Bunkus
7e0ad798 Moritz Bunkus
my $form = $self->{form};
dbcd72ed Moritz Bunkus
my $locale = $::locale;
4fd8bdbf Moritz Bunkus
local *IN;
my %all_controls;

00cfe3f2 Sven Schöling
my $path = $self->path;
4fd8bdbf Moritz Bunkus
foreach my $file_name (<$path/*.sql>, <$path/*.pl>) {
next unless (open(IN, $file_name));

my $file = $file_name;
$file =~ s|.*/||;

my $control = {
"priority" => 1000,
53c7990b Moritz Bunkus
"depends" => [],
4fd8bdbf Moritz Bunkus
};

while (<IN>) {
chomp();
next unless (/^(--|\#)\s*\@/);
s/^(--|\#)\s*\@//;
s/\s*$//;
next if ($_ eq "");

my @fields = split(/\s*:\s*/, $_, 2);
next unless (scalar(@fields) == 2);

if ($fields[0] eq "depends") {
push(@{$control->{"depends"}}, split(/\s+/, $fields[1]));
} else {
$control->{$fields[0]} = $fields[1];
}
}

91836534 Moritz Bunkus
next if ($control->{ignore});

347f2cff Moritz Bunkus
$control->{charset} = 'UTF-8' if $file =~ m/\.pl$/;
dcaf9754 Moritz Bunkus
$control->{charset} = $control->{charset} || $control->{encoding} || Common::DEFAULT_CHARSET;
faef45c2 Moritz Bunkus
53c7990b Moritz Bunkus
if (!$control->{"tag"}) {
_control_error($form, $file_name, $locale->text("Missing 'tag' field.")) ;
}
4fd8bdbf Moritz Bunkus
53c7990b Moritz Bunkus
if ($control->{"tag"} =~ /[^a-zA-Z0-9_\(\)\-]/) {
_control_error($form, $file_name, $locale->text("The 'tag' field must only consist of alphanumeric characters or the carachters - _ ( )"))
}
4fd8bdbf Moritz Bunkus
53c7990b Moritz Bunkus
if (defined($all_controls{$control->{"tag"}})) {
_control_error($form, $file_name, sprintf($locale->text("More than one control file with the tag '%s' exist."), $control->{"tag"}))
}
4fd8bdbf Moritz Bunkus
53c7990b Moritz Bunkus
if (!$control->{"description"}) {
_control_error($form, $file_name, sprintf($locale->text("Missing 'description' field."))) ;
}
4fd8bdbf Moritz Bunkus
53c7990b Moritz Bunkus
$control->{"priority"} *= 1;
$control->{"priority"} ||= 1000;
$control->{"file"} = $file;
4fd8bdbf Moritz Bunkus
53c7990b Moritz Bunkus
delete @{$control}{qw(depth applied)};
4fd8bdbf Moritz Bunkus
$all_controls{$control->{"tag"}} = $control;

close(IN);
}

foreach my $control (values(%all_controls)) {
foreach my $dependency (@{$control->{"depends"}}) {
53c7990b Moritz Bunkus
_control_error($form, $control->{"file"}, sprintf($locale->text("Unknown dependency '%s'."), $dependency)) if (!defined($all_controls{$dependency}));
4fd8bdbf Moritz Bunkus
}

map({ $_->{"loop"} = 0; } values(%all_controls));
53c7990b Moritz Bunkus
_check_for_loops($form, $control->{"file"}, \%all_controls, $control->{"tag"});
4fd8bdbf Moritz Bunkus
}

map({ _dbupdate2_calculate_depth(\%all_controls, $_->{"tag"}) }
values(%all_controls));

7e0ad798 Moritz Bunkus
$self->{all_controls} = \%all_controls;

dbcd72ed Moritz Bunkus
$::lxdebug->leave_sub();
4fd8bdbf Moritz Bunkus
38a2e789 Moritz Bunkus
return $self;
4fd8bdbf Moritz Bunkus
}

a1d1605e Moritz Bunkus
sub process_query {
dbcd72ed Moritz Bunkus
$::lxdebug->enter_sub();
a1d1605e Moritz Bunkus
my ($self, $dbh, $filename, $version_or_control, $db_charset) = @_;

my $form = $self->{form};
my $fh = IO::File->new($filename, "r") or $form->error("$filename : $!\n");
my $query = "";
my $sth;
my @quote_chars;

my $file_charset = Common::DEFAULT_CHARSET;
while (<$fh>) {
last if !/^--/;
dcaf9754 Moritz Bunkus
next if !/^--\s*\@(?:charset|encoding):\s*(.+)/;
a1d1605e Moritz Bunkus
$file_charset = $1;
last;
}
$fh->seek(0, SEEK_SET);

$db_charset ||= Common::DEFAULT_CHARSET;

$dbh->begin_work();

while (<$fh>) {
$_ = SL::Iconv::convert($file_charset, $db_charset, $_);

# Remove DOS and Unix style line endings.
chomp;

# remove comments
s/--.*$//;

for (my $i = 0; $i < length($_); $i++) {
my $char = substr($_, $i, 1);

# Are we inside a string?
if (@quote_chars) {
if ($char eq $quote_chars[-1]) {
pop(@quote_chars);
b2448c14 Sven Schöling
} elsif (length $quote_chars[-1] > 1
&& substr($_, $i, length $quote_chars[-1]) eq $quote_chars[-1]) {
c4ee17ee Moritz Bunkus
$i += length($quote_chars[-1]) - 1;
b2448c14 Sven Schöling
$char = $quote_chars[-1];
pop(@quote_chars);
a1d1605e Moritz Bunkus
}
$query .= $char;

} else {
b2448c14 Sven Schöling
my ($tag, $tag_end);
a1d1605e Moritz Bunkus
if (($char eq "'") || ($char eq "\"")) {
push(@quote_chars, $char);

592052f4 Sven Schöling
} elsif ($char eq '$' # start of dollar quoting
&& ($tag_end = index($_, '$', $i + 1)) > -1 # ends on same line
&& (do { $tag = substr($_, $i + 1, $tag_end - $i - 1); 1 }) # extract tag
&& $tag =~ /^ (?= [A-Za-z_] [A-Za-z0-9_]* | ) $/x) { # tag is identifier
b2448c14 Sven Schöling
push @quote_chars, $char = '$' . $tag . '$';
$i = $tag_end;
a1d1605e Moritz Bunkus
} elsif ($char eq ";") {

# Query is complete. Send it.

$sth = $dbh->prepare($query);
if (!$sth->execute()) {
my $errstr = $dbh->errstr;
$sth->finish();
$dbh->rollback();
$form->dberror("The database update/creation did not succeed. " .
"The file ${filename} containing the following " .
"query failed:<br>${query}<br>" .
"The error message was: ${errstr}<br>" .
"All changes in that file have been reverted.");
}
$sth->finish();

$char = "";
$query = "";
}

$query .= $char;
}
}

# Insert a space at the end of each line so that queries split
# over multiple lines work properly.
if ($query ne '') {
$query .= @quote_chars ? "\n" : ' ';
}
}

if (ref($version_or_control) eq "HASH") {
d0fb3d4d Moritz Bunkus
$dbh->do("INSERT INTO " . $self->{schema} . "schema_info (tag, login) VALUES (" . $dbh->quote($version_or_control->{"tag"}) . ", " . $dbh->quote($form->{"login"}) . ")");
a1d1605e Moritz Bunkus
} elsif ($version_or_control) {
d0fb3d4d Moritz Bunkus
$dbh->do("UPDATE defaults SET version = " . $dbh->quote($version_or_control));
a1d1605e Moritz Bunkus
}
$dbh->commit();

$fh->close();

dbcd72ed Moritz Bunkus
$::lxdebug->leave_sub();
a1d1605e Moritz Bunkus
}

8b39e389 Moritz Bunkus
# Process a Perl script which updates the database.
# If the script returns 1 then the update was successful.
# Return code "2" means "needs more interaction; remove
# users/nologin and end current request".
# All other return codes are fatal errors.
sub process_perl_script {
dbcd72ed Moritz Bunkus
$::lxdebug->enter_sub();
8b39e389 Moritz Bunkus
my ($self, $dbh, $filename, $version_or_control, $db_charset) = @_;

8f7283f5 Moritz Bunkus
my %form_values = map { $_ => $::form->{$_} } qw(dbconnect dbdefault dbdriver dbhost dbmbkiviunstable dbname dboptions dbpasswd dbport dbupdate dbuser login template_object version);

347f2cff Moritz Bunkus
$dbh->begin_work;
8b39e389 Moritz Bunkus
347f2cff Moritz Bunkus
# setup dbup_ export vars & run script
my %dbup_myconfig = map { ($_ => $::form->{$_}) } qw(dbname dbuser dbpasswd dbhost dbport dbconnect);
my $result = SL::DBUpgrade2::Base::execute_script(
file_name => $filename,
tag => $version_or_control->{tag},
dbh => $dbh,
myconfig => \%dbup_myconfig,
);
8b39e389 Moritz Bunkus
7d607d91 Moritz Bunkus
if (1 != ($result // 1)) {
8b39e389 Moritz Bunkus
$dbh->rollback();
}

if (!defined($result)) {
347f2cff Moritz Bunkus
print $::form->parse_html_template("dbupgrade/error", { file => $filename, error => $@ });
8b39e389 Moritz Bunkus
::end_of_request();
} elsif (1 != $result) {
unlink("users/nologin") if (2 == $result);
::end_of_request();
}

if (ref($version_or_control) eq "HASH") {
347f2cff Moritz Bunkus
$dbh->do("INSERT INTO " . $self->{schema} . "schema_info (tag, login) VALUES (" . $dbh->quote($version_or_control->{tag}) . ", " . $dbh->quote($::form->{login}) . ")");
8b39e389 Moritz Bunkus
} elsif ($version_or_control) {
d0fb3d4d Moritz Bunkus
$dbh->do("UPDATE defaults SET version = " . $dbh->quote($version_or_control));
8b39e389 Moritz Bunkus
}
$dbh->commit();

8f7283f5 Moritz Bunkus
# 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
# the usual 'continued' mechanism that's used for determining
# whether or not the upgrade form must be displayed).
delete @{ $::form }{ keys %{ $::form } };
$::form->{$_} = $form_values{$_} for keys %form_values;

dbcd72ed Moritz Bunkus
$::lxdebug->leave_sub();
8b39e389 Moritz Bunkus
}

35636cc2 Moritz Bunkus
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);
}
}

38a2e789 Moritz Bunkus
sub update_available {
my ($self, $cur_version) = @_;

local *SQLDIR;

my $dbdriver = $self->{dbdriver};
opendir SQLDIR, "sql/${dbdriver}-upgrade" || error("", "sql/${dbdriver}-upgrade: $!");
my @upgradescripts = grep /${dbdriver}-upgrade-\Q$cur_version\E.*\.(sql|pl)$/, readdir SQLDIR;
closedir SQLDIR;

return ($#upgradescripts > -1);
}

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 $needs_update = any { !$_->{applied} } values %{ $self->{all_controls} };

$::lxdebug->leave_sub();

return $needs_update;
}

9b0c7269 Moritz Bunkus
sub unapplied_upgrade_scripts {
my ($self, $dbh) = @_;

my @all_scripts = map { $_->{applied} = 0; $_ } $self->sort_dbupdate_controls;

626ec4b4 Moritz Bunkus
my $query = qq|SELECT tag FROM | . $self->{schema} . qq|schema_info|;
9b0c7269 Moritz Bunkus
my $sth = $dbh->prepare($query);
$sth->execute || $self->{form}->dberror($query);
while (my ($tag) = $sth->fetchrow_array()) {
$self->{all_controls}->{$tag}->{applied} = 1 if defined $self->{all_controls}->{$tag};
}
$sth->finish;

return grep { !$_->{applied} } @all_scripts;
}

486fe464 Moritz Bunkus
sub apply_admin_dbupgrade_scripts {
my ($self, $called_from_admin) = @_;

2da6fbfb Moritz Bunkus
return 0 if !$self->{auth};
486fe464 Moritz Bunkus
my $dbh = $::auth->dbconnect;
my @unapplied_scripts = $self->unapplied_upgrade_scripts($dbh);

2da6fbfb Moritz Bunkus
return 0 if !@unapplied_scripts;
486fe464 Moritz Bunkus
be6f6cfd Moritz Bunkus
my $db_charset = $::lx_office_conf{system}->{dbcharset} || Common::DEFAULT_CHARSET;
486fe464 Moritz Bunkus
$self->{form}->{login} ||= 'admin';

map { $_->{description} = SL::Iconv::convert($_->{charset}, $db_charset, $_->{description}) } values %{ $self->{all_controls} };

2da6fbfb Moritz Bunkus
if ($called_from_admin) {
$self->{form}->{title} = $::locale->text('Dataset upgrade');
$self->{form}->header;
}

486fe464 Moritz Bunkus
print $self->{form}->parse_html_template("dbupgrade/header", { dbname => $::auth->{DB_config}->{db} });

foreach my $control (@unapplied_scripts) {
$::lxdebug->message(LXDebug->DEBUG2(), "Applying Update $control->{file}");
print $self->{form}->parse_html_template("dbupgrade/upgrade_message2", $control);

$self->process_file($dbh, "sql/$self->{dbdriver}-upgrade2-auth/$control->{file}", $control, $db_charset);
}

2da6fbfb Moritz Bunkus
print $self->{form}->parse_html_template("dbupgrade/footer", { is_admin => 1 }) if $called_from_admin;

return 1;
486fe464 Moritz Bunkus
}

4fd8bdbf Moritz Bunkus
sub _check_for_loops {
my ($form, $file_name, $controls, $tag, @path) = @_;

push(@path, $tag);

ad876674 Moritz Bunkus
my $ctrl = $controls->{$tag};

if ($ctrl->{"loop"} == 1) {
# Not done yet.
dbcd72ed Moritz Bunkus
_control_error($form, $file_name, $::locale->text("Dependency loop detected:") . " " . join(" -> ", @path))
53c7990b Moritz Bunkus
ad876674 Moritz Bunkus
} elsif ($ctrl->{"loop"} == 0) {
# Not checked yet.
$ctrl->{"loop"} = 1;
53c7990b Moritz Bunkus
map({ _check_for_loops($form, $file_name, $controls, $_, @path); } @{ $ctrl->{"depends"} });
ad876674 Moritz Bunkus
$ctrl->{"loop"} = 2;
}
4fd8bdbf Moritz Bunkus
}

sub _control_error {
my ($form, $file_name, $message) = @_;

dbcd72ed Moritz Bunkus
$form = $::form;
my $locale = $::locale;
4fd8bdbf Moritz Bunkus
53c7990b Moritz Bunkus
$form->error(sprintf($locale->text("Error in database control file '%s': %s"), $file_name, $message));
4fd8bdbf Moritz Bunkus
}

sub _dbupdate2_calculate_depth {
dbcd72ed Moritz Bunkus
$::lxdebug->enter_sub(2);
4fd8bdbf Moritz Bunkus
my ($tree, $tag) = @_;

my $node = $tree->{$tag};

dbcd72ed Moritz Bunkus
return $::lxdebug->leave_sub(2) if (defined($node->{"depth"}));
4fd8bdbf Moritz Bunkus
my $max_depth = 0;

foreach $tag (@{$node->{"depends"}}) {
_dbupdate2_calculate_depth($tree, $tag);
my $value = $tree->{$tag}->{"depth"};
$max_depth = $value if ($value > $max_depth);
}

$node->{"depth"} = $max_depth + 1;

dbcd72ed Moritz Bunkus
$::lxdebug->leave_sub(2);
4fd8bdbf Moritz Bunkus
}

sub sort_dbupdate_controls {
7e0ad798 Moritz Bunkus
my $self = shift;

486fe464 Moritz Bunkus
$self->parse_dbupdate_controls unless $self->{all_controls};

dbcd72ed Moritz Bunkus
return sort { ($a->{depth} <=> $b->{depth}) || ($a->{priority} <=> $b->{priority}) || ($a->{tag} cmp $b->{tag}) } values %{ $self->{all_controls} };
4fd8bdbf Moritz Bunkus
}

1;
8d7674a0 Moritz Bunkus
__END__

=pod

=encoding utf8

=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>)

=head1 SYNOPSIS

use SL::User;
use SL::DBUpgrade2;

# Apply outstanding updates to the authentication database
my $scripts = SL::DBUpgrade2->new(
form => $::form,
dbdriver => 'Pg',
auth => 1
);
$scripts->apply_admin_dbupgrade_scripts(1);

# Apply updates to a user database
my $scripts = SL::DBUpgrade2->new(
form => $::form,
dbdriver => $::form->{dbdriver},
auth => 1
);
User->dbupdate2($form, $scripts->parse_dbupdate_controls);

=head1 OVERVIEW

Database upgrade files are used to upgrade the database structure and
content of both the authentication database and the user
databases. They're applied when a user logs in. As long as the
authentication database is not up to date users cannot log in in
general, and the admin has to log in first in order to get his
database updated.

Database scripts form a tree by specifying which upgrade file depends
on which other upgrade file. This means that such files are always
applied in a well-defined order.

Each script is run in a separate transaction. If a script fails the
current transaction is rolled back and the whole upgrade process is
stopped. The user/admin is required to fix the issue manually.

A list of applied upgrade scripts is maintained in a table called
C<schema_info> for the user database and C<auth.schema_info>) for the
authentication database. They contain the tags, the login name of the
user having applied the script and the timestamp when the script was
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<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.

=head1 CONTROL FIELDS

=head2 SYNTAX

Control fields for Perl files:

# @tag1: value1
# @tag2: some more values
sub do_stuff {
}
1;

Control fields for SQL files:

-- @tag1: value1
-- @tag2: some more values
ALTER TABLE ...;

=head2 TAGS AND THEIR MEANING

The following tags are recognized:

=over 4

=item tag

The name for this file. The C<tag> is also used for dependency
resolution (see C<depends>).

This is mandatory.

=item description

A description presented to the user when the update is applied.

This is mandatory.

=item depends

A space-separated list of tags of scripts this particular script
depends on. All other upgrades listed in C<depends> will be applied
before the current one is applied.

=item charset
28919cb3 Sven Schöling
dcaf9754 Moritz Bunkus
=item encoding
8d7674a0 Moritz Bunkus
dcaf9754 Moritz Bunkus
The charset this file uses. Defaults to C<ISO-8859-15> if
missing. Both terms are recognized.
8d7674a0 Moritz Bunkus
=item priority

Ordering the scripts by their dependencies alone produces a lot of
groups of scripts that could be applied at the same time (e.g. if both
B and C depend only on A then B could be applied before C or the other
way around). This field determines the order inside such a
group. Scripts with lower priority fields are executed before scripts
with higher priority fields.

If two scripts have equal priorities then their tag name decides.

The priority defaults to 1000.

=back

=head1 FUNCTIONS

=over 4

=item C<apply_admin_dbupgrade_scripts $called_from_admin>

Applies all unapplied upgrade files to the authentication/admin
database. The parameter C<$called_from_admin> should be truish if the
function is called from the web interface and falsish if it's called
from e.g. a command line script like C<scripts/dbupgrade2_tool.pl>.

=item C<init %params>

Initializes the object. Is called directly from L<new> and should not
be called again.

=item C<new %params>

Creates a new object. Possible parameters are:

=over 4

=item path

Path to the upgrade files to parse. Required.

=item form

C<SL::Form> object to use. Required.

=item dbdriver

Name of the database driver. Currently only C<Pg> for PostgreSQL is
supported.

=item auth

Optional parameter defaulting to 0. If trueish then the scripts read
are the ones applying to the authentication database.

=back

=item C<parse_dbupdate_controls>

Parses all files located in C<path> (see L<new>), ananlyzes their
control fields, builds the tree, and signals errors if control fields
are missing/wrong (e.g. a tag name listed in C<depends> is not
found). Sets C<$Self-&gt;{all_controls}> to the list of database
scripts.

=item C<process_file $dbh, $filename, $version_or_control, $db_charset>

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>).

Returns the result of the actual function called.

=item C<process_perl_script $dbh, $filename, $version_or_control, $db_charset>

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>).

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
script returns C<1> then the update was successful. Return code C<2>
means "needs more interaction from the user; remove users/nologin and
end current upgrade process". All other return codes are fatal errors.

Inside the Perl script several local variables exist that can be used:

=over 4

=item $dbup_locale

A locale object for translating messages

=item $dbh

The database handle (inside a transaction).

=item $::form

The global C<SL::Form> object.

=back

A Perl script can actually implement queries that fail while
continueing the process by handling the transaction itself, e.g. with
the following function:

sub do_query {
my ($query, $may_fail) = @_;

if (!$dbh->do($query)) {
die($dbup_locale->text("Database update error:") . "<br>$msg<br>" . $DBI::errstr) unless $may_fail;
$dbh->rollback();
$dbh->begin_work();
}
}

=item C<process_query $dbh, $filename, $version_or_control, $db_charset>

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>).

=item C<sort_dbupdate_controls>

Sorts the database upgrade scripts according to their C<tag> and
C<priority> control fields. Returns a list of their hash
representations that can be applied in order.

=item C<unapplied_upgrade_scripts $dbh>

Returns a list if upgrade scripts (their internal hash representation)
that haven't been applied to a database yet. C<$dbh> is an open handle
to the database that is checked.

Requires that the scripts have been parsed.

=item C<update2_available $dbh>

Returns trueish if at least one upgrade script hasn't been applied to
a database yet. C<$dbh> is an open handle to the database that is
checked.

Requires that the scripts have been parsed.

=back

=head1 BUGS

Nothing here yet.

=head1 AUTHOR

Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>

=cut