File Coverage

blib/lib/WordList.pm

Criterion	Covered	Total	%
statement	71	72	98.6
branch	21	26	80.7
condition	3	3	100.0
subroutine	15	15	100.0
pod	8	8	100.0
total	118	124	95.1

package WordList;

our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
our $DATE = '2021-02-23'; # DATE
our $DIST = 'WordList'; # DIST
our $VERSION = '0.7.8'; # VERSION

use strict 'subs', 'vars';

use WordListBase ();
our @ISA = qw(WordListBase);

# IFUNBUILT
# use Role::Tiny::With;
# with 'WordListRole::WordList';
# END IFUNBUILT

sub new {
    my $class = shift;
    my $self = $class->SUPER::new(@_);

    my $fh = \*{"$class\::DATA"};
    binmode $fh, "encoding(utf8)";
    my $fh_orig_pos = tell $fh;
    unless (defined ${"$class\::DATA_POS"}) {
        ${"$class\::DATA_POS"} = $fh_orig_pos;
    }

    $self->{fh} = $fh;
    $self->{fh_orig_pos} = $fh_orig_pos;
    $self->{fh_seekable} = 1;
    $self;
}

sub each_word {
    my ($self, $code) = @_;

    my $i = 0;
    while (1) {
        my $word = $i++ ? $self->next_word : $self->first_word;
        last unless defined $word;
        my $res = $code->($word);
        last if defined $res && $res == -2;
    }
}

sub next_word {
    my $self = shift;

    my $fh = $self->{fh};
    my $word = <$fh>;
    chomp $word if defined $word;
    $word;
}

sub reset_iterator {
    my $self = shift;

    die "Cannot reset iterator, filehandle not seekable"
        unless $self->{fh_seekable};
    my $fh = $self->{fh};
    seek $fh, $self->{fh_orig_pos}, 0;
}

sub first_word {
    my $self = shift;

    $self->reset_iterator;
    $self->next_word;
}

sub pick {
    my ($self, $n, $allow_duplicates) = @_; # but this implementaiton never produces duplicates

    $n = 1 if !defined $n;
    die "Please specify a positive number of words to pick" if $n < 1;

    if ($n == 1) {
        my $i = 0;
        my $word;
        # algorithm from Learning Perl
        $self->each_word(
            sub {
                $i++;
                $word = $_[0] if rand($i) < 1;
            }
        );
        return $word;
    }

    my $i = 0;
    my @words;
    $self->each_word(
        sub {
            $i++;
            if (@words < $n) {
                # we haven't reached $n, put word to result in a random position
                splice @words, rand(@words+1), 0, $_[0];
            } else {
                # we have reached $n, just replace a word randomly, using
                # algorithm from Learning Perl, slightly modified
                rand($i) < @words and splice @words, rand(@words), 1, $_[0];
            }
        }
    );
    @words;
}

sub word_exists {
    my ($self, $word) = @_;

    my $found = 0;
    $self->each_word(
        sub {
            if ($word eq $_[0]) {
                $found = 1;
                return -2;
            }
        }
    );
    $found;
}

sub all_words {
    my ($self) = @_;

    my @words;
    $self->each_word(
        sub {
            push @words, $_[0];
        }
    );
    @words;
}

1;
# ABSTRACT: Specification and base class for WordList::*, modules that contain word list

__END__