X-Git-Url: http://wagnertech.de/gitweb/gitweb.cgi/kivitendo-erp.git/blobdiff_plain/f705775670d8312e716364f8fc12abc8417f72bc..69822fd215cb15e1bb017f1af6f0a185f62a31e2:/SL/User.pm diff --git a/SL/User.pm b/SL/User.pm index c563b9e87..93c88834e 100644 --- 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("", ); - 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 () { + 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