Projekt

Allgemein

Profil

Herunterladen (11,2 KB) Statistiken
| Zweig: | Markierung: | Revision:

kivitendo/SL/User.pm @ f5093da0

d319704a Moritz Bunkus
#=====================================================================
# LX-Office ERP
# Copyright (C) 2004
# Based on SQL-Ledger Version 2.1.9
# Web http://www.lx-office.org
#
#=====================================================================
# SQL-Ledger Accounting
# Copyright (C) 2001
#
# Author: Dieter Simader
# Email: dsimader@sql-ledger.org
# Web: http://www.sql-ledger.org
#
# Contributors:
#
# This program is free software; you can redistribute it and/or modify
# 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
# GNU General Public License for more details.
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
#=====================================================================
#
# user related functions
#
#=====================================================================

package User;

faef45c2 Moritz Bunkus
use IO::File;
use Fcntl qw(:seek);

684e84d8 Sven Schöling
#use SL::Auth;
44d893c2 Moritz Bunkus
use SL::DB::AuthClient;
f5093da0 Moritz Bunkus
use SL::DB::Employee;
22c02125 Moritz Bunkus
use SL::DBConnect;
4fd8bdbf Moritz Bunkus
use SL::DBUpgrade2;
f7057756 Moritz Bunkus
use SL::DBUtils;
a200453a Moritz Bunkus
use SL::Iconv;
0b280f98 Moritz Bunkus
use SL::Inifile;
66c08b64 Moritz Bunkus
use SL::System::InstallationLock;
4fd8bdbf Moritz Bunkus
3d967be3 Sven Schöling
use strict;

6ca9244c Moritz Bunkus
use constant LOGIN_OK => 0;
use constant LOGIN_BASIC_TABLES_MISSING => -1;
use constant LOGIN_DBUPDATE_AVAILABLE => -2;
use constant LOGIN_AUTH_DBUPDATE_AVAILABLE => -3;
use constant LOGIN_GENERAL_ERROR => -4;

d319704a Moritz Bunkus
sub new {
$main::lxdebug->enter_sub();

4531a6c7 Sven Schöling
my ($type, %params) = @_;
8c7e4493 Moritz Bunkus
d319704a Moritz Bunkus
my $self = {};

4531a6c7 Sven Schöling
if ($params{id} || $params{login}) {
my %user_data = $main::auth->read_user(%params);
8c7e4493 Moritz Bunkus
map { $self->{$_} = $user_data{$_} } keys %user_data;
d319704a Moritz Bunkus
}

$main::lxdebug->leave_sub();
8c7e4493 Moritz Bunkus
d319704a Moritz Bunkus
bless $self, $type;
}

sub country_codes {
$main::lxdebug->enter_sub();

8e6eda05 Moritz Bunkus
local *DIR;

d319704a Moritz Bunkus
my %cc = ();
my @language = ();

# scan the locale directory and read in the LANGUAGE files
f7057756 Moritz Bunkus
opendir(DIR, "locale");
d319704a Moritz Bunkus
f7057756 Moritz Bunkus
my @dir = grep(!/(^\.\.?$|\..*)/, readdir(DIR));
d319704a Moritz Bunkus
foreach my $dir (@dir) {
6c45a4db Moritz Bunkus
next unless open(my $fh, '<:encoding(UTF-8)', "locale/$dir/LANGUAGE");
@language = <$fh>;
close $fh;
d319704a Moritz Bunkus
$cc{$dir} = "@language";
}

closedir(DIR);

$main::lxdebug->leave_sub();

return %cc;
}

