File Coverage

blib/lib/WWW/Correios/PrecoPrazo.pm

Criterion	Covered	Total	%
statement	70	70	100.0
branch	14	18	77.7
condition	11	12	91.6
subroutine	12	12	100.0
pod	3	3	100.0
total	110	115	95.6

package WWW::Correios::PrecoPrazo;

use strict;
use warnings;

use Const::Fast;
use URI;
use URI::Escape;

our $VERSION = 0.32;

const my %INPUT_KEYS => (
    'codigo_empresa'    => 'nCdEmpresa',
    'senha'             => 'sDsSenha',
    'codigo_servico'    => 'nCdServico',
    'cep_origem'        => 'sCepOrigem',
    'cep_destino'       => 'sCepDestino',
    'peso'              => 'nVlPeso',
    'formato'           => 'nCdFormato',
    'comprimento'       => 'nVlComprimento',
    'altura'            => 'nVlAltura',
    'largura'           => 'nVlLargura',
    'diametro'          => 'nVlDiametro',
    'mao_propria'       => 'sCdMaoPropria',
    'valor_declarado'   => 'nVlValorDeclarado',
    'aviso_recebimento' => 'sCdAvisoRecebimento',
    'formato_retorno'   => 'StrRetorno',
);

const my @REQUIRED => qw( codigo_servico cep_origem cep_destino );

const my %OUTPUT_KEYS => (
    'EntregaDomiciliar'     => 'entrega_domiciliar',
    'Erro'                  => 'erro',
    'Valor'                 => 'valor',
    'MsgErro'               => 'msg_erro',
    'ValorMaoPropria'       => 'valor_mao_propria',
    'PrazoEntrega'          => 'prazo_entrega',
    'Codigo'                => 'codigo_servico',
    'ValorValorDeclarado'   => 'valor_declarado',
    'ValorAvisoRecebimento' => 'valor_aviso_recebimento',
    'EntregaSabado'         => 'entrega_sabado',
);

const my %DEFAULTS => (
    'codigo_empresa'    => '',
    'senha'             => '',
    'codigo_servico'    => '40010',
    'cep_origem'        => '',
    'cep_destino'       => '',
    'peso'              => 0.1,
    'formato'           => 'caixa',
    'comprimento'       => 16,
    'altura'            => 2,
    'largura'           => 11,
    'diametro'          => 5,
    'mao_propria'       => 'N',
    'valor_declarado'   => '0',
    'aviso_recebimento' => 'N',
    'formato_retorno'   => 'XML',
);

const my %PACKAGING_FORMATS => (
    'caixa'    => 1,
    'pacote'   => 1,
    'rolo'     => 2,
    'prisma'   => 2,
    'envelope' => 3,
);

sub new {
    my $class = shift;
    my %args  = ref $_[0] ? %{ $_[0] } : @_;

    my $uri = URI->new;
    $uri->scheme( $args{scheme} || 'http' );
    $uri->host( $args{host}     || 'ws.correios.com.br' );
    $uri->path( $args{path}     || '/calculador/CalcPrecoPrazo.aspx' );

    delete @args{qw{scheme host path}};

    my $atts = {
        user_agent => _init_user_agent(\%args),
        base_uri   => $uri,
    };

    return bless $atts, $class;
}

sub query_multi {
    my ($res, $parsed_response) = _query(@_);
    return $parsed_response;
}

sub query {
    my ($res, $parsed_response) = _query(@_);
    return { %{$parsed_response->[0]}, response => $res };
}

sub _query {
    my $self = shift;
    my $args = ref $_[0] ? $_[0] : {@_};

    return (undef, [{}])
        unless scalar(grep exists $args->{$_}, @REQUIRED) == @REQUIRED;

    $args->{cep_origem}  =~ s/-//;
    $args->{cep_destino} =~ s/-//;

    my $params = {
        map { $INPUT_KEYS{$_} => $args->{$_} || $DEFAULTS{$_} }
          keys %INPUT_KEYS
    };

    $params->{ $INPUT_KEYS{formato} } = _pkg_format_code( $args->{formato} );

    my $uri = $self->{base_uri}->clone;
    $uri->query_form($params);

    my $res = $self->{user_agent}->get( uri_unescape( $uri->as_string ) );
    my $parsed_response = _parse_response($res);

    return ($res, $parsed_response);
}

sub _parse_response {
    my ($res) = @_;

    my @parsed_response;
    my $i = 0;
    if (my $content = $res->content) {
        if (substr($content, 0, 5) eq '
            while ($content =~ m{(.+?)}gs) {
                my $inner_content = $1;
                my %data;
                $data{$1} = $2 while $inner_content =~ m{<([^<]+)>([^<]*)}gs;
                if (
                    exists $data{Erro}
                    && $inner_content =~ m{(?:(?:)?)??}
                ) {
                    $data{MsgErro} = $1;
                }
                push @parsed_response, \%data;
                $i++;
            }
        }
    }
    return \@parsed_response;
}

sub _init_user_agent {
    my $args = shift;

    my $ua = $args->{user_agent};

    unless ($ua) {
        require LWP::UserAgent;
        $ua = LWP::UserAgent->new( %{$args} );
    }

    return $ua;
}

sub _pkg_format_code {
    my $format = shift;
    my $code   = undef;

    $format = $DEFAULTS{formato} unless $format;

    $code = $PACKAGING_FORMATS{$format}
      if exists $PACKAGING_FORMATS{$format};

    $code = $PACKAGING_FORMATS{ $DEFAULTS{formato} };

    return $code;
}

1;

__END__