Revision dbda14c2
Von Moritz Bunkus vor mehr als 11 Jahren hinzugefügt
| SL/DBUpgrade2.pm | ||
|---|---|---|
| 82 | 82 |
next if ($control->{ignore});
|
| 83 | 83 |
|
| 84 | 84 |
$control->{charset} = 'UTF-8' if $file =~ m/\.pl$/;
|
| 85 |
$control->{charset} = $control->{charset} || $control->{encoding} || Common::DEFAULT_CHARSET;
|
|
| 85 |
$control->{charset} = $control->{charset} || $control->{encoding} || 'UTF-8';
|
|
| 86 | 86 |
|
| 87 | 87 |
if (!$control->{"tag"}) {
|
| 88 | 88 |
_control_error($form, $file_name, $locale->text("Missing 'tag' field.")) ;
|
| ... | ... | |
| 133 | 133 |
sub process_query {
|
| 134 | 134 |
$::lxdebug->enter_sub(); |
| 135 | 135 |
|
| 136 |
my ($self, $dbh, $filename, $version_or_control, $db_charset) = @_;
|
|
| 136 |
my ($self, $dbh, $filename, $version_or_control) = @_; |
|
| 137 | 137 |
|
| 138 | 138 |
my $form = $self->{form};
|
| 139 | 139 |
my $fh = IO::File->new($filename, "r") or $form->error("$filename : $!\n");
|
| ... | ... | |
| 141 | 141 |
my $sth; |
| 142 | 142 |
my @quote_chars; |
| 143 | 143 |
|
| 144 |
my $file_charset = Common::DEFAULT_CHARSET;
|
|
| 144 |
my $file_charset = 'UTF-8';
|
|
| 145 | 145 |
while (<$fh>) {
|
| 146 | 146 |
last if !/^--/; |
| 147 | 147 |
next if !/^--\s*\@(?:charset|encoding):\s*(.+)/; |
| ... | ... | |
| 150 | 150 |
} |
| 151 | 151 |
$fh->seek(0, SEEK_SET); |
| 152 | 152 |
|
| 153 |
$db_charset ||= Common::DEFAULT_CHARSET; |
|
| 154 |
|
|
| 155 | 153 |
$dbh->begin_work(); |
| 156 | 154 |
|
| 157 | 155 |
while (<$fh>) {
|
| 158 |
$_ = SL::Iconv::convert($file_charset, $db_charset, $_);
|
|
| 156 |
$_ = SL::Iconv::convert($file_charset, 'UTF-8', $_);
|
|
| 159 | 157 |
|
| 160 | 158 |
# Remove DOS and Unix style line endings. |
| 161 | 159 |
chomp; |
| ... | ... | |
| 241 | 239 |
sub process_perl_script {
|
| 242 | 240 |
$::lxdebug->enter_sub(); |
| 243 | 241 |
|
| 244 |
my ($self, $dbh, $filename, $version_or_control, $db_charset) = @_;
|
|
| 242 |
my ($self, $dbh, $filename, $version_or_control) = @_; |
|
| 245 | 243 |
|
| 246 | 244 |
my %form_values = map { $_ => $::form->{$_} } qw(dbconnect dbdefault dbhost dbmbkiviunstable dbname dboptions dbpasswd dbport dbupdate dbuser login template_object version);
|
| 247 | 245 |
|
| ... | ... | |
| 288 | 286 |
} |
| 289 | 287 |
|
| 290 | 288 |
sub process_file {
|
| 291 |
my ($self, $dbh, $filename, $version_or_control, $db_charset) = @_;
|
|
| 289 |
my ($self, $dbh, $filename, $version_or_control) = @_; |
|
| 292 | 290 |
|
| 293 | 291 |
if ($filename =~ m/sql$/) {
|
| 294 |
$self->process_query($dbh, $filename, $version_or_control, $db_charset);
|
|
| 292 |
$self->process_query($dbh, $filename, $version_or_control); |
|
| 295 | 293 |
} else {
|
| 296 |
$self->process_perl_script($dbh, $filename, $version_or_control, $db_charset);
|
|
| 294 |
$self->process_perl_script($dbh, $filename, $version_or_control); |
|
| 297 | 295 |
} |
| 298 | 296 |
} |
| 299 | 297 |
|
| ... | ... | |
| 357 | 355 |
|
| 358 | 356 |
return 0 if !@unapplied_scripts; |
| 359 | 357 |
|
| 360 |
my $db_charset = $::lx_office_conf{system}->{dbcharset} || Common::DEFAULT_CHARSET;
|
|
| 361 | 358 |
$self->{form}->{login} ||= 'admin';
|
| 362 | 359 |
|
| 363 |
map { $_->{description} = SL::Iconv::convert($_->{charset}, $db_charset, $_->{description}) } values %{ $self->{all_controls} };
|
|
| 360 |
map { $_->{description} = SL::Iconv::convert($_->{charset}, 'UTF-8', $_->{description}) } values %{ $self->{all_controls} };
|
|
| 364 | 361 |
|
| 365 | 362 |
if ($called_from_admin) {
|
| 366 | 363 |
$self->{form}->{title} = $::locale->text('Dataset upgrade');
|
| ... | ... | |
| 373 | 370 |
$::lxdebug->message(LXDebug->DEBUG2(), "Applying Update $control->{file}");
|
| 374 | 371 |
print $self->{form}->parse_html_template("dbupgrade/upgrade_message2", $control);
|
| 375 | 372 |
|
| 376 |
$self->process_file($dbh, "sql/Pg-upgrade2-auth/$control->{file}", $control, $db_charset);
|
|
| 373 |
$self->process_file($dbh, "sql/Pg-upgrade2-auth/$control->{file}", $control);
|
|
| 377 | 374 |
} |
| 378 | 375 |
|
| 379 | 376 |
print $self->{form}->parse_html_template("dbupgrade/footer", { is_admin => 1 }) if $called_from_admin;
|
| ... | ... | |
| 617 | 614 |
found). Sets C<$Self->{all_controls}> to the list of database
|
| 618 | 615 |
scripts. |
| 619 | 616 |
|
| 620 |
=item C<process_file $dbh, $filename, $version_or_control, $db_charset>
|
|
| 617 |
=item C<process_file $dbh, $filename, $version_or_control> |
|
| 621 | 618 |
|
| 622 | 619 |
Applies a single database upgrade file. Calls L<process_perl_script> |
| 623 | 620 |
for Perl update files and C<process_query> for SQL update |
| 624 | 621 |
files. Requires an open database handle(C<$dbh>), the file name |
| 625 |
(C<$filename>), a hash structure of the file's control fields as |
|
| 626 |
produced by L<parse_dbupdate_controls> (C<$version_or_control>) and |
|
| 627 |
the database charset (for on-the-fly charset recoding of the script if |
|
| 628 |
required, C<$db_charset>). |
|
| 622 |
(C<$filename>) and a hash structure of the file's control fields as |
|
| 623 |
produced by L<parse_dbupdate_controls> (C<$version_or_control>). |
|
| 629 | 624 |
|
| 630 | 625 |
Returns the result of the actual function called. |
| 631 | 626 |
|
| 632 |
=item C<process_perl_script $dbh, $filename, $version_or_control, $db_charset>
|
|
| 627 |
=item C<process_perl_script $dbh, $filename, $version_or_control> |
|
| 633 | 628 |
|
| 634 | 629 |
Applies a single Perl database upgrade file. Requires an open database |
| 635 |
handle(C<$dbh>), the file name (C<$filename>), a hash structure of the |
|
| 636 |
file's control fields as produced by L<parse_dbupdate_controls> |
|
| 637 |
(C<$version_or_control>) and the database charset (for on-the-fly |
|
| 638 |
charset recoding of the script if required, C<$db_charset>). |
|
| 630 |
handle(C<$dbh>), the file name (C<$filename>) and a hash structure of |
|
| 631 |
the file's control fields as produced by L<parse_dbupdate_controls> |
|
| 632 |
(C<$version_or_control>). |
|
| 639 | 633 |
|
| 640 | 634 |
Perl scripts are executed via L<eval>. If L<eval> returns falsish then |
| 641 | 635 |
an error is expected. There are two special return values: If the |
| ... | ... | |
| 675 | 669 |
} |
| 676 | 670 |
} |
| 677 | 671 |
|
| 678 |
=item C<process_query $dbh, $filename, $version_or_control, $db_charset>
|
|
| 672 |
=item C<process_query $dbh, $filename, $version_or_control> |
|
| 679 | 673 |
|
| 680 | 674 |
Applies a single SQL database upgrade file. Requires an open database |
| 681 |
handle(C<$dbh>), the file name (C<$filename>), a hash structure of the |
|
| 682 |
ofile's control fields as produced by L<parse_dbupdate_controls> |
|
| 683 |
(C<$version_or_control>) and the database charset (for on-the-fly |
|
| 684 |
charset recoding of the script if required, C<$db_charset>). |
|
| 675 |
handle(C<$dbh>), the file name (C<$filename>), and a hash structure of |
|
| 676 |
the file's control fields as produced by L<parse_dbupdate_controls> |
|
| 677 |
(C<$version_or_control>). |
|
| 685 | 678 |
|
| 686 | 679 |
=item C<sort_dbupdate_controls> |
| 687 | 680 |
|
Auch abrufbar als: Unified diff
Unterstützung für andere Datenbankencodings als Unicode/UTF-8 entfernt