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->{"title"} = $main::locale->text("Dataset upgrade");
141 print $form->parse_html_template("dbupgrade/header");
143 $form->{dbupdate} = "db$myconfig{dbname}";
144 $form->{ $form->{dbupdate} } = 1;
146 if ($form->{"show_dbupdate_warning"}) {
147 print $form->parse_html_template("dbupgrade/warning");
152 if (!open(FH, ">", $::lx_office_conf{paths}->{userspath} . "/nologin")) {
153 $form->show_generic_error($main::locale->text('A temporary file could not be created. ' .
154 'Please verify that the directory "#1" is writeable by the webserver.',
155 $::lx_office_conf{paths}->{userspath}),
159 # required for Oracle
160 $form->{dbdefault} = $sid;
162 # ignore HUP, QUIT in case the webserver times out
163 $SIG{HUP} = 'IGNORE';
164 $SIG{QUIT} = 'IGNORE';
166 $self->dbupdate($form);
167 $self->dbupdate2($form, $dbupdater);
168 SL::DBUpgrade2->new(form => $::form, dbdriver => 'Pg', auth => 1)->apply_admin_dbupgrade_scripts(0);
173 unlink($::lx_office_conf{paths}->{userspath} . "/nologin");
176 $self->{"menustyle"} eq "v3" ? "menuv3.pl" :
177 $self->{"menustyle"} eq "neu" ? "menunew.pl" :
178 $self->{"menustyle"} eq "js" ? "menujs.pl" :
181 print $form->parse_html_template("dbupgrade/footer", { "menufile" => $menufile });
187 $main::lxdebug->leave_sub();
193 $main::lxdebug->enter_sub();
195 my ($form, $db) = @_;
198 'Pg' => { 'yy-mm-dd' => 'set DateStyle to \'ISO\'',
199 'yyyy-mm-dd' => 'set DateStyle to \'ISO\'',
200 'mm/dd/yy' => 'set DateStyle to \'SQL, US\'',
201 'dd/mm/yy' => 'set DateStyle to \'SQL, EUROPEAN\'',
202 'dd.mm.yy' => 'set DateStyle to \'GERMAN\''
205 'yy-mm-dd' => 'ALTER SESSION SET NLS_DATE_FORMAT = \'YY-MM-DD\'',
206 'yyyy-mm-dd' => 'ALTER SESSION SET NLS_DATE_FORMAT = \'YYYY-MM-DD\'',
207 'mm/dd/yy' => 'ALTER SESSION SET NLS_DATE_FORMAT = \'MM/DD/YY\'',
208 'dd/mm/yy' => 'ALTER SESSION SET NLS_DATE_FORMAT = \'DD/MM/YY\'',
209 'dd.mm.yy' => 'ALTER SESSION SET NLS_DATE_FORMAT = \'DD.MM.YY\'',
212 $form->{dboptions} = $dboptions{ $form->{dbdriver} }{ $form->{dateformat} };
214 if ($form->{dbdriver} eq 'Pg') {
215 $form->{dbconnect} = "dbi:Pg:dbname=$db";
218 if ($form->{dbdriver} eq 'Oracle') {
219 $form->{dbconnect} = "dbi:Oracle:sid=$form->{sid}";
222 if ($form->{dbhost}) {
223 $form->{dbconnect} .= ";host=$form->{dbhost}";
225 if ($form->{dbport}) {
226 $form->{dbconnect} .= ";port=$form->{dbport}";
229 $main::lxdebug->leave_sub();
233 $main::lxdebug->enter_sub();
235 my @drivers = DBI->available_drivers();
237 $main::lxdebug->leave_sub();
239 return (grep { /(Pg|Oracle)/ } @drivers);
243 $main::lxdebug->enter_sub();
245 my ($self, $form) = @_;
250 $form->{dbdefault} = $form->{dbuser} unless $form->{dbdefault};
251 $form->{sid} = $form->{dbdefault};
252 &dbconnect_vars($form, $form->{dbdefault});
254 my $dbh = SL::DBConnect->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
257 if ($form->{dbdriver} eq 'Pg') {
259 qq|SELECT datname FROM pg_database | .
260 qq|WHERE NOT datname IN ('template0', 'template1')|;
261 $sth = $dbh->prepare($query);
262 $sth->execute() || $form->dberror($query);
264 while (my ($db) = $sth->fetchrow_array) {
266 if ($form->{only_acc_db}) {
268 next if ($db =~ /^template/);
270 &dbconnect_vars($form, $db);
271 my $dbh = SL::DBConnect->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
275 qq|SELECT tablename FROM pg_tables | .
276 qq|WHERE (tablename = 'defaults') AND (tableowner = ?)|;
277 my $sth = $dbh->prepare($query);
278 $sth->execute($form->{dbuser}) ||
279 $form->dberror($query . " ($form->{dbuser})");
281 if ($sth->fetchrow_array) {
282 push(@dbsources, $db);
288 push(@dbsources, $db);
292 if ($form->{dbdriver} eq 'Oracle') {
293 if ($form->{only_acc_db}) {
295 qq|SELECT owner FROM dba_objects | .
296 qq|WHERE object_name = 'DEFAULTS' AND object_type = 'TABLE'|;
298 $query = qq|SELECT username FROM dba_users|;
301 $sth = $dbh->prepare($query);
302 $sth->execute || $form->dberror($query);
304 while (my ($db) = $sth->fetchrow_array) {
305 push(@dbsources, $db);
312 $main::lxdebug->leave_sub();
317 sub dbclusterencoding {
318 $main::lxdebug->enter_sub();
320 my ($self, $form) = @_;
322 $form->{dbdefault} ||= $form->{dbuser};
324 dbconnect_vars($form, $form->{dbdefault});
326 my $dbh = SL::DBConnect->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}) || $form->dberror();
327 my $query = qq|SELECT pg_encoding_to_char(encoding) FROM pg_database WHERE datname = 'template0'|;
328 my ($cluster_encoding) = $dbh->selectrow_array($query);
331 $main::lxdebug->leave_sub();
333 return $cluster_encoding;
337 $main::lxdebug->enter_sub();
339 my ($self, $form) = @_;
341 $form->{sid} = $form->{dbdefault};
342 &dbconnect_vars($form, $form->{dbdefault});
344 SL::DBConnect->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
346 $form->{db} =~ s/\"//g;
348 'Pg' => qq|CREATE DATABASE "$form->{db}"|,
350 qq|CREATE USER "$form->{db}" DEFAULT TABLESPACE USERS | .
351 qq|TEMPORARY TABLESPACE TEMP IDENTIFIED BY "$form->{db}"|
358 push(@{$dboptions{"Pg"}}, "ENCODING = " . $dbh->quote($form->{"encoding"}))
359 if ($form->{"encoding"});
360 if ($form->{"dbdefault"}) {
361 my $dbdefault = $form->{"dbdefault"};
362 $dbdefault =~ s/[^a-zA-Z0-9_\-]//g;
363 push(@{$dboptions{"Pg"}}, "TEMPLATE = $dbdefault");
366 my $query = $dbcreate{$form->{dbdriver}};
367 $query .= " WITH " . join(" ", @{$dboptions{"Pg"}}) if (@{$dboptions{"Pg"}});
369 # Ignore errors if the database exists.
372 if ($form->{dbdriver} eq 'Oracle') {
373 $query = qq|GRANT CONNECT, RESOURCE TO "$form->{db}"|;
374 do_query($form, $dbh, $query);
378 # setup variables for the new database
379 if ($form->{dbdriver} eq 'Oracle') {
380 $form->{dbuser} = $form->{db};
381 $form->{dbpasswd} = $form->{db};
384 &dbconnect_vars($form, $form->{db});
386 $dbh = SL::DBConnect->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
389 my $db_charset = $Common::db_encoding_to_charset{$form->{encoding}};
390 $db_charset ||= Common::DEFAULT_CHARSET;
392 my $dbupdater = SL::DBUpgrade2->new(form => $form, dbdriver => $form->{dbdriver});
394 $dbupdater->process_query($dbh, "sql/lx-office.sql", undef, $db_charset);
396 # load chart of accounts
397 $dbupdater->process_query($dbh, "sql/$form->{chart}-chart.sql", undef, $db_charset);
399 $query = "UPDATE defaults SET coa = ?";
400 do_query($form, $dbh, $query, $form->{chart});
401 $query = "UPDATE defaults SET accounting_method = ?";
402 do_query($form, $dbh, $query, $form->{accounting_method});
403 $query = "UPDATE defaults SET profit_determination = ?";
404 do_query($form, $dbh, $query, $form->{profit_determination});
405 $query = "UPDATE defaults SET inventory_system = ?";
406 do_query($form, $dbh, $query, $form->{inventory_system});
410 $main::lxdebug->leave_sub();
414 $main::lxdebug->enter_sub();
416 my ($self, $form) = @_;
417 $form->{db} =~ s/\"//g;
418 my %dbdelete = ('Pg' => qq|DROP DATABASE "$form->{db}"|,
419 'Oracle' => qq|DROP USER "$form->{db}" CASCADE|);
421 $form->{sid} = $form->{dbdefault};
422 &dbconnect_vars($form, $form->{dbdefault});
423 my $dbh = SL::DBConnect->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
425 my $query = $dbdelete{$form->{dbdriver}};
426 do_query($form, $dbh, $query);
430 $main::lxdebug->leave_sub();
433 sub dbsources_unused {
434 $main::lxdebug->enter_sub();
436 my ($self, $form) = @_;
438 $form->{only_acc_db} = 1;
440 my %members = $main::auth->read_all_users();
441 my %dbexcl = map { $_ => 1 } grep { $_ } map { $_->{dbname} } values %members;
443 $dbexcl{$form->{dbdefault}} = 1;
444 $dbexcl{$main::auth->{DB_config}->{db}} = 1;
446 my @dbunused = grep { !$dbexcl{$_} } dbsources("", $form);
448 $main::lxdebug->leave_sub();
454 $main::lxdebug->enter_sub();
456 my ($self, $form) = @_;
458 my %members = $main::auth->read_all_users();
459 my $dbupdater = SL::DBUpgrade2->new(form => $form, dbdriver => $form->{dbdriver})->parse_dbupdate_controls;
461 my ($query, $sth, %dbs_needing_updates);
463 foreach my $login (grep /[a-z]/, keys %members) {
464 my $member = $members{$login};
466 map { $form->{$_} = $member->{$_} } qw(dbname dbuser dbpasswd dbhost dbport);
467 dbconnect_vars($form, $form->{dbname});
469 my $dbh = SL::DBConnect->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd});
475 $query = qq|SELECT version FROM defaults|;
476 $sth = prepare_query($form, $dbh, $query);
477 if ($sth->execute()) {
478 ($version) = $sth->fetchrow_array();
482 $dbh->disconnect and next unless $version;
484 my $update_available = $dbupdater->update_available($version) || $dbupdater->update2_available($dbh);
487 if ($update_available) {
489 map { $dbinfo->{$_} = $member->{$_} } grep /^db/, keys %{ $member };
490 $dbs_needing_updates{$member->{dbhost} . "::" . $member->{dbname}} = $dbinfo;
494 $main::lxdebug->leave_sub();
496 return values %dbs_needing_updates;
500 $main::lxdebug->enter_sub(2);
502 my (@v, $version, $i);
504 @v = split(/\./, $_[0]);
505 while (scalar(@v) < 4) {
509 for ($i = 0; $i < 4; $i++) {
514 $main::lxdebug->leave_sub(2);
518 sub cmp_script_version {
519 my ($a_from, $a_to, $b_from, $b_to);
520 my ($i, $res_a, $res_b);
521 my ($my_a, $my_b) = ($a, $b);
523 $my_a =~ s/.*-upgrade-//;
525 $my_b =~ s/.*-upgrade-//;
527 my ($my_a_from, $my_a_to) = split(/-/, $my_a);
528 my ($my_b_from, $my_b_to) = split(/-/, $my_b);
530 $res_a = calc_version($my_a_from);
531 $res_b = calc_version($my_b_from);
533 if ($res_a == $res_b) {
534 $res_a = calc_version($my_a_to);
535 $res_b = calc_version($my_b_to);
538 return $res_a <=> $res_b;
541 sub create_schema_info_table {
542 $main::lxdebug->enter_sub();
544 my ($self, $form, $dbh) = @_;
546 my $query = "SELECT tag FROM schema_info LIMIT 1";
547 if (!$dbh->do($query)) {
550 qq|CREATE TABLE schema_info (| .
553 qq| itime timestamp DEFAULT now(), | .
554 qq| PRIMARY KEY (tag))|;
555 $dbh->do($query) || $form->dberror($query);
558 $main::lxdebug->leave_sub();
562 $main::lxdebug->enter_sub();
564 my ($self, $form) = @_;
568 $form->{sid} = $form->{dbdefault};
570 my @upgradescripts = ();
574 if ($form->{dbupdate}) {
576 # read update scripts into memory
577 opendir(SQLDIR, "sql/" . $form->{dbdriver} . "-upgrade")
578 or &error("", "sql/" . $form->{dbdriver} . "-upgrade : $!");
580 sort(cmp_script_version
581 grep(/$form->{dbdriver}-upgrade-.*?\.(sql|pl)$/,
586 my $db_charset = $::lx_office_conf{system}->{dbcharset};
587 $db_charset ||= Common::DEFAULT_CHARSET;
589 my $dbupdater = SL::DBUpgrade2->new(form => $form, dbdriver => $form->{dbdriver});
591 foreach my $db (split(/ /, $form->{dbupdate})) {
593 next unless $form->{$db};
595 # strip db from dataset
597 &dbconnect_vars($form, $db);
599 my $dbh = SL::DBConnect->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
602 $dbh->do($form->{dboptions}) if ($form->{dboptions});
605 $query = qq|SELECT version FROM defaults|;
606 my ($version) = selectrow_query($form, $dbh, $query);
608 next unless $version;
610 $version = calc_version($version);
612 foreach my $upgradescript (@upgradescripts) {
613 my $a = $upgradescript;
614 $a =~ s/^\Q$form->{dbdriver}\E-upgrade-|\.(sql|pl)$//g;
616 my ($mindb, $maxdb) = split /-/, $a;
617 my $str_maxdb = $maxdb;
618 $mindb = calc_version($mindb);
619 $maxdb = calc_version($maxdb);
621 next if ($version >= $maxdb);
623 # if there is no upgrade script exit
624 last if ($version < $mindb);
627 $main::lxdebug->message(LXDebug->DEBUG2(), "Applying Update $upgradescript");
628 $dbupdater->process_file($dbh, "sql/" . $form->{"dbdriver"} . "-upgrade/$upgradescript", $str_maxdb, $db_charset);
639 $main::lxdebug->leave_sub();
645 $main::lxdebug->enter_sub();
647 my ($self, $form, $dbupdater) = @_;
649 $form->{sid} = $form->{dbdefault};
652 my $db_charset = $::lx_office_conf{system}->{dbcharset} || Common::DEFAULT_CHARSET;
654 map { $_->{description} = SL::Iconv::convert($_->{charset}, $db_charset, $_->{description}) } values %{ $dbupdater->{all_controls} };
656 foreach my $db (split / /, $form->{dbupdate}) {
657 next unless $form->{$db};
659 # strip db from dataset
661 &dbconnect_vars($form, $db);
663 my $dbh = SL::DBConnect->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}) or $form->dberror;
665 $dbh->do($form->{dboptions}) if ($form->{dboptions});
667 $self->create_schema_info_table($form, $dbh);
669 my @upgradescripts = $dbupdater->unapplied_upgrade_scripts($dbh);
671 $dbh->disconnect and next if !@upgradescripts;
673 foreach my $control (@upgradescripts) {
675 $main::lxdebug->message(LXDebug->DEBUG2(), "Applying Update $control->{file}");
676 print $form->parse_html_template("dbupgrade/upgrade_message2", $control);
678 $dbupdater->process_file($dbh, "sql/" . $form->{"dbdriver"} . "-upgrade2/$control->{file}", $control, $db_charset);
686 $main::lxdebug->leave_sub();
692 $main::lxdebug->enter_sub();
696 # format dbconnect and dboptions string
697 dbconnect_vars($self, $self->{dbname});
699 map { $self->{$_} =~ s/\r//g; } qw(address signature);
701 $main::auth->save_user($self->{login}, map { $_, $self->{$_} } config_vars());
703 my $dbh = SL::DBConnect->connect($self->{dbconnect}, $self->{dbuser}, $self->{dbpasswd});
705 $self->create_employee_entry($::form, $dbh, $self, 1);
709 $main::lxdebug->leave_sub();
712 sub create_employee_entry {
713 $main::lxdebug->enter_sub();
718 my $myconfig = shift;
719 my $update_existing = shift;
721 if (!does_table_exist($dbh, 'employee')) {
722 $main::lxdebug->leave_sub();
726 # add login to employee table if it does not exist
727 # no error check for employee table, ignore if it does not exist
728 my ($id) = selectrow_query($form, $dbh, qq|SELECT id FROM employee WHERE login = ?|, $self->{login});
729 my ($good_db) = selectrow_query($form, $dbh, qq|select * from pg_tables where tablename = ? and schemaname = ?|, 'schema_info', 'public');
731 ($can_delete) = selectrow_query($form, $dbh, qq|SELECT tag FROM schema_info WHERE tag = ?|, 'employee_deleted') if $good_db;
734 my $query = qq|INSERT INTO employee (login, name, workphone, role) VALUES (?, ?, ?, ?)|;
735 do_query($form, $dbh, $query, ($self->{login}, $myconfig->{name}, $myconfig->{tel}, "user"));
737 } elsif ($update_existing && $can_delete) {
738 my $query = qq|UPDATE employee SET name = ?, workphone = ?, role = 'user', deleted = 'f' WHERE id = ?|;
739 do_query($form, $dbh, $query, $myconfig->{name}, $myconfig->{tel}, $id);
742 $main::lxdebug->leave_sub();
746 $main::lxdebug->enter_sub();
748 my @conf = qw(address admin businessnumber company countrycode
749 currency dateformat dbconnect dbdriver dbhost dbport dboptions
750 dbname dbuser dbpasswd email fax name numberformat password
751 printer sid signature stylesheet tel templates vclimit angebote
752 bestellungen rechnungen anfragen lieferantenbestellungen einkaufsrechnungen
753 taxnumber co_ustid duns menustyle template_format default_media
754 default_printer_id copies show_form_details favorites
755 pdonumber sdonumber hide_cvar_search_options mandatory_departments
756 sepa_creditor_id taxincluded_checked);
758 $main::lxdebug->leave_sub();
764 $main::lxdebug->enter_sub();
766 my ($self, $msg) = @_;
768 $main::lxdebug->show_backtrace();
770 if ($ENV{HTTP_USER_AGENT}) {
771 print qq|Content-Type: text/html
773 <!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0//EN">
775 <body bgcolor=ffffff>
777 <h2><font color=red>Error!</font></h2>
784 $main::lxdebug->leave_sub();