sub login {
8c7e4493 Moritz Bunkus
my ($self, $form) = @_;
d319704a Moritz Bunkus
6ca9244c Moritz Bunkus
return LOGIN_GENERAL_ERROR() if !$self->{login} || !$::auth->client;
d319704a Moritz Bunkus
722fee3c Moritz Bunkus
my %myconfig = $main::auth->read_user(login => $self->{login});
d319704a Moritz Bunkus
6ca9244c Moritz Bunkus
# Auth DB upgrades available?
my $dbupdater_auth = SL::DBUpgrade2->new(form => $form, auth => 1)->parse_dbupdate_controls;
return LOGIN_AUTH_DBUPDATE_AVAILABLE() if $dbupdater_auth->unapplied_upgrade_scripts($::auth->dbconnect);

722fee3c Moritz Bunkus
# check if database is down
my $dbh = $form->dbconnect_noauto;
d319704a Moritz Bunkus
722fee3c Moritz Bunkus
# we got a connection, check the version
90bb521a Moritz Bunkus
my ($dbversion) = $dbh->selectrow_array(qq|SELECT version FROM defaults|);
6ca9244c Moritz Bunkus
if (!$dbversion) {
$dbh->disconnect;
return LOGIN_BASIC_TABLES_MISSING();
}
4fd8bdbf Moritz Bunkus
722fee3c Moritz Bunkus
$self->create_schema_info_table($form, $dbh);
be3db7d1 Moritz Bunkus
6ca9244c Moritz Bunkus
my $dbupdater = SL::DBUpgrade2->new(form => $form)->parse_dbupdate_controls;
0e43d3cf Moritz Bunkus
my $update_available = $dbupdater->update2_available($dbh);
722fee3c Moritz Bunkus
$dbh->disconnect;
aa6ce434 Moritz Bunkus
f5093da0 Moritz Bunkus
if (!$update_available) {
SL::DB::Manager::Employee->update_entries_for_authorized_users;
return LOGIN_OK();
}
af412f0d Moritz Bunkus
$form->{$_} = $::auth->client->{$_} for qw(dbname dbhost dbport dbuser dbpasswd);
$form->{$_} = $myconfig{$_} for qw(datestyle);

722fee3c Moritz Bunkus
$form->{"title"} = $main::locale->text("Dataset upgrade");
$form->header(no_layout => $form->{no_layout});
print $form->parse_html_template("dbupgrade/header");
aa6ce434 Moritz Bunkus
af412f0d Moritz Bunkus
$form->{dbupdate} = "db" . $::auth->client->{dbname};
d319704a Moritz Bunkus
722fee3c Moritz Bunkus
if ($form->{"show_dbupdate_warning"}) {
print $form->parse_html_template("dbupgrade/warning");
::end_of_request();
}
d319704a Moritz Bunkus
722fee3c Moritz Bunkus
# update the tables
66c08b64 Moritz Bunkus
SL::System::InstallationLock->lock;
d319704a Moritz Bunkus
722fee3c Moritz Bunkus
# ignore HUP, QUIT in case the webserver times out
$SIG{HUP} = 'IGNORE';
$SIG{QUIT} = 'IGNORE';
d319704a Moritz Bunkus
af412f0d Moritz Bunkus
$self->dbupdate2(form => $form, updater => $dbupdater, database => $::auth->client->{dbname});
8e6eda05 Moritz Bunkus
f5093da0 Moritz Bunkus
# If $self->dbupdate2 returns than this means all upgrade scripts
# have been applied successfully, none required user
# interaction. Otherwise the deeper layers would have called
# ::end_of_request() already, and return would not have returned to
# us. Therefore we can now use RDBO instances because their supposed
# table structures do match the actual structures. So let's ensure
# that the "employee" table contains the appropriate entries for all
# users authorized for the current client.
SL::DB::Manager::Employee->update_entries_for_authorized_users;

66c08b64 Moritz Bunkus
SL::System::InstallationLock->unlock;
d319704a Moritz Bunkus
722fee3c Moritz Bunkus
print $form->parse_html_template("dbupgrade/footer");
d319704a Moritz Bunkus
6ca9244c Moritz Bunkus
return LOGIN_DBUPDATE_AVAILABLE();
d319704a Moritz Bunkus
}

sub dbconnect_vars {
$main::lxdebug->enter_sub();

my ($form, $db) = @_;

my %dboptions = (
90bb521a Moritz Bunkus
'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\''
);
d319704a Moritz Bunkus
90bb521a Moritz Bunkus
$form->{dboptions} = $dboptions{ $form->{dateformat} };
$form->{dbconnect} = "dbi:Pg:dbname=${db};host=" . ($form->{dbhost} || 'localhost') . ";port=" . ($form->{dbport} || 5432);
d319704a Moritz Bunkus
$main::lxdebug->leave_sub();
}

sub dbsources {
$main::lxdebug->enter_sub();

my ($self, $form) = @_;

my @dbsources = ();
my ($sth, $query);

$form->{dbdefault} = $form->{dbuser} unless $form->{dbdefault};
&dbconnect_vars($form, $form->{dbdefault});

7edc2444 Moritz Bunkus
my $dbh = SL::DBConnect->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}, SL::DBConnect->get_options)
d319704a Moritz Bunkus
or $form->dberror;

