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 #=====================================================================
41 $main::lxdebug->enter_sub();
43 my ($type, $memfile, $login) = @_;
47 &error("", "$memfile locked!") if (-f "${memfile}.LCK");
49 open(MEMBER, "$memfile") or &error("", "$memfile : $!");
60 # remove any trailing whitespace
63 ($key, $value) = split(/=/, $_, 2);
65 if (($key eq "stylesheet") && ($value eq "sql-ledger.css")) {
66 $value = "lx-office-erp.css";
69 $self->{$key} = $value;
72 $self->{login} = $login;
80 $main::lxdebug->leave_sub();
85 $main::lxdebug->enter_sub();
90 # scan the locale directory and read in the LANGUAGE files
91 opendir(DIR, "locale");
93 my @dir = grep(!/(^\.\.?$|\..*)/, readdir(DIR));
95 foreach my $dir (@dir) {
96 next unless open(FH, "locale/$dir/LANGUAGE");
100 $cc{$dir} = "@language";
105 $main::lxdebug->leave_sub();
111 $main::lxdebug->enter_sub();
113 my ($self, $form, $userspath) = @_;
117 if ($self->{login}) {
119 if ($self->{password}) {
120 if ($form->{hashed_password}) {
121 $form->{password} = $form->{hashed_password};
123 $form->{password} = crypt($form->{password},
124 substr($self->{login}, 0, 2));
126 if ($self->{password} ne $form->{password}) {
127 $main::lxdebug->leave_sub();
132 unless (-e "$userspath/$self->{login}.conf") {
133 $self->create_config("$userspath/$self->{login}.conf");
136 do "$userspath/$self->{login}.conf";
137 $myconfig{dbpasswd} = unpack('u', $myconfig{dbpasswd});
139 # check if database is down
141 DBI->connect($myconfig{dbconnect}, $myconfig{dbuser},
143 or $self->error(DBI::errstr);
145 # we got a connection, check the version
146 my $query = qq|SELECT version FROM defaults|;
147 my $sth = $dbh->prepare($query);
148 $sth->execute || $form->dberror($query);
150 my ($dbversion) = $sth->fetchrow_array;
153 # add login to employee table if it does not exist
154 # no error check for employee table, ignore if it does not exist
155 $query = qq|SELECT id FROM employee WHERE login = ?|;
156 my ($login) = selectrow_query($form, $dbh, $query, $self->{login});
159 $query = qq|INSERT INTO employee (login, name, workphone, role)| .
160 qq|VALUES (?, ?, ?, ?)|;
161 my @values = ($self->{login}, $myconfig{name}, $myconfig{tel}, "user");
162 do_query($form, $dbh, $query, @values);
165 $self->create_schema_info_table($form, $dbh);
172 parse_dbupdate_controls($form, $myconfig{"dbdriver"});
174 map({ $form->{$_} = $myconfig{$_} }
175 qw(dbname dbhost dbport dbdriver dbuser dbpasswd dbconnect));
177 if (update_available($myconfig{"dbdriver"}, $dbversion) ||
178 update2_available($form, $controls)) {
180 $form->{"stylesheet"} = "lx-office-erp.css";
181 $form->{"title"} = $main::locale->text("Dataset upgrade");
183 print($form->parse_html_template("dbupgrade/header"));
185 $form->{dbupdate} = "db$myconfig{dbname}";
186 $form->{ $form->{dbupdate} } = 1;
188 if ($form->{"show_dbupdate_warning"}) {
189 print($form->parse_html_template("dbupgrade/warning"));
194 open(FH, ">$userspath/nologin") or die("$!");
196 # required for Oracle
197 $form->{dbdefault} = $sid;
199 # ignore HUP, QUIT in case the webserver times out
200 $SIG{HUP} = 'IGNORE';
201 $SIG{QUIT} = 'IGNORE';
203 $self->dbupdate($form);
204 $self->dbupdate2($form, $controls);
207 unlink("$userspath/nologin");
210 $self->{"menustyle"} eq "v3" ? "menuv3.pl" :
211 $self->{"menustyle"} eq "neu" ? "menunew.pl" :
214 print($form->parse_html_template("dbupgrade/footer",
215 { "menufile" => $menufile }));
222 $main::lxdebug->leave_sub();
228 $main::lxdebug->enter_sub();
230 my ($form, $db) = @_;
233 'Pg' => { 'yy-mm-dd' => 'set DateStyle to \'ISO\'',
234 'yyyy-mm-dd' => 'set DateStyle to \'ISO\'',
235 'mm/dd/yy' => 'set DateStyle to \'SQL, US\'',
236 'mm-dd-yy' => 'set DateStyle to \'POSTGRES, US\'',
237 'dd/mm/yy' => 'set DateStyle to \'SQL, EUROPEAN\'',
238 'dd-mm-yy' => 'set DateStyle to \'POSTGRES, EUROPEAN\'',
239 'dd.mm.yy' => 'set DateStyle to \'GERMAN\''
242 'yy-mm-dd' => 'ALTER SESSION SET NLS_DATE_FORMAT = \'YY-MM-DD\'',
243 'yyyy-mm-dd' => 'ALTER SESSION SET NLS_DATE_FORMAT = \'YYYY-MM-DD\'',
244 'mm/dd/yy' => 'ALTER SESSION SET NLS_DATE_FORMAT = \'MM/DD/YY\'',
245 'mm-dd-yy' => 'ALTER SESSION SET NLS_DATE_FORMAT = \'MM-DD-YY\'',
246 'dd/mm/yy' => 'ALTER SESSION SET NLS_DATE_FORMAT = \'DD/MM/YY\'',
247 'dd-mm-yy' => 'ALTER SESSION SET NLS_DATE_FORMAT = \'DD-MM-YY\'',
248 'dd.mm.yy' => 'ALTER SESSION SET NLS_DATE_FORMAT = \'DD.MM.YY\'',
251 $form->{dboptions} = $dboptions{ $form->{dbdriver} }{ $form->{dateformat} };
253 if ($form->{dbdriver} eq 'Pg') {
254 $form->{dbconnect} = "dbi:Pg:dbname=$db";
257 if ($form->{dbdriver} eq 'Oracle') {
258 $form->{dbconnect} = "dbi:Oracle:sid=$form->{sid}";
261 if ($form->{dbhost}) {
262 $form->{dbconnect} .= ";host=$form->{dbhost}";
264 if ($form->{dbport}) {
265 $form->{dbconnect} .= ";port=$form->{dbport}";
268 $main::lxdebug->leave_sub();
272 $main::lxdebug->enter_sub();
274 my @drivers = DBI->available_drivers();
276 $main::lxdebug->leave_sub();
278 return (grep { /(Pg|Oracle)/ } @drivers);
282 $main::lxdebug->enter_sub();
284 my ($self, $form) = @_;
289 $form->{dbdefault} = $form->{dbuser} unless $form->{dbdefault};
290 $form->{sid} = $form->{dbdefault};
291 &dbconnect_vars($form, $form->{dbdefault});
294 DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
297 if ($form->{dbdriver} eq 'Pg') {
299 qq|SELECT datname FROM pg_database | .
300 qq|WHERE NOT datname IN ('template0', 'template1')|;
301 $sth = $dbh->prepare($query);
302 $sth->execute() || $form->dberror($query);
304 while (my ($db) = $sth->fetchrow_array) {
306 if ($form->{only_acc_db}) {
308 next if ($db =~ /^template/);
310 &dbconnect_vars($form, $db);
312 DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
316 qq|SELECT tablename FROM pg_tables | .
317 qq|WHERE (tablename = 'defaults') AND (tableowner = ?)|;
318 my $sth = $dbh->prepare($query);
319 $sth->execute($form->{dbuser}) ||
320 $form->dberror($query . " ($form->{dbuser})");
322 if ($sth->fetchrow_array) {
323 push(@dbsources, $db);
329 push(@dbsources, $db);
333 if ($form->{dbdriver} eq 'Oracle') {
334 if ($form->{only_acc_db}) {
336 qq|SELECT owner FROM dba_objects | .
337 qq|WHERE object_name = 'DEFAULTS' AND object_type = 'TABLE'|;
339 $query = qq|SELECT username FROM dba_users|;
342 $sth = $dbh->prepare($query);
343 $sth->execute || $form->dberror($query);
345 while (my ($db) = $sth->fetchrow_array) {
346 push(@dbsources, $db);
353 $main::lxdebug->leave_sub();
359 $main::lxdebug->enter_sub();
361 my ($self, $form) = @_;
363 $form->{sid} = $form->{dbdefault};
364 &dbconnect_vars($form, $form->{dbdefault});
366 DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
368 $form->{db} =~ s/\"//g;
370 'Pg' => qq|CREATE DATABASE "$form->{db}"|,
372 qq|CREATE USER "$form->{db}" DEFAULT TABLESPACE USERS | .
373 qq|TEMPORARY TABLESPACE TEMP IDENTIFIED BY "$form->{db}"|
380 push(@{$dboptions{"Pg"}}, "ENCODING = " . $dbh->quote($form->{"encoding"}))
381 if ($form->{"encoding"});
382 if ($form->{"dbdefault"}) {
383 my $dbdefault = $form->{"dbdefault"};
384 $dbdefault =~ s/[^a-zA-Z0-9_\-]//g;
385 push(@{$dboptions{"Pg"}}, "TEMPLATE = $dbdefault");
388 my $query = $dbcreate{$form->{dbdriver}};
389 $query .= " WITH " . join(" ", @{$dboptions{"Pg"}}) if (@{$dboptions{"Pg"}});
391 do_query($form, $dbh, $query);
393 if ($form->{dbdriver} eq 'Oracle') {
394 $query = qq|GRANT CONNECT, RESOURCE TO "$form->{db}"|;
395 do_query($form, $dbh, $query);
399 # setup variables for the new database
400 if ($form->{dbdriver} eq 'Oracle') {
401 $form->{dbuser} = $form->{db};
402 $form->{dbpasswd} = $form->{db};
405 &dbconnect_vars($form, $form->{db});
407 $dbh = DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
411 my $filename = qq|sql/lx-office.sql|;
412 $self->process_query($form, $dbh, $filename);
415 ($filename) = split /_/, $form->{chart};
417 $self->process_query($form, $dbh, "sql/${filename}-gifi.sql");
419 # load chart of accounts
420 $filename = qq|sql/$form->{chart}-chart.sql|;
421 $self->process_query($form, $dbh, $filename);
423 $query = "UPDATE defaults SET coa = ?";
424 do_query($form, $dbh, $query, $form->{chart});
428 $main::lxdebug->leave_sub();
431 # Process a Perl script which updates the database.
432 # If the script returns 1 then the update was successful.
433 # Return code "2" means "needs more interaction; remove
434 # users/nologin and exit".
435 # All other return codes are fatal errors.
436 sub process_perl_script {
437 $main::lxdebug->enter_sub();
439 my ($self, $form, $dbh, $filename, $version_or_control) = @_;
441 open(FH, "$filename") or $form->error("$filename : $!\n");
442 my $contents = join("", <FH>);
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) = @_;
491 open(FH, "$filename") or $form->error("$filename : $!\n");
500 # Remove DOS and Unix style line endings.
506 for (my $i = 0; $i < length($_); $i++) {
507 my $char = substr($_, $i, 1);
509 # Are we inside a string?
511 if ($char eq $quote_chars[-1]) {
517 if (($char eq "'") || ($char eq "\"")) {
518 push(@quote_chars, $char);
520 } elsif ($char eq ";") {
522 # Query is complete. Send it.
524 $sth = $dbh->prepare($query);
525 if (!$sth->execute()) {
526 my $errstr = $dbh->errstr;
529 $form->dberror("The database update/creation did not succeed. " .
530 "The file ${filename} containing the following " .
531 "query failed:<br>${query}<br>" .
532 "The error message was: ${errstr}<br>" .
533 "All changes in that file have been reverted.");
546 if (ref($version_or_control) eq "HASH") {
547 $dbh->do("INSERT INTO schema_info (tag, login) VALUES (" .
548 $dbh->quote($version_or_control->{"tag"}) . ", " .
549 $dbh->quote($form->{"login"}) . ")");
550 } elsif ($version_or_control) {
551 $dbh->do("UPDATE defaults SET version = " .
552 $dbh->quote($version_or_control));
558 $main::lxdebug->leave_sub();
562 $main::lxdebug->enter_sub();
564 my ($self, $form) = @_;
565 $form->{db} =~ s/\"//g;
566 my %dbdelete = ('Pg' => qq|DROP DATABASE "$form->{db}"|,
567 'Oracle' => qq|DROP USER "$form->{db}" CASCADE|);
569 $form->{sid} = $form->{dbdefault};
570 &dbconnect_vars($form, $form->{dbdefault});
572 DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
574 my $query = $dbdelete{$form->{dbdriver}};
575 do_query($form, $dbh, $query);
579 $main::lxdebug->leave_sub();
582 sub dbsources_unused {
583 $main::lxdebug->enter_sub();
585 my ($self, $form, $memfile) = @_;
590 $form->error('File locked!') if (-f "${memfile}.LCK");
593 open(FH, "$memfile") or $form->error("$memfile : $!");
597 my ($null, $item) = split(/=/);
604 $form->{only_acc_db} = 1;
605 my @db = &dbsources("", $form);
607 push @dbexcl, $form->{dbdefault};
609 foreach $item (@db) {
610 unless (grep /$item$/, @dbexcl) {
611 push @dbsources, $item;
615 $main::lxdebug->leave_sub();
621 $main::lxdebug->enter_sub();
623 my ($self, $form) = @_;
628 $form->{sid} = $form->{dbdefault};
629 &dbconnect_vars($form, $form->{dbdefault});
632 DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
635 if ($form->{dbdriver} eq 'Pg') {
638 qq|SELECT d.datname FROM pg_database d, pg_user u | .
639 qq|WHERE d.datdba = u.usesysid AND u.usename = ?|;
640 my $sth = prepare_execute_query($form, $dbh, $query, $form->{dbuser});
642 while (my ($db) = $sth->fetchrow_array) {
644 next if ($db =~ /^template/);
646 &dbconnect_vars($form, $db);
649 DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
653 qq|SELECT tablename FROM pg_tables | .
654 qq|WHERE tablename = 'defaults'|;
655 my $sth2 = prepare_execute_query($form, $dbh, $query);
657 if ($sth2->fetchrow_array) {
658 $query = qq|SELECT version FROM defaults|;
659 my ($version) = selectrow_query($form, $dbh2, $query);
660 $dbsources{$db} = $version;
668 if ($form->{dbdriver} eq 'Oracle') {
670 qq|SELECT owner FROM dba_objects |.
671 qq|WHERE object_name = 'DEFAULTS' AND object_type = 'TABLE'|;
673 $sth = $dbh->prepare($query);
674 $sth->execute || $form->dberror($query);
676 while (my ($db) = $sth->fetchrow_array) {
678 $form->{dbuser} = $db;
679 &dbconnect_vars($form, $db);
682 DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
685 $query = qq|SELECT version FROM defaults|;
686 my $sth = $dbh->prepare($query);
689 if (my ($version) = $sth->fetchrow_array) {
690 $dbsources{$db} = $version;
700 $main::lxdebug->leave_sub();
706 $main::lxdebug->enter_sub(2);
708 my (@v, $version, $i);
710 @v = split(/\./, $_[0]);
711 while (scalar(@v) < 4) {
715 for ($i = 0; $i < 4; $i++) {
720 $main::lxdebug->leave_sub(2);
724 sub cmp_script_version {
725 my ($a_from, $a_to, $b_from, $b_to);
726 my ($i, $res_a, $res_b);
727 my ($my_a, $my_b) = ($a, $b);
729 $my_a =~ s/.*-upgrade-//;
731 $my_b =~ s/.*-upgrade-//;
733 ($my_a_from, $my_a_to) = split(/-/, $my_a);
734 ($my_b_from, $my_b_to) = split(/-/, $my_b);
736 $res_a = calc_version($my_a_from);
737 $res_b = calc_version($my_b_from);
739 if ($res_a == $res_b) {
740 $res_a = calc_version($my_a_to);
741 $res_b = calc_version($my_b_to);
744 return $res_a <=> $res_b;
747 sub update_available {
748 my ($dbdriver, $cur_version) = @_;
750 opendir(SQLDIR, "sql/${dbdriver}-upgrade")
751 or &error("", "sql/${dbdriver}-upgrade: $!");
753 grep(/$form->{dbdriver}-upgrade-\Q$cur_version\E.*\.(sql|pl)$/,
757 return ($#upgradescripts > -1);
760 sub create_schema_info_table {
761 $main::lxdebug->enter_sub();
763 my ($self, $form, $dbh) = @_;
765 my $query = "SELECT tag FROM schema_info LIMIT 1";
766 if (!$dbh->do($query)) {
768 qq|CREATE TABLE schema_info (| .
771 qq| itime timestamp DEFAULT now(), | .
772 qq| PRIMARY KEY (tag))|;
773 $dbh->do($query) || $form->dberror($query);
776 $main::lxdebug->leave_sub();
780 $main::lxdebug->enter_sub();
782 my ($self, $form) = @_;
784 $form->{sid} = $form->{dbdefault};
786 my @upgradescripts = ();
790 if ($form->{dbupdate}) {
792 # read update scripts into memory
793 opendir(SQLDIR, "sql/" . $form->{dbdriver} . "-upgrade")
794 or &error("", "sql/" . $form->{dbdriver} . "-upgrade : $!");
796 sort(cmp_script_version
797 grep(/$form->{dbdriver}-upgrade-.*?\.(sql|pl)$/,
802 foreach my $db (split(/ /, $form->{dbupdate})) {
804 next unless $form->{$db};
806 # strip db from dataset
808 &dbconnect_vars($form, $db);
811 DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
815 $query = qq|SELECT version FROM defaults|;
816 my ($version) = selectrow_query($form, $dbh, $query);
818 next unless $version;
820 $version = calc_version($version);
822 foreach my $upgradescript (@upgradescripts) {
823 my $a = $upgradescript;
824 $a =~ s/^$form->{dbdriver}-upgrade-|\.(sql|pl)$//g;
827 my ($mindb, $maxdb) = split /-/, $a;
828 my $str_maxdb = $maxdb;
829 $mindb = calc_version($mindb);
830 $maxdb = calc_version($maxdb);
832 next if ($version >= $maxdb);
834 # if there is no upgrade script exit
835 last if ($version < $mindb);
838 $main::lxdebug->message(DEBUG2, "Applying Update $upgradescript");
839 if ($file_type eq "sql") {
840 $self->process_query($form, $dbh, "sql/" . $form->{"dbdriver"} .
841 "-upgrade/$upgradescript", $str_maxdb);
843 $self->process_perl_script($form, $dbh, "sql/" . $form->{"dbdriver"} .
844 "-upgrade/$upgradescript", $str_maxdb);
856 $main::lxdebug->leave_sub();
862 $main::lxdebug->enter_sub();
864 my ($self, $form, $controls) = @_;
866 $form->{sid} = $form->{dbdefault};
868 my @upgradescripts = ();
869 my ($query, $sth, $tag);
872 @upgradescripts = sort_dbupdate_controls($controls);
874 foreach my $db (split / /, $form->{dbupdate}) {
876 next unless $form->{$db};
878 # strip db from dataset
880 &dbconnect_vars($form, $db);
883 DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
886 map({ $_->{"applied"} = 0; } @upgradescripts);
888 $query = qq|SELECT tag FROM schema_info|;
889 $sth = $dbh->prepare($query);
890 $sth->execute() || $form->dberror($query);
891 while (($tag) = $sth->fetchrow_array()) {
892 $controls->{$tag}->{"applied"} = 1 if (defined($controls->{$tag}));
897 foreach (@upgradescripts) {
898 if (!$_->{"applied"}) {
904 next if ($all_applied);
906 foreach my $control (@upgradescripts) {
907 next if ($control->{"applied"});
909 $control->{"file"} =~ /\.(sql|pl)$/;
913 $main::lxdebug->message(DEBUG2, "Applying Update $control->{file}");
914 print($form->parse_html_template("dbupgrade/upgrade_message2",
917 if ($file_type eq "sql") {
918 $self->process_query($form, $dbh, "sql/" . $form->{"dbdriver"} .
919 "-upgrade2/$control->{file}", $control);
921 $self->process_perl_script($form, $dbh, "sql/" . $form->{"dbdriver"} .
922 "-upgrade2/$control->{file}", $control);
931 $main::lxdebug->leave_sub();
936 sub update2_available {
937 $main::lxdebug->enter_sub();
939 my ($form, $controls) = @_;
941 map({ $_->{"applied"} = 0; } values(%{$controls}));
943 dbconnect_vars($form, $form->{"dbname"});
946 DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}) ||
949 my ($query, $tag, $sth);
951 $query = qq|SELECT tag FROM schema_info|;
952 $sth = $dbh->prepare($query);
953 $sth->execute() || $form->dberror($query);
954 while (($tag) = $sth->fetchrow_array()) {
955 $controls->{$tag}->{"applied"} = 1 if (defined($controls->{$tag}));
960 map({ $main::lxdebug->leave_sub() and return 1 if (!$_->{"applied"}) }
961 values(%{$controls}));
963 $main::lxdebug->leave_sub();
968 $main::lxdebug->enter_sub();
970 my ($self, $filename) = @_;
972 @config = &config_vars;
974 open(CONF, ">$filename") or $self->error("$filename : $!");
976 # create the config file
977 print CONF qq|# configuration file for $self->{login}
982 foreach $key (sort @config) {
983 $self->{$key} =~ s/\'/\\\'/g;
984 print CONF qq| $key => '$self->{$key}',\n|;
987 print CONF qq|);\n\n|;
991 $main::lxdebug->leave_sub();
995 $main::lxdebug->enter_sub();
997 my ($self, $memberfile, $userspath) = @_;
1001 # format dbconnect and dboptions string
1002 &dbconnect_vars($self, $self->{dbname});
1004 $self->error('File locked!') if (-f "${memberfile}.LCK");
1005 open(FH, ">${memberfile}.LCK") or $self->error("${memberfile}.LCK : $!");
1008 open(CONF, "+<$memberfile") or $self->error("$memberfile : $!");
1015 while ($line = shift @config) {
1016 if ($line =~ /^\[$self->{login}\]/) {
1023 # remove everything up to next login or EOF
1024 while ($line = shift @config) {
1025 last if ($line =~ /^\[/);
1028 # this one is either the next login or EOF
1031 while ($line = shift @config) {
1035 print CONF qq|[$self->{login}]\n|;
1037 if ((($self->{dbpasswd} ne $self->{old_dbpasswd}) || $newmember)
1039 $self->{dbpasswd} = pack 'u', $self->{dbpasswd};
1040 chop $self->{dbpasswd};
1042 if (defined($self->{new_password})) {
1043 if ($self->{new_password} ne $self->{old_password}) {
1044 $self->{password} = crypt $self->{new_password},
1045 substr($self->{login}, 0, 2)
1046 if $self->{new_password};
1049 if ($self->{password} ne $self->{old_password}) {
1050 $self->{password} = crypt $self->{password}, substr($self->{login}, 0, 2)
1051 if $self->{password};
1055 if ($self->{'root login'}) {
1056 @config = ("password");
1058 @config = &config_vars;
1061 # replace \r\n with \n
1062 map { $self->{$_} =~ s/\r\n/\\n/g } qw(address signature);
1063 foreach $key (sort @config) {
1064 print CONF qq|$key=$self->{$key}\n|;
1069 unlink "${memberfile}.LCK";
1072 $self->create_config("$userspath/$self->{login}.conf")
1073 unless $self->{'root login'};
1075 $main::lxdebug->leave_sub();
1079 $main::lxdebug->enter_sub();
1081 my @conf = qw(acs address admin businessnumber charset company countrycode
1082 currency dateformat dbconnect dbdriver dbhost dbport dboptions
1083 dbname dbuser dbpasswd email fax name numberformat password
1084 printer role sid signature stylesheet tel templates vclimit angebote
1085 bestellungen rechnungen anfragen lieferantenbestellungen einkaufsrechnungen
1086 taxnumber co_ustid duns menustyle template_format default_media
1087 default_printer_id copies show_form_details);
1089 $main::lxdebug->leave_sub();
1095 $main::lxdebug->enter_sub();
1097 my ($self, $msg) = @_;
1099 if ($ENV{HTTP_USER_AGENT}) {
1100 print qq|Content-Type: text/html
1102 <!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0//EN">
1104 <body bgcolor=ffffff>
1106 <h2><font color=red>Error!</font></h2>
1111 die "Error: $msg\n";
1113 $main::lxdebug->leave_sub();