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 #=====================================================================
47 $main::lxdebug->enter_sub();
49 my ($type, $login) = @_;
54 my %user_data = $main::auth->read_user($login);
55 map { $self->{$_} = $user_data{$_} } keys %user_data;
58 $main::lxdebug->leave_sub();
64 $main::lxdebug->enter_sub();
71 # scan the locale directory and read in the LANGUAGE files
72 opendir(DIR, "locale");
74 my @dir = grep(!/(^\.\.?$|\..*)/, readdir(DIR));
76 foreach my $dir (@dir) {
77 next unless open(FH, "locale/$dir/LANGUAGE");
81 $cc{$dir} = "@language";
86 $main::lxdebug->leave_sub();
92 $main::lxdebug->enter_sub();
94 my ($self, $form) = @_;
100 if ($self->{login}) {
101 my %myconfig = $main::auth->read_user($self->{login});
103 # check if database is down
105 DBI->connect($myconfig{dbconnect}, $myconfig{dbuser},
107 or $self->error(DBI::errstr);
109 # we got a connection, check the version
110 my $query = qq|SELECT version FROM defaults|;
111 my $sth = $dbh->prepare($query);
112 $sth->execute || $form->dberror($query);
114 my ($dbversion) = $sth->fetchrow_array;
117 $self->create_employee_entry($form, $dbh, \%myconfig);
119 $self->create_schema_info_table($form, $dbh);
126 parse_dbupdate_controls($form, $myconfig{"dbdriver"});
128 map({ $form->{$_} = $myconfig{$_} }
129 qw(dbname dbhost dbport dbdriver dbuser dbpasswd dbconnect dateformat));
131 if (update_available($myconfig{"dbdriver"}, $dbversion) ||
132 update2_available($form, $controls)) {
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, ">$main::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.',
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, $controls);
168 unlink("$main::userspath/nologin");
171 $self->{"menustyle"} eq "v3" ? "menuv3.pl" :
172 $self->{"menustyle"} eq "neu" ? "menunew.pl" :
173 $self->{"menustyle"} eq "xml" ? "menuXML.pl" :
176 print $form->parse_html_template("dbupgrade/footer", { "menufile" => $menufile });
183 $main::lxdebug->leave_sub();
189 $main::lxdebug->enter_sub();
191 my ($form, $db) = @_;
194 'Pg' => { 'yy-mm-dd' => 'set DateStyle to \'ISO\'',
195 'yyyy-mm-dd' => 'set DateStyle to \'ISO\'',
196 'mm/dd/yy' => 'set DateStyle to \'SQL, US\'',
197 'mm-dd-yy' => 'set DateStyle to \'POSTGRES, US\'',
198 'dd/mm/yy' => 'set DateStyle to \'SQL, EUROPEAN\'',
199 'dd-mm-yy' => 'set DateStyle to \'POSTGRES, EUROPEAN\'',
200 'dd.mm.yy' => 'set DateStyle to \'GERMAN\''
203 'yy-mm-dd' => 'ALTER SESSION SET NLS_DATE_FORMAT = \'YY-MM-DD\'',
204 'yyyy-mm-dd' => 'ALTER SESSION SET NLS_DATE_FORMAT = \'YYYY-MM-DD\'',
205 'mm/dd/yy' => 'ALTER SESSION SET NLS_DATE_FORMAT = \'MM/DD/YY\'',
206 'mm-dd-yy' => 'ALTER SESSION SET NLS_DATE_FORMAT = \'MM-DD-YY\'',
207 'dd/mm/yy' => 'ALTER SESSION SET NLS_DATE_FORMAT = \'DD/MM/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\'',
212 $form->{dboptions} = $dboptions{ $form->{dbdriver} }{ $form->{dateformat} };
214 if ($form->{dbdriver} eq 'Pg') {
215 $form->{dbconnect} = "dbi:Pg:dbname=$db";
218 if ($form->{dbdriver} eq 'Oracle') {
219 $form->{dbconnect} = "dbi:Oracle:sid=$form->{sid}";
222 if ($form->{dbhost}) {
223 $form->{dbconnect} .= ";host=$form->{dbhost}";
225 if ($form->{dbport}) {
226 $form->{dbconnect} .= ";port=$form->{dbport}";
229 $main::lxdebug->leave_sub();
233 $main::lxdebug->enter_sub();
235 my @drivers = DBI->available_drivers();
237 $main::lxdebug->leave_sub();
239 return (grep { /(Pg|Oracle)/ } @drivers);
243 $main::lxdebug->enter_sub();
245 my ($self, $form) = @_;
250 $form->{dbdefault} = $form->{dbuser} unless $form->{dbdefault};
251 $form->{sid} = $form->{dbdefault};
252 &dbconnect_vars($form, $form->{dbdefault});
255 DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
258 if ($form->{dbdriver} eq 'Pg') {
260 qq|SELECT datname FROM pg_database | .
261 qq|WHERE NOT datname IN ('template0', 'template1')|;
262 $sth = $dbh->prepare($query);
263 $sth->execute() || $form->dberror($query);
265 while (my ($db) = $sth->fetchrow_array) {
267 if ($form->{only_acc_db}) {
269 next if ($db =~ /^template/);
271 &dbconnect_vars($form, $db);
273 DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
277 qq|SELECT tablename FROM pg_tables | .
278 qq|WHERE (tablename = 'defaults') AND (tableowner = ?)|;
279 my $sth = $dbh->prepare($query);
280 $sth->execute($form->{dbuser}) ||
281 $form->dberror($query . " ($form->{dbuser})");
283 if ($sth->fetchrow_array) {
284 push(@dbsources, $db);
290 push(@dbsources, $db);
294 if ($form->{dbdriver} eq 'Oracle') {
295 if ($form->{only_acc_db}) {
297 qq|SELECT owner FROM dba_objects | .
298 qq|WHERE object_name = 'DEFAULTS' AND object_type = 'TABLE'|;
300 $query = qq|SELECT username FROM dba_users|;
303 $sth = $dbh->prepare($query);
304 $sth->execute || $form->dberror($query);
306 while (my ($db) = $sth->fetchrow_array) {
307 push(@dbsources, $db);
314 $main::lxdebug->leave_sub();
319 sub dbclusterencoding {
320 $main::lxdebug->enter_sub();
322 my ($self, $form) = @_;
324 $form->{dbdefault} ||= $form->{dbuser};
326 dbconnect_vars($form, $form->{dbdefault});
328 my $dbh = DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}) || $form->dberror();
329 my $query = qq|SELECT pg_encoding_to_char(encoding) FROM pg_database WHERE datname = 'template0'|;
330 my ($cluster_encoding) = $dbh->selectrow_array($query);
333 $main::lxdebug->leave_sub();
335 return $cluster_encoding;
339 $main::lxdebug->enter_sub();
341 my ($self, $form) = @_;
343 $form->{sid} = $form->{dbdefault};
344 &dbconnect_vars($form, $form->{dbdefault});
346 DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
348 $form->{db} =~ s/\"//g;
350 'Pg' => qq|CREATE DATABASE "$form->{db}"|,
352 qq|CREATE USER "$form->{db}" DEFAULT TABLESPACE USERS | .
353 qq|TEMPORARY TABLESPACE TEMP IDENTIFIED BY "$form->{db}"|
360 push(@{$dboptions{"Pg"}}, "ENCODING = " . $dbh->quote($form->{"encoding"}))
361 if ($form->{"encoding"});
362 if ($form->{"dbdefault"}) {
363 my $dbdefault = $form->{"dbdefault"};
364 $dbdefault =~ s/[^a-zA-Z0-9_\-]//g;
365 push(@{$dboptions{"Pg"}}, "TEMPLATE = $dbdefault");
368 my $query = $dbcreate{$form->{dbdriver}};
369 $query .= " WITH " . join(" ", @{$dboptions{"Pg"}}) if (@{$dboptions{"Pg"}});
371 # Ignore errors if the database exists.
374 if ($form->{dbdriver} eq 'Oracle') {
375 $query = qq|GRANT CONNECT, RESOURCE TO "$form->{db}"|;
376 do_query($form, $dbh, $query);
380 # setup variables for the new database
381 if ($form->{dbdriver} eq 'Oracle') {
382 $form->{dbuser} = $form->{db};
383 $form->{dbpasswd} = $form->{db};
386 &dbconnect_vars($form, $form->{db});
388 $dbh = DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
391 my $db_charset = $Common::db_encoding_to_charset{$form->{encoding}};
392 $db_charset ||= Common::DEFAULT_CHARSET;
395 $self->process_query($form, $dbh, "sql/lx-office.sql", undef, $db_charset);
397 # load chart of accounts
398 $self->process_query($form, $dbh, "sql/$form->{chart}-chart.sql", undef, $db_charset);
400 $query = "UPDATE defaults SET coa = ?";
401 do_query($form, $dbh, $query, $form->{chart});
405 $main::lxdebug->leave_sub();
408 # Process a Perl script which updates the database.
409 # If the script returns 1 then the update was successful.
410 # Return code "2" means "needs more interaction; remove
411 # users/nologin and exit".
412 # All other return codes are fatal errors.
413 sub process_perl_script {
414 $main::lxdebug->enter_sub();
416 my ($self, $form, $dbh, $filename, $version_or_control, $db_charset) = @_;
418 my $fh = IO::File->new($filename, "r") or $form->error("$filename : $!\n");
420 my $file_charset = Common::DEFAULT_CHARSET;
422 if (ref($version_or_control) eq "HASH") {
423 $file_charset = $version_or_control->{charset};
428 next if !/^--\s*\@charset:\s*(.+)/;
432 $fh->seek(0, SEEK_SET);
435 my $contents = join "", <$fh>;
438 $db_charset ||= Common::DEFAULT_CHARSET;
440 my $iconv = SL::Iconv::get_converter($file_charset, $db_charset);
444 my %dbup_myconfig = ();
445 map({ $dbup_myconfig{$_} = $form->{$_}; }
446 qw(dbname dbuser dbpasswd dbhost dbport dbconnect));
448 my $nls_file = $filename;
449 $nls_file =~ s|.*/||;
450 $nls_file =~ s|.pl$||;
451 my $dbup_locale = Locale->new($main::language, $nls_file);
453 my $result = eval($contents);
460 if (!defined($result)) {
461 print $form->parse_html_template("dbupgrade/error",
462 { "file" => $filename,
465 } elsif (1 != $result) {
466 unlink("users/nologin") if (2 == $result);
470 if (ref($version_or_control) eq "HASH") {
471 $dbh->do("INSERT INTO schema_info (tag, login) VALUES (" .
472 $dbh->quote($version_or_control->{"tag"}) . ", " .
473 $dbh->quote($form->{"login"}) . ")");
474 } elsif ($version_or_control) {
475 $dbh->do("UPDATE defaults SET version = " .
476 $dbh->quote($version_or_control));
480 $main::lxdebug->leave_sub();
484 $main::lxdebug->enter_sub();
486 my ($self, $form, $dbh, $filename, $version_or_control, $db_charset) = @_;
488 my $fh = IO::File->new($filename, "r") or $form->error("$filename : $!\n");
493 my $file_charset = Common::DEFAULT_CHARSET;
496 next if !/^--\s*\@charset:\s*(.+)/;
500 $fh->seek(0, SEEK_SET);
502 $db_charset ||= Common::DEFAULT_CHARSET;
507 $_ = SL::Iconv::convert($file_charset, $db_charset, $_);
509 # Remove DOS and Unix style line endings.
515 for (my $i = 0; $i < length($_); $i++) {
516 my $char = substr($_, $i, 1);
518 # Are we inside a string?
520 if ($char eq $quote_chars[-1]) {
526 if (($char eq "'") || ($char eq "\"")) {
527 push(@quote_chars, $char);
529 } elsif ($char eq ";") {
531 # Query is complete. Send it.
533 $sth = $dbh->prepare($query);
534 if (!$sth->execute()) {
535 my $errstr = $dbh->errstr;
538 $form->dberror("The database update/creation did not succeed. " .
539 "The file ${filename} containing the following " .
540 "query failed:<br>${query}<br>" .
541 "The error message was: ${errstr}<br>" .
542 "All changes in that file have been reverted.");
555 if (ref($version_or_control) eq "HASH") {
556 $dbh->do("INSERT INTO schema_info (tag, login) VALUES (" .
557 $dbh->quote($version_or_control->{"tag"}) . ", " .
558 $dbh->quote($form->{"login"}) . ")");
559 } elsif ($version_or_control) {
560 $dbh->do("UPDATE defaults SET version = " .
561 $dbh->quote($version_or_control));
567 $main::lxdebug->leave_sub();
571 $main::lxdebug->enter_sub();
573 my ($self, $form) = @_;
574 $form->{db} =~ s/\"//g;
575 my %dbdelete = ('Pg' => qq|DROP DATABASE "$form->{db}"|,
576 'Oracle' => qq|DROP USER "$form->{db}" CASCADE|);
578 $form->{sid} = $form->{dbdefault};
579 &dbconnect_vars($form, $form->{dbdefault});
581 DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
583 my $query = $dbdelete{$form->{dbdriver}};
584 do_query($form, $dbh, $query);
588 $main::lxdebug->leave_sub();
591 sub dbsources_unused {
592 $main::lxdebug->enter_sub();
594 my ($self, $form) = @_;
596 $form->{only_acc_db} = 1;
598 my %members = $main::auth->read_all_users();
599 my %dbexcl = map { $_ => 1 } grep { $_ } map { $_->{dbname} } values %members;
601 $dbexcl{$form->{dbdefault}} = 1;
602 $dbexcl{$main::auth->{DB_config}->{db}} = 1;
604 my @dbunused = grep { !$dbexcl{$_} } dbsources("", $form);
606 $main::lxdebug->leave_sub();
612 $main::lxdebug->enter_sub();
614 my ($self, $form) = @_;
616 my %members = $main::auth->read_all_users();
617 my $controls = parse_dbupdate_controls($form, $form->{dbdriver});
619 my ($query, $sth, %dbs_needing_updates);
621 foreach my $login (grep /[a-z]/, keys %members) {
622 my $member = $members{$login};
624 map { $form->{$_} = $member->{$_} } qw(dbname dbuser dbpasswd dbhost dbport);
625 dbconnect_vars($form, $form->{dbname});
627 my $dbh = DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd});
633 $query = qq|SELECT version FROM defaults|;
634 $sth = prepare_query($form, $dbh, $query);
635 if ($sth->execute()) {
636 ($version) = $sth->fetchrow_array();
641 next unless $version;
643 if (update_available($form->{dbdriver}, $version) || update2_available($form, $controls)) {
645 map { $dbinfo->{$_} = $member->{$_} } grep /^db/, keys %{ $member };
646 $dbs_needing_updates{$member->{dbhost} . "::" . $member->{dbname}} = $dbinfo;
650 $main::lxdebug->leave_sub();
652 return values %dbs_needing_updates;
656 $main::lxdebug->enter_sub(2);
658 my (@v, $version, $i);
660 @v = split(/\./, $_[0]);
661 while (scalar(@v) < 4) {
665 for ($i = 0; $i < 4; $i++) {
670 $main::lxdebug->leave_sub(2);
674 sub cmp_script_version {
675 my ($a_from, $a_to, $b_from, $b_to);
676 my ($i, $res_a, $res_b);
677 my ($my_a, $my_b) = ($a, $b);
679 $my_a =~ s/.*-upgrade-//;
681 $my_b =~ s/.*-upgrade-//;
683 ($my_a_from, $my_a_to) = split(/-/, $my_a);
684 ($my_b_from, $my_b_to) = split(/-/, $my_b);
686 $res_a = calc_version($my_a_from);
687 $res_b = calc_version($my_b_from);
689 if ($res_a == $res_b) {
690 $res_a = calc_version($my_a_to);
691 $res_b = calc_version($my_b_to);
694 return $res_a <=> $res_b;
697 sub update_available {
698 my ($dbdriver, $cur_version) = @_;
702 opendir SQLDIR, "sql/${dbdriver}-upgrade" || error("", "sql/${dbdriver}-upgrade: $!");
703 my @upgradescripts = grep /${dbdriver}-upgrade-\Q$cur_version\E.*\.(sql|pl)$/, readdir SQLDIR;
706 return ($#upgradescripts > -1);
709 sub create_schema_info_table {
710 $main::lxdebug->enter_sub();
712 my ($self, $form, $dbh) = @_;
714 my $query = "SELECT tag FROM schema_info LIMIT 1";
715 if (!$dbh->do($query)) {
718 qq|CREATE TABLE schema_info (| .
721 qq| itime timestamp DEFAULT now(), | .
722 qq| PRIMARY KEY (tag))|;
723 $dbh->do($query) || $form->dberror($query);
726 $main::lxdebug->leave_sub();
730 $main::lxdebug->enter_sub();
732 my ($self, $form) = @_;
736 $form->{sid} = $form->{dbdefault};
738 my @upgradescripts = ();
742 if ($form->{dbupdate}) {
744 # read update scripts into memory
745 opendir(SQLDIR, "sql/" . $form->{dbdriver} . "-upgrade")
746 or &error("", "sql/" . $form->{dbdriver} . "-upgrade : $!");
748 sort(cmp_script_version
749 grep(/$form->{dbdriver}-upgrade-.*?\.(sql|pl)$/,
754 my $db_charset = $main::dbcharset;
755 $db_charset ||= Common::DEFAULT_CHARSET;
757 foreach my $db (split(/ /, $form->{dbupdate})) {
759 next unless $form->{$db};
761 # strip db from dataset
763 &dbconnect_vars($form, $db);
766 DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
769 $dbh->do($form->{dboptions}) if ($form->{dboptions});
772 $query = qq|SELECT version FROM defaults|;
773 my ($version) = selectrow_query($form, $dbh, $query);
775 next unless $version;
777 $version = calc_version($version);
779 foreach my $upgradescript (@upgradescripts) {
780 my $a = $upgradescript;
781 $a =~ s/^\Q$form->{dbdriver}\E-upgrade-|\.(sql|pl)$//g;
784 my ($mindb, $maxdb) = split /-/, $a;
785 my $str_maxdb = $maxdb;
786 $mindb = calc_version($mindb);
787 $maxdb = calc_version($maxdb);
789 next if ($version >= $maxdb);
791 # if there is no upgrade script exit
792 last if ($version < $mindb);
795 $main::lxdebug->message(LXDebug::DEBUG2, "Applying Update $upgradescript");
796 if ($file_type eq "sql") {
797 $self->process_query($form, $dbh, "sql/" . $form->{"dbdriver"} .
798 "-upgrade/$upgradescript", $str_maxdb, $db_charset);
800 $self->process_perl_script($form, $dbh, "sql/" . $form->{"dbdriver"} .
801 "-upgrade/$upgradescript", $str_maxdb, $db_charset);
813 $main::lxdebug->leave_sub();
819 $main::lxdebug->enter_sub();
821 my ($self, $form, $controls) = @_;
823 $form->{sid} = $form->{dbdefault};
825 my @upgradescripts = ();
826 my ($query, $sth, $tag);
829 @upgradescripts = sort_dbupdate_controls($controls);
831 my $db_charset = $main::dbcharset;
832 $db_charset ||= Common::DEFAULT_CHARSET;
834 foreach my $db (split / /, $form->{dbupdate}) {
836 next unless $form->{$db};
838 # strip db from dataset
840 &dbconnect_vars($form, $db);
843 DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
846 $dbh->do($form->{dboptions}) if ($form->{dboptions});
848 map({ $_->{"applied"} = 0; } @upgradescripts);
850 $self->create_schema_info_table($form, $dbh);
852 $query = qq|SELECT tag FROM schema_info|;
853 $sth = $dbh->prepare($query);
854 $sth->execute() || $form->dberror($query);
855 while (($tag) = $sth->fetchrow_array()) {
856 $controls->{$tag}->{"applied"} = 1 if (defined($controls->{$tag}));
861 foreach (@upgradescripts) {
862 if (!$_->{"applied"}) {
868 next if ($all_applied);
870 foreach my $control (@upgradescripts) {
871 next if ($control->{"applied"});
873 $control->{description} = SL::Iconv::convert($control->{charset}, $db_charset, $control->{description});
875 $control->{"file"} =~ /\.(sql|pl)$/;
879 $main::lxdebug->message(LXDebug::DEBUG2, "Applying Update $control->{file}");
880 print $form->parse_html_template("dbupgrade/upgrade_message2", $control);
882 if ($file_type eq "sql") {
883 $self->process_query($form, $dbh, "sql/" . $form->{"dbdriver"} .
884 "-upgrade2/$control->{file}", $control, $db_charset);
886 $self->process_perl_script($form, $dbh, "sql/" . $form->{"dbdriver"} .
887 "-upgrade2/$control->{file}", $control, $db_charset);
896 $main::lxdebug->leave_sub();
901 sub update2_available {
902 $main::lxdebug->enter_sub();
904 my ($form, $controls) = @_;
906 map({ $_->{"applied"} = 0; } values(%{$controls}));
908 dbconnect_vars($form, $form->{"dbname"});
911 DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}) ||
914 my ($query, $tag, $sth);
916 $query = qq|SELECT tag FROM schema_info|;
917 $sth = $dbh->prepare($query);
918 if ($sth->execute()) {
919 while (($tag) = $sth->fetchrow_array()) {
920 $controls->{$tag}->{"applied"} = 1 if (defined($controls->{$tag}));
926 map({ $main::lxdebug->leave_sub() and return 1 if (!$_->{"applied"}) }
927 values(%{$controls}));
929 $main::lxdebug->leave_sub();
934 $main::lxdebug->enter_sub();
938 # format dbconnect and dboptions string
939 dbconnect_vars($self, $self->{dbname});
941 map { $self->{$_} =~ s/\r//g; } qw(address signature);
943 $main::auth->save_user($self->{login}, map { $_, $self->{$_} } config_vars());
945 my $dbh = DBI->connect($self->{dbconnect}, $self->{dbuser}, $self->{dbpasswd});
947 $self->create_employee_entry($form, $dbh, $self);
951 $main::lxdebug->leave_sub();
954 sub create_employee_entry {
955 $main::lxdebug->enter_sub();
960 my $myconfig = shift;
962 # add login to employee table if it does not exist
963 # no error check for employee table, ignore if it does not exist
964 my ($login) = selectrow_query($form, $dbh, qq|SELECT id FROM employee WHERE login = ?|, $self->{login});
967 $query = qq|INSERT INTO employee (login, name, workphone, role) VALUES (?, ?, ?, ?)|;
968 do_query($form, $dbh, $query, ($self->{login}, $myconfig->{name}, $myconfig->{tel}, "user"));
971 $main::lxdebug->leave_sub();
975 $main::lxdebug->enter_sub();
977 my @conf = qw(acs address admin businessnumber company countrycode
978 currency dateformat dbconnect dbdriver dbhost dbport dboptions
979 dbname dbuser dbpasswd email fax name numberformat password
980 printer role sid signature stylesheet tel templates vclimit angebote
981 bestellungen rechnungen anfragen lieferantenbestellungen einkaufsrechnungen
982 taxnumber co_ustid duns menustyle template_format default_media
983 default_printer_id copies show_form_details favorites
984 pdonumber sdonumber);
986 $main::lxdebug->leave_sub();
992 $main::lxdebug->enter_sub();
994 my ($self, $msg) = @_;
996 $main::lxdebug->show_backtrace();
998 if ($ENV{HTTP_USER_AGENT}) {
999 print qq|Content-Type: text/html
1001 <!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0//EN">
1003 <body bgcolor=ffffff>
1005 <h2><font color=red>Error!</font></h2>
1010 die "Error: $msg\n";
1012 $main::lxdebug->leave_sub();