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, $login) = @_;
57 my %user_data = $main::auth->read_user($login);
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(FH, "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($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" :
180 $self->{"menustyle"} eq "xml" ? "menuXML.pl" :
183 print $form->parse_html_template("dbupgrade/footer", { "menufile" => $menufile });
189 $main::lxdebug->leave_sub();
195 $main::lxdebug->enter_sub();
197 my ($form, $db) = @_;
200 'Pg' => { 'yy-mm-dd' => 'set DateStyle to \'ISO\'',
201 'yyyy-mm-dd' => 'set DateStyle to \'ISO\'',
202 'mm/dd/yy' => 'set DateStyle to \'SQL, US\'',
203 'mm-dd-yy' => 'set DateStyle to \'POSTGRES, US\'',
204 'dd/mm/yy' => 'set DateStyle to \'SQL, EUROPEAN\'',
205 'dd-mm-yy' => 'set DateStyle to \'POSTGRES, EUROPEAN\'',
206 'dd.mm.yy' => 'set DateStyle to \'GERMAN\''
209 'yy-mm-dd' => 'ALTER SESSION SET NLS_DATE_FORMAT = \'YY-MM-DD\'',
210 'yyyy-mm-dd' => 'ALTER SESSION SET NLS_DATE_FORMAT = \'YYYY-MM-DD\'',
211 'mm/dd/yy' => 'ALTER SESSION SET NLS_DATE_FORMAT = \'MM/DD/YY\'',
212 'mm-dd-yy' => 'ALTER SESSION SET NLS_DATE_FORMAT = \'MM-DD-YY\'',
213 'dd/mm/yy' => 'ALTER SESSION SET NLS_DATE_FORMAT = \'DD/MM/YY\'',
214 'dd-mm-yy' => 'ALTER SESSION SET NLS_DATE_FORMAT = \'DD-MM-YY\'',
215 'dd.mm.yy' => 'ALTER SESSION SET NLS_DATE_FORMAT = \'DD.MM.YY\'',
218 $form->{dboptions} = $dboptions{ $form->{dbdriver} }{ $form->{dateformat} };
220 if ($form->{dbdriver} eq 'Pg') {
221 $form->{dbconnect} = "dbi:Pg:dbname=$db";
224 if ($form->{dbdriver} eq 'Oracle') {
225 $form->{dbconnect} = "dbi:Oracle:sid=$form->{sid}";
228 if ($form->{dbhost}) {
229 $form->{dbconnect} .= ";host=$form->{dbhost}";
231 if ($form->{dbport}) {
232 $form->{dbconnect} .= ";port=$form->{dbport}";
235 $main::lxdebug->leave_sub();
239 $main::lxdebug->enter_sub();
241 my @drivers = DBI->available_drivers();
243 $main::lxdebug->leave_sub();
245 return (grep { /(Pg|Oracle)/ } @drivers);
249 $main::lxdebug->enter_sub();
251 my ($self, $form) = @_;
256 $form->{dbdefault} = $form->{dbuser} unless $form->{dbdefault};
257 $form->{sid} = $form->{dbdefault};
258 &dbconnect_vars($form, $form->{dbdefault});
260 my $dbh = SL::DBConnect->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
263 if ($form->{dbdriver} eq 'Pg') {
265 qq|SELECT datname FROM pg_database | .
266 qq|WHERE NOT datname IN ('template0', 'template1')|;
267 $sth = $dbh->prepare($query);
268 $sth->execute() || $form->dberror($query);
270 while (my ($db) = $sth->fetchrow_array) {
272 if ($form->{only_acc_db}) {
274 next if ($db =~ /^template/);
276 &dbconnect_vars($form, $db);
277 my $dbh = SL::DBConnect->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
281 qq|SELECT tablename FROM pg_tables | .
282 qq|WHERE (tablename = 'defaults') AND (tableowner = ?)|;
283 my $sth = $dbh->prepare($query);
284 $sth->execute($form->{dbuser}) ||
285 $form->dberror($query . " ($form->{dbuser})");
287 if ($sth->fetchrow_array) {
288 push(@dbsources, $db);
294 push(@dbsources, $db);
298 if ($form->{dbdriver} eq 'Oracle') {
299 if ($form->{only_acc_db}) {
301 qq|SELECT owner FROM dba_objects | .
302 qq|WHERE object_name = 'DEFAULTS' AND object_type = 'TABLE'|;
304 $query = qq|SELECT username FROM dba_users|;
307 $sth = $dbh->prepare($query);
308 $sth->execute || $form->dberror($query);
310 while (my ($db) = $sth->fetchrow_array) {
311 push(@dbsources, $db);
318 $main::lxdebug->leave_sub();
323 sub dbclusterencoding {
324 $main::lxdebug->enter_sub();
326 my ($self, $form) = @_;
328 $form->{dbdefault} ||= $form->{dbuser};
330 dbconnect_vars($form, $form->{dbdefault});
332 my $dbh = SL::DBConnect->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}) || $form->dberror();
333 my $query = qq|SELECT pg_encoding_to_char(encoding) FROM pg_database WHERE datname = 'template0'|;
334 my ($cluster_encoding) = $dbh->selectrow_array($query);
337 $main::lxdebug->leave_sub();
339 return $cluster_encoding;
343 $main::lxdebug->enter_sub();
345 my ($self, $form) = @_;
347 $form->{sid} = $form->{dbdefault};
348 &dbconnect_vars($form, $form->{dbdefault});
350 SL::DBConnect->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
352 $form->{db} =~ s/\"//g;
354 'Pg' => qq|CREATE DATABASE "$form->{db}"|,
356 qq|CREATE USER "$form->{db}" DEFAULT TABLESPACE USERS | .
357 qq|TEMPORARY TABLESPACE TEMP IDENTIFIED BY "$form->{db}"|
364 push(@{$dboptions{"Pg"}}, "ENCODING = " . $dbh->quote($form->{"encoding"}))
365 if ($form->{"encoding"});
366 if ($form->{"dbdefault"}) {
367 my $dbdefault = $form->{"dbdefault"};
368 $dbdefault =~ s/[^a-zA-Z0-9_\-]//g;
369 push(@{$dboptions{"Pg"}}, "TEMPLATE = $dbdefault");
372 my $query = $dbcreate{$form->{dbdriver}};
373 $query .= " WITH " . join(" ", @{$dboptions{"Pg"}}) if (@{$dboptions{"Pg"}});
375 # Ignore errors if the database exists.
378 if ($form->{dbdriver} eq 'Oracle') {
379 $query = qq|GRANT CONNECT, RESOURCE TO "$form->{db}"|;
380 do_query($form, $dbh, $query);
384 # setup variables for the new database
385 if ($form->{dbdriver} eq 'Oracle') {
386 $form->{dbuser} = $form->{db};
387 $form->{dbpasswd} = $form->{db};
390 &dbconnect_vars($form, $form->{db});
392 $dbh = SL::DBConnect->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
395 my $db_charset = $Common::db_encoding_to_charset{$form->{encoding}};
396 $db_charset ||= Common::DEFAULT_CHARSET;
398 my $dbupdater = SL::DBUpgrade2->new(form => $form, dbdriver => $form->{dbdriver});
400 $dbupdater->process_query($dbh, "sql/lx-office.sql", undef, $db_charset);
402 # load chart of accounts
403 $dbupdater->process_query($dbh, "sql/$form->{chart}-chart.sql", undef, $db_charset);
405 $query = "UPDATE defaults SET coa = ?";
406 do_query($form, $dbh, $query, $form->{chart});
407 $query = "UPDATE defaults SET accounting_method = ?";
408 do_query($form, $dbh, $query, $form->{accounting_method});
409 $query = "UPDATE defaults SET profit_determination = ?";
410 do_query($form, $dbh, $query, $form->{profit_determination});
411 $query = "UPDATE defaults SET inventory_system = ?";
412 do_query($form, $dbh, $query, $form->{inventory_system});
416 $main::lxdebug->leave_sub();
420 $main::lxdebug->enter_sub();
422 my ($self, $form) = @_;
423 $form->{db} =~ s/\"//g;
424 my %dbdelete = ('Pg' => qq|DROP DATABASE "$form->{db}"|,
425 'Oracle' => qq|DROP USER "$form->{db}" CASCADE|);
427 $form->{sid} = $form->{dbdefault};
428 &dbconnect_vars($form, $form->{dbdefault});
429 my $dbh = SL::DBConnect->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
431 my $query = $dbdelete{$form->{dbdriver}};
432 do_query($form, $dbh, $query);
436 $main::lxdebug->leave_sub();
439 sub dbsources_unused {
440 $main::lxdebug->enter_sub();
442 my ($self, $form) = @_;
444 $form->{only_acc_db} = 1;
446 my %members = $main::auth->read_all_users();
447 my %dbexcl = map { $_ => 1 } grep { $_ } map { $_->{dbname} } values %members;
449 $dbexcl{$form->{dbdefault}} = 1;
450 $dbexcl{$main::auth->{DB_config}->{db}} = 1;
452 my @dbunused = grep { !$dbexcl{$_} } dbsources("", $form);
454 $main::lxdebug->leave_sub();
460 $main::lxdebug->enter_sub();
462 my ($self, $form) = @_;
464 my %members = $main::auth->read_all_users();
465 my $dbupdater = SL::DBUpgrade2->new(form => $form, dbdriver => $form->{dbdriver})->parse_dbupdate_controls;
467 my ($query, $sth, %dbs_needing_updates);
469 foreach my $login (grep /[a-z]/, keys %members) {
470 my $member = $members{$login};
472 map { $form->{$_} = $member->{$_} } qw(dbname dbuser dbpasswd dbhost dbport);
473 dbconnect_vars($form, $form->{dbname});
475 my $dbh = SL::DBConnect->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd});
481 $query = qq|SELECT version FROM defaults|;
482 $sth = prepare_query($form, $dbh, $query);
483 if ($sth->execute()) {
484 ($version) = $sth->fetchrow_array();
488 $dbh->disconnect and next unless $version;
490 my $update_available = $dbupdater->update_available($version) || $dbupdater->update2_available($dbh);
493 if ($update_available) {
495 map { $dbinfo->{$_} = $member->{$_} } grep /^db/, keys %{ $member };
496 $dbs_needing_updates{$member->{dbhost} . "::" . $member->{dbname}} = $dbinfo;
500 $main::lxdebug->leave_sub();
502 return values %dbs_needing_updates;
506 $main::lxdebug->enter_sub(2);
508 my (@v, $version, $i);
510 @v = split(/\./, $_[0]);
511 while (scalar(@v) < 4) {
515 for ($i = 0; $i < 4; $i++) {
520 $main::lxdebug->leave_sub(2);
524 sub cmp_script_version {
525 my ($a_from, $a_to, $b_from, $b_to);
526 my ($i, $res_a, $res_b);
527 my ($my_a, $my_b) = ($a, $b);
529 $my_a =~ s/.*-upgrade-//;
531 $my_b =~ s/.*-upgrade-//;
533 my ($my_a_from, $my_a_to) = split(/-/, $my_a);
534 my ($my_b_from, $my_b_to) = split(/-/, $my_b);
536 $res_a = calc_version($my_a_from);
537 $res_b = calc_version($my_b_from);
539 if ($res_a == $res_b) {
540 $res_a = calc_version($my_a_to);
541 $res_b = calc_version($my_b_to);
544 return $res_a <=> $res_b;
547 sub create_schema_info_table {
548 $main::lxdebug->enter_sub();
550 my ($self, $form, $dbh) = @_;
552 my $query = "SELECT tag FROM schema_info LIMIT 1";
553 if (!$dbh->do($query)) {
556 qq|CREATE TABLE schema_info (| .
559 qq| itime timestamp DEFAULT now(), | .
560 qq| PRIMARY KEY (tag))|;
561 $dbh->do($query) || $form->dberror($query);
564 $main::lxdebug->leave_sub();
568 $main::lxdebug->enter_sub();
570 my ($self, $form) = @_;
574 $form->{sid} = $form->{dbdefault};
576 my @upgradescripts = ();
580 if ($form->{dbupdate}) {
582 # read update scripts into memory
583 opendir(SQLDIR, "sql/" . $form->{dbdriver} . "-upgrade")
584 or &error("", "sql/" . $form->{dbdriver} . "-upgrade : $!");
586 sort(cmp_script_version
587 grep(/$form->{dbdriver}-upgrade-.*?\.(sql|pl)$/,
592 my $db_charset = $::lx_office_conf{system}->{dbcharset};
593 $db_charset ||= Common::DEFAULT_CHARSET;
595 my $dbupdater = SL::DBUpgrade2->new(form => $form, dbdriver => $form->{dbdriver});
597 foreach my $db (split(/ /, $form->{dbupdate})) {
599 next unless $form->{$db};
601 # strip db from dataset
603 &dbconnect_vars($form, $db);
605 my $dbh = SL::DBConnect->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
608 $dbh->do($form->{dboptions}) if ($form->{dboptions});
611 $query = qq|SELECT version FROM defaults|;
612 my ($version) = selectrow_query($form, $dbh, $query);
614 next unless $version;
616 $version = calc_version($version);
618 foreach my $upgradescript (@upgradescripts) {
619 my $a = $upgradescript;
620 $a =~ s/^\Q$form->{dbdriver}\E-upgrade-|\.(sql|pl)$//g;
622 my ($mindb, $maxdb) = split /-/, $a;
623 my $str_maxdb = $maxdb;
624 $mindb = calc_version($mindb);
625 $maxdb = calc_version($maxdb);
627 next if ($version >= $maxdb);
629 # if there is no upgrade script exit
630 last if ($version < $mindb);
633 $main::lxdebug->message(LXDebug->DEBUG2(), "Applying Update $upgradescript");
634 $dbupdater->process_file($dbh, "sql/" . $form->{"dbdriver"} . "-upgrade/$upgradescript", $str_maxdb, $db_charset);
645 $main::lxdebug->leave_sub();
651 $main::lxdebug->enter_sub();
653 my ($self, $form, $dbupdater) = @_;
655 $form->{sid} = $form->{dbdefault};
658 my $db_charset = $::lx_office_conf{system}->{dbcharset} || Common::DEFAULT_CHARSET;
660 map { $_->{description} = SL::Iconv::convert($_->{charset}, $db_charset, $_->{description}) } values %{ $dbupdater->{all_controls} };
662 foreach my $db (split / /, $form->{dbupdate}) {
663 next unless $form->{$db};
665 # strip db from dataset
667 &dbconnect_vars($form, $db);
669 my $dbh = SL::DBConnect->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}) or $form->dberror;
671 $dbh->do($form->{dboptions}) if ($form->{dboptions});
673 $self->create_schema_info_table($form, $dbh);
675 my @upgradescripts = $dbupdater->unapplied_upgrade_scripts($dbh);
677 $dbh->disconnect and next if !@upgradescripts;
679 foreach my $control (@upgradescripts) {
681 $main::lxdebug->message(LXDebug->DEBUG2(), "Applying Update $control->{file}");
682 print $form->parse_html_template("dbupgrade/upgrade_message2", $control);
684 $dbupdater->process_file($dbh, "sql/" . $form->{"dbdriver"} . "-upgrade2/$control->{file}", $control, $db_charset);
692 $main::lxdebug->leave_sub();
698 $main::lxdebug->enter_sub();
701 my $form = \%main::form;
703 # format dbconnect and dboptions string
704 dbconnect_vars($self, $self->{dbname});
706 map { $self->{$_} =~ s/\r//g; } qw(address signature);
708 $main::auth->save_user($self->{login}, map { $_, $self->{$_} } config_vars());
710 my $dbh = SL::DBConnect->connect($self->{dbconnect}, $self->{dbuser}, $self->{dbpasswd});
712 $self->create_employee_entry($form, $dbh, $self, 1);
716 $main::lxdebug->leave_sub();
719 sub create_employee_entry {
720 $main::lxdebug->enter_sub();
725 my $myconfig = shift;
726 my $update_existing = shift;
728 if (!does_table_exist($dbh, 'employee')) {
729 $main::lxdebug->leave_sub();
733 # add login to employee table if it does not exist
734 # no error check for employee table, ignore if it does not exist
735 my ($id) = selectrow_query($form, $dbh, qq|SELECT id FROM employee WHERE login = ?|, $self->{login});
738 my $query = qq|INSERT INTO employee (login, name, workphone, role) VALUES (?, ?, ?, ?)|;
739 do_query($form, $dbh, $query, ($self->{login}, $myconfig->{name}, $myconfig->{tel}, "user"));
741 } elsif ($update_existing) {
742 my $query = qq|UPDATE employee SET name = ?, workphone = ?, role = 'user' WHERE id = ?|;
743 do_query($form, $dbh, $query, $myconfig->{name}, $myconfig->{tel}, $id);
746 $main::lxdebug->leave_sub();
750 $main::lxdebug->enter_sub();
752 my @conf = qw(address admin businessnumber company countrycode
753 currency dateformat dbconnect dbdriver dbhost dbport dboptions
754 dbname dbuser dbpasswd email fax name numberformat password
755 printer sid signature stylesheet tel templates vclimit angebote
756 bestellungen rechnungen anfragen lieferantenbestellungen einkaufsrechnungen
757 taxnumber co_ustid duns menustyle template_format default_media
758 default_printer_id copies show_form_details favorites
759 pdonumber sdonumber hide_cvar_search_options mandatory_departments
762 $main::lxdebug->leave_sub();
768 $main::lxdebug->enter_sub();
770 my ($self, $msg) = @_;
772 $main::lxdebug->show_backtrace();
774 if ($ENV{HTTP_USER_AGENT}) {
775 print qq|Content-Type: text/html
777 <!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0//EN">
779 <body bgcolor=ffffff>
781 <h2><font color=red>Error!</font></h2>
788 $main::lxdebug->leave_sub();