view release on metacpan or  search on metacpan

lib/Config/Checker.pm  view on Meta::CPAN

package Config::Checker;

use strict;
use warnings;
use Eval::LineNumbers qw(eval_line_numbers);
require Exporter;
require Config::YAMLMacros::YAML;
require Module::Load;
require Time::ParseDate;
require Carp;
use Config::YAMLMacros::YAML;

our @ISA = qw(Exporter);
our @EXPORT = qw(config_checker_source);
our @EXPORT_OK = (@EXPORT, qw(unique split_listify));
our $VERSION = 0.42;

our %mults = (
	K	=> 1024,
	M	=> 1024**2,
	G	=> 1024**3,
	T	=> 1024**4,
	P	=> 1024**5,
);

#
# We are returning this code as text for the recipient to compile so that
# it will have access to the recipient's lexical variables.
#
sub config_checker_source
{
return eval_line_numbers(<<'END_SOURCE');

	import Config::Checker qw(unique split_listify);
	sub {
		my ($config, $prototype_string, $where) = @_;
		$prototype_string =~ s/^(\t+)/" " x length($1) * 8/e;
		my $proto = ref($prototype_string)
			? $prototype_string
			: Config::YAMLMacros::YAML::Load($prototype_string);

		my %checker;
		my $error;

		local(%Config::Checker::unique);

		my $cleaner = sub {
			my ($spec) = @_;
			Carp::confess if ref($spec);
			my $desc = $spec;
			my $quantity = '';
			my $default;
			my $name_entry;
			$desc =~ s/^=//
				and $name_entry = 1;
			$desc =~ s/^([*%+?])//
				and $quantity = $1 || '';
			if ($quantity eq '?') {
				$desc =~ s/^<([^<>]*)>//
					and $default = $1;
			} elsif ($quantity eq '+' || $quantity eq '*') {
				$desc =~ s/^<([^<>]*)>//
					and $default = qr/$1/;
			}
			my $type = '';
			$desc =~ s/\[(.*)\]$// 
				and $type = $1 || '';
			my $code = '';
			$desc =~ s/\{(.*)\}$// 
				and $code = $1 || '';
			return ($desc, $type, $code, $quantity, $default);
		};
		my $validate = sub {
			my ($ref, $context, $spec) = @_;
			Carp::confess if ref($spec);
			my $value = $$ref;
			my ($desc, $type, $code, $quantity, $default) = $cleaner->($spec);
#no warnings;
#print <<END;
#----------------
#DESC: $desc
#TYPE: $type
#CODE: $code
#QNTY: $quantity
#DFLT: $default
#END
			if (ref $value) {
				die "Not expecting a ".ref($value)." for $context $where";
			}
			if ($type eq 'MODULE_NAME') {
				eval { Module::Load::load $value };
				die "Could not load module $value for $context ($proto): $@ $where" if $@;
			} elsif ($type eq 'PATH') {
				die "Illegal characters in path '$value' for $context $where"
					if $value =~ /\s/;
			} elsif ($type eq 'DATE') {
				die "Could not understand date '$value' for $context $where"
					unless Time::ParseDate::parsedate($value);
			} elsif ($type eq 'INTEGER') {
				die "An integer is required, not '$value' for $context $where"