File Coverage

blib/lib/WordList/DBI.pm

Criterion	Covered	Total	%
statement	26	35	74.2
branch	3	8	37.5
condition			n/a
subroutine	8	8	100.0
pod	4	4	100.0
total	41	55	74.5

package WordList::DBI;

our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
our $DATE = '2020-06-01'; # DATE
our $DIST = 'WordList-DBI'; # DIST
our $VERSION = '0.002'; # VERSION

use strict;
use warnings;
use parent qw(WordList);

our $NO_STATS = 1;
our $SORT = 'custom';
our $DYNAMIC = 2; # it can be 1 or 2, depending on the query

our %PARAMS = (
    dbh => {
        summary => 'Either dbh or dsn+user+password need to be specified',
        schema => 'obj*',
    },
    dsn => {
        summary => 'Either dbh or dsn+user+password need to be specified',
        schema => 'str*',
    },
    user => {
        summary => 'Either dbh or dsn+user+password need to be specified',
        schema => 'obj*',
    },
    password => {
        summary => 'Either dbh or dsn+user+password need to be specified',
        schema => 'str*',
    },
    query => {
        schema => 'str*',
        req => 1,
    },
    query_pick => {
        schema => 'str*',
    },
);

sub _connect {
    my $self = shift;
    if ($self->{params}{dbh}) {
        $self->{_dbh} = $self->{params}{dbh};
    } else {
        require DBI;
        $self->{_dbh} = DBI->connect(
            $self->{params}{dsn},
            $self->{params}{user}, $self->{params}{password},
            {RaiseError=>1});
    }
}

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

sub reset_iterator {
    my $self = shift;
    $self->{_sth} = $self->{_dbh}->prepare($self->{params}{query});
    $self->{_sth}->execute;
}

sub next_word {
    my $self = shift;
    my ($word) = $self->{_sth}->fetchrow_array;
    $word;
}

sub pick {
    my ($self, $num, $allow_duplicates) = @_;
    $num = 1 unless defined $num;
    unless (defined $self->{query_pick}) {
        return $self->SUPER::pick($num, $allow_duplicates);
    }
    my $sth = $self->{_dbh}->prepare($self->{params}{query_pick});
    $sth->execute;
    my @words;
    while (defined(my ($word) = $sth->fetchrow_array)) {
        push @words, $word;
        last if @words >= $num;
    }
    @words;
}

1;
# ABSTRACT: Wordlist that get its list from a DBI query

__END__