X-Git-Url: http://git.shiar.net/perl/list-index.git/blobdiff_plain/cfc00067daf415f2bb92a22a307d7f840508ee54..1c9de66914ea7bf8525df6f5285b649c006477b9:/lib/List/Index.pm diff --git a/lib/List/Index.pm b/lib/List/Index.pm index 3663c24..dca0d1f 100644 --- a/lib/List/Index.pm +++ b/lib/List/Index.pm @@ -78,6 +78,7 @@ sub rangematch { my ($link) = @_; my ($s1, $s2) = $link =~ /([^-]*) - ([^-]*)/x or return qr/^\Q$link/i; + $s1 =~ s/\.$//; my @allow; if (length $s1) { @@ -88,9 +89,12 @@ sub rangematch { my $prefix = ''; my $char; for my $i (0 .. length($s1) - 1) { + my $lasti = $i == length($s1) - 1; $char = substr $s1, $i, 1; my $next = $char; - $next = chr( ord($char) + 1 ) if length $s1 > $i + 1; + # do not include prefix character in final range + $next = chr( ord($char) + 1 ) unless $lasti; + my $last = 'z'; next if $next gt $last; if (length $s2 > $i) { @@ -101,10 +105,23 @@ sub rangematch { next if $next gt $last; } } + + if ($char eq '.') { + if ($last eq 'z') { +# push @allow, $prefix if $i and $lasti; +# next; + } +# if ($last eq 'z') { +# push @allow, $prefix if $i and $lasti; +# next; +# } + $next = 'a'; + } + push @allow, $prefix."[$next-$last]"; } continue { - $prefix .= $char; + $prefix .= $char eq '.' ? '[^a-z]' : $char; } } @@ -120,11 +137,16 @@ sub rangematch { next if $c1 le $char; } } - push @allow, $prefix."(?![$char-$last])" + + if ($char eq '.') { + next if $i < length($s2) - 1; + } + + push @allow, $prefix.'(?!['.($char eq '.' ? 'a' : $char)."-$last])" if $i or $s1 eq ''; } continue { - $prefix .= $char; + $prefix .= $char eq '.' ? '[^a-z]' : $char; } push @allow, $prefix