File Coverage

blib/lib/WWW/Wordnik/API.pm

Criterion	Covered	Total	%
statement	154	179	86.0
branch	49	94	52.1
condition	7	30	23.3
subroutine	29	31	93.5
pod	17	17	100.0
total	256	351	72.9

package WWW::Wordnik::API;

use warnings;
use strict;
use Carp;

use LWP::UserAgent;

use version; our $VERSION = qv('0.0.5');

use constant {
    API_VERSION  => 4,
    API_BASE_URL => 'http://api.wordnik.com',
    API_KEY      => 'YOUR KEY HERE',
    API_FORMAT   => 'json',
    CACHE        => 10,
    DEBUG        => 0,
    MODULE_NAME  => 'WWW::Wordnik::API',
    USE_JSON     => 0,
};

sub _fields {
    {   server_uri  => API_BASE_URL . q{/v} . API_VERSION,
        api_key     => API_KEY,
        version     => API_VERSION,
        format      => API_FORMAT,
        cache       => CACHE,
        debug       => DEBUG,
        _formats    => { json => 1, xml => 1, perl => 1 },
        _versions   => { 1 => 0, 2 => 0, 3 => 1, 4 => 1 },
        _cache      => { max => CACHE, requests => {}, data => [] },
        _user_agent => LWP::UserAgent->new(
            agent           => 'Perl-' . MODULE_NAME . q{/} . $VERSION,
            default_headers => HTTP::Headers->new( ':api_key' => API_KEY ),
        ),
        _json => USE_JSON,
    };
}

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

    my $self = bless( _fields(), $class );

    eval { require JSON; JSON->import() };
    $self->{_json} = 'available' unless $@;

    bless $self, $class;

    while ( my ( $key, $value ) = each %args ) {
        croak "Can't access '$key' field in class $class"
            if !exists $self->{$key}
                or $key =~ m/^_/;

        $self->$key($value);
    }

    return $self;
}

sub server_uri {
    my ( $self, $uri ) = @_;

    if ( defined $uri ) {
        $self->{server_uri} = $uri;
    }
    return $self->{server_uri};
}

sub api_key {
    my ( $self, $key ) = @_;

    if ( defined $key ) {
        $self->{_user_agent}->default_headers->header( ':api_key' => $key );
        $self->{api_key} = $key;
    }
    return $self->{api_key};
}

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

    if ( defined $version ) {
        croak "Unsupported api version: '$version'"
            unless $self->{_versions}->{$version};
        $self->{version} = $version;
    }
    return $self->{version};
}

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

    if ( defined $format ) {
        croak "Unsupported api format: '$format'"
            unless $self->{_formats}->{$format};

        $self->_json_available
            if 'perl' eq $format;

        $self->{format} = $format;
    }
    return $self->{format};
}

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

    if ( defined $cache and $cache =~ m/\d+/ ) {
        $self->{cache} = $self->{_cache}->{max} = $cache;
    }
    return $self->{cache};
}

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

    if ( defined $debug ) {
        $self->{debug} = $debug;
    }
    return $self->{debug};
}

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

    return unless $word;

    my %parameters = (
        useSuggest => { true => 0, false => 1 },
        literal    => { true => 1, false => 0 },
    );

    for ( keys %args ) {
        croak "Invalid argument key or value: '$_'"
            unless exists $parameters{$_}
                and exists $parameters{$_}->{ $args{$_} };
    }

    my $query = $word;
    $query .= "?$_=$args{$_}" for keys %args;

    return $self->_send_request( $self->_build_request( 'word', $query ) );
}

sub phrases {
    my ( $self, $word, %args ) = @_;

    return unless $word;

    my %parameters = ( count => 10 );

    for ( keys %args ) {
        croak "Invalid argument key or value: '$_'"
            unless exists $parameters{$_}
                and $args{$_} =~ m/\d+/;
    }

    my $query = "$word/phrases";
    $query .= "?$_=$args{$_}" for keys %args;

    return $self->_send_request( $self->_build_request( 'word', $query ) );
}

sub definitions {
    my ( $self, $word, %args ) = @_;

    return unless $word;

    my %parameters = (
        count        => 5,
        partOfSpeech => {
            noun         => 0,
            verb         => 0,
            adjective    => 0,
            adverb       => 0,
            idiom        => 0,
            article      => 0,
            abbreviation => 0,
            preposition  => 0,
            prefix       => 0,
            interjection => 0,
            suffix       => 0,
        }
    );

    my $query = "$word/definitions";

    for ( keys %args ) {

        if ( 'count' eq $_ ) {
            croak "Invalid argument key or value: '$_'"
                unless $args{count} =~ m/\d/;
            $query .= "?count=$args{count}";
        }
        elsif ( 'ARRAY' eq ref $args{partOfSpeech} ) {
            for my $type ( @{ $args{partOfSpeech} } ) {
                croak "Invalid argument key or value: '$type'"
                    unless exists $parameters{partOfSpeech}->{$type};
            }
            $query .= "?partOfSpeech=" . join q{,}, @{ $args{partOfSpeech} };
        }
        else {
            croak "Parameter 'partOfSpeech' requires a reference to an array";
        }
    }

    return $self->_send_request( $self->_build_request( 'word', $query ) );
}

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

    return unless $word;

    my $query = "$word/examples";

    return $self->_send_request( $self->_build_request( 'word', $query ) );
}

