#!/usr/bin/perl -w
use strict;

use XML::LibXML;

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 $parser = new XML::LibXML;
    my $doc = $parser->parse_file ( $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);
            add_errors( $doc, $errors);
            output_doc_to_check(  $rejected_file, $doc);
          }
      };
  }

exit;

sub check_invoice
  { my( $doc)= @_;
    my $root= $doc->getDocumentElement; # so we really work with the root element
    my $errors=[];  # array ref, holds the error messages

    my $BuyerPartyDetails     = first_child( $root, 'BuyerPartyDetails');
    my $BuyerPartyIdentifier  = first_child( $BuyerPartyDetails, 'BuyerPartyIdentifier');
    my $BuyerOrganisationName = first_child( $BuyerPartyDetails, 'BuyerOrganisationName');
    check_buyer(  text( $BuyerPartyIdentifier),
                  text( $BuyerOrganisationName),
                  $errors
               );
    my $InvoiceDetails  = first_child( $root, 'InvoiceDetails');
    my $OrderIdentifier = first_child( $InvoiceDetails, 'OrderIdentifier');
    check_po( text( $OrderIdentifier), $errors);

    my @rows= children( $root, 'InvoiceRow');

    reset_default_row_id();
    
    foreach my $row ( @rows)
      { # this does not cope well with broken row numbers

        my $row_id= text( first_child( $row, 'RowIdentifier')) || default_row_id();
        
        print "checking row $row_id\n" if $DEBUG;

        my $DeliveredQuantity= first_child( $row, 'DeliveredQuantity');
        my $OrderedQuantity  = first_child( $row, 'OrderedQuantity');

        my $delivered_qty  = text( $DeliveredQuantity);
        my $delivered_unit = $DeliveredQuantity ? $DeliveredQuantity->getAttribute( 'QuantityUnitCode') : '';
        my $ordered_qty    = text( $OrderedQuantity);
        my $ordered_unit   = $OrderedQuantity ? $OrderedQuantity->getAttribute( 'QuantityUnitCode') : '';

        check_qtty( $row_id, $delivered_qty, $delivered_unit, $ordered_qty, $ordered_unit, $errors);
      }
    
    return $errors;
  }

