File Coverage

blib/lib/WWW/Correios/SRO.pm

Criterion	Covered	Total	%
statement	61	96	63.5
branch	24	66	36.3
condition	33	109	30.2
subroutine	8	11	72.7
pod	5	5	100.0
total	131	287	45.6

package WWW::Correios::SRO;
use strict;
use warnings;

use parent 'Exporter';
our @EXPORT_OK = qw( sro sro_en sro_ok sro_sigla status_da_entrega );

our $VERSION = '0.13';
my $AGENT = 'Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1)';
my $TIMEOUT = 30;

# Verificado em 6 de Abril de 2018
# https://www.correios.com.br/precisa-de-ajuda/como-rastrear-um-objeto/siglas-utilizadas-no-rastreamento-de-objeto
# (era http://www.correios.com.br/para-voce/precisa-de-ajuda/como-rastrear-um-objeto/siglas-utilizadas-no-rastreamento-de-objeto)
#
#
# Sabemos que as seguintes siglas são usadas: DH
# Como não existem na tabela dos correios, nao se encontra na hash.
# Um código com esse prefixo funcionará ao usar a funcao sro sem
# passar o parametro verifica_prefixo. Porém, se passar este
# parametro, deve retornar undef como qualquer SRO
# cujo prefixo não está previsto na tabela dos Correios.
my %siglas = (
  AL => 'AGENTES DE LEITURA',
  AR => 'AVISO DE RECEBIMENTO',
  AS => 'ENCOMENDA PAC – ACAO SOCIAL',
  BE => 'REMESSA ECONOMICA SEM AR DIGITAL',
  BF => 'REMESSA EXPRESSA SEM AR DIGITAL',
  BG => 'ETIQUETA LOG REM ECON C/AR BG',
  BH => 'MENSAGEM FISICO-DIGITAL',
  BI => 'ETIQUETA LOG REGIST URG',
  CA => 'OBJETO INTERNACIONAL COLIS',
  CB => 'OBJETO INTERNACIONAL COLIS',
  CC => 'OBJETO INTERNACIONAL COLIS',
  CD => 'OBJETO INTERNACIONAL COLIS',
  CE => 'OBJETO INTERNACIONAL COLIS',
  CF => 'OBJETO INTERNACIONAL COLIS',
  CG => 'OBJETO INTERNACIONAL COLIS',
  CH => 'OBJETO INTERNACIONAL COLIS',
  CI => 'OBJETO INTERNACIONAL COLIS',
  CJ => 'OBJETO INTERNACIONAL COLIS',
  CK => 'OBJETO INTERNACIONAL COLIS',
  CL => 'OBJETO INTERNACIONAL COLIS',
  CM => 'OBJETO INTERNACIONAL COLIS',
  CN => 'OBJETO INTERNACIONAL COLIS',
  CO => 'OBJETO INTERNACIONAL COLIS',
  CP => 'OBJETO INTERNACIONAL COLIS',
  CQ => 'OBJETO INTERNACIONAL COLIS',
  CR => 'OBJETO INTERNACIONAL COLIS',
  CS => 'OBJETO INTERNACIONAL COLIS',
  CT => 'OBJETO INTERNACIONAL COLIS',
  CU => 'OBJETO INTERNACIONAL COLIS',
  CV => 'OBJETO INTERNACIONAL COLIS',
  CW => 'OBJETO INTERNACIONAL COLIS',
  CX => 'OBJETO INTERNACIONAL COLIS',
  CY => 'OBJETO INTERNACIONAL COLIS',
  CZ => 'OBJETO INTERNACIONAL COLIS',
  DA => 'ENCOMENDA SEDEX COM AR DIGITAL',
  DB => 'REMESSA EXPRESSA COM AR DIGITAL (BRADESCO)',
  DC => 'REMESSA EXPRESSA (ORGAO TRANSITO)',
  DD => 'DEVOLUCAO DE DOCUMENTOS',
  DE => 'REMESSA EXPRESSA COM AR DIGITAL',
  DF => 'ENCOMENDA SEDEX (ETIQ LOGICA)',
  DG => 'ENCOMENDA SEDEX (ETIQ LOGICA)',
  DI => 'REMESSA EXPRESSA COM AR DIGITAL (ITAU)',
  DJ => 'ENCOMENDA SEDEX',
  DK => 'SEDEX EXTRA GRANDE',
  DL => 'SEDEX LOGICO',
  DM => 'ENCOMENDA SEDEX',
  DN => 'ENCOMENDA SEDEX',
  DO => 'REMESSA EXPRESSA COM AR DIGITAL (ITAU UNIBANCO)',
  DP => 'SEDEX PAGAMENTO NA ENTREGA',
  DQ => 'REMESSA EXPRESSA COM AR DIGITAL (BRADESCO)',
  DR => 'REMESSA EXPRESSA COM AR DIGITAL (SANTANDER)',
  DS => 'REMESSA EXPRESSA COM AR DIGITAL (SANTANDER)',
  DT => 'REMESSA ECON. SEG. TRANSITO COM AR DIGITAL',
  DU => 'ENCOMENDA SEDEX',
  DV => 'SEDEX COM AR DIGITAL',
  DW => 'ENCOMENDA SEDEX (ETIQ LOGICA)',
  DX => 'SEDEX 10 LOGICO',
  DY => 'ENCOMENDA SEDEX (ETIQ FISICA)',
  DZ => 'ENCOMENDA SEDEX (ETIQ LOGICA)',
  EA => 'OBJETO INTERNACIONAL EMS',
  EB => 'OBJETO INTERNACIONAL EMS',
  EC => 'ENCOMENDA PAC',
  ED => 'OBJETO INTERNACIONAL PACKET EXPRESS',
  EE => 'OBJETO INTERNACIONAL EMS',
  EF => 'OBJETO INTERNACIONAL EMS',
  EG => 'OBJETO INTERNACIONAL EMS',
  EH => 'OBJETO INTERNACIONAL EMS',
  EI => 'OBJETO INTERNACIONAL EMS',
  EJ => 'OBJETO INTERNACIONAL EMS',
  EK => 'OBJETO INTERNACIONAL EMS',
  EL => 'OBJETO INTERNACIONAL EMS',
  EM => 'SEDEX MUNDI',
  EN => 'OBJETO INTERNACIONAL EMS',
  EO => 'OBJETO INTERNACIONAL EMS',
  EP => 'OBJETO INTERNACIONAL EMS',
  EQ => 'ENCOMENDA SERVICO NAO EXPRESSA ECT',
  ER => 'REGISTRADO',
  ES => 'E-SEDEX OU EMS',
  ET => 'OBJETO INTERNACIONAL EMS',
  EU => 'OBJETO INTERNACIONAL EMS',
  EV => 'OBJETO INTERNACIONAL EMS',
  EW => 'OBJETO INTERNACIONAL EMS',
  EX => 'OBJETO INTERNACIONAL EMS',
  EY => 'OBJETO INTERNACIONAL EMS',
  EZ => 'OBJETO INTERNACIONAL EMS',
  FA => 'FAC REGISTRADO',
  FB => 'FAC REGISTRADO',
  FC => 'FAC REGISTRADO (5 DIAS)',
  FD => 'FAC REGISTRADO (10 DIAS)',
  FE => 'ENCOMENDA FNDE',
  FF => 'REGISTRADO DETRAN',
  FH => 'FAC REGISTRADO COM AR DIGITAL',
  FJ => 'REMESSA ECONOMICA COM AR DIGITAL',
  FM => 'FAC REGISTRADO (MONITORADO)',
  FR => 'FAC REGISTRADO',
  IA => 'INTEGRADA AVULSA',
  IC => 'INTEGRADA A COBRAR',
  ID => 'INTEGRADA DEVOLUCAO DE DOCUMENTO',
  IE => 'INTEGRADA ESPECIAL',
  IF => 'CPF',
  II => 'INTEGRADA INTERNO',
  IK => 'INTEGRADA COM COLETA SIMULTANEA',
  IM => 'INTEGRADA MEDICAMENTOS',
  IN => 'OBJETO DE CORRESP E EMS REC EXTERIOR',
  IP => 'INTEGRADA PROGRAMADA',
  IR => 'IMPRESSO REGISTRADO',
  IS => 'INTEGRADA STANDARD',
  IT => 'INTEGRADA TERMOLABIL',
  IU => 'INTEGRADA URGENTE',
  IX => 'EDEI ENCOMENDA EXPRESSA',
  JA => 'REMESSA ECONOMICA COM AR DIGITAL',
  JB => 'REMESSA ECONOMICA COM AR DIGITAL',
  JC => 'REMESSA ECONOMICA COM AR DIGITAL',
  JD => 'REMESSA ECONOMICA SEM AR DIGITAL',
  JE => 'REMESSA ECONOMICA COM AR DIGITAL',
  JF => 'REMESSA ECONOMICA COM AR DIGITAL',
  JG => 'REGISTRADO PRIORITARIO',
  JH => 'REGISTRADO PRIORITARIO',
  JI => 'REMESSA ECONOMICA SEM AR DIGITAL',
  JJ => 'REGISTRADO JUSTICA',
  JK => 'REMESSA ECONOMICA SEM AR DIGITAL',
  JL => 'REGISTRADO LOGICO',
  JM => 'MALA DIRETA POSTAL ESPECIAL',
  JN => 'MALA DIRETA POSTAL ESPECIAL',
  JO => 'REGISTRADO PRIORITARIO',
  JP => 'OBJETO RECEITA FEDERAL (EXCLUSIVO)',
  JQ => 'REMESSA ECONOMICA COM AR DIGITAL',
  JR => 'REGISTRADO PRIORITARIO',
  JS => 'REGISTRADO LOGICO',
  JT => 'REGISTRADO URGENTE',
  JU => 'ETIQUETA FISICA REGISTRADO URGENTE',
  JV => 'REMESSA ECONOMICA COM AR DIGITAL',
  JW => 'CARTA COMERCIAL A FATURAR (5 DIAS)',
  JX => 'CARTA COMERCIAL A FATURAR (10 DIAS)',
  JY => 'REMESSA ECONOMICA (5 DIAS)',
  JZ => 'REMESSA ECONOMICA (10 DIAS)',
  LA => 'LOGISTICA REVERSA SIMULTANEA SEDEX',
  LB => 'LOGISTICA REVERSA SIMULTANEA SEDEX',
  LC => 'OBJETO INTERNACIONAL PRIME',
  LD => 'OBJETO INTERNACIONAL PRIME',
  LE => 'LOGISTICA REVERSA ECONOMICA',
  LF => 'OBJETO INTERNACIONAL PRIME',
  LG => 'OBJETO INTERNACIONAL PRIME',
  LH => 'OBJETO INTERNACIONAL PRIME',
  LI => 'OBJETO INTERNACIONAL PRIME',
  LJ => 'OBJETO INTERNACIONAL PRIME',
  LK => 'OBJETO INTERNACIONAL PRIME',
  LL => 'OBJETO INTERNACIONAL PRIME',
  LM => 'OBJETO INTERNACIONAL PRIME',
  LN => 'OBJETO INTERNACIONAL PRIME',
  LP => 'LOGISTICA REVERSA SIMULTANEA PAC',
  LQ => 'OBJETO INTERNACIONAL PRIME',
  LS => 'LOGISTICA REVERSA SEDEX',
  LV => 'LOGISTICA REVERSA EXPRESSA',
  LW => 'OBJETO INTERNACIONAL PRIME',
  LX => 'OBJETO INTERNACIONAL PACKET ECONOMIC',
  LY => 'OBJETO INTERNACIONAL PRIME',
  LZ => 'OBJETO INTERNACIONAL PRIME',
  MA => 'TELEGRAMA - SERVICOS ADICIONAIS',
  MB => 'TELEGRAMA DE BALCAO',
  MC => 'TELEGRAMA FONADO',
  MD => 'MAQUINA DE FRANQUEAR (LOGICA)',
  ME => 'TELEGRAMA',
  MF => 'TELEGRAMA FONADO',
  MH => 'CARTA VIA INTERNET',
  MK => 'TELEGRAMA CORPORATIVO',
#  ML => 'FECHA MALAS (RABICHO)', # <-- descontinuado? (sumiu da lista oficial)
  MM => 'TELEGRAMA GRANDES CLIENTES',
  MP => 'TELEGRAMA PRE-PAGO',
#  MR => 'AR DIGITAL', # <-- descontinuado? (sumiu da lista oficial)
  MS => 'ENCOMENDA SAUDE',
  MT => 'TELEGRAMA VIA TELEMAIL',
  MY => 'TELEGRAMA INTERNACIONAL ENTRANTE',
  MZ => 'TELEGRAMA VIA CORREIOS ONLINE',
  NE => 'TELE SENA RESGATADA',
  NX => 'EDEI ENCOMENDA NAO URGENTE',
  OA => 'ENCOMENDA SEDEX (ETIQUETA LOGICA)',
  OB => 'ENCOMENDA SEDEX (ETIQUETA LOGICA)',
  OC => 'ENCOMENDA SEDEX (ETIQUETA LOGICA)',
  OD => 'ENCOMENDA SEDEX (ETIQUETA FISICA)',
  PA => 'PASSAPORTE',
  PB => 'ENCOMENDA PAC - NAO URGENTE',
  PC => 'ENCOMENDA PAC A COBRAR',
  PD => 'ENCOMENDA PAC',
  PE => 'ENCOMENDA PAC (ETIQUETA FISICA)',
  PF => 'PASSAPORTE',
  PG => 'ENCOMENDA PAC (ETIQUETA FISICA)',
  PH => 'ENCOMENDA PAC (ETIQUETA LOGICA)',
  PI => 'ENCOMENDA PAC',
  PJ => 'ENCOMENDA PAC',
  PK => 'PAC EXTRA GRANDE',
  PL => 'ENCOMENDA PAC',
  PM => 'ENCOMENDA PAC (ETIQUETA FISICA)',
  PN => 'ENCOMENDA PAC (ETIQUETA LOGICA)',
  PO => 'ENCOMENDA PAC (ETIQUETA LOGICA)',
  PP => 'ETIQUETA LOGICA PAC',
  PR => 'REEMBOLSO POSTAL - CLIENTE AVULSO',
#  QQ => 'OBJETO DE TESTE (SIGEP WEB)', # <-- descontinuado? (sumiu da lista oficial)
  RA => 'REGISTRADO PRIORITARIO',
  RB => 'CARTA REGISTRADA',
  RC => 'CARTA REGISTRADA COM VALOR DECLARADO',
  RD => 'REMESSA ECONOMICA DETRAN',
  RE => 'MALA DIRETA POSTAL ESPECIAL',
  RF => 'OBJETO DA RECEITA FEDERAL',
  RG => 'REGISTRADO DO SISTEMA SARA',
  RH => 'REGISTRADO COM AR DIGITAL',
  RI => 'REGISTRADO PRIORITARIO INTERNACIONAL',
  RJ => 'REGISTRADO AGENCIA',
  RK => 'REGISTRADO AGENCIA',
  RL => 'REGISTRADO LOGICO',
  RM => 'REGISTRADO AGENCIA',
  RN => 'REGISTRADO AGENCIA',
  RO => 'REGISTRADO AGENCIA',
  RP => 'REEMBOLSO POSTAL - CLIENTE INSCRITO',
  RQ => 'REGISTRADO AGENCIA',
  RR => 'REGISTRADO INTERNACIONAL',
  RS => 'REMESSA ECONOMICA ORG TRANSITO COM OU SEM AR',
  RT => 'REMESSA ECONOMICA TALAO/CARTAO SEM AR DIGITAL',
  RU => 'REGISTRADO SERVICO ECT',
  RV => 'REMESSA ECONOMICA CRLV/CRV/CNH COM AR DIGITAL',
  RW => 'REGISTRADO INTERNACIONAL',
  RX => 'REGISTRADO INTERNACIONAL',
  RY => 'REMESSA ECONOMICA TALAO/CARTAO COM AR DIGITAL',
  RZ => 'REGISTRADO',
  SA => 'ETIQUETA SEDEX AGENCIA',
  SB => 'SEDEX 10',
  SC => 'SEDEX A COBRAR',
  SD => 'REMESSA EXPRESSA DETRAN',
  SE => 'ENCOMENDA SEDEX',
  SF => 'SEDEX AGENCIA',
  SG => 'SEDEX DO SISTEMA SARA',
  SH => 'SEDEX COM AR DIGITAL',
  SI => 'SEDEX AGENCIA',
  SJ => 'SEDEX HOJE',
  SK => 'SEDEX AGENCIA',
  SL => 'SEDEX LOGICO',
  SM => 'SEDEX 12',
  SN => 'SEDEX AGENCIA',
  SO => 'SEDEX AGENCIA',
  SP => 'SEDEX PRE-FRANQUEADO',
  SQ => 'SEDEX',
  SR => 'SEDEX',
  SS => 'SEDEX FISICO',
  ST => 'REMESSA EXPRESSA TALAO/CARTAO SEM AR DIGITAL',
  SU => 'ENCOMENDA SERVICO EXPRESSA ECT',
  SV => 'REMESSA EXPRESSA CRLV/CRV/CNH COM AR DIGITAL',
  SW => 'ENCOMENDA SEDEX',
  SX => 'SEDEX 10',
  SY => 'REMESSA EXPRESSA TALAO/CARTAO COM AR DIGITAL',
  SZ => 'SEDEX AGENCIA',
  TC => 'TESTE (OBJETO PARA TREINAMENTO)',
  TE => 'TESTE (OBJETO PARA TREINAMENTO)',
  TR => 'OBJETO TREINAMENTO - NAO GERA PRE-ALERTA',
  TS => 'TESTE (OBJETO PARA TREINAMENTO)',
  VA => 'OBJETO INTERNACIONAL COM VALOR DECLARADO',
  VC => 'OBJETO INTERNACIONAL COM VALOR DECLARADO',
  VD => 'OBJETO INTERNACIONAL COM VALOR DECLARADO',
  VE => 'OBJETO INTERNACIONAL COM VALOR DECLARADO',
  VF => 'OBJETO INTERNACIONAL COM VALOR DECLARADO',
  VV => 'OBJETO INTERNACIONAL COM VALOR DECLARADO',
  XA => 'AVISO DE CHEGADA OBJETO INTERNACIONAL TRIBUTADO',
  XM => 'SEDEX MUNDI',
  XR => 'OBJETO INTERNACIONAL (PPS TRIBUTADO)',
  XX => 'OBJETO INTERNACIONAL (PPS TRIBUTADO)',
);

