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 (!$::lx_office_conf{debug}->{keep_installation_unlocked} && !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");
175 print $form->parse_html_template("dbupgrade/footer");
181 $main::lxdebug->leave_sub();
187 $main::lxdebug->enter_sub();
189 my ($form, $db) = @_;
192 'Pg' => { 'yy-mm-dd' => 'set DateStyle to \'ISO\'',
193 'yyyy-mm-dd' => 'set DateStyle to \'ISO\'',
194 'mm/dd/yy' => 'set DateStyle to \'SQL, US\'',
195 'dd/mm/yy' => 'set DateStyle to \'SQL, EUROPEAN\'',
196 'dd.mm.yy' => 'set DateStyle to \'GERMAN\''
199 'yy-mm-dd' => 'ALTER SESSION SET NLS_DATE_FORMAT = \'YY-MM-DD\'',
200 'yyyy-mm-dd' => 'ALTER SESSION SET NLS_DATE_FORMAT = \'YYYY-MM-DD\'',
201 'mm/dd/yy' => 'ALTER SESSION SET NLS_DATE_FORMAT = \'MM/DD/YY\'',
202 'dd/mm/yy' => 'ALTER SESSION SET NLS_DATE_FORMAT = \'DD/MM/YY\'',
203 'dd.mm.yy' => 'ALTER SESSION SET NLS_DATE_FORMAT = \'DD.MM.YY\'',
206 $form->{dboptions} = $dboptions{ $form->{dbdriver} }{ $form->{dateformat} };
208 if ($form->{dbdriver} eq 'Pg') {
209 $form->{dbconnect} = "dbi:Pg:dbname=$db";
212 if ($form->{dbdriver} eq 'Oracle') {
213 $form->{dbconnect} = "dbi:Oracle:sid=$form->{sid}";
216 if ($form->{dbhost}) {
217 $form->{dbconnect} .= ";host=$form->{dbhost}";
219 if ($form->{dbport}) {
220 $form->{dbconnect} .= ";port=$form->{dbport}";
223 $main::lxdebug->leave_sub();
227 $main::lxdebug->enter_sub();
229 my @drivers = DBI->available_drivers();
231 $main::lxdebug->leave_sub();
233 return (grep { /(Pg|Oracle)/ } @drivers);
237 $main::lxdebug->enter_sub();
239 my ($self, $form) = @_;
244 $form->{dbdefault} = $form->{dbuser} unless $form->{dbdefault};
245 $form->{sid} = $form->{dbdefault};
246 &dbconnect_vars($form, $form->{dbdefault});
248 my $dbh = SL::DBConnect->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
251 if ($form->{dbdriver} eq 'Pg') {
253 qq|SELECT datname FROM pg_database | .
254 qq|WHERE NOT datname IN ('template0', 'template1')|;
255 $sth = $dbh->prepare($query);
256 $sth->execute() || $form->dberror($query);
258 while (my ($db) = $sth->fetchrow_array) {
260 if ($form->{only_acc_db}) {
262 next if ($db =~ /^template/);
264 &dbconnect_vars($form, $db);
265 my $dbh = SL::DBConnect->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
269 qq|SELECT tablename FROM pg_tables | .
270 qq|WHERE (tablename = 'defaults') AND (tableowner = ?)|;
271 my $sth = $dbh->prepare($query);
272 $sth->execute($form->{dbuser}) ||
273 $form->dberror($query . " ($form->{dbuser})");
275 if ($sth->fetchrow_array) {
276 push(@dbsources, $db);
282 push(@dbsources, $db);
286 if ($form->{dbdriver} eq 'Oracle') {
287 if ($form->{only_acc_db}) {
289 qq|SELECT owner FROM dba_objects | .
290 qq|WHERE object_name = 'DEFAULTS' AND object_type = 'TABLE'|;
292 $query = qq|SELECT username FROM dba_users|;
295 $sth = $dbh->prepare($query);
296 $sth->execute || $form->dberror($query);
298 while (my ($db) = $sth->fetchrow_array) {
299 push(@dbsources, $db);
306 $main::lxdebug->leave_sub();
311 sub dbclusterencoding {
312 $main::lxdebug->enter_sub();
314 my ($self, $form) = @_;
316 $form->{dbdefault} ||= $form->{dbuser};
318 dbconnect_vars($form, $form->{dbdefault});
320 my $dbh = SL::DBConnect->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}) || $form->dberror();
321 my $query = qq|SELECT pg_encoding_to_char(encoding) FROM pg_database WHERE datname = 'template0'|;
322 my ($cluster_encoding) = $dbh->selectrow_array($query);
325 $main::lxdebug->leave_sub();
327 return $cluster_encoding;
331 $main::lxdebug->enter_sub();
333 my ($self, $form) = @_;
335 $form->{sid} = $form->{dbdefault};
336 &dbconnect_vars($form, $form->{dbdefault});
338 SL::DBConnect->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
340 $form->{db} =~ s/\"//g;
342 'Pg' => qq|CREATE DATABASE "$form->{db}"|,
344 qq|CREATE USER "$form->{db}" DEFAULT TABLESPACE USERS | .
345 qq|TEMPORARY TABLESPACE TEMP IDENTIFIED BY "$form->{db}"|
352 push(@{$dboptions{"Pg"}}, "ENCODING = " . $dbh->quote($form->{"encoding"}))
353 if ($form->{"encoding"});
354 if ($form->{"dbdefault"}) {
355 my $dbdefault = $form->{"dbdefault"};
356 $dbdefault =~ s/[^a-zA-Z0-9_\-]//g;
357 push(@{$dboptions{"Pg"}}, "TEMPLATE = $dbdefault");
360 my $query = $dbcreate{$form->{dbdriver}};
361 $query .= " WITH " . join(" ", @{$dboptions{"Pg"}}) if (@{$dboptions{"Pg"}});
363 # Ignore errors if the database exists.
366 if ($form->{dbdriver} eq 'Oracle') {
367 $query = qq|GRANT CONNECT, RESOURCE TO "$form->{db}"|;
368 do_query($form, $dbh, $query);
372 # setup variables for the new database
373 if ($form->{dbdriver} eq 'Oracle') {
374 $form->{dbuser} = $form->{db};
375 $form->{dbpasswd} = $form->{db};
378 &dbconnect_vars($form, $form->{db});
380 $dbh = SL::DBConnect->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
383 my $db_charset = $Common::db_encoding_to_charset{$form->{encoding}};
384 $db_charset ||= Common::DEFAULT_CHARSET;
386 my $dbupdater = SL::DBUpgrade2->new(form => $form, dbdriver => $form->{dbdriver});
388 $dbupdater->process_query($dbh, "sql/lx-office.sql", undef, $db_charset);
390 # load chart of accounts
391 $dbupdater->process_query($dbh, "sql/$form->{chart}-chart.sql", undef, $db_charset);
393 $query = "UPDATE defaults SET coa = ?";
394 do_query($form, $dbh, $query, $form->{chart});
395 $query = "UPDATE defaults SET accounting_method = ?";
396 do_query($form, $dbh, $query, $form->{accounting_method});
397 $query = "UPDATE defaults SET profit_determination = ?";
398 do_query($form, $dbh, $query, $form->{profit_determination});
399 $query = "UPDATE defaults SET inventory_system = ?";
400 do_query($form, $dbh, $query, $form->{inventory_system});
401 $query = "UPDATE defaults SET curr = ?";
402 do_query($form, $dbh, $query, $form->{defaultcurrency});
406 $main::lxdebug->leave_sub();
410 $main::lxdebug->enter_sub();
412 my ($self, $form) = @_;
413 $form->{db} =~ s/\"//g;
414 my %dbdelete = ('Pg' => qq|DROP DATABASE "$form->{db}"|,
415 'Oracle' => qq|DROP USER "$form->{db}" CASCADE|);
417 $form->{sid} = $form->{dbdefault};
418 &dbconnect_vars($form, $form->{dbdefault});
419 my $dbh = SL::DBConnect->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
421 my $query = $dbdelete{$form->{dbdriver}};
422 do_query($form, $dbh, $query);
426 $main::lxdebug->leave_sub();
429 sub dbsources_unused {
430 $main::lxdebug->enter_sub();
432 my ($self, $form) = @_;
434 $form->{only_acc_db} = 1;
436 my %members = $main::auth->read_all_users();
437 my %dbexcl = map { $_ => 1 } grep { $_ } map { $_->{dbname} } values %members;
439 $dbexcl{$form->{dbdefault}} = 1;
440 $dbexcl{$main::auth->{DB_config}->{db}} = 1;
442 my @dbunused = grep { !$dbexcl{$_} } dbsources("", $form);
444 $main::lxdebug->leave_sub();
450 $main::lxdebug->enter_sub();
452 my ($self, $form) = @_;
454 my %members = $main::auth->read_all_users();
455 my $dbupdater = SL::DBUpgrade2->new(form => $form, dbdriver => $form->{dbdriver})->parse_dbupdate_controls;
457 my ($query, $sth, %dbs_needing_updates);
459 foreach my $login (grep /[a-z]/, keys %members) {
460 my $member = $members{$login};
462 map { $form->{$_} = $member->{$_} } qw(dbname dbuser dbpasswd dbhost dbport);
463 dbconnect_vars($form, $form->{dbname});
465 my $dbh = SL::DBConnect->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd});
471 $query = qq|SELECT version FROM defaults|;
472 $sth = prepare_query($form, $dbh, $query);
473 if ($sth->execute()) {
474 ($version) = $sth->fetchrow_array();
478 $dbh->disconnect and next unless $version;
480 my $update_available = $dbupdater->update_available($version) || $dbupdater->update2_available($dbh);
483 if ($update_available) {
485 map { $dbinfo->{$_} = $member->{$_} } grep /^db/, keys %{ $member };
486 $dbs_needing_updates{$member->{dbhost} . "::" . $member->{dbname}} = $dbinfo;
490 $main::lxdebug->leave_sub();
492 return values %dbs_needing_updates;
496 $main::lxdebug->enter_sub(2);
498 my (@v, $version, $i);
500 @v = split(/\./, $_[0]);
501 while (scalar(@v) < 4) {
505 for ($i = 0; $i < 4; $i++) {
510 $main::lxdebug->leave_sub(2);
514 sub cmp_script_version {
515 my ($a_from, $a_to, $b_from, $b_to);
516 my ($i, $res_a, $res_b);
517 my ($my_a, $my_b) = ($a, $b);
519 $my_a =~ s/.*-upgrade-//;
521 $my_b =~ s/.*-upgrade-//;
523 my ($my_a_from, $my_a_to) = split(/-/, $my_a);
524 my ($my_b_from, $my_b_to) = split(/-/, $my_b);
526 $res_a = calc_version($my_a_from);
527 $res_b = calc_version($my_b_from);
529 if ($res_a == $res_b) {
530 $res_a = calc_version($my_a_to);
531 $res_b = calc_version($my_b_to);
534 return $res_a <=> $res_b;
537 sub create_schema_info_table {
538 $main::lxdebug->enter_sub();
540 my ($self, $form, $dbh) = @_;
542 my $query = "SELECT tag FROM schema_info LIMIT 1";
543 if (!$dbh->do($query)) {
546 qq|CREATE TABLE schema_info (| .
549 qq| itime timestamp DEFAULT now(), | .
550 qq| PRIMARY KEY (tag))|;
551 $dbh->do($query) || $form->dberror($query);
554 $main::lxdebug->leave_sub();
558 $main::lxdebug->enter_sub();
560 my ($self, $form) = @_;
564 $form->{sid} = $form->{dbdefault};
566 my @upgradescripts = ();
570 if ($form->{dbupdate}) {
572 # read update scripts into memory
573 opendir(SQLDIR, "sql/" . $form->{dbdriver} . "-upgrade")
574 or &error("", "sql/" . $form->{dbdriver} . "-upgrade : $!");
576 sort(cmp_script_version
577 grep(/$form->{dbdriver}-upgrade-.*?\.(sql|pl)$/,
582 my $db_charset = $::lx_office_conf{system}->{dbcharset};
583 $db_charset ||= Common::DEFAULT_CHARSET;
585 my $dbupdater = SL::DBUpgrade2->new(form => $form, dbdriver => $form->{dbdriver});
587 foreach my $db (split(/ /, $form->{dbupdate})) {
589 next unless $form->{$db};
591 # strip db from dataset
593 &dbconnect_vars($form, $db);
595 my $dbh = SL::DBConnect->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
598 $dbh->do($form->{dboptions}) if ($form->{dboptions});
601 $query = qq|SELECT version FROM defaults|;
602 my ($version) = selectrow_query($form, $dbh, $query);
604 next unless $version;
606 $version = calc_version($version);
608 foreach my $upgradescript (@upgradescripts) {
609 my $a = $upgradescript;
610 $a =~ s/^\Q$form->{dbdriver}\E-upgrade-|\.(sql|pl)$//g;
612 my ($mindb, $maxdb) = split /-/, $a;
613 my $str_maxdb = $maxdb;
614 $mindb = calc_version($mindb);
615 $maxdb = calc_version($maxdb);
617 next if ($version >= $maxdb);
619 # if there is no upgrade script exit
620 last if ($version < $mindb);
623 $main::lxdebug->message(LXDebug->DEBUG2(), "Applying Update $upgradescript");
624 $dbupdater->process_file($dbh, "sql/" . $form->{"dbdriver"} . "-upgrade/$upgradescript", $str_maxdb, $db_charset);
635 $main::lxdebug->leave_sub();
641 $main::lxdebug->enter_sub();
643 my ($self, $form, $dbupdater) = @_;
645 $form->{sid} = $form->{dbdefault};
648 my $db_charset = $::lx_office_conf{system}->{dbcharset} || Common::DEFAULT_CHARSET;
650 map { $_->{description} = SL::Iconv::convert($_->{charset}, $db_charset, $_->{description}) } values %{ $dbupdater->{all_controls} };
652 foreach my $db (split / /, $form->{dbupdate}) {
653 next unless $form->{$db};
655 # strip db from dataset
657 &dbconnect_vars($form, $db);
659 my $dbh = SL::DBConnect->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}) or $form->dberror;
661 $dbh->do($form->{dboptions}) if ($form->{dboptions});
663 $self->create_schema_info_table($form, $dbh);
665 my @upgradescripts = $dbupdater->unapplied_upgrade_scripts($dbh);
667 $dbh->disconnect and next if !@upgradescripts;
669 foreach my $control (@upgradescripts) {
671 $main::lxdebug->message(LXDebug->DEBUG2(), "Applying Update $control->{file}");
672 print $form->parse_html_template("dbupgrade/upgrade_message2", $control);
674 $dbupdater->process_file($dbh, "sql/" . $form->{"dbdriver"} . "-upgrade2/$control->{file}", $control, $db_charset);
682 $main::lxdebug->leave_sub();
688 $main::lxdebug->enter_sub();
692 # format dbconnect and dboptions string
693 dbconnect_vars($self, $self->{dbname});
695 map { $self->{$_} =~ s/\r//g; } qw(address signature);
697 $main::auth->save_user($self->{login}, map { $_, $self->{$_} } config_vars());
699 my $dbh = SL::DBConnect->connect($self->{dbconnect}, $self->{dbuser}, $self->{dbpasswd});
701 $self->create_employee_entry($::form, $dbh, $self, 1);
705 $main::lxdebug->leave_sub();
708 sub create_employee_entry {
709 $main::lxdebug->enter_sub();
714 my $myconfig = shift;
715 my $update_existing = shift;
717 if (!does_table_exist($dbh, 'employee')) {
718 $main::lxdebug->leave_sub();
722 # add login to employee table if it does not exist
723 # no error check for employee table, ignore if it does not exist
724 my ($id) = selectrow_query($form, $dbh, qq|SELECT id FROM employee WHERE login = ?|, $self->{login});
725 my ($good_db) = selectrow_query($form, $dbh, qq|select * from pg_tables where tablename = ? and schemaname = ?|, 'schema_info', 'public');
727 ($can_delete) = selectrow_query($form, $dbh, qq|SELECT tag FROM schema_info WHERE tag = ?|, 'employee_deleted') if $good_db;
730 my $query = qq|INSERT INTO employee (login, name, workphone, role) VALUES (?, ?, ?, ?)|;
731 do_query($form, $dbh, $query, ($self->{login}, $myconfig->{name}, $myconfig->{tel}, "user"));
733 } elsif ($update_existing && $can_delete) {
734 my $query = qq|UPDATE employee SET name = ?, workphone = ?, role = 'user', deleted = 'f' WHERE id = ?|;
735 do_query($form, $dbh, $query, $myconfig->{name}, $myconfig->{tel}, $id);
738 $main::lxdebug->leave_sub();
742 $main::lxdebug->enter_sub();
744 my @conf = qw(address admin businessnumber company countrycode
745 currency dateformat dbconnect dbdriver dbhost dbport dboptions
746 dbname dbuser dbpasswd email fax name numberformat password
747 printer sid signature stylesheet tel templates vclimit angebote
748 bestellungen rechnungen anfragen lieferantenbestellungen einkaufsrechnungen
749 taxnumber co_ustid duns menustyle template_format default_media
750 default_printer_id copies show_form_details favorites
751 pdonumber sdonumber hide_cvar_search_options mandatory_departments
752 sepa_creditor_id taxincluded_checked);
754 $main::lxdebug->leave_sub();
760 $main::lxdebug->enter_sub();
762 my ($self, $msg) = @_;
764 $main::lxdebug->show_backtrace();
766 if ($ENV{HTTP_USER_AGENT}) {
767 print qq|Content-Type: text/html
769 <!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0//EN">
771 <body bgcolor=ffffff>
773 <h2><font color=red>Error!</font></h2>
780 $main::lxdebug->leave_sub();