X-Git-Url: http://git.shiar.net/perl/list-index.git/blobdiff_plain/0f46a9fa54c9ecca0f0c3180b51f7c3079d048a8..f467842b8e311a78d9900c4626583fc08a8ce31b:/lib/List/Index.pm diff --git a/lib/List/Index.pm b/lib/List/Index.pm index ea7b433..483d1eb 100644 --- a/lib/List/Index.pm +++ b/lib/List/Index.pm @@ -23,7 +23,7 @@ sub ranges { my $pages = $options->{pages } || 1 + int $#$self / $pagesize; $pagesize = @$self / $pages; - my $offset = $pagesize; + my $offset = $pagesize + .5; my @links = (''); while ($offset < @$self) { my $link = substr $self->[$offset], 0, $length; @@ -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