| 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{<([^<]+)>([^<]+)\1>}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__ |