package Badger::Config::Item;
use Badger::Debug ':dump';
use Badger::Class
version => 0.01,
debug => 0,
base => 'Badger::Base',
import => 'class CLASS',
utils => 'blessed',
accessors => 'name',
constants => 'DELIMITER ARRAY HASH',
alias => {
init => \&init_item,
},
messages => {
bad_type => 'Invalid type prefix specified for %s: %s',
bad_method => 'Missing method for the %s %s configuration item: %s',
dup_item => 'Duplicate specification for scheme item: %s',
bad_fallback => 'Invalid fallback item specified for %s: %s',
no_value => 'No value specified for the %s configuration item',
};
sub init_item {
my ($self, $config) = @_;
my ($name, @aka, $alias, $fallback, $test);
my $fall = delete $config->{ fallback_provider } || $self;
$self->debug("Generating config item: ", $self->dump_data($config))
if DEBUG;
$name = $config->{ name }
|| return $self->error_msg( missing => 'name' );
# A '!' at the end of the name indicates it's mandatory.
# A '=value' at the end indicates a default value.
$self->{ required } = ($name =~ s/!$//) ? 1 : $config->{ required };
$self->{ default } = ($name =~ s/=(\S+)$//) ? $1 : $config->{ default };
# name can be 'name|alias1|alias2|...'
($name, @aka) = split(/\|/, $name);
# alias can be specified as hash ref or string
$alias = $config->{ alias } || { };
$alias = [ split(DELIMITER, $alias) ]
unless ref $alias;
$alias = { map { $_ => $name } @$alias }
if ref $alias eq ARRAY;
return $self->error_msg( invalid => alias => $alias )
unless ref $alias eq HASH;
# aliases, and more generally, fallbacks, can be specified as a list ref
# or string which we split
$self->debug("fallback: ", $self->dump_data($config->{ fallback })) if DEBUG;
$fallback = $config->{ fallback } || [ ];
$fallback = [ split(DELIMITER, $fallback) ]
unless ref $fallback eq ARRAY;
push(@$fallback, @aka);
$self->debug("fallbacks: ", $self->dump_data($fallback)) if DEBUG;
foreach my $item (@$fallback) {
unless ($item =~ /:/) {
$alias->{ $item } = $name;
next;
}
my ($type, $data) = split(/:/, $item, 2);
$item = $fall->fallback($name, $type, $data)
|| return $self->error_msg( bad_type => $name, $type );
}
# add any aliases specified as part of the name and bind them
# back into the field info hash
$self->{ fallback } = $fallback;
# this is getting way too large... but I just want to get things working
# before I start paring things down
$self->{ name } = $name;
$self->{ alias } = $alias;
$self->{ message } = $config->{ message } || $config->{ error };
$self->{ action } = $config->{ action };
$self->{ method } = $config->{ method };
$self->{ about } = $config->{ about };
$self->{ args } = $config->{ args };
$self->debug(
"Configured configuration item: ", $self->dump
) if DEBUG;
return $self;
}
sub fallback {
shift->not_implemented;
}
sub names {
my $self = shift;
my @names = ($self->{ name }, keys %{ $self->{ alias } });
return wantarray
? @names
: \@names;
}
sub configure {
my ($self, $config, $target, $class) = @_;
my ($name, $alias, $code, @args, $ok, $value);
$class ||= $target;
$self->debug("configure(", CLASS->dump_data_inline($config), ')') if DEBUG;
$self->debug("item is ", $self->dump_data($self)) if DEBUG;
# $self->debug("items: ", CLASS->dump_data($items)) if DEBUG;
$name = $self->{ name };
# TODO: abstract out action calls.
FALLBACK: foreach $alias ($name, @{ $self->{ fallback } || [ ] }) {
next unless defined $alias;
if (ref $alias eq ARRAY) {
($code, @args) = @$alias;
#$self->todo('calling code');
($ok, $value) = $code->($class, $name, $config, $target, @args);
if ($ok) {
return $self->set($target, $name, $value, $class);
}
}
elsif (defined $config->{ $alias }) {
$self->debug("Found value for $name ($alias): $config->{ $alias }\n") if DEBUG;
return $self->set($target, $name, $config->{ $alias }, $class);
}
else {
$self->debug("Nothing found for $alias to set $name\n") if DEBUG;
}
}
if (defined $self->{ default }) {
$self->debug("setting to default value: $self->{ default }\n") if DEBUG;
return $self->set($target, $name, $self->{ default }, $class);
}
if ($self->{ required }) {
$self->debug("$name is required, throwing error\n") if DEBUG;
return $self->error_msg( $self->{ message } || missing => $name );
}
return $self;
}
sub set {
my ($self, $target, $name, $value, $object) = @_;
my $method;
$object ||= $target;
$self->debug("set($target, $name, $value)") if DEBUG;
$target->{ $name } = $value;
$self->{ action }->($self, $name, $value) if $self->{ action };
if (blessed($object) && ($method = $self->{ method })) {
$self->debug("calling method $method on object $object\n") if DEBUG;
$object->$method($name, $value);
}
return $self;
}
sub args {
my $self = shift;
my $args = shift;
my $value;
if ($self->{ args }) {
$self->debug("looking for $self->{ name } arg in ", $self->dump_data($args)) if DEBUG;
return $self->error_msg( no_value => $self->{ name } )
unless @$args && defined $args->[0] && $args->[0] !~ /^-/;
$value = shift @$args;
}
else {
$value = 1;
}
# this is all the wrong way around - quick hack
return $self->configure({ $self->{ name } => $value }, @_);
}
sub summary {
my ($self, $reporter) = @_;
my $name = $self->{ name };
my $args = $self->{ args } || '';
my $about = $self->{ about } || '';
$args = " <$args>" if length $args;
return $reporter
? $reporter->option( $name.$args, $about )
: sprintf('--%-20s %s', $name.$args, $about);
}
1;