90bb521a Moritz Bunkus
$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) {
d319704a Moritz Bunkus
if ($form->{only_acc_db}) {

90bb521a Moritz Bunkus
next if ($db =~ /^template/);

&dbconnect_vars($form, $db);
my $dbh = SL::DBConnect->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}, SL::DBConnect->get_options)
or $form->dberror;
d319704a Moritz Bunkus
90bb521a Moritz Bunkus
$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;
d319704a Moritz Bunkus
}
90bb521a Moritz Bunkus
push(@dbsources, $db);
d319704a Moritz Bunkus
}

$sth->finish;
$dbh->disconnect;

$main::lxdebug->leave_sub();

return @dbsources;
}

sub dbcreate {
$main::lxdebug->enter_sub();

my ($self, $form) = @_;

61bd0898 Moritz Bunkus
&dbconnect_vars($form, $form->{dbdefault});
my $dbh =
7edc2444 Moritz Bunkus
SL::DBConnect->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}, SL::DBConnect->get_options)
61bd0898 Moritz Bunkus
or $form->dberror;
f7057756 Moritz Bunkus
$form->{db} =~ s/\"//g;
d319704a Moritz Bunkus
90bb521a Moritz Bunkus
my @dboptions;
61bd0898 Moritz Bunkus
90bb521a Moritz Bunkus
push @dboptions, "ENCODING = " . $dbh->quote($form->{"encoding"}) if $form->{"encoding"};
61bd0898 Moritz Bunkus
if ($form->{"dbdefault"}) {
my $dbdefault = $form->{"dbdefault"};
$dbdefault =~ s/[^a-zA-Z0-9_\-]//g;
90bb521a Moritz Bunkus
push @dboptions, "TEMPLATE = $dbdefault";
61bd0898 Moritz Bunkus
}
d319704a Moritz Bunkus
90bb521a Moritz Bunkus
my $query = qq|CREATE DATABASE "$form->{db}"|;
$query .= " WITH " . join(" ", @dboptions) if @dboptions;
61bd0898 Moritz Bunkus
6b7624a4 Moritz Bunkus
# Ignore errors if the database exists.
$dbh->do($query);
d319704a Moritz Bunkus
$dbh->disconnect;

&dbconnect_vars($form, $form->{db});

7edc2444 Moritz Bunkus
$dbh = SL::DBConnect->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}, SL::DBConnect->get_options)
d319704a Moritz Bunkus
or $form->dberror;

90bb521a Moritz Bunkus
my $dbupdater = SL::DBUpgrade2->new(form => $form);
d319704a Moritz Bunkus
# create the tables
dbda14c2 Moritz Bunkus
$dbupdater->process_query($dbh, "sql/lx-office.sql");
d319704a Moritz Bunkus
# load chart of accounts
dbda14c2 Moritz Bunkus
$dbupdater->process_query($dbh, "sql/$form->{chart}-chart.sql");
d319704a Moritz Bunkus
07427030 Sven Schöling
$query = qq|UPDATE defaults SET coa = ?, accounting_method = ?, profit_determination = ?, inventory_system = ?, curr = ?|;
839ed59d Moritz Bunkus
do_query($form, $dbh, $query, map { $form->{$_} } qw(chart accounting_method profit_determination inventory_system defaultcurrency));
89c9d0aa Moritz Bunkus
d319704a Moritz Bunkus
$dbh->disconnect;

$main::lxdebug->leave_sub();
}

sub dbdelete {
$main::lxdebug->enter_sub();

my ($self, $form) = @_;
f7057756 Moritz Bunkus
$form->{db} =~ s/\"//g;
d319704a Moritz Bunkus
&dbconnect_vars($form, $form->{dbdefault});
7edc2444 Moritz Bunkus
my $dbh = SL::DBConnect->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}, SL::DBConnect->get_options)
d319704a Moritz Bunkus
or $form->dberror;
90bb521a Moritz Bunkus
my $query = qq|DROP DATABASE "$form->{db}"|;
f7057756 Moritz Bunkus
do_query($form, $dbh, $query);
d319704a Moritz Bunkus
$dbh->disconnect;

$main::lxdebug->leave_sub();
}

