#!/usr/bin/perl -w use strict; use XML::Twig; use FindBin qw($Bin); use lib $Bin; use wtr2_base; my $DEBUG=0; init_db(); # XML::Twig can output the updated document, whith the error messages my $CAN_OUTPUT= 1; my @files= @ARGV || (<$dir{invoices}/*.xml>); foreach my $file (@files) { my $doc= XML::Twig->new( pretty_print => 'indented')->parsefile( $file); my $xml= $doc->simplify( forcearray => [ qw(InvoiceRow)], forcecontent => 1); my $errors= check_invoice( $xml); if( !@$errors) { store_invoice( $xml); } 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); add_errors( $doc, $errors); output_doc_to_check( $rejected_file, $doc); } }; } exit; sub check_invoice { my( $xml)= @_; my $errors=[]; # array ref, holds the error messages check_buyer( $xml->{BuyerPartyDetails}->{BuyerPartyIdentifier}->{content}, $xml->{BuyerPartyDetails}->{BuyerOrganisationName}->{content}, $errors ); check_po( $xml->{InvoiceDetails}->{OrderIdentifier}->{content}, $errors); my @rows= @{$xml->{InvoiceRow}}; reset_default_row_id(); foreach my $row( @rows) { # this does not cope well with broken row numbers my $row_id= $row->{RowIdentifier}->{content} || default_row_id(); print "checking row $row_id\n" if $DEBUG; check_qtty( $row_id, $row->{DeliveredQuantity}->{content}, $row->{DeliveredQuantity}->{QuantityUnitCode}, $row->{OrderedQuantity}->{content}, $row->{OrderedQuantity}->{QuantityUnitCode}, $errors ); } return $errors; } sub store_invoice { my( $xml)= @_; print "storing invoice $xml->{InvoiceDetails}->{InvoiceNumber}->{content}\n"; # build the various data structures my $data; my $invoice = $xml->{InvoiceDetails}; $data->{invoice} = { number => $invoice->{InvoiceNumber}->{content}, date => $invoice->{InvoiceDate}->{content}, po => $invoice->{OrderIdentifier}->{content}, amount_no_tax => $invoice->{InvoiceTotalVatExcludedAmount}->{content}, tax => $invoice->{InvoiceTotalVatAmount}->{content}, amount => $invoice->{InvoiceTotalVatIncludedAmount}->{content}, payment_status => $xml->{PaymentStatusDetails}->{PaymentStatusCode}->{content}, }; my $seller = $xml->{SellerPartyDetails}; $data->{seller} = { identifier => $seller->{SellerPartyIdentifier}->{content}, name => $seller->{SellerOrganisationName}->{content}, tax_code => $seller->{SellerOrganisationTaxCode}->{content}, }; my $address = $xml->{SellerPartyDetails}->{SellerPostalAddressDetails}; $data->{address} = { street => $address->{SellerStreetName}->{content}, town => $address->{SellerTownName}->{content}, zip => $address->{SellerPostCodeIdentifier}->{content}, country_code => $address->{CountryCode}->{content}, po_box => $address->{SellerPostOfficeBoxIdentifier}->{content}, }; $data->{contact} = { name => $xml->{SellerContactPersonName}->{content}, phone => $xml->{SellerCommunicationDetails}->{SellerPhoneNumberIdentifier}->{content}, email => $xml->{SellerCommunicationDetails}->{SellerEmailaddressIdentifier}->{content}, }; $data->{invoicerow} ||= []; reset_default_row_id(); foreach my $invoicerow (@{$xml->{InvoiceRow}}) { push @{$data->{invoicerow}}, { row_id => $invoicerow->{RowIdentifier}->{content} || default_row_id(), sku => $invoicerow->{ArticleIdentifier}->{content}, name => $invoicerow->{ArticleName}->{content}, qty => $invoicerow->{DeliveredQuantity}->{content}, qty_unit => $invoicerow->{DeliveredQuantity}->{QuantityUnitCode}, unit_price => $invoicerow->{UnitPriceAmount}->{content}, amount_no_tax => $invoicerow->{RowVatExcludedAmount}->{content}, tax => $invoicerow->{RowVatAmount}->{content}, amount => $invoicerow->{RowAmount}->{content}, } } store_all( $data); } sub add_errors { my( $doc, $error_messages)= @_; my $errors= $doc->root->insert_new_elt( first_child => 'errors'); foreach my $message (@$error_messages) { $errors->insert_new_elt( last_child => error => $message); } return $doc; } sub output_doc_to_check { my( $file, $doc)= @_; open( FILE, ">$file") or die "cannot create file to check $file: $!"; $doc->print( \*FILE); close FILE; } __END__ =head1 NAME wtr2_twig_simple =head1 SYNOPSYS perl wtr2_twig_simple =head1 DESCRIPTION This code uses L to process the invoices As this code was written after the C example, it was very, very easy to write. I blatantly cheated ;--): it uses XML::Twig C method, which generates the same data structure as XML::Simple for a document (or an element) (available only in XML::Twig 3.10). So once the XML document is parsed in memory a call to that method gives me a data structure that can be processed with exactly the same code as in C. The original document is still in memory though, which makes it possible to update it with the error messages and output it. Note that in this example the only modification of the original document is the addition of the error messages. If I had needed to change data within the document before outputing it (for example to link the error messages to the place where th error occurs), then I would have had to access it using XML::Twig methods, see C>. =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 L, L, wtr2_simple Ways to Rome 2 - Kourallinen Dollareita: http://www.xmltwig.com/article/ways_to_rome_2/