File Coverage

blib/lib/Lingua/Awkwords/OneOf.pm

Criterion	Covered	Total	%
statement	52	52	100.0
branch	7	8	87.5
condition	3	5	60.0
subroutine	10	10	100.0
pod	4	4	100.0
total	76	79	96.2

# -*- Perl -*-
#
# instances of this object hold a list of choices one of which is
# randomly picked upon render

package Lingua::Awkwords::OneOf;

use strict;
use warnings;

use Carp qw(croak confess);
use Math::Random::Discrete;
use Moo;
use namespace::clean;

our $VERSION = '0.08';

my $DEFAULT_WEIGHT = 1;

has filters => (
    is      => 'rwp',
    default => sub { [] },
);
has filter_with => (
    is      => 'rw',
    default => sub { '' },
);
has terms => (
    is      => 'rwp',
    default => sub { [] },
);
has picker => ( is => 'rwp', clearer => 1 );
has weights => (
    is      => 'rwp',
    default => sub { [] },
);

########################################################################
#
# METHODS

sub add_choice {
    croak "add_choice requires a value" if @_ < 2;
    my ( $self, $value, $weight ) = @_;
    push @{ $self->terms }, $value;
    push @{ $self->weights }, $weight // $DEFAULT_WEIGHT;
    $self->clear_picker;
    return $self;
}

sub add_filters { my $self = shift; push @{ $self->filters }, @_; return $self }

sub render {
    my $self = shift;
    my $str;

    my $terms = $self->terms;
    if ( !@$terms ) {
        # in theory this shouldn't happen. could also instead set the
        # empty string here...
        confess "no choices to pick from";
    } elsif ( @$terms == 1 ) {
        $str = $terms->[0]->render;
    } else {
        my $picker = $self->picker;
        if ( !defined $picker ) {
            $picker = Math::Random::Discrete->new( $self->weights, $terms );
            $self->_set_picker($picker);
        }
        $str = $picker->rand->render;
    }

    my $filter_with = $self->filter_with // '';
    for my $filter ( @{ $self->filters } ) {
        $str =~ s/\Q$filter/$filter_with/g;
    }
    return $str;
}

sub walk {
    my ($self, $callback) = @_;
    $callback->($self);
    for my $term ( @{ $self->terms } ) {
        $term->walk($callback);
    }
    return;
}

1;
__END__