File Coverage

blib/lib/WWW/Correios/SIGEP.pm

Criterion	Covered	Total	%
statement	39	96	40.6
branch	9	72	12.5
condition	6	116	5.1
subroutine	7	15	46.6
pod	3	11	27.2
total	64	310	20.6

package WWW::Correios::SIGEP;
use strict;
use warnings;
use WWW::Correios::SIGEP::LogisticaReversa;
use WWW::Correios::SIGEP::Common;

our $VERSION = 0.04;

sub new {
    my ($class, $params) = @_;
    $params = {} unless $params && ref $params eq 'HASH';

    if ($params->{sandbox}) {
        $params->{target} = 'https://apphom.correios.com.br/SigepMasterJPA/AtendeClienteService/AtendeCliente?wsdl';
        # na sandbox, Correios nos instruem a ignorar configurações do cliente e usar essas:
        $params->{usuario}  = 'sigep';
        $params->{senha}    = 'n5f9t8';
        $params->{contrato} = '9992157880';
        $params->{cartao}   = '0067599079';

        $params->{wsdl_local_file} = 'sandbox/atende_cliente.wsdl';
    }
    else {
        $params->{target} = 'https://apps.correios.com.br/SigepMasterJPA/AtendeClienteService/AtendeCliente?wsdl';
        $params->{wsdl_local_file} = 'live/atende_cliente.wsdl';
    }

    WWW::Correios::SIGEP::Common::build_transport($params);
    return bless $params, $class;
}

sub logistica_reversa {
    my ($self, $params) = @_;
    $params = {} unless $params && ref $params eq 'HASH';

    if (!$self->{scol_obj} || keys %$params) {
        $self->{scol_obj} = WWW::Correios::SIGEP::LogisticaReversa->new(+{
            debug   => $self->{debug},
            sandbox => $self->{sandbox},
            usuario => $self->{usuario},
            senha   => $self->{senha},
            %$params,
        });
    }
    return $self->{scol_obj};
}

sub busca_cliente {
    my ($self, $params) = @_;
    $params = {} unless $params && ref $params eq 'HASH';

    return WWW::Correios::SIGEP::Common::call($self, 'buscaCliente', {
        idContrato       => $self->{contrato} || $params->{idContrato},
        idCartaoPostagem => $self->{cartao}   || $params->{idCartaoPostagem},
        usuario          => $self->{usuario}  || $params->{usuario},
        senha            => $self->{senha}    || $params->{senha},
    });
}

sub consulta_cep {
    my ($self, $cep) = @_;
    $cep =~ s/\D//g;

    return WWW::Correios::SIGEP::Common::call($self, 'consultaCEP', {
        cep => $cep
    });
}

sub cartao_valido {
    my ($self, $params) = @_;
    $params = {} unless $params && ref $params eq 'HASH';

    my $return = WWW::Correios::SIGEP::Common::call(
        $self,
        'getStatusCartaoPostagem',
        {
            numeroCartaoPostagem => $self->{cartao}  || $params->{numeroCartaoPostagem},
            usuario              => $self->{usuario} || $params->{usuario},
            senha                => $self->{senha}   || $params->{senha},
        }
    );
    return $return eq 'Normal';
}

sub servico_disponivel {
    my ($self, $params) = @_;

    $params->{cep_origem}  =~ s/\D+//g;
    $params->{cep_destino} =~ s/\D+//g;

    return WWW::Correios::SIGEP::Common::call(
        $self,
        'verificaDisponibilidadeServico',
        {
            usuario           => $self->{usuario} || $params->{usuario},
            senha             => $self->{senha}   || $params->{senha},
            codAdministrativo => $self->{codigo}  || $params->{codigo},
            numeroServico     => $params->{codigo_servico},
            cepOrigem         => $params->{cep_origem},
            cepDestino        => $params->{cep_destino},
        }
    );
}

