X-Git-Url: http://wagnertech.de/gitweb/gitweb.cgi/mfinanz.git/blobdiff_plain/4dbb09950c9f5596646537c12d991c99086fe7c1..a3ae31c:/SL/User.pm diff --git a/SL/User.pm b/SL/User.pm index d50d1c9ec..7f4ec1a56 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,230 +34,141 @@ package User; +use IO::File; +use Fcntl qw(:seek); + +#use SL::Auth; +use SL::DBConnect; +use SL::DBUpgrade2; +use SL::DBUtils; +use SL::Iconv; +use SL::Inifile; +use SL::System::InstallationLock; + +use strict; + sub new { $main::lxdebug->enter_sub(); - my ($type, $memfile, $login) = @_; + my ($type, %params) = @_; + 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)/; - - # remove comments - s/\s#.*//g; - - # remove any trailing whitespace - s/^\s*(.*?)\s*$/$1/; - - ($key, $value) = split /=/, $_, 2; - - if (($key eq "stylesheet") && ($value eq "sql-ledger.css")) { - $value = "lx-office-erp.css"; - } - - $self->{$key} = $value; - } - - $self->{login} = $login; - - last; - } - } - close MEMBER; + if ($params{id} || $params{login}) { + my %user_data = $main::auth->read_user(%params); + 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 %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"); - @language = ; - close FH; + next unless open(my $fh, '<:encoding(UTF-8)', "locale/$dir/LANGUAGE"); + @language = <$fh>; + close $fh; $cc{$dir} = "@language"; } closedir(DIR); - + $main::lxdebug->leave_sub(); return %cc; } - sub login { - $main::lxdebug->enter_sub(); + my ($self, $form) = @_; - my ($self, $form, $userspath) = @_; - - 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}; - - # check if database is down - 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); - $sth->execute || $form->dberror($query); - - 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; - - my ($login) = $sth->fetchrow_array; - $sth->finish; - - if (!$login) { - $query = qq|INSERT INTO employee (login, name, workphone, role) - VALUES ('$self->{login}', '$myconfig{name}', - '$myconfig{tel}', 'user')|; - $dbh->do($query); - } - $dbh->disconnect; + return -3 if !$self->{login} || !$::auth->client; - $rc = 0; + my %myconfig = $main::auth->read_user(login => $self->{login}); - if ($form->{dbversion} ne $dbversion) { - # update the tables - open FH, ">$userspath/nologin" or die " -$!"; + # check if database is down + my $dbh = $form->dbconnect_noauto; - map { $form->{$_} = $myconfig{$_} } qw(dbname dbhost dbport dbdriver dbuser dbpasswd); - - $form->{dbupdate} = "db$myconfig{dbname}"; - $form->{$form->{dbupdate}} = 1; + # we got a connection, check the version + my ($dbversion) = $dbh->selectrow_array(qq|SELECT version FROM defaults|); - $form->info("Upgrading Dataset $myconfig{dbname} ..."); - - # required for Oracle - $form->{dbdefault} = $sid; + $self->create_schema_info_table($form, $dbh); - # ignore HUP, QUIT in case the webserver times out - $SIG{HUP} = 'IGNORE'; - $SIG{QUIT} = 'IGNORE'; - - $self->dbupdate($form); + # Auth DB upgrades available? + my $dbupdater_auth = SL::DBUpgrade2->new(form => $form, auth => 1)->parse_dbupdate_controls; + return -3 if $dbupdater_auth->unapplied_upgrade_scripts($::auth->dbconnect); - # remove lock file - unlink "$userspath/nologin"; + my $dbupdater = SL::DBUpgrade2->new(form => $form)->parse_dbupdate_controls; - $form->info("... done"); + my $update_available = $dbupdater->update_available($dbversion) || $dbupdater->update2_available($dbh); + $dbh->disconnect; - $rc = -2; + return 0 if !$update_available; - } - } + $form->{$_} = $::auth->client->{$_} for qw(dbname dbhost dbport dbuser dbpasswd); + $form->{$_} = $myconfig{$_} for qw(datestyle); - $main::lxdebug->leave_sub(); + $form->{"title"} = $main::locale->text("Dataset upgrade"); + $form->header(no_layout => $form->{no_layout}); + print $form->parse_html_template("dbupgrade/header"); - return $rc; -} + $form->{dbupdate} = "db" . $::auth->client->{dbname}; + if ($form->{"show_dbupdate_warning"}) { + print $form->parse_html_template("dbupgrade/warning"); + ::end_of_request(); + } + # update the tables + SL::System::InstallationLock->lock; -sub dbconnect_vars { - $main::lxdebug->enter_sub(); + # ignore HUP, QUIT in case the webserver times out + $SIG{HUP} = 'IGNORE'; + $SIG{QUIT} = 'IGNORE'; - 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}}; - - if ($form->{dbdriver} eq 'Pg') { - $form->{dbconnect} = "dbi:Pg:dbname=$db"; - } + $self->dbupdate($form); + $self->dbupdate2(form => $form, updater => $dbupdater, database => $::auth->client->{dbname}); + SL::DBUpgrade2->new(form => $::form, auth => 1)->apply_admin_dbupgrade_scripts(0); - if ($form->{dbdriver} eq 'Oracle') { - $form->{dbconnect} = "dbi:Oracle:sid=$form->{sid}"; - } + SL::System::InstallationLock->unlock; - if ($form->{dbhost}) { - $form->{dbconnect} .= ";host=$form->{dbhost}"; - } - if ($form->{dbport}) { - $form->{dbconnect} .= ";port=$form->{dbport}"; - } - - $main::lxdebug->leave_sub(); -} + print $form->parse_html_template("dbupgrade/footer"); + return -2; +} -sub dbdrivers { +sub dbconnect_vars { $main::lxdebug->enter_sub(); + my ($form, $db) = @_; - my @drivers = DBI->available_drivers(); + my %dboptions = ( + 'yy-mm-dd' => 'set DateStyle to \'ISO\'', + 'yyyy-mm-dd' => 'set DateStyle to \'ISO\'', + 'mm/dd/yy' => 'set DateStyle to \'SQL, US\'', + 'dd/mm/yy' => 'set DateStyle to \'SQL, EUROPEAN\'', + 'dd.mm.yy' => 'set DateStyle to \'GERMAN\'' + ); - $main::lxdebug->leave_sub(); + $form->{dboptions} = $dboptions{ $form->{dateformat} }; + $form->{dbconnect} = "dbi:Pg:dbname=${db};host=" . ($form->{dbhost} || 'localhost') . ";port=" . ($form->{dbport} || 5432); - return (grep { /(Pg|Oracle)/ } @drivers); + $main::lxdebug->leave_sub(); } - sub dbsources { $main::lxdebug->enter_sub(); @@ -265,337 +176,217 @@ 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 = SL::DBConnect->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}, SL::DBConnect->get_options) + or $form->dberror; + $query = + qq|SELECT datname FROM pg_database | . + qq|WHERE NOT datname IN ('template0', 'template1')|; + $sth = $dbh->prepare($query); + $sth->execute() || $form->dberror($query); - if ($form->{dbdriver} eq 'Pg') { + while (my ($db) = $sth->fetchrow_array) { - $query = qq|SELECT datname FROM pg_database|; - $sth = $dbh->prepare($query); - $sth->execute || $form->dberror($query); - - while (my ($db) = $sth->fetchrow_array) { + if ($form->{only_acc_db}) { - if ($form->{only_acc_db}) { - - next if ($db =~ /^template/); + next if ($db =~ /^template/); - &dbconnect_vars($form, $db); - my $dbh = DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}) or $form->dberror; + &dbconnect_vars($form, $db); + my $dbh = SL::DBConnect->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}, SL::DBConnect->get_options) + or $form->dberror; - $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); + $query = + qq|SELECT tablename FROM pg_tables | . + qq|WHERE (tablename = 'defaults') AND (tableowner = ?)|; + my $sth = $dbh->prepare($query); + $sth->execute($form->{dbuser}) || + $form->dberror($query . " ($form->{dbuser})"); - if ($sth->fetchrow_array) { - push @dbsources, $db; - } - $sth->finish; - $dbh->disconnect; - next; + if ($sth->fetchrow_array) { + 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'|; - } else { - $query = qq|SELECT username FROM dba_users|; - } - - $sth = $dbh->prepare($query); - $sth->execute || $form->dberror($query); - - while (my ($db) = $sth->fetchrow_array) { - push @dbsources, $db; + $sth->finish; + $dbh->disconnect; + next; } + push(@dbsources, $db); } $sth->finish; $dbh->disconnect; - + $main::lxdebug->leave_sub(); 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}"|); - - $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 $query = qq|$dbcreate{$form->{dbdriver}}|; - $dbh->do($query) || $form->dberror($query); - - if ($form->{dbdriver} eq 'Oracle') { - $query = qq|GRANT CONNECT,RESOURCE TO "$form->{db}"|; - $dbh->do($query) || $form->dberror($query); - } - $dbh->disconnect; - - - # setup variables for the new database - if ($form->{dbdriver} eq 'Oracle') { - $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; - - # create the tables - my $filename = qq|sql/lx-office.sql|; - $self->process_query($form, $dbh, $filename); + $form->{dbdefault} ||= $form->{dbuser}; - # load gifi - ($filename) = split /_/, $form->{chart}; - $filename =~ s/_//; - $self->process_query($form, $dbh, "sql/${filename}-gifi.sql"); + dbconnect_vars($form, $form->{dbdefault}); - # load chart of accounts - $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); - - $dbh->disconnect; + my $dbh = SL::DBConnect->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}, SL::DBConnect->get_options) || $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 process_query { +sub dbcreate { $main::lxdebug->enter_sub(); - my ($self, $form, $dbh, $filename) = @_; - -# return unless (-f $filename); - - open(FH, "$filename") or $form->error("$filename : $!\n"); - my $query = ""; - my $sth; - my @quote_chars; + my ($self, $form) = @_; - while () { - # Remove DOS and Unix style line endings. - s/[\r\n]//g; + &dbconnect_vars($form, $form->{dbdefault}); + my $dbh = + SL::DBConnect->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}, SL::DBConnect->get_options) + or $form->dberror; + $form->{db} =~ s/\"//g; + + my @dboptions; + + push @dboptions, "ENCODING = " . $dbh->quote($form->{"encoding"}) if $form->{"encoding"}; + if ($form->{"dbdefault"}) { + my $dbdefault = $form->{"dbdefault"}; + $dbdefault =~ s/[^a-zA-Z0-9_\-]//g; + push @dboptions, "TEMPLATE = $dbdefault"; + } - # don't add comments or empty lines - next if /^(--.*|\s+)$/; + my $query = qq|CREATE DATABASE "$form->{db}"|; + $query .= " WITH " . join(" ", @dboptions) if @dboptions; - for (my $i = 0; $i < length($_); $i++) { - my $char = substr($_, $i, 1); + # Ignore errors if the database exists. + $dbh->do($query); - # Are we inside a string? - if (@quote_chars) { - if ($char eq $quote_chars[-1]) { - pop(@quote_chars); - } - $query .= $char; + $dbh->disconnect; - } else { - if (($char eq "'") || ($char eq "\"")) { - push(@quote_chars, $char); + &dbconnect_vars($form, $form->{db}); - } elsif ($char eq ";") { - # Query is complete. Send it. + $dbh = SL::DBConnect->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}, SL::DBConnect->get_options) + or $form->dberror; - $sth = $dbh->prepare($query); - $sth->execute || $form->dberror($query); - $sth->finish; + my $db_charset = $Common::db_encoding_to_charset{$form->{encoding}}; + $db_charset ||= Common::DEFAULT_CHARSET; - $char = ""; - $query = ""; - } + my $dbupdater = SL::DBUpgrade2->new(form => $form); + # create the tables + $dbupdater->process_query($dbh, "sql/lx-office.sql", undef, $db_charset); - $query .= $char; - } - } - } + # load chart of accounts + $dbupdater->process_query($dbh, "sql/$form->{chart}-chart.sql", undef, $db_charset); + + $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}); + $query = "UPDATE defaults SET curr = ?"; + do_query($form, $dbh, $query, $form->{defaultcurrency}); - close FH; + $dbh->disconnect; $main::lxdebug->leave_sub(); } - - 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| - ); - - $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 $dbh = SL::DBConnect->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}, SL::DBConnect->get_options) + or $form->dberror; + my $query = qq|DROP DATABASE "$form->{db}"|; + do_query($form, $dbh, $query); $dbh->disconnect; $main::lxdebug->leave_sub(); } - - sub dbsources_unused { $main::lxdebug->enter_sub(); - my ($self, $form, $memfile) = @_; - - my @dbexcl = (); - my @dbsources = (); - - $form->error('File locked!') if (-f "${memfile}.LCK"); - - # open members file - open(FH, "$memfile") or $form->error("$memfile : $!"); - - while () { - 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 { $main::lxdebug->enter_sub(); my ($self, $form) = @_; - my %dbsources = (); - my $query; - - $form->{sid} = $form->{dbdefault}; - &dbconnect_vars($form, $form->{dbdefault}); + my %members = $main::auth->read_all_users(); + my $dbupdater = SL::DBUpgrade2->new(form => $form)->parse_dbupdate_controls; - my $dbh = DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}) or $form->dberror; + my ($query, $sth, %dbs_needing_updates); - if ($form->{dbdriver} eq 'Pg') { + foreach my $login (grep /[a-z]/, keys %members) { + my $member = $members{$login}; - $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) { + map { $form->{$_} = $member->{$_} } qw(dbname dbuser dbpasswd dbhost dbport); + dbconnect_vars($form, $form->{dbname}); - next if ($db =~ /^template/); + my $dbh = SL::DBConnect->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}, SL::DBConnect->get_options); - &dbconnect_vars($form, $db); - - my $dbh = DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}) or $form->dberror; + next unless $dbh; - $query = qq|SELECT t.tablename FROM pg_tables t - WHERE t.tablename = 'defaults'|; - my $sth = $dbh->prepare($query); - $sth->execute || $form->dberror($query); + my $version; - 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; - } - $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->finish(); - $sth = $dbh->prepare($query); - $sth->execute || $form->dberror($query); + $dbh->disconnect and next unless $version; - 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 $update_available = $dbupdater->update_available($version) || $dbupdater->update2_available($dbh); + $dbh->disconnect; - $query = qq|SELECT version FROM defaults|; - my $sth = $dbh->prepare($query); - $sth->execute; - - if (my ($version) = $sth->fetchrow_array) { - $dbsources{$db} = $version; - } - $sth->finish; - $dbh->disconnect; + if ($update_available) { + 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); @@ -609,7 +400,7 @@ sub calc_version { $version += $v[$i]; } - $main::lxdebug->leave_sub(); + $main::lxdebug->leave_sub(2); return $version; } @@ -622,8 +413,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); @@ -635,63 +426,84 @@ sub cmp_script_version { return $res_a <=> $res_b; } -## /LINET + +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) = @_; - $form->{sid} = $form->{dbdefault}; - + local *SQLDIR; + my @upgradescripts = (); my $query; my $rc = -2; - + if ($form->{dbupdate}) { + # read update scripts into memory - opendir SQLDIR, "sql/." or $form-error($!); - ## LINET - @upgradescripts = sort(cmp_script_version grep(/$form->{dbdriver}-upgrade-.*?\.sql$/, readdir(SQLDIR))); - ## /LINET - closedir SQLDIR; + opendir(SQLDIR, "sql/Pg-upgrade") + or &error("", "sql/Pg-upgrade : $!"); + @upgradescripts = + sort(cmp_script_version + grep(/Pg-upgrade-.*?\.(sql|pl)$/, + readdir(SQLDIR))); + closedir(SQLDIR); } + my $db_charset = $::lx_office_conf{system}->{dbcharset}; + $db_charset ||= Common::DEFAULT_CHARSET; + + my $dbupdater = SL::DBUpgrade2->new(form => $form); - foreach my $db (split / /, $form->{dbupdate}) { + 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}, SL::DBConnect->get_options) + 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) = selectrow_query($form, $dbh, $query); - my $version = $sth->fetchrow_array; - $sth->finish; - 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/^Pg-upgrade-|\.(sql|pl)$//g; + my ($mindb, $maxdb) = split /-/, $a; - ## LINET + my $str_maxdb = $maxdb; $mindb = calc_version($mindb); $maxdb = calc_version($maxdb); - ## /LINET next if ($version >= $maxdb); @@ -699,173 +511,66 @@ sub dbupdate { last if ($version < $mindb); # apply upgrade - $self->process_query($form, $dbh, "sql/$upgradescript"); + $main::lxdebug->message(LXDebug->DEBUG2(), "Applying Update $upgradescript"); + $dbupdater->process_file($dbh, "sql/Pg-upgrade/$upgradescript", $str_maxdb, $db_charset); $version = $maxdb; - + } - + $rc = 0; $dbh->disconnect; - + } $main::lxdebug->leave_sub(); return $rc; } - - -sub create_config { +sub dbupdate2 { $main::lxdebug->enter_sub(); - my ($self, $filename) = @_; + my ($self, %params) = @_; + my $form = $params{form}; + my $dbupdater = $params{updater}; + my $db = $params{database}; + my $rc = -2; + my $db_charset = $::lx_office_conf{system}->{dbcharset} || Common::DEFAULT_CHARSET; - @config = &config_vars; - - open(CONF, ">$filename") or $self->error("$filename : $!"); - - # create the config file - print CONF qq|# configuration file for $self->{login} + map { $_->{description} = SL::Iconv::convert($_->{charset}, $db_charset, $_->{description}) } values %{ $dbupdater->{all_controls} }; -\%myconfig = ( -|; + &dbconnect_vars($form, $db); - foreach $key (sort @config) { - $self->{$key} =~ s/\'/\\\'/g; - print CONF qq| $key => '$self->{$key}',\n|; - } + my $dbh = SL::DBConnect->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}, SL::DBConnect->get_options) or $form->dberror; - - print CONF qq|);\n\n|; + $dbh->do($form->{dboptions}) if ($form->{dboptions}); - close CONF; + $self->create_schema_info_table($form, $dbh); - $main::lxdebug->leave_sub(); -} + my @upgradescripts = $dbupdater->unapplied_upgrade_scripts($dbh); + $dbh->disconnect and next if !@upgradescripts; -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; - last; - } - print CONF $line; - } - - # remove everything up to next login or EOF - while ($line = shift @config) { - last if ($line =~ /^\[/); - } + foreach my $control (@upgradescripts) { + # apply upgrade + $main::lxdebug->message(LXDebug->DEBUG2(), "Applying Update $control->{file}"); + print $form->parse_html_template("dbupgrade/upgrade_message2", $control); - # this one is either the next login or EOF - print CONF $line; - - while ($line = shift @config) { - print CONF $line; - } - - print CONF qq|[$self->{login}]\n|; - - 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}; - } - } - - 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) { - print CONF qq|$key=$self->{$key}\n|; + $dbupdater->process_file($dbh, "sql/Pg-upgrade2/$control->{file}", $control, $db_charset); } - print CONF "\n"; - close CONF; - unlink "${memberfile}.LCK"; - - # create conf file - $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); + $rc = 0; + $dbh->disconnect; $main::lxdebug->leave_sub(); - return @conf; + return $rc; } - -sub error { - $main::lxdebug->enter_sub(); - - my ($self, $msg) = @_; - - if ($ENV{HTTP_USER_AGENT}) { - print qq|Content-Type: text/html - - - - - -

Error!

-

$msg|; - - } - - die "Error: $msg\n"; - - $main::lxdebug->leave_sub(); +sub data { + +{ %{ $_[0] } } } - 1; -