#!/usr/bin/perl -w use strict; use XML::EasyOBJ; use FindBin qw($Bin); use lib $Bin; use wtr2_base; init_db(); my $DEBUG=0; my $CAN_OUTPUT= 0; my @files= @ARGV || (<$dir{invoices}/*.xml>); foreach my $file (@files) { my $doc = XML::EasyOBJ->new( $file); my $errors= check_invoice( $doc); if( !@$errors) { store_invoice( $doc); } else { print "ERROR in $file\n ", join( "\n ", @$errors), "\n"; if( $CAN_OUTPUT) { my $rejected_file= rejected( $file); print "adding errors in $rejected_file\n" if( $DEBUG); my $dom= $doc->getDomObj->getOwnerDocument; # we need to use the DOM for this add_errors( $dom, $errors); output_doc_to_check( $rejected_file, $dom); } }; } exit; sub check_invoice { my( $doc)= @_; my $errors=[]; # array ref, holds the error messages my $BuyerPartyDetails = $doc->BuyerPartyDetails; my $BuyerPartyIdentifier = $BuyerPartyDetails->BuyerPartyIdentifier; my $BuyerOrganisationName = $BuyerPartyDetails->BuyerOrganisationName; check_buyer( $BuyerPartyIdentifier->getString, $BuyerOrganisationName->getString, $errors ); my $InvoiceDetails = $doc->InvoiceDetails; my $OrderIdentifier = $InvoiceDetails->OrderIdentifier; check_po( $OrderIdentifier->getString, $errors); my @rows= $doc->InvoiceRow; reset_default_row_id(); foreach my $row ( @rows) { # this does not cope well with broken row numbers my $row_id= $row->RowIdentifier->getString || default_row_id(); print "checking row $row_id\n" if $DEBUG; my $DeliveredQuantity= $row->DeliveredQuantity; my $OrderedQuantity = $row->OrderedQuantity; my( $delivered_qty, $delivered_unit, $ordered_qty, $ordered_unit)= ('','','',''); if( $DeliveredQuantity) { $delivered_qty = $DeliveredQuantity->getString; $delivered_unit = $DeliveredQuantity->getAttr( 'QuantityUnitCode'); } if( $OrderedQuantity) { $ordered_qty = $OrderedQuantity->getString; $ordered_unit = $OrderedQuantity->getAttr( 'QuantityUnitCode'); } check_qtty( $row_id, $delivered_qty, $delivered_unit, $ordered_qty, $ordered_unit, $errors); } return $errors; } sub store_invoice { my( $doc)= @_; print "storing invoice ", $doc->InvoiceDetails->InvoiceNumber->getString, "\n"; # build the various data structures my $data; my $invoice = $doc->InvoiceDetails; $data->{invoice} = { number => $invoice->InvoiceNumber->getString, date => $invoice->InvoiceDate->getString, po => $invoice->OrderIdentifier->getString, amount_no_tax => $invoice->InvoiceTotalVatExcludedAmount->getString, tax => $invoice->InvoiceTotalVatAmount->getString, amount => $invoice->InvoiceTotalVatIncludedAmount->getString, payment_status => $doc->PaymentStatusDetails->PaymentStatusCode->getString, }; my $seller = $doc->SellerPartyDetails; $data->{seller} = { identifier => $seller->SellerPartyIdentifier->getString, name => $seller->SellerOrganisationName->getString, tax_code => $seller->SellerOrganisationTaxCode->getString, }; my $address = $doc->SellerPartyDetails->SellerPostalAddressDetails; $data->{address} = { street => $address->SellerStreetName->getString, town => $address->SellerTownName->getString, zip => $address->SellerPostCodeIdentifier->getString, country_code => $address->CountryCode->getString, po_box => $address->SellerPostOfficeBoxIdentifier->getString, }; my $contact = $doc->SellerCommunicationDetails; $data->{contact} = { name => $doc->SellerContactPersonName->getString, phone => $contact->SellerPhoneNumberIdentifier->getString, email => $contact->SellerEmailaddressIdentifier->getString, }; $data->{invoicerow} ||= []; reset_default_row_id(); foreach my $invoicerow ( $doc->InvoiceRow) { # need to check that the DeliveredQuantity element is present before getting its attribute my $DeliveredQuantity= $invoicerow->DeliveredQuantity; my( $qty, $qty_unit)= ('',''); if( $DeliveredQuantity) { $qty = $DeliveredQuantity->getString; $qty_unit = $DeliveredQuantity->getAttr( 'QuantityUnitCode'); } push @{$data->{invoicerow}}, { row_id => $invoicerow->RowIdentifier->getString || default_row_id(), sku => $invoicerow->ArticleIdentifier->getString, name => $invoicerow->ArticleName->getString, qty => $qty, qty_unit => $qty_unit, unit_price => $invoicerow->UnitPriceAmount->getString, amount_no_tax => $invoicerow->RowVatExcludedAmount->getString, tax => $invoicerow->RowVatAmount->getString, amount => $invoicerow->RowAmount->getString, } } store_all( $data); } sub add_errors { my( $doc, $error_messages)= @_; my $root= $doc->getDocumentElement; my $errors= $doc->createElement( 'errors'); $root->insertBefore ( $errors, $root->getFirstChild); foreach my $message (@$error_messages) { my $error= $doc->createElement( 'error'); $errors->appendChild( $error); # those 2 lines could be replaced by $error->addText( $message) # which is not in the DOM spec my $text= $doc->createTextNode( $message); $error->appendChild( $text); } return $doc; } sub output_doc_to_check { my( $file, $doc)= @_; open( FILE, ">$file") or die "cannot create file to check $file: $!"; print FILE $doc->toString; close FILE; } __END__ =head1 NAME wtr2_easyobj =head1 SYNOPSYS perl wtr2_easyobj =head1 DESCRIPTION This code uses L to process the invoices XML::EasyOBJ is built on top of L, and mostly allows for easy navigation by letting you write C<< $invoice= $doc->InvoiceDetails->InvoiceNumber >> to get the invoice number element, and C<< $invoice->getString >> to get its value. The fact that tag names (from the document) are used as method names in the code feels a little weird, and it can make name collision possible (XML::EasyOBJ lets you rename methods though, so you can deal with this problem). It makes it really easy to work with these invoices though, the code was easy to write and The bad news here is that XML::EasyOBJ mostly helps you accessing the data. If you want to create new elements you have to use the DOM methods. Overall XML::EasyOBJ feels like a very convenient layer on top of the DOM, which lets you easily navigate and access the data in the DOM (making easy things easy), and lets you use native DOM methods for advanced (making harder things possible). =head1 AUTHOR Michel Rodriguez =head1 LICENSE This code is Copyright (c) 2003 Michel Rodriguez. All rights reserved. This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. Comments can be sent to mirod@xmltwig.com =head1 SEE ALSO XML::DOM Ways to Rome 2 - Kourallinen Dollareita : http://www.xmltwig.com/article/ways_to_rome_2/