X-Git-Url: http://git.shiar.net/perl/list-index.git/blobdiff_plain/df37e7ec6afd25d57679dc37999a36887d2247ca..f201c1cafae5e0a87e562961316c7650b0e2231a:/lib/List/Index.pm diff --git a/lib/List/Index.pm b/lib/List/Index.pm index e30beef..3663c24 100644 --- a/lib/List/Index.pm +++ b/lib/List/Index.pm @@ -23,33 +23,53 @@ sub ranges { my $pages = $options->{pages } || 1 + int $#$self / $pagesize; $pagesize = @$self / $pages; - my $offset = 0; - my @links; + my $offset = $pagesize; + my @links = (''); 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]; + push @links, $link; $offset += $pagesize; } + use List::MoreUtils 'uniq'; + @links = uniq @links; for my $i (0 .. $#links - 1) { - my ($link, $lastchar) = $links[$i + 1]->[0] =~ /(.*)(.)/; - $link .= $lastchar eq 'a' ? '.' : chr( ord($lastchar) - 1 ) - unless $lastchar eq '.'; - next if $link eq $links[$i]->[0] and $i; - $links[$i]->[1] = $link; + my ($link, $lastchar) = $links[$i + 1] =~ /(.*)(.)/; + $link .= $lastchar le 'a' ? '.' : chr( ord($lastchar) - 1 ); + next if $link eq $links[$i] and $i; + $links[$i] .= '-'.$link; } - $links[-1]->[1] = ''; - $links[0]->[0] = ''; + $links[-1] .= '-'; return \@links; } @@ -72,6 +92,7 @@ sub rangematch { my $next = $char; $next = chr( ord($char) + 1 ) if length $s1 > $i + 1; my $last = 'z'; + next if $next gt $last; if (length $s2 > $i) { if ($s2 =~ /^\Q$prefix/) { $last = substr $s2, $i, 1;