Buchungsjournal: Filter "Bearbeiter" gefixt

[mfinanz.git] / SL / DBUpgrade2.pm

diff --git a/SL/DBUpgrade2.pm b/SL/DBUpgrade2.pm
index a74e8ae82ed4a75504adb26655e3bc716af3713b..d98627c563362906f280ef6958766d0bc16815ad 100644 (file)
--- a/SL/DBUpgrade2.pm
+++ b/SL/DBUpgrade2.pm
@@ -4,6 +4,7 @@ use IO::File;
 use List::MoreUtils qw(any);
 
 use SL::Common;
 use List::MoreUtils qw(any);
 
 use SL::Common;

+use SL::DBUpgrade2::Base;

 use SL::DBUtils;
 use SL::Iconv;
 
 use SL::DBUtils;
 use SL::Iconv;
 


@@ -25,12 +26,17 @@ sub init {
 
   $params{path_suffix} ||= '';
   $params{schema}      ||= '';
 
   $params{path_suffix} ||= '';
   $params{schema}      ||= '';

+  $params{path}          = "sql/" . $params{dbdriver} . "-upgrade2" . $params{path_suffix};

 
   map { $self->{$_} = $params{$_} } keys %params;
 
   return $self;
 }
 
 
   map { $self->{$_} = $params{$_} } keys %params;
 
   return $self;
 }
 

