# Odo.pm ovedpo15 pm #11145308 06jul22waw package Odo; use strict; use warnings; use Data::Dump qw(dd); # for debug sub Iterator (&) { return $_[0]; } # syntactic sugar per mjd (Dominus) sub odometer { my ($string, # string to permute @special_chars, # single, special characters to use in "odometer" ) = @_; # offsets in string of individual whitespace characters. my @offsets; push @offsets, $-[0] while $string =~ m{ \s }xmsg; # dd '-----', $string, \@offsets; # for debug die "too few special characters to replace all whitespace found" if @special_chars < @offsets; # minimal validation # init odo counter for each offset plus overflow flag (inited false). my @odo_offsets = ((0) x @offsets, 0); # iterator to generate each string permutation. return Iterator { # return undef if odo overflowed (iterator permanently exhausted). return if $odo_offsets[-1]; # overflow flag true my $permutation = $string; # possible string permutation # dd '+++++', \@odo_offsets; # ; # for debug # replace each whitespace char with permuted special character. substr $permutation, $offsets[$_], 1, $special_chars[$odo_offsets[$_]] for 0 .. $#offsets; # increment odometer for next permutation; flag odo overflow. $odo_offsets[$_] < $#special_chars ? ($odo_offsets[$_]++, last) : ($odo_offsets[$_] = 0) for 0 .. $#odo_offsets; # dd '_____', \@odo_offsets; ; # for debug return $permutation; }; # end path permutation Iterator } # end sub odometer() 1; #### # Odo.t 06jul22waw use strict; use warnings; use Test::More; use Test::NoWarnings; use Data::Dump qw(dd pp); BEGIN { use_ok 'Odo'; } my @Tests = ( [ '/a/b/c/d/e/fi le' => # path with whitespace to permute '/a/b/c/d/e/fi:le', # special character permutations '/a/b/c/d/e/fi;le', '/a/b/c/d/e/fi,le', '/a/b/c/d/e/fi=le', '/a/b/c/d/e/fi-le', ], [ ' /a/b/c/d/e/file' => ':/a/b/c/d/e/file', ';/a/b/c/d/e/file', ',/a/b/c/d/e/file', '=/a/b/c/d/e/file', '-/a/b/c/d/e/file', ], [ '/a/b/c/d/e/file ' => '/a/b/c/d/e/file:', '/a/b/c/d/e/file;', '/a/b/c/d/e/file,', '/a/b/c/d/e/file=', '/a/b/c/d/e/file-', ], [ '/a/b/c/d/e/fi l e' => '/a/b/c/d/e/fi:l:e', '/a/b/c/d/e/fi;l:e', '/a/b/c/d/e/fi,l:e', '/a/b/c/d/e/fi=l:e', '/a/b/c/d/e/fi-l:e', '/a/b/c/d/e/fi:l;e', '/a/b/c/d/e/fi;l;e', '/a/b/c/d/e/fi,l;e', '/a/b/c/d/e/fi=l;e', '/a/b/c/d/e/fi-l;e', '/a/b/c/d/e/fi:l,e', '/a/b/c/d/e/fi;l,e', '/a/b/c/d/e/fi,l,e', '/a/b/c/d/e/fi=l,e', '/a/b/c/d/e/fi-l,e', '/a/b/c/d/e/fi:l=e', '/a/b/c/d/e/fi;l=e', '/a/b/c/d/e/fi,l=e', '/a/b/c/d/e/fi=l=e', '/a/b/c/d/e/fi-l=e', '/a/b/c/d/e/fi:l-e', '/a/b/c/d/e/fi;l-e', '/a/b/c/d/e/fi,l-e', '/a/b/c/d/e/fi=l-e', '/a/b/c/d/e/fi-l-e', ], [ "/a/b/c/d/e/fi \tle " => '/a/b/c/d/e/fi::le:', '/a/b/c/d/e/fi;:le:', '/a/b/c/d/e/fi,:le:', '/a/b/c/d/e/fi=:le:', '/a/b/c/d/e/fi-:le:', '/a/b/c/d/e/fi:;le:', '/a/b/c/d/e/fi;;le:', '/a/b/c/d/e/fi,;le:', '/a/b/c/d/e/fi=;le:', '/a/b/c/d/e/fi-;le:', '/a/b/c/d/e/fi:,le:', '/a/b/c/d/e/fi;,le:', '/a/b/c/d/e/fi,,le:', '/a/b/c/d/e/fi=,le:', '/a/b/c/d/e/fi-,le:', '/a/b/c/d/e/fi:=le:', '/a/b/c/d/e/fi;=le:', '/a/b/c/d/e/fi,=le:', '/a/b/c/d/e/fi==le:', '/a/b/c/d/e/fi-=le:', '/a/b/c/d/e/fi:-le:', '/a/b/c/d/e/fi;-le:', '/a/b/c/d/e/fi,-le:', '/a/b/c/d/e/fi=-le:', '/a/b/c/d/e/fi--le:', '/a/b/c/d/e/fi::le;', '/a/b/c/d/e/fi;:le;', '/a/b/c/d/e/fi,:le;', '/a/b/c/d/e/fi=:le;', '/a/b/c/d/e/fi-:le;', '/a/b/c/d/e/fi:;le;', '/a/b/c/d/e/fi;;le;', '/a/b/c/d/e/fi,;le;', '/a/b/c/d/e/fi=;le;', '/a/b/c/d/e/fi-;le;', '/a/b/c/d/e/fi:,le;', '/a/b/c/d/e/fi;,le;', '/a/b/c/d/e/fi,,le;', '/a/b/c/d/e/fi=,le;', '/a/b/c/d/e/fi-,le;', '/a/b/c/d/e/fi:=le;', '/a/b/c/d/e/fi;=le;', '/a/b/c/d/e/fi,=le;', '/a/b/c/d/e/fi==le;', '/a/b/c/d/e/fi-=le;', '/a/b/c/d/e/fi:-le;', '/a/b/c/d/e/fi;-le;', '/a/b/c/d/e/fi,-le;', '/a/b/c/d/e/fi=-le;', '/a/b/c/d/e/fi--le;', '/a/b/c/d/e/fi::le,', '/a/b/c/d/e/fi;:le,', '/a/b/c/d/e/fi,:le,', '/a/b/c/d/e/fi=:le,', '/a/b/c/d/e/fi-:le,', '/a/b/c/d/e/fi:;le,', '/a/b/c/d/e/fi;;le,', '/a/b/c/d/e/fi,;le,', '/a/b/c/d/e/fi=;le,', '/a/b/c/d/e/fi-;le,', '/a/b/c/d/e/fi:,le,', '/a/b/c/d/e/fi;,le,', '/a/b/c/d/e/fi,,le,', '/a/b/c/d/e/fi=,le,', '/a/b/c/d/e/fi-,le,', '/a/b/c/d/e/fi:=le,', '/a/b/c/d/e/fi;=le,', '/a/b/c/d/e/fi,=le,', '/a/b/c/d/e/fi==le,', '/a/b/c/d/e/fi-=le,', '/a/b/c/d/e/fi:-le,', '/a/b/c/d/e/fi;-le,', '/a/b/c/d/e/fi,-le,', '/a/b/c/d/e/fi=-le,', '/a/b/c/d/e/fi--le,', '/a/b/c/d/e/fi::le=', '/a/b/c/d/e/fi;:le=', '/a/b/c/d/e/fi,:le=', '/a/b/c/d/e/fi=:le=', '/a/b/c/d/e/fi-:le=', '/a/b/c/d/e/fi:;le=', '/a/b/c/d/e/fi;;le=', '/a/b/c/d/e/fi,;le=', '/a/b/c/d/e/fi=;le=', '/a/b/c/d/e/fi-;le=', '/a/b/c/d/e/fi:,le=', '/a/b/c/d/e/fi;,le=', '/a/b/c/d/e/fi,,le=', '/a/b/c/d/e/fi=,le=', '/a/b/c/d/e/fi-,le=', '/a/b/c/d/e/fi:=le=', '/a/b/c/d/e/fi;=le=', '/a/b/c/d/e/fi,=le=', '/a/b/c/d/e/fi==le=', '/a/b/c/d/e/fi-=le=', '/a/b/c/d/e/fi:-le=', '/a/b/c/d/e/fi;-le=', '/a/b/c/d/e/fi,-le=', '/a/b/c/d/e/fi=-le=', '/a/b/c/d/e/fi--le=', '/a/b/c/d/e/fi::le-', '/a/b/c/d/e/fi;:le-', '/a/b/c/d/e/fi,:le-', '/a/b/c/d/e/fi=:le-', '/a/b/c/d/e/fi-:le-', '/a/b/c/d/e/fi:;le-', '/a/b/c/d/e/fi;;le-', '/a/b/c/d/e/fi,;le-', '/a/b/c/d/e/fi=;le-', '/a/b/c/d/e/fi-;le-', '/a/b/c/d/e/fi:,le-', '/a/b/c/d/e/fi;,le-', '/a/b/c/d/e/fi,,le-', '/a/b/c/d/e/fi=,le-', '/a/b/c/d/e/fi-,le-', '/a/b/c/d/e/fi:=le-', '/a/b/c/d/e/fi;=le-', '/a/b/c/d/e/fi,=le-', '/a/b/c/d/e/fi==le-', '/a/b/c/d/e/fi-=le-', '/a/b/c/d/e/fi:-le-', '/a/b/c/d/e/fi;-le-', '/a/b/c/d/e/fi,-le-', '/a/b/c/d/e/fi=-le-', '/a/b/c/d/e/fi--le-', ], [ "\t/a/b/c/d/e/fi\nle\f" => ':/a/b/c/d/e/fi:le:', ';/a/b/c/d/e/fi:le:', ',/a/b/c/d/e/fi:le:', '=/a/b/c/d/e/fi:le:', '-/a/b/c/d/e/fi:le:', ':/a/b/c/d/e/fi;le:', ';/a/b/c/d/e/fi;le:', ',/a/b/c/d/e/fi;le:', '=/a/b/c/d/e/fi;le:', '-/a/b/c/d/e/fi;le:', ':/a/b/c/d/e/fi,le:', ';/a/b/c/d/e/fi,le:', ',/a/b/c/d/e/fi,le:', '=/a/b/c/d/e/fi,le:', '-/a/b/c/d/e/fi,le:', ':/a/b/c/d/e/fi=le:', ';/a/b/c/d/e/fi=le:', ',/a/b/c/d/e/fi=le:', '=/a/b/c/d/e/fi=le:', '-/a/b/c/d/e/fi=le:', ':/a/b/c/d/e/fi-le:', ';/a/b/c/d/e/fi-le:', ',/a/b/c/d/e/fi-le:', '=/a/b/c/d/e/fi-le:', '-/a/b/c/d/e/fi-le:', ':/a/b/c/d/e/fi:le;', ';/a/b/c/d/e/fi:le;', ',/a/b/c/d/e/fi:le;', '=/a/b/c/d/e/fi:le;', '-/a/b/c/d/e/fi:le;', ':/a/b/c/d/e/fi;le;', ';/a/b/c/d/e/fi;le;', ',/a/b/c/d/e/fi;le;', '=/a/b/c/d/e/fi;le;', '-/a/b/c/d/e/fi;le;', ':/a/b/c/d/e/fi,le;', ';/a/b/c/d/e/fi,le;', ',/a/b/c/d/e/fi,le;', '=/a/b/c/d/e/fi,le;', '-/a/b/c/d/e/fi,le;', ':/a/b/c/d/e/fi=le;', ';/a/b/c/d/e/fi=le;', ',/a/b/c/d/e/fi=le;', '=/a/b/c/d/e/fi=le;', '-/a/b/c/d/e/fi=le;', ':/a/b/c/d/e/fi-le;', ';/a/b/c/d/e/fi-le;', ',/a/b/c/d/e/fi-le;', '=/a/b/c/d/e/fi-le;', '-/a/b/c/d/e/fi-le;', ':/a/b/c/d/e/fi:le,', ';/a/b/c/d/e/fi:le,', ',/a/b/c/d/e/fi:le,', '=/a/b/c/d/e/fi:le,', '-/a/b/c/d/e/fi:le,', ':/a/b/c/d/e/fi;le,', ';/a/b/c/d/e/fi;le,', ',/a/b/c/d/e/fi;le,', '=/a/b/c/d/e/fi;le,', '-/a/b/c/d/e/fi;le,', ':/a/b/c/d/e/fi,le,', ';/a/b/c/d/e/fi,le,', ',/a/b/c/d/e/fi,le,', '=/a/b/c/d/e/fi,le,', '-/a/b/c/d/e/fi,le,', ':/a/b/c/d/e/fi=le,', ';/a/b/c/d/e/fi=le,', ',/a/b/c/d/e/fi=le,', '=/a/b/c/d/e/fi=le,', '-/a/b/c/d/e/fi=le,', ':/a/b/c/d/e/fi-le,', ';/a/b/c/d/e/fi-le,', ',/a/b/c/d/e/fi-le,', '=/a/b/c/d/e/fi-le,', '-/a/b/c/d/e/fi-le,', ':/a/b/c/d/e/fi:le=', ';/a/b/c/d/e/fi:le=', ',/a/b/c/d/e/fi:le=', '=/a/b/c/d/e/fi:le=', '-/a/b/c/d/e/fi:le=', ':/a/b/c/d/e/fi;le=', ';/a/b/c/d/e/fi;le=', ',/a/b/c/d/e/fi;le=', '=/a/b/c/d/e/fi;le=', '-/a/b/c/d/e/fi;le=', ':/a/b/c/d/e/fi,le=', ';/a/b/c/d/e/fi,le=', ',/a/b/c/d/e/fi,le=', '=/a/b/c/d/e/fi,le=', '-/a/b/c/d/e/fi,le=', ':/a/b/c/d/e/fi=le=', ';/a/b/c/d/e/fi=le=', ',/a/b/c/d/e/fi=le=', '=/a/b/c/d/e/fi=le=', '-/a/b/c/d/e/fi=le=', ':/a/b/c/d/e/fi-le=', ';/a/b/c/d/e/fi-le=', ',/a/b/c/d/e/fi-le=', '=/a/b/c/d/e/fi-le=', '-/a/b/c/d/e/fi-le=', ':/a/b/c/d/e/fi:le-', ';/a/b/c/d/e/fi:le-', ',/a/b/c/d/e/fi:le-', '=/a/b/c/d/e/fi:le-', '-/a/b/c/d/e/fi:le-', ':/a/b/c/d/e/fi;le-', ';/a/b/c/d/e/fi;le-', ',/a/b/c/d/e/fi;le-', '=/a/b/c/d/e/fi;le-', '-/a/b/c/d/e/fi;le-', ':/a/b/c/d/e/fi,le-', ';/a/b/c/d/e/fi,le-', ',/a/b/c/d/e/fi,le-', '=/a/b/c/d/e/fi,le-', '-/a/b/c/d/e/fi,le-', ':/a/b/c/d/e/fi=le-', ';/a/b/c/d/e/fi=le-', ',/a/b/c/d/e/fi=le-', '=/a/b/c/d/e/fi=le-', '-/a/b/c/d/e/fi=le-', ':/a/b/c/d/e/fi-le-', ';/a/b/c/d/e/fi-le-', ',/a/b/c/d/e/fi-le-', '=/a/b/c/d/e/fi-le-', '-/a/b/c/d/e/fi-le-', ], ); # end array @Tests my @additional = qw(Test::NoWarnings use_ok); # each of these adds 1 test plan 'tests' => @Tests + @additional; # special characters to permute in place of whitespace for all tests. use constant SPECIAL_CHARS => (':', ';', ',', '=', '-'); # testing, testing... ###################################################### VECTOR: for my $ar_vector (@Tests) { if (not ref $ar_vector) { note $ar_vector; next VECTOR; } my ($path, @expected) = @$ar_vector; my $iter = Odo::odometer($path, SPECIAL_CHARS); my @got; while (defined(my $possible = $iter->())) { push @got, $possible; } is_deeply \@got, \@expected, pp $path; } # end for VECTOR #### Win8 Strawberry 5.8.9.5 (32) Wed 07/06/2022 21:46:31 C:\@Work\Perl\monks\ovedpo15 >perl Odo.t ok 1 - use Odo; 1..8 ok 2 - "/a/b/c/d/e/fi le" ok 3 - " /a/b/c/d/e/file" ok 4 - "/a/b/c/d/e/file " ok 5 - "/a/b/c/d/e/fi l e" ok 6 - "/a/b/c/d/e/fi \tle " ok 7 - "\t/a/b/c/d/e/fi\nle\f" ok 8 - no warnings