Bei PDF-Reports nur die Spalten anzeigen, die für PDF konfiguriert wurden

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

diff --git a/SL/User.pm b/SL/User.pm
index a034e03..46fe855 100644 (file)
--- a/SL/User.pm
+++ b/SL/User.pm
@@ -34,60 +34,46 @@
 
 package User;
 
 
 package User;
 

-sub new {
-  $main::lxdebug->enter_sub();
-
-  my ($type, $memfile, $login) = @_;
-  my $self = {};
-
-  if ($login ne "") {
-    &error("", "$memfile locked!") if (-f "${memfile}.LCK");
-
-    open(MEMBER, "$memfile") or &error("", "$memfile : $!");
-
-    while (<MEMBER>) {
-      if (/^\[$login\]/) {
-        while (<MEMBER>) {
-          last if /^\[/;
-          next if /^(#|\s)/;
+use IO::File;
+use Fcntl qw(:seek);

 
 

-          # remove comments
-          s/\s#.*//g;
+#use SL::Auth;
+use SL::DBUpgrade2;
+use SL::DBUtils;
+use SL::Iconv;
+use SL::Inifile;

 
 

-          # remove any trailing whitespace
-          s/^\s*(.*?)\s*$/$1/;
+use strict;

 
 

-          ($key, $value) = split /=/, $_, 2;
-
-          if (($key eq "stylesheet") && ($value eq "sql-ledger.css")) {
-            $value = "lx-office-erp.css";
-          }
+sub new {
+  $main::lxdebug->enter_sub();

 
 

-          $self->{$key} = $value;
-        }
+  my ($type, $login) = @_;

 
 

-        $self->{login} = $login;
+  my $self = {};

 
 

-        last;
-      }
-    }
-    close MEMBER;
+  if ($login ne "") {
+    my %user_data = $main::auth->read_user($login);
+    map { $self->{$_} = $user_data{$_} } keys %user_data;

   }
 
   $main::lxdebug->leave_sub();
   }
 
   $main::lxdebug->leave_sub();

+

   bless $self, $type;
 }
 
 sub country_codes {
   $main::lxdebug->enter_sub();
 
   bless $self, $type;
 }
 
 sub country_codes {
   $main::lxdebug->enter_sub();
 

+  local *DIR;
+

   my %cc       = ();
   my @language = ();
 
   # scan the locale directory and read in the LANGUAGE files
   my %cc       = ();
   my @language = ();
 
   # scan the locale directory and read in the LANGUAGE files

-  opendir DIR, "locale";
+  opendir(DIR, "locale");

 
 

-  my @dir = grep !/(^\.\.?$|\..*)/, readdir DIR;
+  my @dir = grep(!/(^\.\.?$|\..*)/, readdir(DIR));

 
   foreach my $dir (@dir) {
     next unless open(FH, "locale/$dir/LANGUAGE");
 
   foreach my $dir (@dir) {
     next unless open(FH, "locale/$dir/LANGUAGE");


@@ -107,33 +93,21 @@ sub country_codes {
 sub login {
   $main::lxdebug->enter_sub();
 
 sub login {
   $main::lxdebug->enter_sub();
 

-  my ($self, $form, $userspath) = @_;
+  my ($self, $form) = @_;
+  our $sid;
+
+  local *FH;

 
   my $rc = -3;
 
   if ($self->{login}) {
 
   my $rc = -3;
 
   if ($self->{login}) {

-
-    if ($self->{password}) {
-      $form->{password} = crypt $form->{password},
-        substr($self->{login}, 0, 2);
-      if ($self->{password} ne $form->{password}) {
-        $main::lxdebug->leave_sub();
-        return -1;
-      }
-    }
-
-    unless (-e "$userspath/$self->{login}.conf") {
-      $self->create_config("$userspath/$self->{login}.conf");
-    }
-
-    do "$userspath/$self->{login}.conf";
-    $myconfig{dbpasswd} = unpack 'u', $myconfig{dbpasswd};
+    my %myconfig = $main::auth->read_user($self->{login});

 
     # check if database is down
     my $dbh =
       DBI->connect($myconfig{dbconnect}, $myconfig{dbuser},
                    $myconfig{dbpasswd})
 
     # check if database is down
     my $dbh =
       DBI->connect($myconfig{dbconnect}, $myconfig{dbuser},
                    $myconfig{dbpasswd})

-      or $self->error(DBI::errstr);
+      or $self->error($DBI::errstr);

 
     # we got a connection, check the version
     my $query = qq|SELECT version FROM defaults|;
 
     # we got a connection, check the version
     my $query = qq|SELECT version FROM defaults|;


@@ -143,38 +117,43 @@ sub login {
     my ($dbversion) = $sth->fetchrow_array;
     $sth->finish;
 
     my ($dbversion) = $sth->fetchrow_array;
     $sth->finish;
 

-    # add login to employee table if it does not exist
-    # no error check for employee table, ignore if it does not exist
-    $query = qq|SELECT e.id FROM employee e WHERE e.login = '$self->{login}'|;
-    $sth   = $dbh->prepare($query);
-    $sth->execute;
+    $self->create_employee_entry($form, $dbh, \%myconfig);

 
 

-    my ($login) = $sth->fetchrow_array;
-    $sth->finish;
+    $self->create_schema_info_table($form, $dbh);

 
 

-    if (!$login) {
-      $query = qq|INSERT INTO employee (login, name, workphone, role)
-                  VALUES ('$self->{login}', '$myconfig{name}',
-                 '$myconfig{tel}', 'user')|;
-      $dbh->do($query);
-    }

     $dbh->disconnect;
 
     $rc = 0;
 
     $dbh->disconnect;
 
     $rc = 0;
 

-    if ($form->{dbversion} ne $dbversion) {
+    my $controls =
+      parse_dbupdate_controls($form, $myconfig{"dbdriver"});

 
 

-      # update the tables
-      open FH, ">$userspath/nologin" or die "
-$!";
+    map({ $form->{$_} = $myconfig{$_} }
+        qw(dbname dbhost dbport dbdriver dbuser dbpasswd dbconnect dateformat));

 
 

-      map { $form->{$_} = $myconfig{$_} }
-        qw(dbname dbhost dbport dbdriver dbuser dbpasswd);
+    if (update_available($myconfig{"dbdriver"}, $dbversion) ||
+        update2_available($form, $controls)) {
+
+      $form->{"stylesheet"} = "lx-office-erp.css";
+      $form->{"title"} = $main::locale->text("Dataset upgrade");
+      $form->header();
+      print $form->parse_html_template("dbupgrade/header");

 
       $form->{dbupdate} = "db$myconfig{dbname}";
       $form->{ $form->{dbupdate} } = 1;
 
 
       $form->{dbupdate} = "db$myconfig{dbname}";
       $form->{ $form->{dbupdate} } = 1;
 

-      $form->info("Upgrading Dataset $myconfig{dbname} ...");
+      if ($form->{"show_dbupdate_warning"}) {
+        print $form->parse_html_template("dbupgrade/warning");
+        ::end_of_request();
+      }
+
+      # update the tables
+      if (!open(FH, ">$main::userspath/nologin")) {
+        $form->show_generic_error($main::locale->text('A temporary file could not be created. ' .
+                                                      'Please verify that the directory "#1" is writeable by the webserver.',
+                                                      $main::userspath),
+                                  'back_button' => 1);
+      }

 
       # required for Oracle
       $form->{dbdefault} = $sid;
 
       # required for Oracle
       $form->{dbdefault} = $sid;


@@ -184,11 +163,21 @@ $!";
       $SIG{QUIT} = 'IGNORE';
 
       $self->dbupdate($form);
       $SIG{QUIT} = 'IGNORE';
 
       $self->dbupdate($form);

+      $self->dbupdate2($form, $controls);
+
+      close(FH);

 
       # remove lock file
 
       # remove lock file

-      unlink "$userspath/nologin";
+      unlink("$main::userspath/nologin");

 
 

-      $form->info("... done");
+      my $menufile =
+        $self->{"menustyle"} eq "v3" ? "menuv3.pl" :
+        $self->{"menustyle"} eq "neu" ? "menunew.pl" :
+        $self->{"menustyle"} eq "js" ? "menujs.pl" :
+        $self->{"menustyle"} eq "xml" ? "menuXML.pl" :
+        "menu.pl";
+
+      print $form->parse_html_template("dbupgrade/footer", { "menufile" => $menufile });

 
       $rc = -2;
 
 
       $rc = -2;
 


@@ -271,10 +260,11 @@ sub dbsources {
     or $form->dberror;
 
   if ($form->{dbdriver} eq 'Pg') {
     or $form->dberror;
 
   if ($form->{dbdriver} eq 'Pg') {

-
-    $query = qq|SELECT datname FROM pg_database|;
-    $sth   = $dbh->prepare($query);
-    $sth->execute || $form->dberror($query);
+    $query =
+      qq|SELECT datname FROM pg_database | .
+      qq|WHERE NOT datname IN ('template0', 'template1')|;
+    $sth = $dbh->prepare($query);
+    $sth->execute() || $form->dberror($query);

 
     while (my ($db) = $sth->fetchrow_array) {
 
 
     while (my ($db) = $sth->fetchrow_array) {
 


@@ -287,28 +277,29 @@ sub dbsources {
           DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
           or $form->dberror;
 
           DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
           or $form->dberror;
 

-        $query = qq|SELECT p.tablename FROM pg_tables p
-                   WHERE p.tablename = 'defaults'
-                   AND p.tableowner = '$form->{dbuser}'|;
+        $query =
+          qq|SELECT tablename FROM pg_tables | .
+          qq|WHERE (tablename = 'defaults') AND (tableowner = ?)|;

         my $sth = $dbh->prepare($query);
         my $sth = $dbh->prepare($query);

-        $sth->execute || $form->dberror($query);
+        $sth->execute($form->{dbuser}) ||
+          $form->dberror($query . " ($form->{dbuser})");

 
         if ($sth->fetchrow_array) {
 
         if ($sth->fetchrow_array) {

-          push @dbsources, $db;
+          push(@dbsources, $db);

         }
         $sth->finish;
         $dbh->disconnect;
         next;
       }
         }
         $sth->finish;
         $dbh->disconnect;
         next;
       }

-      push @dbsources, $db;
+      push(@dbsources, $db);

     }
   }
 
   if ($form->{dbdriver} eq 'Oracle') {
     if ($form->{only_acc_db}) {
     }
   }
 
   if ($form->{dbdriver} eq 'Oracle') {
     if ($form->{only_acc_db}) {

-      $query = qq|SELECT o.owner FROM dba_objects o
-                 WHERE o.object_name = 'DEFAULTS'
-                 AND o.object_type = 'TABLE'|;
+      $query =
+        qq|SELECT owner FROM dba_objects | .
+        qq|WHERE object_name = 'DEFAULTS' AND object_type = 'TABLE'|;

     } else {
       $query = qq|SELECT username FROM dba_users|;
     }
     } else {
       $query = qq|SELECT username FROM dba_users|;
     }


@@ -317,7 +308,7 @@ sub dbsources {
     $sth->execute || $form->dberror($query);
 
     while (my ($db) = $sth->fetchrow_array) {
     $sth->execute || $form->dberror($query);
 
     while (my ($db) = $sth->fetchrow_array) {

-      push @dbsources, $db;
+      push(@dbsources, $db);

     }
   }
 
     }
   }
 


@@ -329,30 +320,64 @@ sub dbsources {
   return @dbsources;
 }
 
   return @dbsources;
 }
 

-sub dbcreate {
+sub dbclusterencoding {

   $main::lxdebug->enter_sub();
 
   my ($self, $form) = @_;
 
   $main::lxdebug->enter_sub();
 
   my ($self, $form) = @_;
 

-  my %dbcreate = (
-    'Pg'     => qq|CREATE DATABASE "$form->{db}"|,
-    'Oracle' =>
-      qq|CREATE USER "$form->{db}" DEFAULT TABLESPACE USERS TEMPORARY TABLESPACE TEMP IDENTIFIED BY "$form->{db}"|
-  );
+  $form->{dbdefault} ||= $form->{dbuser};
+
+  dbconnect_vars($form, $form->{dbdefault});

 
 

-  $dbcreate{Pg} .= " WITH ENCODING = '$form->{encoding}'" if $form->{encoding};
+  my $dbh                = DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}) || $form->dberror();
+  my $query              = qq|SELECT pg_encoding_to_char(encoding) FROM pg_database WHERE datname = 'template0'|;
+  my ($cluster_encoding) = $dbh->selectrow_array($query);
+  $dbh->disconnect();
+
+  $main::lxdebug->leave_sub();
+
+  return $cluster_encoding;
+}
+
+sub dbcreate {
+  $main::lxdebug->enter_sub();
+
+  my ($self, $form) = @_;

 
   $form->{sid} = $form->{dbdefault};
   &dbconnect_vars($form, $form->{dbdefault});
   my $dbh =
     DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
     or $form->dberror;
 
   $form->{sid} = $form->{dbdefault};
   &dbconnect_vars($form, $form->{dbdefault});
   my $dbh =
     DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
     or $form->dberror;

-  my $query = qq|$dbcreate{$form->{dbdriver}}|;
-  $dbh->do($query) || $form->dberror($query);
+  $form->{db} =~ s/\"//g;
+  my %dbcreate = (
+    'Pg'     => qq|CREATE DATABASE "$form->{db}"|,
+    'Oracle' =>
+    qq|CREATE USER "$form->{db}" DEFAULT TABLESPACE USERS | .
+    qq|TEMPORARY TABLESPACE TEMP IDENTIFIED BY "$form->{db}"|
+  );
+
+  my %dboptions = (
+    'Pg' => [],
+  );
+
+  push(@{$dboptions{"Pg"}}, "ENCODING = " . $dbh->quote($form->{"encoding"}))
+    if ($form->{"encoding"});
+  if ($form->{"dbdefault"}) {
+    my $dbdefault = $form->{"dbdefault"};
+    $dbdefault =~ s/[^a-zA-Z0-9_\-]//g;
+    push(@{$dboptions{"Pg"}}, "TEMPLATE = $dbdefault");
+  }
+
+  my $query = $dbcreate{$form->{dbdriver}};
+  $query .= " WITH " . join(" ", @{$dboptions{"Pg"}}) if (@{$dboptions{"Pg"}});
+
+  # Ignore errors if the database exists.
+  $dbh->do($query);

 
   if ($form->{dbdriver} eq 'Oracle') {
 
   if ($form->{dbdriver} eq 'Oracle') {

-    $query = qq|GRANT CONNECT,RESOURCE TO "$form->{db}"|;
-    $dbh->do($query) || $form->dberror($query);
+    $query = qq|GRANT CONNECT, RESOURCE TO "$form->{db}"|;
+    do_query($form, $dbh, $query);

   }
   $dbh->disconnect;
 
   }
   $dbh->disconnect;
 


@@ -367,48 +392,127 @@ 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;
 

-  # 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
 
   # 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);

 
 

-  # create indices
-  # Indices sind auch in lx-office.sql
-  # $filename = qq|sql/$form->{dbdriver}-indices.sql|;
-  # $self->process_query($form, $dbh, $filename);
+  $query = "UPDATE defaults SET coa = ?";
+  do_query($form, $dbh, $query, $form->{chart});

 
   $dbh->disconnect;
 
   $main::lxdebug->leave_sub();
 }
 
 
   $dbh->disconnect;
 
   $main::lxdebug->leave_sub();
 }
 

-sub process_query {
+# Process a Perl script which updates the database.
+# If the script returns 1 then the update was successful.
+# Return code "2" means "needs more interaction; remove
+# users/nologin and end current request".
+# All other return codes are fatal errors.
+sub process_perl_script {

   $main::lxdebug->enter_sub();
 
   $main::lxdebug->enter_sub();
 

-  my ($self, $form, $dbh, $filename) = @_;
+  my ($self, $form, $dbh, $filename, $version_or_control, $db_charset) = @_;
+
+  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();
+
+  # setup dbup_ export vars
+  my %dbup_myconfig = ();
+  map({ $dbup_myconfig{$_} = $form->{$_}; }
+      qw(dbname dbuser dbpasswd dbhost dbport dbconnect));
+
+  my $dbup_locale = $::locale;
+
+  my $result = eval($contents);
+
+  if (1 != $result) {
+    $dbh->rollback();
+    $dbh->disconnect();
+  }
+
+  if (!defined($result)) {
+    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();
+  }
+
+  if (ref($version_or_control) eq "HASH") {
+    $dbh->do("INSERT INTO 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));
+  }
+  $dbh->commit();
+
+  $main::lxdebug->leave_sub();
+}
+
+sub process_query {
+  $main::lxdebug->enter_sub();

 
 

-  #  return unless (-f $filename);
+  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;
 

-  while (<FH>) {
+  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>) {
+    $_ = SL::Iconv::convert($file_charset, $db_charset, $_);

 
     # Remove DOS and Unix style line endings.
 
     # Remove DOS and Unix style line endings.

-    s/[\r\n]//g;
+    chomp;

 
 

-    # don't add comments or empty lines
-    next if /^(--.*|\s+)$/;
+    # 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);


@@ -429,8 +533,17 @@ sub process_query {
           # Query is complete. Send it.
 
           $sth = $dbh->prepare($query);
           # Query is complete. Send it.
 
           $sth = $dbh->prepare($query);

-          $sth->execute || $form->dberror($query);
-          $sth->finish;
+          if (!$sth->execute()) {
+            my $errstr = $dbh->errstr;
+            $sth->finish();
+            $dbh->rollback();
+            $form->dberror("The database update/creation did not succeed. " .
+                           "The file ${filename} containing the following " .
+                           "query failed:<br>${query}<br>" .
+                           "The error message was: ${errstr}<br>" .
+                           "All changes in that file have been reverted.");
+          }
+          $sth->finish();

 
           $char  = "";
           $query = "";
 
           $char  = "";
           $query = "";


@@ -439,9 +552,25 @@ sub process_query {
         $query .= $char;
       }
     }
         $query .= $char;
       }
     }

+
+    # Insert a space at the end of each line so that queries split
+    # over multiple lines work properly.
+    if ($query ne '') {
+      $query .= @quote_chars ? "\n" : ' ';
+    }

   }
 
   }
 

-  close FH;
+  if (ref($version_or_control) eq "HASH") {
+    $dbh->do("INSERT INTO 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));
+  }
+  $dbh->commit();
+
+  $fh->close();

 
   $main::lxdebug->leave_sub();
 }
 
   $main::lxdebug->leave_sub();
 }


@@ -450,17 +579,17 @@ sub dbdelete {
   $main::lxdebug->enter_sub();
 
   my ($self, $form) = @_;
   $main::lxdebug->enter_sub();
 
   my ($self, $form) = @_;

-
+  $form->{db} =~ s/\"//g;

   my %dbdelete = ('Pg'     => qq|DROP DATABASE "$form->{db}"|,
   my %dbdelete = ('Pg'     => qq|DROP DATABASE "$form->{db}"|,

-                  'Oracle' => qq|DROP USER $form->{db} CASCADE|);
+                  'Oracle' => qq|DROP USER "$form->{db}" CASCADE|);

 
   $form->{sid} = $form->{dbdefault};
   &dbconnect_vars($form, $form->{dbdefault});
   my $dbh =
     DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
     or $form->dberror;
 
   $form->{sid} = $form->{dbdefault};
   &dbconnect_vars($form, $form->{dbdefault});
   my $dbh =
     DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
     or $form->dberror;

-  my $query = qq|$dbdelete{$form->{dbdriver}}|;
-  $dbh->do($query) || $form->dberror($query);
+  my $query = $dbdelete{$form->{dbdriver}};
+  do_query($form, $dbh, $query);

 
   $dbh->disconnect;
 
 
   $dbh->disconnect;
 


@@ -470,39 +599,21 @@ sub dbdelete {
 sub dbsources_unused {
   $main::lxdebug->enter_sub();
 
 sub dbsources_unused {
   $main::lxdebug->enter_sub();
 

-  my ($self, $form, $memfile) = @_;
-
-  my @dbexcl    = ();
-  my @dbsources = ();
-
-  $form->error('File locked!') if (-f "${memfile}.LCK");
-
-  # open members file
-  open(FH, "$memfile") or $form->error("$memfile : $!");
-
-  while (<FH>) {
-    if (/^dbname=/) {
-      my ($null, $item) = split /=/;
-      push @dbexcl, $item;
-    }
-  }
-
-  close FH;
+  my ($self, $form) = @_;

 
   $form->{only_acc_db} = 1;
 
   $form->{only_acc_db} = 1;

-  my @db = &dbsources("", $form);

 
 

-  push @dbexcl, $form->{dbdefault};
+  my %members = $main::auth->read_all_users();
+  my %dbexcl  = map { $_ => 1 } grep { $_ } map { $_->{dbname} } values %members;

 
 

-  foreach $item (@db) {
-    unless (grep /$item$/, @dbexcl) {
-      push @dbsources, $item;
-    }
-  }
+  $dbexcl{$form->{dbdefault}}             = 1;
+  $dbexcl{$main::auth->{DB_config}->{db}} = 1;
+
+  my @dbunused = grep { !$dbexcl{$_} } dbsources("", $form);

 
   $main::lxdebug->leave_sub();
 
 
   $main::lxdebug->leave_sub();
 

-  return @dbsources;
+  return @dbunused;

 }
 
 sub dbneedsupdate {
 }
 
 sub dbneedsupdate {


@@ -510,95 +621,47 @@ sub dbneedsupdate {
 
   my ($self, $form) = @_;
 
 
   my ($self, $form) = @_;
 

-  my %dbsources = ();
-  my $query;
+  my %members  = $main::auth->read_all_users();
+  my $controls = parse_dbupdate_controls($form, $form->{dbdriver});

 
 

-  $form->{sid} = $form->{dbdefault};
-  &dbconnect_vars($form, $form->{dbdefault});
+  my ($query, $sth, %dbs_needing_updates);

 
 

-  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
-                WHERE d.datdba = u.usesysid
-               AND u.usename = '$form->{dbuser}'|;
-    my $sth = $dbh->prepare($query);
-    $sth->execute || $form->dberror($query);
-
-    while (my ($db) = $sth->fetchrow_array) {
-
-      next if ($db =~ /^template/);
+  foreach my $login (grep /[a-z]/, keys %members) {
+    my $member = $members{$login};

 
 

-      &dbconnect_vars($form, $db);
+    map { $form->{$_} = $member->{$_} } qw(dbname dbuser dbpasswd dbhost dbport);
+    dbconnect_vars($form, $form->{dbname});

 
 

-      my $dbh =
-        DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
-        or $form->dberror;
+    my $dbh = DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd});

 
 

-      $query = qq|SELECT t.tablename FROM pg_tables t
-                 WHERE t.tablename = 'defaults'|;
-      my $sth = $dbh->prepare($query);
-      $sth->execute || $form->dberror($query);
+    next unless $dbh;

 
 

-      if ($sth->fetchrow_array) {
-        $query = qq|SELECT version FROM defaults|;
-        my $sth = $dbh->prepare($query);
-        $sth->execute;
+    my $version;

 
 

-        if (my ($version) = $sth->fetchrow_array) {
-          $dbsources{$db} = $version;
-        }
-        $sth->finish;
-      }
-      $sth->finish;
-      $dbh->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 o.owner FROM dba_objects o
-               WHERE o.object_name = 'DEFAULTS'
-               AND o.object_type = 'TABLE'|;
-
-    $sth = $dbh->prepare($query);
-    $sth->execute || $form->dberror($query);
-
-    while (my ($db) = $sth->fetchrow_array) {
+    $sth->finish();
+    $dbh->disconnect();

 
 

-      $form->{dbuser} = $db;
-      &dbconnect_vars($form, $db);
-
-      my $dbh =
-        DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
-        or $form->dberror;
-
-      $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;

 }
 
 }
 

-## LINET

 sub calc_version {
 sub calc_version {

-  $main::lxdebug->enter_sub();
+  $main::lxdebug->enter_sub(2);

 
   my (@v, $version, $i);
 
 
   my (@v, $version, $i);
 


@@ -612,7 +675,7 @@ sub calc_version {
     $version += $v[$i];
   }
 
     $version += $v[$i];
   }
 

-  $main::lxdebug->leave_sub();
+  $main::lxdebug->leave_sub(2);

   return $version;
 }
 
   return $version;
 }
 


@@ -625,8 +688,8 @@ sub cmp_script_version {
   $my_a =~ s/.sql$//;
   $my_b =~ s/.*-upgrade-//;
   $my_b =~ s/.sql$//;
   $my_a =~ s/.sql$//;
   $my_b =~ s/.*-upgrade-//;
   $my_b =~ s/.sql$//;

-  ($my_a_from, $my_a_to) = split(/-/, $my_a);
-  ($my_b_from, $my_b_to) = split(/-/, $my_b);
+  my ($my_a_from, $my_a_to) = split(/-/, $my_a);
+  my ($my_b_from, $my_b_to) = split(/-/, $my_b);

 
   $res_a = calc_version($my_a_from);
   $res_b = calc_version($my_b_from);
 
   $res_a = calc_version($my_a_from);
   $res_b = calc_version($my_b_from);


@@ -638,13 +701,46 @@ sub cmp_script_version {
 
   return $res_a <=> $res_b;
 }
 
   return $res_a <=> $res_b;
 }

-## /LINET
+
+sub update_available {
+  my ($dbdriver, $cur_version) = @_;
+
+  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);
+}
+
+sub create_schema_info_table {
+  $main::lxdebug->enter_sub();
+
+  my ($self, $form, $dbh) = @_;
+
+  my $query = "SELECT tag FROM schema_info LIMIT 1";
+  if (!$dbh->do($query)) {
+    $dbh->rollback();
+    $query =
+      qq|CREATE TABLE schema_info (| .
+      qq|  tag text, | .
+      qq|  login text, | .
+      qq|  itime timestamp DEFAULT now(), | .
+      qq|  PRIMARY KEY (tag))|;
+    $dbh->do($query) || $form->dberror($query);
+  }
+
+  $main::lxdebug->leave_sub();
+}

 
 sub dbupdate {
   $main::lxdebug->enter_sub();
 
   my ($self, $form) = @_;
 
 
 sub dbupdate {
   $main::lxdebug->enter_sub();
 
   my ($self, $form) = @_;
 

+  local *SQLDIR;
+

   $form->{sid} = $form->{dbdefault};
 
   my @upgradescripts = ();
   $form->{sid} = $form->{dbdefault};
 
   my @upgradescripts = ();


@@ -654,16 +750,19 @@ sub dbupdate {
   if ($form->{dbupdate}) {
 
     # read update scripts into memory
   if ($form->{dbupdate}) {
 
     # read update scripts into memory

-    opendir SQLDIR, "sql/." or $form - error($!);
-    ## LINET
+    opendir(SQLDIR, "sql/" . $form->{dbdriver} . "-upgrade")
+      or &error("", "sql/" . $form->{dbdriver} . "-upgrade : $!");

     @upgradescripts =
       sort(cmp_script_version
     @upgradescripts =
       sort(cmp_script_version

-           grep(/$form->{dbdriver}-upgrade-.*?\.sql$/, readdir(SQLDIR)));
-    ## /LINET
-    closedir SQLDIR;
+           grep(/$form->{dbdriver}-upgrade-.*?\.(sql|pl)$/,
+                readdir(SQLDIR)));
+    closedir(SQLDIR);

   }
 
   }
 

-  foreach my $db (split / /, $form->{dbupdate}) {
+  my $db_charset = $main::dbcharset;
+  $db_charset ||= Common::DEFAULT_CHARSET;
+
+  foreach my $db (split(/ /, $form->{dbupdate})) {

 
     next unless $form->{$db};
 
 
     next unless $form->{$db};
 


@@ -675,31 +774,25 @@ sub dbupdate {
       DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
       or $form->dberror;
 
       DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
       or $form->dberror;
 

+    $dbh->do($form->{dboptions}) if ($form->{dboptions});
+

     # check version
     $query = qq|SELECT version FROM defaults|;
     # check version
     $query = qq|SELECT version FROM defaults|;

-    my $sth = $dbh->prepare($query);
-
-    # no error check, let it fall through
-    $sth->execute;
-
-    my $version = $sth->fetchrow_array;
-    $sth->finish;
+    my ($version) = selectrow_query($form, $dbh, $query);

 
     next unless $version;
 
 
     next unless $version;
 

-    ## LINET

     $version = calc_version($version);
     $version = calc_version($version);

-    ## /LINET

 
     foreach my $upgradescript (@upgradescripts) {
       my $a = $upgradescript;
 
     foreach my $upgradescript (@upgradescripts) {
       my $a = $upgradescript;

-      $a =~ s/^$form->{dbdriver}-upgrade-|\.sql$//g;
+      $a =~ s/^\Q$form->{dbdriver}\E-upgrade-|\.(sql|pl)$//g;
+      my $file_type = $1;

 
       my ($mindb, $maxdb) = split /-/, $a;
 
       my ($mindb, $maxdb) = split /-/, $a;

-      ## LINET
+      my $str_maxdb = $maxdb;

       $mindb = calc_version($mindb);
       $maxdb = calc_version($maxdb);
       $mindb = calc_version($mindb);
       $maxdb = calc_version($maxdb);

-      ## /LINET

 
       next if ($version >= $maxdb);
 
 
       next if ($version >= $maxdb);
 


@@ -707,7 +800,14 @@ sub dbupdate {
       last if ($version < $mindb);
 
       # apply upgrade
       last if ($version < $mindb);
 
       # apply upgrade

-      $self->process_query($form, $dbh, "sql/$upgradescript");
+      $main::lxdebug->message(LXDebug->DEBUG2(), "Applying Update $upgradescript");
+      if ($file_type eq "sql") {
+        $self->process_query($form, $dbh, "sql/" . $form->{"dbdriver"} .
+                             "-upgrade/$upgradescript", $str_maxdb, $db_charset);
+      } else {
+        $self->process_perl_script($form, $dbh, "sql/" . $form->{"dbdriver"} .
+                                   "-upgrade/$upgradescript", $str_maxdb, $db_charset);
+      }

 
       $version = $maxdb;
 
 
       $version = $maxdb;
 


@@ -723,113 +823,169 @@ sub dbupdate {
   return $rc;
 }
 
   return $rc;
 }
 

-sub create_config {
+sub dbupdate2 {

   $main::lxdebug->enter_sub();
 
   $main::lxdebug->enter_sub();
 

-  my ($self, $filename) = @_;
+  my ($self, $form, $controls) = @_;

 
 

-  @config = &config_vars;
+  $form->{sid} = $form->{dbdefault};

 
 

-  open(CONF, ">$filename") or $self->error("$filename : $!");
+  my @upgradescripts = ();
+  my ($query, $sth, $tag);
+  my $rc = -2;

 
 

-  # create the config file
-  print CONF qq|# configuration file for $self->{login}
+  @upgradescripts = sort_dbupdate_controls($controls);

 
 

-\%myconfig = (
-|;
+  my $db_charset = $main::dbcharset;
+  $db_charset ||= Common::DEFAULT_CHARSET;

 
 

-  foreach $key (sort @config) {
-    $self->{$key} =~ s/\'/\\\'/g;
-    print CONF qq|  $key => '$self->{$key}',\n|;
-  }
+  foreach my $db (split / /, $form->{dbupdate}) {

 
 

-  print CONF qq|);\n\n|;
+    next unless $form->{$db};

 
 

-  close CONF;
+    # strip db from dataset
+    $db =~ s/^db//;
+    &dbconnect_vars($form, $db);

 
 

-  $main::lxdebug->leave_sub();
-}
+    my $dbh =
+      DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
+      or $form->dberror;

 
 

-sub save_member {
-  $main::lxdebug->enter_sub();
+    $dbh->do($form->{dboptions}) if ($form->{dboptions});

 
 

-  my ($self, $memberfile, $userspath) = @_;
+    map({ $_->{"applied"} = 0; } @upgradescripts);

 
 

-  my $newmember = 1;
+    $self->create_schema_info_table($form, $dbh);

 
 

-  # format dbconnect and dboptions string
-  &dbconnect_vars($self, $self->{dbname});
+    $query = qq|SELECT tag FROM schema_info|;
+    $sth = $dbh->prepare($query);
+    $sth->execute() || $form->dberror($query);
+    while (($tag) = $sth->fetchrow_array()) {
+      $controls->{$tag}->{"applied"} = 1 if (defined($controls->{$tag}));
+    }
+    $sth->finish();

 
 

-  $self->error('File locked!') if (-f "${memberfile}.LCK");
-  open(FH, ">${memberfile}.LCK") or $self->error("${memberfile}.LCK : $!");
-  close(FH);
+    my $all_applied = 1;
+    foreach (@upgradescripts) {
+      if (!$_->{"applied"}) {
+        $all_applied = 0;
+        last;
+      }
+    }

 
 

-  open(CONF, "+<$memberfile") or $self->error("$memberfile : $!");
+    next if ($all_applied);

 
 

-  @config = <CONF>;
+    foreach my $control (@upgradescripts) {
+      next if ($control->{"applied"});

 
 

-  seek(CONF, 0, 0);
-  truncate(CONF, 0);
+      $control->{description} = SL::Iconv::convert($control->{charset}, $db_charset, $control->{description});

 
 

-  while ($line = shift @config) {
-    if ($line =~ /^\[$self->{login}\]/) {
-      $newmember = 0;
-      last;
+      $control->{"file"} =~ /\.(sql|pl)$/;
+      my $file_type = $1;
+
+      # apply upgrade
+      $main::lxdebug->message(LXDebug->DEBUG2(), "Applying Update $control->{file}");
+      print $form->parse_html_template("dbupgrade/upgrade_message2", $control);
+
+      if ($file_type eq "sql") {
+        $self->process_query($form, $dbh, "sql/" . $form->{"dbdriver"} .
+                             "-upgrade2/$control->{file}", $control, $db_charset);
+      } else {
+        $self->process_perl_script($form, $dbh, "sql/" . $form->{"dbdriver"} .
+                                   "-upgrade2/$control->{file}", $control, $db_charset);
+      }

     }
     }

-    print CONF $line;
-  }

 
 

-  # remove everything up to next login or EOF
-  while ($line = shift @config) {
-    last if ($line =~ /^\[/);
+    $rc = 0;
+    $dbh->disconnect;
+

   }
 
   }
 

-  # this one is either the next login or EOF
-  print CONF $line;
+  $main::lxdebug->leave_sub();

 
 

-  while ($line = shift @config) {
-    print CONF $line;
-  }
+  return $rc;
+}

 
 

-  print CONF qq|[$self->{login}]\n|;
+sub update2_available {
+  $main::lxdebug->enter_sub();

 
 

-  if ((($self->{dbpasswd} ne $self->{old_dbpasswd}) || $newmember)
-      && $self->{root}) {
-    $self->{dbpasswd} = pack 'u', $self->{dbpasswd};
-    chop $self->{dbpasswd};
-  }
-  if (defined($self->{new_password})) {
-    if ($self->{new_password} ne $self->{old_password}) {
-      $self->{password} = crypt $self->{new_password},
-        substr($self->{login}, 0, 2)
-        if $self->{new_password};
-    }
-  } else {
-    if ($self->{password} ne $self->{old_password}) {
-      $self->{password} = crypt $self->{password}, substr($self->{login}, 0, 2)
-        if $self->{password};
+  my ($form, $controls) = @_;
+
+  map({ $_->{"applied"} = 0; } values(%{$controls}));
+
+  dbconnect_vars($form, $form->{"dbname"});
+
+  my $dbh =
+    DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}) ||
+    $form->dberror;
+
+  my ($query, $tag, $sth);
+
+  $query = qq|SELECT tag FROM schema_info|;
+  $sth = $dbh->prepare($query);
+  if ($sth->execute()) {
+    while (($tag) = $sth->fetchrow_array()) {
+      $controls->{$tag}->{"applied"} = 1 if (defined($controls->{$tag}));

     }
   }
     }
   }

+  $sth->finish();
+  $dbh->disconnect();

 
 

-  if ($self->{'root login'}) {
-    @config = ("password");
-  } else {
-    @config = &config_vars;
+  map({ $main::lxdebug->leave_sub() and return 1 if (!$_->{"applied"}) }
+      values(%{$controls}));
+
+  $main::lxdebug->leave_sub();
+  return 0;
+}
+
+sub save_member {
+  $main::lxdebug->enter_sub();
+
+  my ($self) = @_;
+  my $form   = \%main::form;
+
+  # format dbconnect and dboptions string
+  dbconnect_vars($self, $self->{dbname});
+
+  map { $self->{$_} =~ s/\r//g; } qw(address signature);
+
+  $main::auth->save_user($self->{login}, map { $_, $self->{$_} } config_vars());
+
+  my $dbh = DBI->connect($self->{dbconnect}, $self->{dbuser}, $self->{dbpasswd});
+  if ($dbh) {
+    $self->create_employee_entry($form, $dbh, $self, 1);
+    $dbh->disconnect();

   }
 
   }
 

-  # replace \r\n with \n
-  map { $self->{$_} =~ s/\r\n/\\n/g } qw(address signature);
-  foreach $key (sort @config) {
-    print CONF qq|$key=$self->{$key}\n|;
+  $main::lxdebug->leave_sub();
+}
+
+sub create_employee_entry {
+  $main::lxdebug->enter_sub();
+
+  my $self            = shift;
+  my $form            = shift;
+  my $dbh             = shift;
+  my $myconfig        = shift;
+  my $update_existing = shift;
+
+  if (!does_table_exist($dbh, 'employee')) {
+    $main::lxdebug->leave_sub();
+    return;

   }
 
   }
 

-  print CONF "\n";
-  close CONF;
-  unlink "${memberfile}.LCK";
+  # add login to employee table if it does not exist
+  # no error check for employee table, ignore if it does not exist
+  my ($id)  = selectrow_query($form, $dbh, qq|SELECT id FROM employee WHERE login = ?|, $self->{login});

 
 

-  # create conf file
-  $self->create_config("$userspath/$self->{login}.conf")
-    unless $self->{'root login'};
+  if (!$id) {
+    my $query = qq|INSERT INTO employee (login, name, workphone, role) VALUES (?, ?, ?, ?)|;
+    do_query($form, $dbh, $query, ($self->{login}, $myconfig->{name}, $myconfig->{tel}, "user"));
+
+  } elsif ($update_existing) {
+    my $query = qq|UPDATE employee SET name = ?, workphone = ?, role = 'user' WHERE id = ?|;
+    do_query($form, $dbh, $query, $myconfig->{name}, $myconfig->{tel}, $id);
+  }

 
   $main::lxdebug->leave_sub();
 }
 
   $main::lxdebug->leave_sub();
 }


@@ -837,11 +993,14 @@ 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(address admin businessnumber company countrycode

     currency dateformat dbconnect dbdriver dbhost dbport dboptions
     dbname dbuser dbpasswd email fax name numberformat password
     currency dateformat dbconnect dbdriver dbhost dbport dboptions
     dbname dbuser dbpasswd email fax name numberformat password

-    printer role sid signature stylesheet tel templates vclimit angebote bestellungen rechnungen
-    anfragen lieferantenbestellungen einkaufsrechnungen steuernummer ustid duns);
+    printer role sid signature stylesheet tel templates vclimit angebote
+    bestellungen rechnungen anfragen lieferantenbestellungen einkaufsrechnungen
+    taxnumber co_ustid duns menustyle template_format default_media
+    default_printer_id copies show_form_details favorites
+    pdonumber sdonumber hide_cvar_search_options mandatory_departments);

 
   $main::lxdebug->leave_sub();
 
 
   $main::lxdebug->leave_sub();
 


@@ -853,6 +1012,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