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 "xml" ? "menuXML.pl" :
179 print $form->parse_html_template("dbupgrade/footer", { "menufile" => $menufile });
186 $main::lxdebug->leave_sub();
192 $main::lxdebug->enter_sub();
194 my ($form, $db) = @_;
197 'Pg' => { 'yy-mm-dd' => 'set DateStyle to \'ISO\'',
198 'yyyy-mm-dd' => 'set DateStyle to \'ISO\'',
199 'mm/dd/yy' => 'set DateStyle to \'SQL, US\'',
200 'mm-dd-yy' => 'set DateStyle to \'POSTGRES, US\'',
201 'dd/mm/yy' => 'set DateStyle to \'SQL, EUROPEAN\'',
202 'dd-mm-yy' => 'set DateStyle to \'POSTGRES, EUROPEAN\'',
203 'dd.mm.yy' => 'set DateStyle to \'GERMAN\''
206 'yy-mm-dd' => 'ALTER SESSION SET NLS_DATE_FORMAT = \'YY-MM-DD\'',
207 'yyyy-mm-dd' => 'ALTER SESSION SET NLS_DATE_FORMAT = \'YYYY-MM-DD\'',
208 'mm/dd/yy' => 'ALTER SESSION SET NLS_DATE_FORMAT = \'MM/DD/YY\'',
209 'mm-dd-yy' => 'ALTER SESSION SET NLS_DATE_FORMAT = \'MM-DD-YY\'',
210 'dd/mm/yy' => 'ALTER SESSION SET NLS_DATE_FORMAT = \'DD/MM/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\'',
215 $form->{dboptions} = $dboptions{ $form->{dbdriver} }{ $form->{dateformat} };
217 if ($form->{dbdriver} eq 'Pg') {
218 $form->{dbconnect} = "dbi:Pg:dbname=$db";
221 if ($form->{dbdriver} eq 'Oracle') {
222 $form->{dbconnect} = "dbi:Oracle:sid=$form->{sid}";
225 if ($form->{dbhost}) {
226 $form->{dbconnect} .= ";host=$form->{dbhost}";
228 if ($form->{dbport}) {
229 $form->{dbconnect} .= ";port=$form->{dbport}";
232 $main::lxdebug->leave_sub();
236 $main::lxdebug->enter_sub();
238 my @drivers = DBI->available_drivers();
240 $main::lxdebug->leave_sub();
242 return (grep { /(Pg|Oracle)/ } @drivers);
246 $main::lxdebug->enter_sub();
248 my ($self, $form) = @_;
253 $form->{dbdefault} = $form->{dbuser} unless $form->{dbdefault};
254 $form->{sid} = $form->{dbdefault};
255 &dbconnect_vars($form, $form->{dbdefault});
258 DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
261 if ($form->{dbdriver} eq 'Pg') {
263 qq|SELECT datname FROM pg_database | .
264 qq|WHERE NOT datname IN ('template0', 'template1')|;
265 $sth = $dbh->prepare($query);
266 $sth->execute() || $form->dberror($query);
268 while (my ($db) = $sth->fetchrow_array) {
270 if ($form->{only_acc_db}) {
272 next if ($db =~ /^template/);
274 &dbconnect_vars($form, $db);
276 DBI->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 = DBI->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 DBI->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 = DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
394 my $db_charset = $Common::db_encoding_to_charset{$form->{encoding}};
395 $db_charset ||= Common::DEFAULT_CHARSET;
398 $self->process_query($form, $dbh, "sql/lx-office.sql", undef, $db_charset);
400 # load chart of accounts
401 $self->process_query($form, $dbh, "sql/$form->{chart}-chart.sql", undef, $db_charset);
403 $query = "UPDATE defaults SET coa = ?";
404 do_query($form, $dbh, $query, $form->{chart});
408 $main::lxdebug->leave_sub();
411 # Process a Perl script which updates the database.
412 # If the script returns 1 then the update was successful.
413 # Return code "2" means "needs more interaction; remove
414 # users/nologin and exit".
415 # All other return codes are fatal errors.
416 sub process_perl_script {
417 $main::lxdebug->enter_sub();
419 my ($self, $form, $dbh, $filename, $version_or_control, $db_charset) = @_;
421 my $fh = IO::File->new($filename, "r") or $form->error("$filename : $!\n");
423 my $file_charset = Common::DEFAULT_CHARSET;
425 if (ref($version_or_control) eq "HASH") {
426 $file_charset = $version_or_control->{charset};
431 next if !/^--\s*\@charset:\s*(.+)/;
435 $fh->seek(0, SEEK_SET);
438 my $contents = join "", <$fh>;
441 $db_charset ||= Common::DEFAULT_CHARSET;
443 my $iconv = SL::Iconv::get_converter($file_charset, $db_charset);
447 my %dbup_myconfig = ();
448 map({ $dbup_myconfig{$_} = $form->{$_}; }
449 qw(dbname dbuser dbpasswd dbhost dbport dbconnect));
451 my $nls_file = $filename;
452 $nls_file =~ s|.*/||;
453 $nls_file =~ s|.pl$||;
454 my $dbup_locale = Locale->new($main::language, $nls_file);
456 my $result = eval($contents);
463 if (!defined($result)) {
464 print $form->parse_html_template("dbupgrade/error",
465 { "file" => $filename,
468 } elsif (1 != $result) {
469 unlink("users/nologin") if (2 == $result);
473 if (ref($version_or_control) eq "HASH") {
474 $dbh->do("INSERT INTO schema_info (tag, login) VALUES (" .
475 $dbh->quote($version_or_control->{"tag"}) . ", " .
476 $dbh->quote($form->{"login"}) . ")");
477 } elsif ($version_or_control) {
478 $dbh->do("UPDATE defaults SET version = " .
479 $dbh->quote($version_or_control));
483 $main::lxdebug->leave_sub();
487 $main::lxdebug->enter_sub();
489 my ($self, $form, $dbh, $filename, $version_or_control, $db_charset) = @_;
491 my $fh = IO::File->new($filename, "r") or $form->error("$filename : $!\n");
496 my $file_charset = Common::DEFAULT_CHARSET;
499 next if !/^--\s*\@charset:\s*(.+)/;
503 $fh->seek(0, SEEK_SET);
505 $db_charset ||= Common::DEFAULT_CHARSET;
510 $_ = SL::Iconv::convert($file_charset, $db_charset, $_);
512 # Remove DOS and Unix style line endings.
518 for (my $i = 0; $i < length($_); $i++) {
519 my $char = substr($_, $i, 1);
521 # Are we inside a string?
523 if ($char eq $quote_chars[-1]) {
529 if (($char eq "'") || ($char eq "\"")) {
530 push(@quote_chars, $char);
532 } elsif ($char eq ";") {
534 # Query is complete. Send it.
536 $sth = $dbh->prepare($query);
537 if (!$sth->execute()) {
538 my $errstr = $dbh->errstr;
541 $form->dberror("The database update/creation did not succeed. " .
542 "The file ${filename} containing the following " .
543 "query failed:<br>${query}<br>" .
544 "The error message was: ${errstr}<br>" .
545 "All changes in that file have been reverted.");
558 if (ref($version_or_control) eq "HASH") {
559 $dbh->do("INSERT INTO schema_info (tag, login) VALUES (" .
560 $dbh->quote($version_or_control->{"tag"}) . ", " .
561 $dbh->quote($form->{"login"}) . ")");
562 } elsif ($version_or_control) {
563 $dbh->do("UPDATE defaults SET version = " .
564 $dbh->quote($version_or_control));
570 $main::lxdebug->leave_sub();
574 $main::lxdebug->enter_sub();
576 my ($self, $form) = @_;
577 $form->{db} =~ s/\"//g;
578 my %dbdelete = ('Pg' => qq|DROP DATABASE "$form->{db}"|,
579 'Oracle' => qq|DROP USER "$form->{db}" CASCADE|);
581 $form->{sid} = $form->{dbdefault};
582 &dbconnect_vars($form, $form->{dbdefault});
584 DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
586 my $query = $dbdelete{$form->{dbdriver}};
587 do_query($form, $dbh, $query);
591 $main::lxdebug->leave_sub();
594 sub dbsources_unused {
595 $main::lxdebug->enter_sub();
597 my ($self, $form) = @_;
599 $form->{only_acc_db} = 1;
601 my %members = $main::auth->read_all_users();
602 my %dbexcl = map { $_ => 1 } grep { $_ } map { $_->{dbname} } values %members;
604 $dbexcl{$form->{dbdefault}} = 1;
605 $dbexcl{$main::auth->{DB_config}->{db}} = 1;
607 my @dbunused = grep { !$dbexcl{$_} } dbsources("", $form);
609 $main::lxdebug->leave_sub();
615 $main::lxdebug->enter_sub();
617 my ($self, $form) = @_;
619 my %members = $main::auth->read_all_users();
620 my $controls = parse_dbupdate_controls($form, $form->{dbdriver});
622 my ($query, $sth, %dbs_needing_updates);
624 foreach my $login (grep /[a-z]/, keys %members) {
625 my $member = $members{$login};
627 map { $form->{$_} = $member->{$_} } qw(dbname dbuser dbpasswd dbhost dbport);
628 dbconnect_vars($form, $form->{dbname});
630 my $dbh = DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd});
636 $query = qq|SELECT version FROM defaults|;
637 $sth = prepare_query($form, $dbh, $query);
638 if ($sth->execute()) {
639 ($version) = $sth->fetchrow_array();
644 next unless $version;
646 if (update_available($form->{dbdriver}, $version) || update2_available($form, $controls)) {
648 map { $dbinfo->{$_} = $member->{$_} } grep /^db/, keys %{ $member };
649 $dbs_needing_updates{$member->{dbhost} . "::" . $member->{dbname}} = $dbinfo;
653 $main::lxdebug->leave_sub();
655 return values %dbs_needing_updates;
659 $main::lxdebug->enter_sub(2);
661 my (@v, $version, $i);
663 @v = split(/\./, $_[0]);
664 while (scalar(@v) < 4) {
668 for ($i = 0; $i < 4; $i++) {
673 $main::lxdebug->leave_sub(2);
677 sub cmp_script_version {
678 my ($a_from, $a_to, $b_from, $b_to);
679 my ($i, $res_a, $res_b);
680 my ($my_a, $my_b) = ($a, $b);
682 $my_a =~ s/.*-upgrade-//;
684 $my_b =~ s/.*-upgrade-//;
686 my ($my_a_from, $my_a_to) = split(/-/, $my_a);
687 my ($my_b_from, $my_b_to) = split(/-/, $my_b);
689 $res_a = calc_version($my_a_from);
690 $res_b = calc_version($my_b_from);
692 if ($res_a == $res_b) {
693 $res_a = calc_version($my_a_to);
694 $res_b = calc_version($my_b_to);
697 return $res_a <=> $res_b;
700 sub update_available {
701 my ($dbdriver, $cur_version) = @_;
705 opendir SQLDIR, "sql/${dbdriver}-upgrade" || error("", "sql/${dbdriver}-upgrade: $!");
706 my @upgradescripts = grep /${dbdriver}-upgrade-\Q$cur_version\E.*\.(sql|pl)$/, readdir SQLDIR;
709 return ($#upgradescripts > -1);
712 sub create_schema_info_table {
713 $main::lxdebug->enter_sub();
715 my ($self, $form, $dbh) = @_;
717 my $query = "SELECT tag FROM schema_info LIMIT 1";
718 if (!$dbh->do($query)) {
721 qq|CREATE TABLE schema_info (| .
724 qq| itime timestamp DEFAULT now(), | .
725 qq| PRIMARY KEY (tag))|;
726 $dbh->do($query) || $form->dberror($query);
729 $main::lxdebug->leave_sub();
733 $main::lxdebug->enter_sub();
735 my ($self, $form) = @_;
739 $form->{sid} = $form->{dbdefault};
741 my @upgradescripts = ();
745 if ($form->{dbupdate}) {
747 # read update scripts into memory
748 opendir(SQLDIR, "sql/" . $form->{dbdriver} . "-upgrade")
749 or &error("", "sql/" . $form->{dbdriver} . "-upgrade : $!");
751 sort(cmp_script_version
752 grep(/$form->{dbdriver}-upgrade-.*?\.(sql|pl)$/,
757 my $db_charset = $main::dbcharset;
758 $db_charset ||= Common::DEFAULT_CHARSET;
760 foreach my $db (split(/ /, $form->{dbupdate})) {
762 next unless $form->{$db};
764 # strip db from dataset
766 &dbconnect_vars($form, $db);
769 DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
772 $dbh->do($form->{dboptions}) if ($form->{dboptions});
775 $query = qq|SELECT version FROM defaults|;
776 my ($version) = selectrow_query($form, $dbh, $query);
778 next unless $version;
780 $version = calc_version($version);
782 foreach my $upgradescript (@upgradescripts) {
783 my $a = $upgradescript;
784 $a =~ s/^\Q$form->{dbdriver}\E-upgrade-|\.(sql|pl)$//g;
787 my ($mindb, $maxdb) = split /-/, $a;
788 my $str_maxdb = $maxdb;
789 $mindb = calc_version($mindb);
790 $maxdb = calc_version($maxdb);
792 next if ($version >= $maxdb);
794 # if there is no upgrade script exit
795 last if ($version < $mindb);
798 $main::lxdebug->message(LXDebug::DEBUG2, "Applying Update $upgradescript");
799 if ($file_type eq "sql") {
800 $self->process_query($form, $dbh, "sql/" . $form->{"dbdriver"} .
801 "-upgrade/$upgradescript", $str_maxdb, $db_charset);
803 $self->process_perl_script($form, $dbh, "sql/" . $form->{"dbdriver"} .
804 "-upgrade/$upgradescript", $str_maxdb, $db_charset);
816 $main::lxdebug->leave_sub();
822 $main::lxdebug->enter_sub();
824 my ($self, $form, $controls) = @_;
826 $form->{sid} = $form->{dbdefault};
828 my @upgradescripts = ();
829 my ($query, $sth, $tag);
832 @upgradescripts = sort_dbupdate_controls($controls);
834 my $db_charset = $main::dbcharset;
835 $db_charset ||= Common::DEFAULT_CHARSET;
837 foreach my $db (split / /, $form->{dbupdate}) {
839 next unless $form->{$db};
841 # strip db from dataset
843 &dbconnect_vars($form, $db);
846 DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
849 $dbh->do($form->{dboptions}) if ($form->{dboptions});
851 map({ $_->{"applied"} = 0; } @upgradescripts);
853 $self->create_schema_info_table($form, $dbh);
855 $query = qq|SELECT tag FROM schema_info|;
856 $sth = $dbh->prepare($query);
857 $sth->execute() || $form->dberror($query);
858 while (($tag) = $sth->fetchrow_array()) {
859 $controls->{$tag}->{"applied"} = 1 if (defined($controls->{$tag}));
864 foreach (@upgradescripts) {
865 if (!$_->{"applied"}) {
871 next if ($all_applied);
873 foreach my $control (@upgradescripts) {
874 next if ($control->{"applied"});
876 $control->{description} = SL::Iconv::convert($control->{charset}, $db_charset, $control->{description});
878 $control->{"file"} =~ /\.(sql|pl)$/;
882 $main::lxdebug->message(LXDebug::DEBUG2, "Applying Update $control->{file}");
883 print $form->parse_html_template("dbupgrade/upgrade_message2", $control);
885 if ($file_type eq "sql") {
886 $self->process_query($form, $dbh, "sql/" . $form->{"dbdriver"} .
887 "-upgrade2/$control->{file}", $control, $db_charset);
889 $self->process_perl_script($form, $dbh, "sql/" . $form->{"dbdriver"} .
890 "-upgrade2/$control->{file}", $control, $db_charset);
899 $main::lxdebug->leave_sub();
904 sub update2_available {
905 $main::lxdebug->enter_sub();
907 my ($form, $controls) = @_;
909 map({ $_->{"applied"} = 0; } values(%{$controls}));
911 dbconnect_vars($form, $form->{"dbname"});
914 DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}) ||
917 my ($query, $tag, $sth);
919 $query = qq|SELECT tag FROM schema_info|;
920 $sth = $dbh->prepare($query);
921 if ($sth->execute()) {
922 while (($tag) = $sth->fetchrow_array()) {
923 $controls->{$tag}->{"applied"} = 1 if (defined($controls->{$tag}));
929 map({ $main::lxdebug->leave_sub() and return 1 if (!$_->{"applied"}) }
930 values(%{$controls}));
932 $main::lxdebug->leave_sub();
937 $main::lxdebug->enter_sub();
940 my $form = \%main::form;
942 # format dbconnect and dboptions string
943 dbconnect_vars($self, $self->{dbname});
945 map { $self->{$_} =~ s/\r//g; } qw(address signature);
947 $main::auth->save_user($self->{login}, map { $_, $self->{$_} } config_vars());
949 my $dbh = DBI->connect($self->{dbconnect}, $self->{dbuser}, $self->{dbpasswd});
951 $self->create_employee_entry($form, $dbh, $self);
955 $main::lxdebug->leave_sub();
958 sub create_employee_entry {
959 $main::lxdebug->enter_sub();
964 my $myconfig = shift;
966 # add login to employee table if it does not exist
967 # no error check for employee table, ignore if it does not exist
968 my ($login) = selectrow_query($form, $dbh, qq|SELECT id FROM employee WHERE login = ?|, $self->{login});
971 my $query = qq|INSERT INTO employee (login, name, workphone, role) VALUES (?, ?, ?, ?)|;
972 do_query($form, $dbh, $query, ($self->{login}, $myconfig->{name}, $myconfig->{tel}, "user"));
975 $main::lxdebug->leave_sub();
979 $main::lxdebug->enter_sub();
981 my @conf = qw(address admin businessnumber company countrycode
982 currency dateformat dbconnect dbdriver dbhost dbport dboptions
983 dbname dbuser dbpasswd email fax name numberformat password
984 printer role sid signature stylesheet tel templates vclimit angebote
985 bestellungen rechnungen anfragen lieferantenbestellungen einkaufsrechnungen
986 taxnumber co_ustid duns menustyle template_format default_media
987 default_printer_id copies show_form_details favorites
988 pdonumber sdonumber);
990 $main::lxdebug->leave_sub();
996 $main::lxdebug->enter_sub();
998 my ($self, $msg) = @_;
1000 $main::lxdebug->show_backtrace();
1002 if ($ENV{HTTP_USER_AGENT}) {
1003 print qq|Content-Type: text/html
1005 <!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0//EN">
1007 <body bgcolor=ffffff>
1009 <h2><font color=red>Error!</font></h2>
1014 die "Error: $msg\n";
1016 $main::lxdebug->leave_sub();