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 #=====================================================================
40 $main::lxdebug->enter_sub();
42 my ($type, $memfile, $login) = @_;
46 &error("", "$memfile locked!") if (-f "${memfile}.LCK");
48 open(MEMBER, "$memfile") or &error("", "$memfile : $!");
59 # remove any trailing whitespace
62 ($key, $value) = split(/=/, $_, 2);
64 if (($key eq "stylesheet") && ($value eq "sql-ledger.css")) {
65 $value = "lx-office-erp.css";
68 $self->{$key} = $value;
71 $self->{login} = $login;
79 $main::lxdebug->leave_sub();
84 $main::lxdebug->enter_sub();
89 # scan the locale directory and read in the LANGUAGE files
90 opendir DIR, "locale";
92 my @dir = grep !/(^\.\.?$|\..*)/, readdir DIR;
94 foreach my $dir (@dir) {
95 next unless open(FH, "locale/$dir/LANGUAGE");
99 $cc{$dir} = "@language";
104 $main::lxdebug->leave_sub();
110 $main::lxdebug->enter_sub();
112 my ($self, $form, $userspath) = @_;
116 if ($self->{login}) {
118 if ($self->{password}) {
119 if ($form->{hashed_password}) {
120 $form->{password} = $form->{hashed_password};
122 $form->{password} = crypt($form->{password},
123 substr($self->{login}, 0, 2));
125 if ($self->{password} ne $form->{password}) {
126 $main::lxdebug->leave_sub();
131 unless (-e "$userspath/$self->{login}.conf") {
132 $self->create_config("$userspath/$self->{login}.conf");
135 do "$userspath/$self->{login}.conf";
136 $myconfig{dbpasswd} = unpack 'u', $myconfig{dbpasswd};
138 # check if database is down
140 DBI->connect($myconfig{dbconnect}, $myconfig{dbuser},
142 or $self->error(DBI::errstr);
144 # we got a connection, check the version
145 my $query = qq|SELECT version FROM defaults|;
146 my $sth = $dbh->prepare($query);
147 $sth->execute || $form->dberror($query);
149 my ($dbversion) = $sth->fetchrow_array;
152 # add login to employee table if it does not exist
153 # no error check for employee table, ignore if it does not exist
154 $query = qq|SELECT e.id FROM employee e WHERE e.login = '$self->{login}'|;
155 $sth = $dbh->prepare($query);
158 my ($login) = $sth->fetchrow_array;
162 $query = qq|INSERT INTO employee (login, name, workphone, role)
163 VALUES ('$self->{login}', '$myconfig{name}',
164 '$myconfig{tel}', 'user')|;
168 $self->create_schema_info_table($form, $dbh);
175 parse_dbupdate_controls($form, $myconfig{"dbdriver"});
177 map({ $form->{$_} = $myconfig{$_} }
178 qw(dbname dbhost dbport dbdriver dbuser dbpasswd dbconnect));
180 if (update_available($myconfig{"dbdriver"}, $dbversion) ||
181 update2_available($form, $controls)) {
183 $form->{"stylesheet"} = "lx-office-erp.css";
184 $form->{"title"} = $main::locale->text("Dataset upgrade");
186 print($form->parse_html_template("dbupgrade/header"));
188 $form->{dbupdate} = "db$myconfig{dbname}";
189 $form->{ $form->{dbupdate} } = 1;
191 if ($form->{"show_dbupdate_warning"}) {
192 print($form->parse_html_template("dbupgrade/warning"));
197 open(FH, ">$userspath/nologin") or die("$!");
199 # required for Oracle
200 $form->{dbdefault} = $sid;
202 # ignore HUP, QUIT in case the webserver times out
203 $SIG{HUP} = 'IGNORE';
204 $SIG{QUIT} = 'IGNORE';
206 $self->dbupdate($form);
207 $self->dbupdate2($form, $controls);
210 unlink("$userspath/nologin");
213 $self->{"menustyle"} eq "v3" ? "menuv3.pl" :
214 $self->{"menustyle"} eq "neu" ? "menunew.pl" :
217 print($form->parse_html_template("dbupgrade/footer",
218 { "menufile" => $menufile }));
225 $main::lxdebug->leave_sub();
231 $main::lxdebug->enter_sub();
233 my ($form, $db) = @_;
236 'Pg' => { 'yy-mm-dd' => 'set DateStyle to \'ISO\'',
237 'yyyy-mm-dd' => 'set DateStyle to \'ISO\'',
238 'mm/dd/yy' => 'set DateStyle to \'SQL, US\'',
239 'mm-dd-yy' => 'set DateStyle to \'POSTGRES, US\'',
240 'dd/mm/yy' => 'set DateStyle to \'SQL, EUROPEAN\'',
241 'dd-mm-yy' => 'set DateStyle to \'POSTGRES, EUROPEAN\'',
242 'dd.mm.yy' => 'set DateStyle to \'GERMAN\''
245 'yy-mm-dd' => 'ALTER SESSION SET NLS_DATE_FORMAT = \'YY-MM-DD\'',
246 'yyyy-mm-dd' => 'ALTER SESSION SET NLS_DATE_FORMAT = \'YYYY-MM-DD\'',
247 'mm/dd/yy' => 'ALTER SESSION SET NLS_DATE_FORMAT = \'MM/DD/YY\'',
248 'mm-dd-yy' => 'ALTER SESSION SET NLS_DATE_FORMAT = \'MM-DD-YY\'',
249 'dd/mm/yy' => 'ALTER SESSION SET NLS_DATE_FORMAT = \'DD/MM/YY\'',
250 'dd-mm-yy' => 'ALTER SESSION SET NLS_DATE_FORMAT = \'DD-MM-YY\'',
251 'dd.mm.yy' => 'ALTER SESSION SET NLS_DATE_FORMAT = \'DD.MM.YY\'',
254 $form->{dboptions} = $dboptions{ $form->{dbdriver} }{ $form->{dateformat} };
256 if ($form->{dbdriver} eq 'Pg') {
257 $form->{dbconnect} = "dbi:Pg:dbname=$db";
260 if ($form->{dbdriver} eq 'Oracle') {
261 $form->{dbconnect} = "dbi:Oracle:sid=$form->{sid}";
264 if ($form->{dbhost}) {
265 $form->{dbconnect} .= ";host=$form->{dbhost}";
267 if ($form->{dbport}) {
268 $form->{dbconnect} .= ";port=$form->{dbport}";
271 $main::lxdebug->leave_sub();
275 $main::lxdebug->enter_sub();
277 my @drivers = DBI->available_drivers();
279 $main::lxdebug->leave_sub();
281 return (grep { /(Pg|Oracle)/ } @drivers);
285 $main::lxdebug->enter_sub();
287 my ($self, $form) = @_;
292 $form->{dbdefault} = $form->{dbuser} unless $form->{dbdefault};
293 $form->{sid} = $form->{dbdefault};
294 &dbconnect_vars($form, $form->{dbdefault});
297 DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
300 if ($form->{dbdriver} eq 'Pg') {
302 $query = qq|SELECT datname FROM pg_database WHERE NOT ((datname = 'template0') OR (datname = 'template1'))|;
303 $sth = $dbh->prepare($query);
304 $sth->execute || $form->dberror($query);
306 while (my ($db) = $sth->fetchrow_array) {
308 if ($form->{only_acc_db}) {
310 next if ($db =~ /^template/);
312 &dbconnect_vars($form, $db);
314 DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
317 $query = qq|SELECT p.tablename FROM pg_tables p
318 WHERE p.tablename = 'defaults'
319 AND p.tableowner = '$form->{dbuser}'|;
320 my $sth = $dbh->prepare($query);
321 $sth->execute || $form->dberror($query);
323 if ($sth->fetchrow_array) {
324 push @dbsources, $db;
330 push @dbsources, $db;
334 if ($form->{dbdriver} eq 'Oracle') {
335 if ($form->{only_acc_db}) {
336 $query = qq|SELECT o.owner FROM dba_objects o
337 WHERE o.object_name = 'DEFAULTS'
338 AND o.object_type = 'TABLE'|;
340 $query = qq|SELECT username FROM dba_users|;
343 $sth = $dbh->prepare($query);
344 $sth->execute || $form->dberror($query);
346 while (my ($db) = $sth->fetchrow_array) {
347 push @dbsources, $db;
354 $main::lxdebug->leave_sub();
360 $main::lxdebug->enter_sub();
362 my ($self, $form) = @_;
364 $form->{sid} = $form->{dbdefault};
365 &dbconnect_vars($form, $form->{dbdefault});
367 DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
371 'Pg' => qq|CREATE DATABASE "$form->{db}"|,
373 qq|CREATE USER "$form->{db}" DEFAULT TABLESPACE USERS 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 = qq|$dbcreate{$form->{dbdriver}}|;
389 $query .= " WITH " . join(" ", @{$dboptions{"Pg"}}) if (@{$dboptions{"Pg"}});
391 $dbh->do($query) || $form->dberror($query);
393 if ($form->{dbdriver} eq 'Oracle') {
394 $query = qq|GRANT CONNECT,RESOURCE TO "$form->{db}"|;
395 $dbh->do($query) || $form->dberror($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 = " . $dbh->quote($form->{"chart"});
424 $dbh->do($query) || $form->dberror($query);
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) = @_;
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);
474 $dbh->do("UPDATE defaults SET version = " . $dbh->quote($version));
478 $main::lxdebug->leave_sub();
482 $main::lxdebug->enter_sub();
484 my ($self, $form, $dbh, $filename, $version_or_control) = @_;
486 # return unless (-f $filename);
488 open(FH, "$filename") or $form->error("$filename : $!\n");
497 # Remove DOS and Unix style line endings.
503 for (my $i = 0; $i < length($_); $i++) {
504 my $char = substr($_, $i, 1);
506 # Are we inside a string?
508 if ($char eq $quote_chars[-1]) {
514 if (($char eq "'") || ($char eq "\"")) {
515 push(@quote_chars, $char);
517 } elsif ($char eq ";") {
519 # Query is complete. Send it.
521 $sth = $dbh->prepare($query);
522 if (!$sth->execute()) {
523 my $errstr = $dbh->errstr;
526 $form->dberror("The database update/creation did not succeed. The file ${filename} containing the following query failed:<br>${query}<br>" .
527 "The error message was: ${errstr}<br>" .
528 "All changes in that file have been reverted.");
541 if (ref($version_or_control) eq "HASH") {
542 $dbh->do("INSERT INTO schema_info (tag, login) VALUES (" .
543 $dbh->quote($version_or_control->{"tag"}) . ", " .
544 $dbh->quote($form->{"login"}) . ")");
545 } elsif ($version_or_control) {
546 $dbh->do("UPDATE defaults SET version = " .
547 $dbh->quote($version_or_control));
553 $main::lxdebug->leave_sub();
557 $main::lxdebug->enter_sub();
559 my ($self, $form) = @_;
561 my %dbdelete = ('Pg' => qq|DROP DATABASE "$form->{db}"|,
562 'Oracle' => qq|DROP USER $form->{db} CASCADE|);
564 $form->{sid} = $form->{dbdefault};
565 &dbconnect_vars($form, $form->{dbdefault});
567 DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
569 my $query = qq|$dbdelete{$form->{dbdriver}}|;
570 $dbh->do($query) || $form->dberror($query);
574 $main::lxdebug->leave_sub();
577 sub dbsources_unused {
578 $main::lxdebug->enter_sub();
580 my ($self, $form, $memfile) = @_;
585 $form->error('File locked!') if (-f "${memfile}.LCK");
588 open(FH, "$memfile") or $form->error("$memfile : $!");
592 my ($null, $item) = split(/=/);
599 $form->{only_acc_db} = 1;
600 my @db = &dbsources("", $form);
602 push @dbexcl, $form->{dbdefault};
604 foreach $item (@db) {
605 unless (grep /$item$/, @dbexcl) {
606 push @dbsources, $item;
610 $main::lxdebug->leave_sub();
616 $main::lxdebug->enter_sub();
618 my ($self, $form) = @_;
623 $form->{sid} = $form->{dbdefault};
624 &dbconnect_vars($form, $form->{dbdefault});
627 DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
630 if ($form->{dbdriver} eq 'Pg') {
632 $query = qq|SELECT d.datname FROM pg_database d, pg_user u
633 WHERE d.datdba = u.usesysid
634 AND u.usename = '$form->{dbuser}'|;
635 my $sth = $dbh->prepare($query);
636 $sth->execute || $form->dberror($query);
638 while (my ($db) = $sth->fetchrow_array) {
640 next if ($db =~ /^template/);
642 &dbconnect_vars($form, $db);
645 DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
648 $query = qq|SELECT t.tablename FROM pg_tables t
649 WHERE t.tablename = 'defaults'|;
650 my $sth = $dbh->prepare($query);
651 $sth->execute || $form->dberror($query);
653 if ($sth->fetchrow_array) {
654 $query = qq|SELECT version FROM defaults|;
655 my $sth = $dbh->prepare($query);
658 if (my ($version) = $sth->fetchrow_array) {
659 $dbsources{$db} = $version;
669 if ($form->{dbdriver} eq 'Oracle') {
670 $query = qq|SELECT o.owner FROM dba_objects o
671 WHERE o.object_name = 'DEFAULTS'
672 AND o.object_type = 'TABLE'|;
674 $sth = $dbh->prepare($query);
675 $sth->execute || $form->dberror($query);
677 while (my ($db) = $sth->fetchrow_array) {
679 $form->{dbuser} = $db;
680 &dbconnect_vars($form, $db);
683 DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
686 $query = qq|SELECT version FROM defaults|;
687 my $sth = $dbh->prepare($query);
690 if (my ($version) = $sth->fetchrow_array) {
691 $dbsources{$db} = $version;
701 $main::lxdebug->leave_sub();
708 $main::lxdebug->enter_sub(2);
710 my (@v, $version, $i);
712 @v = split(/\./, $_[0]);
713 while (scalar(@v) < 4) {
717 for ($i = 0; $i < 4; $i++) {
722 $main::lxdebug->leave_sub(2);
726 sub cmp_script_version {
727 my ($a_from, $a_to, $b_from, $b_to);
728 my ($i, $res_a, $res_b);
729 my ($my_a, $my_b) = ($a, $b);
731 $my_a =~ s/.*-upgrade-//;
733 $my_b =~ s/.*-upgrade-//;
735 ($my_a_from, $my_a_to) = split(/-/, $my_a);
736 ($my_b_from, $my_b_to) = split(/-/, $my_b);
738 $res_a = calc_version($my_a_from);
739 $res_b = calc_version($my_b_from);
741 if ($res_a == $res_b) {
742 $res_a = calc_version($my_a_to);
743 $res_b = calc_version($my_b_to);
746 return $res_a <=> $res_b;
750 sub update_available {
751 my ($dbdriver, $cur_version) = @_;
753 opendir SQLDIR, "sql/${dbdriver}-upgrade" or &error("", "sql/${dbdriver}-upgrade: $!");
755 grep(/$form->{dbdriver}-upgrade-\Q$cur_version\E.*\.(sql|pl)$/, readdir(SQLDIR));
758 return ($#upgradescripts > -1);
761 sub create_schema_info_table {
762 $main::lxdebug->enter_sub();
764 my ($self, $form, $dbh) = @_;
766 my $query = "SELECT tag FROM schema_info LIMIT 1";
767 if (!$dbh->do($query)) {
769 "CREATE TABLE schema_info (" .
772 " itime timestamp DEFAULT now(), " .
773 " PRIMARY KEY (tag))";
774 $dbh->do($query) || $form->dberror($query);
777 $main::lxdebug->leave_sub();
781 $main::lxdebug->enter_sub();
783 my ($self, $form) = @_;
785 $form->{sid} = $form->{dbdefault};
787 my @upgradescripts = ();
791 if ($form->{dbupdate}) {
793 # read update scripts into memory
794 opendir SQLDIR, "sql/" . $form->{dbdriver} . "-upgrade" or &error("", "sql/" . $form->{dbdriver} . "-upgrade : $!");
797 sort(cmp_script_version
798 grep(/$form->{dbdriver}-upgrade-.*?\.(sql|pl)$/, readdir(SQLDIR)));
803 foreach my $db (split / /, $form->{dbupdate}) {
805 next unless $form->{$db};
807 # strip db from dataset
809 &dbconnect_vars($form, $db);
812 DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
816 $query = qq|SELECT version FROM defaults|;
817 my $sth = $dbh->prepare($query);
819 # no error check, let it fall through
822 my $version = $sth->fetchrow_array;
825 next unless $version;
828 $version = calc_version($version);
831 foreach my $upgradescript (@upgradescripts) {
832 my $a = $upgradescript;
833 $a =~ s/^$form->{dbdriver}-upgrade-|\.(sql|pl)$//g;
836 my ($mindb, $maxdb) = split /-/, $a;
837 my $str_maxdb = $maxdb;
839 $mindb = calc_version($mindb);
840 $maxdb = calc_version($maxdb);
843 next if ($version >= $maxdb);
845 # if there is no upgrade script exit
846 last if ($version < $mindb);
849 $main::lxdebug->message(DEBUG2, "Applying Update $upgradescript");
850 if ($file_type eq "sql") {
851 $self->process_query($form, $dbh, "sql/" . $form->{"dbdriver"} . "-upgrade/$upgradescript", $str_maxdb);
853 $self->process_perl_script($form, $dbh, "sql/" . $form->{"dbdriver"} . "-upgrade/$upgradescript", $str_maxdb);
865 $main::lxdebug->leave_sub();
871 $main::lxdebug->enter_sub();
873 my ($self, $form, $controls) = @_;
875 $form->{sid} = $form->{dbdefault};
877 my @upgradescripts = ();
878 my ($query, $sth, $tag);
881 @upgradescripts = sort_dbupdate_controls($controls);
883 foreach my $db (split / /, $form->{dbupdate}) {
885 next unless $form->{$db};
887 # strip db from dataset
889 &dbconnect_vars($form, $db);
892 DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
895 map({ $_->{"applied"} = 0; } @upgradescripts);
897 $query = "SELECT tag FROM schema_info";
898 $sth = $dbh->prepare($query);
899 $sth->execute() || $form->dberror($query);
900 while (($tag) = $sth->fetchrow_array()) {
901 $controls->{$tag}->{"applied"} = 1 if (defined($controls->{$tag}));
906 foreach (@upgradescripts) {
907 if (!$_->{"applied"}) {
913 next if ($all_applied);
915 foreach my $control (@upgradescripts) {
916 next if ($control->{"applied"});
918 $control->{"file"} =~ /\.(sql|pl)$/;
922 $main::lxdebug->message(DEBUG2, "Applying Update $control->{file}");
923 print($form->parse_html_template("dbupgrade/upgrade_message2",
926 if ($file_type eq "sql") {
927 $self->process_query($form, $dbh, "sql/" . $form->{"dbdriver"} .
928 "-upgrade2/$control->{file}", $control);
930 $self->process_perl_script($form, $dbh, "sql/" . $form->{"dbdriver"} .
931 "-upgrade2/$control->{file}", $control);
940 $main::lxdebug->leave_sub();
945 sub update2_available {
946 $main::lxdebug->enter_sub();
948 my ($form, $controls) = @_;
950 map({ $_->{"applied"} = 0; } values(%{$controls}));
952 dbconnect_vars($form, $form->{"dbname"});
955 DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}) ||
958 my ($query, $tag, $sth);
960 $query = "SELECT tag FROM schema_info";
961 $sth = $dbh->prepare($query);
962 $sth->execute() || $form->dberror($query);
963 while (($tag) = $sth->fetchrow_array()) {
964 $controls->{$tag}->{"applied"} = 1 if (defined($controls->{$tag}));
969 map({ $main::lxdebug->leave_sub() and return 1 if (!$_->{"applied"}) }
970 values(%{$controls}));
972 $main::lxdebug->leave_sub();
977 $main::lxdebug->enter_sub();
979 my ($self, $filename) = @_;
981 @config = &config_vars;
983 open(CONF, ">$filename") or $self->error("$filename : $!");
985 # create the config file
986 print CONF qq|# configuration file for $self->{login}
991 foreach $key (sort @config) {
992 $self->{$key} =~ s/\'/\\\'/g;
993 print CONF qq| $key => '$self->{$key}',\n|;
996 print CONF qq|);\n\n|;
1000 $main::lxdebug->leave_sub();
1004 $main::lxdebug->enter_sub();
1006 my ($self, $memberfile, $userspath) = @_;
1010 # format dbconnect and dboptions string
1011 &dbconnect_vars($self, $self->{dbname});
1013 $self->error('File locked!') if (-f "${memberfile}.LCK");
1014 open(FH, ">${memberfile}.LCK") or $self->error("${memberfile}.LCK : $!");
1017 open(CONF, "+<$memberfile") or $self->error("$memberfile : $!");
1024 while ($line = shift @config) {
1025 if ($line =~ /^\[$self->{login}\]/) {
1032 # remove everything up to next login or EOF
1033 while ($line = shift @config) {
1034 last if ($line =~ /^\[/);
1037 # this one is either the next login or EOF
1040 while ($line = shift @config) {
1044 print CONF qq|[$self->{login}]\n|;
1046 if ((($self->{dbpasswd} ne $self->{old_dbpasswd}) || $newmember)
1048 $self->{dbpasswd} = pack 'u', $self->{dbpasswd};
1049 chop $self->{dbpasswd};
1051 if (defined($self->{new_password})) {
1052 if ($self->{new_password} ne $self->{old_password}) {
1053 $self->{password} = crypt $self->{new_password},
1054 substr($self->{login}, 0, 2)
1055 if $self->{new_password};
1058 if ($self->{password} ne $self->{old_password}) {
1059 $self->{password} = crypt $self->{password}, substr($self->{login}, 0, 2)
1060 if $self->{password};
1064 if ($self->{'root login'}) {
1065 @config = ("password");
1067 @config = &config_vars;
1070 # replace \r\n with \n
1071 map { $self->{$_} =~ s/\r\n/\\n/g } qw(address signature);
1072 foreach $key (sort @config) {
1073 print CONF qq|$key=$self->{$key}\n|;
1078 unlink "${memberfile}.LCK";
1081 $self->create_config("$userspath/$self->{login}.conf")
1082 unless $self->{'root login'};
1084 $main::lxdebug->leave_sub();
1088 $main::lxdebug->enter_sub();
1090 my @conf = qw(acs address admin businessnumber charset company countrycode
1091 currency dateformat dbconnect dbdriver dbhost dbport dboptions
1092 dbname dbuser dbpasswd email fax name numberformat password
1093 printer role sid signature stylesheet tel templates vclimit angebote bestellungen rechnungen
1094 anfragen lieferantenbestellungen einkaufsrechnungen taxnumber co_ustid duns menustyle
1095 template_format default_media default_printer_id copies show_form_details);
1097 $main::lxdebug->leave_sub();
1103 $main::lxdebug->enter_sub();
1105 my ($self, $msg) = @_;
1107 if ($ENV{HTTP_USER_AGENT}) {
1108 print qq|Content-Type: text/html
1110 <!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0//EN">
1112 <body bgcolor=ffffff>
1114 <h2><font color=red>Error!</font></h2>
1119 die "Error: $msg\n";
1121 $main::lxdebug->leave_sub();