- $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 %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;