# http://www.correios.com.br/para-sua-empresa/servicos-para-o-seu-contrato/guias/enderecamento/arquivos/guia_tecnico_encomendas.pdf/at_download/file
sub sro_ok {
  if ( $_[0] =~ m/^[A-Z|a-z]{2}([0-9]{8})([0-9])BR$/i ) {
    my ( $numeros, $dv ) = ($1, $2);
    my @numeros = split // => $numeros;
    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_check = $resto == 0 ? 5
                 : $resto == 1 ? 0
                 : 11 - $resto
                 ;
    return $dv == $dv_check;
  }
  else {
    return;
  }
}

sub sro_sigla {
  if ( sro_ok( @_ ) ) {
    $_[0] =~ m/^([A-Z|a-z]{2}).*$/i;
    my $prefixo = $1;
    return $siglas{$prefixo};
  } else {
    return;
  }
}

sub sro    { _sro('101', @_) }
sub sro_en { _sro('102', @_) }

sub _sro {
    my ($language, $code, $params) = @_;
    return unless $code && length($code) % 13 == 0;
    my @codes = ($code =~ /.{13}/g);
    return if !@codes || (@codes > 1 && !$params->{multiple});

    foreach my $code_to_check (@codes) {
        return unless sro_ok( $code_to_check );

        if ($params->{verifica_prefixo}) {
            my $prefixo = sro_sigla( $code_to_check );
            return unless defined $prefixo;
        }
    }

    my $agent = $params->{ua};
    if (!$agent) {
        require LWP::UserAgent;
        $agent = LWP::UserAgent->new(
            agent   => $AGENT,
            timeout => (exists $params->{timeout} ? $params->{timeout} : $TIMEOUT),
        );
    }

    my $results = wantarray ? 'T' : 'U';
    my $user    = $params->{username} || 'ECT';
    my $pass    = $params->{password} || 'SRO';

    # http://www.correios.com.br/para-voce/correios-de-a-a-z/pdf/rastreamento-de-objetos/manual_rastreamentoobjetosws.pdf
    my $response = $agent->post(
        'http://webservice.correios.com.br:80/service/rastro',
        'Content-Type' => 'text/xml;charset=utf-8',
        'SOAPAction' => 'buscaEventos',
        'Content' => qq{
$user$passL$results$language$code}
    );
    return unless $response->is_success;

    my $data = _parse_response($response->content);
    if (ref $data eq 'HASH') {
        if (!$params->{multiple}) {
            warn 'unexpected data from Correios webservice';
            return;
        }
        if ($results eq 'U') {
            foreach my $k (keys %$data) {
                $data->{$k} = $data->{$k}[0];
            }
        }
        return $data;
    }
    return $results eq 'T' ? @$data : $data->[0];
}

