File Coverage

blib/lib/Word/Rhymes.pm

Criterion	Covered	Total	%
statement	145	169	85.8
branch	86	100	86.0
condition	31	37	83.7
subroutine	20	22	90.9
pod	11	11	100.0
total	293	339	86.4

package Word::Rhymes;

use strict;
use warnings;

our $VERSION = '1.04';

use Carp qw(croak);
use HTTP::Request;
use JSON;
use LWP::UserAgent;

use constant {
    # Core
    MIN_SCORE           => 0,
    MAX_SCORE           => 1000000,
    MIN_RESULTS         => 1,
    MAX_RESULTS         => 1000,
    MIN_SYLLABLES       => 1,
    MAX_SYLLABLES       => 100,
    MULTI_WORD          => 0,
    RETURN_RAW          => 0,
    MIN_LIMIT           => 1,
    MAX_LIMIT           => 1000,

    # print() related
    MAX_NUM_COLS        => 8,
    MIN_NUM_COLS        => 7,
    COL_DIVIDER         => 15,
    COL_PADDING         => 3,
    ROW_INDENT          => '    ',

    # Sort by
    SORT_BY_SCORE_DESC  => 0x00, # Default
    SORT_BY_SCORE_ASC   => 0x01,
    SORT_BY_ALPHA_DESC  => 0x02,
    SORT_BY_ALPHA_ASC   => 0x03,

};

my $ua = LWP::UserAgent->new;

# Public

sub new {
    my ($class, %args) = @_;

    my $self = bless {}, $class;

    $self->_args(\%args);

    return $self;
}
sub fetch {
    my ($self, $word, $context) = @_;

    if (! defined $word) {
        croak("fetch() needs a word sent in");
    }

    if (defined $context && $context !~ /^\w+$/) {
        croak("context parameter must be an alpha word only.");
    }

    my ($req, $response);

    if (! $self->file) {
        $req = HTTP::Request->new('GET', $self->_uri($word, $context));
        $response = $ua->request($req);
    }

    if ($self->file || $response->is_success) {

        my $json;

        if ($self->file) {
            {
                local $/;
                open my $fh, '<', $self->file or croak(
                    sprintf("Can't open the data file '%s': $!", $self->file)
                );
                $json = <$fh>;
                close $fh;
            }
        }
        else {
            $json = $response->decoded_content;
        }

        my $result = decode_json $json;

        return $result if $self->return_raw;

        return $self->_process($result);
    }
    else {
        print "Invalid response\n\n";
        return undef;
    }
}
sub file {
    my ($self, $file) = @_;

    if (defined $file) {
        croak("File '$file' does not exist") if ! -e $file;
        croak("File '$file' is not a valid file") if ! -f $file;
        $self->{file} = $file;
    }

    return $self->{file} // '';
}
sub limit {
    my ($self, $limit) = @_;

    if (defined $limit) {
        croak("limit must be an integer") if $limit !~ /^\d+$/;
        if ($limit < MIN_LIMIT || $limit > MAX_LIMIT) {
            croak(
                sprintf(
                    "limit must be between %d and %d",
                    MIN_LIMIT,
                    MAX_LIMIT
                )
            );
        }
        $self->{limit} = $limit;
    }

    return $self->{limit} // MAX_LIMIT;
}
sub max_results {
    my ($self, $max) = @_;

    if (defined $max) {
        croak("max_results must be an integer") if $max !~ /^\d+$/;
        if ($max < MIN_RESULTS || $max > MAX_RESULTS) {
            croak(
                sprintf(
                    "max_results must be between %d and %d",
                    MIN_RESULTS,
                    MAX_RESULTS
                )
            );
        }
        $self->{max_results} = $max;
    }

    return $self->{max_results} // MAX_RESULTS;
}
sub min_score {
    my ($self, $min) = @_;

    if (defined $min) {
        croak("min_score must be an integer") if $min !~ /^-?\d+$/;
        if ($min < MIN_SCORE || $min > MAX_SCORE) {
            croak(
                sprintf(
                    "min_score must be between %d and %d",
                    MIN_SCORE,
                    MAX_SCORE
                )
            );
        }
        $self->{min_score} = $min;
    }

    return $self->{min_score} // MIN_SCORE;
}
sub min_syllables {
    my ($self, $min) = @_;

    if (defined $min) {
        croak("min_syllables must be an integer") if $min !~ /^-?\d+$/;
        if ($min < MIN_SYLLABLES || $min > MAX_SYLLABLES) {
            croak(
                sprintf(
                    "min_syllables must be between %d and %d",
                    MIN_SYLLABLES,
                    MAX_SYLLABLES
                )
            );
        }
        $self->{min_syllables} = $min;
    }

    return $self->{min_syllables} // MIN_SYLLABLES;
}
sub multi_word {
    my ($self, $bool) = @_;

    if (defined $bool) {
        $self->{multi_word} = $bool;
    }

    return $self->{multi_word} // MULTI_WORD;
}
sub print {
    my ($self, $word, $context) = @_;

    my $rhyming_words = $self->fetch($word, $context);

    print defined $context
        ? "\nRhymes with '$word' related to '$context'\n"
        : "\nRhymes with '$word'\n";

    for my $num_syl (reverse sort keys %$rhyming_words) {
        my $max_word_len = length(
            (sort {length $b->{word} <=> length $a->{word}} @{ $rhyming_words->{$num_syl} })[0]->{word}
        );

        my $column_width = $max_word_len + COL_PADDING;
        my $columns = $column_width > COL_DIVIDER ? MIN_NUM_COLS : MAX_NUM_COLS;

        printf "\nSyllables: $num_syl\n\n%s", ROW_INDENT;

        for (0 .. $#{ $rhyming_words->{$num_syl} }) {
            printf "\n%s", ROW_INDENT if $_ % $columns == 0 && $_ != 0;
            printf("%-*s", $column_width, $rhyming_words->{$num_syl}[$_]->{word});
        }
        print "\n";
    }

    return 0;
}
sub return_raw {
    my ($self, $ret) = @_;

    if (defined $ret) {
        $self->{return_raw} = $ret;
    }

    return $self->{return_raw} // RETURN_RAW;
}
sub sort_by {
    my ($self, $sort_by) = @_;

    if (defined $sort_by) {
        if (! grep /^$sort_by$/, qw(score_desc score_asc alpha_desc alpha_asc)) {
            croak("sort() needs 'score_desc', 'score_asc', 'alpha_desc' or 'alpha_asc' as param");
        }

        if ($sort_by =~ /^alpha/) {
            $self->{sort_by} =  $sort_by =~ /desc/
                ? SORT_BY_ALPHA_DESC
                : SORT_BY_ALPHA_ASC;
        }
        elsif ($sort_by =~ /^score/) {
            $self->{sort_by} = $sort_by =~ /desc/
                ? SORT_BY_SCORE_DESC
                : SORT_BY_SCORE_ASC;
        }
    }

    return $self->{sort_by} // SORT_BY_SCORE_DESC;
}

