view release on metacpan or  search on metacpan

lib/App/Glacier/Config.pm  view on Meta::CPAN

			if ($v !~ /$x->{re}/) {
			    $self->error("invalid value for $k",
					 locus => new Text::Locus($file, $line));
			    $self->{error_count}++;
			    next;
			}
		    }

		    if (exists($x->{check})) {
			if (defined($errstr = &{$x->{check}}(\$v, $prev_val))) {
			    $self->error($errstr,
					 locus => new Text::Locus($file, $line));
			    $self->{error_count}++;
			    next;
			}
		    }

		    if ($x->{array}) {
			if (!defined($prev_val)) {
			    $v = [ $v ];
			} else {
			    $v = [ @{$prev_val}, $v ];
			}
		    }
		}
	    }

	    $section->{-locus}->add($file, $line);
	    unless (exists($section->{$k})) {
		$section->{$k}{-locus} = new Text::Locus();
	    }
	    $section->{$k}{-locus}->add($file, $line);
	    $section->{$k}{-order} = $self->{order}++;
	    $section->{$k}{-value} = $v;
        } else {
    	    $self->error("malformed line",
			 locus => new Text::Locus($file, $line));
	    $self->{error_count}++;
	    next;
	}
    }
    close $fd;
    return $self->{error_count} == 0;
}

sub fixup {
    my $self = shift;
    my $params = shift;
    while (my ($kv, $descr) = each %$params) {
	next unless ref($descr) eq 'HASH';
	if (exists($descr->{section})) {
	    $self->fixup($descr->{section}, @_, $kv);
	} elsif (exists($descr->{default}) && !$self->isset(@_, $kv)) {
	    $self->set(@_, $kv, $descr->{default});
	}
    }
}

sub file_up_to_date {
    my ($self, $file) = @_;
    my $st_conf = stat($self->{filename}) or return 1;
    my $st_file = stat($file)
	or carp "can't stat $file: $!";
    return $st_conf->mtime <= $st_file->mtime;
}

=head2 $cfg->parse()

Parses the configuration file and stores the data in the object.  Returns
true on success and false on failure.  Eventual errors in the configuration
are reported using B<error>.

=cut

sub parse {
    my ($self) = @_;
    my %conf;

    return if exists $self->{conf};
    $self->{error_count} = 0;
    if (exists($self->{cachefile}) and -f $self->{cachefile}) {
	if ($self->file_up_to_date($self->{cachefile})) {
	    my $ref;
	    $self->debug(1, "reading from cache file $self->{cachefile}");
	    eval { $ref = retrieve($self->{cachefile}); };
	    if (defined($ref)) {
		$self->{conf} = $ref;
		$self->{updated} = $self->{rw};
		return 1;
	    } elsif ($@) {
		$self->error("warning: unable to load configuration cache: $@");
	    }
	}
	unlink $self->{cachefile};
    }
    
    $self->debug(1, "parsing $self->{filename}");
    $self->readconfig($self->{filename}, \%conf);
    $self->check_mandatory($self->{parameters}, \%conf);

    if ($self->{error_count} == 0) {
	$self->{conf} = \%conf ;
	$self->{updated} = 1;
	$self->fixup($self->{parameters}) if exists $self->{parameters};
	return 1;
    }
    return 0;
}

sub getref {
    my $self = shift;
    
    return undef unless exists $self->{conf};
    my $ref = $self->{conf};
    for (@_) {
	my $k = $self->{ci} ? lc($_) : $_;
	return undef unless exists $ref->{$k};
	$ref = $ref->{$k};
    }
    return $ref;
}