X-Git-Url: http://wagnertech.de/git?a=blobdiff_plain;f=SL%2FUser.pm;h=3b36f310c28be9c229ea34c792309c243ee016c8;hb=fe3df36071968d9f22c33f40adfc87717a578b1b;hp=d50d1c9ecf689b9d711b9737983df771b22b7a4a;hpb=4dbb09950c9f5596646537c12d991c99086fe7c1;p=kivitendo-erp.git diff --git a/SL/User.pm b/SL/User.pm index d50d1c9ec..3b36f310c 100644 --- a/SL/User.pm +++ b/SL/User.pm @@ -18,7 +18,7 @@ # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # (at your option) any later version. -# +# # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the @@ -34,6 +34,8 @@ package User; +use SL::DBUpgrade2; + sub new { $main::lxdebug->enter_sub(); @@ -42,55 +44,53 @@ sub new { 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)/; - - # remove comments - s/\s#.*//g; + while () { + last if /^\[/; + next if /^(#|\s)/; - # remove any trailing whitespace - s/^\s*(.*?)\s*$/$1/; + # remove comments + s/\s#.*//g; - ($key, $value) = split /=/, $_, 2; + # remove any trailing whitespace + s/^\s*(.*?)\s*$/$1/; - if (($key eq "stylesheet") && ($value eq "sql-ledger.css")) { - $value = "lx-office-erp.css"; - } + ($key, $value) = split(/=/, $_, 2); + + if (($key eq "stylesheet") && ($value eq "sql-ledger.css")) { + $value = "lx-office-erp.css"; + } + + $self->{$key} = $value; + } - $self->{$key} = $value; - } - - $self->{login} = $login; + $self->{login} = $login; - last; + last; } } close MEMBER; } - + $main::lxdebug->leave_sub(); bless $self, $type; } - sub country_codes { $main::lxdebug->enter_sub(); - - my %cc = (); + my %cc = (); my @language = (); - + # scan the locale directory and read in the LANGUAGE files opendir DIR, "locale"; my @dir = grep !/(^\.\.?$|\..*)/, readdir DIR; - + foreach my $dir (@dir) { next unless open(FH, "locale/$dir/LANGUAGE"); @language = ; @@ -100,43 +100,50 @@ sub country_codes { } closedir(DIR); - + $main::lxdebug->leave_sub(); return %cc; } - sub login { $main::lxdebug->enter_sub(); my ($self, $form, $userspath) = @_; my $rc = -3; - + if ($self->{login}) { - + if ($self->{password}) { - $form->{password} = crypt $form->{password}, substr($self->{login}, 0, 2); + if ($form->{hashed_password}) { + $form->{password} = $form->{hashed_password}; + } else { + $form->{password} = crypt($form->{password}, + substr($self->{login}, 0, 2)); + } if ($self->{password} ne $form->{password}) { $main::lxdebug->leave_sub(); - return -1; + 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}; - + # check if database is down - my $dbh = DBI->connect($myconfig{dbconnect}, $myconfig{dbuser}, $myconfig{dbpasswd}) or $self->error(DBI::errstr); + my $dbh = + DBI->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|; - my $sth = $dbh->prepare($query); + my $sth = $dbh->prepare($query); $sth->execute || $form->dberror($query); my ($dbversion) = $sth->fetchrow_array; @@ -145,7 +152,7 @@ sub login { # 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 = $dbh->prepare($query); $sth->execute; my ($login) = $sth->fetchrow_array; @@ -157,35 +164,52 @@ sub login { '$myconfig{tel}', 'user')|; $dbh->do($query); } + + $self->create_schema_info_table($form, $dbh); + $dbh->disconnect; $rc = 0; - if ($form->{dbversion} ne $dbversion) { - # update the tables - open FH, ">$userspath/nologin" or die " -$!"; + my $controls = + parse_dbupdate_controls($form, $myconfig{"dbdriver"}); + + map({ $form->{$_} = $myconfig{$_} } + qw(dbname dbhost dbport dbdriver dbuser dbpasswd dbconnect)); + + 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")); - map { $form->{$_} = $myconfig{$_} } qw(dbname dbhost dbport dbdriver dbuser dbpasswd); - $form->{dbupdate} = "db$myconfig{dbname}"; - $form->{$form->{dbupdate}} = 1; + $form->{ $form->{dbupdate} } = 1; + + if ($form->{"show_dbupdate_warning"}) { + print($form->parse_html_template("dbupgrade/warning")); + exit(0); + } + + # update the tables + open(FH, ">$userspath/nologin") or die("$!"); - $form->info("Upgrading Dataset $myconfig{dbname} ..."); - # required for Oracle $form->{dbdefault} = $sid; # ignore HUP, QUIT in case the webserver times out - $SIG{HUP} = 'IGNORE'; + $SIG{HUP} = 'IGNORE'; $SIG{QUIT} = 'IGNORE'; - + $self->dbupdate($form); + $self->dbupdate2($form, $controls); # remove lock file - unlink "$userspath/nologin"; + unlink("$userspath/nologin"); - $form->info("... done"); + print($form->parse_html_template("dbupgrade/footer")); $rc = -2; @@ -197,35 +221,31 @@ $!"; return $rc; } - - sub dbconnect_vars { $main::lxdebug->enter_sub(); my ($form, $db) = @_; - + my %dboptions = ( - '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\'', - } - ); - - $form->{dboptions} = $dboptions{$form->{dbdriver}}{$form->{dateformat}}; + '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\'', + }); + + $form->{dboptions} = $dboptions{ $form->{dbdriver} }{ $form->{dateformat} }; if ($form->{dbdriver} eq 'Pg') { $form->{dbconnect} = "dbi:Pg:dbname=$db"; @@ -241,15 +261,13 @@ sub dbconnect_vars { if ($form->{dbport}) { $form->{dbconnect} .= ";port=$form->{dbport}"; } - + $main::lxdebug->leave_sub(); } - sub dbdrivers { $main::lxdebug->enter_sub(); - my @drivers = DBI->available_drivers(); $main::lxdebug->leave_sub(); @@ -257,7 +275,6 @@ sub dbdrivers { return (grep { /(Pg|Oracle)/ } @drivers); } - sub dbsources { $main::lxdebug->enter_sub(); @@ -265,41 +282,44 @@ sub dbsources { my @dbsources = (); my ($sth, $query); - + $form->{dbdefault} = $form->{dbuser} unless $form->{dbdefault}; $form->{sid} = $form->{dbdefault}; &dbconnect_vars($form, $form->{dbdefault}); - my $dbh = DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}) or $form->dberror; - + my $dbh = + DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}) + or $form->dberror; if ($form->{dbdriver} eq 'Pg') { - $query = qq|SELECT datname FROM pg_database|; - $sth = $dbh->prepare($query); + $query = qq|SELECT datname FROM pg_database WHERE NOT ((datname = 'template0') OR (datname = 'template1'))|; + $sth = $dbh->prepare($query); $sth->execute || $form->dberror($query); - + while (my ($db) = $sth->fetchrow_array) { if ($form->{only_acc_db}) { - - next if ($db =~ /^template/); - &dbconnect_vars($form, $db); - my $dbh = DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}) or $form->dberror; + next if ($db =~ /^template/); + + &dbconnect_vars($form, $db); + my $dbh = + DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}) + or $form->dberror; - $query = qq|SELECT p.tablename FROM pg_tables p + $query = qq|SELECT p.tablename FROM pg_tables p WHERE p.tablename = 'defaults' AND p.tableowner = '$form->{dbuser}'|; - my $sth = $dbh->prepare($query); - $sth->execute || $form->dberror($query); - - if ($sth->fetchrow_array) { - push @dbsources, $db; - } - $sth->finish; - $dbh->disconnect; - next; + my $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + if ($sth->fetchrow_array) { + push @dbsources, $db; + } + $sth->finish; + $dbh->disconnect; + next; } push @dbsources, $db; } @@ -324,27 +344,44 @@ sub dbsources { $sth->finish; $dbh->disconnect; - + $main::lxdebug->leave_sub(); return @dbsources; } - sub dbcreate { $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}"|); - - $dbcreate{Pg} .= " WITH ENCODING = '$form->{encoding}'" if $form->{encoding}; - $form->{sid} = $form->{dbdefault}; &dbconnect_vars($form, $form->{dbdefault}); - my $dbh = DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}) or $form->dberror; + my $dbh = + DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}) + or $form->dberror; + + my %dbcreate = ( + 'Pg' => qq|CREATE DATABASE "$form->{db}"|, + 'Oracle' => + qq|CREATE USER "$form->{db}" DEFAULT TABLESPACE USERS 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 = qq|$dbcreate{$form->{dbdriver}}|; + $query .= " WITH " . join(" ", @{$dboptions{"Pg"}}) if (@{$dboptions{"Pg"}}); + $dbh->do($query) || $form->dberror($query); if ($form->{dbdriver} eq 'Oracle') { @@ -353,18 +390,17 @@ sub dbcreate { } $dbh->disconnect; - # setup variables for the new database if ($form->{dbdriver} eq 'Oracle') { - $form->{dbuser} = $form->{db}; + $form->{dbuser} = $form->{db}; $form->{dbpasswd} = $form->{db}; } - - + &dbconnect_vars($form, $form->{db}); - - $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); @@ -378,36 +414,85 @@ sub dbcreate { $filename = qq|sql/$form->{chart}-chart.sql|; $self->process_query($form, $dbh, $filename); - # 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 = " . $dbh->quote($form->{"chart"}); + $dbh->do($query) || $form->dberror($query); + $dbh->disconnect; $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) = @_; + + open(FH, "$filename") or $form->error("$filename : $!\n"); + my $contents = join("", ); + close(FH); + + $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 ($version) { + $dbh->do("UPDATE defaults SET version = " . $dbh->quote($version)); + } + $dbh->commit(); + $main::lxdebug->leave_sub(); +} sub process_query { $main::lxdebug->enter_sub(); - my ($self, $form, $dbh, $filename) = @_; - -# return unless (-f $filename); - + my ($self, $form, $dbh, $filename, $version_or_control) = @_; + + # return unless (-f $filename); + open(FH, "$filename") or $form->error("$filename : $!\n"); my $query = ""; my $sth; my @quote_chars; + $dbh->begin_work(); + while () { + # 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); @@ -424,13 +509,21 @@ sub process_query { push(@quote_chars, $char); } elsif ($char eq ";") { + # Query is complete. Send it. $sth = $dbh->prepare($query); - $sth->execute || $form->dberror($query); - $sth->finish; - - $char = ""; + 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,25 +532,34 @@ sub process_query { } } + 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(); + close FH; $main::lxdebug->leave_sub(); } - - sub dbdelete { $main::lxdebug->enter_sub(); my ($self, $form) = @_; - my %dbdelete = ( 'Pg' => qq|DROP DATABASE "$form->{db}"|, - 'Oracle' => qq|DROP USER $form->{db} CASCADE| - ); - + my %dbdelete = ('Pg' => qq|DROP DATABASE "$form->{db}"|, + '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 $dbh = + DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}) + or $form->dberror; my $query = qq|$dbdelete{$form->{dbdriver}}|; $dbh->do($query) || $form->dberror($query); @@ -465,25 +567,23 @@ sub dbdelete { $main::lxdebug->leave_sub(); } - - sub dbsources_unused { $main::lxdebug->enter_sub(); my ($self, $form, $memfile) = @_; - my @dbexcl = (); + 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 /=/; + my ($null, $item) = split(/=/); push @dbexcl, $item; } } @@ -506,7 +606,6 @@ sub dbsources_unused { return @dbsources; } - sub dbneedsupdate { $main::lxdebug->enter_sub(); @@ -514,11 +613,13 @@ sub dbneedsupdate { my %dbsources = (); my $query; - + $form->{sid} = $form->{dbdefault}; &dbconnect_vars($form, $form->{dbdefault}); - my $dbh = DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}) or $form->dberror; + my $dbh = + DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}) + or $form->dberror; if ($form->{dbdriver} eq 'Pg') { @@ -527,14 +628,16 @@ sub dbneedsupdate { 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/); &dbconnect_vars($form, $db); - - my $dbh = DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}) or $form->dberror; + + my $dbh = + DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}) + or $form->dberror; $query = qq|SELECT t.tablename FROM pg_tables t WHERE t.tablename = 'defaults'|; @@ -542,14 +645,14 @@ sub dbneedsupdate { $sth->execute || $form->dberror($query); if ($sth->fetchrow_array) { - $query = qq|SELECT version FROM defaults|; - my $sth = $dbh->prepare($query); - $sth->execute; - - if (my ($version) = $sth->fetchrow_array) { - $dbsources{$db} = $version; - } - $sth->finish; + $query = qq|SELECT version FROM defaults|; + my $sth = $dbh->prepare($query); + $sth->execute; + + if (my ($version) = $sth->fetchrow_array) { + $dbsources{$db} = $version; + } + $sth->finish; } $sth->finish; $dbh->disconnect; @@ -557,7 +660,6 @@ sub dbneedsupdate { $sth->finish; } - if ($form->{dbdriver} eq 'Oracle') { $query = qq|SELECT o.owner FROM dba_objects o WHERE o.object_name = 'DEFAULTS' @@ -567,27 +669,29 @@ sub dbneedsupdate { $sth->execute || $form->dberror($query); while (my ($db) = $sth->fetchrow_array) { - + $form->{dbuser} = $db; &dbconnect_vars($form, $db); - - my $dbh = DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}) or $form->dberror; + + 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; - + if (my ($version) = $sth->fetchrow_array) { - $dbsources{$db} = $version; + $dbsources{$db} = $version; } $sth->finish; $dbh->disconnect; } $sth->finish; } - + $dbh->disconnect; - + $main::lxdebug->leave_sub(); return %dbsources; @@ -595,7 +699,7 @@ sub dbneedsupdate { ## LINET sub calc_version { - $main::lxdebug->enter_sub(); + $main::lxdebug->enter_sub(2); my (@v, $version, $i); @@ -609,7 +713,7 @@ sub calc_version { $version += $v[$i]; } - $main::lxdebug->leave_sub(); + $main::lxdebug->leave_sub(2); return $version; } @@ -637,27 +741,59 @@ sub cmp_script_version { } ## /LINET +sub update_available { + my ($dbdriver, $cur_version) = @_; + + opendir SQLDIR, "sql/${dbdriver}-upgrade" or &error("", "sql/${dbdriver}-upgrade: $!"); + my @upgradescripts = + grep(/$form->{dbdriver}-upgrade-\Q$cur_version\E.*\.(sql|pl)$/, readdir(SQLDIR)); + closedir SQLDIR; + + 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)) { + $query = + "CREATE TABLE schema_info (" . + " tag text, " . + " login text, " . + " itime timestamp DEFAULT now(), " . + " PRIMARY KEY (tag))"; + $dbh->do($query) || $form->dberror($query); + } + + $main::lxdebug->leave_sub(); +} + sub dbupdate { $main::lxdebug->enter_sub(); my ($self, $form) = @_; $form->{sid} = $form->{dbdefault}; - + my @upgradescripts = (); my $query; my $rc = -2; - + if ($form->{dbupdate}) { + # read update scripts into memory - opendir SQLDIR, "sql/." or $form-error($!); + opendir SQLDIR, "sql/" . $form->{dbdriver} . "-upgrade" or &error("", "sql/" . $form->{dbdriver} . "-upgrade : $!"); ## LINET - @upgradescripts = sort(cmp_script_version grep(/$form->{dbdriver}-upgrade-.*?\.sql$/, readdir(SQLDIR))); + @upgradescripts = + sort(cmp_script_version + grep(/$form->{dbdriver}-upgrade-.*?\.(sql|pl)$/, readdir(SQLDIR))); ## /LINET closedir SQLDIR; } - foreach my $db (split / /, $form->{dbupdate}) { next unless $form->{$db}; @@ -665,18 +801,21 @@ sub dbupdate { # 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 = + DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}) + or $form->dberror; # 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; - + next unless $version; ## LINET @@ -685,9 +824,11 @@ sub dbupdate { foreach my $upgradescript (@upgradescripts) { my $a = $upgradescript; - $a =~ s/^$form->{dbdriver}-upgrade-|\.sql$//g; - + $a =~ s/^$form->{dbdriver}-upgrade-|\.(sql|pl)$//g; + my $file_type = $1; + my ($mindb, $maxdb) = split /-/, $a; + my $str_maxdb = $maxdb; ## LINET $mindb = calc_version($mindb); $maxdb = calc_version($maxdb); @@ -699,34 +840,142 @@ sub dbupdate { last if ($version < $mindb); # apply upgrade - $self->process_query($form, $dbh, "sql/$upgradescript"); + $main::lxdebug->message(DEBUG2, "Applying Update $upgradescript"); + if ($file_type eq "sql") { + $self->process_query($form, $dbh, "sql/" . $form->{"dbdriver"} . "-upgrade/$upgradescript", $str_maxdb); + } else { + $self->process_perl_script($form, $dbh, "sql/" . $form->{"dbdriver"} . "-upgrade/$upgradescript", $str_maxdb); + } $version = $maxdb; - + } - + $rc = 0; $dbh->disconnect; - + } $main::lxdebug->leave_sub(); return $rc; } - +sub dbupdate2 { + $main::lxdebug->enter_sub(); + + my ($self, $form, $controls) = @_; + + $form->{sid} = $form->{dbdefault}; + + my @upgradescripts = (); + my ($query, $sth, $tag); + my $rc = -2; + + @upgradescripts = sort_dbupdate_controls($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; + + map({ $_->{"applied"} = 0; } @upgradescripts); + + $query = "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 $all_applied = 1; + foreach (@upgradescripts) { + if (!$_->{"applied"}) { + $all_applied = 0; + last; + } + } + + next if ($all_applied); + + foreach my $control (@upgradescripts) { + next if ($control->{"applied"}); + + $control->{"file"} =~ /\.(sql|pl)$/; + my $file_type = $1; + + # apply upgrade + $main::lxdebug->message(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); + } else { + $self->process_perl_script($form, $dbh, "sql/" . $form->{"dbdriver"} . + "-upgrade2/$control->{file}", $control); + } + } + + $rc = 0; + $dbh->disconnect; + + } + + $main::lxdebug->leave_sub(); + + 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 = "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(); + $dbh->disconnect(); + + map({ $main::lxdebug->leave_sub() and return 1 if (!$_->{"applied"}) } + values(%{$controls})); + + $main::lxdebug->leave_sub(); + return 0; +} sub create_config { $main::lxdebug->enter_sub(); my ($self, $filename) = @_; - @config = &config_vars; - + open(CONF, ">$filename") or $self->error("$filename : $!"); - + # create the config file print CONF qq|# configuration file for $self->{login} @@ -738,7 +987,6 @@ sub create_config { print CONF qq| $key => '$self->{$key}',\n|; } - print CONF qq|);\n\n|; close CONF; @@ -746,29 +994,27 @@ sub create_config { $main::lxdebug->leave_sub(); } - sub save_member { $main::lxdebug->enter_sub(); my ($self, $memberfile, $userspath) = @_; my $newmember = 1; - - + # format dbconnect and dboptions string &dbconnect_vars($self, $self->{dbname}); - + $self->error('File locked!') if (-f "${memberfile}.LCK"); open(FH, ">${memberfile}.LCK") or $self->error("${memberfile}.LCK : $!"); close(FH); - + open(CONF, "+<$memberfile") or $self->error("$memberfile : $!"); - + @config = ; - + seek(CONF, 0, 0); truncate(CONF, 0); - + while ($line = shift @config) { if ($line =~ /^\[$self->{login}\]/) { $newmember = 0; @@ -790,27 +1036,31 @@ sub save_member { } print CONF qq|[$self->{login}]\n|; - - if ((($self->{dbpasswd} ne $self->{old_dbpasswd}) || $newmember) && $self->{root}) { + + 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}; + $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}; + $self->{password} = crypt $self->{password}, substr($self->{login}, 0, 2) + if $self->{password}; } } - + if ($self->{'root login'}) { @config = ("password"); } else { @config = &config_vars; } - + # replace \r\n with \n map { $self->{$_} =~ s/\r\n/\\n/g } qw(address signature); foreach $key (sort @config) { @@ -820,30 +1070,29 @@ sub save_member { print CONF "\n"; close CONF; unlink "${memberfile}.LCK"; - + # create conf file - $self->create_config("$userspath/$self->{login}.conf") unless $self->{'root login'}; - + $self->create_config("$userspath/$self->{login}.conf") + unless $self->{'root login'}; + $main::lxdebug->leave_sub(); } - sub config_vars { $main::lxdebug->enter_sub(); - my @conf = qw(acs address admin businessnumber charset 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); + currency dateformat dbconnect dbdriver dbhost dbport dboptions + dbname dbuser dbpasswd email fax name numberformat in_numberformat password + printer role sid signature stylesheet tel templates vclimit angebote bestellungen rechnungen + anfragen lieferantenbestellungen einkaufsrechnungen taxnumber co_ustid duns menustyle + template_format copies); $main::lxdebug->leave_sub(); return @conf; } - sub error { $main::lxdebug->enter_sub(); @@ -860,12 +1109,11 @@ sub error {

$msg|; } - + die "Error: $msg\n"; - + $main::lxdebug->leave_sub(); } - 1;