X-Git-Url: http://wagnertech.de/git?a=blobdiff_plain;f=SL%2FUser.pm;h=368a0a278ef869b75fc6f999c5bb1db64ab48742;hb=c8e0c77f4da1fe14f1294a3be2e437c24f40eaea;hp=838b6a69630dcaf6cf29aa840ca1a924ecec4284;hpb=8b39e3893d7e9061c0e8142aca681c90f137bf30;p=kivitendo-erp.git diff --git a/SL/User.pm b/SL/User.pm index 838b6a696..368a0a278 100644 --- a/SL/User.pm +++ b/SL/User.pm @@ -38,6 +38,7 @@ use IO::File; use Fcntl qw(:seek); #use SL::Auth; +use SL::DBConnect; use SL::DBUpgrade2; use SL::DBUtils; use SL::Iconv; @@ -48,12 +49,12 @@ use strict; sub new { $main::lxdebug->enter_sub(); - my ($type, $login) = @_; + my ($type, %params) = @_; my $self = {}; - if ($login ne "") { - my %user_data = $main::auth->read_user($login); + if ($params{id} || $params{login}) { + my %user_data = $main::auth->read_user(%params); map { $self->{$_} = $user_data{$_} } keys %user_data; } @@ -76,9 +77,9 @@ sub country_codes { my @dir = grep(!/(^\.\.?$|\..*)/, readdir(DIR)); foreach my $dir (@dir) { - next unless open(FH, "locale/$dir/LANGUAGE"); - @language = ; - close FH; + next unless open(my $fh, '<:encoding(UTF-8)', "locale/$dir/LANGUAGE"); + @language = <$fh>; + close $fh; $cc{$dir} = "@language"; } @@ -101,12 +102,10 @@ sub login { my $rc = -3; if ($self->{login}) { - my %myconfig = $main::auth->read_user($self->{login}); + my %myconfig = $main::auth->read_user(login => $self->{login}); # check if database is down - my $dbh = - DBI->connect($myconfig{dbconnect}, $myconfig{dbuser}, - $myconfig{dbpasswd}) + my $dbh = SL::DBConnect->connect($myconfig{dbconnect}, $myconfig{dbuser}, $myconfig{dbpasswd}) or $self->error($DBI::errstr); # we got a connection, check the version @@ -121,20 +120,22 @@ sub login { $self->create_schema_info_table($form, $dbh); - $dbh->disconnect; + my $dbupdater_auth = SL::DBUpgrade2->new(form => $form, dbdriver => 'Pg', auth => 1)->parse_dbupdate_controls; + if ($dbupdater_auth->unapplied_upgrade_scripts($::auth->dbconnect)) { + $::lxdebug->leave_sub; + return -3; + } $rc = 0; - my $dbupdater = SL::DBUpgrade2->new($form, $myconfig{"dbdriver"}); - my $controls = $dbupdater->parse_dbupdate_controls; + 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; - $form->{"stylesheet"} = "lx-office-erp.css"; + if ($update_available) { $form->{"title"} = $main::locale->text("Dataset upgrade"); $form->header(); print $form->parse_html_template("dbupgrade/header"); @@ -148,10 +149,10 @@ sub login { } # update the tables - if (!open(FH, ">$main::userspath/nologin")) { + if (!$::lx_office_conf{debug}->{keep_installation_unlocked} && !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); } @@ -164,23 +165,16 @@ sub login { $self->dbupdate($form); $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"); - - 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"; + unlink($::lx_office_conf{paths}->{userspath} . "/nologin"); - print $form->parse_html_template("dbupgrade/footer", { "menufile" => $menufile }); + print $form->parse_html_template("dbupgrade/footer"); $rc = -2; - } } @@ -198,18 +192,14 @@ sub dbconnect_vars { 'Pg' => { 'yy-mm-dd' => 'set DateStyle to \'ISO\'', 'yyyy-mm-dd' => 'set DateStyle to \'ISO\'', 'mm/dd/yy' => 'set DateStyle to \'SQL, US\'', - 'mm-dd-yy' => 'set DateStyle to \'POSTGRES, US\'', 'dd/mm/yy' => 'set DateStyle to \'SQL, EUROPEAN\'', - 'dd-mm-yy' => 'set DateStyle to \'POSTGRES, EUROPEAN\'', 'dd.mm.yy' => 'set DateStyle to \'GERMAN\'' }, 'Oracle' => { 'yy-mm-dd' => 'ALTER SESSION SET NLS_DATE_FORMAT = \'YY-MM-DD\'', 'yyyy-mm-dd' => 'ALTER SESSION SET NLS_DATE_FORMAT = \'YYYY-MM-DD\'', 'mm/dd/yy' => 'ALTER SESSION SET NLS_DATE_FORMAT = \'MM/DD/YY\'', - 'mm-dd-yy' => 'ALTER SESSION SET NLS_DATE_FORMAT = \'MM-DD-YY\'', 'dd/mm/yy' => 'ALTER SESSION SET NLS_DATE_FORMAT = \'DD/MM/YY\'', - 'dd-mm-yy' => 'ALTER SESSION SET NLS_DATE_FORMAT = \'DD-MM-YY\'', 'dd.mm.yy' => 'ALTER SESSION SET NLS_DATE_FORMAT = \'DD.MM.YY\'', }); @@ -255,8 +245,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') { @@ -273,8 +262,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 = @@ -329,7 +317,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(); @@ -347,7 +335,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 = ( @@ -389,13 +377,13 @@ 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}); + my $dbupdater = SL::DBUpgrade2->new(form => $form, dbdriver => $form->{dbdriver}); # create the tables $dbupdater->process_query($dbh, "sql/lx-office.sql", undef, $db_charset); @@ -404,6 +392,12 @@ sub dbcreate { $query = "UPDATE defaults SET coa = ?"; do_query($form, $dbh, $query, $form->{chart}); + $query = "UPDATE defaults SET accounting_method = ?"; + do_query($form, $dbh, $query, $form->{accounting_method}); + $query = "UPDATE defaults SET profit_determination = ?"; + do_query($form, $dbh, $query, $form->{profit_determination}); + $query = "UPDATE defaults SET inventory_system = ?"; + do_query($form, $dbh, $query, $form->{inventory_system}); $dbh->disconnect; @@ -420,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); @@ -456,8 +449,8 @@ sub dbneedsupdate { my ($self, $form) = @_; - my %members = $main::auth->read_all_users(); - my $controls = SL::DBUpgrade2->new($form, $form->{dbdriver})->parse_dbupdate_controls; + 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); @@ -467,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; @@ -479,11 +472,13 @@ sub dbneedsupdate { ($version) = $sth->fetchrow_array(); } $sth->finish(); - $dbh->disconnect(); - next unless $version; + $dbh->disconnect and next unless $version; - if (update_available($form->{dbdriver}, $version) || update2_available($form, $controls)) { + my $update_available = $dbupdater->update_available($version) || $dbupdater->update2_available($dbh); + $dbh->disconnect; + + if ($update_available) { my $dbinfo = {}; map { $dbinfo->{$_} = $member->{$_} } grep /^db/, keys %{ $member }; $dbs_needing_updates{$member->{dbhost} . "::" . $member->{dbname}} = $dbinfo; @@ -537,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(); @@ -594,10 +577,10 @@ 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}); + my $dbupdater = SL::DBUpgrade2->new(form => $form, dbdriver => $form->{dbdriver}); foreach my $db (split(/ /, $form->{dbupdate})) { @@ -607,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}); @@ -624,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; @@ -638,11 +619,7 @@ sub dbupdate { # apply upgrade $main::lxdebug->message(LXDebug->DEBUG2(), "Applying Update $upgradescript"); - if ($file_type eq "sql") { - $dbupdater->process_query($dbh, "sql/" . $form->{"dbdriver"} . "-upgrade/$upgradescript", $str_maxdb, $db_charset); - } else { - $dbupdater->process_perl_script($dbh, "sql/" . $form->{"dbdriver"} . "-upgrade/$upgradescript", $str_maxdb, $db_charset); - } + $dbupdater->process_file($dbh, "sql/" . $form->{"dbdriver"} . "-upgrade/$upgradescript", $str_maxdb, $db_charset); $version = $maxdb; @@ -665,68 +642,34 @@ sub dbupdate2 { $form->{sid} = $form->{dbdefault}; - my @upgradescripts = (); - my ($query, $sth, $tag); - my $rc = -2; - - @upgradescripts = $dbupdater->sort_dbupdate_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()) { - $dbupdater->{all_controls}->{$tag}->{"applied"} = 1 if (defined($dbupdater->{all_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}"); print $form->parse_html_template("dbupgrade/upgrade_message2", $control); - if ($file_type eq "sql") { - $dbupdater->process_query($dbh, "sql/" . $form->{"dbdriver"} . "-upgrade2/$control->{file}", $control, $db_charset); - } else { - $dbupdater->process_perl_script($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; @@ -739,43 +682,10 @@ 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(); my ($self) = @_; - my $form = \%main::form; # format dbconnect and dboptions string dbconnect_vars($self, $self->{dbname}); @@ -784,9 +694,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, 1); + $self->create_employee_entry($::form, $dbh, $self, 1); $dbh->disconnect(); } @@ -809,14 +719,17 @@ sub create_employee_entry { # 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}); + my ($id) = selectrow_query($form, $dbh, qq|SELECT id FROM employee WHERE login = ?|, $self->{login}); + my ($good_db) = selectrow_query($form, $dbh, qq|select * from pg_tables where tablename = ? and schemaname = ?|, 'schema_info', 'public'); + my $can_delete; + ($can_delete) = selectrow_query($form, $dbh, qq|SELECT tag FROM schema_info WHERE tag = ?|, 'employee_deleted') if $good_db; 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 = ?|; + } elsif ($update_existing && $can_delete) { + my $query = qq|UPDATE employee SET name = ?, workphone = ?, role = 'user', deleted = 'f' WHERE id = ?|; do_query($form, $dbh, $query, $myconfig->{name}, $myconfig->{tel}, $id); } @@ -829,12 +742,12 @@ sub config_vars { my @conf = qw(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 + printer 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 - sepa_creditor_id); + sepa_creditor_id taxincluded_checked); $main::lxdebug->leave_sub(); @@ -865,5 +778,8 @@ sub error { $main::lxdebug->leave_sub(); } -1; +sub data { + +{ %{ $_[0] } } +} +1;