projects / kivitendo-erp.git / blobdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | inline | side by side
Die ausgewiesenen Mahngebühren gelten pro Rechnung, nicht pro erzeugter Mahnung,...
[kivitendo-erp.git] / SL / User.pm
diff --git a/SL/User.pm b/SL/User.pm
index 9e1afb8..d2e914f 100644 (file)
--- a/SL/User.pm
+++ b/SL/User.pm
@@ -34,8 +34,13 @@
 
 package User;
 
 
 package User;
 
+use IO::File;
+use Fcntl qw(:seek);
+
 use SL::DBUpgrade2;
 use SL::DBUtils;
 use SL::DBUpgrade2;
 use SL::DBUtils;
+use SL::Iconv;
+use SL::Inifile;
 
 sub new {
   $main::lxdebug->enter_sub();
 
 sub new {
   $main::lxdebug->enter_sub();
@@ -44,6 +49,10 @@ sub new {
   my $self = {};
 
   if ($login ne "") {
   my $self = {};
 
   if ($login ne "") {
+    local *MEMBER;
+
+    $login =~ s|.*/||;
+
     &error("", "$memfile locked!") if (-f "${memfile}.LCK");
 
     open(MEMBER, "$memfile") or &error("", "$memfile : $!");
     &error("", "$memfile locked!") if (-f "${memfile}.LCK");
 
     open(MEMBER, "$memfile") or &error("", "$memfile : $!");
@@ -51,8 +60,8 @@ sub new {
     while (<MEMBER>) {
       if (/^\[$login\]/) {
         while (<MEMBER>) {
     while (<MEMBER>) {
       if (/^\[$login\]/) {
         while (<MEMBER>) {
-          last if /^\[/;
-          next if /^(#|\s)/;
+          last if m/^\[/;
+          next if m/^(#|\s)/;
 
           # remove comments
           s/\s#.*//g;
 
           # remove comments
           s/\s#.*//g;
@@ -84,6 +93,8 @@ sub new {
 sub country_codes {
   $main::lxdebug->enter_sub();
 
 sub country_codes {
   $main::lxdebug->enter_sub();
 
+  local *DIR;
+
   my %cc       = ();
   my @language = ();
 
   my %cc       = ();
   my @language = ();
 
@@ -112,6 +123,8 @@ sub login {
 
   my ($self, $form, $userspath) = @_;
 
 
   my ($self, $form, $userspath) = @_;
 
+  local *FH;
+
   my $rc = -3;
 
   if ($self->{login}) {
   my $rc = -3;
 
   if ($self->{login}) {
@@ -130,7 +143,7 @@ sub login {
     }
 
     unless (-e "$userspath/$self->{login}.conf") {
     }
 
     unless (-e "$userspath/$self->{login}.conf") {
-      $self->create_config("$userspath/$self->{login}.conf");
+      $self->create_config();
     }
 
     do "$userspath/$self->{login}.conf";
     }
 
     do "$userspath/$self->{login}.conf";
@@ -203,6 +216,8 @@ sub login {
       $self->dbupdate($form);
       $self->dbupdate2($form, $controls);
 
       $self->dbupdate($form);
       $self->dbupdate2($form, $controls);
 
+      close(FH);
+
       # remove lock file
       unlink("$userspath/nologin");
 
       # remove lock file
       unlink("$userspath/nologin");
 
@@ -407,13 +422,14 @@ sub dbcreate {
   $dbh = DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
     or $form->dberror;
 
   $dbh = DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
     or $form->dberror;
 
+  my $db_charset = $Common::db_encoding_to_charset{$form->{encoding}};
+  $db_charset ||= Common::DEFAULT_CHARSET;
+
   # create the tables
   # create the tables
-  my $filename = qq|sql/lx-office.sql|;
-  $self->process_query($form, $dbh, $filename);
+  $self->process_query($form, $dbh, "sql/lx-office.sql", undef, $db_charset);
 
   # load chart of accounts
 
   # 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});
 
   $query = "UPDATE defaults SET coa = ?";
   do_query($form, $dbh, $query, $form->{chart});
@@ -431,11 +447,31 @@ sub dbcreate {
 sub process_perl_script {
   $main::lxdebug->enter_sub();
 
 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();
 
 
   $dbh->begin_work();
 
@@ -481,16 +517,28 @@ sub process_perl_script {
 sub process_query {
   $main::lxdebug->enter_sub();
 
 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 $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();
 
   $dbh->begin_work();
 
-  while (<FH>) {
+  while (<$fh>) {
+    $_ = SL::Iconv::convert($file_charset, $db_charset, $_);
 
     # Remove DOS and Unix style line endings.
     chomp;
 
     # Remove DOS and Unix style line endings.
     chomp;
@@ -548,7 +596,7 @@ sub process_query {
   }
   $dbh->commit();
 
   }
   $dbh->commit();
 
-  close FH;
+  $fh->close();
 
   $main::lxdebug->leave_sub();
 }
 
   $main::lxdebug->leave_sub();
 }
@@ -579,6 +627,8 @@ sub dbsources_unused {
 
   my ($self, $form, $memfile) = @_;
 
 
   my ($self, $form, $memfile) = @_;
 
+  local *FH;
+
   my @dbexcl    = ();
   my @dbsources = ();
 
   my @dbexcl    = ();
   my @dbsources = ();
 
@@ -617,84 +667,43 @@ sub dbneedsupdate {
 
   my ($self, $form) = @_;
 
 
   my ($self, $form) = @_;
 
-  my %dbsources = ();
-  my $query;
-
-  $form->{sid} = $form->{dbdefault};
-  &dbconnect_vars($form, $form->{dbdefault});
+  my $members  = Inifile->new($main::memberfile);
+  my $controls = parse_dbupdate_controls($form, $form->{dbdriver});
 
 
-  my $dbh =
-    DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
-    or $form->dberror;
-
-  if ($form->{dbdriver} eq 'Pg') {
-
-    $query =
-      qq|SELECT d.datname FROM pg_database d, pg_user u | .
-      qq|WHERE d.datdba = u.usesysid AND u.usename = ?|;
-    my $sth = prepare_execute_query($form, $dbh, $query, $form->{dbuser});
+  my ($query, $sth, %dbs_needing_updates);
 
 
-    while (my ($db) = $sth->fetchrow_array) {
+  foreach my $login (grep /[a-z]/, keys %{ $members }) {
+    my $member = $members->{$login};
 
 
-      next if ($db =~ /^template/);
+    map { $form->{$_} = $member->{$_} } qw(dbname dbuser dbpasswd dbhost dbport);
+    dbconnect_vars($form, $form->{dbname});
+    $main::lxdebug->dump(0, "form", $form);
+    my $dbh = DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd});
 
 
-      &dbconnect_vars($form, $db);
+    next unless $dbh;
 
 
-      my $dbh2 =
-        DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
-        or $form->dberror;
+    my $version;
 
 
-      $query =
-        qq|SELECT tablename FROM pg_tables | .
-        qq|WHERE tablename = 'defaults'|;
-      my $sth2 = prepare_execute_query($form, $dbh, $query);
-
-      if ($sth2->fetchrow_array) {
-        $query = qq|SELECT version FROM defaults|;
-        my ($version) = selectrow_query($form, $dbh2, $query);
-        $dbsources{$db} = $version;
-      }
-      $sth2->finish;
-      $dbh2->disconnect;
+    $query = qq|SELECT version FROM defaults|;
+    $sth = prepare_query($form, $dbh, $query);
+    if ($sth->execute()) {
+      ($version) = $sth->fetchrow_array();
     }
     }
-    $sth->finish;
-  }
-
-  if ($form->{dbdriver} eq 'Oracle') {
-    $query =
-      qq|SELECT owner FROM dba_objects |.
-      qq|WHERE object_name = 'DEFAULTS' AND object_type = 'TABLE'|;
-
-    $sth = $dbh->prepare($query);
-    $sth->execute || $form->dberror($query);
-
-    while (my ($db) = $sth->fetchrow_array) {
-
-      $form->{dbuser} = $db;
-      &dbconnect_vars($form, $db);
-
-      my $dbh =
-        DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
-        or $form->dberror;
+    $sth->finish();
+    $dbh->disconnect();
 
 
-      $query = qq|SELECT version FROM defaults|;
-      my $sth = $dbh->prepare($query);
-      $sth->execute;
+    next unless $version;
 
 
-      if (my ($version) = $sth->fetchrow_array) {
-        $dbsources{$db} = $version;
-      }
-      $sth->finish;
-      $dbh->disconnect;
+    if (update_available($form->{dbdriver}, $version) || update2_available($form, $controls)) {
+      my $dbinfo = {};
+      map { $dbinfo->{$_} = $member->{$_} } grep /^db/, keys %{ $member };
+      $dbs_needing_updates{$member->{dbhost} . "::" . $member->{dbname}} = $dbinfo;
     }
     }
-    $sth->finish;
   }
 
   }
 
-  $dbh->disconnect;
-
   $main::lxdebug->leave_sub();
 
   $main::lxdebug->leave_sub();
 
-  return %dbsources;
+  return values %dbs_needing_updates;
 }
 
 sub calc_version {
 }
 
 sub calc_version {
@@ -742,12 +751,11 @@ sub cmp_script_version {
 sub update_available {
   my ($dbdriver, $cur_version) = @_;
 
 sub update_available {
   my ($dbdriver, $cur_version) = @_;
 
-  opendir(SQLDIR, "sql/${dbdriver}-upgrade")
-    or &error("", "sql/${dbdriver}-upgrade: $!");
-  my @upgradescripts =
-    grep(/$form->{dbdriver}-upgrade-\Q$cur_version\E.*\.(sql|pl)$/,
-         readdir(SQLDIR));
-  closedir(SQLDIR);
+  local *SQLDIR;
+
+  opendir SQLDIR, "sql/${dbdriver}-upgrade" || error("", "sql/${dbdriver}-upgrade: $!");
+  my @upgradescripts = grep /${dbdriver}-upgrade-\Q$cur_version\E.*\.(sql|pl)$/, readdir SQLDIR;
+  closedir SQLDIR;
 
   return ($#upgradescripts > -1);
 }
 
   return ($#upgradescripts > -1);
 }
@@ -759,6 +767,7 @@ sub create_schema_info_table {
 
   my $query = "SELECT tag FROM schema_info LIMIT 1";
   if (!$dbh->do($query)) {
 
   my $query = "SELECT tag FROM schema_info LIMIT 1";
   if (!$dbh->do($query)) {
+    $dbh->rollback();
     $query =
       qq|CREATE TABLE schema_info (| .
       qq|  tag text, | .
     $query =
       qq|CREATE TABLE schema_info (| .
       qq|  tag text, | .
@@ -776,6 +785,8 @@ sub dbupdate {
 
   my ($self, $form) = @_;
 
 
   my ($self, $form) = @_;
 
+  local *SQLDIR;
+
   $form->{sid} = $form->{dbdefault};
 
   my @upgradescripts = ();
   $form->{sid} = $form->{dbdefault};
 
   my @upgradescripts = ();
@@ -794,6 +805,9 @@ sub dbupdate {
     closedir(SQLDIR);
   }
 
     closedir(SQLDIR);
   }
 
+  my $db_charset = $main::dbcharset;
+  $db_charset ||= Common::DEFAULT_CHARSET;
+
   foreach my $db (split(/ /, $form->{dbupdate})) {
 
     next unless $form->{$db};
   foreach my $db (split(/ /, $form->{dbupdate})) {
 
     next unless $form->{$db};
@@ -833,10 +847,10 @@ sub dbupdate {
       $main::lxdebug->message(DEBUG2, "Applying Update $upgradescript");
       if ($file_type eq "sql") {
         $self->process_query($form, $dbh, "sql/" . $form->{"dbdriver"} .
       $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"} .
       } else {
         $self->process_perl_script($form, $dbh, "sql/" . $form->{"dbdriver"} .
-                                   "-upgrade/$upgradescript", $str_maxdb);
+                                   "-upgrade/$upgradescript", $str_maxdb, $db_charset);
       }
 
       $version = $maxdb;
       }
 
       $version = $maxdb;
@@ -866,6 +880,9 @@ sub dbupdate2 {
 
   @upgradescripts = sort_dbupdate_controls($controls);
 
 
   @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};
   foreach my $db (split / /, $form->{dbupdate}) {
 
     next unless $form->{$db};
@@ -880,6 +897,8 @@ sub dbupdate2 {
 
     map({ $_->{"applied"} = 0; } @upgradescripts);
 
 
     map({ $_->{"applied"} = 0; } @upgradescripts);
 
+    $self->create_schema_info_table($form, $dbh);
+
     $query = qq|SELECT tag FROM schema_info|;
     $sth = $dbh->prepare($query);
     $sth->execute() || $form->dberror($query);
     $query = qq|SELECT tag FROM schema_info|;
     $sth = $dbh->prepare($query);
     $sth->execute() || $form->dberror($query);
@@ -901,6 +920,8 @@ sub dbupdate2 {
     foreach my $control (@upgradescripts) {
       next if ($control->{"applied"});
 
     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;
 
       $control->{"file"} =~ /\.(sql|pl)$/;
       my $file_type = $1;
 
@@ -911,10 +932,10 @@ sub dbupdate2 {
 
       if ($file_type eq "sql") {
         $self->process_query($form, $dbh, "sql/" . $form->{"dbdriver"} .
 
       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"} .
       } else {
         $self->process_perl_script($form, $dbh, "sql/" . $form->{"dbdriver"} .
-                                   "-upgrade2/$control->{file}", $control);
+                                   "-upgrade2/$control->{file}", $control, $db_charset);
       }
     }
 
       }
     }
 
@@ -962,11 +983,15 @@ sub update2_available {
 sub create_config {
   $main::lxdebug->enter_sub();
 
 sub create_config {
   $main::lxdebug->enter_sub();
 
-  my ($self, $filename) = @_;
+  my ($self) = @_;
+
+  local *CONF;
 
 
-  @config = &config_vars;
+  @config = config_vars();
 
 
-  open(CONF, ">$filename") or $self->error("$filename : $!");
+  my $userspath = $main::userspath;
+
+  open(CONF, ">", "$userspath/$self->{login}.conf") || $self->error("$userspath/$self->{login}.conf : $!");
 
   # create the config file
   print CONF qq|# configuration file for $self->{login}
 
   # create the config file
   print CONF qq|# configuration file for $self->{login}
@@ -974,7 +999,7 @@ sub create_config {
 \%myconfig = (
 |;
 
 \%myconfig = (
 |;
 
-  foreach $key (sort @config) {
+  foreach my $key (sort @config) {
     $self->{$key} =~ s/\'/\\\'/g;
     print CONF qq|  $key => '$self->{$key}',\n|;
   }
     $self->{$key} =~ s/\'/\\\'/g;
     print CONF qq|  $key => '$self->{$key}',\n|;
   }
@@ -991,6 +1016,8 @@ sub save_member {
 
   my ($self, $memberfile, $userspath) = @_;
 
 
   my ($self, $memberfile, $userspath) = @_;
 
+  local (*FH, *CONF);
+
   my $newmember = 1;
 
   # format dbconnect and dboptions string
   my $newmember = 1;
 
   # format dbconnect and dboptions string
@@ -1064,8 +1091,7 @@ sub save_member {
   unlink "${memberfile}.LCK";
 
   # create conf file
   unlink "${memberfile}.LCK";
 
   # create conf file
-  $self->create_config("$userspath/$self->{login}.conf")
-    unless $self->{'root login'};
+  $self->create_config() unless $self->{'root login'};
 
   $main::lxdebug->leave_sub();
 }
 
   $main::lxdebug->leave_sub();
 }
@@ -1073,7 +1099,7 @@ sub save_member {
 sub config_vars {
   $main::lxdebug->enter_sub();
 
 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
     currency dateformat dbconnect dbdriver dbhost dbport dboptions
     dbname dbuser dbpasswd email fax name numberformat password
     printer role sid signature stylesheet tel templates vclimit angebote
@@ -1091,6 +1117,8 @@ sub error {
 
   my ($self, $msg) = @_;
 
 
   my ($self, $msg) = @_;
 
+  $main::lxdebug->show_backtrace();
+
   if ($ENV{HTTP_USER_AGENT}) {
     print qq|Content-Type: text/html
 
   if ($ENV{HTTP_USER_AGENT}) {
     print qq|Content-Type: text/html
 
Unnamed repository; edit this file 'description' to name the repository.