SL/XMLInvoice/UBL.pm

   1 package SL::XMLInvoice::UBL;
   2
   3 use strict;
   4 use warnings;
   5
   6 use parent qw(SL::XMLInvoice::Base);
   7
   8 use constant ITEMS_XPATH => '//cac:InvoiceLine';
   9
  10 =head1 NAME
  11
  12 SL::XMLInvoice::UBL - XML parser for Universal Business Language invoices
  13
  14 =head1 DESCRIPTION
  15
  16 C<SL::XMLInvoice::UBL> parses XML invoices in Oasis Universal Business
  17 Language format and makes their data available through the interface defined
  18 by C<SL::XMLInvoice>. Refer to L<SL::XMLInvoice> for a detailed description of
  19 that interface.
  20
  21 See L<http://docs.oasis-open.org/ubl/os-UBL-2.1/UBL-2.1.html#T-INVOICE> for
  22 that format's 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 = ( "Oasis Universal Business Language (UBL) invoice version 2 (urn:oasis:names:specification:ubl:schema:xsd:Invoice-2)" );
  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:oasis:names:specification:ubl:schema:xsd:Invoice-2/ ) {
  69       return 1;
  70       }
  71     }
  72
  73   return 0;
  74 }
  75
  76 # XML XPath expressions for scalar metadata
  77 sub scalar_xpaths {
  78   return {
  79     currency => '//cbc:DocumentCurrencyCode',
  80     direct_debit => '//cbc:PaymentMeansCode[@listID="UN/ECE 4461"]',
  81     duedate => '//cbc:DueDate',
  82     gross_total => '//cac:LegalMonetaryTotal/cbc:TaxInclusiveAmount',
  83     iban => '//cac:PayeeFinancialAccount/cbc:ID',
  84     invnumber => '//cbc:ID',
  85     net_total => '//cac:LegalMonetaryTotal/cbc:TaxExclusiveAmount',
  86     transdate => '//cbc:IssueDate',
  87     type => '//cbc:InvoiceTypeCode',
  88     taxnumber => '//cac:AccountingSupplierParty/cac:Party/cac:PartyTaxScheme/cbc:CompanyID',
  89     ustid => '//cac:AccountingSupplierParty/cac:Party/cac:PartyTaxScheme/cbc:CompanyID',
  90     vendor_name => '//cac:AccountingSupplierParty/cac:Party/cac:PartyName/cbc:Name',
  91   };
  92 }
  93
  94 # XML XPath expressions for parsing bill items
  95 sub item_xpaths {
  96   return {
  97     'currency' => './cbc:LineExtensionAmount[attribute::currencyID]',
  98     'price' => './cac:Price/cbc:PriceAmount',
  99     'description' => './cac:Item/cbc:Description',
 100     'quantity' => './cbc:InvoicedQuantity',
 101     'subtotal' => './cbc:LineExtensionAmount',
 102     'tax_rate' => './/cac:ClassifiedTaxCategory/cbc:Percent',
 103     'tax_scheme' => './cac:Item/cac:ClassifiedTaxCategory/cac:TaxScheme/cbc:ID',
 104     'vendor_partno' => './cac:Item/cac:SellersItemIdentification/cbc:ID',
 105   };
 106 }
 107
 108
 109 # Metadata accessor method
 110 sub metadata {
 111   my $self = shift;
 112   return $self->{_metadata};
 113 }
 114
 115 # Item list accessor method
 116 sub items {
 117   my $self = shift;
 118   return $self->{_items};
 119 }
 120
 121 sub _xpath_context {
 122   my $xc = XML::LibXML::XPathContext->new;
 123   $xc->registerNs(cac => 'urn:oasis:names:specification:ubl:schema:xsd:CommonAggregateComponents-2');
 124   $xc->registerNs(cec => 'urn:oasis:names:specification:ubl:schema:xsd:CommonExtensionComponents-2');
 125   $xc->registerNs(cbc => 'urn:oasis:names:specification:ubl:schema:xsd:CommonBasicComponents-2');
 126   $xc;
 127 }
 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     my $xpath = ${$self->scalar_xpaths}{$key};
 161     my $value = $xc->find($xpath, $self->{dom});
 162     if ( $value ) {
 163       # Get rid of extraneous white space
 164       $value = $value->string_value;
 165       $value =~ s/\n|\r//g;
 166       $value =~ s/\s{2,}/ /g;
 167       ${$self->{_metadata}}{$key} = $value;
 168     } else {
 169       ${$self->{_metadata}}{$key} = undef;
 170     }
 171   }
 172
 173   # Convert payment code metadata field to Boolean
 174   # See https://service.unece.org/trade/untdid/d16b/tred/tred4461.htm for other valid codes.
 175   if (${$self->{_metadata}}{'direct_debit'}) {
 176     ${$self->{_metadata}}{'direct_debit'} = ${$self->{_metadata}}{'direct_debit'} == 59 ? 1 : 0;
 177   }
 178
 179   # UBL does not have a specified way of designating the tax scheme, so we'll
 180   # have to guess whether it's a tax ID or VAT ID (not using
 181   # SL::VATIDNr->validate here to keep this code portable):
 182
 183   if ( ${$self->{_metadata}}{'ustid'} =~ qr"/" ) {
 184       # Unset this since the 'taxid' key has been retrieved with the same xpath
 185       # expression.
 186       ${$self->{_metadata}}{'ustid'} = undef;
 187   } else {
 188       # Unset this since the 'ustid' key has been retrieved with the same xpath
 189       # expression.
 190       ${$self->{_metadata}}{'taxnumber'} = undef;
 191   }
 192
 193   my @items;
 194   $self->{_items} = \@items;
 195
 196   foreach my $item ( $xc->findnodes(ITEMS_XPATH, $self->{dom}) ) {
 197     my %line_item;
 198     foreach my $key ( keys %{$self->item_xpaths} ) {
 199       my $xpath = ${$self->item_xpaths}{$key};
 200       my $value = $xc->find($xpath, $item);
 201       if ( $value ) {
 202         # Get rid of extraneous white space
 203         $value = $value->string_value;
 204         $value =~ s/\n|\r//g;
 205         $value =~ s/\s{2,}/ /g;
 206         $line_item{$key} = $value;
 207       } else {
 208         $line_item{$key} = undef;
 209       }
 210     }
 211     push @items, \%line_item;
 212   }
 213
 214
 215 }
 216
 217 1;