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);
126 my $dbupdater = SL::DBUpgrade2->new(form => $form, dbdriver => $myconfig{dbdriver})->parse_dbupdate_controls;
128 map({ $form->{$_} = $myconfig{$_} } qw(dbname dbhost dbport dbdriver dbuser dbpasswd dbconnect dateformat));
129 dbconnect_vars($form, $form->{dbname});
130 my $update_available = $dbupdater->update_available($dbversion) || $dbupdater->update2_available($dbh);
133 if ($update_available) {
134 $form->{"stylesheet"} = "lx-office-erp.css";
135 $form->{"title"} = $main::locale->text("Dataset upgrade");
137 print $form->parse_html_template("dbupgrade/header");
139 $form->{dbupdate} = "db$myconfig{dbname}";
140 $form->{ $form->{dbupdate} } = 1;
142 if ($form->{"show_dbupdate_warning"}) {
143 print $form->parse_html_template("dbupgrade/warning");
148 if (!open(FH, ">" . $::lx_office_conf{paths}->{userspath} . "/nologin")) {
149 $form->show_generic_error($main::locale->text('A temporary file could not be created. ' .
150 'Please verify that the directory "#1" is writeable by the webserver.',
151 $::lx_office_conf{paths}->{userspath}),
155 # required for Oracle
156 $form->{dbdefault} = $sid;
158 # ignore HUP, QUIT in case the webserver times out
159 $SIG{HUP} = 'IGNORE';
160 $SIG{QUIT} = 'IGNORE';
162 $self->dbupdate($form);
163 $self->dbupdate2($form, $dbupdater);
164 SL::DBUpgrade2->new(form => $::form, dbdriver => 'Pg', auth => 1)->apply_admin_dbupgrade_scripts(0);
169 unlink($::lx_office_conf{paths}->{userspath} . "/nologin");
172 $self->{"menustyle"} eq "v3" ? "menuv3.pl" :
173 $self->{"menustyle"} eq "neu" ? "menunew.pl" :
174 $self->{"menustyle"} eq "js" ? "menujs.pl" :
175 $self->{"menustyle"} eq "xml" ? "menuXML.pl" :
178 print $form->parse_html_template("dbupgrade/footer", { "menufile" => $menufile });
184 $main::lxdebug->leave_sub();
190 $main::lxdebug->enter_sub();
192 my ($form, $db) = @_;
195 'Pg' => { 'yy-mm-dd' => 'set DateStyle to \'ISO\'',
196 'yyyy-mm-dd' => 'set DateStyle to \'ISO\'',
197 'mm/dd/yy' => 'set DateStyle to \'SQL, US\'',
198 'mm-dd-yy' => 'set DateStyle to \'POSTGRES, US\'',
199 'dd/mm/yy' => 'set DateStyle to \'SQL, EUROPEAN\'',
200 'dd-mm-yy' => 'set DateStyle to \'POSTGRES, EUROPEAN\'',
201 'dd.mm.yy' => 'set DateStyle to \'GERMAN\''
204 'yy-mm-dd' => 'ALTER SESSION SET NLS_DATE_FORMAT = \'YY-MM-DD\'',
205 'yyyy-mm-dd' => 'ALTER SESSION SET NLS_DATE_FORMAT = \'YYYY-MM-DD\'',
206 'mm/dd/yy' => 'ALTER SESSION SET NLS_DATE_FORMAT = \'MM/DD/YY\'',
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\'',
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});
256 DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
259 if ($form->{dbdriver} eq 'Pg') {
261 qq|SELECT datname FROM pg_database | .
262 qq|WHERE NOT datname IN ('template0', 'template1')|;
263 $sth = $dbh->prepare($query);
264 $sth->execute() || $form->dberror($query);
266 while (my ($db) = $sth->fetchrow_array) {
268 if ($form->{only_acc_db}) {
270 next if ($db =~ /^template/);
272 &dbconnect_vars($form, $db);
274 DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
278 qq|SELECT tablename FROM pg_tables | .
279 qq|WHERE (tablename = 'defaults') AND (tableowner = ?)|;
280 my $sth = $dbh->prepare($query);
281 $sth->execute($form->{dbuser}) ||
282 $form->dberror($query . " ($form->{dbuser})");
284 if ($sth->fetchrow_array) {
285 push(@dbsources, $db);
291 push(@dbsources, $db);
295 if ($form->{dbdriver} eq 'Oracle') {
296 if ($form->{only_acc_db}) {
298 qq|SELECT owner FROM dba_objects | .
299 qq|WHERE object_name = 'DEFAULTS' AND object_type = 'TABLE'|;
301 $query = qq|SELECT username FROM dba_users|;
304 $sth = $dbh->prepare($query);
305 $sth->execute || $form->dberror($query);
307 while (my ($db) = $sth->fetchrow_array) {
308 push(@dbsources, $db);
315 $main::lxdebug->leave_sub();
320 sub dbclusterencoding {
321 $main::lxdebug->enter_sub();
323 my ($self, $form) = @_;
325 $form->{dbdefault} ||= $form->{dbuser};
327 dbconnect_vars($form, $form->{dbdefault});
329 my $dbh = DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}) || $form->dberror();
330 my $query = qq|SELECT pg_encoding_to_char(encoding) FROM pg_database WHERE datname = 'template0'|;
331 my ($cluster_encoding) = $dbh->selectrow_array($query);
334 $main::lxdebug->leave_sub();
336 return $cluster_encoding;
340 $main::lxdebug->enter_sub();
342 my ($self, $form) = @_;
344 $form->{sid} = $form->{dbdefault};
345 &dbconnect_vars($form, $form->{dbdefault});
347 DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
349 $form->{db} =~ s/\"//g;
351 'Pg' => qq|CREATE DATABASE "$form->{db}"|,
353 qq|CREATE USER "$form->{db}" DEFAULT TABLESPACE USERS | .
354 qq|TEMPORARY TABLESPACE TEMP IDENTIFIED BY "$form->{db}"|
361 push(@{$dboptions{"Pg"}}, "ENCODING = " . $dbh->quote($form->{"encoding"}))
362 if ($form->{"encoding"});
363 if ($form->{"dbdefault"}) {
364 my $dbdefault = $form->{"dbdefault"};
365 $dbdefault =~ s/[^a-zA-Z0-9_\-]//g;
366 push(@{$dboptions{"Pg"}}, "TEMPLATE = $dbdefault");
369 my $query = $dbcreate{$form->{dbdriver}};
370 $query .= " WITH " . join(" ", @{$dboptions{"Pg"}}) if (@{$dboptions{"Pg"}});
372 # Ignore errors if the database exists.
375 if ($form->{dbdriver} eq 'Oracle') {
376 $query = qq|GRANT CONNECT, RESOURCE TO "$form->{db}"|;
377 do_query($form, $dbh, $query);
381 # setup variables for the new database
382 if ($form->{dbdriver} eq 'Oracle') {
383 $form->{dbuser} = $form->{db};
384 $form->{dbpasswd} = $form->{db};
387 &dbconnect_vars($form, $form->{db});
389 $dbh = DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
392 my $db_charset = $Common::db_encoding_to_charset{$form->{encoding}};
393 $db_charset ||= Common::DEFAULT_CHARSET;
395 my $dbupdater = SL::DBUpgrade2->new(form => $form, dbdriver => $form->{dbdriver});
397 $dbupdater->process_query($dbh, "sql/lx-office.sql", undef, $db_charset);
399 # load chart of accounts
400 $dbupdater->process_query($dbh, "sql/$form->{chart}-chart.sql", undef, $db_charset);
402 $query = "UPDATE defaults SET coa = ?";
403 do_query($form, $dbh, $query, $form->{chart});
407 $main::lxdebug->leave_sub();
411 $main::lxdebug->enter_sub();
413 my ($self, $form) = @_;
414 $form->{db} =~ s/\"//g;
415 my %dbdelete = ('Pg' => qq|DROP DATABASE "$form->{db}"|,
416 'Oracle' => qq|DROP USER "$form->{db}" CASCADE|);
418 $form->{sid} = $form->{dbdefault};
419 &dbconnect_vars($form, $form->{dbdefault});
421 DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
423 my $query = $dbdelete{$form->{dbdriver}};
424 do_query($form, $dbh, $query);
428 $main::lxdebug->leave_sub();
431 sub dbsources_unused {
432 $main::lxdebug->enter_sub();
434 my ($self, $form) = @_;
436 $form->{only_acc_db} = 1;
438 my %members = $main::auth->read_all_users();
439 my %dbexcl = map { $_ => 1 } grep { $_ } map { $_->{dbname} } values %members;
441 $dbexcl{$form->{dbdefault}} = 1;
442 $dbexcl{$main::auth->{DB_config}->{db}} = 1;
444 my @dbunused = grep { !$dbexcl{$_} } dbsources("", $form);
446 $main::lxdebug->leave_sub();
452 $main::lxdebug->enter_sub();
454 my ($self, $form) = @_;
456 my %members = $main::auth->read_all_users();
457 my $dbupdater = SL::DBUpgrade2->new(form => $form, dbdriver => $form->{dbdriver})->parse_dbupdate_controls;
459 my ($query, $sth, %dbs_needing_updates);
461 foreach my $login (grep /[a-z]/, keys %members) {
462 my $member = $members{$login};
464 map { $form->{$_} = $member->{$_} } qw(dbname dbuser dbpasswd dbhost dbport);
465 dbconnect_vars($form, $form->{dbname});
467 my $dbh = DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd});
473 $query = qq|SELECT version FROM defaults|;
474 $sth = prepare_query($form, $dbh, $query);
475 if ($sth->execute()) {
476 ($version) = $sth->fetchrow_array();
480 $dbh->disconnect and next unless $version;
482 my $update_available = $dbupdater->update_available($version) || $dbupdater->update2_available($dbh);
485 if ($update_available) {
487 map { $dbinfo->{$_} = $member->{$_} } grep /^db/, keys %{ $member };
488 $dbs_needing_updates{$member->{dbhost} . "::" . $member->{dbname}} = $dbinfo;
492 $main::lxdebug->leave_sub();
494 return values %dbs_needing_updates;
498 $main::lxdebug->enter_sub(2);
500 my (@v, $version, $i);
502 @v = split(/\./, $_[0]);
503 while (scalar(@v) < 4) {
507 for ($i = 0; $i < 4; $i++) {
512 $main::lxdebug->leave_sub(2);
516 sub cmp_script_version {
517 my ($a_from, $a_to, $b_from, $b_to);
518 my ($i, $res_a, $res_b);
519 my ($my_a, $my_b) = ($a, $b);
521 $my_a =~ s/.*-upgrade-//;
523 $my_b =~ s/.*-upgrade-//;
525 my ($my_a_from, $my_a_to) = split(/-/, $my_a);
526 my ($my_b_from, $my_b_to) = split(/-/, $my_b);
528 $res_a = calc_version($my_a_from);
529 $res_b = calc_version($my_b_from);
531 if ($res_a == $res_b) {
532 $res_a = calc_version($my_a_to);
533 $res_b = calc_version($my_b_to);
536 return $res_a <=> $res_b;
539 sub create_schema_info_table {
540 $main::lxdebug->enter_sub();
542 my ($self, $form, $dbh) = @_;
544 my $query = "SELECT tag FROM schema_info LIMIT 1";
545 if (!$dbh->do($query)) {
548 qq|CREATE TABLE schema_info (| .
551 qq| itime timestamp DEFAULT now(), | .
552 qq| PRIMARY KEY (tag))|;
553 $dbh->do($query) || $form->dberror($query);
556 $main::lxdebug->leave_sub();
560 $main::lxdebug->enter_sub();
562 my ($self, $form) = @_;
566 $form->{sid} = $form->{dbdefault};
568 my @upgradescripts = ();
572 if ($form->{dbupdate}) {
574 # read update scripts into memory
575 opendir(SQLDIR, "sql/" . $form->{dbdriver} . "-upgrade")
576 or &error("", "sql/" . $form->{dbdriver} . "-upgrade : $!");
578 sort(cmp_script_version
579 grep(/$form->{dbdriver}-upgrade-.*?\.(sql|pl)$/,
584 my $db_charset = $::lx_office_conf{system}->{dbcharset};
585 $db_charset ||= Common::DEFAULT_CHARSET;
587 my $dbupdater = SL::DBUpgrade2->new(form => $form, dbdriver => $form->{dbdriver});
589 foreach my $db (split(/ /, $form->{dbupdate})) {
591 next unless $form->{$db};
593 # strip db from dataset
595 &dbconnect_vars($form, $db);
598 DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
601 $dbh->do($form->{dboptions}) if ($form->{dboptions});
604 $query = qq|SELECT version FROM defaults|;
605 my ($version) = selectrow_query($form, $dbh, $query);
607 next unless $version;
609 $version = calc_version($version);
611 foreach my $upgradescript (@upgradescripts) {
612 my $a = $upgradescript;
613 $a =~ s/^\Q$form->{dbdriver}\E-upgrade-|\.(sql|pl)$//g;
615 my ($mindb, $maxdb) = split /-/, $a;
616 my $str_maxdb = $maxdb;
617 $mindb = calc_version($mindb);
618 $maxdb = calc_version($maxdb);
620 next if ($version >= $maxdb);
622 # if there is no upgrade script exit
623 last if ($version < $mindb);
626 $main::lxdebug->message(LXDebug->DEBUG2(), "Applying Update $upgradescript");
627 $dbupdater->process_file($dbh, "sql/" . $form->{"dbdriver"} . "-upgrade/$upgradescript", $str_maxdb, $db_charset);
638 $main::lxdebug->leave_sub();
644 $main::lxdebug->enter_sub();
646 my ($self, $form, $dbupdater) = @_;
648 $form->{sid} = $form->{dbdefault};
651 my $db_charset = $::lx_office_conf{system}->{dbcharset} || Common::DEFAULT_CHARSET;
653 map { $_->{description} = SL::Iconv::convert($_->{charset}, $db_charset, $_->{description}) } values %{ $dbupdater->{all_controls} };
655 foreach my $db (split / /, $form->{dbupdate}) {
656 next unless $form->{$db};
658 # strip db from dataset
660 &dbconnect_vars($form, $db);
662 my $dbh = DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}) or $form->dberror;
664 $dbh->do($form->{dboptions}) if ($form->{dboptions});
666 $self->create_schema_info_table($form, $dbh);
668 my @upgradescripts = $dbupdater->unapplied_upgrade_scripts($dbh);
670 $dbh->disconnect and next if !@upgradescripts;
672 foreach my $control (@upgradescripts) {
674 $main::lxdebug->message(LXDebug->DEBUG2(), "Applying Update $control->{file}");
675 print $form->parse_html_template("dbupgrade/upgrade_message2", $control);
677 $dbupdater->process_file($dbh, "sql/" . $form->{"dbdriver"} . "-upgrade2/$control->{file}", $control, $db_charset);
685 $main::lxdebug->leave_sub();
691 $main::lxdebug->enter_sub();
694 my $form = \%main::form;
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 = DBI->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});
731 my $query = qq|INSERT INTO employee (login, name, workphone, role) VALUES (?, ?, ?, ?)|;
732 do_query($form, $dbh, $query, ($self->{login}, $myconfig->{name}, $myconfig->{tel}, "user"));
734 } elsif ($update_existing) {
735 my $query = qq|UPDATE employee SET name = ?, workphone = ?, role = 'user' WHERE id = ?|;
736 do_query($form, $dbh, $query, $myconfig->{name}, $myconfig->{tel}, $id);
739 $main::lxdebug->leave_sub();
743 $main::lxdebug->enter_sub();
745 my @conf = qw(address admin businessnumber company countrycode
746 currency dateformat dbconnect dbdriver dbhost dbport dboptions
747 dbname dbuser dbpasswd email fax name numberformat password
748 printer role sid signature stylesheet tel templates vclimit angebote
749 bestellungen rechnungen anfragen lieferantenbestellungen einkaufsrechnungen
750 taxnumber co_ustid duns menustyle template_format default_media
751 default_printer_id copies show_form_details favorites
752 pdonumber sdonumber hide_cvar_search_options mandatory_departments
755 $main::lxdebug->leave_sub();
761 $main::lxdebug->enter_sub();
763 my ($self, $msg) = @_;
765 $main::lxdebug->show_backtrace();
767 if ($ENV{HTTP_USER_AGENT}) {
768 print qq|Content-Type: text/html
770 <!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0//EN">
772 <body bgcolor=ffffff>
774 <h2><font color=red>Error!</font></h2>
781 $main::lxdebug->leave_sub();