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);
129 parse_dbupdate_controls($form, $myconfig{"dbdriver"});
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, $controls);
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;
399 $self->process_query($form, $dbh, "sql/lx-office.sql", undef, $db_charset);
401 # load chart of accounts
402 $self->process_query($form, $dbh, "sql/$form->{chart}-chart.sql", undef, $db_charset);
404 $query = "UPDATE defaults SET coa = ?";
405 do_query($form, $dbh, $query, $form->{chart});
409 $main::lxdebug->leave_sub();
412 # Process a Perl script which updates the database.
413 # If the script returns 1 then the update was successful.
414 # Return code "2" means "needs more interaction; remove
415 # users/nologin and end current request".
416 # All other return codes are fatal errors.
417 sub process_perl_script {
418 $main::lxdebug->enter_sub();
420 my ($self, $form, $dbh, $filename, $version_or_control, $db_charset) = @_;
422 my $fh = IO::File->new($filename, "r") or $form->error("$filename : $!\n");
424 my $file_charset = Common::DEFAULT_CHARSET;
426 if (ref($version_or_control) eq "HASH") {
427 $file_charset = $version_or_control->{charset};
432 next if !/^--\s*\@charset:\s*(.+)/;
436 $fh->seek(0, SEEK_SET);
439 my $contents = join "", <$fh>;
442 $db_charset ||= Common::DEFAULT_CHARSET;
444 my $iconv = SL::Iconv::get_converter($file_charset, $db_charset);
448 # setup dbup_ export vars
449 my %dbup_myconfig = ();
450 map({ $dbup_myconfig{$_} = $form->{$_}; }
451 qw(dbname dbuser dbpasswd dbhost dbport dbconnect));
453 my $dbup_locale = $::locale;
455 my $result = eval($contents);
462 if (!defined($result)) {
463 print $form->parse_html_template("dbupgrade/error",
464 { "file" => $filename,
467 } elsif (1 != $result) {
468 unlink("users/nologin") if (2 == $result);
472 if (ref($version_or_control) eq "HASH") {
473 $dbh->do("INSERT INTO schema_info (tag, login) VALUES (" .
474 $dbh->quote($version_or_control->{"tag"}) . ", " .
475 $dbh->quote($form->{"login"}) . ")");
476 } elsif ($version_or_control) {
477 $dbh->do("UPDATE defaults SET version = " .
478 $dbh->quote($version_or_control));
482 $main::lxdebug->leave_sub();
486 $main::lxdebug->enter_sub();
488 my ($self, $form, $dbh, $filename, $version_or_control, $db_charset) = @_;
490 my $fh = IO::File->new($filename, "r") or $form->error("$filename : $!\n");
495 my $file_charset = Common::DEFAULT_CHARSET;
498 next if !/^--\s*\@charset:\s*(.+)/;
502 $fh->seek(0, SEEK_SET);
504 $db_charset ||= Common::DEFAULT_CHARSET;
509 $_ = SL::Iconv::convert($file_charset, $db_charset, $_);
511 # Remove DOS and Unix style line endings.
517 for (my $i = 0; $i < length($_); $i++) {
518 my $char = substr($_, $i, 1);
520 # Are we inside a string?
522 if ($char eq $quote_chars[-1]) {
528 if (($char eq "'") || ($char eq "\"")) {
529 push(@quote_chars, $char);
531 } elsif ($char eq ";") {
533 # Query is complete. Send it.
535 $sth = $dbh->prepare($query);
536 if (!$sth->execute()) {
537 my $errstr = $dbh->errstr;
540 $form->dberror("The database update/creation did not succeed. " .
541 "The file ${filename} containing the following " .
542 "query failed:<br>${query}<br>" .
543 "The error message was: ${errstr}<br>" .
544 "All changes in that file have been reverted.");
556 # Insert a space at the end of each line so that queries split
557 # over multiple lines work properly.
559 $query .= @quote_chars ? "\n" : ' ';
563 if (ref($version_or_control) eq "HASH") {
564 $dbh->do("INSERT INTO schema_info (tag, login) VALUES (" .
565 $dbh->quote($version_or_control->{"tag"}) . ", " .
566 $dbh->quote($form->{"login"}) . ")");
567 } elsif ($version_or_control) {
568 $dbh->do("UPDATE defaults SET version = " .
569 $dbh->quote($version_or_control));
575 $main::lxdebug->leave_sub();
579 $main::lxdebug->enter_sub();
581 my ($self, $form) = @_;
582 $form->{db} =~ s/\"//g;
583 my %dbdelete = ('Pg' => qq|DROP DATABASE "$form->{db}"|,
584 'Oracle' => qq|DROP USER "$form->{db}" CASCADE|);
586 $form->{sid} = $form->{dbdefault};
587 &dbconnect_vars($form, $form->{dbdefault});
589 DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
591 my $query = $dbdelete{$form->{dbdriver}};
592 do_query($form, $dbh, $query);
596 $main::lxdebug->leave_sub();
599 sub dbsources_unused {
600 $main::lxdebug->enter_sub();
602 my ($self, $form) = @_;
604 $form->{only_acc_db} = 1;
606 my %members = $main::auth->read_all_users();
607 my %dbexcl = map { $_ => 1 } grep { $_ } map { $_->{dbname} } values %members;
609 $dbexcl{$form->{dbdefault}} = 1;
610 $dbexcl{$main::auth->{DB_config}->{db}} = 1;
612 my @dbunused = grep { !$dbexcl{$_} } dbsources("", $form);
614 $main::lxdebug->leave_sub();
620 $main::lxdebug->enter_sub();
622 my ($self, $form) = @_;
624 my %members = $main::auth->read_all_users();
625 my $controls = parse_dbupdate_controls($form, $form->{dbdriver});
627 my ($query, $sth, %dbs_needing_updates);
629 foreach my $login (grep /[a-z]/, keys %members) {
630 my $member = $members{$login};
632 map { $form->{$_} = $member->{$_} } qw(dbname dbuser dbpasswd dbhost dbport);
633 dbconnect_vars($form, $form->{dbname});
635 my $dbh = DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd});
641 $query = qq|SELECT version FROM defaults|;
642 $sth = prepare_query($form, $dbh, $query);
643 if ($sth->execute()) {
644 ($version) = $sth->fetchrow_array();
649 next unless $version;
651 if (update_available($form->{dbdriver}, $version) || update2_available($form, $controls)) {
653 map { $dbinfo->{$_} = $member->{$_} } grep /^db/, keys %{ $member };
654 $dbs_needing_updates{$member->{dbhost} . "::" . $member->{dbname}} = $dbinfo;
658 $main::lxdebug->leave_sub();
660 return values %dbs_needing_updates;
664 $main::lxdebug->enter_sub(2);
666 my (@v, $version, $i);
668 @v = split(/\./, $_[0]);
669 while (scalar(@v) < 4) {
673 for ($i = 0; $i < 4; $i++) {
678 $main::lxdebug->leave_sub(2);
682 sub cmp_script_version {
683 my ($a_from, $a_to, $b_from, $b_to);
684 my ($i, $res_a, $res_b);
685 my ($my_a, $my_b) = ($a, $b);
687 $my_a =~ s/.*-upgrade-//;
689 $my_b =~ s/.*-upgrade-//;
691 my ($my_a_from, $my_a_to) = split(/-/, $my_a);
692 my ($my_b_from, $my_b_to) = split(/-/, $my_b);
694 $res_a = calc_version($my_a_from);
695 $res_b = calc_version($my_b_from);
697 if ($res_a == $res_b) {
698 $res_a = calc_version($my_a_to);
699 $res_b = calc_version($my_b_to);
702 return $res_a <=> $res_b;
705 sub update_available {
706 my ($dbdriver, $cur_version) = @_;
710 opendir SQLDIR, "sql/${dbdriver}-upgrade" || error("", "sql/${dbdriver}-upgrade: $!");
711 my @upgradescripts = grep /${dbdriver}-upgrade-\Q$cur_version\E.*\.(sql|pl)$/, readdir SQLDIR;
714 return ($#upgradescripts > -1);
717 sub create_schema_info_table {
718 $main::lxdebug->enter_sub();
720 my ($self, $form, $dbh) = @_;
722 my $query = "SELECT tag FROM schema_info LIMIT 1";
723 if (!$dbh->do($query)) {
726 qq|CREATE TABLE schema_info (| .
729 qq| itime timestamp DEFAULT now(), | .
730 qq| PRIMARY KEY (tag))|;
731 $dbh->do($query) || $form->dberror($query);
734 $main::lxdebug->leave_sub();
738 $main::lxdebug->enter_sub();
740 my ($self, $form) = @_;
744 $form->{sid} = $form->{dbdefault};
746 my @upgradescripts = ();
750 if ($form->{dbupdate}) {
752 # read update scripts into memory
753 opendir(SQLDIR, "sql/" . $form->{dbdriver} . "-upgrade")
754 or &error("", "sql/" . $form->{dbdriver} . "-upgrade : $!");
756 sort(cmp_script_version
757 grep(/$form->{dbdriver}-upgrade-.*?\.(sql|pl)$/,
762 my $db_charset = $main::dbcharset;
763 $db_charset ||= Common::DEFAULT_CHARSET;
765 foreach my $db (split(/ /, $form->{dbupdate})) {
767 next unless $form->{$db};
769 # strip db from dataset
771 &dbconnect_vars($form, $db);
774 DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
777 $dbh->do($form->{dboptions}) if ($form->{dboptions});
780 $query = qq|SELECT version FROM defaults|;
781 my ($version) = selectrow_query($form, $dbh, $query);
783 next unless $version;
785 $version = calc_version($version);
787 foreach my $upgradescript (@upgradescripts) {
788 my $a = $upgradescript;
789 $a =~ s/^\Q$form->{dbdriver}\E-upgrade-|\.(sql|pl)$//g;
792 my ($mindb, $maxdb) = split /-/, $a;
793 my $str_maxdb = $maxdb;
794 $mindb = calc_version($mindb);
795 $maxdb = calc_version($maxdb);
797 next if ($version >= $maxdb);
799 # if there is no upgrade script exit
800 last if ($version < $mindb);
803 $main::lxdebug->message(LXDebug->DEBUG2(), "Applying Update $upgradescript");
804 if ($file_type eq "sql") {
805 $self->process_query($form, $dbh, "sql/" . $form->{"dbdriver"} .
806 "-upgrade/$upgradescript", $str_maxdb, $db_charset);
808 $self->process_perl_script($form, $dbh, "sql/" . $form->{"dbdriver"} .
809 "-upgrade/$upgradescript", $str_maxdb, $db_charset);
821 $main::lxdebug->leave_sub();
827 $main::lxdebug->enter_sub();
829 my ($self, $form, $controls) = @_;
831 $form->{sid} = $form->{dbdefault};
833 my @upgradescripts = ();
834 my ($query, $sth, $tag);
837 @upgradescripts = sort_dbupdate_controls($controls);
839 my $db_charset = $main::dbcharset;
840 $db_charset ||= Common::DEFAULT_CHARSET;
842 foreach my $db (split / /, $form->{dbupdate}) {
844 next unless $form->{$db};
846 # strip db from dataset
848 &dbconnect_vars($form, $db);
851 DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
854 $dbh->do($form->{dboptions}) if ($form->{dboptions});
856 map({ $_->{"applied"} = 0; } @upgradescripts);
858 $self->create_schema_info_table($form, $dbh);
860 $query = qq|SELECT tag FROM schema_info|;
861 $sth = $dbh->prepare($query);
862 $sth->execute() || $form->dberror($query);
863 while (($tag) = $sth->fetchrow_array()) {
864 $controls->{$tag}->{"applied"} = 1 if (defined($controls->{$tag}));
869 foreach (@upgradescripts) {
870 if (!$_->{"applied"}) {
876 next if ($all_applied);
878 foreach my $control (@upgradescripts) {
879 next if ($control->{"applied"});
881 $control->{description} = SL::Iconv::convert($control->{charset}, $db_charset, $control->{description});
883 $control->{"file"} =~ /\.(sql|pl)$/;
887 $main::lxdebug->message(LXDebug->DEBUG2(), "Applying Update $control->{file}");
888 print $form->parse_html_template("dbupgrade/upgrade_message2", $control);
890 if ($file_type eq "sql") {
891 $self->process_query($form, $dbh, "sql/" . $form->{"dbdriver"} .
892 "-upgrade2/$control->{file}", $control, $db_charset);
894 $self->process_perl_script($form, $dbh, "sql/" . $form->{"dbdriver"} .
895 "-upgrade2/$control->{file}", $control, $db_charset);
904 $main::lxdebug->leave_sub();
909 sub update2_available {
910 $main::lxdebug->enter_sub();
912 my ($form, $controls) = @_;
914 map({ $_->{"applied"} = 0; } values(%{$controls}));
916 dbconnect_vars($form, $form->{"dbname"});
919 DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}) ||
922 my ($query, $tag, $sth);
924 $query = qq|SELECT tag FROM schema_info|;
925 $sth = $dbh->prepare($query);
926 if ($sth->execute()) {
927 while (($tag) = $sth->fetchrow_array()) {
928 $controls->{$tag}->{"applied"} = 1 if (defined($controls->{$tag}));
934 map({ $main::lxdebug->leave_sub() and return 1 if (!$_->{"applied"}) }
935 values(%{$controls}));
937 $main::lxdebug->leave_sub();
942 $main::lxdebug->enter_sub();
945 my $form = \%main::form;
947 # format dbconnect and dboptions string
948 dbconnect_vars($self, $self->{dbname});
950 map { $self->{$_} =~ s/\r//g; } qw(address signature);
952 $main::auth->save_user($self->{login}, map { $_, $self->{$_} } config_vars());
954 my $dbh = DBI->connect($self->{dbconnect}, $self->{dbuser}, $self->{dbpasswd});
956 $self->create_employee_entry($form, $dbh, $self, 1);
960 $main::lxdebug->leave_sub();
963 sub create_employee_entry {
964 $main::lxdebug->enter_sub();
969 my $myconfig = shift;
970 my $update_existing = shift;
972 if (!does_table_exist($dbh, 'employee')) {
973 $main::lxdebug->leave_sub();
977 # add login to employee table if it does not exist
978 # no error check for employee table, ignore if it does not exist
979 my ($id) = selectrow_query($form, $dbh, qq|SELECT id FROM employee WHERE login = ?|, $self->{login});
982 my $query = qq|INSERT INTO employee (login, name, workphone, role) VALUES (?, ?, ?, ?)|;
983 do_query($form, $dbh, $query, ($self->{login}, $myconfig->{name}, $myconfig->{tel}, "user"));
985 } elsif ($update_existing) {
986 my $query = qq|UPDATE employee SET name = ?, workphone = ?, role = 'user' WHERE id = ?|;
987 do_query($form, $dbh, $query, $myconfig->{name}, $myconfig->{tel}, $id);
990 $main::lxdebug->leave_sub();
994 $main::lxdebug->enter_sub();
996 my @conf = qw(address admin businessnumber company countrycode
997 currency dateformat dbconnect dbdriver dbhost dbport dboptions
998 dbname dbuser dbpasswd email fax name numberformat password
999 printer role sid signature stylesheet tel templates vclimit angebote
1000 bestellungen rechnungen anfragen lieferantenbestellungen einkaufsrechnungen
1001 taxnumber co_ustid duns menustyle template_format default_media
1002 default_printer_id copies show_form_details favorites
1003 pdonumber sdonumber hide_cvar_search_options mandatory_departments);
1005 $main::lxdebug->leave_sub();
1011 $main::lxdebug->enter_sub();
1013 my ($self, $msg) = @_;
1015 $main::lxdebug->show_backtrace();
1017 if ($ENV{HTTP_USER_AGENT}) {
1018 print qq|Content-Type: text/html
1020 <!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0//EN">
1022 <body bgcolor=ffffff>
1024 <h2><font color=red>Error!</font></h2>
1029 die "Error: $msg\n";
1031 $main::lxdebug->leave_sub();