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(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($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 'mm-dd-yy' => 'set DateStyle to \'POSTGRES, US\'',
203 'dd/mm/yy' => 'set DateStyle to \'SQL, EUROPEAN\'',
204 'dd-mm-yy' => 'set DateStyle to \'POSTGRES, EUROPEAN\'',
205 'dd.mm.yy' => 'set DateStyle to \'GERMAN\''
208 'yy-mm-dd' => 'ALTER SESSION SET NLS_DATE_FORMAT = \'YY-MM-DD\'',
209 'yyyy-mm-dd' => 'ALTER SESSION SET NLS_DATE_FORMAT = \'YYYY-MM-DD\'',
210 'mm/dd/yy' => 'ALTER SESSION SET NLS_DATE_FORMAT = \'MM/DD/YY\'',
211 'mm-dd-yy' => 'ALTER SESSION SET NLS_DATE_FORMAT = \'MM-DD-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\'',
214 'dd.mm.yy' => 'ALTER SESSION SET NLS_DATE_FORMAT = \'DD.MM.YY\'',
217 $form->{dboptions} = $dboptions{ $form->{dbdriver} }{ $form->{dateformat} };
219 if ($form->{dbdriver} eq 'Pg') {
220 $form->{dbconnect} = "dbi:Pg:dbname=$db";
223 if ($form->{dbdriver} eq 'Oracle') {
224 $form->{dbconnect} = "dbi:Oracle:sid=$form->{sid}";
227 if ($form->{dbhost}) {
228 $form->{dbconnect} .= ";host=$form->{dbhost}";
230 if ($form->{dbport}) {
231 $form->{dbconnect} .= ";port=$form->{dbport}";
234 $main::lxdebug->leave_sub();
238 $main::lxdebug->enter_sub();
240 my @drivers = DBI->available_drivers();
242 $main::lxdebug->leave_sub();
244 return (grep { /(Pg|Oracle)/ } @drivers);
248 $main::lxdebug->enter_sub();
250 my ($self, $form) = @_;
255 $form->{dbdefault} = $form->{dbuser} unless $form->{dbdefault};
256 $form->{sid} = $form->{dbdefault};
257 &dbconnect_vars($form, $form->{dbdefault});
259 my $dbh = SL::DBConnect->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);
276 my $dbh = SL::DBConnect->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
280 qq|SELECT tablename FROM pg_tables | .
281 qq|WHERE (tablename = 'defaults') AND (tableowner = ?)|;
282 my $sth = $dbh->prepare($query);
283 $sth->execute($form->{dbuser}) ||
284 $form->dberror($query . " ($form->{dbuser})");
286 if ($sth->fetchrow_array) {
287 push(@dbsources, $db);
293 push(@dbsources, $db);
297 if ($form->{dbdriver} eq 'Oracle') {
298 if ($form->{only_acc_db}) {
300 qq|SELECT owner FROM dba_objects | .
301 qq|WHERE object_name = 'DEFAULTS' AND object_type = 'TABLE'|;
303 $query = qq|SELECT username FROM dba_users|;
306 $sth = $dbh->prepare($query);
307 $sth->execute || $form->dberror($query);
309 while (my ($db) = $sth->fetchrow_array) {
310 push(@dbsources, $db);
317 $main::lxdebug->leave_sub();
322 sub dbclusterencoding {
323 $main::lxdebug->enter_sub();
325 my ($self, $form) = @_;
327 $form->{dbdefault} ||= $form->{dbuser};
329 dbconnect_vars($form, $form->{dbdefault});
331 my $dbh = SL::DBConnect->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}) || $form->dberror();
332 my $query = qq|SELECT pg_encoding_to_char(encoding) FROM pg_database WHERE datname = 'template0'|;
333 my ($cluster_encoding) = $dbh->selectrow_array($query);
336 $main::lxdebug->leave_sub();
338 return $cluster_encoding;
342 $main::lxdebug->enter_sub();
344 my ($self, $form) = @_;
346 $form->{sid} = $form->{dbdefault};
347 &dbconnect_vars($form, $form->{dbdefault});
349 SL::DBConnect->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
351 $form->{db} =~ s/\"//g;
353 'Pg' => qq|CREATE DATABASE "$form->{db}"|,
355 qq|CREATE USER "$form->{db}" DEFAULT TABLESPACE USERS | .
356 qq|TEMPORARY TABLESPACE TEMP IDENTIFIED BY "$form->{db}"|
363 push(@{$dboptions{"Pg"}}, "ENCODING = " . $dbh->quote($form->{"encoding"}))
364 if ($form->{"encoding"});
365 if ($form->{"dbdefault"}) {
366 my $dbdefault = $form->{"dbdefault"};
367 $dbdefault =~ s/[^a-zA-Z0-9_\-]//g;
368 push(@{$dboptions{"Pg"}}, "TEMPLATE = $dbdefault");
371 my $query = $dbcreate{$form->{dbdriver}};
372 $query .= " WITH " . join(" ", @{$dboptions{"Pg"}}) if (@{$dboptions{"Pg"}});
374 # Ignore errors if the database exists.
377 if ($form->{dbdriver} eq 'Oracle') {
378 $query = qq|GRANT CONNECT, RESOURCE TO "$form->{db}"|;
379 do_query($form, $dbh, $query);
383 # setup variables for the new database
384 if ($form->{dbdriver} eq 'Oracle') {
385 $form->{dbuser} = $form->{db};
386 $form->{dbpasswd} = $form->{db};
389 &dbconnect_vars($form, $form->{db});
391 $dbh = SL::DBConnect->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
394 my $db_charset = $Common::db_encoding_to_charset{$form->{encoding}};
395 $db_charset ||= Common::DEFAULT_CHARSET;
397 my $dbupdater = SL::DBUpgrade2->new(form => $form, dbdriver => $form->{dbdriver});
399 $dbupdater->process_query($dbh, "sql/lx-office.sql", undef, $db_charset);
401 # load chart of accounts
402 $dbupdater->process_query($dbh, "sql/$form->{chart}-chart.sql", undef, $db_charset);
404 $query = "UPDATE defaults SET coa = ?";
405 do_query($form, $dbh, $query, $form->{chart});
406 $query = "UPDATE defaults SET accounting_method = ?";
407 do_query($form, $dbh, $query, $form->{accounting_method});
408 $query = "UPDATE defaults SET profit_determination = ?";
409 do_query($form, $dbh, $query, $form->{profit_determination});
410 $query = "UPDATE defaults SET inventory_system = ?";
411 do_query($form, $dbh, $query, $form->{inventory_system});
415 $main::lxdebug->leave_sub();
419 $main::lxdebug->enter_sub();
421 my ($self, $form) = @_;
422 $form->{db} =~ s/\"//g;
423 my %dbdelete = ('Pg' => qq|DROP DATABASE "$form->{db}"|,
424 'Oracle' => qq|DROP USER "$form->{db}" CASCADE|);
426 $form->{sid} = $form->{dbdefault};
427 &dbconnect_vars($form, $form->{dbdefault});
428 my $dbh = SL::DBConnect->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
430 my $query = $dbdelete{$form->{dbdriver}};
431 do_query($form, $dbh, $query);
435 $main::lxdebug->leave_sub();
438 sub dbsources_unused {
439 $main::lxdebug->enter_sub();
441 my ($self, $form) = @_;
443 $form->{only_acc_db} = 1;
445 my %members = $main::auth->read_all_users();
446 my %dbexcl = map { $_ => 1 } grep { $_ } map { $_->{dbname} } values %members;
448 $dbexcl{$form->{dbdefault}} = 1;
449 $dbexcl{$main::auth->{DB_config}->{db}} = 1;
451 my @dbunused = grep { !$dbexcl{$_} } dbsources("", $form);
453 $main::lxdebug->leave_sub();
459 $main::lxdebug->enter_sub();
461 my ($self, $form) = @_;
463 my %members = $main::auth->read_all_users();
464 my $dbupdater = SL::DBUpgrade2->new(form => $form, dbdriver => $form->{dbdriver})->parse_dbupdate_controls;
466 my ($query, $sth, %dbs_needing_updates);
468 foreach my $login (grep /[a-z]/, keys %members) {
469 my $member = $members{$login};
471 map { $form->{$_} = $member->{$_} } qw(dbname dbuser dbpasswd dbhost dbport);
472 dbconnect_vars($form, $form->{dbname});
474 my $dbh = SL::DBConnect->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd});
480 $query = qq|SELECT version FROM defaults|;
481 $sth = prepare_query($form, $dbh, $query);
482 if ($sth->execute()) {
483 ($version) = $sth->fetchrow_array();
487 $dbh->disconnect and next unless $version;
489 my $update_available = $dbupdater->update_available($version) || $dbupdater->update2_available($dbh);
492 if ($update_available) {
494 map { $dbinfo->{$_} = $member->{$_} } grep /^db/, keys %{ $member };
495 $dbs_needing_updates{$member->{dbhost} . "::" . $member->{dbname}} = $dbinfo;
499 $main::lxdebug->leave_sub();
501 return values %dbs_needing_updates;
505 $main::lxdebug->enter_sub(2);
507 my (@v, $version, $i);
509 @v = split(/\./, $_[0]);
510 while (scalar(@v) < 4) {
514 for ($i = 0; $i < 4; $i++) {
519 $main::lxdebug->leave_sub(2);
523 sub cmp_script_version {
524 my ($a_from, $a_to, $b_from, $b_to);
525 my ($i, $res_a, $res_b);
526 my ($my_a, $my_b) = ($a, $b);
528 $my_a =~ s/.*-upgrade-//;
530 $my_b =~ s/.*-upgrade-//;
532 my ($my_a_from, $my_a_to) = split(/-/, $my_a);
533 my ($my_b_from, $my_b_to) = split(/-/, $my_b);
535 $res_a = calc_version($my_a_from);
536 $res_b = calc_version($my_b_from);
538 if ($res_a == $res_b) {
539 $res_a = calc_version($my_a_to);
540 $res_b = calc_version($my_b_to);
543 return $res_a <=> $res_b;
546 sub create_schema_info_table {
547 $main::lxdebug->enter_sub();
549 my ($self, $form, $dbh) = @_;
551 my $query = "SELECT tag FROM schema_info LIMIT 1";
552 if (!$dbh->do($query)) {
555 qq|CREATE TABLE schema_info (| .
558 qq| itime timestamp DEFAULT now(), | .
559 qq| PRIMARY KEY (tag))|;
560 $dbh->do($query) || $form->dberror($query);
563 $main::lxdebug->leave_sub();
567 $main::lxdebug->enter_sub();
569 my ($self, $form) = @_;
573 $form->{sid} = $form->{dbdefault};
575 my @upgradescripts = ();
579 if ($form->{dbupdate}) {
581 # read update scripts into memory
582 opendir(SQLDIR, "sql/" . $form->{dbdriver} . "-upgrade")
583 or &error("", "sql/" . $form->{dbdriver} . "-upgrade : $!");
585 sort(cmp_script_version
586 grep(/$form->{dbdriver}-upgrade-.*?\.(sql|pl)$/,
591 my $db_charset = $::lx_office_conf{system}->{dbcharset};
592 $db_charset ||= Common::DEFAULT_CHARSET;
594 my $dbupdater = SL::DBUpgrade2->new(form => $form, dbdriver => $form->{dbdriver});
596 foreach my $db (split(/ /, $form->{dbupdate})) {
598 next unless $form->{$db};
600 # strip db from dataset
602 &dbconnect_vars($form, $db);
604 my $dbh = SL::DBConnect->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
607 $dbh->do($form->{dboptions}) if ($form->{dboptions});
610 $query = qq|SELECT version FROM defaults|;
611 my ($version) = selectrow_query($form, $dbh, $query);
613 next unless $version;
615 $version = calc_version($version);
617 foreach my $upgradescript (@upgradescripts) {
618 my $a = $upgradescript;
619 $a =~ s/^\Q$form->{dbdriver}\E-upgrade-|\.(sql|pl)$//g;
621 my ($mindb, $maxdb) = split /-/, $a;
622 my $str_maxdb = $maxdb;
623 $mindb = calc_version($mindb);
624 $maxdb = calc_version($maxdb);
626 next if ($version >= $maxdb);
628 # if there is no upgrade script exit
629 last if ($version < $mindb);
632 $main::lxdebug->message(LXDebug->DEBUG2(), "Applying Update $upgradescript");
633 $dbupdater->process_file($dbh, "sql/" . $form->{"dbdriver"} . "-upgrade/$upgradescript", $str_maxdb, $db_charset);
644 $main::lxdebug->leave_sub();
650 $main::lxdebug->enter_sub();
652 my ($self, $form, $dbupdater) = @_;
654 $form->{sid} = $form->{dbdefault};
657 my $db_charset = $::lx_office_conf{system}->{dbcharset} || Common::DEFAULT_CHARSET;
659 map { $_->{description} = SL::Iconv::convert($_->{charset}, $db_charset, $_->{description}) } values %{ $dbupdater->{all_controls} };
661 foreach my $db (split / /, $form->{dbupdate}) {
662 next unless $form->{$db};
664 # strip db from dataset
666 &dbconnect_vars($form, $db);
668 my $dbh = SL::DBConnect->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}) or $form->dberror;
670 $dbh->do($form->{dboptions}) if ($form->{dboptions});
672 $self->create_schema_info_table($form, $dbh);
674 my @upgradescripts = $dbupdater->unapplied_upgrade_scripts($dbh);
676 $dbh->disconnect and next if !@upgradescripts;
678 foreach my $control (@upgradescripts) {
680 $main::lxdebug->message(LXDebug->DEBUG2(), "Applying Update $control->{file}");
681 print $form->parse_html_template("dbupgrade/upgrade_message2", $control);
683 $dbupdater->process_file($dbh, "sql/" . $form->{"dbdriver"} . "-upgrade2/$control->{file}", $control, $db_charset);
691 $main::lxdebug->leave_sub();
697 $main::lxdebug->enter_sub();
700 my $form = \%main::form;
702 # format dbconnect and dboptions string
703 dbconnect_vars($self, $self->{dbname});
705 map { $self->{$_} =~ s/\r//g; } qw(address signature);
707 $main::auth->save_user($self->{login}, map { $_, $self->{$_} } config_vars());
709 my $dbh = SL::DBConnect->connect($self->{dbconnect}, $self->{dbuser}, $self->{dbpasswd});
711 $self->create_employee_entry($form, $dbh, $self, 1);
715 $main::lxdebug->leave_sub();
718 sub create_employee_entry {
719 $main::lxdebug->enter_sub();
724 my $myconfig = shift;
725 my $update_existing = shift;
727 if (!does_table_exist($dbh, 'employee')) {
728 $main::lxdebug->leave_sub();
732 # add login to employee table if it does not exist
733 # no error check for employee table, ignore if it does not exist
734 my ($id) = selectrow_query($form, $dbh, qq|SELECT id FROM employee WHERE login = ?|, $self->{login});
737 my $query = qq|INSERT INTO employee (login, name, workphone, role) VALUES (?, ?, ?, ?)|;
738 do_query($form, $dbh, $query, ($self->{login}, $myconfig->{name}, $myconfig->{tel}, "user"));
740 } elsif ($update_existing) {
741 my $query = qq|UPDATE employee SET name = ?, workphone = ?, role = 'user', deleted = 'f' WHERE id = ?|;
742 do_query($form, $dbh, $query, $myconfig->{name}, $myconfig->{tel}, $id);
745 $main::lxdebug->leave_sub();
749 $main::lxdebug->enter_sub();
751 my @conf = qw(address admin businessnumber company countrycode
752 currency dateformat dbconnect dbdriver dbhost dbport dboptions
753 dbname dbuser dbpasswd email fax name numberformat password
754 printer sid signature stylesheet tel templates vclimit angebote
755 bestellungen rechnungen anfragen lieferantenbestellungen einkaufsrechnungen
756 taxnumber co_ustid duns menustyle template_format default_media
757 default_printer_id copies show_form_details favorites
758 pdonumber sdonumber hide_cvar_search_options mandatory_departments
761 $main::lxdebug->leave_sub();
767 $main::lxdebug->enter_sub();
769 my ($self, $msg) = @_;
771 $main::lxdebug->show_backtrace();
773 if ($ENV{HTTP_USER_AGENT}) {
774 print qq|Content-Type: text/html
776 <!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0//EN">
778 <body bgcolor=ffffff>
780 <h2><font color=red>Error!</font></h2>
787 $main::lxdebug->leave_sub();