SL/XMLInvoice/CrossIndustryDocument.pm

   1 package SL::XMLInvoice::CrossIndustryDocument;
   2
   3 use strict;
   4 use warnings;
   5
   6 use parent qw(SL::XMLInvoice::Base);
   7
   8 use constant ITEMS_XPATH => '//ram:IncludedSupplyChainTradeLineItem';
   9
  10 =head1 NAME
  11
  12 SL::XMLInvoice::CrossIndustryDocument - XML parser for UN/CEFACT Cross Industry Document
  13
  14 =head1 DESCRIPTION
  15
  16 C<SL::XMLInvoice::CrossIndustryInvoice> parses XML invoices in UN/CEFACT Cross
  17 Industry Document format (also known as ZUgFeRD 1p0 or ZUgFeRD 1.0)  and makes
  18 their data available through the interface defined by C<SL::XMLInvoice>. Refer
  19 to L<SL::XMLInvoice> for a detailed description of that interface.
  20
  21 See L<https://unece.org/trade/uncefact/xml-schemas> for that format's
  22 specification.
  23
  24 =head1 OPERATION
  25
  26 This module is fairly simple. It keeps two hashes of XPath statements exposed
  27 by methods:
  28
  29 =over 4
  30
  31 =item scalar_xpaths()
  32
  33 This hash is keyed by the keywords C<data_keys> mandates. Values are XPath
  34 statements specifying the location of this field in the invoice XML document.
  35
  36 =item item_xpaths()
  37
  38 This hash is keyed by the keywords C<item_keys> mandates. Values are XPath
  39 statements specifying the location of this field inside a line item.
  40
  41 =back
  42
  43 When invoked by the C<SL::XMLInvoice> constructor, C<parse_xml()> will first
  44 use the XPath statements from the C<scalar_xpaths()> hash to populate the hash
  45 returned by the C<metadata()> method.
  46
  47 After that, it will use the XPath statements from the C<scalar_xpaths()> hash
  48 to iterate over the invoice's line items and populate the array of hashes
  49 returned by the C<items()> method.
  50
  51 =head1 AUTHOR
  52
  53   Johannes Grassler <info@computer-grassler.de>
  54
  55 =cut
  56
  57 sub supported {
  58   my @supported = ( "UN/CEFACT Cross Industry Document/ZUGFeRD 1.0 (urn:ferd:CrossIndustryDocument:invoice:1p0)" );
  59   return @supported;
  60 }
  61
  62 sub check_signature {
  63   my ($self, $dom) = @_;
  64
  65   my $rootnode = $dom->documentElement;
  66
  67   foreach my $attr ( $rootnode->attributes ) {
  68     if ( $attr->getData =~ m/urn:ferd:CrossIndustryDocument:invoice:1p0/ ) {
  69       return 1;
  70       }
  71     }
  72
  73   return 0;
  74 }
  75
  76 # XML XPath expressions for global metadata
  77 sub scalar_xpaths {
  78   return {
  79     currency => ['//ram:InvoiceCurrencyCode'],
  80     direct_debit => ['//ram:SpecifiedTradeSettlementPaymentMeans/ram:TypeCode'],
  81     duedate => ['//ram:DueDateDateTime/udt:DateTimeString', '//ram:EffectiveSpecifiedPeriod/ram:CompleteDateTime/udt:DateTimeString'],
  82     gross_total => ['//ram:DuePayableAmount'],
  83     iban => ['//ram:SpecifiedTradeSettlementPaymentMeans/ram:PayeePartyCreditorFinancialAccount/ram:IBANID'],
  84     invnumber => ['//rsm:HeaderExchangedDocument/ram:ID'],
  85     net_total => ['//ram:TaxBasisTotalAmount'],
  86     transdate => ['//ram:IssueDateTime/udt:DateTimeString'],
  87     taxnumber => ['//ram:SellerTradeParty/ram:SpecifiedTaxRegistration/ram:ID[@schemeID="FC"]'],
  88     type => ['//rsm:HeaderExchangedDocument/ram:TypeCode'],
  89     ustid => ['//ram:SellerTradeParty/ram:SpecifiedTaxRegistration/ram:ID[@schemeID="VA"]'],
  90     vendor_name => ['//ram:SellerTradeParty/ram:Name'],
  91   };
  92 }
  93
  94 sub item_xpaths {
  95   return {
  96     'currency' => ['./ram:SpecifiedSupplyChainTradeAgreement/ram:GrossPriceProductTradePrice/ram:ChargeAmount[attribute::currencyID]',
  97                    './ram:SpecifiedSupplyChainTradeAgreement/ram:GrossPriceProductTradePrice/ram:BasisAmount'],
  98     'price' => ['./ram:SpecifiedSupplyChainTradeAgreement/ram:GrossPriceProductTradePrice/ram:ChargeAmount',
  99                './ram:SpecifiedSupplyChainTradeAgreement/ram:GrossPriceProductTradePrice/ram:BasisAmount'],
 100     'description' => ['./ram:SpecifiedTradeProduct/ram:Name'],
 101     'quantity' => ['./ram:SpecifiedSupplyChainTradeDelivery/ram:BilledQuantity',],
 102     'subtotal' => ['./ram:SpecifiedSupplyChainTradeSettlement/ram:SpecifiedTradeSettlementMonetarySummation/ram:LineTotalAmount'],
 103     'tax_rate' => ['./ram:SpecifiedSupplyChainTradeSettlement/ram:ApplicableTradeTax/ram:ApplicablePercent'],
 104     'tax_scheme' => ['./ram:SpecifiedSupplyChainTradeSettlement/ram:ApplicableTradeTax/ram:TypeCode'],
 105     'vendor_partno' => ['./ram:SpecifiedTradeProduct/ram:SellerAssignedID'],
 106   };
 107 }
 108
 109
 110 # Metadata accessor method
 111 sub metadata {
 112   my $self = shift;
 113   return $self->{_metadata};
 114 }
 115
 116 # Item list accessor method
 117 sub items {
 118   my $self = shift;
 119   return $self->{_items};
 120 }
 121
 122 sub _xpath_context {
 123   my $xc = XML::LibXML::XPathContext->new;
 124   $xc->registerNs(udt => 'urn:un:unece:uncefact:data:standard:UnqualifiedDataType:15');
 125   $xc->registerNs(ram => 'urn:un:unece:uncefact:data:standard:ReusableAggregateBusinessInformationEntity:12');
 126   $xc->registerNs(rsm => 'urn:un:unece:uncefact:data:standard:CrossIndustryInvoice:1p0');
 127   $xc;
 128 }
 129
 130 # Data keys we return
 131 sub _data_keys {
 132   my $self = shift;
 133   my %keys;
 134
 135   map { $keys{$_} = 1; } keys %{$self->scalar_xpaths};
 136
 137   return \%keys;
 138 }
 139
 140 # Item keys we return
 141 sub _item_keys {
 142   my $self = shift;
 143   my %keys;
 144
 145   map { $keys{$_} = 1; } keys %{$self->item_xpaths};
 146
 147   return \%keys;
 148 }
 149
 150 # Main parser subroutine for retrieving XML data
 151 sub parse_xml {
 152   my $self = shift;
 153   $self->{_metadata} = {};
 154   $self->{_items} = ();
 155
 156   my $xc = _xpath_context();
 157
 158   # Retrieve scalar metadata from DOM
 159   foreach my $key ( keys %{$self->scalar_xpaths} ) {
 160     foreach my $xpath ( @{${$self->scalar_xpaths}{$key}} ) {
 161       unless ( $xpath ) {
 162         # Skip keys without xpath list
 163         ${$self->{_metadata}}{$key} = undef;
 164         next;
 165       }
 166       my $value = $xc->find($xpath, $self->{dom});
 167       if ( $value ) {
 168         # Get rid of extraneous white space
 169         $value = $value->string_value;
 170         $value =~ s/\n|\r//g;
 171         $value =~ s/\s{2,}/ /g;
 172         ${$self->{_metadata}}{$key} = $value;
 173         last; # first matching xpath wins
 174       } else {
 175         ${$self->{_metadata}}{$key} = undef;
 176       }
 177     }
 178   }
 179
 180
 181   # Convert payment code metadata field to Boolean
 182   # See https://service.unece.org/trade/untdid/d16b/tred/tred4461.htm for other valid codes.
 183   if (${$self->{_metadata}}{'direct_debit'}) {
 184     ${$self->{_metadata}}{'direct_debit'} = ${$self->{_metadata}}{'direct_debit'} == 59 ? 1 : 0;
 185   }
 186
 187   my @items;
 188   $self->{_items} = \@items;
 189
 190   foreach my $item ( $xc->findnodes(ITEMS_XPATH, $self->{dom}) ) {
 191     my %line_item;
 192     foreach my $key ( keys %{$self->item_xpaths} ) {
 193       foreach my $xpath ( @{${$self->item_xpaths}{$key}} ) {
 194         unless ( $xpath ) {
 195           # Skip keys without xpath list
 196           $line_item{$key} = undef;
 197           next;
 198         }
 199         my $value = $xc->find($xpath, $item);
 200         if ( $value ) {
 201           # Get rid of extraneous white space
 202           $value = $value->string_value;
 203           $value =~ s/\n|\r//g;
 204           $value =~ s/\s{2,}/ /g;
 205           $line_item{$key} = $value;
 206           last; # first matching xpath wins
 207         } else {
 208           $line_item{$key} = undef;
 209         }
 210       }
 211     }
 212     push @items, \%line_item;
 213   }
 214
 215 }
 216
 217 1;