view release on metacpan or  search on metacpan

lib/Business/BR/NFSe.pm  view on Meta::CPAN

    );

    # dCompet é YYYY-MM-DD
    my $d_compet = substr($d{data_emissao}, 0, 10);

    # --- 2. Tomador ---
    my $toma_id;
    if    (defined $d{cpf_tomador})    { $toma_id = "<CPF>$d{cpf_tomador}</CPF>" }
    elsif (defined $d{cnpj_tomador})   { $toma_id = "<CNPJ>$d{cnpj_tomador}</CNPJ>" }
    else                               { $toma_id = "<cNaoNIF>$d{nao_nif_tomador}</cNaoNIF>" }

    # --- 3. Constrói XML infDPS ---
    my $inf_dps = join '',
        qq(<infDPS Id="$id_dps">),
        qq(<tpAmb>$d{ambiente}</tpAmb>),
        qq(<dhEmi>$d{data_emissao}</dhEmi>),
         q(<verAplic>BUSINESS_BR_NFSE_V1</verAplic>),
        qq(<serie>$d{serie}</serie>),
        qq(<nDPS>$d{n_dps}</nDPS>),
        qq(<dCompet>$d_compet</dCompet>),
         q(<tpEmit>1</tpEmit>),
        qq(<cLocEmi>$d{ibge_cidade}</cLocEmi>),
         q(<prest>),
          qq(<CNPJ>$d{cnpj_prestador}</CNPJ>),
          (defined $d{email_prestador} ? qq(<email>$d{email_prestador}</email>) : ()),
           q(<regTrib>),
            qq(<opSimpNac>$d{op_simples_nacional}</opSimpNac>),
            qq(<regApTribSN>$d{reg_ap_trib_sn}</regApTribSN>),
            qq(<regEspTrib>$d{regime_especial}</regEspTrib>),
           q(</regTrib>),
         q(</prest>),
        qq(<toma>${toma_id}<xNome>) . _xml_escape($d{nome_tomador}) . q(</xNome></toma>),
         q(<serv>),
          qq(<locPrest><cLocPrestacao>$d{ibge_cidade}</cLocPrestacao></locPrest>),
           q(<cServ>),
            qq(<cTribNac>$d{cod_tributacao_nacional}</cTribNac>),
            qq(<cTribMun>$d{cod_tributacao_municipal}</cTribMun>),
            qq(<xDescServ>) . _xml_escape($d{descricao_servico}) . q(</xDescServ>),
           q(</cServ>),
         q(</serv>),
         q(<valores>),
          qq(<vServPrest><vServ>$d{valor_servico}</vServ></vServPrest>),
           q(<trib>),
             q(<tribMun><tribISSQN>1</tribISSQN><tpRetISSQN>1</tpRetISSQN></tribMun>),
             q(<tribFed><piscofins><CST>00</CST></piscofins></tribFed>),
            qq(<totTrib><pTotTribSN>$d{p_tot_trib_sn}</pTotTribSN></totTrib>),
           q(</trib>),
         q(</valores>),
         q(</infDPS>);

    # --- 4. Digest do infDPS ---
    # O elemento sendo assinado herda o namespace do pai no documento final,
    # então adicionamos o xmlns explicitamente antes do hash.
    (my $inf_dps_for_hash = $inf_dps) =~ s/<infDPS/<infDPS xmlns="$NS"/;
    my $digest_b64 = encode_base64(sha256(encode('UTF-8', $inf_dps_for_hash)), '');

    # --- 5. SignedInfo ---
    # Precisa fechar tags explicitamente (nada de auto-fechar) porque o servidor verifica
    # as tags contra o formulário canônico exc-c14n#WithComments, que expande <Bla/> em <Bla></Bla>.
    my $signed_info = join '',
        q(<SignedInfo xmlns="http://www.w3.org/2000/09/xmldsig#">),
        q(<CanonicalizationMethod Algorithm="http://www.w3.org/2001/10/xml-exc-c14n#WithComments"></CanonicalizationMethod>),
        q(<SignatureMethod Algorithm="http://www.w3.org/2001/04/xmldsig-more#rsa-sha256"></SignatureMethod>),
        qq(<Reference URI="#$id_dps">),
          q(<Transforms>),
            q(<Transform Algorithm="http://www.w3.org/2000/09/xmldsig#enveloped-signature"></Transform>),
            q(<Transform Algorithm="http://www.w3.org/2001/10/xml-exc-c14n#WithComments"></Transform>),
          q(</Transforms>),
          q(<DigestMethod Algorithm="http://www.w3.org/2001/04/xmlenc#sha256"></DigestMethod>),
          qq(<DigestValue>$digest_b64</DigestValue>),
        q(</Reference>),
        q(</SignedInfo>);

    # --- 6. Assinatura RSA-SHA256 sobre os bytes SignedInfo ---
    my $rsa     = Crypt::PK::RSA->new(\$self->{key_pem});
    my $sig_b64 = encode_base64($rsa->sign_message(encode('UTF-8', $signed_info), 'SHA256', 'v1.5'), '');

    # --- 7. Monta o XML final ---
    my $xml = join '',
        q(<?xml version="1.0" encoding="UTF-8"?>),
        qq(<DPS xmlns="$NS" versao="$VERSAO">),
          $inf_dps,
          q(<Signature xmlns="http://www.w3.org/2000/09/xmldsig#">),
            $signed_info,
            qq(<SignatureValue>$sig_b64</SignatureValue>),
            qq(<KeyInfo><X509Data><X509Certificate>$self->{cert_b64}</X509Certificate></X509Data></KeyInfo>),
          q(</Signature>),
        q(</DPS>);

    # --- 8. GZip + base64 ---
    my $xml_bytes = encode('UTF-8', $xml);
    my $gzipped;
    gzip(\$xml_bytes, \$gzipped) or croak "gzip failed: $GzipError";
    my $payload_b64 = encode_base64($gzipped, '');

    # --- 9. POST com TLS mútuo ---
    my $res = $self->{http}->post(
        $self->{_url},
        {
            content => encode_json({ dpsXmlGZipB64 => $payload_b64 }),
            headers => { 'Content-Type' => 'application/json' },
        },
    );
    my $body = eval { decode_json($res->{content}) } // {};
    return $body;
}


sub danfse {
    my ($self, $chave_acesso) = @_;
    croak "danfse() precisa de uma chave de acesso." unless defined $chave_acesso;
    my $res = $self->{http}->get('https://adn.nfse.gov.br/danfse/' . $chave_acesso);
    return $res->{success} ? $res->{content} : ();
}


sub _slurp {
    my ($path) = @_;
    open my $fh, '<', $path or croak "Cannot open '$path': $!";
    local $/;
    my $content = <$fh>;
    close $fh;
    return $content;
}

sub _xml_escape {
    my ($str) = @_;
    $str =~ s/&/&amp;/g;
    $str =~ s/</&lt;/g;
    $str =~ s/>/&gt;/g;
    return $str;
}

1;

__END__
=encoding utf8

=head1 NAME

Business::BR::NFSe - Consulta e emissão de NFS-e (Nota Fiscal de Serviços Eletrônica)
via API REST do Emissor Nacional (Sefin)