#!/usr/bin/perl use strict; use XML::Smart; use FindBin qw($Bin); use lib $Bin; use wtr2_base; init_db(); my $DEBUG=0; my $CAN_OUTPUT= 1; my @files= @ARGV || (<$dir{invoices}/*.xml>); foreach my $file (@files) { my $doc= XML::Smart->new( $file); my $xml= $doc->{Finvoice}; 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}, $xml->{BuyerPartyDetails}->{BuyerOrganisationName}, $errors ); check_po( $xml->{InvoiceDetails}->{OrderIdentifier}, $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} || default_row_id(); print "checking row $row_id\n" if $DEBUG; check_qtty( $row_id, $row->{DeliveredQuantity}, $row->{DeliveredQuantity}->{QuantityUnitCode}, $row->{OrderedQuantity}, $row->{OrderedQuantity}->{QuantityUnitCode}, $errors ); } return $errors; } sub store_invoice { my( $xml)= @_; print "storing invoice $xml->{InvoiceDetails}->{InvoiceNumber}\n"; # build the various data structures my $data; my $invoice = $xml->{InvoiceDetails}; $data->{invoice} = { number => $invoice->{InvoiceNumber}, date => $invoice->{InvoiceDate}, po => $invoice->{OrderIdentifier}, amount_no_tax => $invoice->{InvoiceTotalVatExcludedAmount}, tax => $invoice->{InvoiceTotalVatAmount}, amount => $invoice->{InvoiceTotalVatIncludedAmount}, payment_status => $xml->{PaymentStatusDetails}->{PaymentStatusCode}, }; my $seller = $xml->{SellerPartyDetails}; $data->{seller} = { identifier => $seller->{SellerPartyIdentifier}, name => $seller->{SellerOrganisationName}, tax_code => $seller->{SellerOrganisationTaxCode}, }; my $address = $xml->{SellerPartyDetails}->{SellerPostalAddressDetails}; $data->{address} = { street => $address->{SellerStreetName}, town => $address->{SellerTownName}, zip => $address->{SellerPostCodeIdentifier}, country_code => $address->{CountryCode}, po_box => $address->{SellerPostOfficeBoxIdentifier}, }; $data->{contact} = { name => $xml->{SellerContactPersonName}, phone => $xml->{SellerCommunicationDetails}->{SellerPhoneNumberIdentifier}, email => $xml->{SellerCommunicationDetails}->{SellerEmailaddressIdentifier}, }; $data->{invoicerow} ||= []; reset_default_row_id(); foreach my $invoicerow (@{$xml->{InvoiceRow}}) { push @{$data->{invoicerow}}, { row_id => $invoicerow->{RowIdentifier} || default_row_id(), sku => $invoicerow->{ArticleIdentifier}, name => $invoicerow->{ArticleName}, qty => $invoicerow->{DeliveredQuantity}, qty_unit => $invoicerow->{DeliveredQuantity}->{QuantityUnitCode}, unit_price => $invoicerow->{UnitPriceAmount}, amount_no_tax => $invoicerow->{RowVatExcludedAmount}, tax => $invoicerow->{RowVatAmount}, amount => $invoicerow->{RowAmount}, } } store_all( $data); } sub add_errors { my( $doc, $error_messages)= @_; my $errors= { error => [@$error_messages]}; unshift @$doc, $errors; return $doc; } sub output_doc_to_check { my( $file, $doc)= @_; open( FILE, ">$file") or die "cannot create file to check $file: $!"; print FILE $doc->data; close FILE; } __END__ =head1 NAME wtr2_smart =head1 SYNOPSYS perl wtr2_smart =head1 DESCRIPTION I wrote this L example after having written the L one and I must say I was impressed by how compatible it was: it took me a good 10 minutes to modufy the wtr2_simple code to get this one: basically understanding that I needed to work with C< <$xml->{Finvoice} >> instead of directly the original C<$xml> object, and removing all the extra C<< ->{content} >> calls as XML::Smart lets me happily get the content of an element using C<< $row->{DeliveredQuantity} >> and the value of an attribute with C<< $row->{DeliveredQuantity}->{QuantityUnitCode} >>. Very neat. In 10 more minutes I could add the errors, by just unshifting the newly created container in the document object. One big annoyance with this module: I had to remove the C<-w> switch as I kept getting warnings. This should be in the TODO list of the author (along with the unnecessary attacks against XML::Simple in the docs, the module can stand on its own and certainly does not need them). =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 Ways to Rome 2 - Kourallinen Dollareita: http://www.xmltwig.com/article/ways_to_rome_2/