Revision a1d1605e
Von Moritz Bunkus vor fast 14 Jahren hinzugefügt
| SL/DBUpgrade2.pm | ||
|---|---|---|
| 1 | 1 |
package SL::DBUpgrade2; |
| 2 | 2 |
|
| 3 |
use IO::File; |
|
| 4 |
|
|
| 3 | 5 |
use SL::Common; |
| 6 |
use SL::Iconv; |
|
| 4 | 7 |
|
| 5 | 8 |
use strict; |
| 6 | 9 |
|
| ... | ... | |
| 10 | 13 |
return bless($self, $package); |
| 11 | 14 |
} |
| 12 | 15 |
|
| 16 |
sub set_dbcharset {
|
|
| 17 |
my $self = shift; |
|
| 18 |
$self->{dbcharset} = shift;
|
|
| 19 |
return $self; |
|
| 20 |
} |
|
| 21 |
|
|
| 13 | 22 |
sub parse_dbupdate_controls {
|
| 14 | 23 |
$main::lxdebug->enter_sub(); |
| 15 | 24 |
|
| ... | ... | |
| 101 | 110 |
return \%all_controls; |
| 102 | 111 |
} |
| 103 | 112 |
|
| 113 |
sub process_query {
|
|
| 114 |
$main::lxdebug->enter_sub(); |
|
| 115 |
|
|
| 116 |
my ($self, $dbh, $filename, $version_or_control, $db_charset) = @_; |
|
| 117 |
|
|
| 118 |
my $form = $self->{form};
|
|
| 119 |
my $fh = IO::File->new($filename, "r") or $form->error("$filename : $!\n");
|
|
| 120 |
my $query = ""; |
|
| 121 |
my $sth; |
|
| 122 |
my @quote_chars; |
|
| 123 |
|
|
| 124 |
my $file_charset = Common::DEFAULT_CHARSET; |
|
| 125 |
while (<$fh>) {
|
|
| 126 |
last if !/^--/; |
|
| 127 |
next if !/^--\s*\@charset:\s*(.+)/; |
|
| 128 |
$file_charset = $1; |
|
| 129 |
last; |
|
| 130 |
} |
|
| 131 |
$fh->seek(0, SEEK_SET); |
|
| 132 |
|
|
| 133 |
$db_charset ||= Common::DEFAULT_CHARSET; |
|
| 134 |
|
|
| 135 |
$dbh->begin_work(); |
|
| 136 |
|
|
| 137 |
while (<$fh>) {
|
|
| 138 |
$_ = SL::Iconv::convert($file_charset, $db_charset, $_); |
|
| 139 |
|
|
| 140 |
# Remove DOS and Unix style line endings. |
|
| 141 |
chomp; |
|
| 142 |
|
|
| 143 |
# remove comments |
|
| 144 |
s/--.*$//; |
|
| 145 |
|
|
| 146 |
for (my $i = 0; $i < length($_); $i++) {
|
|
| 147 |
my $char = substr($_, $i, 1); |
|
| 148 |
|
|
| 149 |
# Are we inside a string? |
|
| 150 |
if (@quote_chars) {
|
|
| 151 |
if ($char eq $quote_chars[-1]) {
|
|
| 152 |
pop(@quote_chars); |
|
| 153 |
} |
|
| 154 |
$query .= $char; |
|
| 155 |
|
|
| 156 |
} else {
|
|
| 157 |
if (($char eq "'") || ($char eq "\"")) {
|
|
| 158 |
push(@quote_chars, $char); |
|
| 159 |
|
|
| 160 |
} elsif ($char eq ";") {
|
|
| 161 |
|
|
| 162 |
# Query is complete. Send it. |
|
| 163 |
|
|
| 164 |
$sth = $dbh->prepare($query); |
|
| 165 |
if (!$sth->execute()) {
|
|
| 166 |
my $errstr = $dbh->errstr; |
|
| 167 |
$sth->finish(); |
|
| 168 |
$dbh->rollback(); |
|
| 169 |
$form->dberror("The database update/creation did not succeed. " .
|
|
| 170 |
"The file ${filename} containing the following " .
|
|
| 171 |
"query failed:<br>${query}<br>" .
|
|
| 172 |
"The error message was: ${errstr}<br>" .
|
|
| 173 |
"All changes in that file have been reverted."); |
|
| 174 |
} |
|
| 175 |
$sth->finish(); |
|
| 176 |
|
|
| 177 |
$char = ""; |
|
| 178 |
$query = ""; |
|
| 179 |
} |
|
| 180 |
|
|
| 181 |
$query .= $char; |
|
| 182 |
} |
|
| 183 |
} |
|
| 184 |
|
|
| 185 |
# Insert a space at the end of each line so that queries split |
|
| 186 |
# over multiple lines work properly. |
|
| 187 |
if ($query ne '') {
|
|
| 188 |
$query .= @quote_chars ? "\n" : ' '; |
|
| 189 |
} |
|
| 190 |
} |
|
| 191 |
|
|
| 192 |
if (ref($version_or_control) eq "HASH") {
|
|
| 193 |
$dbh->do("INSERT INTO schema_info (tag, login) VALUES (" .
|
|
| 194 |
$dbh->quote($version_or_control->{"tag"}) . ", " .
|
|
| 195 |
$dbh->quote($form->{"login"}) . ")");
|
|
| 196 |
} elsif ($version_or_control) {
|
|
| 197 |
$dbh->do("UPDATE defaults SET version = " .
|
|
| 198 |
$dbh->quote($version_or_control)); |
|
| 199 |
} |
|
| 200 |
$dbh->commit(); |
|
| 201 |
|
|
| 202 |
$fh->close(); |
|
| 203 |
|
|
| 204 |
$main::lxdebug->leave_sub(); |
|
| 205 |
} |
|
| 206 |
|
|
| 104 | 207 |
sub _check_for_loops {
|
| 105 | 208 |
my ($form, $file_name, $controls, $tag, @path) = @_; |
| 106 | 209 |
|
| SL/User.pm | ||
|---|---|---|
| 395 | 395 |
my $db_charset = $Common::db_encoding_to_charset{$form->{encoding}};
|
| 396 | 396 |
$db_charset ||= Common::DEFAULT_CHARSET; |
| 397 | 397 |
|
| 398 |
my $dbupdater = SL::DBUpgrade2->new($form, $form->{dbdriver});
|
|
| 398 | 399 |
# create the tables |
| 399 |
$self->process_query($form, $dbh, "sql/lx-office.sql", undef, $db_charset);
|
|
| 400 |
$dbupdater->process_query($dbh, "sql/lx-office.sql", undef, $db_charset);
|
|
| 400 | 401 |
|
| 401 | 402 |
# load chart of accounts |
| 402 |
$self->process_query($form, $dbh, "sql/$form->{chart}-chart.sql", undef, $db_charset);
|
|
| 403 |
$dbupdater->process_query($dbh, "sql/$form->{chart}-chart.sql", undef, $db_charset);
|
|
| 403 | 404 |
|
| 404 | 405 |
$query = "UPDATE defaults SET coa = ?"; |
| 405 | 406 |
do_query($form, $dbh, $query, $form->{chart});
|
| ... | ... | |
| 482 | 483 |
$main::lxdebug->leave_sub(); |
| 483 | 484 |
} |
| 484 | 485 |
|
| 485 |
sub process_query {
|
|
| 486 |
$main::lxdebug->enter_sub(); |
|
| 487 |
|
|
| 488 |
my ($self, $form, $dbh, $filename, $version_or_control, $db_charset) = @_; |
|
| 489 |
|
|
| 490 |
my $fh = IO::File->new($filename, "r") or $form->error("$filename : $!\n");
|
|
| 491 |
my $query = ""; |
|
| 492 |
my $sth; |
|
| 493 |
my @quote_chars; |
|
| 494 |
|
|
| 495 |
my $file_charset = Common::DEFAULT_CHARSET; |
|
| 496 |
while (<$fh>) {
|
|
| 497 |
last if !/^--/; |
|
| 498 |
next if !/^--\s*\@charset:\s*(.+)/; |
|
| 499 |
$file_charset = $1; |
|
| 500 |
last; |
|
| 501 |
} |
|
| 502 |
$fh->seek(0, SEEK_SET); |
|
| 503 |
|
|
| 504 |
$db_charset ||= Common::DEFAULT_CHARSET; |
|
| 505 |
|
|
| 506 |
$dbh->begin_work(); |
|
| 507 |
|
|
| 508 |
while (<$fh>) {
|
|
| 509 |
$_ = SL::Iconv::convert($file_charset, $db_charset, $_); |
|
| 510 |
|
|
| 511 |
# Remove DOS and Unix style line endings. |
|
| 512 |
chomp; |
|
| 513 |
|
|
| 514 |
# remove comments |
|
| 515 |
s/--.*$//; |
|
| 516 |
|
|
| 517 |
for (my $i = 0; $i < length($_); $i++) {
|
|
| 518 |
my $char = substr($_, $i, 1); |
|
| 519 |
|
|
| 520 |
# Are we inside a string? |
|
| 521 |
if (@quote_chars) {
|
|
| 522 |
if ($char eq $quote_chars[-1]) {
|
|
| 523 |
pop(@quote_chars); |
|
| 524 |
} |
|
| 525 |
$query .= $char; |
|
| 526 |
|
|
| 527 |
} else {
|
|
| 528 |
if (($char eq "'") || ($char eq "\"")) {
|
|
| 529 |
push(@quote_chars, $char); |
|
| 530 |
|
|
| 531 |
} elsif ($char eq ";") {
|
|
| 532 |
|
|
| 533 |
# Query is complete. Send it. |
|
| 534 |
|
|
| 535 |
$sth = $dbh->prepare($query); |
|
| 536 |
if (!$sth->execute()) {
|
|
| 537 |
my $errstr = $dbh->errstr; |
|
| 538 |
$sth->finish(); |
|
| 539 |
$dbh->rollback(); |
|
| 540 |
$form->dberror("The database update/creation did not succeed. " .
|
|
| 541 |
"The file ${filename} containing the following " .
|
|
| 542 |
"query failed:<br>${query}<br>" .
|
|
| 543 |
"The error message was: ${errstr}<br>" .
|
|
| 544 |
"All changes in that file have been reverted."); |
|
| 545 |
} |
|
| 546 |
$sth->finish(); |
|
| 547 |
|
|
| 548 |
$char = ""; |
|
| 549 |
$query = ""; |
|
| 550 |
} |
|
| 551 |
|
|
| 552 |
$query .= $char; |
|
| 553 |
} |
|
| 554 |
} |
|
| 555 |
|
|
| 556 |
# Insert a space at the end of each line so that queries split |
|
| 557 |
# over multiple lines work properly. |
|
| 558 |
if ($query ne '') {
|
|
| 559 |
$query .= @quote_chars ? "\n" : ' '; |
|
| 560 |
} |
|
| 561 |
} |
|
| 562 |
|
|
| 563 |
if (ref($version_or_control) eq "HASH") {
|
|
| 564 |
$dbh->do("INSERT INTO schema_info (tag, login) VALUES (" .
|
|
| 565 |
$dbh->quote($version_or_control->{"tag"}) . ", " .
|
|
| 566 |
$dbh->quote($form->{"login"}) . ")");
|
|
| 567 |
} elsif ($version_or_control) {
|
|
| 568 |
$dbh->do("UPDATE defaults SET version = " .
|
|
| 569 |
$dbh->quote($version_or_control)); |
|
| 570 |
} |
|
| 571 |
$dbh->commit(); |
|
| 572 |
|
|
| 573 |
$fh->close(); |
|
| 574 |
|
|
| 575 |
$main::lxdebug->leave_sub(); |
|
| 576 |
} |
|
| 577 |
|
|
| 578 | 486 |
sub dbdelete {
|
| 579 | 487 |
$main::lxdebug->enter_sub(); |
| 580 | 488 |
|
| ... | ... | |
| 762 | 670 |
my $db_charset = $main::dbcharset; |
| 763 | 671 |
$db_charset ||= Common::DEFAULT_CHARSET; |
| 764 | 672 |
|
| 673 |
my $dbupdater = SL::DBUpgrade2->new($form, $form->{dbdriver});
|
|
| 674 |
|
|
| 765 | 675 |
foreach my $db (split(/ /, $form->{dbupdate})) {
|
| 766 | 676 |
|
| 767 | 677 |
next unless $form->{$db};
|
| ... | ... | |
| 802 | 712 |
# apply upgrade |
| 803 | 713 |
$main::lxdebug->message(LXDebug->DEBUG2(), "Applying Update $upgradescript"); |
| 804 | 714 |
if ($file_type eq "sql") {
|
| 805 |
$self->process_query($form, $dbh, "sql/" . $form->{"dbdriver"} .
|
|
| 806 |
"-upgrade/$upgradescript", $str_maxdb, $db_charset); |
|
| 715 |
$dbupdater->process_query($dbh, "sql/" . $form->{"dbdriver"} . "-upgrade/$upgradescript", $str_maxdb, $db_charset);
|
|
| 807 | 716 |
} else {
|
| 808 | 717 |
$self->process_perl_script($form, $dbh, "sql/" . $form->{"dbdriver"} .
|
| 809 | 718 |
"-upgrade/$upgradescript", $str_maxdb, $db_charset); |
| ... | ... | |
| 888 | 797 |
print $form->parse_html_template("dbupgrade/upgrade_message2", $control);
|
| 889 | 798 |
|
| 890 | 799 |
if ($file_type eq "sql") {
|
| 891 |
$self->process_query($form, $dbh, "sql/" . $form->{"dbdriver"} .
|
|
| 892 |
"-upgrade2/$control->{file}", $control, $db_charset);
|
|
| 800 |
$dbupdater->process_query($dbh, "sql/" . $form->{"dbdriver"} . "-upgrade2/$control->{file}", $control, $db_charset);
|
|
| 893 | 801 |
} else {
|
| 894 | 802 |
$self->process_perl_script($form, $dbh, "sql/" . $form->{"dbdriver"} .
|
| 895 | 803 |
"-upgrade2/$control->{file}", $control, $db_charset);
|
Auch abrufbar als: Unified diff
Funktion "process_query" von User.pm nach DBUpgrade2.pm verschoben