+sub path {
+  $_[0]{path};
+}
+

 sub parse_dbupdate_controls {
   $::lxdebug->enter_sub();
 
 sub parse_dbupdate_controls {
   $::lxdebug->enter_sub();
 


@@ -42,7 +48,7 @@ sub parse_dbupdate_controls {
   local *IN;
   my %all_controls;
 
   local *IN;
   my %all_controls;
 

-  my $path = "sql/" . $self->{dbdriver} . "-upgrade2" . $self->{path_suffix};
+  my $path = $self->path;

 
   foreach my $file_name (<$path/*.sql>, <$path/*.pl>) {
     next unless (open(IN, $file_name));
 
   foreach my $file_name (<$path/*.sql>, <$path/*.pl>) {
     next unless (open(IN, $file_name));


@@ -74,6 +80,7 @@ sub parse_dbupdate_controls {
 
     next if ($control->{ignore});
 
 
     next if ($control->{ignore});
 

+    $control->{charset} = 'UTF-8' if $file =~ m/\.pl$/;

     $control->{charset} = $control->{charset} || $control->{encoding} || Common::DEFAULT_CHARSET;
 
     if (!$control->{"tag"}) {
     $control->{charset} = $control->{charset} || $control->{encoding} || Common::DEFAULT_CHARSET;
 
     if (!$control->{"tag"}) {


@@ -163,9 +170,8 @@ sub process_query {
         if ($char eq $quote_chars[-1]) {
           pop(@quote_chars);
         } elsif (length $quote_chars[-1] > 1
         if ($char eq $quote_chars[-1]) {
           pop(@quote_chars);
         } elsif (length $quote_chars[-1] > 1

-             &&  substr($quote_chars[-1], 0, 1) eq $char

              &&  substr($_, $i, length $quote_chars[-1]) eq $quote_chars[-1]) {
              &&  substr($_, $i, length $quote_chars[-1]) eq $quote_chars[-1]) {

-          $i   += length $quote_chars[-1] - 1;
+          $i   += length($quote_chars[-1]) - 1;

           $char = $quote_chars[-1];
           pop(@quote_chars);
         }
           $char = $quote_chars[-1];
           pop(@quote_chars);
         }


@@ -176,10 +182,10 @@ sub process_query {
         if (($char eq "'") || ($char eq "\"")) {
           push(@quote_chars, $char);
 
         if (($char eq "'") || ($char eq "\"")) {
           push(@quote_chars, $char);
 

-        } elsif ($char eq '$'                                      # start of dollar quoting
-             && ($tag_end = index($_, '$', $i + 1)) > -1           # ends on same line
-             && (do { substr($_, $i + 1, $tag_end - $i - 1); 1 })  # extract tag
-             &&  $tag =~ /^ (?= [A-Za-z_] [A-Za-z0-9_]* | ) $/x) { # tag is identifier
+        } elsif ($char eq '$'                                            # start of dollar quoting
+             && ($tag_end  = index($_, '$', $i + 1)) > -1                # ends on same line
+             && (do { $tag = substr($_, $i + 1, $tag_end - $i - 1); 1 }) # extract tag
+             &&  $tag      =~ /^ (?= [A-Za-z_] [A-Za-z0-9_]* | ) $/x) {  # tag is identifier

           push @quote_chars, $char = '$' . $tag . '$';
           $i = $tag_end;
         } elsif ($char eq ";") {
           push @quote_chars, $char = '$' . $tag . '$';
           $i = $tag_end;
         } elsif ($char eq ";") {


@@ -236,49 +242,23 @@ sub process_perl_script {
 
   my ($self, $dbh, $filename, $version_or_control, $db_charset) = @_;
 
 
   my ($self, $dbh, $filename, $version_or_control, $db_charset) = @_;
 

-  my $form         = $self->{form};
-  my $fh           = IO::File->new($filename, "r") or $form->error("$filename : $!\n");
-  my $file_charset = Common::DEFAULT_CHARSET;
-
-  if (ref($version_or_control) eq "HASH") {
-    $file_charset = $version_or_control->{charset};
-
-  } else {
-    while (<$fh>) {
-      last if !/^--/;
-      next if !/^--\s*\@(?:charset|encoding):\s*(.+)/;
-      $file_charset = $1;
-      last;
-    }
-    $fh->seek(0, SEEK_SET);
-  }
-
-  my $contents = join "", <$fh>;
-  $fh->close();
-
-  $db_charset ||= Common::DEFAULT_CHARSET;
-
-  my $iconv = SL::Iconv->new($file_charset, $db_charset);
-
-  $dbh->begin_work();
-
-  # setup dbup_ export vars
-  my %dbup_myconfig = ();
-  map({ $dbup_myconfig{$_} = $form->{$_}; } qw(dbname dbuser dbpasswd dbhost dbport dbconnect));
-
-  my $dbup_locale = $::locale;
+  $dbh->begin_work;

 
 

-  my $result = eval($contents);
+  # setup dbup_ export vars & run script
+  my %dbup_myconfig = map { ($_ => $::form->{$_}) } qw(dbname dbuser dbpasswd dbhost dbport dbconnect);
+  my $result        = SL::DBUpgrade2::Base::execute_script(
+    file_name => $filename,
+    tag       => $version_or_control->{tag},
+    dbh       => $dbh,
+    myconfig  => \%dbup_myconfig,
+  );

 
 

-  if (1 != $result) {
+  if (1 != ($result // 1)) {

     $dbh->rollback();
     $dbh->rollback();

-    $dbh->disconnect();

   }
 
   if (!defined($result)) {
   }
 
   if (!defined($result)) {

-    print $form->parse_html_template("dbupgrade/error",
-                                     { "file"  => $filename,
-                                       "error" => $@ });
+    print $::form->parse_html_template("dbupgrade/error", { file  => $filename, error => $@ });

     ::end_of_request();
   } elsif (1 != $result) {
     unlink("users/nologin") if (2 == $result);
     ::end_of_request();
   } elsif (1 != $result) {
     unlink("users/nologin") if (2 == $result);


@@ -286,7 +266,7 @@ sub process_perl_script {
   }
 
   if (ref($version_or_control) eq "HASH") {
   }
 
   if (ref($version_or_control) eq "HASH") {

-    $dbh->do("INSERT INTO " . $self->{schema} . "schema_info (tag, login) VALUES (" . $dbh->quote($version_or_control->{"tag"}) . ", " . $dbh->quote($form->{"login"}) . ")");
+    $dbh->do("INSERT INTO " . $self->{schema} . "schema_info (tag, login) VALUES (" . $dbh->quote($version_or_control->{tag}) . ", " . $dbh->quote($::form->{login}) . ")");

   } elsif ($version_or_control) {
     $dbh->do("UPDATE defaults SET version = " . $dbh->quote($version_or_control));
   }
   } elsif ($version_or_control) {
     $dbh->do("UPDATE defaults SET version = " . $dbh->quote($version_or_control));
   }