1 #=====================================================================
4 # Based on SQL-Ledger Version 2.1.9
5 # Web http://www.lx-office.org
7 #=====================================================================
8 # SQL-Ledger Accounting
11 # Author: Dieter Simader
12 # Email: dsimader@sql-ledger.org
13 # Web: http://www.sql-ledger.org
17 # This program is free software; you can redistribute it and/or modify
18 # it under the terms of the GNU General Public License as published by
19 # the Free Software Foundation; either version 2 of the License, or
20 # (at your option) any later version.
22 # This program is distributed in the hope that it will be useful,
23 # but WITHOUT ANY WARRANTY; without even the implied warranty of
24 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
25 # GNU General Public License for more details.
26 # You should have received a copy of the GNU General Public License
27 # along with this program; if not, write to the Free Software
28 # Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
29 #=====================================================================
31 # user related functions
33 #=====================================================================
50 $main::lxdebug->enter_sub();
52 my ($type, %params) = @_;
56 if ($params{id} || $params{login}) {
57 my %user_data = $main::auth->read_user(%params);
58 map { $self->{$_} = $user_data{$_} } keys %user_data;
61 $main::lxdebug->leave_sub();
67 $main::lxdebug->enter_sub();
74 # scan the locale directory and read in the LANGUAGE files
75 opendir(DIR, "locale");
77 my @dir = grep(!/(^\.\.?$|\..*)/, readdir(DIR));
79 foreach my $dir (@dir) {
80 next unless open(my $fh, '<:encoding(UTF-8)', "locale/$dir/LANGUAGE");
84 $cc{$dir} = "@language";
89 $main::lxdebug->leave_sub();
95 $main::lxdebug->enter_sub();
97 my ($self, $form) = @_;
104 if ($self->{login}) {
105 my %myconfig = $main::auth->read_user(login => $self->{login});
107 # check if database is down
108 my $dbh = SL::DBConnect->connect($myconfig{dbconnect}, $myconfig{dbuser}, $myconfig{dbpasswd})
109 or $self->error($DBI::errstr);
111 # we got a connection, check the version
112 my $query = qq|SELECT version FROM defaults|;
113 my $sth = $dbh->prepare($query);
114 $sth->execute || $form->dberror($query);
116 my ($dbversion) = $sth->fetchrow_array;
119 $self->create_employee_entry($form, $dbh, \%myconfig);
121 $self->create_schema_info_table($form, $dbh);
123 my $dbupdater_auth = SL::DBUpgrade2->new(form => $form, dbdriver => 'Pg', auth => 1)->parse_dbupdate_controls;
124 if ($dbupdater_auth->unapplied_upgrade_scripts($::auth->dbconnect)) {
125 $::lxdebug->leave_sub;
131 my $dbupdater = SL::DBUpgrade2->new(form => $form, dbdriver => $myconfig{dbdriver})->parse_dbupdate_controls;
133 map({ $form->{$_} = $myconfig{$_} } qw(dbname dbhost dbport dbdriver dbuser dbpasswd dbconnect dateformat));
134 dbconnect_vars($form, $form->{dbname});
135 my $update_available = $dbupdater->update_available($dbversion) || $dbupdater->update2_available($dbh);
138 if ($update_available) {
139 $form->{"stylesheet"} = "lx-office-erp.css";
140 $form->{"title"} = $main::locale->text("Dataset upgrade");
142 print $form->parse_html_template("dbupgrade/header");
144 $form->{dbupdate} = "db$myconfig{dbname}";
145 $form->{ $form->{dbupdate} } = 1;
147 if ($form->{"show_dbupdate_warning"}) {
148 print $form->parse_html_template("dbupgrade/warning");
153 if (!open(FH, ">", $::lx_office_conf{paths}->{userspath} . "/nologin")) {
154 $form->show_generic_error($main::locale->text('A temporary file could not be created. ' .
155 'Please verify that the directory "#1" is writeable by the webserver.',
156 $::lx_office_conf{paths}->{userspath}),
160 # required for Oracle
161 $form->{dbdefault} = $sid;
163 # ignore HUP, QUIT in case the webserver times out
164 $SIG{HUP} = 'IGNORE';
165 $SIG{QUIT} = 'IGNORE';
167 $self->dbupdate($form);
168 $self->dbupdate2($form, $dbupdater);
169 SL::DBUpgrade2->new(form => $::form, dbdriver => 'Pg', auth => 1)->apply_admin_dbupgrade_scripts(0);
174 unlink($::lx_office_conf{paths}->{userspath} . "/nologin");
177 $self->{"menustyle"} eq "v3" ? "menuv3.pl" :
178 $self->{"menustyle"} eq "neu" ? "menunew.pl" :
179 $self->{"menustyle"} eq "js" ? "menujs.pl" :
182 print $form->parse_html_template("dbupgrade/footer", { "menufile" => $menufile });
188 $main::lxdebug->leave_sub();
194 $main::lxdebug->enter_sub();
196 my ($form, $db) = @_;
199 'Pg' => { 'yy-mm-dd' => 'set DateStyle to \'ISO\'',
200 'yyyy-mm-dd' => 'set DateStyle to \'ISO\'',
201 'mm/dd/yy' => 'set DateStyle to \'SQL, US\'',
202 'dd/mm/yy' => 'set DateStyle to \'SQL, EUROPEAN\'',
203 'dd.mm.yy' => 'set DateStyle to \'GERMAN\''
206 'yy-mm-dd' => 'ALTER SESSION SET NLS_DATE_FORMAT = \'YY-MM-DD\'',
207 'yyyy-mm-dd' => 'ALTER SESSION SET NLS_DATE_FORMAT = \'YYYY-MM-DD\'',
208 'mm/dd/yy' => 'ALTER SESSION SET NLS_DATE_FORMAT = \'MM/DD/YY\'',
209 'dd/mm/yy' => 'ALTER SESSION SET NLS_DATE_FORMAT = \'DD/MM/YY\'',
210 'dd.mm.yy' => 'ALTER SESSION SET NLS_DATE_FORMAT = \'DD.MM.YY\'',
213 $form->{dboptions} = $dboptions{ $form->{dbdriver} }{ $form->{dateformat} };
215 if ($form->{dbdriver} eq 'Pg') {
216 $form->{dbconnect} = "dbi:Pg:dbname=$db";
219 if ($form->{dbdriver} eq 'Oracle') {
220 $form->{dbconnect} = "dbi:Oracle:sid=$form->{sid}";
223 if ($form->{dbhost}) {
224 $form->{dbconnect} .= ";host=$form->{dbhost}";
226 if ($form->{dbport}) {
227 $form->{dbconnect} .= ";port=$form->{dbport}";
230 $main::lxdebug->leave_sub();
234 $main::lxdebug->enter_sub();
236 my @drivers = DBI->available_drivers();
238 $main::lxdebug->leave_sub();
240 return (grep { /(Pg|Oracle)/ } @drivers);
244 $main::lxdebug->enter_sub();
246 my ($self, $form) = @_;
251 $form->{dbdefault} = $form->{dbuser} unless $form->{dbdefault};
252 $form->{sid} = $form->{dbdefault};
253 &dbconnect_vars($form, $form->{dbdefault});
255 my $dbh = SL::DBConnect->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
258 if ($form->{dbdriver} eq 'Pg') {
260 qq|SELECT datname FROM pg_database | .
261 qq|WHERE NOT datname IN ('template0', 'template1')|;
262 $sth = $dbh->prepare($query);
263 $sth->execute() || $form->dberror($query);
265 while (my ($db) = $sth->fetchrow_array) {
267 if ($form->{only_acc_db}) {
269 next if ($db =~ /^template/);
271 &dbconnect_vars($form, $db);
272 my $dbh = SL::DBConnect->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
276 qq|SELECT tablename FROM pg_tables | .
277 qq|WHERE (tablename = 'defaults') AND (tableowner = ?)|;
278 my $sth = $dbh->prepare($query);
279 $sth->execute($form->{dbuser}) ||
280 $form->dberror($query . " ($form->{dbuser})");
282 if ($sth->fetchrow_array) {
283 push(@dbsources, $db);
289 push(@dbsources, $db);
293 if ($form->{dbdriver} eq 'Oracle') {
294 if ($form->{only_acc_db}) {
296 qq|SELECT owner FROM dba_objects | .
297 qq|WHERE object_name = 'DEFAULTS' AND object_type = 'TABLE'|;
299 $query = qq|SELECT username FROM dba_users|;
302 $sth = $dbh->prepare($query);
303 $sth->execute || $form->dberror($query);
305 while (my ($db) = $sth->fetchrow_array) {
306 push(@dbsources, $db);
313 $main::lxdebug->leave_sub();
318 sub dbclusterencoding {
319 $main::lxdebug->enter_sub();
321 my ($self, $form) = @_;
323 $form->{dbdefault} ||= $form->{dbuser};
325 dbconnect_vars($form, $form->{dbdefault});
327 my $dbh = SL::DBConnect->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}) || $form->dberror();
328 my $query = qq|SELECT pg_encoding_to_char(encoding) FROM pg_database WHERE datname = 'template0'|;
329 my ($cluster_encoding) = $dbh->selectrow_array($query);
332 $main::lxdebug->leave_sub();
334 return $cluster_encoding;
338 $main::lxdebug->enter_sub();
340 my ($self, $form) = @_;
342 $form->{sid} = $form->{dbdefault};
343 &dbconnect_vars($form, $form->{dbdefault});
345 SL::DBConnect->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
347 $form->{db} =~ s/\"//g;
349 'Pg' => qq|CREATE DATABASE "$form->{db}"|,
351 qq|CREATE USER "$form->{db}" DEFAULT TABLESPACE USERS | .
352 qq|TEMPORARY TABLESPACE TEMP IDENTIFIED BY "$form->{db}"|
359 push(@{$dboptions{"Pg"}}, "ENCODING = " . $dbh->quote($form->{"encoding"}))
360 if ($form->{"encoding"});
361 if ($form->{"dbdefault"}) {
362 my $dbdefault = $form->{"dbdefault"};
363 $dbdefault =~ s/[^a-zA-Z0-9_\-]//g;
364 push(@{$dboptions{"Pg"}}, "TEMPLATE = $dbdefault");
367 my $query = $dbcreate{$form->{dbdriver}};
368 $query .= " WITH " . join(" ", @{$dboptions{"Pg"}}) if (@{$dboptions{"Pg"}});
370 # Ignore errors if the database exists.
373 if ($form->{dbdriver} eq 'Oracle') {
374 $query = qq|GRANT CONNECT, RESOURCE TO "$form->{db}"|;
375 do_query($form, $dbh, $query);
379 # setup variables for the new database
380 if ($form->{dbdriver} eq 'Oracle') {
381 $form->{dbuser} = $form->{db};
382 $form->{dbpasswd} = $form->{db};
385 &dbconnect_vars($form, $form->{db});
387 $dbh = SL::DBConnect->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
390 my $db_charset = $Common::db_encoding_to_charset{$form->{encoding}};
391 $db_charset ||= Common::DEFAULT_CHARSET;
393 my $dbupdater = SL::DBUpgrade2->new(form => $form, dbdriver => $form->{dbdriver});
395 $dbupdater->process_query($dbh, "sql/lx-office.sql", undef, $db_charset);
397 # load chart of accounts
398 $dbupdater->process_query($dbh, "sql/$form->{chart}-chart.sql", undef, $db_charset);
400 $query = "UPDATE defaults SET coa = ?";
401 do_query($form, $dbh, $query, $form->{chart});
402 $query = "UPDATE defaults SET accounting_method = ?";
403 do_query($form, $dbh, $query, $form->{accounting_method});
404 $query = "UPDATE defaults SET profit_determination = ?";
405 do_query($form, $dbh, $query, $form->{profit_determination});
406 $query = "UPDATE defaults SET inventory_system = ?";
407 do_query($form, $dbh, $query, $form->{inventory_system});
411 $main::lxdebug->leave_sub();
415 $main::lxdebug->enter_sub();
417 my ($self, $form) = @_;
418 $form->{db} =~ s/\"//g;
419 my %dbdelete = ('Pg' => qq|DROP DATABASE "$form->{db}"|,
420 'Oracle' => qq|DROP USER "$form->{db}" CASCADE|);
422 $form->{sid} = $form->{dbdefault};
423 &dbconnect_vars($form, $form->{dbdefault});
424 my $dbh = SL::DBConnect->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
426 my $query = $dbdelete{$form->{dbdriver}};
427 do_query($form, $dbh, $query);
431 $main::lxdebug->leave_sub();
434 sub dbsources_unused {
435 $main::lxdebug->enter_sub();
437 my ($self, $form) = @_;
439 $form->{only_acc_db} = 1;
441 my %members = $main::auth->read_all_users();
442 my %dbexcl = map { $_ => 1 } grep { $_ } map { $_->{dbname} } values %members;
444 $dbexcl{$form->{dbdefault}} = 1;
445 $dbexcl{$main::auth->{DB_config}->{db}} = 1;
447 my @dbunused = grep { !$dbexcl{$_} } dbsources("", $form);
449 $main::lxdebug->leave_sub();
455 $main::lxdebug->enter_sub();
457 my ($self, $form) = @_;
459 my %members = $main::auth->read_all_users();
460 my $dbupdater = SL::DBUpgrade2->new(form => $form, dbdriver => $form->{dbdriver})->parse_dbupdate_controls;
462 my ($query, $sth, %dbs_needing_updates);
464 foreach my $login (grep /[a-z]/, keys %members) {
465 my $member = $members{$login};
467 map { $form->{$_} = $member->{$_} } qw(dbname dbuser dbpasswd dbhost dbport);
468 dbconnect_vars($form, $form->{dbname});
470 my $dbh = SL::DBConnect->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd});
476 $query = qq|SELECT version FROM defaults|;
477 $sth = prepare_query($form, $dbh, $query);
478 if ($sth->execute()) {
479 ($version) = $sth->fetchrow_array();
483 $dbh->disconnect and next unless $version;
485 my $update_available = $dbupdater->update_available($version) || $dbupdater->update2_available($dbh);
488 if ($update_available) {
490 map { $dbinfo->{$_} = $member->{$_} } grep /^db/, keys %{ $member };
491 $dbs_needing_updates{$member->{dbhost} . "::" . $member->{dbname}} = $dbinfo;
495 $main::lxdebug->leave_sub();
497 return values %dbs_needing_updates;
501 $main::lxdebug->enter_sub(2);
503 my (@v, $version, $i);
505 @v = split(/\./, $_[0]);
506 while (scalar(@v) < 4) {
510 for ($i = 0; $i < 4; $i++) {
515 $main::lxdebug->leave_sub(2);
519 sub cmp_script_version {
520 my ($a_from, $a_to, $b_from, $b_to);
521 my ($i, $res_a, $res_b);
522 my ($my_a, $my_b) = ($a, $b);
524 $my_a =~ s/.*-upgrade-//;
526 $my_b =~ s/.*-upgrade-//;
528 my ($my_a_from, $my_a_to) = split(/-/, $my_a);
529 my ($my_b_from, $my_b_to) = split(/-/, $my_b);
531 $res_a = calc_version($my_a_from);
532 $res_b = calc_version($my_b_from);
534 if ($res_a == $res_b) {
535 $res_a = calc_version($my_a_to);
536 $res_b = calc_version($my_b_to);
539 return $res_a <=> $res_b;
542 sub create_schema_info_table {
543 $main::lxdebug->enter_sub();
545 my ($self, $form, $dbh) = @_;
547 my $query = "SELECT tag FROM schema_info LIMIT 1";
548 if (!$dbh->do($query)) {
551 qq|CREATE TABLE schema_info (| .
554 qq| itime timestamp DEFAULT now(), | .
555 qq| PRIMARY KEY (tag))|;
556 $dbh->do($query) || $form->dberror($query);
559 $main::lxdebug->leave_sub();
563 $main::lxdebug->enter_sub();
565 my ($self, $form) = @_;
569 $form->{sid} = $form->{dbdefault};
571 my @upgradescripts = ();
575 if ($form->{dbupdate}) {
577 # read update scripts into memory
578 opendir(SQLDIR, "sql/" . $form->{dbdriver} . "-upgrade")
579 or &error("", "sql/" . $form->{dbdriver} . "-upgrade : $!");
581 sort(cmp_script_version
582 grep(/$form->{dbdriver}-upgrade-.*?\.(sql|pl)$/,
587 my $db_charset = $::lx_office_conf{system}->{dbcharset};
588 $db_charset ||= Common::DEFAULT_CHARSET;
590 my $dbupdater = SL::DBUpgrade2->new(form => $form, dbdriver => $form->{dbdriver});
592 foreach my $db (split(/ /, $form->{dbupdate})) {
594 next unless $form->{$db};
596 # strip db from dataset
598 &dbconnect_vars($form, $db);
600 my $dbh = SL::DBConnect->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
603 $dbh->do($form->{dboptions}) if ($form->{dboptions});
606 $query = qq|SELECT version FROM defaults|;
607 my ($version) = selectrow_query($form, $dbh, $query);
609 next unless $version;
611 $version = calc_version($version);
613 foreach my $upgradescript (@upgradescripts) {
614 my $a = $upgradescript;
615 $a =~ s/^\Q$form->{dbdriver}\E-upgrade-|\.(sql|pl)$//g;
617 my ($mindb, $maxdb) = split /-/, $a;
618 my $str_maxdb = $maxdb;
619 $mindb = calc_version($mindb);
620 $maxdb = calc_version($maxdb);
622 next if ($version >= $maxdb);
624 # if there is no upgrade script exit
625 last if ($version < $mindb);
628 $main::lxdebug->message(LXDebug->DEBUG2(), "Applying Update $upgradescript");
629 $dbupdater->process_file($dbh, "sql/" . $form->{"dbdriver"} . "-upgrade/$upgradescript", $str_maxdb, $db_charset);
640 $main::lxdebug->leave_sub();
646 $main::lxdebug->enter_sub();
648 my ($self, $form, $dbupdater) = @_;
650 $form->{sid} = $form->{dbdefault};
653 my $db_charset = $::lx_office_conf{system}->{dbcharset} || Common::DEFAULT_CHARSET;
655 map { $_->{description} = SL::Iconv::convert($_->{charset}, $db_charset, $_->{description}) } values %{ $dbupdater->{all_controls} };
657 foreach my $db (split / /, $form->{dbupdate}) {
658 next unless $form->{$db};
660 # strip db from dataset
662 &dbconnect_vars($form, $db);
664 my $dbh = SL::DBConnect->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}) or $form->dberror;
666 $dbh->do($form->{dboptions}) if ($form->{dboptions});
668 $self->create_schema_info_table($form, $dbh);
670 my @upgradescripts = $dbupdater->unapplied_upgrade_scripts($dbh);
672 $dbh->disconnect and next if !@upgradescripts;
674 foreach my $control (@upgradescripts) {
676 $main::lxdebug->message(LXDebug->DEBUG2(), "Applying Update $control->{file}");
677 print $form->parse_html_template("dbupgrade/upgrade_message2", $control);
679 $dbupdater->process_file($dbh, "sql/" . $form->{"dbdriver"} . "-upgrade2/$control->{file}", $control, $db_charset);
687 $main::lxdebug->leave_sub();
693 $main::lxdebug->enter_sub();
697 # format dbconnect and dboptions string
698 dbconnect_vars($self, $self->{dbname});
700 map { $self->{$_} =~ s/\r//g; } qw(address signature);
702 $main::auth->save_user($self->{login}, map { $_, $self->{$_} } config_vars());
704 my $dbh = SL::DBConnect->connect($self->{dbconnect}, $self->{dbuser}, $self->{dbpasswd});
706 $self->create_employee_entry($::form, $dbh, $self, 1);
710 $main::lxdebug->leave_sub();
713 sub create_employee_entry {
714 $main::lxdebug->enter_sub();
719 my $myconfig = shift;
720 my $update_existing = shift;
722 if (!does_table_exist($dbh, 'employee')) {
723 $main::lxdebug->leave_sub();
727 # add login to employee table if it does not exist
728 # no error check for employee table, ignore if it does not exist
729 my ($id) = selectrow_query($form, $dbh, qq|SELECT id FROM employee WHERE login = ?|, $self->{login});
730 my ($good_db) = selectrow_query($form, $dbh, qq|select * from pg_tables where tablename = ? and schemaname = ?|, 'schema_info', 'public');
732 ($can_delete) = selectrow_query($form, $dbh, qq|SELECT tag FROM schema_info WHERE tag = ?|, 'employee_deleted') if $good_db;
735 my $query = qq|INSERT INTO employee (login, name, workphone, role) VALUES (?, ?, ?, ?)|;
736 do_query($form, $dbh, $query, ($self->{login}, $myconfig->{name}, $myconfig->{tel}, "user"));
738 } elsif ($update_existing && $can_delete) {
739 my $query = qq|UPDATE employee SET name = ?, workphone = ?, role = 'user', deleted = 'f' WHERE id = ?|;
740 do_query($form, $dbh, $query, $myconfig->{name}, $myconfig->{tel}, $id);
743 $main::lxdebug->leave_sub();
747 $main::lxdebug->enter_sub();
749 my @conf = qw(address admin businessnumber company countrycode
750 currency dateformat dbconnect dbdriver dbhost dbport dboptions
751 dbname dbuser dbpasswd email fax name numberformat password
752 printer sid signature stylesheet tel templates vclimit angebote
753 bestellungen rechnungen anfragen lieferantenbestellungen einkaufsrechnungen
754 taxnumber co_ustid duns menustyle template_format default_media
755 default_printer_id copies show_form_details favorites
756 pdonumber sdonumber hide_cvar_search_options mandatory_departments
757 sepa_creditor_id taxincluded_checked);
759 $main::lxdebug->leave_sub();
765 $main::lxdebug->enter_sub();
767 my ($self, $msg) = @_;
769 $main::lxdebug->show_backtrace();
771 if ($ENV{HTTP_USER_AGENT}) {
772 print qq|Content-Type: text/html
774 <!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0//EN">
776 <body bgcolor=ffffff>
778 <h2><font color=red>Error!</font></h2>
785 $main::lxdebug->leave_sub();