File Coverage

blib/lib/PLN/PT.pm

Criterion	Covered	Total	%
statement	82	95	86.3
branch	8	16	50.0
condition	2	6	33.3
subroutine	17	19	89.4
pod	7	7	100.0
total	116	143	81.1

package PLN::PT;
# ABSTRACT: interface for the http://pln.pt web service
$PLN::PT::VERSION = '0.007';
use strict;
use warnings;

use JSON::XS;
use CHI;
use Digest::MD5 qw/md5_base64/;
use LWP::UserAgent;
use Encode;
use utf8::all;

sub new {
  my ($class, $url) = @_;
  my $self = bless( {url=>$url}, $class);

  $self->{ua} = LWP::UserAgent->new;
  $self->{cache} = CHI->new( driver => 'Memory', global => 1 );

  return $self;
}

sub tokenizer {
  my ($self, $text, $opts) = @_;

  my $url = $self->_cat('tokenizer');
  $url .= '?' . $self->_args($opts);

  return $self->_post($url, $text, $opts);
}

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

  $word =~ s/\// /g; # make it sane, if someone tries to go guessing

  my $url = $self->_cat('morph_analyzer', $word);
  $url .= '?' . $self->_args($opts);

  return $self->_get($url, $opts);
}

sub tagger {
  my ($self, $text, $opts) = @_;

  my $url = $self->_cat('tagger');
  $url .= '?' . $self->_args($opts);

  return $self->_post($url, $text, $opts);
}

sub dep_parser {
  my ($self, $text, $opts) = @_;

  my $url = $self->_cat('dep_parser');
  $url .= '?' . $self->_args($opts);

  return $self->_post($url, $text, $opts);
}

sub tf {
  my ($self, $text, $opts) = @_;

  my $url = $self->_cat('tf');
  $url .= '?' . $self->_args($opts);

  return $self->_post($url, $text, $opts);
}

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

  my $url = $self->_cat('stopwords');
  $url .= '?' . $self->_args($opts);

  return $self->_get($url, $opts);
}

sub _post {
  my ($self, $url, $text, $opts) = @_;

  my $key = $url . '-' . md5_base64(Encode::encode_utf8($text));
  my $data = $self->{cache}->get($key);

  unless ($data) {
    my $req = HTTP::Request->new(POST => $url);
    $req->header('Content-Type', 'text/html; charset=UTF-8');
    $req->content(Encode::encode_utf8($text));

    my $res = $self->{ua}->request($req);
    if ($res->is_success) {
      $data = $res->decoded_content;
      $data = $res->content unless $data;
      $data = Encode::decode_utf8($data);
      $self->{cache}->set($key, $data);
    }
    else {
      print STDERR "HTTP POST error: ", $res->code, " - ", $res->message, "\n";
      return undef;
    }
  }

  return $data if ($opts->{output} and $opts->{output} eq 'raw');
  return JSON::XS->new->decode($data);
}

sub _get {
  my ($self, $url, $opts) = @_;

  my $key = $url . '-' . md5_base64(join('', values %$opts));
  my $data = $self->{cache}->get($key);

  unless ($data) {
    my $req = HTTP::Request->new(GET => $url);

    my $res = $self->{ua}->request($req);
    if ($res->is_success) {
      $data = $res->decoded_content;
      $data = $res->content unless $data;
      $data = Encode::decode_utf8($data);
      $self->{cache}->set($key, $data);
    }
    else {
      print STDERR "HTTP GET error: ", $res->code, " - ", $res->message, "\n";
      return undef;
    }
  }

  return $data if ($opts->{output} and $opts->{output} eq 'raw');
  return JSON::XS->new->decode($data);
}

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

  my @parts = ($self->{url});
  push @parts, @args;

  return join('/', @parts);
}

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

  my @args;
  foreach (keys %$opts) {
    push @args, join('=', $_, $opts->{$_});
  }

  return join('&', @args);
}

1;

__END__