view release on metacpan or  search on metacpan

lib/Apache/Admin/Config.pm  view on Meta::CPAN

            {
                $name = $_->value;
            }
            elsif($_->type eq 'blank')
            {
                $name = $_->{length};
            }

            my $value = defined $_->value ? $_->value : '';
            $string .= $self->$method($name||'', $value);
        }
    }

    return $string;
}

=pod

=head2 select

    @result = $obj->select
    (
        [-type  => $type],
        [-name  => $name],
        [-value => $value],
        [-which => $index],
    );

    @directives    = $obj->select('directive');
    @sections_foo  = $obj->select('section', 'Foo');

This method search in the current context for items (directives, sections,
comments...) that correspond to a properties given by arguments. It returns
a B<list> of matched nods.

This method can only be called on an object of type "section". This
method search only for elements in the section pointed by object, and
isn't recursive. So elements B<in> sub-sections of current section
aren's seek (it's not a bug).

Arguments:

=over 4

=item B<C<type>>

Selects item(s) of C<type> type.

=item B<C<name>>

Selects item(s) with C<name> name.

=item B<C<value>>

Selects item(s) with C<value> value.

=item B<C<which>>

Instead of returning a list of items, returns only a single one
pointed by index given to the -which option. Caution, returns an empty
string if none selected, so don't cascade your methodes calls like
$obj->select(-which=>0)->name. Index starts at 0.

=back

Method returns a list of item(s) founds. Each items is an
Apache::Admin::Config object with same methods but pointing to a
different part of the tree.

=cut

sub select
{
    my $self = shift;

    my $which = _get_arg(\@_, '-which');

    my %args;
    $args{type}  = _get_arg(\@_, '-type')  || undef;
    $args{name}  = _get_arg(\@_, '-name')  || undef;
    $args{value} = _get_arg(\@_, '-value') || undef;

    # accepting old style arguments for backward compatibilitie
    $args{type}  = shift unless defined $args{type};
    $args{name}  = shift unless defined $args{name};
    $args{value} = shift unless defined $args{value};

    # _get_arg return undef on error or empty string on not founded rule
    return $self->_set_error('malformed arguments')
        if not defined $which; 
    # $which isn't an integer
    return $self->_set_error('error in -which argument: not an integer')
        if $which =~ /[^\d\-]/;
    return $self->_set_error('too many arguments')
        if @_;
    return $self->_set_error('method not allowed')
        unless $self->{type} eq 'section';

    $args{name}  = lc($args{name})  if defined $args{name};
    $args{value} = lc($args{value}) if defined $args{value};

    my @children = @{$self->{children}};

    my $n = 0;
    my @items;
    # pre-select fields to test on each objects
    my @field_to_test = 
        grep(defined $args{$_}, qw(type name value));

    foreach my $item (@children)
    {
        my $match = 1;
        # for all given arguments, we test if it matched
        # for missing aguments, match is always true
        foreach(@field_to_test)
        {
            if(defined $item->{$_})
            {
                $match = $args{$_} eq lc($item->{$_});
            }
            else