- $filename = qq|sql/$form->{chart}-chart.sql|;
- $self->process_query($form, $dbh, $filename);
-
- $dbh->disconnect;
-
- $main::lxdebug->leave_sub();
-}
-
-# 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 $result = eval($contents);
-
- if (1 != $result) {
- $dbh->rollback();
- $dbh->disconnect();
- }
-
- if (!defined($result)) {
- $form->dberror("The database update/creation did not succeed. The file ${filename} containing the following syntax error:<br>${@}<br>" .
- "All changes in that file have been reverted.");
- } 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;