sub related {
    my ( $self, $word, %args ) = @_;

    return unless $word;

    my %parameters = (
        type => {
            synonym           => 0,
            antonym           => 0,
            form              => 0,
            hyponym           => 0,
            variant           => 0,
            'verb-stem'       => 0,
            'verb-form'       => 0,
            'cross-reference' => 0,
            'same-context'    => 0,
        },
        limit => 1000,
    );

    my $query = "$word/related";
    $query .= '?' if keys %args;

    if ( exists $args{type} ) {
        if ( 'ARRAY' eq ref $args{type} ) {
            for my $type ( @{ $args{type} } ) {

                croak "Invalid argument key or value: '$type'"
                    unless exists $parameters{type}->{$type};
            }
            $query .= "type=" . join q{,}, @{ $args{type} };
        }
        else {
            croak "Parameter 'type' requires a reference to an array";
        }
    }

    if ( exists $args{limit} ) {
        if ( 0 >= $args{limit} ) {
            croak "Parameter 'limit' must be a positive number";
        }
        $query .= '&' if exists $args{type};
        $query .= "limit=$args{limit}";
    }

    return $self->_send_request( $self->_build_request( 'word', $query ) );
}

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

    return unless $word;

    my $query = "$word/frequency";

    return $self->_send_request( $self->_build_request( 'word', $query ) );
}

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

    return unless $word;

    my $query = "$word/punctuationFactor";

    return $self->_send_request( $self->_build_request( 'word', $query ) );
}

sub suggest {
    my ( $self, $word, %args ) = @_;

    return unless $word;

    my %parameters = (
        count   => 10,
        startAt => 0,
    );

    for ( keys %args ) {
        croak "Invalid argument key or value: '$_'"
            unless exists $parameters{$_}
                and $args{$_} =~ m/\d+/;
    }

    my $query = "$word";
    $query .= "?$_=$args{$_}" for keys %args;

    return $self->_send_request( $self->_build_request( 'suggest', $query ) );
}

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

    return $self->_send_request( $self->_build_request('wordoftheday') );
}

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

    my %parameters = ( hasDictionaryDef => { true => 0, false => 1 }, );

    for ( keys %args ) {
        croak "Invalid argument key or value: '$_'"
            unless exists $parameters{$_}
                and exists $parameters{$_}->{ $args{$_} };
    }

    my $query = "randomWord";
    $query .= "?$_=$args{$_}" for keys %args;

    return $self->_send_request( $self->_build_request( 'words', $query ) );
}

### internal methods

sub _build_request {
    my ( $self, $namespace, $query ) = @_;

    my $request = $self->server_uri . q{/} . $namespace . q{.};
    $request .= 'perl' eq $self->format ? 'json' : $self->format;
    $request .= defined $query ? "/$query" : q{};

    return $request;
}

sub _send_request {
    my ( $self, $request ) = @_;

    return $request if $self->{debug};

    # cache
    if ( $self->cache and exists $self->{_cache}->{requests}->{$request} ) {
        return ${ $self->{_cache}->{requests}->{$request} };
    }

    # request
    else {
        my $response = $self->{_user_agent}->get($request);

        my $data = $self->_validate_response($response);

        $data = from_json($data)
            if 'perl' eq $self->format;

        return $self->_cache_data( $request, $data );
    }
}

sub _validate_response {
    my ( $self, $response ) = @_;

    return $response->decoded_content
        if $response->is_success
            or $response->is_redirect;

    croak $response->as_string
        if ( $response->is_error
        or $response->is_info );
}

sub _pop_cache {
    my ($self) = @_;
    my $c = $self->{_cache};

    return unless $c && 'ARRAY' eq ref $c->{data};
    my $oldest = pop @{ $c->{data} };

    return unless 'ARRAY' eq ref $oldest;
    my ( $request, $data ) = @{$oldest};

    delete $c->{requests}->{$request};
    return $data;
}

sub _load_cache {
    my ( $self, $request, $data ) = @_;

    my $c = $self->{_cache};
    return unless $c;

    $c->{requests}->{$request} = \$data;

    unshift @{ $c->{data} }, [ $request, $data ];

    return $data;
}

sub _cache_data {
    my ( $self, $request, $data ) = @_;

    my $c = $self->{_cache};
    return unless $c;

    $self->_pop_cache if @{ $c->{data} } >= $c->{max};

    return $self->_load_cache( $request, $data );
}

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

    croak "The operation you requested requires JSON to be installed"
        unless $self->{_json};
}
1;    # Magic true value required at end of module
__END__