X-Git-Url: http://git.shiar.net/perl/list-index.git/blobdiff_plain/2af0622fdc633320a7172164ddb9c7436e41998f..b9c565b77b8ac8f8856c6af118a1e1af5b917c24:/lib/List/Index.pm diff --git a/lib/List/Index.pm b/lib/List/Index.pm index 4ce9c25..daeb707 100644 --- a/lib/List/Index.pm +++ b/lib/List/Index.pm @@ -6,36 +6,40 @@ 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 >= $#rows ? 1 : @rows / $pages; + my $lookbehind = -$context; + my $lookahead = $context; - $pagesize = @$self / $pages; - my $offset = $pagesize + .5; - my $shrunk = 0; - my $enlarged = 0; my @links = (''); - while ($offset < @$self) { - 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; # take a value slightly before the current offset - if ((my $before = $offset - $context + $shrunk) > 0) { + 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++; } @@ -43,47 +47,49 @@ sub ranges { if ($trim < length $link) { substr($link, $trim) = ''; for (reverse $before .. $offset) { - $self->[$offset - $penalty] =~ /^\Q$link/ or last; + $rows[$offset - $penalty] =~ /^\Q$link/ or last; $penalty++; } } } - $shrunk = 0; + $lookbehind = -$context; + # take a value after the current offset - if ((my $after = $offset + $context - $enlarged) < $#$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]) { + 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; + $link = substr $rows[$after], 0, $trim; # advance lookbehind offset on the next page $penalty = 0; - for ($offset .. $#$self) { - last if $self->[$offset + $shrunk] =~ /^\Q$link/; - $shrunk++; + for ($offset .. $after) { + last if $rows[$_] =~ /^\Q$link/; + $lookbehind++; } } } - $enlarged = $penalty; + + $lookahead = $context - $penalty; } - push @links, $link; - $offset += $pagesize; + push @links, $link unless $links[-1] eq $link; } - use List::MoreUtils 'uniq'; - @links = uniq @links; + # add range end to each link for my $i (0 .. $#links - 1) { - 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; + # end at start of next value with the last character decremented + my $next = $links[$i + 1]; + $next =~ s{(.)$}{ $1 le 'a' ? '.' : chr( ord($1) - 1 ) }e; + # amend range if it's ahead + $links[$i] .= '-'.$next unless $next eq $links[$i]; } + # final value takes the rest $links[-1] .= '-'; return \@links; @@ -184,8 +190,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';