File Coverage

blib/lib/String/Range/Expand.pm

Criterion	Covered	Total	%
statement	77	79	97.4
branch	25	32	78.1
condition	6	6	100.0
subroutine	9	9	100.0
pod	2	2	100.0
total	119	128	92.9

package String::Range::Expand;

#######################
# LOAD MODULES
#######################
use strict;
use warnings FATAL => 'all';
use Carp qw(croak carp);

#######################
# VERSION
#######################
our $VERSION = '0.04';

#######################
# EXPORT
#######################
use base qw(Exporter);
our ( @EXPORT, @EXPORT_OK );

@EXPORT    = qw(expand_range);
@EXPORT_OK = qw(expand_range expand_expr);

#######################
# PUBLIC FUNCTIONS
#######################
sub expand_range {
    my ($range_expr) = @_;

    my @range;

    # Define a valid range
    my $valid_range = qr{[a-zA-Z0-9\,\-\^]+}x;

    # split expression into ranges
    my @bits;
    if ( $range_expr =~ m{\[$valid_range\]}x ) {

        # This is a Range
        # Loop thru' multiple instances (e.g. [a-c][f-i])
        while (1) {

            if ( $range_expr =~ m{(\[$valid_range\])}x ) {
                my $match = $+;
                my $pre = substr( $range_expr, 0, $-[0] );
                push @bits, ($pre) if defined $pre;
                push @bits, $match;
                substr( $range_expr, 0, $+[0], '' );
            } ## end if ( $range_expr =~ m{(\[$valid_range\])}x)
            else {
                push @bits, $range_expr;
                $range_expr = '';
            } ## end else [ if ( $range_expr =~ m{(\[$valid_range\])}x)]
          last unless $range_expr;

        } ## end while (1)
    } ## end if ( $range_expr =~ m{\[$valid_range\]}x)
    else {

        # Expression does not have any ranges to expand
        push @range, $range_expr;
    } ## end else [ if ( $range_expr =~ m{\[$valid_range\]}x)]

    # Expand
    foreach my $_bit (@bits) {
        if ( $_bit =~ m{^\[(.+)\]$}x ) {
            @range
              ? do { @range = _combine( \@range, [ _compute($1) ] ); }
              : do { @range = _compute($1); };
        } ## end if ( $_bit =~ m{^\[(.+)\]$}x)
        else {
            @range
              ? do { @range = _combine( \@range, [$_bit] ); }
              : do { push( @range, $_bit ); };
        } ## end else [ if ( $_bit =~ m{^\[(.+)\]$}x)]
    } ## end foreach my $_bit (@bits)

    @range = sort { lc($a) cmp lc($b) } @range if @range;
  return @range;
} ## end sub expand_range


sub expand_expr {
    my @range;
    foreach my $expr ( _split_expr(@_) ) {
        push @range, expand_range($expr);
    }
    @range = sort { lc($a) cmp lc($b) } @range if @range;
  return @range;
} ## end sub expand_expr

#######################
# INTERNAL FUNCTIONS
#######################

## _compute
##  This performs the actual expansion
sub _compute {
    my ($expr) = @_;

    my @list;  # Expanded values

    # Loop thru' ranges
    foreach my $_range ( split( /,/x, $expr ) ) {

        # Type: [aa-az]. Normal Range
        if ( $_range =~ m{^(\w+)\-(\w+)$}x ) { push @list, ( $1 .. $2 ); }

        # Type: [^ba-be]. Negate range
        elsif ( $_range =~ m{^\^(\w+)\-(\w+)$}x ) {
            foreach my $_exclude ( $1 .. $2 ) {
                @list = grep { !/^$_exclude$/x } @list;
            }
        } ## end elsif ( $_range =~ m{^\^(\w+)\-(\w+)$}x)

        # Type: [^zz]. Negate element
        elsif ( $_range =~ m{^\^(\w+)$}x ) {
            @list = grep { !/^$1$/x } @list;
        }

        # Type: [foo]. Individual element
        else { push @list, $_range; }
    } ## end foreach my $_range ( split(...))
  return @list;
} ## end sub _compute

## _combine
sub _combine {
    my ( $a1, $a2 ) = @_;

    my @list;

    foreach my $_a1 (@$a1) {
        foreach my $_a2 (@$a2) {
            push @list, join( '', $_a1, $_a2 );
        }
    } ## end foreach my $_a1 (@$a1)

  return @list;
} ## end sub _combine

## split string into range expressions
sub _split_expr {
    my @args = @_;
    my @found;
    foreach my $arg (@args) {
        my @parts = split( /\s*(?
        while ( my $bit = shift @parts ) {
          next unless $bit =~ m{^\S+$};
            if ( $bit =~ m{\[} and $bit !~ m{\]} ) {
                my @current = ($bit);
                while ( my $next = shift @parts ) {
                    push @current, $next;
                  last if $next =~ m{\]};
                } ## end while ( my $next = shift ...)
                push @found, join( ',', @current );
            } ## end if ( $bit =~ m{\[} and...{]})
            elsif ( $bit =~ m{\]} and $bit !~ m{\[} ) {
                my $previous = pop @found;
                push @found, join( ',', $previous, $bit );
            } ## end elsif ( $bit =~ m{\]} and...{[})
            else {
                push @found, $bit;
            }
        } ## end while ( my $bit = shift @parts)
    } ## end foreach my $arg (@args)
  return @found;
} ## end sub _split_expr

#######################
1;

__END__