X-Git-Url: http://wagnertech.de/git?a=blobdiff_plain;f=SL%2FUser.pm;h=d6b870552c37f6aedcde7650a7177183f8ca2804;hb=b354d72972e377a3007f8f03ad9b719488c4b3bf;hp=a50ca969804d812c5462e8b20dff806bd9dbadb8;hpb=b8da8785c1b6d313518202acb307adfb50ebdb65;p=kivitendo-erp.git
diff --git a/SL/User.pm b/SL/User.pm
index a50ca9698..d6b870552 100644
--- a/SL/User.pm
+++ b/SL/User.pm
@@ -34,17 +34,18 @@
package User;
-use strict;
-
use IO::File;
use Fcntl qw(:seek);
-use SL::Auth;
+#use SL::Auth;
+use SL::DBConnect;
use SL::DBUpgrade2;
use SL::DBUtils;
use SL::Iconv;
use SL::Inifile;
+use strict;
+
sub new {
$main::lxdebug->enter_sub();
@@ -104,10 +105,8 @@ sub login {
my %myconfig = $main::auth->read_user($self->{login});
# check if database is down
- my $dbh =
- DBI->connect($myconfig{dbconnect}, $myconfig{dbuser},
- $myconfig{dbpasswd})
- or $self->error(DBI::errstr);
+ my $dbh = SL::DBConnect->connect($myconfig{dbconnect}, $myconfig{dbuser}, $myconfig{dbpasswd})
+ or $self->error($DBI::errstr);
# we got a connection, check the version
my $query = qq|SELECT version FROM defaults|;
@@ -121,19 +120,16 @@ sub login {
$self->create_schema_info_table($form, $dbh);
- $dbh->disconnect;
-
$rc = 0;
- my $controls =
- parse_dbupdate_controls($form, $myconfig{"dbdriver"});
+ my $dbupdater = SL::DBUpgrade2->new(form => $form, dbdriver => $myconfig{dbdriver})->parse_dbupdate_controls;
- map({ $form->{$_} = $myconfig{$_} }
- qw(dbname dbhost dbport dbdriver dbuser dbpasswd dbconnect dateformat));
-
- if (update_available($myconfig{"dbdriver"}, $dbversion) ||
- update2_available($form, $controls)) {
+ map({ $form->{$_} = $myconfig{$_} } qw(dbname dbhost dbport dbdriver dbuser dbpasswd dbconnect dateformat));
+ dbconnect_vars($form, $form->{dbname});
+ my $update_available = $dbupdater->update_available($dbversion) || $dbupdater->update2_available($dbh);
+ $dbh->disconnect;
+ if ($update_available) {
$form->{"stylesheet"} = "lx-office-erp.css";
$form->{"title"} = $main::locale->text("Dataset upgrade");
$form->header();
@@ -144,14 +140,14 @@ sub login {
if ($form->{"show_dbupdate_warning"}) {
print $form->parse_html_template("dbupgrade/warning");
- exit(0);
+ ::end_of_request();
}
# update the tables
- if (!open(FH, ">$main::userspath/nologin")) {
+ if (!open(FH, ">" . $::lx_office_conf{paths}->{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),
+ $::lx_office_conf{paths}->{userspath}),
'back_button' => 1);
}
@@ -163,23 +159,24 @@ sub login {
$SIG{QUIT} = 'IGNORE';
$self->dbupdate($form);
- $self->dbupdate2($form, $controls);
+ $self->dbupdate2($form, $dbupdater);
+ SL::DBUpgrade2->new(form => $::form, dbdriver => 'Pg', auth => 1)->apply_admin_dbupgrade_scripts(0);
close(FH);
# remove lock file
- unlink("$main::userspath/nologin");
+ unlink($::lx_office_conf{paths}->{userspath} . "/nologin");
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;
-
}
}
@@ -254,8 +251,7 @@ sub dbsources {
$form->{sid} = $form->{dbdefault};
&dbconnect_vars($form, $form->{dbdefault});
- my $dbh =
- DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
+ my $dbh = SL::DBConnect->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
or $form->dberror;
if ($form->{dbdriver} eq 'Pg') {
@@ -272,8 +268,7 @@ sub dbsources {
next if ($db =~ /^template/);
&dbconnect_vars($form, $db);
- my $dbh =
- DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
+ my $dbh = SL::DBConnect->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
or $form->dberror;
$query =
@@ -328,7 +323,7 @@ sub dbclusterencoding {
dbconnect_vars($form, $form->{dbdefault});
- my $dbh = DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}) || $form->dberror();
+ my $dbh = SL::DBConnect->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();
@@ -346,7 +341,7 @@ sub dbcreate {
$form->{sid} = $form->{dbdefault};
&dbconnect_vars($form, $form->{dbdefault});
my $dbh =
- DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
+ SL::DBConnect->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
or $form->dberror;
$form->{db} =~ s/\"//g;
my %dbcreate = (
@@ -388,17 +383,18 @@ sub dbcreate {
&dbconnect_vars($form, $form->{db});
- $dbh = DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
+ $dbh = SL::DBConnect->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;
+ my $dbupdater = SL::DBUpgrade2->new(form => $form, dbdriver => $form->{dbdriver});
# create the tables
- $self->process_query($form, $dbh, "sql/lx-office.sql", undef, $db_charset);
+ $dbupdater->process_query($dbh, "sql/lx-office.sql", undef, $db_charset);
# load chart of accounts
- $self->process_query($form, $dbh, "sql/$form->{chart}-chart.sql", undef, $db_charset);
+ $dbupdater->process_query($dbh, "sql/$form->{chart}-chart.sql", undef, $db_charset);
$query = "UPDATE defaults SET coa = ?";
do_query($form, $dbh, $query, $form->{chart});
@@ -408,168 +404,6 @@ sub dbcreate {
$main::lxdebug->leave_sub();
}
-# 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 exit".
-# All other return codes are fatal errors.
-sub process_perl_script {
- $main::lxdebug->enter_sub();
-
- 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();
-
- my %dbup_myconfig = ();
- map({ $dbup_myconfig{$_} = $form->{$_}; }
- qw(dbname dbuser dbpasswd dbhost dbport dbconnect));
-
- my $nls_file = $filename;
- $nls_file =~ s|.*/||;
- $nls_file =~ s|.pl$||;
- my $dbup_locale = Locale->new($main::language, $nls_file);
-
- my $result = eval($contents);
-
- if (1 != $result) {
- $dbh->rollback();
- $dbh->disconnect();
- }
-
- if (!defined($result)) {
- print $form->parse_html_template("dbupgrade/error",
- { "file" => $filename,
- "error" => $@ });
- exit(0);
- } elsif (1 != $result) {
- unlink("users/nologin") if (2 == $result);
- exit(0);
- }
-
- 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();
-
- my ($self, $form, $dbh, $filename, $version_or_control, $db_charset) = @_;
-
- 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>) {
- $_ = SL::Iconv::convert($file_charset, $db_charset, $_);
-
- # Remove DOS and Unix style line endings.
- chomp;
-
- # remove comments
- s/--.*$//;
-
- for (my $i = 0; $i < length($_); $i++) {
- my $char = substr($_, $i, 1);
-
- # Are we inside a string?
- if (@quote_chars) {
- if ($char eq $quote_chars[-1]) {
- pop(@quote_chars);
- }
- $query .= $char;
-
- } else {
- if (($char eq "'") || ($char eq "\"")) {
- push(@quote_chars, $char);
-
- } elsif ($char eq ";") {
-
- # Query is complete. Send it.
-
- $sth = $dbh->prepare($query);
- 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:
${query}
" .
- "The error message was: ${errstr}
" .
- "All changes in that file have been reverted.");
- }
- $sth->finish();
-
- $char = "";
- $query = "";
- }
-
- $query .= $char;
- }
- }
- }
-
- 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();
-}
-
sub dbdelete {
$main::lxdebug->enter_sub();
@@ -580,8 +414,7 @@ sub dbdelete {
$form->{sid} = $form->{dbdefault};
&dbconnect_vars($form, $form->{dbdefault});
- my $dbh =
- DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
+ my $dbh = SL::DBConnect->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
or $form->dberror;
my $query = $dbdelete{$form->{dbdriver}};
do_query($form, $dbh, $query);
@@ -616,8 +449,8 @@ sub dbneedsupdate {
my ($self, $form) = @_;
- my %members = $main::auth->read_all_users();
- my $controls = parse_dbupdate_controls($form, $form->{dbdriver});
+ my %members = $main::auth->read_all_users();
+ my $dbupdater = SL::DBUpgrade2->new(form => $form, dbdriver => $form->{dbdriver})->parse_dbupdate_controls;
my ($query, $sth, %dbs_needing_updates);
@@ -627,7 +460,7 @@ sub dbneedsupdate {
map { $form->{$_} = $member->{$_} } qw(dbname dbuser dbpasswd dbhost dbport);
dbconnect_vars($form, $form->{dbname});
- my $dbh = DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd});
+ my $dbh = SL::DBConnect->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd});
next unless $dbh;
@@ -639,11 +472,13 @@ sub dbneedsupdate {
($version) = $sth->fetchrow_array();
}
$sth->finish();
- $dbh->disconnect();
- next unless $version;
+ $dbh->disconnect and next unless $version;
+
+ my $update_available = $dbupdater->update_available($version) || $dbupdater->update2_available($dbh);
+ $dbh->disconnect;
- if (update_available($form->{dbdriver}, $version) || update2_available($form, $controls)) {
+ if ($update_available) {
my $dbinfo = {};
map { $dbinfo->{$_} = $member->{$_} } grep /^db/, keys %{ $member };
$dbs_needing_updates{$member->{dbhost} . "::" . $member->{dbname}} = $dbinfo;
@@ -697,18 +532,6 @@ sub cmp_script_version {
return $res_a <=> $res_b;
}
-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();
@@ -754,9 +577,11 @@ sub dbupdate {
closedir(SQLDIR);
}
- my $db_charset = $main::dbcharset;
+ my $db_charset = $::lx_office_conf{system}->{dbcharset};
$db_charset ||= Common::DEFAULT_CHARSET;
+ my $dbupdater = SL::DBUpgrade2->new(form => $form, dbdriver => $form->{dbdriver});
+
foreach my $db (split(/ /, $form->{dbupdate})) {
next unless $form->{$db};
@@ -765,8 +590,7 @@ sub dbupdate {
$db =~ s/^db//;
&dbconnect_vars($form, $db);
- my $dbh =
- DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
+ my $dbh = SL::DBConnect->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
or $form->dberror;
$dbh->do($form->{dboptions}) if ($form->{dboptions});
@@ -782,7 +606,6 @@ sub dbupdate {
foreach my $upgradescript (@upgradescripts) {
my $a = $upgradescript;
$a =~ s/^\Q$form->{dbdriver}\E-upgrade-|\.(sql|pl)$//g;
- my $file_type = $1;
my ($mindb, $maxdb) = split /-/, $a;
my $str_maxdb = $maxdb;
@@ -795,14 +618,8 @@ sub dbupdate {
last if ($version < $mindb);
# apply upgrade
- $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);
- }
+ $main::lxdebug->message(LXDebug->DEBUG2(), "Applying Update $upgradescript");
+ $dbupdater->process_file($dbh, "sql/" . $form->{"dbdriver"} . "-upgrade/$upgradescript", $str_maxdb, $db_charset);
$version = $maxdb;
@@ -821,74 +638,38 @@ sub dbupdate {
sub dbupdate2 {
$main::lxdebug->enter_sub();
- my ($self, $form, $controls) = @_;
+ my ($self, $form, $dbupdater) = @_;
$form->{sid} = $form->{dbdefault};
- my @upgradescripts = ();
- my ($query, $sth, $tag);
- my $rc = -2;
-
- @upgradescripts = sort_dbupdate_controls($controls);
+ my $rc = -2;
+ my $db_charset = $::lx_office_conf{system}->{dbcharset} || Common::DEFAULT_CHARSET;
- my $db_charset = $main::dbcharset;
- $db_charset ||= Common::DEFAULT_CHARSET;
+ map { $_->{description} = SL::Iconv::convert($_->{charset}, $db_charset, $_->{description}) } values %{ $dbupdater->{all_controls} };
foreach my $db (split / /, $form->{dbupdate}) {
-
next unless $form->{$db};
# strip db from dataset
$db =~ s/^db//;
&dbconnect_vars($form, $db);
- my $dbh =
- DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
- or $form->dberror;
+ my $dbh = SL::DBConnect->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}) or $form->dberror;
$dbh->do($form->{dboptions}) if ($form->{dboptions});
- 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);
- while (($tag) = $sth->fetchrow_array()) {
- $controls->{$tag}->{"applied"} = 1 if (defined($controls->{$tag}));
- }
- $sth->finish();
+ my @upgradescripts = $dbupdater->unapplied_upgrade_scripts($dbh);
- my $all_applied = 1;
- foreach (@upgradescripts) {
- if (!$_->{"applied"}) {
- $all_applied = 0;
- last;
- }
- }
-
- next if ($all_applied);
+ $dbh->disconnect and next if !@upgradescripts;
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;
-
# apply upgrade
- $main::lxdebug->message(LXDebug::DEBUG2, "Applying Update $control->{file}");
+ $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);
- }
+ $dbupdater->process_file($dbh, "sql/" . $form->{"dbdriver"} . "-upgrade2/$control->{file}", $control, $db_charset);
}
$rc = 0;
@@ -901,38 +682,6 @@ sub dbupdate2 {
return $rc;
}
-sub update2_available {
- $main::lxdebug->enter_sub();
-
- 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();
-
- 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();
@@ -946,9 +695,9 @@ sub save_member {
$main::auth->save_user($self->{login}, map { $_, $self->{$_} } config_vars());
- my $dbh = DBI->connect($self->{dbconnect}, $self->{dbuser}, $self->{dbpasswd});
+ my $dbh = SL::DBConnect->connect($self->{dbconnect}, $self->{dbuser}, $self->{dbpasswd});
if ($dbh) {
- $self->create_employee_entry($form, $dbh, $self);
+ $self->create_employee_entry($form, $dbh, $self, 1);
$dbh->disconnect();
}
@@ -958,18 +707,28 @@ sub save_member {
sub create_employee_entry {
$main::lxdebug->enter_sub();
- my $self = shift;
- my $form = shift;
- my $dbh = shift;
- my $myconfig = shift;
+ 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;
+ }
# add login to employee table if it does not exist
# no error check for employee table, ignore if it does not exist
- my ($login) = selectrow_query($form, $dbh, qq|SELECT id FROM employee WHERE login = ?|, $self->{login});
+ my ($id) = selectrow_query($form, $dbh, qq|SELECT id FROM employee WHERE login = ?|, $self->{login});
- if (!$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();
@@ -985,7 +744,8 @@ sub config_vars {
bestellungen rechnungen anfragen lieferantenbestellungen einkaufsrechnungen
taxnumber co_ustid duns menustyle template_format default_media
default_printer_id copies show_form_details favorites
- pdonumber sdonumber);
+ pdonumber sdonumber hide_cvar_search_options mandatory_departments
+ sepa_creditor_id);
$main::lxdebug->leave_sub();