Anständig quoten.

[kivitendo-erp.git] / SL / User.pm

diff --git a/SL/User.pm b/SL/User.pm
index c563b9e875e87c6522dda94db4d9bd52222ba064..93c88834e0f6e97bb200126c4e96dfe5504b3fba 100644 (file)
--- a/SL/User.pm
+++ b/SL/User.pm
@@ -34,8 +34,12 @@
 
 package User;
 
+use IO::File;
+use Fcntl qw(:seek);
+
 use SL::DBUpgrade2;
 use SL::DBUtils;
+use SL::Iconv;
 
 sub new {
   $main::lxdebug->enter_sub();
@@ -407,18 +411,14 @@ sub dbcreate {
   $dbh = DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
     or $form->dberror;
 
-  # create the tables
-  my $filename = qq|sql/lx-office.sql|;
-  $self->process_query($form, $dbh, $filename);
+  my $db_charset = $Common::db_encoding_to_charset{$form->{encoding}};
+  $db_charset ||= Common::DEFAULT_CHARSET;
 
-  # load gifi
-  ($filename) = split /_/, $form->{chart};
-  $filename =~ s/_//;
-  $self->process_query($form, $dbh, "sql/${filename}-gifi.sql");
+  # create the tables
+  $self->process_query($form, $dbh, "sql/lx-office.sql", undef, $db_charset);
 
   # load chart of accounts
-  $filename = qq|sql/$form->{chart}-chart.sql|;
-  $self->process_query($form, $dbh, $filename);
+  $self->process_query($form, $dbh, "sql/$form->{chart}-chart.sql", undef, $db_charset);
 
   $query = "UPDATE defaults SET coa = ?";
   do_query($form, $dbh, $query, $form->{chart});
@@ -436,11 +436,31 @@ sub dbcreate {
 sub process_perl_script {
   $main::lxdebug->enter_sub();
 
-  my ($self, $form, $dbh, $filename, $version_or_control) = @_;
+  my ($self, $form, $dbh, $filename, $version_or_control, $db_charset) = @_;
 
-  open(FH, "$filename") or $form->error("$filename : $!\n");
-  my $contents = join("", <FH>);
-  close(FH);
+  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:\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::get_converter($file_charset, $db_charset);
 
   $dbh->begin_work();
 
@@ -486,16 +506,28 @@ sub process_perl_script {
 sub process_query {
   $main::lxdebug->enter_sub();
 
-  my ($self, $form, $dbh, $filename, $version_or_control) = @_;
+  my ($self, $form, $dbh, $filename, $version_or_control, $db_charset) = @_;
 
-  open(FH, "$filename") or $form->error("$filename : $!\n");
+  my $fh = IO::File->new($filename, "r") or $form->error("$filename : $!\n");
   my $query = "";
   my $sth;
   my @quote_chars;
 
+  my $file_charset = Common::DEFAULT_CHARSET;
+  while (<$fh>) {
+    last if !/^--/;
+    next if !/^--\s*\@charset:\s*(.+)/;
+    $file_charset = $1;
+    last;
+  }
+  $fh->seek(0, SEEK_SET);
+
+  $db_charset ||= Common::DEFAULT_CHARSET;
+
   $dbh->begin_work();
 
-  while (<FH>) {
+  while (<$fh>) {
+    $_ = SL::Iconv::convert($file_charset, $db_charset, $_);
 
     # Remove DOS and Unix style line endings.
     chomp;
@@ -553,7 +585,7 @@ sub process_query {
   }
   $dbh->commit();
 
-  close FH;
+  $fh->close();
 
   $main::lxdebug->leave_sub();
 }
@@ -764,6 +796,7 @@ sub create_schema_info_table {
 
   my $query = "SELECT tag FROM schema_info LIMIT 1";
   if (!$dbh->do($query)) {
+    $dbh->rollback();
     $query =
       qq|CREATE TABLE schema_info (| .
       qq|  tag text, | .
@@ -799,6 +832,9 @@ sub dbupdate {
     closedir(SQLDIR);
   }
 
+  my $db_charset = $main::dbcharset;
+  $db_charset ||= Common::DEFAULT_CHARSET;
+
   foreach my $db (split(/ /, $form->{dbupdate})) {
 
     next unless $form->{$db};
@@ -838,10 +874,10 @@ sub dbupdate {
       $main::lxdebug->message(DEBUG2, "Applying Update $upgradescript");
       if ($file_type eq "sql") {
         $self->process_query($form, $dbh, "sql/" . $form->{"dbdriver"} .
-                             "-upgrade/$upgradescript", $str_maxdb);
+                             "-upgrade/$upgradescript", $str_maxdb, $db_charset);
       } else {
         $self->process_perl_script($form, $dbh, "sql/" . $form->{"dbdriver"} .
-                                   "-upgrade/$upgradescript", $str_maxdb);
+                                   "-upgrade/$upgradescript", $str_maxdb, $db_charset);
       }
 
       $version = $maxdb;
@@ -871,6 +907,9 @@ sub dbupdate2 {
 
   @upgradescripts = sort_dbupdate_controls($controls);
 
+  my $db_charset = $main::dbcharset;
+  $db_charset ||= Common::DEFAULT_CHARSET;
+
   foreach my $db (split / /, $form->{dbupdate}) {
 
     next unless $form->{$db};
@@ -906,6 +945,8 @@ sub dbupdate2 {
     foreach my $control (@upgradescripts) {
       next if ($control->{"applied"});
 
+      $control->{description} = SL::Iconv::convert($control->{charset}, $db_charset, $control->{description});
+
       $control->{"file"} =~ /\.(sql|pl)$/;
       my $file_type = $1;
 
@@ -916,10 +957,10 @@ sub dbupdate2 {
 
       if ($file_type eq "sql") {
         $self->process_query($form, $dbh, "sql/" . $form->{"dbdriver"} .
-                             "-upgrade2/$control->{file}", $control);
+                             "-upgrade2/$control->{file}", $control, $db_charset);
       } else {
         $self->process_perl_script($form, $dbh, "sql/" . $form->{"dbdriver"} .
-                                   "-upgrade2/$control->{file}", $control);
+                                   "-upgrade2/$control->{file}", $control, $db_charset);
       }
     }
 
@@ -1078,7 +1119,7 @@ sub save_member {
 sub config_vars {
   $main::lxdebug->enter_sub();
 
-  my @conf = qw(acs address admin businessnumber charset company countrycode
+  my @conf = qw(acs address admin businessnumber company countrycode
     currency dateformat dbconnect dbdriver dbhost dbport dboptions
     dbname dbuser dbpasswd email fax name numberformat password
     printer role sid signature stylesheet tel templates vclimit angebote