File Coverage

blib/lib/Role/TinyCommons/Collection/PickItems/RandomSeekLines.pm

Criterion	Covered	Total	%
statement	6	38	15.7
branch	0	24	0.0
condition	0	13	0.0
subroutine	2	3	66.6
pod	0	1	0.0
total	8	79	10.1

package Role::TinyCommons::Collection::PickItems::RandomSeekLines;

use Role::Tiny;
use Role::Tiny::With;

our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
our $DATE = '2024-01-16'; # DATE
our $DIST = 'Role-TinyCommons-Collection'; # DIST
our $VERSION = '0.010'; # VERSION

requires 'fh';
# optionally depended methods
# fh_min_offset
# fh_max_offset
# cmp_items

with 'Role::TinyCommons::Collection::PickItems';

sub pick_items {
    my ($self, %args) = @_;
    my $n = $args{n} || 1;
    my $allow_resampling = defined $args{allow_resampling} ? $args{allow_resampling} : 0;
    my $max_attempts = $args{max_attempts} || 10_000;

    my $fh = $self->fh;
    my $fh_min_offset = $self->can('fh_min_offset') ? $self->fh_min_offset : 0;
    my $fh_max_offset = $self->can('fh_max_offset') ? $self->fh_max_offset : undef;
    unless (defined $fh_max_offset) {
        my @st = stat($fh) or die "Can't stat filehandle: $!";
        $fh_max_offset = $st[7]-1;
    }
    #print "D:fh_min_offset=$fh_min_offset, fh_max_offset=$fh_max_offset\n";

    return () unless $fh_max_offset >= 0 && $fh_max_offset > $fh_min_offset;

    my @items;
    my %used_pos;
    my $attempts = 0;
  PICK:
    while (@items < $n) {
        if ($attempts++ > $max_attempts) {
            warn "max_attempts exceeded, only picked ".scalar(@items)." out of $n";
            last PICK;
        }

        my ($line, $pos);
      GET_RANDOM_LINE: {
            my $pos0 = int(rand($fh_max_offset-$fh_min_offset+1)) + $fh_min_offset;
            seek $fh, $pos0, 0; # XXX this is random *bytes*
            if ($pos0 > $fh_min_offset) {
                # discard partial line
                <$fh>;
            }
            $line = <$fh>;
            $pos = tell $fh;
            die "Can't tell filehandle position: $!" if $pos < 0;
            next PICK if !defined($line) || ($pos >= $fh_max_offset && $line !~ /\R\z/);
            #print "D:line=<$line>\n";
            chomp($line);
        }

        unless ($allow_resampling) {
            next if $used_pos{$pos}++;
        }
        push @items, $line;
    }
    @items;
}

1;
# ABSTRACT: Provide pick_items() that picks items by random seeking lines in a (file)handle

__END__