Text-Glob-Expand

 view release on metacpan or  search on metacpan

lib/Text/Glob/Expand.pm  view on Meta::CPAN

# Private methods

# $permutations = $obj->_traverse(@expression)
#
# This method traverses a sub-expression and recursively expands them
# into all possible permutations, returning an arrayref to the
# resulting list of lists (of Text::Glob::Expand::Segment instances).
#
# If no arguments are given, it returns an empty arrayref.
sub _traverse {
    my $self = shift;

    # Trivial case.
    return [] unless @_;

    # Since @expression contains the elements of a glob expression,
    # each parameter param can be one of two things: a string segment
    # or a brace-expression.

    # Take the first element, and process the rest recursively.
    my $first = shift;

    if (ref $first eq 'Text::Glob::Expand::Segment') {
        # $first is a string segment - in which case we recursively
        # expand the the remaining arguments (if any) into their
        # permutations and prepend $first to each of the permutations.

        return [[$first]] unless @_;

        my $exploded = $self->_traverse(@_);
        unshift @$_, $first for @$exploded;
        return $exploded;
    }
    else {
        # $first is an brace-expression (an arrayref of alternative
        # sub-expressions) - in which case we take out each
        # alternative sub-expression $seq, concatenate it with with
        # the remaining arguments into a new expression, and
        # recursively expand the permutations of that expression.
        #
        # After processing them all, we return a concatenated list of
        # all the permutations.
        my @exploded;
        foreach my $seq (@$first) {
            die "unexpected scalar '$seq'" if !ref $seq;
            my $exploded2 = $self->_traverse(@$seq, @_);
            push @exploded, @$exploded2;
        }
        return \@exploded;
    }
}


# $root = $obj->_transform($depth, $permutation)
#
# $permutation is an arrayref of segments (Text::Glob::Expand::Segment
# instances) representing a permutation generated from a
# Text::Glob::Expand expression (i.e. one of the elements in the
# result from from _traverse).
#
# $depth is a depth to partition it by (in hindsight, perhaps this
# could be computed from the first element's depth?).
#
# The result $root is the root node of a tree structure describing the
# structure of the permutation (a Text::Glob::Expand::Permutation
# instance), by using the segments' depth attribute.  This tree is
# designed to allow the placeholders in formats to be mapped to
# expansions.
#
# See the POD within Text::Glob::Expand::Permutation for a description of 
# the structure of this result.
#
# For example, this glob expression:
#
#     "a{b{c,d,}e,f}g"
#
# Generates this set of permutations:
#
#    "abceg", "abdeg", "abeg", "afg"
#
# Permutations are generated by _traverse in terms of arrays of
# Text::Glob::Expand::Segment instances. The first permutation above
# would look like this (omitting blessings):
#
#    $permutation = [['a', 0], ['b', 1], ['c', 2], ['e', 1], ['g', 0]]
#
# This then gets passed to _transform to turn it into a
# Text::Glob::Expand::Permutation instance:
#
#     $root = $glob->_transform(0, $permutation)
#
# The structure of $root would be:
#
#    ["abceg", ["bce", ["c"]]]
#
# This is then relatively easily used to expand a format like "%1 %1.1
# %1.1.1" into "abcdeg bce c".
#
sub _transform {
    my $self = shift;
    my $depth = shift;
    my $permutation = shift;

    # Concatenate the strings from all the Text::Glob::Expand::Segment
    # instances in $permutation into one.
    my $flat =  join '', map { $_->[0] } @$permutation;

    # Group the segments deeper than $depth recursively
    if (my @deeper = _partition $depth, @$permutation) {
        return bless (
            [$flat, map { $self->_transform($depth+1, $_)} @deeper],
            'Text::Glob::Expand::Permutation',
        );
    }

    # Bless the result, to add convenience methods for the user.
    return bless [$flat], 'Text::Glob::Expand::Permutation';
}


# $permutations = $obj->_explode



( run in 0.662 second using v1.01-cache-2.11-cpan-71847e10f99 )