X-Git-Url: http://git.shiar.net/gitweb.cgi/perl/list-index.git/blobdiff_plain/0433a4eb785409f46a2d61e668fda84bd87c3148..ab9917512865cf7070b364a1b0f07f32a3b49e3f:/lib/List/Index.pm diff --git a/lib/List/Index.pm b/lib/List/Index.pm index 7214ced..47ef0da 100644 --- a/lib/List/Index.pm +++ b/lib/List/Index.pm @@ -28,13 +28,33 @@ sub ranges { while ($offset < @$self) { my $link = substr $self->[$offset], 0, $length; if ($context) { - my $trim = 1; - my $before = $offset > $context ? $self->[$offset - $context] : ''; - for my $match (split //, $before) { - scalar $link =~ /\G\Q$match/g or last; - $trim++; + { + # take a value slightly before the current offset + my $before = $offset > $context ? $self->[$offset - $context] : '.'; + # see how much of it matches the current link + my $trim = 1; + for my $match (split //, $before) { + scalar $link =~ /\G\Q$match/g or last; + $trim++; + } + # truncate link upto where the earlier value starts to differ + substr($link, $trim) = '' unless $trim > length $link; + } + + if ($offset + $context < $#$self) { + # take a value after the current offset + my $after = $self->[$offset + $context]; + # see how much of it matches the current link + my $trim = 1; + for my $match (split //, $after) { + scalar $link =~ /\G\Q$match/g or last; + $trim++; + } + # use this link if it's shorter + if ($trim < length $link) { + $link = substr $after, 0, $trim; + } } - substr($link, $trim) = '' unless $trim > length $link; } push @links, [$link]; @@ -43,11 +63,13 @@ sub ranges { for my $i (0 .. $#links - 1) { my ($link, $lastchar) = $links[$i + 1]->[0] =~ /(.*)(.)/; - $link .= $lastchar eq '.' ? 'z' : chr( ord($lastchar) - 1 ) - unless $lastchar eq 'a'; + $link .= $lastchar eq 'a' ? '.' : chr( ord($lastchar) - 1 ) + unless $lastchar eq '.'; + next if $link eq $links[$i]->[0] and $i; $links[$i]->[1] = $link; } $links[-1]->[1] = ''; + $links[0]->[0] = ''; return \@links; } @@ -59,6 +81,10 @@ sub rangematch { my @allow; if (length $s1) { + if (length $s2) { + $s1 le $s2 or $s1 =~ /^\Q$s2/ or return undef; + } + my $prefix = ''; my $char; for my $i (0 .. length($s1) - 1) {