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 in_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();