- my ($form, $controls) = @_;
-
- map({ $_->{"applied"} = 0; } values(%{$controls}));
-
- dbconnect_vars($form, $form->{"dbname"});
-
- my $dbh =
- DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}) ||
- $form->dberror;
-
- my ($query, $tag, $sth);
-
- $query = qq|SELECT tag FROM schema_info|;
- $sth = $dbh->prepare($query);
- if ($sth->execute()) {
- while (($tag) = $sth->fetchrow_array()) {
- $controls->{$tag}->{"applied"} = 1 if (defined($controls->{$tag}));
- }
- }
- $sth->finish();
- $dbh->disconnect();
-
- map({ $main::lxdebug->leave_sub() and return 1 if (!$_->{"applied"}) }
- values(%{$controls}));
-
- $main::lxdebug->leave_sub();
- return 0;
-}
-
-sub create_config {
- $main::lxdebug->enter_sub();
-
- my ($self) = @_;
-
- local *CONF;
-
- @config = config_vars();
-
- my $userspath = $main::userspath;
-
- open(CONF, ">", "$userspath/$self->{login}.conf") || $self->error("$userspath/$self->{login}.conf : $!");
-
- # create the config file
- print CONF qq|# configuration file for $self->{login}
-
-\%myconfig = (
-|;
-
- foreach my $key (sort @config) {
- $self->{$key} =~ s/\'/\\\'/g;
- print CONF qq| $key => '$self->{$key}',\n|;
- }
-
- print CONF qq|);\n\n|;
-
- close CONF;
-
- $main::lxdebug->leave_sub();
-}
-
-sub save_member {
- $main::lxdebug->enter_sub();
-
- my ($self, $memberfile, $userspath) = @_;
-
- local (*FH, *CONF);
-
- my $newmember = 1;
-
- # format dbconnect and dboptions string
- &dbconnect_vars($self, $self->{dbname});
-
- $self->error('File locked!') if (-f "${memberfile}.LCK");
- open(FH, ">${memberfile}.LCK") or $self->error("${memberfile}.LCK : $!");
- close(FH);
-
- open(CONF, "+<$memberfile") or $self->error("$memberfile : $!");
-
- @config = <CONF>;
-
- seek(CONF, 0, 0);
- truncate(CONF, 0);
-
- while ($line = shift @config) {
- if ($line =~ /^\[\Q$self->{login}\E\]/) {
- $newmember = 0;
- last;
- }
- print CONF $line;
- }
-
- # remove everything up to next login or EOF
- while ($line = shift @config) {
- last if ($line =~ /^\[/);
- }
-
- # this one is either the next login or EOF
- print CONF $line;
-
- while ($line = shift @config) {
- print CONF $line;
- }
-
- print CONF qq|[$self->{login}]\n|;
-
- if ((($self->{dbpasswd} ne $self->{old_dbpasswd}) || $newmember)
- && $self->{root}) {
- $self->{dbpasswd} = pack 'u', $self->{dbpasswd};
- chop $self->{dbpasswd};
- }
- if (defined($self->{new_password})) {
- if ($self->{new_password} ne $self->{old_password}) {
- $self->{password} = crypt $self->{new_password},
- substr($self->{login}, 0, 2)
- if $self->{new_password};
- }
- } else {
- if ($self->{password} ne $self->{old_password}) {
- $self->{password} = crypt $self->{password}, substr($self->{login}, 0, 2)
- if $self->{password};
- }
- }
-
- if ($self->{'root login'}) {
- @config = ("password");
- } else {
- @config = &config_vars;