sub calc_version {
8c6efb2a Moritz Bunkus
$main::lxdebug->enter_sub(2);
d319704a Moritz Bunkus
my (@v, $version, $i);

@v = split(/\./, $_[0]);
while (scalar(@v) < 4) {
push(@v, 0);
}
$version = 0;
for ($i = 0; $i < 4; $i++) {
$version *= 1000;
$version += $v[$i];
}

8c6efb2a Moritz Bunkus
$main::lxdebug->leave_sub(2);
d319704a Moritz Bunkus
return $version;
}

sub cmp_script_version {
my ($a_from, $a_to, $b_from, $b_to);
my ($i, $res_a, $res_b);
07427030 Sven Schöling
my ($my_a, $my_b) = do { no warnings 'once'; ($a, $b) };
d319704a Moritz Bunkus
$my_a =~ s/.*-upgrade-//;
$my_a =~ s/.sql$//;
$my_b =~ s/.*-upgrade-//;
$my_b =~ s/.sql$//;
b8da8785 Sven Schöling
my ($my_a_from, $my_a_to) = split(/-/, $my_a);
my ($my_b_from, $my_b_to) = split(/-/, $my_b);
d319704a Moritz Bunkus
$res_a = calc_version($my_a_from);
$res_b = calc_version($my_b_from);

if ($res_a == $res_b) {
$res_a = calc_version($my_a_to);
$res_b = calc_version($my_b_to);
}

return $res_a <=> $res_b;
}

4fd8bdbf Moritz Bunkus
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)) {
81b82d22 Moritz Bunkus
$dbh->rollback();
4fd8bdbf Moritz Bunkus
$query =
f7057756 Moritz Bunkus
qq|CREATE TABLE schema_info (| .
qq| tag text, | .
qq| login text, | .
qq| itime timestamp DEFAULT now(), | .
qq| PRIMARY KEY (tag))|;
4fd8bdbf Moritz Bunkus
$dbh->do($query) || $form->dberror($query);
}

$main::lxdebug->leave_sub();
}

sub dbupdate2 {
$main::lxdebug->enter_sub();

af412f0d Moritz Bunkus
my ($self, %params) = @_;
4fd8bdbf Moritz Bunkus
af412f0d Moritz Bunkus
my $form = $params{form};
my $dbupdater = $params{updater};
my $db = $params{database};
my $rc = -2;
4fd8bdbf Moritz Bunkus
dbda14c2 Moritz Bunkus
map { $_->{description} = SL::Iconv::convert($_->{charset}, 'UTF-8', $_->{description}) } values %{ $dbupdater->{all_controls} };
faef45c2 Moritz Bunkus
af412f0d Moritz Bunkus
&dbconnect_vars($form, $db);
4fd8bdbf Moritz Bunkus
af412f0d Moritz Bunkus
my $dbh = SL::DBConnect->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}, SL::DBConnect->get_options) or $form->dberror;
4fd8bdbf Moritz Bunkus
af412f0d Moritz Bunkus
$dbh->do($form->{dboptions}) if ($form->{dboptions});
4fd8bdbf Moritz Bunkus
af412f0d Moritz Bunkus
$self->create_schema_info_table($form, $dbh);
4fd8bdbf Moritz Bunkus
af412f0d Moritz Bunkus
my @upgradescripts = $dbupdater->unapplied_upgrade_scripts($dbh);
4fd8bdbf Moritz Bunkus
af412f0d Moritz Bunkus
$dbh->disconnect and next if !@upgradescripts;
4fd8bdbf Moritz Bunkus
af412f0d Moritz Bunkus
foreach my $control (@upgradescripts) {
# apply upgrade
$main::lxdebug->message(LXDebug->DEBUG2(), "Applying Update $control->{file}");
print $form->parse_html_template("dbupgrade/upgrade_message2", $control);
4fd8bdbf Moritz Bunkus
dbda14c2 Moritz Bunkus
$dbupdater->process_file($dbh, "sql/Pg-upgrade2/$control->{file}", $control);
4fd8bdbf Moritz Bunkus
}

af412f0d Moritz Bunkus
$rc = 0;
$dbh->disconnect;

4fd8bdbf Moritz Bunkus
$main::lxdebug->leave_sub();

return $rc;
}

4531a6c7 Sven Schöling
sub data {
+{ %{ $_[0] } }
}

d319704a Moritz Bunkus
1;