File Coverage

blib/lib/Net/Moip.pm

Criterion	Covered	Total	%
statement	50	53	94.3
branch	11	16	68.7
condition			n/a
subroutine	10	10	100.0
pod	0	1	0.0
total	71	80	88.7

package Net::Moip;

use IO::Socket::SSL;
use MIME::Base64;
use Furl;

use String::CamelCase ();
use XML::SAX::Writer;
use XML::Generator::PerlData;

use Moo;

our $VERSION = 0.06;

has 'ua', is => 'ro', default => sub {
    Furl->new(
        agent         => "Net-Moip/$VERSION",
        timeout       => 15,
        max_redirects => 3,
        #  "SSL Wants a read first" I think is suggesting you
        # haven't read OpenSSL a bedtime story in too long and perhaps
        # it's feeling neglected and lonely?
        # see also: https://metacpan.org/pod/IO::Socket::SSL#SNI-Support
        # https://metacpan.org/pod/Furl#FAQ
        # https://rt.cpan.org/Public/Bug/Display.html?id=86684
        ssl_opts => {
            SSL_verify_mode => SSL_VERIFY_PEER(),
        },
    );
};

has 'token', is => 'ro', required => 1;

has 'key', is => 'ro', required => 1;

has 'api_url', (
    is      => 'ro',
    writer  => '_set_api_url',
    default => 'https://www.moip.com.br/ws/alpha/EnviarInstrucao/Unica'
);

has 'sandbox', (
    is      => 'rw',
    default => 0,
    trigger => sub {
        my ($self, $sandbox) = @_;
        $self->_set_api_url( $sandbox
            ? 'https://desenvolvedor.moip.com.br/sandbox/ws/alpha/EnviarInstrucao/Unica'
            : 'https://www.moip.com.br/ws/alpha/EnviarInstrucao/Unica'
        );
    }
);

has 'decode_as', is => 'rw', default => undef;

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

    my $xml  = $self->_gen_xml( $args );
    my $auth = 'Basic ' . MIME::Base64::encode( $self->token . ':' . $self->key, '');

    my $res = $self->ua->post(
        $self->api_url,
        [ 'Authorization' => $auth ],
        $xml
    );

    my %data = ( response => $res );
    if ($res->is_success) {
        my $c = $res->content;
        $data{id}     = $1 if $c =~ m{(.+?)};
        $data{status} = $1 if $c =~ m{(.+?)};
        $data{token}  = $1 if $c =~ m{(.+?)};

        while ($c =~ m{(.+?)}gs) {
            push @{$data{erros}}, { codigo => $1, mensagem => $2 };
        }
    }

    return \%data;
}

sub _gen_xml {
    my ($self, $args) = @_;
    my $xml;

    my $generator = XML::Generator::PerlData->new(
        Handler  => XML::SAX::Writer->new(
                        Output     => \$xml,
                        EncodeFrom => $self->decode_as,
                        EncodeTo   => 'iso-8859-1'
                    ),
        rootname => 'EnviarInstrucao',
        keymap   => {
            '*' => \&String::CamelCase::camelize,
            'url_notificacao' => 'URLNotificacao',
            'url_logo'        => 'URLLogo',
            'url_retorno'     => 'URLRetorno',
        },
        attrmap  => { InstrucaoUnica => ['TipoValidacao']  },
    );

    no autovivification;

    $args->{valores}{valor} = delete $args->{valor};

    if (my $acrescimo = delete $args->{acrescimo}) {
        $args->{valores}{acrescimo} = $acrescimo;
    }

    if (my $deducao = delete $args->{deducao}) {
        $args->{valores}{deducao} = $deducao;
    }

    if (my $cep = delete $args->{pagador}{endereco_cobranca}{cep}) {
        $args->{pagador}{endereco_cobranca}{CEP} = $cep;
    }

    my $xml_args  = { instrucao_unica => $args };

    $generator->parse( $xml_args );

    # FIXME: XML::Generator::PerlData does not know how to handle
    # elements with attributes *and* (leaf) data inside. And of course
    # Moip requires just that.
    if (exists $xml_args->{instrucao_unica}{pagador}{identidade}) {
        $xml =~ s{(\d+)}
                 {$1};
    }

    return $xml;
}

1;
__END__