sub store_invoice
  { my( $doc)= @_; 
    my $root= $doc->getDocumentElement; # so we really work with the root element
    
    print "storing invoice ", text( first_child( first_child( $root, 'InvoiceDetails'), 'InvoiceNumber')), "\n";

    # build the various data structures
    my $data;

    my $invoice = first_child( $root, 'InvoiceDetails');
    $data->{invoice} = { number         => text( first_child( $invoice, 'InvoiceNumber')),
                         date           => text( first_child( $invoice, 'InvoiceDate')),
                         po             => text( first_child( $invoice, 'OrderIdentifier')),
                         amount_no_tax  => text( first_child( $invoice, 'InvoiceTotalVatExcludedAmount')),
                         tax            => text( first_child( $invoice, 'InvoiceTotalVatAmount')),
                         amount         => text( first_child( $invoice, 'InvoiceTotalVatIncludedAmount')),
                         payment_status => text( first_child( first_child( $root, 'PaymentStatusDetails'), 'PaymentStatusCode')),
                       };

    my $seller = first_child( $root, 'SellerPartyDetails');
    $data->{seller}  = { identifier      => text( first_child( $seller, 'SellerPartyIdentifier')),
                         name            => text( first_child( $seller, 'SellerOrganisationName')),
                         tax_code        => text( first_child( $seller, 'SellerOrganisationTaxCode')),
                       };

    my $SellerPartyDetails = first_child( $root, 'SellerPartyDetails');
    my $address            = first_child( $SellerPartyDetails, 'SellerPostalAddressDetails');
    $data->{address} = { street         => text( first_child( $address, 'SellerStreetName')),
                         town           => text( first_child( $address, 'SellerTownName')),
                         zip            => text( first_child( $address, 'SellerPostCodeIdentifier')),
                         country_code   => text( first_child( $address, 'CountryCode')),
                         po_box         => text( first_child( $address, 'SellerPostOfficeBoxIdentifier')),
                       };

    my $contact = first_child( $root, 'SellerCommunicationDetails');
    $data->{contact} = { name           => text( first_child( $root, 'SellerContactPersonName')),
                         phone          => text( first_child( $contact, 'SellerPhoneNumberIdentifier')),
                         email          => text( first_child( $contact, 'SellerEmailaddressIdentifier')),
                       };

    $data->{invoicerow} ||= [];
    reset_default_row_id();

    foreach my $invoicerow ( children($root, 'InvoiceRow'))
      { # need to check that the DeliveredQuantity element is present before getting its attribute
        my $DeliveredQuantity= first_child( $invoicerow, 'DeliveredQuantity');
        my $qty_unit= $DeliveredQuantity ? $DeliveredQuantity->getAttribute( 'QuantityUnitCode') : '';
        
        push @{$data->{invoicerow}},
          { row_id        => text( first_child( $invoicerow, 'RowIdentifier')) || default_row_id(),
            sku           => text( first_child( $invoicerow, 'ArticleIdentifier')),
            name          => text( first_child( $invoicerow, 'ArticleName')),
            qty           => text( $DeliveredQuantity),
            qty_unit      => $qty_unit,
            unit_price    => text( first_child( $invoicerow, 'UnitPriceAmount')),
            amount_no_tax => text( first_child( $invoicerow, 'RowVatExcludedAmount')),
            tax           => text( first_child( $invoicerow, 'RowVatAmount')),
            amount        => text( first_child( $invoicerow, 'RowAmount')),
          }
      }


    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;
  }

# this is very important,this ensures that we get the proper child
# never use XML::DOM's getFirstChild method directly!
sub first_child
  { my( $node, $tag)= @_;
    my $child= $node->getFirstChild or return undef;
    while( $child && ($child->nodeName ne $tag) )
      { $child= $child->getNextSibling; }
    return $child;
  }

sub children
  { my( $node, $tag)= @_;
    my @children;
    my $child= first_child( $node, $tag) or return undef;
    push @children, $child;
    while( $child= $child->getNextSibling)
      { push @children, $child if( $child->nodeName eq $tag); }
    return @children;
  }
  
# node must include only text (and comments)
sub text
  { my( $node)= @_;
    unless( $node) { return undef; }
    my $text='';
    foreach my $child ($node->getChildNodes)
      { if( $child->nodeName eq 'text')
          { $text.= $child->getData; }
      }
    return $text;
  }  
__END__

=head1 NAME

wtr2_libxml_dom

=head1 SYNOPSYS

  perl wtr2_libxml_dom 

=head1 DESCRIPTION

This code uses L<XML::LibXML> to process the invoices

It is directly derived from the L<XML::DOM> code in wtr2_dom. It only differs where
XML::DOM and XML::LibXML DOM methods or constants have different names:

  XML::DOM        XML::LibXML   

  getNodeName     nodeName       method
  #text           text           constant returned by nodeName/getNodeName

This was very easy to write, but does not take advantage of XML::LibXML's best
feature: its support for XPath. See L<C<wtr2_libxml>> for a slightly different
version, made a lot safer by using XPath queries instead of navigation methods
(like C<getFirstChild>) to access the data.

This exemple is here just to show how easy it is to port code from XML::DOM
(which IMHO should be deprecated) to XML::LibXML, and then take advantage of
XML::LibXML more powerful features.

=head1 AUTHOR

Michel Rodriguez <mirod@xmltwig.com>

=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<XML::LibXML>, L<XML::DOM>, wtr2_libxml, wtr2_dom

Ways to Rome 2 - Kourallinen Dollareita: http://www.xmltwig.com/article/ways_to_rome_2/