sub solicita_etiquetas {
    my ($self, $cnpj, $id, $n) = @_;

    my $return = WWW::Correios::SIGEP::Common::call($self, 'solicitaEtiquetas', {
        tipoDestinatario => 'C',
        identificador    => $cnpj,
        idServico        => $id,
        qtdEtiquetas     => $n,
        usuario          => $self->{usuario},
        senha            => $self->{senha}
    });
    return () unless $return && !ref $return;

    my ($i, $f) = map { s/\D+//g; $_ } split /\s*,\s*/ => $return;
    my $prefixo = substr $return, 0, 2;

    my @etiquetas;
    foreach my $codigo ($i .. $f) {
        push @etiquetas, $prefixo . $codigo . digito_verificador($codigo) . 'BR';
    }
    return @etiquetas;
}

sub fecha_plp_varios_servicos {
    my ($self, $params) = @_;
    die "fecha_plp_varios_servicos: parametros exigidos"
        unless ref $params eq 'HASH';

    my $xml;
    if (exists $params->{xml}) {
        $xml = $params->{xml};
    }
    else {
        $xml = $self->gera_xml_plp($params);
    }

    return WWW::Correios::SIGEP::Common::call(
        $self,
        'fechaPlpVariosServicos',
        {
            usuario        => $self->{usuario} || $params->{usuario},
            senha          => $self->{senha}   || $params->{senha},
            cartaoPostagem => $self->{cartao} || $params->{cartao},
            xml            => $xml,
            idPlpCliente   => $params->{id},
            listaEtiquetas => [
                map {
                    my $etq = $_->{etiqueta};
                    substr($etq, 10, 1, '');
                    $etq;
                } @{$params->{objetos}}
            ],
        }
    );
}

sub status_plp {
    my ($self, $id) = @_;
    die "status_plp: id da PLP exigido" unless defined $id;
    return WWW::Correios::SIGEP::Common::call(
        $self,
        'solicitaXmlPlp',
        {
            usuario     => $self->{usuario},
            senha       => $self->{senha},
            idPlpMaster => $id,
        }
    );
}

sub gera_xml_plp {
    my ($self, $params) = @_;

    #  I'm sorry, ubu.
    my $xml = 'Postagem2.3'
    . ($params->{cartao} || $self->{cartao} || die "cartao de postagem exigido")
    . ''
    . ($params->{contrato} || $self->{contrato} || die "contrato exigido")
    . ''
    . ($params->{diretoria} || die "diretoria exigido")
    . ''
    . ($params->{codigo_administrativo} || die "codigo_administrativo exigido")
    . '
    . ($params->{remetente}{nome} || die "remetente.nome exigido")
    . ']]>
    . ($params->{remetente}{logradouro} || die "remetente.logradouro exigido")
    . ']]>'
    . (defined $params->{remetente}{numero}
       && $params->{remetente}{numero} =~ m{\A(?:s/n|\d+)\z}  # digit or "s/n"
       ? $params->{remetente}{numero} : die "remetente.numero exigido"
      )
    . ''
    . (defined $params->{remetente}{complemento}
        ? '
          . $params->{remetente}{complemento}
          . ']]>'
        : ''
      )
    . '
    . ($params->{remetente}{bairro} || die "remetente.bairro exigido")
    . ']]>'
    . ($params->{remetente}{cep} =~ /\A\d{8}\z/ ? $params->{remetente}{cep} : die "remetente.cep (somente numeros) exigido")
    . '
    . ($params->{remetente}{cidade} || die "remetente.cidade exigido")
    . ']]>'
    . uc($params->{remetente}{estado} || die "remetente.estado (sigla) exigido")
    . ''
    . (defined $params->{remetente}{telefone}
        ? '
          . $params->{remetente}{telefone}
          . ']]>'
        : ''
      )
    . (defined $params->{remetente}{fax}
        ? '
          . $params->{remetente}{fax}
          . ']]>'
        : ''
      )
    . (defined $params->{remetente}{email}
        ? '
          . $params->{remetente}{email}
          . ']]>'
        : ''
      )
    . ''
    ;

    die "objetos exigidos (ao menos 1)" unless @{$params->{objetos}} > 0;
    foreach my $obj (@{$params->{objetos}}) {
        if (defined $obj->{valor_declarado}) {
            if ($obj->{valor_declarado} =~ /\A(\d{1,9}),(\d{2})\z/) {
                my $valor_declarado = $1 + $2/100;
                if ($obj->{codigo_postagem_sigla} eq 'PAC') {
                    die "objetos[].valor_declarado (PAC) precisa ser entre 18,50 e 3000,00"
                        unless $valor_declarado >= 18.5 && $valor_declarado <= 3000;
                }
                elsif ($obj->{codigo_postagem_sigla} eq 'SEDEX') {
                    die "objetos[].valor_declarado (SEDEX) precisa ser entre 18,50 e 10000,00"
                        unless $valor_declarado >= 18.5 && $valor_declarado <= 10_000;
                }
                else {
                    die "objetos[].codigo_postagem_sigla precisa ser SEDEX, PAC ou CARTA"
                        unless $obj->{codigo_postagem_sigla} eq 'CARTA';
                }
            }
            else {
                die "objetos[].valor_declarado (formato NNNN,NN) invalido";
            }
        }
        $xml .= ''
             . ($obj->{etiqueta} || die "objetos[].etiqueta exigido")
             . ''
             . ($obj->{codigo_postagem} || die "objetos[].codigo_postagem exigido")
             . '0,00'
             . ($obj->{peso} || die "objetos[].peso em gramas exigido")
             . '
             . (substr($obj->{destinatario}{nome},0,50) || die "objetos[].destinatario.nome exigido")
             . ']]>'
             . (defined $obj->{destinatario}{telefone}
                 ? '
                   . $obj->{destinatario}{telefone}
                   . ']]>'
                 : ''
               )
             . (defined $obj->{destinatario}{celular}
                 ? '
                   . $obj->{destinatario}{celular}
                   . ']]>'
                 : ''
               )
             . (defined $obj->{destinatario}{email}
                 ? '
                   . $obj->{destinatario}{email}
                   . ']]>'
                 : ''
               )
             . '
             . ($obj->{destinatario}{logradouro} || die "objetos[].destinatario.logradouro exigido")
             . ']]>'
             . (defined $obj->{destinatario}{complemento}
                 ? '
                   . $obj->{destinatario}{complemento}
                   . ']]>'
                 : ''
             )
             . ''
             . (defined $obj->{destinatario}{numero}
                && $obj->{destinatario}{numero} =~ m{\A(?:s/n|\d+)\z}  # digit or "s/n"
                ? $obj->{destinatario}{numero} : die "objetos[].destinatario.numero"
               )
             . '
             . ($obj->{destinatario}{bairro} || die "objetos[].destinatario.bairro exigido")
             . ']]>
             . ($obj->{destinatario}{cidade} || die "objetos[].destinatario.cidade exigido")
             . ']]>'
             . (uc $obj->{destinatario}{uf} || die "objetos[].destinatario.uf exigido")
             . '
             . ($obj->{destinatario}{cep} =~ /\A\d{8}\z/ ? $obj->{destinatario}{cep} : die "objetos[].destinatario.cep (somente numeros) exigido")
             . ']]>'
             . ''
             . ''
             . ''
             . '0,0'
             . ''
             # 'O serviço adicional “025”, referente ao registro, deve sempre ser informado.'
             . '025'
             . (exists $obj->{servicos_adicionais} && @{$obj->{servicos_adicionais}} > 0
                 ? join('' => map '' . $_ . '', @{$obj->{servicos_adicionais}})
                 : ''
               )
             . (defined $obj->{valor_declarado}
                ? '' . ($obj->{codigo_postagem_sigla} eq 'PAC'
                    ? '064' : $obj->{codigo_postagem_sigla} eq 'SEDEX' ? '019' : '035'
                  ) . '' . $obj->{valor_declarado} . ''
                  : ''
             )
             . ''
             . ''
             . ($obj->{tipo} || die "objetos[].tipo (001, 002, 003) exigido")
             . ''
             . ($obj->{altura} || '0')
             . ''
             . ($obj->{largura} || '0')
             . ''
             . ($obj->{comprimento} || '0')
             . ''
             . ($obj->{diametro} || '0')
             . '0'
             ;
    }
    $xml .= '';
    return $xml;
}

sub digito_verificador {
    my ($codigo) = @_;
    my @numeros = split // => $codigo;
    my @magica  = ( 8, 6, 4, 2, 3, 5, 9, 7 );

    my $soma = 0;
    foreach ( 0 .. 7 ) {
      $soma += ( $numeros[$_] * $magica[$_] );
    }

    my $resto = $soma % 11;
    my $dv = $resto == 0 ? 5
           : $resto == 1 ? 0
           : 11 - $resto
           ;

    return $dv;
}

1;
__END__