# Private

sub _args {
    my ($self, $args) = @_;

    # file
    $self->file($args->{file}) if exists $args->{file};

    # limit
    $self->limit($args->{limit}) if exists $args->{limit};

    # max_results
    $self->max_results($args->{max_results}) if exists $args->{max_results};

    # min_score
    $self->min_score($args->{min_score}) if exists $args->{min_score};

    # min_syllables
    $self->min_syllables($args->{min_syllables}) if exists $args->{min_syllables};

    # multi_word
    $self->multi_word($args->{multi_word}) if exists $args->{multi_word};

    # return_raw
    $self->return_raw($args->{return_raw}) if exists $args->{return_raw};

    # sort_by
    $self->sort_by($args->{sort_by}) if exists $args->{sort_by};
}
sub _process {
    my ($self, $result) = @_;

    my @data;

    # Dump rhyming words that don't have a score or are multi-word
    if ($self->multi_word) {
        @data = grep { $_->{score} } @$result;
    }
    else {
        @data = grep { $_->{score} && $_->{word} !~ /\s+/ } @$result;
    }

    # Dump rhyming words that are outside of min_syllables threshold
    @data = grep { $_->{numSyllables} >= $self->min_syllables } @data;

    my @sorted = sort {$b->{numSyllables} <=> $a->{numSyllables}} @data;
    my %organized;

    for (@sorted) {
        push @{ $organized{$_->{numSyllables}} }, $_ if $_->{score} >= $self->min_score;
    }

    for (keys %organized) {
        if ($self->sort_by == SORT_BY_ALPHA_DESC) {
            @{ $organized{$_} } = sort {$b->{word} cmp $a->{word}} @{ $organized{$_} };
        }
        elsif ($self->sort_by == SORT_BY_ALPHA_ASC) {
            @{ $organized{$_} } = sort {$a->{word} cmp $b->{word}} @{ $organized{$_} };
        }
        elsif ($self->sort_by == SORT_BY_SCORE_DESC) {
            @{ $organized{$_} } = sort {$b->{score} <=> $a->{score}} @{ $organized{$_} };
        }
        elsif ($self->sort_by == SORT_BY_SCORE_ASC) {
            @{ $organized{$_} } = sort {$a->{score} <=> $b->{score}} @{ $organized{$_} };
        }
    }

    # Limit the result count in each syllable href

    for (keys %organized) {
        next if scalar @{ $organized{$_} } <= $self->limit;
        @{ $organized{$_} } = @{ $organized{$_} }[0..$self->limit -1];
    }

    return \%organized;

}
sub _uri {
    my ($self, $word, $context) = @_;

    my $uri;

    if (defined $context) {
        $uri = sprintf(
            "http://api.datamuse.com/words?max=%d&ml=%s&rel_rhy=%s",
            $self->max_results,
            $context,
            $word
        );
    }
    else {
        $uri = sprintf(
            "http://api.datamuse.com/words?max=%d&rel_rhy=%s",
            $self->max_results,
            $word
        );
    }

    return $uri;
}
sub __placeholder {}

1;
__END__