-# 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 exit".
-# All other return codes are fatal errors.
-sub process_perl_script {
- $main::lxdebug->enter_sub();
-
- my ($self, $form, $dbh, $filename, $version) = @_;
-
- open(FH, "$filename") or $form->error("$filename : $!\n");
- my $contents = join("", <FH>);
- close(FH);
-
- $dbh->begin_work();
-
- my %dbup_myconfig = ();
- map({ $dbup_myconfig{$_} = $form->{$_}; }
- qw(dbname dbuser dbpasswd dbhost dbport dbconnect));
-
- my $nls_file = $filename;
- $nls_file =~ s|.*/||;
- $nls_file =~ s|.pl$||;
- my $dbup_locale = Locale->new($main::language, $nls_file);
-
- my $result = eval($contents);
-
- if (1 != $result) {
- $dbh->rollback();
- $dbh->disconnect();
- }
-
- if (!defined($result)) {
- print($form->parse_html_template("dbupgrade/error",
- { "file" => $filename,
- "error" => $@ }));
- exit(0);
- } elsif (1 != $result) {
- unlink("users/nologin") if (2 == $result);
- exit(0);
- }
-
- if ($version) {
- $dbh->do("UPDATE defaults SET version = " . $dbh->quote($version));
- }
- $dbh->commit();
-
- $main::lxdebug->leave_sub();
-}
-
-sub process_query {
- $main::lxdebug->enter_sub();
-
- my ($self, $form, $dbh, $filename, $version) = @_;
-
- # return unless (-f $filename);
-
- open(FH, "$filename") or $form->error("$filename : $!\n");
- my $query = "";
- my $sth;
- my @quote_chars;
-
- $dbh->begin_work();
-
- while (<FH>) {
-
- # 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);
- }
- $query .= $char;
-
- } else {
- if (($char eq "'") || ($char eq "\"")) {
- push(@quote_chars, $char);
-
- } 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;
- }
- }
- }
-
- if ($version) {
- $dbh->do("UPDATE defaults SET version = " . $dbh->quote($version));
- }
- $dbh->commit();
-
- close FH;
-
- $main::lxdebug->leave_sub();
-}
-