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 #=====================================================================
46 $main::lxdebug->enter_sub();
48 my ($type, $memfile, $login) = @_;
56 &error("", "$memfile locked!") if (-f "${memfile}.LCK");
58 open(MEMBER, "$memfile") or &error("", "$memfile : $!");
69 # remove any trailing whitespace
72 ($key, $value) = split(/=/, $_, 2);
74 if (($key eq "stylesheet") && ($value eq "sql-ledger.css")) {
75 $value = "lx-office-erp.css";
78 $self->{$key} = $value;
81 $self->{login} = $login;
89 $main::lxdebug->leave_sub();
94 $main::lxdebug->enter_sub();
101 # scan the locale directory and read in the LANGUAGE files
102 opendir(DIR, "locale");
104 my @dir = grep(!/(^\.\.?$|\..*)/, readdir(DIR));
106 foreach my $dir (@dir) {
107 next unless open(FH, "locale/$dir/LANGUAGE");
111 $cc{$dir} = "@language";
116 $main::lxdebug->leave_sub();
122 $main::lxdebug->enter_sub();
124 my ($self, $form, $userspath) = @_;
130 if ($self->{login}) {
132 if ($self->{password}) {
133 if ($form->{hashed_password}) {
134 $form->{password} = $form->{hashed_password};
136 $form->{password} = crypt($form->{password},
137 substr($self->{login}, 0, 2));
139 if ($self->{password} ne $form->{password}) {
140 $main::lxdebug->leave_sub();
145 unless (-e "$userspath/$self->{login}.conf") {
146 $self->create_config();
149 do "$userspath/$self->{login}.conf";
150 $myconfig{dbpasswd} = unpack('u', $myconfig{dbpasswd});
152 # check if database is down
154 DBI->connect($myconfig{dbconnect}, $myconfig{dbuser},
156 or $self->error(DBI::errstr);
158 # we got a connection, check the version
159 my $query = qq|SELECT version FROM defaults|;
160 my $sth = $dbh->prepare($query);
161 $sth->execute || $form->dberror($query);
163 my ($dbversion) = $sth->fetchrow_array;
166 # add login to employee table if it does not exist
167 # no error check for employee table, ignore if it does not exist
168 $query = qq|SELECT id FROM employee WHERE login = ?|;
169 my ($login) = selectrow_query($form, $dbh, $query, $self->{login});
172 $query = qq|INSERT INTO employee (login, name, workphone, role)| .
173 qq|VALUES (?, ?, ?, ?)|;
174 my @values = ($self->{login}, $myconfig{name}, $myconfig{tel}, "user");
175 do_query($form, $dbh, $query, @values);
178 $self->create_schema_info_table($form, $dbh);
185 parse_dbupdate_controls($form, $myconfig{"dbdriver"});
187 map({ $form->{$_} = $myconfig{$_} }
188 qw(dbname dbhost dbport dbdriver dbuser dbpasswd dbconnect));
190 if (update_available($myconfig{"dbdriver"}, $dbversion) ||
191 update2_available($form, $controls)) {
193 $form->{"stylesheet"} = "lx-office-erp.css";
194 $form->{"title"} = $main::locale->text("Dataset upgrade");
196 print($form->parse_html_template2("dbupgrade/header"));
198 $form->{dbupdate} = "db$myconfig{dbname}";
199 $form->{ $form->{dbupdate} } = 1;
201 if ($form->{"show_dbupdate_warning"}) {
202 print($form->parse_html_template2("dbupgrade/warning"));
207 open(FH, ">$userspath/nologin") or die("$!");
209 # required for Oracle
210 $form->{dbdefault} = $sid;
212 # ignore HUP, QUIT in case the webserver times out
213 $SIG{HUP} = 'IGNORE';
214 $SIG{QUIT} = 'IGNORE';
216 $self->dbupdate($form);
217 $self->dbupdate2($form, $controls);
222 unlink("$userspath/nologin");
225 $self->{"menustyle"} eq "v3" ? "menuv3.pl" :
226 $self->{"menustyle"} eq "neu" ? "menunew.pl" :
227 $self->{"menustyle"} eq "xml" ? "menuXML.pl" :
230 print($form->parse_html_template2("dbupgrade/footer",
231 { "menufile" => $menufile }));
238 $main::lxdebug->leave_sub();
244 $main::lxdebug->enter_sub();
246 my ($form, $db) = @_;
249 'Pg' => { 'yy-mm-dd' => 'set DateStyle to \'ISO\'',
250 'yyyy-mm-dd' => 'set DateStyle to \'ISO\'',
251 'mm/dd/yy' => 'set DateStyle to \'SQL, US\'',
252 'mm-dd-yy' => 'set DateStyle to \'POSTGRES, US\'',
253 'dd/mm/yy' => 'set DateStyle to \'SQL, EUROPEAN\'',
254 'dd-mm-yy' => 'set DateStyle to \'POSTGRES, EUROPEAN\'',
255 'dd.mm.yy' => 'set DateStyle to \'GERMAN\''
258 'yy-mm-dd' => 'ALTER SESSION SET NLS_DATE_FORMAT = \'YY-MM-DD\'',
259 'yyyy-mm-dd' => 'ALTER SESSION SET NLS_DATE_FORMAT = \'YYYY-MM-DD\'',
260 'mm/dd/yy' => 'ALTER SESSION SET NLS_DATE_FORMAT = \'MM/DD/YY\'',
261 'mm-dd-yy' => 'ALTER SESSION SET NLS_DATE_FORMAT = \'MM-DD-YY\'',
262 'dd/mm/yy' => 'ALTER SESSION SET NLS_DATE_FORMAT = \'DD/MM/YY\'',
263 'dd-mm-yy' => 'ALTER SESSION SET NLS_DATE_FORMAT = \'DD-MM-YY\'',
264 'dd.mm.yy' => 'ALTER SESSION SET NLS_DATE_FORMAT = \'DD.MM.YY\'',
267 $form->{dboptions} = $dboptions{ $form->{dbdriver} }{ $form->{dateformat} };
269 if ($form->{dbdriver} eq 'Pg') {
270 $form->{dbconnect} = "dbi:Pg:dbname=$db";
273 if ($form->{dbdriver} eq 'Oracle') {
274 $form->{dbconnect} = "dbi:Oracle:sid=$form->{sid}";
277 if ($form->{dbhost}) {
278 $form->{dbconnect} .= ";host=$form->{dbhost}";
280 if ($form->{dbport}) {
281 $form->{dbconnect} .= ";port=$form->{dbport}";
284 $main::lxdebug->leave_sub();
288 $main::lxdebug->enter_sub();
290 my @drivers = DBI->available_drivers();
292 $main::lxdebug->leave_sub();
294 return (grep { /(Pg|Oracle)/ } @drivers);
298 $main::lxdebug->enter_sub();
300 my ($self, $form) = @_;
305 $form->{dbdefault} = $form->{dbuser} unless $form->{dbdefault};
306 $form->{sid} = $form->{dbdefault};
307 &dbconnect_vars($form, $form->{dbdefault});
310 DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
313 if ($form->{dbdriver} eq 'Pg') {
315 qq|SELECT datname FROM pg_database | .
316 qq|WHERE NOT datname IN ('template0', 'template1')|;
317 $sth = $dbh->prepare($query);
318 $sth->execute() || $form->dberror($query);
320 while (my ($db) = $sth->fetchrow_array) {
322 if ($form->{only_acc_db}) {
324 next if ($db =~ /^template/);
326 &dbconnect_vars($form, $db);
328 DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
332 qq|SELECT tablename FROM pg_tables | .
333 qq|WHERE (tablename = 'defaults') AND (tableowner = ?)|;
334 my $sth = $dbh->prepare($query);
335 $sth->execute($form->{dbuser}) ||
336 $form->dberror($query . " ($form->{dbuser})");
338 if ($sth->fetchrow_array) {
339 push(@dbsources, $db);
345 push(@dbsources, $db);
349 if ($form->{dbdriver} eq 'Oracle') {
350 if ($form->{only_acc_db}) {
352 qq|SELECT owner FROM dba_objects | .
353 qq|WHERE object_name = 'DEFAULTS' AND object_type = 'TABLE'|;
355 $query = qq|SELECT username FROM dba_users|;
358 $sth = $dbh->prepare($query);
359 $sth->execute || $form->dberror($query);
361 while (my ($db) = $sth->fetchrow_array) {
362 push(@dbsources, $db);
369 $main::lxdebug->leave_sub();
375 $main::lxdebug->enter_sub();
377 my ($self, $form) = @_;
379 $form->{sid} = $form->{dbdefault};
380 &dbconnect_vars($form, $form->{dbdefault});
382 DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
384 $form->{db} =~ s/\"//g;
386 'Pg' => qq|CREATE DATABASE "$form->{db}"|,
388 qq|CREATE USER "$form->{db}" DEFAULT TABLESPACE USERS | .
389 qq|TEMPORARY TABLESPACE TEMP IDENTIFIED BY "$form->{db}"|
396 push(@{$dboptions{"Pg"}}, "ENCODING = " . $dbh->quote($form->{"encoding"}))
397 if ($form->{"encoding"});
398 if ($form->{"dbdefault"}) {
399 my $dbdefault = $form->{"dbdefault"};
400 $dbdefault =~ s/[^a-zA-Z0-9_\-]//g;
401 push(@{$dboptions{"Pg"}}, "TEMPLATE = $dbdefault");
404 my $query = $dbcreate{$form->{dbdriver}};
405 $query .= " WITH " . join(" ", @{$dboptions{"Pg"}}) if (@{$dboptions{"Pg"}});
407 do_query($form, $dbh, $query);
409 if ($form->{dbdriver} eq 'Oracle') {
410 $query = qq|GRANT CONNECT, RESOURCE TO "$form->{db}"|;
411 do_query($form, $dbh, $query);
415 # setup variables for the new database
416 if ($form->{dbdriver} eq 'Oracle') {
417 $form->{dbuser} = $form->{db};
418 $form->{dbpasswd} = $form->{db};
421 &dbconnect_vars($form, $form->{db});
423 $dbh = DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
426 my $db_charset = $Common::db_encoding_to_charset{$form->{encoding}};
427 $db_charset ||= Common::DEFAULT_CHARSET;
430 $self->process_query($form, $dbh, "sql/lx-office.sql", undef, $db_charset);
432 # load chart of accounts
433 $self->process_query($form, $dbh, "sql/$form->{chart}-chart.sql", undef, $db_charset);
435 $query = "UPDATE defaults SET coa = ?";
436 do_query($form, $dbh, $query, $form->{chart});
440 $main::lxdebug->leave_sub();
443 # Process a Perl script which updates the database.
444 # If the script returns 1 then the update was successful.
445 # Return code "2" means "needs more interaction; remove
446 # users/nologin and exit".
447 # All other return codes are fatal errors.
448 sub process_perl_script {
449 $main::lxdebug->enter_sub();
451 my ($self, $form, $dbh, $filename, $version_or_control, $db_charset) = @_;
453 my $fh = IO::File->new($filename, "r") or $form->error("$filename : $!\n");
455 my $file_charset = Common::DEFAULT_CHARSET;
457 if (ref($version_or_control) eq "HASH") {
458 $file_charset = $version_or_control->{charset};
463 next if !/^--\s*\@charset:\s*(.+)/;
467 $fh->seek(0, SEEK_SET);
470 my $contents = join "", <$fh>;
473 $db_charset ||= Common::DEFAULT_CHARSET;
475 my $iconv = SL::Iconv::get_converter($file_charset, $db_charset);
479 my %dbup_myconfig = ();
480 map({ $dbup_myconfig{$_} = $form->{$_}; }
481 qw(dbname dbuser dbpasswd dbhost dbport dbconnect));
483 my $nls_file = $filename;
484 $nls_file =~ s|.*/||;
485 $nls_file =~ s|.pl$||;
486 my $dbup_locale = Locale->new($main::language, $nls_file);
488 my $result = eval($contents);
495 if (!defined($result)) {
496 print($form->parse_html_template2("dbupgrade/error",
497 { "file" => $filename,
500 } elsif (1 != $result) {
501 unlink("users/nologin") if (2 == $result);
505 if (ref($version_or_control) eq "HASH") {
506 $dbh->do("INSERT INTO schema_info (tag, login) VALUES (" .
507 $dbh->quote($version_or_control->{"tag"}) . ", " .
508 $dbh->quote($form->{"login"}) . ")");
509 } elsif ($version_or_control) {
510 $dbh->do("UPDATE defaults SET version = " .
511 $dbh->quote($version_or_control));
515 $main::lxdebug->leave_sub();
519 $main::lxdebug->enter_sub();
521 my ($self, $form, $dbh, $filename, $version_or_control, $db_charset) = @_;
523 my $fh = IO::File->new($filename, "r") or $form->error("$filename : $!\n");
528 my $file_charset = Common::DEFAULT_CHARSET;
531 next if !/^--\s*\@charset:\s*(.+)/;
535 $fh->seek(0, SEEK_SET);
537 $db_charset ||= Common::DEFAULT_CHARSET;
542 $_ = SL::Iconv::convert($file_charset, $db_charset, $_);
544 # Remove DOS and Unix style line endings.
550 for (my $i = 0; $i < length($_); $i++) {
551 my $char = substr($_, $i, 1);
553 # Are we inside a string?
555 if ($char eq $quote_chars[-1]) {
561 if (($char eq "'") || ($char eq "\"")) {
562 push(@quote_chars, $char);
564 } elsif ($char eq ";") {
566 # Query is complete. Send it.
568 $sth = $dbh->prepare($query);
569 if (!$sth->execute()) {
570 my $errstr = $dbh->errstr;
573 $form->dberror("The database update/creation did not succeed. " .
574 "The file ${filename} containing the following " .
575 "query failed:<br>${query}<br>" .
576 "The error message was: ${errstr}<br>" .
577 "All changes in that file have been reverted.");
590 if (ref($version_or_control) eq "HASH") {
591 $dbh->do("INSERT INTO schema_info (tag, login) VALUES (" .
592 $dbh->quote($version_or_control->{"tag"}) . ", " .
593 $dbh->quote($form->{"login"}) . ")");
594 } elsif ($version_or_control) {
595 $dbh->do("UPDATE defaults SET version = " .
596 $dbh->quote($version_or_control));
602 $main::lxdebug->leave_sub();
606 $main::lxdebug->enter_sub();
608 my ($self, $form) = @_;
609 $form->{db} =~ s/\"//g;
610 my %dbdelete = ('Pg' => qq|DROP DATABASE "$form->{db}"|,
611 'Oracle' => qq|DROP USER "$form->{db}" CASCADE|);
613 $form->{sid} = $form->{dbdefault};
614 &dbconnect_vars($form, $form->{dbdefault});
616 DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
618 my $query = $dbdelete{$form->{dbdriver}};
619 do_query($form, $dbh, $query);
623 $main::lxdebug->leave_sub();
626 sub dbsources_unused {
627 $main::lxdebug->enter_sub();
629 my ($self, $form, $memfile) = @_;
636 $form->error('File locked!') if (-f "${memfile}.LCK");
639 open(FH, "$memfile") or $form->error("$memfile : $!");
643 my ($null, $item) = split(/=/);
650 $form->{only_acc_db} = 1;
651 my @db = &dbsources("", $form);
653 push @dbexcl, $form->{dbdefault};
655 foreach $item (@db) {
656 unless (grep /$item$/, @dbexcl) {
657 push @dbsources, $item;
661 $main::lxdebug->leave_sub();
667 $main::lxdebug->enter_sub();
669 my ($self, $form) = @_;
671 my $members = Inifile->new($main::memberfile);
672 my $controls = parse_dbupdate_controls($form, $form->{dbdriver});
674 my ($query, $sth, %dbs_needing_updates);
676 foreach my $login (grep /[a-z]/, keys %{ $members }) {
677 my $member = $members->{$login};
679 map { $form->{$_} = $member->{$_} } qw(dbname dbuser dbpasswd dbhost dbport);
680 dbconnect_vars($form, $form->{dbname});
681 $main::lxdebug->dump(0, "form", $form);
682 my $dbh = DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd});
688 $query = qq|SELECT version FROM defaults|;
689 $sth = prepare_query($form, $dbh, $query);
690 if ($sth->execute()) {
691 ($version) = $sth->fetchrow_array();
696 next unless $version;
698 if (update_available($form->{dbdriver}, $version) || update2_available($form, $controls)) {
700 map { $dbinfo->{$_} = $member->{$_} } grep /^db/, keys %{ $member };
701 $dbs_needing_updates{$member->{dbhost} . "::" . $member->{dbname}} = $dbinfo;
705 $main::lxdebug->leave_sub();
707 return values %dbs_needing_updates;
711 $main::lxdebug->enter_sub(2);
713 my (@v, $version, $i);
715 @v = split(/\./, $_[0]);
716 while (scalar(@v) < 4) {
720 for ($i = 0; $i < 4; $i++) {
725 $main::lxdebug->leave_sub(2);
729 sub cmp_script_version {
730 my ($a_from, $a_to, $b_from, $b_to);
731 my ($i, $res_a, $res_b);
732 my ($my_a, $my_b) = ($a, $b);
734 $my_a =~ s/.*-upgrade-//;
736 $my_b =~ s/.*-upgrade-//;
738 ($my_a_from, $my_a_to) = split(/-/, $my_a);
739 ($my_b_from, $my_b_to) = split(/-/, $my_b);
741 $res_a = calc_version($my_a_from);
742 $res_b = calc_version($my_b_from);
744 if ($res_a == $res_b) {
745 $res_a = calc_version($my_a_to);
746 $res_b = calc_version($my_b_to);
749 return $res_a <=> $res_b;
752 sub update_available {
753 my ($dbdriver, $cur_version) = @_;
757 opendir SQLDIR, "sql/${dbdriver}-upgrade" || error("", "sql/${dbdriver}-upgrade: $!");
758 my @upgradescripts = grep /${dbdriver}-upgrade-\Q$cur_version\E.*\.(sql|pl)$/, readdir SQLDIR;
761 return ($#upgradescripts > -1);
764 sub create_schema_info_table {
765 $main::lxdebug->enter_sub();
767 my ($self, $form, $dbh) = @_;
769 my $query = "SELECT tag FROM schema_info LIMIT 1";
770 if (!$dbh->do($query)) {
773 qq|CREATE TABLE schema_info (| .
776 qq| itime timestamp DEFAULT now(), | .
777 qq| PRIMARY KEY (tag))|;
778 $dbh->do($query) || $form->dberror($query);
781 $main::lxdebug->leave_sub();
785 $main::lxdebug->enter_sub();
787 my ($self, $form) = @_;
791 $form->{sid} = $form->{dbdefault};
793 my @upgradescripts = ();
797 if ($form->{dbupdate}) {
799 # read update scripts into memory
800 opendir(SQLDIR, "sql/" . $form->{dbdriver} . "-upgrade")
801 or &error("", "sql/" . $form->{dbdriver} . "-upgrade : $!");
803 sort(cmp_script_version
804 grep(/$form->{dbdriver}-upgrade-.*?\.(sql|pl)$/,
809 my $db_charset = $main::dbcharset;
810 $db_charset ||= Common::DEFAULT_CHARSET;
812 foreach my $db (split(/ /, $form->{dbupdate})) {
814 next unless $form->{$db};
816 # strip db from dataset
818 &dbconnect_vars($form, $db);
821 DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
825 $query = qq|SELECT version FROM defaults|;
826 my ($version) = selectrow_query($form, $dbh, $query);
828 next unless $version;
830 $version = calc_version($version);
832 foreach my $upgradescript (@upgradescripts) {
833 my $a = $upgradescript;
834 $a =~ s/^\Q$form->{dbdriver}\E-upgrade-|\.(sql|pl)$//g;
837 my ($mindb, $maxdb) = split /-/, $a;
838 my $str_maxdb = $maxdb;
839 $mindb = calc_version($mindb);
840 $maxdb = calc_version($maxdb);
842 next if ($version >= $maxdb);
844 # if there is no upgrade script exit
845 last if ($version < $mindb);
848 $main::lxdebug->message(DEBUG2, "Applying Update $upgradescript");
849 if ($file_type eq "sql") {
850 $self->process_query($form, $dbh, "sql/" . $form->{"dbdriver"} .
851 "-upgrade/$upgradescript", $str_maxdb, $db_charset);
853 $self->process_perl_script($form, $dbh, "sql/" . $form->{"dbdriver"} .
854 "-upgrade/$upgradescript", $str_maxdb, $db_charset);
866 $main::lxdebug->leave_sub();
872 $main::lxdebug->enter_sub();
874 my ($self, $form, $controls) = @_;
876 $form->{sid} = $form->{dbdefault};
878 my @upgradescripts = ();
879 my ($query, $sth, $tag);
882 @upgradescripts = sort_dbupdate_controls($controls);
884 my $db_charset = $main::dbcharset;
885 $db_charset ||= Common::DEFAULT_CHARSET;
887 foreach my $db (split / /, $form->{dbupdate}) {
889 next unless $form->{$db};
891 # strip db from dataset
893 &dbconnect_vars($form, $db);
896 DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
899 map({ $_->{"applied"} = 0; } @upgradescripts);
901 $self->create_schema_info_table($form, $dbh);
903 $query = qq|SELECT tag FROM schema_info|;
904 $sth = $dbh->prepare($query);
905 $sth->execute() || $form->dberror($query);
906 while (($tag) = $sth->fetchrow_array()) {
907 $controls->{$tag}->{"applied"} = 1 if (defined($controls->{$tag}));
912 foreach (@upgradescripts) {
913 if (!$_->{"applied"}) {
919 next if ($all_applied);
921 foreach my $control (@upgradescripts) {
922 next if ($control->{"applied"});
924 $control->{description} = SL::Iconv::convert($control->{charset}, $db_charset, $control->{description});
926 $control->{"file"} =~ /\.(sql|pl)$/;
930 $main::lxdebug->message(DEBUG2, "Applying Update $control->{file}");
931 print($form->parse_html_template2("dbupgrade/upgrade_message2",
934 if ($file_type eq "sql") {
935 $self->process_query($form, $dbh, "sql/" . $form->{"dbdriver"} .
936 "-upgrade2/$control->{file}", $control, $db_charset);
938 $self->process_perl_script($form, $dbh, "sql/" . $form->{"dbdriver"} .
939 "-upgrade2/$control->{file}", $control, $db_charset);
948 $main::lxdebug->leave_sub();
953 sub update2_available {
954 $main::lxdebug->enter_sub();
956 my ($form, $controls) = @_;
958 map({ $_->{"applied"} = 0; } values(%{$controls}));
960 dbconnect_vars($form, $form->{"dbname"});
963 DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}) ||
966 my ($query, $tag, $sth);
968 $query = qq|SELECT tag FROM schema_info|;
969 $sth = $dbh->prepare($query);
970 if ($sth->execute()) {
971 while (($tag) = $sth->fetchrow_array()) {
972 $controls->{$tag}->{"applied"} = 1 if (defined($controls->{$tag}));
978 map({ $main::lxdebug->leave_sub() and return 1 if (!$_->{"applied"}) }
979 values(%{$controls}));
981 $main::lxdebug->leave_sub();
986 $main::lxdebug->enter_sub();
992 @config = config_vars();
994 my $userspath = $main::userspath;
996 open(CONF, ">", "$userspath/$self->{login}.conf") || $self->error("$userspath/$self->{login}.conf : $!");
998 # create the config file
999 print CONF qq|# configuration file for $self->{login}
1004 foreach my $key (sort @config) {
1005 $self->{$key} =~ s/\'/\\\'/g;
1006 print CONF qq| $key => '$self->{$key}',\n|;
1009 print CONF qq|);\n\n|;
1013 $main::lxdebug->leave_sub();
1017 $main::lxdebug->enter_sub();
1019 my ($self, $memberfile, $userspath) = @_;
1025 # format dbconnect and dboptions string
1026 &dbconnect_vars($self, $self->{dbname});
1028 $self->error('File locked!') if (-f "${memberfile}.LCK");
1029 open(FH, ">${memberfile}.LCK") or $self->error("${memberfile}.LCK : $!");
1032 open(CONF, "+<$memberfile") or $self->error("$memberfile : $!");
1039 while ($line = shift @config) {
1040 if ($line =~ /^\[\Q$self->{login}\E\]/) {
1047 # remove everything up to next login or EOF
1048 while ($line = shift @config) {
1049 last if ($line =~ /^\[/);
1052 # this one is either the next login or EOF
1055 while ($line = shift @config) {
1059 print CONF qq|[$self->{login}]\n|;
1061 if ((($self->{dbpasswd} ne $self->{old_dbpasswd}) || $newmember)
1063 $self->{dbpasswd} = pack 'u', $self->{dbpasswd};
1064 chop $self->{dbpasswd};
1066 if (defined($self->{new_password})) {
1067 if ($self->{new_password} ne $self->{old_password}) {
1068 $self->{password} = crypt $self->{new_password},
1069 substr($self->{login}, 0, 2)
1070 if $self->{new_password};
1073 if ($self->{password} ne $self->{old_password}) {
1074 $self->{password} = crypt $self->{password}, substr($self->{login}, 0, 2)
1075 if $self->{password};
1079 if ($self->{'root login'}) {
1080 @config = ("password");
1082 @config = &config_vars;
1085 # replace \r\n with \n
1086 map { $self->{$_} =~ s/\r\n/\\n/g } qw(address signature);
1087 foreach $key (sort @config) {
1088 print CONF qq|$key=$self->{$key}\n|;
1093 unlink "${memberfile}.LCK";
1096 $self->create_config() unless $self->{'root login'};
1098 $main::lxdebug->leave_sub();
1102 $main::lxdebug->enter_sub();
1104 my @conf = qw(acs address admin businessnumber company countrycode
1105 currency dateformat dbconnect dbdriver dbhost dbport dboptions
1106 dbname dbuser dbpasswd email fax name numberformat password
1107 printer role sid signature stylesheet tel templates vclimit angebote
1108 bestellungen rechnungen anfragen lieferantenbestellungen einkaufsrechnungen
1109 taxnumber co_ustid duns menustyle template_format default_media
1110 default_printer_id copies show_form_details favorites);
1112 $main::lxdebug->leave_sub();
1118 $main::lxdebug->enter_sub();
1120 my ($self, $msg) = @_;
1122 $main::lxdebug->show_backtrace();
1124 if ($ENV{HTTP_USER_AGENT}) {
1125 print qq|Content-Type: text/html
1127 <!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0//EN">
1129 <body bgcolor=ffffff>
1131 <h2><font color=red>Error!</font></h2>
1136 die "Error: $msg\n";
1138 $main::lxdebug->leave_sub();