X-Git-Url: http://git.shiar.nl/perl/list-index.git/blobdiff_plain/e288145c227aef0ecfed7c26e135ca2bbd77c040..e2a186365224032ff37caac824d50c9b43130952:/lib/List/Index.pm diff --git a/lib/List/Index.pm b/lib/List/Index.pm index 719aca7..35f0549 100644 --- a/lib/List/Index.pm +++ b/lib/List/Index.pm @@ -6,72 +6,78 @@ use warnings; use Exporter 'import'; -our $VERSION = '1.01'; +our $VERSION = '1.02'; our @EXPORT_OK = qw(rangematch); sub new { - my ($class, $values) = @_; - bless [sort map { s/[^a-z]/./g; $_ } @$values], $class; + my ($class, $options) = @_; + $options ||= {}; + bless $options, $class; } sub ranges { my $self = shift; + my @rows = sort map { s/[^a-z]/./g; $_ } @{ shift() }; my $options = shift || {}; + $options->{$_} //= $self->{$_} for keys %$self; + my $pagesize = $options->{pagesize} || 50; my $context = $options->{context } // 1 + ($pagesize >> 4); my $length = $options->{length } || 4; - my $pages = $options->{pages } || 1 + int $#$self / $pagesize; + my $pages = $options->{pages } || 1 + int($#rows / $pagesize); - $pagesize = $pages >= $#$self ? 1 : @$self / $pages; - my $lookbehind = -$context; - my $lookahead = $context; + $pagesize = $pages >= @rows ? 1 : @rows / $pages; + my $shrunk = 0; + my $enlarged = 0; my @links = (''); - for (my $offset = $pagesize + .5; $offset < @$self; $offset += $pagesize) { - my $link = substr $self->[$offset], 0, $length; + for (my $offset = $pagesize + .5; $offset < @rows; $offset += $pagesize) { + my $link = substr $rows[$offset], 0, $length; if ($context) { - my $penalty = 0; + my $lookbehind = -$context + $shrunk; + my $lookahead = $context - $enlarged; + $shrunk = $enlarged = 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 //, $self->[$before - 1]) { + for my $match (split //, $rows[$before - 1]) { scalar $link =~ /\G\Q$match/g or last; $trim++; } # truncate link upto where the earlier value starts to differ if ($trim < length $link) { substr($link, $trim) = ''; - for (reverse $before .. $offset) { - $self->[$offset - $penalty] =~ /^\Q$link/ or last; - $penalty++; + for (reverse $before .. $offset - 1) { + $rows[$_] =~ /^\Q$link/ or last; + $enlarged++; } } } - $lookbehind = -$context; - # take a value after the current offset - if ((my $after = $offset + $lookahead) < $#$self) { + if ((my $after = $offset + $lookahead) < $#rows) { # see how much of it matches the current link my $trim = 1; - for my $match (split //, $self->[$after]) { + pos $link = 0; + for my $match (split //, $rows[$after]) { scalar $link =~ /\G\Q$match/g or last; $trim++; } # use this link if it's shorter if ($trim < length $link) { - $link = substr $self->[$after], 0, $trim; - # advance lookbehind offset on the next page - $penalty = 0; - for ($offset .. $after) { - last if $self->[$_] =~ /^\Q$link/; - $lookbehind++; + $enlarged = 0; + for ($offset + 1 .. $after) { + my $prefix = substr $rows[$_], 0, $trim; + # advance lookbehind offset on the next page + $shrunk++; + next if $link =~ /^\Q$prefix/; + $link = $prefix; + last; } } } - - $lookahead = $context - $penalty; } push @links, $link unless $links[-1] eq $link; @@ -186,8 +192,8 @@ 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}); + my $index = List::Index->new({ pagesize => 50 }); + my @pages = $index->ranges(\@values); say "$_" for @pages; use List::Index 'rangematch';