projects
/
kivitendo-erp.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
LXDebug: Flag SHOW_CALLER für Ausgabe Dateiname:Zeilennummer bei message() & dump()
[kivitendo-erp.git]
/
SL
/
DBUpgrade2.pm
diff --git
a/SL/DBUpgrade2.pm
b/SL/DBUpgrade2.pm
index
01af8f6
..
bd65a1a
100644
(file)
--- a/
SL/DBUpgrade2.pm
+++ b/
SL/DBUpgrade2.pm
@@
-7,6
+7,7
@@
use List::MoreUtils qw(any);
use SL::Common;
use SL::DBUpgrade2::Base;
use SL::DBUtils;
use SL::Common;
use SL::DBUpgrade2::Base;
use SL::DBUtils;
+use SL::System::Process;
use strict;
use strict;
@@
-26,7
+27,7
@@
sub init {
$params{path_suffix} ||= '';
$params{schema} ||= '';
$params{path_suffix} ||= '';
$params{schema} ||= '';
- $params{path} ||=
"
sql/Pg-upgrade2" . $params{path_suffix};
+ $params{path} ||=
SL::System::Process->exe_dir . "/
sql/Pg-upgrade2" . $params{path_suffix};
map { $self->{$_} = $params{$_} } keys %params;
map { $self->{$_} = $params{$_} } keys %params;
@@
-147,9
+148,6
@@
sub process_query {
# Remove DOS and Unix style line endings.
chomp;
# Remove DOS and Unix style line endings.
chomp;
- # remove comments
- s/--.*$//;
-
for (my $i = 0; $i < length($_); $i++) {
my $char = substr($_, $i, 1);
for (my $i = 0; $i < length($_); $i++) {
my $char = substr($_, $i, 1);
@@
-176,6
+174,11
@@
sub process_query {
&& $tag =~ /^ (?= [A-Za-z_] [A-Za-z0-9_]* | ) $/x) { # tag is identifier
push @quote_chars, $char = '$' . $tag . '$';
$i = $tag_end;
&& $tag =~ /^ (?= [A-Za-z_] [A-Za-z0-9_]* | ) $/x) { # tag is identifier
push @quote_chars, $char = '$' . $tag . '$';
$i = $tag_end;
+ } elsif ($char eq "-") {
+ if ( substr($_, $i+1, 1) eq "-") {
+ # found a comment outside quote
+ last;
+ }
} elsif ($char eq ";") {
# Query is complete. Send it.
} elsif ($char eq ";") {
# Query is complete. Send it.
@@
-241,7
+244,6
@@
sub process_perl_script {
$dbh->begin_work;
# setup dbup_ export vars & run script
$dbh->begin_work;
# setup dbup_ export vars & run script
- my $old_dbh = $::form->set_standard_dbh($dbh);
my %dbup_myconfig = map { ($_ => $::form->{$_}) } qw(dbname dbuser dbpasswd dbhost dbport dbconnect);
my $result = eval {
SL::DBUpgrade2::Base::execute_script(
my %dbup_myconfig = map { ($_ => $::form->{$_}) } qw(dbname dbuser dbpasswd dbhost dbport dbconnect);
my $result = eval {
SL::DBUpgrade2::Base::execute_script(
@@
-254,8
+256,6
@@
sub process_perl_script {
my $error = $EVAL_ERROR;
my $error = $EVAL_ERROR;
- $::form->set_standard_dbh($old_dbh);
-
$dbh->rollback if 1 != ($result // -1);
return $error if $self->{return_on_error} && (1 != ($result // -1));
$dbh->rollback if 1 != ($result // -1);
return $error if $self->{return_on_error} && (1 != ($result // -1));
@@
-610,7
+610,7
@@
The global C<SL::Form> object.
=back
A Perl script can actually implement queries that fail while
=back
A Perl script can actually implement queries that fail while
-continu
e
ing the process by handling the transaction itself, e.g. with
+continuing the process by handling the transaction itself, e.g. with
the following function:
sub do_query {
the following function:
sub do_query {