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 exit".
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 $nls_file = $filename;
454 $nls_file =~ s|.*/||;
455 $nls_file =~ s|.pl$||;
456 my $dbup_locale = Locale->new($main::language, $nls_file);
458 my $result = eval($contents);
465 if (!defined($result)) {
466 print $form->parse_html_template("dbupgrade/error",
467 { "file" => $filename,
470 } elsif (1 != $result) {
471 unlink("users/nologin") if (2 == $result);
475 if (ref($version_or_control) eq "HASH") {
476 $dbh->do("INSERT INTO schema_info (tag, login) VALUES (" .
477 $dbh->quote($version_or_control->{"tag"}) . ", " .
478 $dbh->quote($form->{"login"}) . ")");
479 } elsif ($version_or_control) {
480 $dbh->do("UPDATE defaults SET version = " .
481 $dbh->quote($version_or_control));
485 $main::lxdebug->leave_sub();
489 $main::lxdebug->enter_sub();
491 my ($self, $form, $dbh, $filename, $version_or_control, $db_charset) = @_;
493 my $fh = IO::File->new($filename, "r") or $form->error("$filename : $!\n");
498 my $file_charset = Common::DEFAULT_CHARSET;
501 next if !/^--\s*\@charset:\s*(.+)/;
505 $fh->seek(0, SEEK_SET);
507 $db_charset ||= Common::DEFAULT_CHARSET;
512 $_ = SL::Iconv::convert($file_charset, $db_charset, $_);
514 # Remove DOS and Unix style line endings.
520 for (my $i = 0; $i < length($_); $i++) {
521 my $char = substr($_, $i, 1);
523 # Are we inside a string?
525 if ($char eq $quote_chars[-1]) {
531 if (($char eq "'") || ($char eq "\"")) {
532 push(@quote_chars, $char);
534 } elsif ($char eq ";") {
536 # Query is complete. Send it.
538 $sth = $dbh->prepare($query);
539 if (!$sth->execute()) {
540 my $errstr = $dbh->errstr;
543 $form->dberror("The database update/creation did not succeed. " .
544 "The file ${filename} containing the following " .
545 "query failed:<br>${query}<br>" .
546 "The error message was: ${errstr}<br>" .
547 "All changes in that file have been reverted.");
559 # Insert a space at the end of each line so that queries split
560 # over multiple lines work properly.
562 $query .= @quote_chars ? "\n" : ' ';
566 if (ref($version_or_control) eq "HASH") {
567 $dbh->do("INSERT INTO schema_info (tag, login) VALUES (" .
568 $dbh->quote($version_or_control->{"tag"}) . ", " .
569 $dbh->quote($form->{"login"}) . ")");
570 } elsif ($version_or_control) {
571 $dbh->do("UPDATE defaults SET version = " .
572 $dbh->quote($version_or_control));
578 $main::lxdebug->leave_sub();
582 $main::lxdebug->enter_sub();
584 my ($self, $form) = @_;
585 $form->{db} =~ s/\"//g;
586 my %dbdelete = ('Pg' => qq|DROP DATABASE "$form->{db}"|,
587 'Oracle' => qq|DROP USER "$form->{db}" CASCADE|);
589 $form->{sid} = $form->{dbdefault};
590 &dbconnect_vars($form, $form->{dbdefault});
592 DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
594 my $query = $dbdelete{$form->{dbdriver}};
595 do_query($form, $dbh, $query);
599 $main::lxdebug->leave_sub();
602 sub dbsources_unused {
603 $main::lxdebug->enter_sub();
605 my ($self, $form) = @_;
607 $form->{only_acc_db} = 1;
609 my %members = $main::auth->read_all_users();
610 my %dbexcl = map { $_ => 1 } grep { $_ } map { $_->{dbname} } values %members;
612 $dbexcl{$form->{dbdefault}} = 1;
613 $dbexcl{$main::auth->{DB_config}->{db}} = 1;
615 my @dbunused = grep { !$dbexcl{$_} } dbsources("", $form);
617 $main::lxdebug->leave_sub();
623 $main::lxdebug->enter_sub();
625 my ($self, $form) = @_;
627 my %members = $main::auth->read_all_users();
628 my $controls = parse_dbupdate_controls($form, $form->{dbdriver});
630 my ($query, $sth, %dbs_needing_updates);
632 foreach my $login (grep /[a-z]/, keys %members) {
633 my $member = $members{$login};
635 map { $form->{$_} = $member->{$_} } qw(dbname dbuser dbpasswd dbhost dbport);
636 dbconnect_vars($form, $form->{dbname});
638 my $dbh = DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd});
644 $query = qq|SELECT version FROM defaults|;
645 $sth = prepare_query($form, $dbh, $query);
646 if ($sth->execute()) {
647 ($version) = $sth->fetchrow_array();
652 next unless $version;
654 if (update_available($form->{dbdriver}, $version) || update2_available($form, $controls)) {
656 map { $dbinfo->{$_} = $member->{$_} } grep /^db/, keys %{ $member };
657 $dbs_needing_updates{$member->{dbhost} . "::" . $member->{dbname}} = $dbinfo;
661 $main::lxdebug->leave_sub();
663 return values %dbs_needing_updates;
667 $main::lxdebug->enter_sub(2);
669 my (@v, $version, $i);
671 @v = split(/\./, $_[0]);
672 while (scalar(@v) < 4) {
676 for ($i = 0; $i < 4; $i++) {
681 $main::lxdebug->leave_sub(2);
685 sub cmp_script_version {
686 my ($a_from, $a_to, $b_from, $b_to);
687 my ($i, $res_a, $res_b);
688 my ($my_a, $my_b) = ($a, $b);
690 $my_a =~ s/.*-upgrade-//;
692 $my_b =~ s/.*-upgrade-//;
694 my ($my_a_from, $my_a_to) = split(/-/, $my_a);
695 my ($my_b_from, $my_b_to) = split(/-/, $my_b);
697 $res_a = calc_version($my_a_from);
698 $res_b = calc_version($my_b_from);
700 if ($res_a == $res_b) {
701 $res_a = calc_version($my_a_to);
702 $res_b = calc_version($my_b_to);
705 return $res_a <=> $res_b;
708 sub update_available {
709 my ($dbdriver, $cur_version) = @_;
713 opendir SQLDIR, "sql/${dbdriver}-upgrade" || error("", "sql/${dbdriver}-upgrade: $!");
714 my @upgradescripts = grep /${dbdriver}-upgrade-\Q$cur_version\E.*\.(sql|pl)$/, readdir SQLDIR;
717 return ($#upgradescripts > -1);
720 sub create_schema_info_table {
721 $main::lxdebug->enter_sub();
723 my ($self, $form, $dbh) = @_;
725 my $query = "SELECT tag FROM schema_info LIMIT 1";
726 if (!$dbh->do($query)) {
729 qq|CREATE TABLE schema_info (| .
732 qq| itime timestamp DEFAULT now(), | .
733 qq| PRIMARY KEY (tag))|;
734 $dbh->do($query) || $form->dberror($query);
737 $main::lxdebug->leave_sub();
741 $main::lxdebug->enter_sub();
743 my ($self, $form) = @_;
747 $form->{sid} = $form->{dbdefault};
749 my @upgradescripts = ();
753 if ($form->{dbupdate}) {
755 # read update scripts into memory
756 opendir(SQLDIR, "sql/" . $form->{dbdriver} . "-upgrade")
757 or &error("", "sql/" . $form->{dbdriver} . "-upgrade : $!");
759 sort(cmp_script_version
760 grep(/$form->{dbdriver}-upgrade-.*?\.(sql|pl)$/,
765 my $db_charset = $main::dbcharset;
766 $db_charset ||= Common::DEFAULT_CHARSET;
768 foreach my $db (split(/ /, $form->{dbupdate})) {
770 next unless $form->{$db};
772 # strip db from dataset
774 &dbconnect_vars($form, $db);
777 DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
780 $dbh->do($form->{dboptions}) if ($form->{dboptions});
783 $query = qq|SELECT version FROM defaults|;
784 my ($version) = selectrow_query($form, $dbh, $query);
786 next unless $version;
788 $version = calc_version($version);
790 foreach my $upgradescript (@upgradescripts) {
791 my $a = $upgradescript;
792 $a =~ s/^\Q$form->{dbdriver}\E-upgrade-|\.(sql|pl)$//g;
795 my ($mindb, $maxdb) = split /-/, $a;
796 my $str_maxdb = $maxdb;
797 $mindb = calc_version($mindb);
798 $maxdb = calc_version($maxdb);
800 next if ($version >= $maxdb);
802 # if there is no upgrade script exit
803 last if ($version < $mindb);
806 $main::lxdebug->message(LXDebug->DEBUG2(), "Applying Update $upgradescript");
807 if ($file_type eq "sql") {
808 $self->process_query($form, $dbh, "sql/" . $form->{"dbdriver"} .
809 "-upgrade/$upgradescript", $str_maxdb, $db_charset);
811 $self->process_perl_script($form, $dbh, "sql/" . $form->{"dbdriver"} .
812 "-upgrade/$upgradescript", $str_maxdb, $db_charset);
824 $main::lxdebug->leave_sub();
830 $main::lxdebug->enter_sub();
832 my ($self, $form, $controls) = @_;
834 $form->{sid} = $form->{dbdefault};
836 my @upgradescripts = ();
837 my ($query, $sth, $tag);
840 @upgradescripts = sort_dbupdate_controls($controls);
842 my $db_charset = $main::dbcharset;
843 $db_charset ||= Common::DEFAULT_CHARSET;
845 foreach my $db (split / /, $form->{dbupdate}) {
847 next unless $form->{$db};
849 # strip db from dataset
851 &dbconnect_vars($form, $db);
854 DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
857 $dbh->do($form->{dboptions}) if ($form->{dboptions});
859 map({ $_->{"applied"} = 0; } @upgradescripts);
861 $self->create_schema_info_table($form, $dbh);
863 $query = qq|SELECT tag FROM schema_info|;
864 $sth = $dbh->prepare($query);
865 $sth->execute() || $form->dberror($query);
866 while (($tag) = $sth->fetchrow_array()) {
867 $controls->{$tag}->{"applied"} = 1 if (defined($controls->{$tag}));
872 foreach (@upgradescripts) {
873 if (!$_->{"applied"}) {
879 next if ($all_applied);
881 foreach my $control (@upgradescripts) {
882 next if ($control->{"applied"});
884 $control->{description} = SL::Iconv::convert($control->{charset}, $db_charset, $control->{description});
886 $control->{"file"} =~ /\.(sql|pl)$/;
890 $main::lxdebug->message(LXDebug->DEBUG2(), "Applying Update $control->{file}");
891 print $form->parse_html_template("dbupgrade/upgrade_message2", $control);
893 if ($file_type eq "sql") {
894 $self->process_query($form, $dbh, "sql/" . $form->{"dbdriver"} .
895 "-upgrade2/$control->{file}", $control, $db_charset);
897 $self->process_perl_script($form, $dbh, "sql/" . $form->{"dbdriver"} .
898 "-upgrade2/$control->{file}", $control, $db_charset);
907 $main::lxdebug->leave_sub();
912 sub update2_available {
913 $main::lxdebug->enter_sub();
915 my ($form, $controls) = @_;
917 map({ $_->{"applied"} = 0; } values(%{$controls}));
919 dbconnect_vars($form, $form->{"dbname"});
922 DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}) ||
925 my ($query, $tag, $sth);
927 $query = qq|SELECT tag FROM schema_info|;
928 $sth = $dbh->prepare($query);
929 if ($sth->execute()) {
930 while (($tag) = $sth->fetchrow_array()) {
931 $controls->{$tag}->{"applied"} = 1 if (defined($controls->{$tag}));
937 map({ $main::lxdebug->leave_sub() and return 1 if (!$_->{"applied"}) }
938 values(%{$controls}));
940 $main::lxdebug->leave_sub();
945 $main::lxdebug->enter_sub();
948 my $form = \%main::form;
950 # format dbconnect and dboptions string
951 dbconnect_vars($self, $self->{dbname});
953 map { $self->{$_} =~ s/\r//g; } qw(address signature);
955 $main::auth->save_user($self->{login}, map { $_, $self->{$_} } config_vars());
957 my $dbh = DBI->connect($self->{dbconnect}, $self->{dbuser}, $self->{dbpasswd});
959 $self->create_employee_entry($form, $dbh, $self, 1);
963 $main::lxdebug->leave_sub();
966 sub create_employee_entry {
967 $main::lxdebug->enter_sub();
972 my $myconfig = shift;
973 my $update_existing = shift;
975 if (!does_table_exist($dbh, 'employee')) {
976 $main::lxdebug->leave_sub();
980 # add login to employee table if it does not exist
981 # no error check for employee table, ignore if it does not exist
982 my ($id) = selectrow_query($form, $dbh, qq|SELECT id FROM employee WHERE login = ?|, $self->{login});
985 my $query = qq|INSERT INTO employee (login, name, workphone, role) VALUES (?, ?, ?, ?)|;
986 do_query($form, $dbh, $query, ($self->{login}, $myconfig->{name}, $myconfig->{tel}, "user"));
988 } elsif ($update_existing) {
989 my $query = qq|UPDATE employee SET name = ?, workphone = ?, role = 'user' WHERE id = ?|;
990 do_query($form, $dbh, $query, $myconfig->{name}, $myconfig->{tel}, $id);
993 $main::lxdebug->leave_sub();
997 $main::lxdebug->enter_sub();
999 my @conf = qw(address admin businessnumber company countrycode
1000 currency dateformat dbconnect dbdriver dbhost dbport dboptions
1001 dbname dbuser dbpasswd email fax name numberformat password
1002 printer role sid signature stylesheet tel templates vclimit angebote
1003 bestellungen rechnungen anfragen lieferantenbestellungen einkaufsrechnungen
1004 taxnumber co_ustid duns menustyle template_format default_media
1005 default_printer_id copies show_form_details favorites
1006 pdonumber sdonumber hide_cvar_search_options);
1008 $main::lxdebug->leave_sub();
1014 $main::lxdebug->enter_sub();
1016 my ($self, $msg) = @_;
1018 $main::lxdebug->show_backtrace();
1020 if ($ENV{HTTP_USER_AGENT}) {
1021 print qq|Content-Type: text/html
1023 <!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0//EN">
1025 <body bgcolor=ffffff>
1027 <h2><font color=red>Error!</font></h2>
1032 die "Error: $msg\n";
1034 $main::lxdebug->leave_sub();