X-Git-Url: http://wagnertech.de/git?a=blobdiff_plain;f=SL%2FUser.pm;h=46fe855810691cc738cfbfd941f28db0a14324dc;hb=4fd22b569d4436293e0a9d364d7356b5bfc503e5;hp=9fa0035c65678a89b6aeac48a1b69c62a4d2f2a2;hpb=e848dbf1f17a606e22afb161cb3fb7bd88895f92;p=kivitendo-erp.git diff --git a/SL/User.pm b/SL/User.pm index 9fa0035c6..46fe85581 100644 --- a/SL/User.pm +++ b/SL/User.pm @@ -34,60 +34,46 @@ 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 () { - if (/^\[$login\]/) { - while () { - 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(); + 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 - 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"); @@ -107,33 +93,21 @@ sub country_codes { sub login { $main::lxdebug->enter_sub(); - my ($self, $form, $userspath) = @_; + my ($self, $form) = @_; + our $sid; + + local *FH; 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}) - or $self->error(DBI::errstr); + or $self->error($DBI::errstr); # 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; - # 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; - 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->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; @@ -184,11 +163,21 @@ $!"; $SIG{QUIT} = 'IGNORE'; $self->dbupdate($form); + $self->dbupdate2($form, $controls); + + close(FH); # 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; @@ -271,10 +260,11 @@ sub dbsources { 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) { @@ -287,28 +277,29 @@ sub dbsources { 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); - $sth->execute || $form->dberror($query); + $sth->execute($form->{dbuser}) || + $form->dberror($query . " ($form->{dbuser})"); if ($sth->fetchrow_array) { - push @dbsources, $db; + push(@dbsources, $db); } $sth->finish; $dbh->disconnect; next; } - push @dbsources, $db; + push(@dbsources, $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|; } @@ -317,7 +308,7 @@ sub dbsources { $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; } -sub dbcreate { +sub dbclusterencoding { $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; - 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') { - $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; @@ -367,48 +392,127 @@ sub dbcreate { $dbh = DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}) or $form->dberror; - # create the tables - my $filename = qq|sql/lx-office.sql|; - $self->process_query($form, $dbh, $filename); + my $db_charset = $Common::db_encoding_to_charset{$form->{encoding}}; + $db_charset ||= Common::DEFAULT_CHARSET; - # load gifi - ($filename) = split /_/, $form->{chart}; - $filename =~ s/_//; - $self->process_query($form, $dbh, "sql/${filename}-gifi.sql"); + # create the tables + $self->process_query($form, $dbh, "sql/lx-office.sql", undef, $db_charset); # load chart of accounts - $filename = qq|sql/$form->{chart}-chart.sql|; - $self->process_query($form, $dbh, $filename); + $self->process_query($form, $dbh, "sql/$form->{chart}-chart.sql", undef, $db_charset); - # 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(); } -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(); - 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; - while () { + 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. - 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); @@ -429,8 +533,17 @@ sub process_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:
${query}
" . + "The error message was: ${errstr}
" . + "All changes in that file have been reverted."); + } + $sth->finish(); $char = ""; $query = ""; @@ -439,9 +552,25 @@ sub process_query { $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(); } @@ -450,17 +579,17 @@ sub dbdelete { $main::lxdebug->enter_sub(); my ($self, $form) = @_; - + $form->{db} =~ s/\"//g; 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; - my $query = qq|$dbdelete{$form->{dbdriver}}|; - $dbh->do($query) || $form->dberror($query); + my $query = $dbdelete{$form->{dbdriver}}; + do_query($form, $dbh, $query); $dbh->disconnect; @@ -470,39 +599,21 @@ sub dbdelete { 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 () { - if (/^dbname=/) { - my ($null, $item) = split /=/; - push @dbexcl, $item; - } - } - - close FH; + my ($self, $form) = @_; $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(); - return @dbsources; + return @dbunused; } sub dbneedsupdate { @@ -510,95 +621,47 @@ sub dbneedsupdate { 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(); - return %dbsources; + return values %dbs_needing_updates; } -## LINET sub calc_version { - $main::lxdebug->enter_sub(); + $main::lxdebug->enter_sub(2); my (@v, $version, $i); @@ -612,7 +675,7 @@ sub calc_version { $version += $v[$i]; } - $main::lxdebug->leave_sub(); + $main::lxdebug->leave_sub(2); return $version; } @@ -625,8 +688,8 @@ sub cmp_script_version { $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); @@ -638,13 +701,46 @@ sub cmp_script_version { 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) = @_; + local *SQLDIR; + $form->{sid} = $form->{dbdefault}; my @upgradescripts = (); @@ -654,16 +750,19 @@ sub dbupdate { 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 - 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}; @@ -675,31 +774,25 @@ sub dbupdate { 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|; - 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; - ## LINET $version = calc_version($version); - ## /LINET 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; - ## LINET + my $str_maxdb = $maxdb; $mindb = calc_version($mindb); $maxdb = calc_version($maxdb); - ## /LINET next if ($version >= $maxdb); @@ -707,7 +800,14 @@ sub dbupdate { 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; @@ -723,113 +823,169 @@ sub dbupdate { return $rc; } -sub create_config { +sub dbupdate2 { $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 = ; + 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(); } @@ -837,11 +993,14 @@ sub save_member { 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 - printer role sid signature stylesheet tel templates vclimit angebote bestellungen rechnungen - anfragen lieferantenbestellungen einkaufsrechnungen steuernummer ustid duns menustyle); + 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(); @@ -853,6 +1012,8 @@ sub error { my ($self, $msg) = @_; + $main::lxdebug->show_backtrace(); + if ($ENV{HTTP_USER_AGENT}) { print qq|Content-Type: text/html