File Coverage

blib/lib/Config/Maker/Option.pm

Criterion	Covered	Total	%
statement	65	73	89.0
branch	12	18	66.6
condition			n/a
subroutine	15	20	75.0
pod	3	6	50.0
total	95	117	81.2

package Config::Maker::Option;

use utf8;
use warnings;
use strict;

use Carp;

use Config::Maker;
use Config::Maker::Type;
use Config::Maker::Path;

use overload
    'cmp' => \&Config::Maker::truecmp,
    '<=>' => \&Config::Maker::truecmp,
    '""' => sub { $_[0]->{-value}; },
    '/' => sub {
	croak "Can't \"divide by\" option" if $_[2];
	$_[0]->get($_[1]);
    },
    '&{}' => sub {
	my $self = $_[0];
	sub { $self->get(@_); };
    },
    fallback => 1;

sub _ref(\%$;$) {
    my ($hash, $key, $default) = @_;
    if(exists $hash->{$key}) {
	my $rv = $hash->{$key};
	delete $hash->{$key};
	return $rv;
    } elsif(@_ == 3) {
	return $default;
    } else {
	croak "Mandatory argument $key not specified";
    }
}

sub _flatten {
    map {
	ref($_) eq 'ARRAY' ?
	    _flatten(@$_) :
	    $_;
    } @_;
}

sub new {
    my ($class, %args) = @_;
    my $type = _ref(%args, '-type');

    my $self = {
	-type => $type,
	-value => _ref(%args, '-value', ''),
	-children => _ref(%args, '-children', []),
    };
    croak "Unknown arguments: " . join(', ', keys %args)
	if %args;
    bless $self, $class;

    $self->{-children} = [_flatten(@{$self->{-children}})];

    foreach my $child (@{$self->{-children}}) {
	$child->{-parent} = $self;
    }

    foreach my $check (@{$type->{checks}}) {
	&$check($self);
    }

    foreach my $action (@{$type->{actions}}) {
	&$action($self);
    }

    DBG("Instantiated $type");
    $self;
}

sub get {
    my ($self, $path) = @_;
    $path = Config::Maker::Path->make($path);
    my $res = $path->find($self);
    return wantarray ? @$res : $res->[0];
}

sub get1 {
    my ($self, $path) = @_;
    $path = Config::Maker::Path->make($path);
    my $res = $path->find($self);
    Carp::croak "$path should have exactly one result" if $#$res;
    return $res->[0];
}

sub getval {
    my ($self, $path, $default) = @_;
    $path = Config::Maker::Path->make($path);
    my $res = $path->find($self);
    Carp::croak "$path should have at most one result" if @$res > 1;
    @$res ? $res->[0]->{-value} : $default;
}

sub type {
    $_[0]->{-type};
}

sub id {
    "$_[0]->{-type}:$_[0]->{-value}";
}

1;

__END__