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.12';
my $AGENT = 'Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1)';
my $TIMEOUT = 30;

# Verificado em 22 de Maio de 2017
# 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 – AÇÃO SOCIAL',
  BE => 'REMESSA ECONÔMICA TALÃO/CARTÃO (SEM AR DIGITAL)',
  CA => 'ENCOMENDA INTERNACIONAL - COLIS',
  CB => 'ENCOMENDA INTERNACIONAL - COLIS',
  CC => 'ENCOMENDA INTERNACIONAL - COLIS',
  CD => 'ENCOMENDA INTERNACIONAL - COLIS',
  CE => 'ENCOMENDA INTERNACIONAL - COLIS',
  CF => 'ENCOMENDA INTERNACIONAL - COLIS',
  CG => 'ENCOMENDA INTERNACIONAL - COLIS',
  CH => 'ENCOMENDA INTERNACIONAL - COLIS',
  CI => 'ENCOMENDA INTERNACIONAL - COLIS',
  CJ => 'ENCOMENDA INTERNACIONAL - COLIS',
  CK => 'ENCOMENDA INTERNACIONAL - COLIS',
  CL => 'ENCOMENDA INTERNACIONAL - COLIS',
  CM => 'ENCOMENDA INTERNACIONAL - COLIS',
  CN => 'ENCOMENDA INTERNACIONAL - COLIS',
  CO => 'ENCOMENDA INTERNACIONAL - COLIS',
  CP => 'ENCOMENDA INTERNACIONAL - COLIS',
  CQ => 'ENCOMENDA INTERNACIONAL - COLIS',
  CR => 'CARTA REGISTRADA SEM VALOR DECLARADO',
  CS => 'ENCOMENDA INTERNACIONAL - COLIS',
  CT => 'ENCOMENDA INTERNACIONAL - COLIS',
  CU => 'ENCOMENDA INTERNACIONAL - COLIS',
  CV => 'ENCOMENDA INTERNACIONAL - COLIS',
  CW => 'ENCOMENDA INTERNACIONAL - COLIS',
  CX => 'ENCOMENDA INTERNACIONAL - COLIS OU SELO LACRE PARA CAIXETAS',
  CY => 'ENCOMENDA INTERNACIONAL - COLIS',
  CZ => 'ENCOMENDA INTERNACIONAL - COLIS',
  DA => 'SEDEX OU REMESSA EXPRESSA COM AR DIGITAL',
  DB => 'SEDEX OU REMESSA EXPRESSA COM AR DIGITAL (BRADESCO)',
  DC => 'REMESSA EXPRESSA CRLV/CRV/CNH e NOTIFICAÇÕES',
  DD => 'DEVOLUÇÃO DE DOCUMENTOS',
  DE => 'REMESSA EXPRESSA TALÃO/CARTÃO COM AR',
  DF => 'E-SEDEX',
  DG => 'SEDEX',
  DI => 'SEDEX OU REMESSA EXPRESSA COM AR DIGITAL (ITAU)',
  DJ => 'SEDEX',
  DK => 'PAC EXTRA GRANDE',
  DL => 'SEDEX',
  DM => 'E-SEDEX',
  DN => 'SEDEX',
  DO => 'SEDEX OU REMESSA EXPRESSA COM AR DIGITAL (ITAU)',
  DP => 'SEDEX PAGAMENTO NA ENTREGA',
  DQ => 'SEDEX OU REMESSA EXPRESSA COM AR DIGITAL (BRADESCO)',
  DR => 'REMESSA EXPRESSA COM AR DIGITAL (SANTANDER)',
  DS => 'SEDEX OU REMESSA EXPRESSA COM AR DIGITAL (SANTANDER)',
  DT => 'REMESSA ECONÔMICA COM AR DIGITAL (DETRAN)',
  DU => 'E-SEDEX',
  DV => 'SEDEX COM AR DIGITAL',
  DW => 'ENCOMENDA SEDEX (ETIQUETA LÓGICA)',
  DX => 'SEDEX 10',
  EA => 'ENCOMENDA INTERNACIONAL - EMS',
  EB => 'ENCOMENDA INTERNACIONAL - EMS',
  EC => 'PAC',
  ED => 'PACKET EXPRESS',
  EE => 'ENCOMENDA INTERNACIONAL - EMS',
  EF => 'ENCOMENDA INTERNACIONAL - EMS',
  EG => 'ENCOMENDA INTERNACIONAL - EMS',
  EH => 'ENCOMENDA INTERNACIONAL - EMS OU ENCOMENDA COM AR DIGITAL',
  EI => 'ENCOMENDA INTERNACIONAL - EMS',
  EJ => 'ENCOMENDA INTERNACIONAL - EMS',
  EK => 'ENCOMENDA INTERNACIONAL - EMS',
  EL => 'ENCOMENDA INTERNACIONAL - EMS',
  EM => 'ENCOMENDA INTERNACIONAL - SEDEX MUNDI OU EMS IMPORTAÇÃO',
  EN => 'ENCOMENDA INTERNACIONAL - EMS',
  EO => 'ENCOMENDA INTERNACIONAL - EMS',
  EP => 'ENCOMENDA INTERNACIONAL - EMS',
  EQ => 'ENCOMENDA DE SERVIÇO NÃO EXPRESSA (ECT)',
  ER => 'OBJETO REGISTRADO',
  ES => 'E-SEDEX OU EMS',
  ET => 'ENCOMENDA INTERNACIONAL - EMS',
  EU => 'ENCOMENDA INTERNACIONAL - EMS',
  EV => 'ENCOMENDA INTERNACIONAL - EMS',
  EW => 'ENCOMENDA INTERNACIONAL - EMS',
  EX => 'ENCOMENDA INTERNACIONAL - EMS',
  EY => 'ENCOMENDA INTERNACIONAL - EMS',
  EZ => 'ENCOMENDA INTERNACIONAL - EMS',
  FA => 'FAC REGISTRADO',
  FE => 'ENCOMENDA FNDE',
  FF => 'OBJETO REGISTRADO (DETRAN)',
  FH => 'FAC REGISTRADO COM AR DIGITAL',
  FM => 'FAC MONITORADO',
  FR => 'FAC REGISTRADO',
  IA => 'LOGÍSTICA INTEGRADA (AGENDADO/AVULSO)',
  IC => 'LOGÍSTICA INTEGRADA (A COBRAR)',
  ID => 'LOGÍSTICA INTEGRADA (DEVOLUCAO DE DOCUMENTO)',
  IE => 'LOGÍSTICA INTEGRADA (ESPECIAL)',
  IF => 'CPF',
  II => 'LOGÍSTICA INTEGRADA (ECT)',
  IK => 'LOGÍSTICA INTEGRADA COM COLETA SIMULTÂNEA',
  IM => 'LOGÍSTICA INTEGRADA (MEDICAMENTOS)',
  IN => 'CORRESPONDÊNCIA E EMS RECEBIDO DO EXTERIOR',
  IP => 'LOGÍSTICA INTEGRADA (PROGRAMADA)',
  IR => 'IMPRESSO REGISTRADO',
  IS => 'LOGÍSTICA INTEGRADA STANDARD (MEDICAMENTOS)',
  IT => 'REMESSA EXPRESSA MEDICAMENTOS / LOGÍSTICA INTEGRADA TERMOLÁBIL',
  IU => 'LOGÍSTICA INTEGRADA (URGENTE)',
  IX => 'EDEI EXPRESSO',
  JA => 'REMESSA ECONOMICA COM AR DIGITAL',
  JB => 'REMESSA ECONOMICA COM AR DIGITAL',
  JC => 'REMESSA ECONOMICA COM AR DIGITAL',
  JD => 'REMESSA ECONOMICA TALÃO/CARTÃO',
  JE => 'REMESSA ECONÔMICA COM AR DIGITAL',
  JF => 'REMESSA ECONÔMICA COM AR DIGITAL',
  JG => 'OBJETO REGISTRADO URGENTE/PRIORITÁRIO',
  JH => 'OBJETO REGISTRADO URGENTE/PRIORITÁRIO',
  JI => 'REMESSA ECONÔMICA TALÃO/CARTÃO',
  JJ => 'OBJETO REGISTRADO (JUSTIÇA)',
  JK => 'REMESSA ECONÔMICA TALÃO/CARTÃO',
  JL => 'OBJETO REGISTRADO',
  JM => 'MALA DIRETA POSTAL ESPECIAL',
  JN => 'OBJETO REGISTRADO ECONÔMICO',
  JO => 'OBJETO REGISTRADO URGENTE',
  JP => 'RECEITA FEDERAL',
  JQ => 'REMESSA ECONÔMICA COM AR DIGITAL',
  JR => 'OBJETO REGISTRADO URGENTE/PRIORITÁRIO',
  JS => 'OBJETO REGISTRADO',
  JT => 'OBJETO REGISTRADO URGENTE',
  JV => 'REMESSA ECONÔMICA COM AR DIGITAL',
  LA => 'SEDEX COM LOGÍSTICA REVERSA SIMULTÂNEA EM AGÊNCIA',
  LB => 'E-SEDEX COM LOGÍSTICA REVERSA SIMULTÂNEA EM AGÊNCIA',
  LC => 'OBJETO INTERNACIONAL (PRIME)',
  LE => 'LOGÍSTICA REVERSA ECONOMICA',
  LF => 'OBJETO INTERNACIONAL (PRIME)',
  LI => 'OBJETO INTERNACIONAL (PRIME)',
  LJ => 'OBJETO INTERNACIONAL (PRIME)',
  LK => 'OBJETO INTERNACIONAL (PRIME)',
  LM => 'OBJETO INTERNACIONAL (PRIME)',
  LN => 'OBJETO INTERNACIONAL (PRIME)',
  LP => 'PAC COM LOGÍSTICA REVERSA SIMULTÂNEA EM AGÊNCIA',
  LS => 'SEDEX LOGISTICA REVERSA',
  LV => 'LOGISTICA REVERSA EXPRESSA',
  LX => 'PACKET STANDARD/ECONÔMICA',
  LZ => 'OBJETO INTERNACIONAL (PRIME)',
  MA => 'SERVIÇOS ADICIONAIS DO TELEGRAMA',
  MB => 'TELEGRAMA (BALCÃO)',
  MC => 'TELEGRAMA (FONADO)',
  MD => 'SEDEX MUNDI (DOCUMENTO INTERNO)',
  ME => 'TELEGRAMA',
  MF => 'TELEGRAMA FONADO',
  MK => 'TELEGRAMA (CORPORATIVO)',
  ML => 'FECHA MALAS (RABICHO)',
  MM => 'TELEGRAMA (GRANDES CLIENTES)',
  MP => 'TELEGRAMA (PRÉ-PAGO)',
  MR => 'AR DIGITAL',
  MS => 'ENCOMENDA SAUDE',
  MT => 'TELEGRAMA (TELEMAIL)',
  MY => 'TELEGRAMA INTERNACIONAL (ENTRANTE)',
  MZ => 'TELEGRAMA (CORREIOS ONLINE)',
  NE => 'TELE SENA RESGATADA',
  NX => 'EDEI ECONÔMICO (NÃO URGENTE)',
  OA => 'ENCOMENDA SEDEX',
  OB => 'ENCOMENDA E-SEDEX',
  PA => 'PASSAPORTE',
  PB => 'PAC',
  PC => 'PAC A COBRAR',
  PD => 'PAC',
  PE => 'PAC',
  PF => 'PASSAPORTE',
  PG => 'PAC',
  PH => 'PAC',
  PI => 'PAC',
  PJ => 'PAC',
  PK => 'PAC EXTRA GRANDE',
  PL => 'PAC',
  PN => 'PAC',
  PR => 'REEMBOLSO POSTAL',
  QQ => 'OBJETO DE TESTE (SIGEP WEB)',
  RA => 'OBJETO REGISTRADO/PRIORITÁRIO',
  RB => 'CARTA REGISTRADA',
  RC => 'CARTA REGISTRADA COM VALOR DECLARADO',
  RD => 'REMESSA ECONOMICA OU OBJETO REGISTRADO (DETRAN)',
  RE => 'OBJETO REGISTRADO ECONÔMICO',
  RF => 'RECEITA FEDERAL',
  RG => 'OBJETO REGISTRADO',
  RH => 'OBJETO REGISTRADO COM AR DIGITAL',
  RI => 'OBJETO REGISTRADO INTERNACIONAL PRIORITÁRIO',
  RJ => 'OBJETO REGISTRADO',
  RK => 'OBJETO REGISTRADO',
  RL => 'OBJETO REGISTRADO',
  RM => 'OBJETO REGISTRADO URGENTE',
  RN => 'OBJETO REGISTRADO (SIGEPWEB OU AGÊNCIA)',
  RO => 'OBJETO REGISTRADO',
  RP => 'REEMBOLSO POSTAL',
  RQ => 'OBJETO REGISTRADO',
  RR => 'OBJETO REGISTRADO',
  RS => 'OBJETO REGISTRADO',
  RT => 'REMESSA ECONÔMICA TALÃO/CARTAO',
  RU => 'OBJETO REGISTRADO (ECT)',
  RV => 'REMESSA ECONÔMICA CRLV/CRV/CNH E NOTIFICAÇÕES COM AR DIGITAL',
  RW => 'OBJETO INTERNACIONAL',
  RX => 'OBJETO INTERNACIONAL',
  RY => 'REMESSA ECONÔMICA TALÃO/CARTÃO COM AR DIGITAL',
  RZ => 'OBJETO REGISTRADO',
  SA => 'SEDEX',
  SB => 'SEDEX 10',
  SC => 'SEDEX A COBRAR',
  SD => 'SEDEX OU REMESSA EXPRESSA (DETRAN)',
  SE => 'SEDEX',
  SF => 'SEDEX',
  SG => 'SEDEX',
  SH => 'SEDEX COM AR DIGITAL / SEDEX OU AR DIGITAL',
  SI => 'SEDEX',
  SJ => 'SEDEX HOJE',
  SK => 'SEDEX',
  SL => 'SEDEX',
  SM => 'SEDEX 12',
  SN => 'SEDEX',
  SO => 'SEDEX',
  SP => 'SEDEX PRÉ-FRANQUEADO',
  SQ => 'SEDEX',
  SR => 'SEDEX',
  SS => 'SEDEX',
  ST => 'REMESSA EXPRESSA TALÃO/CARTÃO',
  SU => 'ENCOMENDA DE SERVIÇO EXPRESSA (ECT)',
  SV => 'REMESSA EXPRESSA CRLV/CRV/CNH E NOTIFICAÇÕES COM AR DIGITAL',
  SW => 'E-SEDEX',
  SX => 'SEDEX 10',
  SY => 'REMESSA EXPRESSA TALÃO/CARTÃO COM AR DIGITAL',
  SZ => 'SEDEX',
  TC => 'OBJETO PARA TREINAMENTO',
  TE => 'OBJETO PARA TREINAMENTO',
  TS => 'OBJETO PARA TREINAMENTO',
  VA => 'ENCOMENDAS COM VALOR DECLARADO',
  VC => 'ENCOMENDAS',
  VD => 'ENCOMENDAS COM VALOR DECLARADO',
  VE => 'ENCOMENDAS',
  VF => 'ENCOMENDAS COM VALOR DECLARADO',
  VV => 'OBJETO INTERNACIONAL',
  XA => 'AVISO DE CHEGADA (INTERNACIONAL)',
  XM => 'SEDEX MUNDI',
  XR => 'ENCOMENDA SUR POSTAL EXPRESSO',
  XX => 'ENCOMENDA SUR POSTAL 24 HORAS',
);

# 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__