X-Git-Url: http://git.shiar.net/perl/list-index.git/blobdiff_plain/20b084d596ff3d71a76dbc55a9f458911b4b8415..0f46a9fa54c9ecca0f0c3180b51f7c3079d048a8:/lib/List/Index.pm diff --git a/lib/List/Index.pm b/lib/List/Index.pm index 574613e..ea7b433 100644 --- a/lib/List/Index.pm +++ b/lib/List/Index.pm @@ -23,36 +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) { - # 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++; + { + # 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; + } } - # truncate link upto where the earlier value starts to differ - 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; }