view release on metacpan or  search on metacpan

lib/Badger/Config/Item.pm  view on Meta::CPAN

    }


    # 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->{ arity   } = $config->{ arity   } || 0;

    $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 {