sub _parse_response {
    my ($content) = @_;
    return unless index($content, '') >= 0;

    my %data;
    while ($content =~ m{(.+?)}gsi) {
        my $object = $1;
        my $tracking;
        if ($object =~ m{([^>]+)}) {
            $tracking = $1;
        }
        return unless $tracking;
        my @events;
        while ($object =~ m{(.+?)}gi) {
            my $event = $1;
            my $params = _parse_event($event);
            push @events, $params;
        }
        $data{$tracking} = \@events;
    }
    return (keys %data == 1 ? (values %data)[0] : \%data);
}

sub _parse_event {
    my ($event) = @_;

    return $event if index($event, '<') < 0;

    my %params;
    while ($event =~ m{<\s*([^>]+)\s*>\s*(.+?)\s*<\s*/\s*\1\s*>}g) {
        my ($key, $value) = ($1, $2);
        $params{$key} = _parse_event($value);
    }
    return \%params;
}

sub status_da_entrega {
    my ($data) = @_;
    die 'entrega_concluida() takes a HASHREF or ARRAYREF'
        unless $data && ref $data && (ref $data eq 'ARRAY' || ref $data eq 'HASH');

    my $last = ref $data eq 'ARRAY' ? $data->[0] : $data;
    return unless $last;

    # objeto dos Correios tem as mesmas chaves, independente do idioma.
    if (!ref $last || ref $last ne 'HASH' || !exists $last->{tipo} || !exists $last->{status}) {
        warn "status_da_entrega() data looks invalid. Missing keys?";
        return;
    }
    my $tipo   = $last->{tipo};
    my $status = $last->{status};
    if ($tipo eq 'BDR' || $tipo eq 'BDE' || $tipo eq 'BDI') {
        # estado final. entrega efetuada!
        return 'entregue' if $status <= 1;

        # acionar correios (produto extraviado, etc).
        return 'erro' if    $status == 9  || $status == 12 || $status == 28
                         || $status == 37 || $status == 43 || $status == 50
                         || $status == 51 || $status == 52 || $status == 80
        ;

        # pacote aguardando retirada pelo interessado.
        return 'retirar' if $status == 54 || $status == 2;

        # entrega incompleta, pacote retornando.
        return 'incompleto'
            if (  ($status != 20 && $status != 7 && $status <= 21)
                || $status == 26 || $status == 33 || $status == 36
                || $status == 40 || $status == 42 || $status == 48
                || $status == 49 || $status == 56
            );

        return 'acompanhar';
    }
    elsif ($tipo eq 'FC' && $status == 1) {
        return 'incompleto';
    }
    elsif (
        # pacote aguardando retirada.
           ($tipo eq 'LDI' && ($status <= 3 || $status == 14))
        || ($tipo eq 'OEC' && $status == 0)
    ) {
        return 'retirar';
    }
    else {
        return 'acompanhar';
    }
}


42;
__END__