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.");
557 # Insert a space at the end of each line so that queries split
558 # over multiple lines work properly.
560 $query .= @quote_chars ? "\n" : ' ';
564 if (ref($version_or_control) eq "HASH") {
565 $dbh->do("INSERT INTO schema_info (tag, login) VALUES (" .
566 $dbh->quote($version_or_control->{"tag"}) . ", " .
567 $dbh->quote($form->{"login"}) . ")");
568 } elsif ($version_or_control) {
569 $dbh->do("UPDATE defaults SET version = " .
570 $dbh->quote($version_or_control));
576 $main::lxdebug->leave_sub();
580 $main::lxdebug->enter_sub();
582 my ($self, $form) = @_;
583 $form->{db} =~ s/\"//g;
584 my %dbdelete = ('Pg' => qq|DROP DATABASE "$form->{db}"|,
585 'Oracle' => qq|DROP USER "$form->{db}" CASCADE|);
587 $form->{sid} = $form->{dbdefault};
588 &dbconnect_vars($form, $form->{dbdefault});
590 DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
592 my $query = $dbdelete{$form->{dbdriver}};
593 do_query($form, $dbh, $query);
597 $main::lxdebug->leave_sub();
600 sub dbsources_unused {
601 $main::lxdebug->enter_sub();
603 my ($self, $form) = @_;
605 $form->{only_acc_db} = 1;
607 my %members = $main::auth->read_all_users();
608 my %dbexcl = map { $_ => 1 } grep { $_ } map { $_->{dbname} } values %members;
610 $dbexcl{$form->{dbdefault}} = 1;
611 $dbexcl{$main::auth->{DB_config}->{db}} = 1;
613 my @dbunused = grep { !$dbexcl{$_} } dbsources("", $form);
615 $main::lxdebug->leave_sub();
621 $main::lxdebug->enter_sub();
623 my ($self, $form) = @_;
625 my %members = $main::auth->read_all_users();
626 my $controls = parse_dbupdate_controls($form, $form->{dbdriver});
628 my ($query, $sth, %dbs_needing_updates);
630 foreach my $login (grep /[a-z]/, keys %members) {
631 my $member = $members{$login};
633 map { $form->{$_} = $member->{$_} } qw(dbname dbuser dbpasswd dbhost dbport);
634 dbconnect_vars($form, $form->{dbname});
636 my $dbh = DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd});
642 $query = qq|SELECT version FROM defaults|;
643 $sth = prepare_query($form, $dbh, $query);
644 if ($sth->execute()) {
645 ($version) = $sth->fetchrow_array();
650 next unless $version;
652 if (update_available($form->{dbdriver}, $version) || update2_available($form, $controls)) {
654 map { $dbinfo->{$_} = $member->{$_} } grep /^db/, keys %{ $member };
655 $dbs_needing_updates{$member->{dbhost} . "::" . $member->{dbname}} = $dbinfo;
659 $main::lxdebug->leave_sub();
661 return values %dbs_needing_updates;
665 $main::lxdebug->enter_sub(2);
667 my (@v, $version, $i);
669 @v = split(/\./, $_[0]);
670 while (scalar(@v) < 4) {
674 for ($i = 0; $i < 4; $i++) {
679 $main::lxdebug->leave_sub(2);
683 sub cmp_script_version {
684 my ($a_from, $a_to, $b_from, $b_to);
685 my ($i, $res_a, $res_b);
686 my ($my_a, $my_b) = ($a, $b);
688 $my_a =~ s/.*-upgrade-//;
690 $my_b =~ s/.*-upgrade-//;
692 my ($my_a_from, $my_a_to) = split(/-/, $my_a);
693 my ($my_b_from, $my_b_to) = split(/-/, $my_b);
695 $res_a = calc_version($my_a_from);
696 $res_b = calc_version($my_b_from);
698 if ($res_a == $res_b) {
699 $res_a = calc_version($my_a_to);
700 $res_b = calc_version($my_b_to);
703 return $res_a <=> $res_b;
706 sub update_available {
707 my ($dbdriver, $cur_version) = @_;
711 opendir SQLDIR, "sql/${dbdriver}-upgrade" || error("", "sql/${dbdriver}-upgrade: $!");
712 my @upgradescripts = grep /${dbdriver}-upgrade-\Q$cur_version\E.*\.(sql|pl)$/, readdir SQLDIR;
715 return ($#upgradescripts > -1);
718 sub create_schema_info_table {
719 $main::lxdebug->enter_sub();
721 my ($self, $form, $dbh) = @_;
723 my $query = "SELECT tag FROM schema_info LIMIT 1";
724 if (!$dbh->do($query)) {
727 qq|CREATE TABLE schema_info (| .
730 qq| itime timestamp DEFAULT now(), | .
731 qq| PRIMARY KEY (tag))|;
732 $dbh->do($query) || $form->dberror($query);
735 $main::lxdebug->leave_sub();
739 $main::lxdebug->enter_sub();
741 my ($self, $form) = @_;
745 $form->{sid} = $form->{dbdefault};
747 my @upgradescripts = ();
751 if ($form->{dbupdate}) {
753 # read update scripts into memory
754 opendir(SQLDIR, "sql/" . $form->{dbdriver} . "-upgrade")
755 or &error("", "sql/" . $form->{dbdriver} . "-upgrade : $!");
757 sort(cmp_script_version
758 grep(/$form->{dbdriver}-upgrade-.*?\.(sql|pl)$/,
763 my $db_charset = $main::dbcharset;
764 $db_charset ||= Common::DEFAULT_CHARSET;
766 foreach my $db (split(/ /, $form->{dbupdate})) {
768 next unless $form->{$db};
770 # strip db from dataset
772 &dbconnect_vars($form, $db);
775 DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
778 $dbh->do($form->{dboptions}) if ($form->{dboptions});
781 $query = qq|SELECT version FROM defaults|;
782 my ($version) = selectrow_query($form, $dbh, $query);
784 next unless $version;
786 $version = calc_version($version);
788 foreach my $upgradescript (@upgradescripts) {
789 my $a = $upgradescript;
790 $a =~ s/^\Q$form->{dbdriver}\E-upgrade-|\.(sql|pl)$//g;
793 my ($mindb, $maxdb) = split /-/, $a;
794 my $str_maxdb = $maxdb;
795 $mindb = calc_version($mindb);
796 $maxdb = calc_version($maxdb);
798 next if ($version >= $maxdb);
800 # if there is no upgrade script exit
801 last if ($version < $mindb);
804 $main::lxdebug->message(LXDebug::DEBUG2, "Applying Update $upgradescript");
805 if ($file_type eq "sql") {
806 $self->process_query($form, $dbh, "sql/" . $form->{"dbdriver"} .
807 "-upgrade/$upgradescript", $str_maxdb, $db_charset);
809 $self->process_perl_script($form, $dbh, "sql/" . $form->{"dbdriver"} .
810 "-upgrade/$upgradescript", $str_maxdb, $db_charset);
822 $main::lxdebug->leave_sub();
828 $main::lxdebug->enter_sub();
830 my ($self, $form, $controls) = @_;
832 $form->{sid} = $form->{dbdefault};
834 my @upgradescripts = ();
835 my ($query, $sth, $tag);
838 @upgradescripts = sort_dbupdate_controls($controls);
840 my $db_charset = $main::dbcharset;
841 $db_charset ||= Common::DEFAULT_CHARSET;
843 foreach my $db (split / /, $form->{dbupdate}) {
845 next unless $form->{$db};
847 # strip db from dataset
849 &dbconnect_vars($form, $db);
852 DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
855 $dbh->do($form->{dboptions}) if ($form->{dboptions});
857 map({ $_->{"applied"} = 0; } @upgradescripts);
859 $self->create_schema_info_table($form, $dbh);
861 $query = qq|SELECT tag FROM schema_info|;
862 $sth = $dbh->prepare($query);
863 $sth->execute() || $form->dberror($query);
864 while (($tag) = $sth->fetchrow_array()) {
865 $controls->{$tag}->{"applied"} = 1 if (defined($controls->{$tag}));
870 foreach (@upgradescripts) {
871 if (!$_->{"applied"}) {
877 next if ($all_applied);
879 foreach my $control (@upgradescripts) {
880 next if ($control->{"applied"});
882 $control->{description} = SL::Iconv::convert($control->{charset}, $db_charset, $control->{description});
884 $control->{"file"} =~ /\.(sql|pl)$/;
888 $main::lxdebug->message(LXDebug::DEBUG2, "Applying Update $control->{file}");
889 print $form->parse_html_template("dbupgrade/upgrade_message2", $control);
891 if ($file_type eq "sql") {
892 $self->process_query($form, $dbh, "sql/" . $form->{"dbdriver"} .
893 "-upgrade2/$control->{file}", $control, $db_charset);
895 $self->process_perl_script($form, $dbh, "sql/" . $form->{"dbdriver"} .
896 "-upgrade2/$control->{file}", $control, $db_charset);
905 $main::lxdebug->leave_sub();
910 sub update2_available {
911 $main::lxdebug->enter_sub();
913 my ($form, $controls) = @_;
915 map({ $_->{"applied"} = 0; } values(%{$controls}));
917 dbconnect_vars($form, $form->{"dbname"});
920 DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}) ||
923 my ($query, $tag, $sth);
925 $query = qq|SELECT tag FROM schema_info|;
926 $sth = $dbh->prepare($query);
927 if ($sth->execute()) {
928 while (($tag) = $sth->fetchrow_array()) {
929 $controls->{$tag}->{"applied"} = 1 if (defined($controls->{$tag}));
935 map({ $main::lxdebug->leave_sub() and return 1 if (!$_->{"applied"}) }
936 values(%{$controls}));
938 $main::lxdebug->leave_sub();
943 $main::lxdebug->enter_sub();
946 my $form = \%main::form;
948 # format dbconnect and dboptions string
949 dbconnect_vars($self, $self->{dbname});
951 map { $self->{$_} =~ s/\r//g; } qw(address signature);
953 $main::auth->save_user($self->{login}, map { $_, $self->{$_} } config_vars());
955 my $dbh = DBI->connect($self->{dbconnect}, $self->{dbuser}, $self->{dbpasswd});
957 $self->create_employee_entry($form, $dbh, $self);
961 $main::lxdebug->leave_sub();
964 sub create_employee_entry {
965 $main::lxdebug->enter_sub();
970 my $myconfig = shift;
972 # add login to employee table if it does not exist
973 # no error check for employee table, ignore if it does not exist
974 my ($login) = selectrow_query($form, $dbh, qq|SELECT id FROM employee WHERE login = ?|, $self->{login});
977 my $query = qq|INSERT INTO employee (login, name, workphone, role) VALUES (?, ?, ?, ?)|;
978 do_query($form, $dbh, $query, ($self->{login}, $myconfig->{name}, $myconfig->{tel}, "user"));
981 $main::lxdebug->leave_sub();
985 $main::lxdebug->enter_sub();
987 my @conf = qw(address admin businessnumber company countrycode
988 currency dateformat dbconnect dbdriver dbhost dbport dboptions
989 dbname dbuser dbpasswd email fax name numberformat password
990 printer role sid signature stylesheet tel templates vclimit angebote
991 bestellungen rechnungen anfragen lieferantenbestellungen einkaufsrechnungen
992 taxnumber co_ustid duns menustyle template_format default_media
993 default_printer_id copies show_form_details favorites
994 pdonumber sdonumber);
996 $main::lxdebug->leave_sub();
1002 $main::lxdebug->enter_sub();
1004 my ($self, $msg) = @_;
1006 $main::lxdebug->show_backtrace();
1008 if ($ENV{HTTP_USER_AGENT}) {
1009 print qq|Content-Type: text/html
1011 <!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0//EN">
1013 <body bgcolor=ffffff>
1015 <h2><font color=red>Error!</font></h2>
1020 die "Error: $msg\n";
1022 $main::lxdebug->leave_sub();