X-Git-Url: http://git.shiar.net/perl/list-index.git/blobdiff_plain/f467842b8e311a78d9900c4626583fc08a8ce31b..86ab9954f77afe10ac66767d3d79bf2ce51a314d:/lib/List/Index.pm diff --git a/lib/List/Index.pm b/lib/List/Index.pm index 483d1eb..e56d771 100644 --- a/lib/List/Index.pm +++ b/lib/List/Index.pm @@ -22,47 +22,61 @@ sub ranges { my $length = $options->{length } || 4; my $pages = $options->{pages } || 1 + int $#$self / $pagesize; - $pagesize = @$self / $pages; - my $offset = $pagesize + .5; + $pagesize = $pages >= $#$self ? 1 : @$self / $pages; + my $lookbehind = -$context; + my $lookahead = $context; + my @links = (''); - while ($offset < @$self) { + for (my $offset = $pagesize + .5; $offset < @$self; $offset += $pagesize) { my $link = substr $self->[$offset], 0, $length; if ($context) { - { - # take a value slightly before the current offset - my $before = $offset > $context ? $self->[$offset - $context] : '.'; + my $penalty = 0; + # take a value slightly before the current offset + if ((my $before = $offset + $lookbehind) > 0) { # see how much of it matches the current link my $trim = 1; - for my $match (split //, $before) { + for my $match (split //, $self->[$before - 1]) { 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 ($trim < length $link) { + substr($link, $trim) = ''; + for (reverse $before .. $offset) { + $self->[$offset - $penalty] =~ /^\Q$link/ or last; + $penalty++; + } + } } - if ($offset + $context < $#$self) { - # take a value after the current offset - my $after = $self->[$offset + $context]; + $lookbehind = -$context; + + # take a value after the current offset + if ((my $after = $offset + $lookahead) < $#$self) { # see how much of it matches the current link my $trim = 1; - for my $match (split //, $after) { + for my $match (split //, $self->[$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; + $link = substr $self->[$after], 0, $trim; + # advance lookbehind offset on the next page + $penalty = 0; + for ($offset .. $after) { + last if $self->[$_] =~ /^\Q$link/; + $lookbehind++; + } } } + + $lookahead = $context - $penalty; } - push @links, $link; - $offset += $pagesize; + push @links, $link unless $links[-1] eq $link; } - use List::MoreUtils 'uniq'; - @links = uniq @links; for my $i (0 .. $#links - 1) { my ($link, $lastchar) = $links[$i + 1] =~ /(.*)(.)/; $link .= $lastchar le 'a' ? '.' : chr( ord($lastchar) - 1 ); @@ -164,18 +178,18 @@ __END__ =head1 NAME -List::Index - Paginate alphabetic entries by finding minimal prefixes +List::Index - Find and apply prefix ranges to paginate keywords =head1 SYNOPSIS use List::Index; my $index = List::Index->new(\@values); my @pages = $index->ranges({pagesize => 50}); - printf '%1$s ', @$_ for @pages; + say "$_" for @pages; use List::Index 'rangematch'; - my $limit = rangematch('b-bmq'); # matches prefix like 'baa'..'bmq' - @results = grep { $limit } @results; + my $limit = rangematch('b-bmq'); # ge 'b' && le 'bmq' + @request = grep { $limit } @values; =head1 DESCRIPTION