File Coverage

blib/lib/WWW/Correios/PrecoPrazo.pm
Criterion Covered Total %
statement 55 55 100.0
branch 12 16 75.0
condition 9 9 100.0
subroutine 10 10 100.0
pod 2 2 100.0
total 88 92 95.6


line stmt bran cond sub pod time code
1             package WWW::Correios::PrecoPrazo;
2              
3 4     4   67632 use strict;
  4         8  
  4         125  
4 4     4   13 use warnings;
  4         6  
  4         83  
5              
6 4     4   2020 use Const::Fast;
  4         9538  
  4         60  
7 4     4   2545 use URI;
  4         23315  
  4         138  
8 4     4   29 use URI::Escape;
  4         5  
  4         2859  
9              
10             our $VERSION = 0.3;
11              
12             const my %INPUT_KEYS => (
13             'codigo_empresa' => 'nCdEmpresa',
14             'senha' => 'sDsSenha',
15             'codigo_servico' => 'nCdServico',
16             'cep_origem' => 'sCepOrigem',
17             'cep_destino' => 'sCepDestino',
18             'peso' => 'nVlPeso',
19             'formato' => 'nCdFormato',
20             'comprimento' => 'nVlComprimento',
21             'altura' => 'nVlAltura',
22             'largura' => 'nVlLargura',
23             'diametro' => 'nVlDiametro',
24             'mao_propria' => 'sCdMaoPropria',
25             'valor_declarado' => 'nVlValorDeclarado',
26             'aviso_recebimento' => 'sCdAvisoRecebimento',
27             'formato_retorno' => 'StrRetorno',
28             );
29              
30             const my @REQUIRED => qw( codigo_servico cep_origem cep_destino );
31              
32             const my %OUTPUT_KEYS => (
33             'EntregaDomiciliar' => 'entrega_domiciliar',
34             'Erro' => 'erro',
35             'Valor' => 'valor',
36             'MsgErro' => 'msg_erro',
37             'ValorMaoPropria' => 'valor_mao_propria',
38             'PrazoEntrega' => 'prazo_entrega',
39             'Codigo' => 'codigo_servico',
40             'ValorValorDeclarado' => 'valor_declarado',
41             'ValorAvisoRecebimento' => 'valor_aviso_recebimento',
42             'EntregaSabado' => 'entrega_sabado',
43             );
44              
45             const my %DEFAULTS => (
46             'codigo_empresa' => '',
47             'senha' => '',
48             'codigo_servico' => '40010',
49             'cep_origem' => '',
50             'cep_destino' => '',
51             'peso' => 0.1,
52             'formato' => 'caixa',
53             'comprimento' => 16,
54             'altura' => 2,
55             'largura' => 11,
56             'diametro' => 5,
57             'mao_propria' => 'N',
58             'valor_declarado' => '0',
59             'aviso_recebimento' => 'N',
60             'formato_retorno' => 'XML',
61             );
62              
63             const my %PACKAGING_FORMATS => (
64             'caixa' => 1,
65             'pacote' => 1,
66             'rolo' => 2,
67             'prisma' => 2,
68             'envelope' => 3,
69             );
70              
71             sub new {
72 4     4 1 448 my $class = shift;
73 4 100       17 my %args = ref $_[0] ? %{ $_[0] } : @_;
  3         13  
74              
75 4         29 my $uri = URI->new;
76 4   100     14087 $uri->scheme( $args{scheme} || 'http' );
77 4   100     11895 $uri->host( $args{host} || 'ws.correios.com.br' );
78 4   100     532 $uri->path( $args{path} || '/calculador/CalcPrecoPrazo.aspx' );
79              
80 4         198 delete @args{qw{scheme host path}};
81              
82 4         16 my $atts = {
83             user_agent => _init_user_agent(\%args),
84             base_uri => $uri,
85             };
86              
87 4         27 return bless $atts, $class;
88             }
89              
90             sub query {
91 6     6 1 14 my $self = shift;
92 6 100       24 my $args = ref $_[0] ? $_[0] : {@_};
93              
94 6 100       48 return {} unless scalar(grep exists $args->{$_}, @REQUIRED) == @REQUIRED;
95 2         8 $args->{cep_origem} =~ s/-//;
96 2         9 $args->{cep_destino} =~ s/-//;
97              
98 30   100     122 my $params = {
99 2         10 map { $INPUT_KEYS{$_} => $args->{$_} || $DEFAULTS{$_} }
100             keys %INPUT_KEYS
101             };
102              
103 2         19 $params->{ $INPUT_KEYS{formato} } = _pkg_format_code( $args->{formato} );
104              
105 2         22 my $uri = $self->{base_uri}->clone;
106 2         30 $uri->query_form($params);
107              
108 2         530 return _parse_response($self->{user_agent}->get( uri_unescape( $uri->as_string ) ));
109             }
110              
111             sub _parse_response {
112 2     2   78 my ($res) = @_;
113 2         8 my %data = ( response => $res );
114              
115 2 50       6 if (my $content = $res->content) {
116 2 50       15 if (substr($content, 0, 5) eq '
117 2         24 $data{$1} = $2 while $content =~ m{<([^<]+)>([^<]+)}gs;
118             }
119             }
120 2         20 return \%data;
121             }
122              
123             sub _init_user_agent {
124 4     4   9 my $args = shift;
125              
126 4         10 my $ua = $args->{user_agent};
127              
128 4 100       19 unless ($ua) {
129 3         1234 require LWP::UserAgent;
130 3         64439 $ua = LWP::UserAgent->new( %{$args} );
  3         22  
131             }
132              
133 4         5329 return $ua;
134             }
135              
136             sub _pkg_format_code {
137 2     2   7 my $format = shift;
138 2         3 my $code = undef;
139              
140 2 50       6 $format = $DEFAULTS{formato} unless $format;
141              
142 2 50       8 $code = $PACKAGING_FORMATS{$format}
143             if exists $PACKAGING_FORMATS{$format};
144              
145 2         4 $code = $PACKAGING_FORMATS{ $DEFAULTS{formato} };
146              
147 2         7 return $code;
148             }
149              
150             1;
151              
152             __END__