X-Git-Url: http://git.shiar.net/perl/list-index.git/blobdiff_plain/c6b7152b5b448744cce44c7ae52cf530c1e19bba..1c9de66914ea7bf8525df6f5285b649c006477b9:/lib/List/Index.pm?ds=sidebyside diff --git a/lib/List/Index.pm b/lib/List/Index.pm index 57027fa..dca0d1f 100644 --- a/lib/List/Index.pm +++ b/lib/List/Index.pm @@ -62,14 +62,14 @@ sub ranges { } use List::MoreUtils 'uniq'; - @links = map { [$_] } uniq @links; + @links = uniq @links; for my $i (0 .. $#links - 1) { - my ($link, $lastchar) = $links[$i + 1]->[0] =~ /(.*)(.)/; + my ($link, $lastchar) = $links[$i + 1] =~ /(.*)(.)/; $link .= $lastchar le 'a' ? '.' : chr( ord($lastchar) - 1 ); - next if $link eq $links[$i]->[0] and $i; - $links[$i]->[1] = $link; + next if $link eq $links[$i] and $i; + $links[$i] .= '-'.$link; } - $links[-1]->[1] = ''; + $links[-1] .= '-'; return \@links; } @@ -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,10 +89,14 @@ 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) { if ($s2 =~ /^\Q$prefix/) { $last = substr $s2, $i, 1; @@ -100,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; } } @@ -119,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