package User;
-use strict;
-
use IO::File;
use Fcntl qw(:seek);
-use SL::Auth;
+#use SL::Auth;
+use SL::DBConnect;
use SL::DBUpgrade2;
use SL::DBUtils;
use SL::Iconv;
use SL::Inifile;
+use SL::System::InstallationLock;
+
+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;
}
my @dir = grep(!/(^\.\.?$|\..*)/, readdir(DIR));
foreach my $dir (@dir) {
- next unless open(FH, "locale/$dir/LANGUAGE");
- @language = <FH>;
- close FH;
+ next unless open(my $fh, '<:encoding(UTF-8)', "locale/$dir/LANGUAGE");
+ @language = <$fh>;
+ close $fh;
$cc{$dir} = "@language";
}
}
sub login {
- $main::lxdebug->enter_sub();
-
my ($self, $form) = @_;
- our $sid;
-
- local *FH;
- my $rc = -3;
+ return -3 if !$self->{login} || !$::auth->client;
- 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})
- or $self->error(DBI::errstr);
+ # check if database is down
+ my $dbh = $form->dbconnect_noauto;
- # 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;
-
- $self->create_employee_entry($form, $dbh, \%myconfig);
-
- $self->create_schema_info_table($form, $dbh);
-
- $dbh->disconnect;
-
- $rc = 0;
+ # we got a connection, check the version
+ my ($dbversion) = $dbh->selectrow_array(qq|SELECT version FROM defaults|);
- my $controls =
- parse_dbupdate_controls($form, $myconfig{"dbdriver"});
+ $self->create_schema_info_table($form, $dbh);
- map({ $form->{$_} = $myconfig{$_} }
- qw(dbname dbhost dbport dbdriver dbuser dbpasswd dbconnect dateformat));
+ # 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);
- if (update_available($myconfig{"dbdriver"}, $dbversion) ||
- update2_available($form, $controls)) {
+ my $dbupdater = SL::DBUpgrade2->new(form => $form)->parse_dbupdate_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;
+ my $update_available = $dbupdater->update_available($dbversion) || $dbupdater->update2_available($dbh);
+ $dbh->disconnect;
- if ($form->{"show_dbupdate_warning"}) {
- print $form->parse_html_template("dbupgrade/warning");
- exit(0);
- }
+ return 0 if !$update_available;
- # 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);
- }
+ $form->{$_} = $::auth->client->{$_} for qw(dbname dbhost dbport dbuser dbpasswd);
+ $form->{$_} = $myconfig{$_} for qw(datestyle);
- # required for Oracle
- $form->{dbdefault} = $sid;
+ $form->{"title"} = $main::locale->text("Dataset upgrade");
+ $form->header(no_layout => $form->{no_layout});
+ print $form->parse_html_template("dbupgrade/header");
- # ignore HUP, QUIT in case the webserver times out
- $SIG{HUP} = 'IGNORE';
- $SIG{QUIT} = 'IGNORE';
+ $form->{dbupdate} = "db" . $::auth->client->{dbname};
- $self->dbupdate($form);
- $self->dbupdate2($form, $controls);
+ if ($form->{"show_dbupdate_warning"}) {
+ print $form->parse_html_template("dbupgrade/warning");
+ ::end_of_request();
+ }
- close(FH);
+ # update the tables
+ SL::System::InstallationLock->lock;
- # remove lock file
- unlink("$main::userspath/nologin");
+ # ignore HUP, QUIT in case the webserver times out
+ $SIG{HUP} = 'IGNORE';
+ $SIG{QUIT} = 'IGNORE';
- my $menufile =
- $self->{"menustyle"} eq "v3" ? "menuv3.pl" :
- $self->{"menustyle"} eq "neu" ? "menunew.pl" :
- $self->{"menustyle"} eq "xml" ? "menuXML.pl" :
- "menu.pl";
+ $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);
- print $form->parse_html_template("dbupgrade/footer", { "menufile" => $menufile });
+ SL::System::InstallationLock->unlock;
- $rc = -2;
+ print $form->parse_html_template("dbupgrade/footer");
- }
- }
-
- $main::lxdebug->leave_sub();
-
- return $rc;
+ return -2;
}
sub dbconnect_vars {
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";
- }
-
- if ($form->{dbdriver} eq 'Oracle') {
- $form->{dbconnect} = "dbi:Oracle:sid=$form->{sid}";
- }
-
- if ($form->{dbhost}) {
- $form->{dbconnect} .= ";host=$form->{dbhost}";
- }
- if ($form->{dbport}) {
- $form->{dbconnect} .= ";port=$form->{dbport}";
- }
-
- $main::lxdebug->leave_sub();
-}
-
-sub dbdrivers {
- $main::lxdebug->enter_sub();
+ '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\''
+ );
- my @drivers = DBI->available_drivers();
+ $form->{dboptions} = $dboptions{ $form->{dateformat} };
+ $form->{dbconnect} = "dbi:Pg:dbname=${db};host=" . ($form->{dbhost} || 'localhost') . ";port=" . ($form->{dbport} || 5432);
$main::lxdebug->leave_sub();
-
- return (grep { /(Pg|Oracle)/ } @drivers);
}
sub 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})
+ my $dbh = SL::DBConnect->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}, SL::DBConnect->get_options)
or $form->dberror;
- if ($form->{dbdriver} eq 'Pg') {
- $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) {
-
- 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;
-
- $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;
- }
- push(@dbsources, $db);
- }
- }
+ $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) {
- if ($form->{dbdriver} eq 'Oracle') {
if ($form->{only_acc_db}) {
- $query =
- qq|SELECT owner FROM dba_objects | .
- qq|WHERE object_name = 'DEFAULTS' AND object_type = 'TABLE'|;
- } else {
- $query = qq|SELECT username FROM dba_users|;
- }
- $sth = $dbh->prepare($query);
- $sth->execute || $form->dberror($query);
+ next if ($db =~ /^template/);
- while (my ($db) = $sth->fetchrow_array) {
- push(@dbsources, $db);
+ &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 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;
}
+ push(@dbsources, $db);
}
$sth->finish;
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}, 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();
my ($self, $form) = @_;
- $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}, SL::DBConnect->get_options)
or $form->dberror;
$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' => [],
- );
+ my @dboptions;
- push(@{$dboptions{"Pg"}}, "ENCODING = " . $dbh->quote($form->{"encoding"}))
- if ($form->{"encoding"});
+ 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{"Pg"}}, "TEMPLATE = $dbdefault");
+ push @dboptions, "TEMPLATE = $dbdefault";
}
- my $query = $dbcreate{$form->{dbdriver}};
- $query .= " WITH " . join(" ", @{$dboptions{"Pg"}}) if (@{$dboptions{"Pg"}});
+ my $query = qq|CREATE DATABASE "$form->{db}"|;
+ $query .= " WITH " . join(" ", @dboptions) if @dboptions;
# Ignore errors if the database exists.
$dbh->do($query);
- if ($form->{dbdriver} eq 'Oracle') {
- $query = qq|GRANT CONNECT, RESOURCE TO "$form->{db}"|;
- do_query($form, $dbh, $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})
+ $dbh = SL::DBConnect->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}, SL::DBConnect->get_options)
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);
# create the tables
- $self->process_query($form, $dbh, "sql/lx-office.sql", undef, $db_charset);
+ $dbupdater->process_query($dbh, "sql/lx-office.sql", undef, $db_charset);
# load chart of accounts
- $self->process_query($form, $dbh, "sql/$form->{chart}-chart.sql", undef, $db_charset);
+ $dbupdater->process_query($dbh, "sql/$form->{chart}-chart.sql", undef, $db_charset);
$query = "UPDATE defaults SET coa = ?";
do_query($form, $dbh, $query, $form->{chart});
+ $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});
$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_or_control, $db_charset) = @_;
-
- my $fh = IO::File->new($filename, "r") or $form->error("$filename : $!\n");
-
- my $file_charset = Common::DEFAULT_CHARSET;
-
- if (ref($version_or_control) eq "HASH") {
- $file_charset = $version_or_control->{charset};
-
- } else {
- while (<$fh>) {
- last if !/^--/;
- next if !/^--\s*\@charset:\s*(.+)/;
- $file_charset = $1;
- last;
- }
- $fh->seek(0, SEEK_SET);
- }
-
- my $contents = join "", <$fh>;
- $fh->close();
-
- $db_charset ||= Common::DEFAULT_CHARSET;
-
- my $iconv = SL::Iconv::get_converter($file_charset, $db_charset);
-
- $dbh->begin_work();
-
- my %dbup_myconfig = ();
- map({ $dbup_myconfig{$_} = $form->{$_}; }
- qw(dbname dbuser dbpasswd dbhost dbport dbconnect));
-
- my $nls_file = $filename;
- $nls_file =~ s|.*/||;
- $nls_file =~ s|.pl$||;
- my $dbup_locale = Locale->new($main::language, $nls_file);
-
- my $result = eval($contents);
-
- if (1 != $result) {
- $dbh->rollback();
- $dbh->disconnect();
- }
-
- if (!defined($result)) {
- print $form->parse_html_template("dbupgrade/error",
- { "file" => $filename,
- "error" => $@ });
- exit(0);
- } elsif (1 != $result) {
- unlink("users/nologin") if (2 == $result);
- exit(0);
- }
-
- if (ref($version_or_control) eq "HASH") {
- $dbh->do("INSERT INTO schema_info (tag, login) VALUES (" .
- $dbh->quote($version_or_control->{"tag"}) . ", " .
- $dbh->quote($form->{"login"}) . ")");
- } elsif ($version_or_control) {
- $dbh->do("UPDATE defaults SET version = " .
- $dbh->quote($version_or_control));
- }
- $dbh->commit();
-
- $main::lxdebug->leave_sub();
-}
-
-sub process_query {
- $main::lxdebug->enter_sub();
-
- my ($self, $form, $dbh, $filename, $version_or_control, $db_charset) = @_;
-
- my $fh = IO::File->new($filename, "r") or $form->error("$filename : $!\n");
- my $query = "";
- my $sth;
- my @quote_chars;
-
- my $file_charset = Common::DEFAULT_CHARSET;
- while (<$fh>) {
- last if !/^--/;
- next if !/^--\s*\@charset:\s*(.+)/;
- $file_charset = $1;
- last;
- }
- $fh->seek(0, SEEK_SET);
-
- $db_charset ||= Common::DEFAULT_CHARSET;
-
- $dbh->begin_work();
-
- while (<$fh>) {
- $_ = SL::Iconv::convert($file_charset, $db_charset, $_);
-
- # Remove DOS and Unix style line endings.
- chomp;
-
- # remove comments
- s/--.*$//;
-
- for (my $i = 0; $i < length($_); $i++) {
- my $char = substr($_, $i, 1);
-
- # Are we inside a string?
- if (@quote_chars) {
- if ($char eq $quote_chars[-1]) {
- pop(@quote_chars);
- }
- $query .= $char;
-
- } else {
- if (($char eq "'") || ($char eq "\"")) {
- push(@quote_chars, $char);
-
- } elsif ($char eq ";") {
-
- # Query is complete. Send it.
-
- $sth = $dbh->prepare($query);
- if (!$sth->execute()) {
- my $errstr = $dbh->errstr;
- $sth->finish();
- $dbh->rollback();
- $form->dberror("The database update/creation did not succeed. " .
- "The file ${filename} containing the following " .
- "query failed:<br>${query}<br>" .
- "The error message was: ${errstr}<br>" .
- "All changes in that file have been reverted.");
- }
- $sth->finish();
-
- $char = "";
- $query = "";
- }
-
- $query .= $char;
- }
- }
- }
-
- if (ref($version_or_control) eq "HASH") {
- $dbh->do("INSERT INTO schema_info (tag, login) VALUES (" .
- $dbh->quote($version_or_control->{"tag"}) . ", " .
- $dbh->quote($form->{"login"}) . ")");
- } elsif ($version_or_control) {
- $dbh->do("UPDATE defaults SET version = " .
- $dbh->quote($version_or_control));
- }
- $dbh->commit();
-
- $fh->close();
-
- $main::lxdebug->leave_sub();
-}
-
sub dbdelete {
$main::lxdebug->enter_sub();
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})
+ my $dbh = SL::DBConnect->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}, SL::DBConnect->get_options)
or $form->dberror;
- my $query = $dbdelete{$form->{dbdriver}};
+ my $query = qq|DROP DATABASE "$form->{db}"|;
do_query($form, $dbh, $query);
$dbh->disconnect;
my ($self, $form) = @_;
- my %members = $main::auth->read_all_users();
- my $controls = parse_dbupdate_controls($form, $form->{dbdriver});
+ my %members = $main::auth->read_all_users();
+ my $dbupdater = SL::DBUpgrade2->new(form => $form)->parse_dbupdate_controls;
my ($query, $sth, %dbs_needing_updates);
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}, SL::DBConnect->get_options);
next unless $dbh;
($version) = $sth->fetchrow_array();
}
$sth->finish();
- $dbh->disconnect();
- next unless $version;
+ $dbh->disconnect and next unless $version;
+
+ my $update_available = $dbupdater->update_available($version) || $dbupdater->update2_available($dbh);
+ $dbh->disconnect;
- if (update_available($form->{dbdriver}, $version) || update2_available($form, $controls)) {
+ if ($update_available) {
my $dbinfo = {};
map { $dbinfo->{$_} = $member->{$_} } grep /^db/, keys %{ $member };
$dbs_needing_updates{$member->{dbhost} . "::" . $member->{dbname}} = $dbinfo;
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();
local *SQLDIR;
- $form->{sid} = $form->{dbdefault};
-
my @upgradescripts = ();
my $query;
my $rc = -2;
if ($form->{dbupdate}) {
# read update scripts into memory
- opendir(SQLDIR, "sql/" . $form->{dbdriver} . "-upgrade")
- or &error("", "sql/" . $form->{dbdriver} . "-upgrade : $!");
+ opendir(SQLDIR, "sql/Pg-upgrade")
+ or &error("", "sql/Pg-upgrade : $!");
@upgradescripts =
sort(cmp_script_version
- grep(/$form->{dbdriver}-upgrade-.*?\.(sql|pl)$/,
+ grep(/Pg-upgrade-.*?\.(sql|pl)$/,
readdir(SQLDIR)));
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);
+
foreach my $db (split(/ /, $form->{dbupdate})) {
next unless $form->{$db};
$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}, SL::DBConnect->get_options)
or $form->dberror;
$dbh->do($form->{dboptions}) if ($form->{dboptions});
foreach my $upgradescript (@upgradescripts) {
my $a = $upgradescript;
- $a =~ s/^\Q$form->{dbdriver}\E-upgrade-|\.(sql|pl)$//g;
- my $file_type = $1;
+ $a =~ s/^Pg-upgrade-|\.(sql|pl)$//g;
my ($mindb, $maxdb) = split /-/, $a;
my $str_maxdb = $maxdb;
last if ($version < $mindb);
# apply upgrade
- $main::lxdebug->message(LXDebug::DEBUG2, "Applying Update $upgradescript");
- if ($file_type eq "sql") {
- $self->process_query($form, $dbh, "sql/" . $form->{"dbdriver"} .
- "-upgrade/$upgradescript", $str_maxdb, $db_charset);
- } else {
- $self->process_perl_script($form, $dbh, "sql/" . $form->{"dbdriver"} .
- "-upgrade/$upgradescript", $str_maxdb, $db_charset);
- }
+ $main::lxdebug->message(LXDebug->DEBUG2(), "Applying Update $upgradescript");
+ $dbupdater->process_file($dbh, "sql/Pg-upgrade/$upgradescript", $str_maxdb, $db_charset);
$version = $maxdb;
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);
-
- my $db_charset = $main::dbcharset;
- $db_charset ||= Common::DEFAULT_CHARSET;
-
- 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;
-
- $dbh->do($form->{dboptions}) if ($form->{dboptions});
-
- map({ $_->{"applied"} = 0; } @upgradescripts);
-
- $self->create_schema_info_table($form, $dbh);
-
- $query = qq|SELECT tag FROM schema_info|;
- $sth = $dbh->prepare($query);
- $sth->execute() || $form->dberror($query);
- while (($tag) = $sth->fetchrow_array()) {
- $controls->{$tag}->{"applied"} = 1 if (defined($controls->{$tag}));
- }
- $sth->finish();
-
- my $all_applied = 1;
- foreach (@upgradescripts) {
- if (!$_->{"applied"}) {
- $all_applied = 0;
- last;
- }
- }
-
- next if ($all_applied);
-
- 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") {
- $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);
- }
- }
-
- $rc = 0;
- $dbh->disconnect;
-
- }
-
- $main::lxdebug->leave_sub();
-
- return $rc;
-}
-
-sub update2_available {
- $main::lxdebug->enter_sub();
-
- my ($form, $controls) = @_;
+ my ($self, %params) = @_;
- map({ $_->{"applied"} = 0; } values(%{$controls}));
+ 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;
- dbconnect_vars($form, $form->{"dbname"});
+ map { $_->{description} = SL::Iconv::convert($_->{charset}, $db_charset, $_->{description}) } values %{ $dbupdater->{all_controls} };
- my $dbh =
- DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}) ||
- $form->dberror;
+ &dbconnect_vars($form, $db);
- my ($query, $tag, $sth);
+ my $dbh = SL::DBConnect->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}, SL::DBConnect->get_options) or $form->dberror;
- $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();
+ $dbh->do($form->{dboptions}) if ($form->{dboptions});
- map({ $main::lxdebug->leave_sub() and return 1 if (!$_->{"applied"}) }
- values(%{$controls}));
+ $self->create_schema_info_table($form, $dbh);
- $main::lxdebug->leave_sub();
- return 0;
-}
+ my @upgradescripts = $dbupdater->unapplied_upgrade_scripts($dbh);
-sub save_member {
- $main::lxdebug->enter_sub();
+ $dbh->disconnect and next if !@upgradescripts;
- my ($self) = @_;
- my $form = \%main::form;
+ foreach my $control (@upgradescripts) {
+ # apply upgrade
+ $main::lxdebug->message(LXDebug->DEBUG2(), "Applying Update $control->{file}");
+ print $form->parse_html_template("dbupgrade/upgrade_message2", $control);
- # 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);
- $dbh->disconnect();
+ $dbupdater->process_file($dbh, "sql/Pg-upgrade2/$control->{file}", $control, $db_charset);
}
- $main::lxdebug->leave_sub();
-}
-
-sub create_employee_entry {
- $main::lxdebug->enter_sub();
-
- my $self = shift;
- my $form = shift;
- my $dbh = shift;
- my $myconfig = shift;
-
- # add login to employee table if it does not exist
- # no error check for employee table, ignore if it does not exist
- my ($login) = selectrow_query($form, $dbh, qq|SELECT id FROM employee WHERE login = ?|, $self->{login});
-
- if (!$login) {
- my $query = qq|INSERT INTO employee (login, name, workphone, role) VALUES (?, ?, ?, ?)|;
- do_query($form, $dbh, $query, ($self->{login}, $myconfig->{name}, $myconfig->{tel}, "user"));
- }
-
- $main::lxdebug->leave_sub();
-}
-
-sub config_vars {
- $main::lxdebug->enter_sub();
-
- 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
- taxnumber co_ustid duns menustyle template_format default_media
- default_printer_id copies show_form_details favorites
- pdonumber sdonumber);
+ $rc = 0;
+ $dbh->disconnect;
$main::lxdebug->leave_sub();
- return @conf;
+ return $rc;
}
-sub error {
- $main::lxdebug->enter_sub();
-
- my ($self, $msg) = @_;
-
- $main::lxdebug->show_backtrace();
-
- if ($ENV{HTTP_USER_AGENT}) {
- print qq|Content-Type: text/html
-
-<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0//EN">
-
-<body bgcolor=ffffff>
-
-<h2><font color=red>Error!</font></h2>
-<p><b>$msg</b>|;
-
- }
-
- die "Error: $msg\n";
-
- $main::lxdebug->leave_sub();
+sub data {
+ +{ %{ $_[0] } }
}
1;
-
projects / kivitendo-erp.git / blobdiff