File Coverage

blib/lib/WWW/WorldLingo.pm

Criterion	Covered	Total	%
statement	46	88	52.2
branch	8	32	25.0
condition	2	13	15.3
subroutine	13	20	65.0
pod	9	9	100.0
total	78	162	48.1

package WWW::WorldLingo;
use base qw( Class::Accessor::Fast );
use strict;
use warnings;
use Carp;

our $VERSION  = "0.03";

__PACKAGE__->mk_accessors(qw( server
                              response
                              mimetype encoding
                              scheme
                              subscription password
                              srclang trglang srcenc trgenc
                              dictno gloss
                              data
                              result
                              ));

use HTTP::Request::Common;
use HTTP::Response;
use LWP::UserAgent;

use constant ERROR_CODE_HEADER => "X-WL-ERRORCODE";
use constant API_MODE_HEADER   => "X-WL-API-MODE";

my %Errors = (
              0    => "Successful", # no error
              6    => "Subscription expired or suspended", # guessing here
              26   => "Incorrect password",
              28   => "Source language not in subscription",
              29   => "Target language not in subscription",
              176  => "Invalid language pair",
              177  => "No input data",
              502  => "Invalid Mime-type",
              1176 => "Translation timed out",
              );


sub new : method {
    my ( $class, $arg_hashref ) = @_;
    my $self = $class->SUPER::new({
                                   subscription =>"S000.1",
                                   password => "secret",
                                   server => "www.worldlingo.com",
                                   scheme => "http",
                                   %{$arg_hashref || {}},
                                  });
    $self;
}

sub agent : method {
    my ( $self, $agent ) = @_;
    $self->{_agent} = $agent;
    unless ( $self->{_agent} )
    {
        eval { require LWPx::ParanoidAgent; };
        my $agent_class = $@ ? "LWP::UserAgent" : "LWPx::ParanoidAgent";
        my $ua = $agent_class->new(agent => __PACKAGE__ ."/". $VERSION);
        $self->{_agent} = $ua;
    }
    return $self->{_agent};
}

sub request : method {
    my ( $self, $request ) = @_;
    $self->{_request} = $request if $request;
    $self->{_request} ||= POST $self->api, scalar $self->_arguments;
    return $self->{_request};
}

sub parse : method {
    my ( $class, $response ) = @_;
    my $self = $class->new();
    unless ( ref $response and $response->isa("HTTP::Response") )
    {
        $response = HTTP::Response->parse($response);
        carp "This " . ref($self) . " object has no memory of its original request";
    }
    $self->_handle_response($response);
    # responses remade from strings have *no* memory of a request in them
    $self->request( $self->response->request ) if $self->response->request;
    return $self;
}

sub api : method {
    my ( $self ) = @_;
    return join("://",
                $self->scheme,
                join("/",
                     $self->server,
                     $self->subscription,
                     "api")
                );
}

sub translate : method {
    my ( $self, $data ) = @_;
    $self->{_api_mode} = $self->{_error} = $self->{_error_code} = undef;
    $self->data($data) if $data;
    my $response = $self->agent->request($self->request);
#    use Data::Dumper;    warn Dumper $response;
    $self->_handle_response($response);
    return $self->result;
}

sub _handle_response {
    my ( $self, $response ) = @_;
    $self->response($response);
    $self->{_error_code} = $response->header(ERROR_CODE_HEADER);
    $self->{_api_mode} = $response->header(API_MODE_HEADER);

    if ( $response->is_success
         and $Errors{$self->{_error_code}} eq "Successful" )
    {
        eval  {
            $self->result( $response->decoded_content );
        };
        if ( $@ )
        {
            carp "Couldn't decode content with LWP library";
            $self->result( $response->content );
        }
        $self->result;
    }
    elsif ( $self->{_error_code} ) # API error
    {
        $self->{_error} = $Errors{$self->{_error_code}} || "Unknown error!";
    }
    elsif ( not $response->is_success  ) # Agent error
    {

        $self->{_error} = $response->status_line || "Unknown error!";
        $self->{_error_code} = $response->code;
    }
    else # this is logically impossible to reach
    {
        confess "Unhandled error";
    }
    return undef;
}

sub api_mode : method {
    return $_[0]->{_api_mode};
}

sub error : method {
    return $_[0]->{_error};
}

sub error_code : method {
    return $_[0]->{_error_code};
}

sub _arguments : method {
    my $self = shift;
    my @uri = ( "wl_errorstyle", 1 );

    croak "No data given to translate" unless $self->data =~ /\w/;
    croak "No srclang set" unless $self->srclang;
    croak "No trglang set" unless $self->trglang;

    for my $arg ( qw( password srclang trglang mimetype srcenc trgenc
                      data dictno gloss) )
    {
        next unless $self->$arg;
        push @uri, "wl_$arg", $self->$arg(); # arg pairs for HRC::POST
    }
    return wantarray ? @uri : \@uri; # HRC::POST handles encoding args
}


1;

__END__