|
package SL::XMLInvoice::CrossIndustryDocument;
|
|
|
|
use strict;
|
|
use warnings;
|
|
|
|
use parent qw(SL::XMLInvoice::Base);
|
|
|
|
=head1 NAME
|
|
|
|
SL::XMLInvoice::CrossIndustryDocument - XML parser for UN/CEFACT Cross Industry Document
|
|
|
|
=head1 DESCRIPTION
|
|
|
|
C<SL::XMLInvoice::CrossIndustryInvoice> parses XML invoices in UN/CEFACT Cross
|
|
Industry Document format (also known as ZUgFeRD 1p0 or ZUgFeRD 1.0) and makes
|
|
their data available through the interface defined by C<SL::XMLInvoice>. Refer
|
|
to L<SL::XMLInvoice> for a detailed description of that interface.
|
|
|
|
See L<https://unece.org/trade/uncefact/xml-schemas> for that format's
|
|
specification.
|
|
|
|
=head1 OPERATION
|
|
|
|
This module is fairly simple. It keeps two hashes of XPath statements exposed
|
|
by methods:
|
|
|
|
=over 4
|
|
|
|
=item scalar_xpaths()
|
|
|
|
This hash is keyed by the keywords C<data_keys> mandates. Values are XPath
|
|
statements specifying the location of this field in the invoice XML document.
|
|
|
|
=item item_xpaths()
|
|
|
|
This hash is keyed by the keywords C<item_keys> mandates. Values are XPath
|
|
statements specifying the location of this field inside a line item.
|
|
|
|
=back
|
|
|
|
When invoked by the C<SL::XMLInvoice> constructor, C<parse_xml()> will first
|
|
use the XPath statements from the C<scalar_xpaths()> hash to populate the hash
|
|
returned by the C<metadata()> method.
|
|
|
|
After that, it will use the XPath statements from the C<scalar_xpaths()> hash
|
|
to iterate over the invoice's line items and populate the array of hashes
|
|
returned by the C<items()> method.
|
|
|
|
=head1 AUTHOR
|
|
|
|
Johannes Grassler <info@computer-grassler.de>
|
|
Werner Hahn <wh@futureworldsearch.net>
|
|
|
|
=cut
|
|
|
|
sub supported {
|
|
my @supported = ( "UN/CEFACT Cross Industry Document/ZUGFeRD 1.0 (urn:ferd:CrossIndustryDocument:invoice:1p0)" );
|
|
return @supported;
|
|
}
|
|
|
|
sub check_signature {
|
|
my ($self, $dom) = @_;
|
|
|
|
my $rootnode = $dom->documentElement;
|
|
|
|
foreach my $attr ( $rootnode->attributes ) {
|
|
if ( $attr->getData =~ m/urn:ferd:CrossIndustryDocument:invoice:1p0/ ) {
|
|
return 1;
|
|
}
|
|
}
|
|
|
|
return 0;
|
|
}
|
|
|
|
sub namespaces {
|
|
my ($self, $dom) = @_;
|
|
my $rootnode = $dom->documentElement;
|
|
my @nodes = $rootnode->findnodes('namespace::*');
|
|
my @namespaces = map {[ $_->getData, $_->getLocalName]} @nodes;
|
|
return \@namespaces;
|
|
}
|
|
|
|
# XML XPath expressions for global metadata
|
|
sub scalar_xpaths {
|
|
my ($self) = @_;
|
|
|
|
my $rsm = $self->{namespaces}->{'urn:un:unece:uncefact:data:standard:CrossIndustryInvoice:100'};
|
|
my $ram = $self->{namespaces}->{'urn:un:unece:uncefact:data:standard:ReusableAggregateBusinessInformationEntity:100'};
|
|
my $udt = $self->{namespaces}->{'urn:un:unece:uncefact:data:standard:UnqualifiedDataType:100'};
|
|
$ram .= ":" if $ram;
|
|
$rsm .= ":" if $rsm;
|
|
$udt .= ":" if $udt;
|
|
|
|
return {
|
|
currency => ['//' . $ram . 'InvoiceCurrencyCode'],
|
|
direct_debit => ['//' . $ram . 'SpecifiedTradeSettlementPaymentMeans/' . $ram . 'TypeCode'],
|
|
duedate => ['//' . $ram . 'DueDateDateTime/' . $udt . 'DateTimeString', '//' . $ram . 'EffectiveSpecifiedPeriod/' . $ram . 'CompleteDateTime/' . $udt . 'DateTimeString'],
|
|
gross_total => ['//' . $ram . 'DuePayableAmount'],
|
|
iban => ['//' . $ram . 'SpecifiedTradeSettlementPaymentMeans/' . $ram . 'PayeePartyCreditorFinancialAccount/' . $ram . 'IBANID'],
|
|
invnumber => ['//' . $rsm . 'HeaderExchangedDocument/' . $ram . 'ID'],
|
|
net_total => ['//' . $ram . 'TaxBasisTotalAmount'],
|
|
transdate => ['//' . $ram . 'IssueDateTime/' . $udt . 'DateTimeString'],
|
|
taxnumber => ['//' . $ram . 'SellerTradeParty/' . $ram . 'SpecifiedTaxRegistration/' . $ram . 'ID[@schemeID="FC"]'],
|
|
type => ['//' . $rsm . 'HeaderExchangedDocument/' . $ram . 'TypeCode'],
|
|
ustid => ['//' . $ram . 'SellerTradeParty/' . $ram . 'SpecifiedTaxRegistration/' . $ram . 'ID[@schemeID="VA"]'],
|
|
vendor_name => ['//' . $ram . 'SellerTradeParty/' . $ram . 'Name'],
|
|
};
|
|
}
|
|
|
|
sub item_xpaths {
|
|
my ($self) = @_;
|
|
|
|
my $rsm = $self->{namespaces}->{'urn:un:unece:uncefact:data:standard:CrossIndustryInvoice:100'};
|
|
my $ram = $self->{namespaces}->{'urn:un:unece:uncefact:data:standard:ReusableAggregateBusinessInformationEntity:100'};
|
|
my $udt = $self->{namespaces}->{'urn:un:unece:uncefact:data:standard:UnqualifiedDataType:100'};
|
|
$ram .= ":" if $ram;
|
|
$rsm .= ":" if $rsm;
|
|
$udt .= ":" if $udt;
|
|
|
|
return {
|
|
'currency' => ['./' . $ram . ':SpecifiedSupplyChainTradeAgreement/' . $ram . ':GrossPriceProductTradePrice/' . $ram . ':ChargeAmount[attribute::currencyID]',
|
|
'./' . $ram . ':SpecifiedSupplyChainTradeAgreement/' . $ram . ':GrossPriceProductTradePrice/' . $ram . ':BasisAmount'],
|
|
'price' => ['./' . $ram . ':SpecifiedSupplyChainTradeAgreement/' . $ram . ':GrossPriceProductTradePrice/' . $ram . ':ChargeAmount',
|
|
'./' . $ram . ':SpecifiedSupplyChainTradeAgreement/' . $ram . ':GrossPriceProductTradePrice/' . $ram . ':BasisAmount'],
|
|
'description' => ['./' . $ram . ':SpecifiedTradeProduct/' . $ram . ':Name'],
|
|
'quantity' => ['./' . $ram . ':SpecifiedSupplyChainTradeDelivery/' . $ram . ':BilledQuantity',],
|
|
'subtotal' => ['./' . $ram . ':SpecifiedSupplyChainTradeSettlement/' . $ram . ':SpecifiedTradeSettlementMonetarySummation/' . $ram . ':LineTotalAmount'],
|
|
'tax_rate' => ['./' . $ram . ':SpecifiedSupplyChainTradeSettlement/' . $ram . ':ApplicableTradeTax/' . $ram . ':ApplicablePercent'],
|
|
'tax_scheme' => ['./' . $ram . ':SpecifiedSupplyChainTradeSettlement/' . $ram . ':ApplicableTradeTax/' . $ram . ':TypeCode'],
|
|
'vendor_partno' => ['./' . $ram . ':SpecifiedTradeProduct/' . $ram . ':SellerAssignedID'],
|
|
};
|
|
}
|
|
|
|
sub items_xpath {
|
|
my ($self) = @_;
|
|
my $rsm = $self->{namespaces}->{'urn:un:unece:uncefact:data:standard:CrossIndustryInvoice:100'};
|
|
my $ram = $self->{namespaces}->{'urn:un:unece:uncefact:data:standard:ReusableAggregateBusinessInformationEntity:100'};
|
|
my $udt = $self->{namespaces}->{'urn:un:unece:uncefact:data:standard:UnqualifiedDataType:100'};
|
|
$ram .= ":" if $ram;
|
|
$rsm .= ":" if $rsm;
|
|
$udt .= ":" if $udt;
|
|
return '//' . $ram . 'IncludedSupplyChainTradeLineItem';
|
|
}
|
|
|
|
# Metadata accessor method
|
|
sub metadata {
|
|
my $self = shift;
|
|
return $self->{_metadata};
|
|
}
|
|
|
|
# Item list accessor method
|
|
sub items {
|
|
my $self = shift;
|
|
return $self->{_items};
|
|
}
|
|
|
|
# Data keys we return
|
|
sub _data_keys {
|
|
my $self = shift;
|
|
my %keys;
|
|
|
|
map { $keys{$_} = 1; } keys %{$self->scalar_xpaths};
|
|
|
|
return \%keys;
|
|
}
|
|
|
|
# Item keys we return
|
|
sub _item_keys {
|
|
my $self = shift;
|
|
my %keys;
|
|
|
|
map { $keys{$_} = 1; } keys %{$self->item_xpaths};
|
|
|
|
return \%keys;
|
|
}
|
|
|
|
# Main parser subroutine for retrieving XML data
|
|
sub parse_xml {
|
|
my $self = shift;
|
|
$self->{_metadata} = {};
|
|
$self->{_items} = ();
|
|
|
|
my $ram = $self->{namespaces}->{'urn:un:unece:uncefact:data:standard:ReusableAggregateBusinessInformationEntity:100'};
|
|
$ram .= ":" if $ram;
|
|
my $udt = $self->{namespaces}->{'urn:un:unece:uncefact:data:standard:UnqualifiedDataType:100'};
|
|
# Retrieve scalar metadata from DOM
|
|
foreach my $key ( keys %{$self->scalar_xpaths} ) {
|
|
foreach my $xpath ( @{${$self->scalar_xpaths}{$key}} ) {
|
|
unless ( $xpath ) {
|
|
# Skip keys without xpath list
|
|
${$self->{_metadata}}{$key} = undef;
|
|
next;
|
|
}
|
|
my $value = $self->{dom}->findnodes($xpath);
|
|
unless ($udt) {
|
|
$value = $self->{dom}->findnodes('//' . $ram . 'DueDateDateTime','DateTimeString') if $key eq 'duedate';
|
|
$value = $self->{dom}->findnodes('//' . $ram . 'IssueDateTime','DateTimeString') if $key eq 'transdate';
|
|
}
|
|
if ( $value ) {
|
|
# Get rid of extraneous white space
|
|
$value = $value->string_value;
|
|
$value =~ s/\n|\r//g;
|
|
$value =~ s/\s{2,}/ /g;
|
|
${$self->{_metadata}}{$key} = $value;
|
|
last; # first matching xpath wins
|
|
} else {
|
|
${$self->{_metadata}}{$key} = undef;
|
|
}
|
|
}
|
|
}
|
|
|
|
|
|
# Convert payment code metadata field to Boolean
|
|
# See https://service.unece.org/trade/untdid/d16b/tred/tred4461.htm for other valid codes.
|
|
${$self->{_metadata}}{'direct_debit'} = ${$self->{_metadata}}{'direct_debit'} == 59 ? 1 : 0;
|
|
|
|
my @items;
|
|
$self->{_items} = \@items;
|
|
|
|
foreach my $item ( $self->{dom}->findnodes($self->items_xpath)) {
|
|
my %line_item;
|
|
foreach my $key ( keys %{$self->item_xpaths} ) {
|
|
foreach my $xpath ( @{${$self->item_xpaths}{$key}} ) {
|
|
unless ( $xpath ) {
|
|
# Skip keys without xpath list
|
|
$line_item{$key} = undef;
|
|
next;
|
|
}
|
|
my $value = $item->findnodes($xpath);
|
|
if ( $value ) {
|
|
# Get rid of extraneous white space
|
|
$value = $value->string_value;
|
|
$value =~ s/\n|\r//g;
|
|
$value =~ s/\s{2,}/ /g;
|
|
$line_item{$key} = $value;
|
|
last; # first matching xpath wins
|
|
} else {
|
|
$line_item{$key} = undef;
|
|
}
|
|
}
|
|
}
|
|
push @items, \%line_item;
|
|
}
|
|
|
|
}
|
|
|
|
1;
|