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 #=====================================================================
49 $main::lxdebug->enter_sub();
51 my ($type, $login) = @_;
56 my %user_data = $main::auth->read_user($login);
57 map { $self->{$_} = $user_data{$_} } keys %user_data;
60 $main::lxdebug->leave_sub();
66 $main::lxdebug->enter_sub();
73 # scan the locale directory and read in the LANGUAGE files
74 opendir(DIR, "locale");
76 my @dir = grep(!/(^\.\.?$|\..*)/, readdir(DIR));
78 foreach my $dir (@dir) {
79 next unless open(FH, "locale/$dir/LANGUAGE");
83 $cc{$dir} = "@language";
88 $main::lxdebug->leave_sub();
94 $main::lxdebug->enter_sub();
96 my ($self, $form) = @_;
103 if ($self->{login}) {
104 my %myconfig = $main::auth->read_user($self->{login});
106 # check if database is down
108 DBI->connect($myconfig{dbconnect}, $myconfig{dbuser},
110 or $self->error($DBI::errstr);
112 # we got a connection, check the version
113 my $query = qq|SELECT version FROM defaults|;
114 my $sth = $dbh->prepare($query);
115 $sth->execute || $form->dberror($query);
117 my ($dbversion) = $sth->fetchrow_array;
120 $self->create_employee_entry($form, $dbh, \%myconfig);
122 $self->create_schema_info_table($form, $dbh);
128 my $dbupdater = SL::DBUpgrade2->new($form, $myconfig{"dbdriver"});
129 my $controls = $dbupdater->parse_dbupdate_controls;
131 map({ $form->{$_} = $myconfig{$_} }
132 qw(dbname dbhost dbport dbdriver dbuser dbpasswd dbconnect dateformat));
134 if (update_available($myconfig{"dbdriver"}, $dbversion) ||
135 update2_available($form, $controls)) {
137 $form->{"stylesheet"} = "lx-office-erp.css";
138 $form->{"title"} = $main::locale->text("Dataset upgrade");
140 print $form->parse_html_template("dbupgrade/header");
142 $form->{dbupdate} = "db$myconfig{dbname}";
143 $form->{ $form->{dbupdate} } = 1;
145 if ($form->{"show_dbupdate_warning"}) {
146 print $form->parse_html_template("dbupgrade/warning");
151 if (!open(FH, ">$main::userspath/nologin")) {
152 $form->show_generic_error($main::locale->text('A temporary file could not be created. ' .
153 'Please verify that the directory "#1" is writeable by the webserver.',
158 # required for Oracle
159 $form->{dbdefault} = $sid;
161 # ignore HUP, QUIT in case the webserver times out
162 $SIG{HUP} = 'IGNORE';
163 $SIG{QUIT} = 'IGNORE';
165 $self->dbupdate($form);
166 $self->dbupdate2($form, $dbupdater);
171 unlink("$main::userspath/nologin");
174 $self->{"menustyle"} eq "v3" ? "menuv3.pl" :
175 $self->{"menustyle"} eq "neu" ? "menunew.pl" :
176 $self->{"menustyle"} eq "js" ? "menujs.pl" :
177 $self->{"menustyle"} eq "xml" ? "menuXML.pl" :
180 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 'mm-dd-yy' => 'set DateStyle to \'POSTGRES, US\'',
202 'dd/mm/yy' => 'set DateStyle to \'SQL, EUROPEAN\'',
203 'dd-mm-yy' => 'set DateStyle to \'POSTGRES, EUROPEAN\'',
204 'dd.mm.yy' => 'set DateStyle to \'GERMAN\''
207 'yy-mm-dd' => 'ALTER SESSION SET NLS_DATE_FORMAT = \'YY-MM-DD\'',
208 'yyyy-mm-dd' => 'ALTER SESSION SET NLS_DATE_FORMAT = \'YYYY-MM-DD\'',
209 'mm/dd/yy' => 'ALTER SESSION SET NLS_DATE_FORMAT = \'MM/DD/YY\'',
210 'mm-dd-yy' => 'ALTER SESSION SET NLS_DATE_FORMAT = \'MM-DD-YY\'',
211 'dd/mm/yy' => 'ALTER SESSION SET NLS_DATE_FORMAT = \'DD/MM/YY\'',
212 'dd-mm-yy' => 'ALTER SESSION SET NLS_DATE_FORMAT = \'DD-MM-YY\'',
213 'dd.mm.yy' => 'ALTER SESSION SET NLS_DATE_FORMAT = \'DD.MM.YY\'',
216 $form->{dboptions} = $dboptions{ $form->{dbdriver} }{ $form->{dateformat} };
218 if ($form->{dbdriver} eq 'Pg') {
219 $form->{dbconnect} = "dbi:Pg:dbname=$db";
222 if ($form->{dbdriver} eq 'Oracle') {
223 $form->{dbconnect} = "dbi:Oracle:sid=$form->{sid}";
226 if ($form->{dbhost}) {
227 $form->{dbconnect} .= ";host=$form->{dbhost}";
229 if ($form->{dbport}) {
230 $form->{dbconnect} .= ";port=$form->{dbport}";
233 $main::lxdebug->leave_sub();
237 $main::lxdebug->enter_sub();
239 my @drivers = DBI->available_drivers();
241 $main::lxdebug->leave_sub();
243 return (grep { /(Pg|Oracle)/ } @drivers);
247 $main::lxdebug->enter_sub();
249 my ($self, $form) = @_;
254 $form->{dbdefault} = $form->{dbuser} unless $form->{dbdefault};
255 $form->{sid} = $form->{dbdefault};
256 &dbconnect_vars($form, $form->{dbdefault});
259 DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
262 if ($form->{dbdriver} eq 'Pg') {
264 qq|SELECT datname FROM pg_database | .
265 qq|WHERE NOT datname IN ('template0', 'template1')|;
266 $sth = $dbh->prepare($query);
267 $sth->execute() || $form->dberror($query);
269 while (my ($db) = $sth->fetchrow_array) {
271 if ($form->{only_acc_db}) {
273 next if ($db =~ /^template/);
275 &dbconnect_vars($form, $db);
277 DBI->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 = DBI->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 DBI->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 = DBI->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});
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});
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});
424 DBI->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 $controls = SL::DBUpgrade2->new($form, $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 = DBI->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();
484 next unless $version;
486 if (update_available($form->{dbdriver}, $version) || update2_available($form, $controls)) {
488 map { $dbinfo->{$_} = $member->{$_} } grep /^db/, keys %{ $member };
489 $dbs_needing_updates{$member->{dbhost} . "::" . $member->{dbname}} = $dbinfo;
493 $main::lxdebug->leave_sub();
495 return values %dbs_needing_updates;
499 $main::lxdebug->enter_sub(2);
501 my (@v, $version, $i);
503 @v = split(/\./, $_[0]);
504 while (scalar(@v) < 4) {
508 for ($i = 0; $i < 4; $i++) {
513 $main::lxdebug->leave_sub(2);
517 sub cmp_script_version {
518 my ($a_from, $a_to, $b_from, $b_to);
519 my ($i, $res_a, $res_b);
520 my ($my_a, $my_b) = ($a, $b);
522 $my_a =~ s/.*-upgrade-//;
524 $my_b =~ s/.*-upgrade-//;
526 my ($my_a_from, $my_a_to) = split(/-/, $my_a);
527 my ($my_b_from, $my_b_to) = split(/-/, $my_b);
529 $res_a = calc_version($my_a_from);
530 $res_b = calc_version($my_b_from);
532 if ($res_a == $res_b) {
533 $res_a = calc_version($my_a_to);
534 $res_b = calc_version($my_b_to);
537 return $res_a <=> $res_b;
540 sub update_available {
541 my ($dbdriver, $cur_version) = @_;
545 opendir SQLDIR, "sql/${dbdriver}-upgrade" || error("", "sql/${dbdriver}-upgrade: $!");
546 my @upgradescripts = grep /${dbdriver}-upgrade-\Q$cur_version\E.*\.(sql|pl)$/, readdir SQLDIR;
549 return ($#upgradescripts > -1);
552 sub create_schema_info_table {
553 $main::lxdebug->enter_sub();
555 my ($self, $form, $dbh) = @_;
557 my $query = "SELECT tag FROM schema_info LIMIT 1";
558 if (!$dbh->do($query)) {
561 qq|CREATE TABLE schema_info (| .
564 qq| itime timestamp DEFAULT now(), | .
565 qq| PRIMARY KEY (tag))|;
566 $dbh->do($query) || $form->dberror($query);
569 $main::lxdebug->leave_sub();
573 $main::lxdebug->enter_sub();
575 my ($self, $form) = @_;
579 $form->{sid} = $form->{dbdefault};
581 my @upgradescripts = ();
585 if ($form->{dbupdate}) {
587 # read update scripts into memory
588 opendir(SQLDIR, "sql/" . $form->{dbdriver} . "-upgrade")
589 or &error("", "sql/" . $form->{dbdriver} . "-upgrade : $!");
591 sort(cmp_script_version
592 grep(/$form->{dbdriver}-upgrade-.*?\.(sql|pl)$/,
597 my $db_charset = $main::dbcharset;
598 $db_charset ||= Common::DEFAULT_CHARSET;
600 my $dbupdater = SL::DBUpgrade2->new($form, $form->{dbdriver});
602 foreach my $db (split(/ /, $form->{dbupdate})) {
604 next unless $form->{$db};
606 # strip db from dataset
608 &dbconnect_vars($form, $db);
611 DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
614 $dbh->do($form->{dboptions}) if ($form->{dboptions});
617 $query = qq|SELECT version FROM defaults|;
618 my ($version) = selectrow_query($form, $dbh, $query);
620 next unless $version;
622 $version = calc_version($version);
624 foreach my $upgradescript (@upgradescripts) {
625 my $a = $upgradescript;
626 $a =~ s/^\Q$form->{dbdriver}\E-upgrade-|\.(sql|pl)$//g;
628 my ($mindb, $maxdb) = split /-/, $a;
629 my $str_maxdb = $maxdb;
630 $mindb = calc_version($mindb);
631 $maxdb = calc_version($maxdb);
633 next if ($version >= $maxdb);
635 # if there is no upgrade script exit
636 last if ($version < $mindb);
639 $main::lxdebug->message(LXDebug->DEBUG2(), "Applying Update $upgradescript");
640 $dbupdater->process_file($dbh, "sql/" . $form->{"dbdriver"} . "-upgrade/$upgradescript", $str_maxdb, $db_charset);
651 $main::lxdebug->leave_sub();
657 $main::lxdebug->enter_sub();
659 my ($self, $form, $dbupdater) = @_;
661 $form->{sid} = $form->{dbdefault};
663 my @upgradescripts = ();
664 my ($query, $sth, $tag);
667 @upgradescripts = $dbupdater->sort_dbupdate_controls;
669 my $db_charset = $main::dbcharset;
670 $db_charset ||= Common::DEFAULT_CHARSET;
672 foreach my $db (split / /, $form->{dbupdate}) {
674 next unless $form->{$db};
676 # strip db from dataset
678 &dbconnect_vars($form, $db);
681 DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
684 $dbh->do($form->{dboptions}) if ($form->{dboptions});
686 map({ $_->{"applied"} = 0; } @upgradescripts);
688 $self->create_schema_info_table($form, $dbh);
690 $query = qq|SELECT tag FROM schema_info|;
691 $sth = $dbh->prepare($query);
692 $sth->execute() || $form->dberror($query);
693 while (($tag) = $sth->fetchrow_array()) {
694 $dbupdater->{all_controls}->{$tag}->{"applied"} = 1 if (defined($dbupdater->{all_controls}->{$tag}));
699 foreach (@upgradescripts) {
700 if (!$_->{"applied"}) {
706 next if ($all_applied);
708 foreach my $control (@upgradescripts) {
709 next if ($control->{"applied"});
711 $control->{description} = SL::Iconv::convert($control->{charset}, $db_charset, $control->{description});
713 $control->{"file"} =~ /\.(sql|pl)$/;
717 $main::lxdebug->message(LXDebug->DEBUG2(), "Applying Update $control->{file}");
718 print $form->parse_html_template("dbupgrade/upgrade_message2", $control);
720 $dbupdater->process_file($dbh, "sql/" . $form->{"dbdriver"} . "-upgrade2/$control->{file}", $control, $db_charset);
728 $main::lxdebug->leave_sub();
733 sub update2_available {
734 $main::lxdebug->enter_sub();
736 my ($form, $controls) = @_;
738 map({ $_->{"applied"} = 0; } values(%{$controls}));
740 dbconnect_vars($form, $form->{"dbname"});
743 DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}) ||
746 my ($query, $tag, $sth);
748 $query = qq|SELECT tag FROM schema_info|;
749 $sth = $dbh->prepare($query);
750 if ($sth->execute()) {
751 while (($tag) = $sth->fetchrow_array()) {
752 $controls->{$tag}->{"applied"} = 1 if (defined($controls->{$tag}));
758 map({ $main::lxdebug->leave_sub() and return 1 if (!$_->{"applied"}) }
759 values(%{$controls}));
761 $main::lxdebug->leave_sub();
766 $main::lxdebug->enter_sub();
769 my $form = \%main::form;
771 # format dbconnect and dboptions string
772 dbconnect_vars($self, $self->{dbname});
774 map { $self->{$_} =~ s/\r//g; } qw(address signature);
776 $main::auth->save_user($self->{login}, map { $_, $self->{$_} } config_vars());
778 my $dbh = DBI->connect($self->{dbconnect}, $self->{dbuser}, $self->{dbpasswd});
780 $self->create_employee_entry($form, $dbh, $self, 1);
784 $main::lxdebug->leave_sub();
787 sub create_employee_entry {
788 $main::lxdebug->enter_sub();
793 my $myconfig = shift;
794 my $update_existing = shift;
796 if (!does_table_exist($dbh, 'employee')) {
797 $main::lxdebug->leave_sub();
801 # add login to employee table if it does not exist
802 # no error check for employee table, ignore if it does not exist
803 my ($id) = selectrow_query($form, $dbh, qq|SELECT id FROM employee WHERE login = ?|, $self->{login});
806 my $query = qq|INSERT INTO employee (login, name, workphone, role) VALUES (?, ?, ?, ?)|;
807 do_query($form, $dbh, $query, ($self->{login}, $myconfig->{name}, $myconfig->{tel}, "user"));
809 } elsif ($update_existing) {
810 my $query = qq|UPDATE employee SET name = ?, workphone = ?, role = 'user' WHERE id = ?|;
811 do_query($form, $dbh, $query, $myconfig->{name}, $myconfig->{tel}, $id);
814 $main::lxdebug->leave_sub();
818 $main::lxdebug->enter_sub();
820 my @conf = qw(address admin businessnumber company countrycode
821 currency dateformat dbconnect dbdriver dbhost dbport dboptions
822 dbname dbuser dbpasswd email fax name numberformat password
823 printer role sid signature stylesheet tel templates vclimit angebote
824 bestellungen rechnungen anfragen lieferantenbestellungen einkaufsrechnungen
825 taxnumber co_ustid duns menustyle template_format default_media
826 default_printer_id copies show_form_details favorites
827 pdonumber sdonumber hide_cvar_search_options mandatory_departments
830 $main::lxdebug->leave_sub();
836 $main::lxdebug->enter_sub();
838 my ($self, $msg) = @_;
840 $main::lxdebug->show_backtrace();
842 if ($ENV{HTTP_USER_AGENT}) {
843 print qq|Content-Type: text/html
845 <!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0//EN">
847 <body bgcolor=ffffff>
849 <h2><font color=red>Error!</font></h2>
856 $main::lxdebug->leave_sub();