File Coverage

blib/lib/WWW/Translate/interNOSTRUM.pm

Criterion	Covered	Total	%
statement	10	12	83.3
branch			n/a
condition			n/a
subroutine	4	4	100.0
pod			n/a
total	14	16	87.5

package WWW::Translate::interNOSTRUM;

use strict;
use warnings;
use Carp qw(carp);
use WWW::Mechanize;
use Encode;


our $VERSION = '0.13';


my %lang_pairs = (
                    'ca-es' => 'Catalan -> Spanish',   # default
                    'es-ca' => 'Spanish -> Catalan',
                    'es-va' => 'Spanish -> Catalan with Valencian forms',
                 );

my %output =     (
                    plain_text => 'txtf',  # default
                    marked_text => 'txt',
                 );

my %defaults =   (
                    lang_pair => 'ca-es',
                    output => 'plain_text',
                    store_unknown => 0,
                 );


sub new {
    my $class = shift;

    # validate overrides
    my %overrides = @_;
    foreach (keys %overrides) {
        # check key; warn if illegal
        carp "Unknown parameter: $_\n" unless exists $defaults{$_};

        # check value; warn and delete if illegal
        if ($_ eq 'output' && !exists $output{$overrides{output}}) {
            carp _message('output', $overrides{output});
            delete $overrides{output};
        }
        if ($_ eq 'lang_pair' && !exists $lang_pairs{$overrides{lang_pair}}) {
            carp _message('lang_pair', $overrides{lang_pair});
            delete $overrides{lang_pair};
        }
    }

    # replace defaults with overrides
    my %args = (%defaults, %overrides);

    # remove invalid parameters
    my @fields = keys %defaults;
    my %this;
    @this{@fields} = @args{@fields};

    if ($this{store_unknown}) {
        $this{unknown} = ();
    }

    $this{agent} = WWW::Mechanize->new();
    $this{agent}->env_proxy();
    $this{url} = 'http://www.internostrum.com/welcome.php';

    return bless(\%this, $class);
}


sub translate {
    my $self = shift;

    my $string;
    if (@_ > 0) {
        $string = shift;
    } else {
        carp "Nothing to translate\n";
        return '';
    }

    return '' if ($string eq '');

    $string = _fix_source($string);

    my $mech = $self->{agent};

    $mech->get($self->{url});
    unless ($mech->success) {
        carp $mech->response->status_line;
        return undef;
    }

    $mech->field("quadretext", $string);

    if ($self->{lang_pair} eq 'es-va') {
        $self->{lang_pair} = 'es-ca';
        $mech->tick('valen', 1);
    }
    $mech->select("direccio", $self->{lang_pair});
    $mech->select("tipus", $output{$self->{output}});

    $mech->click();

    my $response = $mech->content();

    my $translated;
    if ($response =~
        /spelling\.<\/div>\s*(.+?)<\/p>/s) {
            $translated = $1;
    } else {
        carp "Didn't receive a translation from the interNostrum server.\n" .
             "Please check the length of the source text.\n";
        return '';
    }

    # remove double spaces
    $translated =~ s/(?<=\S)\s{2}(?=\S)/ /g;

    # store unknown words
    if ($self->{store_unknown} && $self->{output} eq 'marked_text') {

        if ($translated =~ /(?:^|\W)\*/) {

            my $source_lang = substr($self->{lang_pair}, 0, 2);
            my $utf8 = decode('iso-8859-1', $translated);

            while ($utf8 =~ /(?:^|\W)\*(\w+?)\b/g) {
                my $detected = encode('iso-8859-1', $1);
                $self->{unknown}->{$source_lang}->{$detected}++;
            }
        }
    }

    return $translated;
}

sub from_into {
    my $self = shift;

    if (@_) {
        my $pair = shift;
        if (!exists $lang_pairs{$pair}) {
            carp _message('lang_pair', $pair);
            $self->{lang_pair} = $defaults{'lang_pair'};
        } else {
            $self->{lang_pair} = $pair;
        }
    } else {
        return $self->{lang_pair};
    }
}

sub output_format {
    my $self = shift;

    if (@_) {
        my $format = shift;
        $self->{output} = $format if exists $output{$format};
    } else {
        return $self->{output};
    }
}

sub get_unknown {
    my $self = shift;

    if (@_ && $self->{store_unknown}) {
        my $lang_code = shift;
        if ($lang_code =~ /^(?:es|ca)$/) {
            return $self->{unknown}->{$lang_code};
        } else {
            carp "Invalid language code\n";
        }
    } else {
        carp "I'm not configured to store unknown words\n";
    }
}

sub _message {
    my ($key, $value) = @_;

    my $string = "Invalid value for parameter $key, $value.\n" .
                 "Will use the default value instead.\n";

    return $string;
}

sub _fix_source {
    my ($string) = @_;

    # fix geminated l; replace . by chr(183) = hex B7
    $string =~ s/l\.l/l\xB7l/g;

    return $string;
}

1;

__END__