File Coverage

blib/lib/String/Glob/Permute.pm

Criterion	Covered	Total	%
statement	34	42	80.9
branch	12	16	75.0
condition	2	3	66.6
subroutine	3	3	100.0
pod	0	1	0.0
total	51	65	78.4

# Copyright (c) 2008 Yahoo! Inc. All rights reserved. The copyrights to
# the contents of this file are licensed under the Perl Artistic License
# (ver. 15 Aug 1997).
###########################################
package String::Glob::Permute;
###########################################

use strict;
use warnings;
require Exporter;
our @ISA       = qw(Exporter);
our @EXPORT_OK = qw(string_glob_permute);
our $VERSION   = "0.01";

###########################################
sub string_glob_permute {
###########################################
    my( $string_glob ) = @_;

    my @stringlist;
    my @patterns = ($string_glob);

    while (@patterns) {

	my $h = shift(@patterns);

	if ($h =~ /^(.*?)\[([^\]]+)\]([^,{[]*)(,(.*))?$/) {
	    my($pre,$post) = ($1,$3);

	    my @r = split(/,/,$2);

	    for (@r) {

		if (/^(!?)(\d+)(-(\d+))?$/) {
		    my $lo = $2;
		    my $hi = $3 ? $4 : $lo;
                    my $fmt = "%d";

                      # Expand [09-11] to ("09", "10", "11") instead of
                      # ("9", "10", "11").
                    if (length($lo) == length($hi) && length($lo) > 1) {
                        $fmt = "%0" . length($lo) . "d";
                    }

		    for (my $n = $lo; $n <= $hi; $n++) {
			my $hn = $pre . sprintf($fmt, $n) . $post;

			if ($1) {
			    @stringlist = grep { $_ ne $hn } @stringlist;
			    @patterns = grep { $_ ne $hn } @patterns;
			} else {
			    push(@patterns,$hn);
			}
		    }
		} else {
		    warn("Unrecognized host pattern: $h");
                    return undef;
		}
	    }

	    if ($4) {
		push(@patterns,$5);
	    }

	} elsif ($h =~ /^(.*?)\{([^\}]+)\}([^,[{]*)(,(.*))?$/) {

	    my($pre,$post) = ($1,$3);
	    my @r = split(/,/,$2);

	    for (@r) {
		push(@patterns,$pre.$_.$post);
	    }

	    if ($4) {
		push(@patterns,$5);
	    }
	} else {
	    my @h = split(/,/,$h);
	    push(@stringlist,@h);
	}
    }
    return @stringlist;
}

1;

__END__