File Coverage

blib/lib/File/RandomLine.pm

Criterion	Covered	Total	%
statement	54	54	100.0
branch	24	24	100.0
condition	18	18	100.0
subroutine	10	10	100.0
pod	2	2	100.0
total	108	108	100.0

use 5.006;
use strict;
use warnings;

package File::RandomLine;
# ABSTRACT: Retrieve random lines from a file
our $VERSION = '0.20'; # VERSION

use Carp;

# Required modules
use Want 'howmany';



sub new {
	my ($class, $filename, $args) = @_;
    croak "new requires a filename parameter" unless $filename;
    my $algo = $args->{algorithm} || q{};
    croak "unknown algorithm '$algo'" if $algo && $algo !~ /fast|uniform/i;
    open(my $fh, "<", $filename) or croak "Can't read $filename";
    my $line_index = lc $algo eq 'uniform' ? _index_file($fh) : undef ;
    my $filesize = -s $fh;
    my $self = {
        fh => $fh,
        line_index => $line_index,
        line_count => $line_index ? scalar @$line_index : undef,
        filesize => $filesize
    };
    return bless( $self, ref($class) ? ref($class) : $class );
}

#--------------------------------------------------------------------------#
# _index_file
#--------------------------------------------------------------------------#

sub _index_file {
    my ($fh) = @_;
    my @index;
    while (! eof $fh) {
        push @index, tell $fh;
        <$fh>;
    }
    return \@index;
}

#--------------------------------------------------------------------------#
# next()
#--------------------------------------------------------------------------#


sub next {
	my ($self,$n) = @_;
    #  behavior copied from File::Random
    if (!defined($n) and wantarray) {
        $n = howmany();
        $n ||= 1;
    }
    unless (!defined($n) or $n =~ /^\d+$/) {
        croak "Number of random_lines should be a positive integer, not '$n'";
    }
    carp "Strange call to File::Random->next(): 0 random lines requested"
        if defined($n) and $n == 0;
    $n ||= 1;
    my @sample;
    while (@sample < $n) {
        push @sample, $self->{line_index} ? $self->_uniform : $self->_fast;
    }
    chomp @sample;
    return wantarray ? @sample : shift @sample;
}


#--------------------------------------------------------------------------#
# Fast Algorithm
#--------------------------------------------------------------------------#

sub _fast {
    my $self = shift;
    my $fh = $self->{fh};
    seek($fh,int(rand($self->{filesize})),0);
    <$fh>; # skip this fragment of a line
    seek($fh,0,0) if eof $fh; # wrap if hit EOF
    return scalar <$fh>; # get the next line
}

#--------------------------------------------------------------------------#
# Uniform Algorithm
#--------------------------------------------------------------------------#

sub _uniform {
    my $self = shift;
    my $fh = $self->{fh};
    my $start = $self->{line_index}[int(rand($self->{line_count}))];
    seek($fh,$start,0);
    return scalar <$fh>; # get the next line
}

1;

__END__