File Coverage

blib/lib/Net/Correios/SRO.pm

Criterion	Covered	Total	%
statement	48	73	65.7
branch	14	38	36.8
condition	30	98	30.6
subroutine	8	11	72.7
pod	4	7	57.1
total	104	227	45.8

use strict;
use warnings;
use Scalar::Util ();
use utf8;

package Net::Correios::SRO;

sub new {
    my ($class, $parent) = @_;
    Scalar::Util::weaken($parent);
    return bless { parent => $parent }, $class;
}

# minha versão da consulta por SRO ;)
sub busca {
    my ($self, $tipo, @sro) = @_;

    if (length($tipo) > 1) {
        unshift @sro, $tipo;
        $tipo = 'T';
    }

    my $res = $self->objetos( objetos => \@sro, resultado => $tipo );
    my %data;
    foreach my $item (@{$res->{objetos}}) {
        $data{ $item->{codObjeto} } = $item;
        $data{ $item->{codObjeto} }{situacao} = $tipo eq 'P'
            ? 'indisponível'
            : ($item->{mensagem} && $item->{mensagem} =~ /\ASRO-020/) ? 'não encontrado'
            : $self->nome_do_evento($item->{eventos}[0]{codigo}, $item->{eventos}[0]{tipo});
    }
    return \%data;
}

sub nome_do_evento {
    my ($self, $codigo, $tipo) = @_;
    return 'indisponivel' unless defined $codigo && defined $tipo;
    if ($codigo eq 'BDR' || $codigo eq 'BDE' || $codigo eq 'BDI') {
        # estado final. entrega efetuada!
        return 'entregue' if $tipo <= 1;

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

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

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

        return 'devolvido' if $tipo == 23;

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

# 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 ( $_[-1] =~ 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;
    }
    return;
}

sub objetos {
    my ($self, %args) = @_;

    my @codes;
    foreach my $code (@{$args{objetos}}) {
        die "código SRO '$code' é inválido" unless defined $code && length($code) == 13;
        push @codes, uc($code);
    }
    die "pelo menos 1 objeto é necessário para consulta" unless @codes;
    my $tipo = $args{resultado} || 'U';
    die "resultado precisa ser 'U' (último), 'P' (primeiro) ou 'T' (todos)"
        unless $tipo eq 'T' || $tipo eq 'U' || $tipo eq 'P';

    my $query_string = 'codigosObjetos=' . join('&codigosObjetos=', @codes)
                     . '&resultado=' . $tipo;

    my $url = 'srorastro/v1/objetos?' . $query_string;
    my $parent = $self->{parent};

    my $res = $parent->make_request('cartao', 'GET', $url);

    return $parent->parse_response($res);
}

sub imagens {
    my ($self, @codes) = @_;
    my $parent = $self->{parent};

    my $body = '[' . join(',', map qq("$_"), @codes) . ']';

    my $res = $parent->make_request(
        'cartao',
        'POST',
        'srorastro/v1/objetos/imagens',
        { content => '[' . join(',', map qq("$_"), @codes) . ']' }
    );
    return $parent->parse_response($res);
}

sub recibo {
    my ($self, $recibo) = @_;
    my $parent = $self->{parent};

    my $res = $parent->make_request('cartao', 'GET', 'srorastro/v1/recibo/' . $recibo);
    return $parent->parse_response($res);
}

1;
__END__