#! /usr/bin/perl -w # Projet CRIL Compta # xml-post-import-records.pl -- Import XML data from Yellownet/The Post Office # AUTHOR # Marc SCHAEFER # LICENSE # (C) 2002 by Marc SCHAEFER, licensed under the terms of the # GNU General Public License as published by the Free Software # Foundation; either version 2 or later (at your option). # DESCRIPTION # This implements a quick and simple way to import Yellownet accounting # data into our accounting system. # NOTES # BUGS # - Fuzzy arithmetic. # TODO # - Enhance, test, and implement importation. # - See if there are better way. # BASED-ON # Original work # MODIFICATION-HISTORY # 2002-12-02 schaefer File creation # $Id: xml-post-import-records.pl,v 1.2 2002/12/08 09:06:15 schaefer Exp $ use strict; use XML::Grove; use XML::Grove::Builder; use XML::Parser::PerlSAX; use URI::Escape; use Unicode::String qw(utf8 latin1); my $result = 1; # FAILURE my $error_reason = 'unknown'; my $show_usage = 0; if (scalar(@ARGV) != 1) { $show_usage = 1; $error_reason = 'bad args'; } else { my ($file_name) = @ARGV; my $grove_builder = XML::Grove::Builder->new; if (defined($grove_builder)) { my $parser = XML::Parser::PerlSAX->new(Handler => $grove_builder); if (defined($parser)) { my $document = $parser->parse (Source => {SystemId => $file_name, Encoding => 'ISO-8859-1'}); if (defined($document)) { $result = 0; # SUCCESS my $start_tree = 'IC/KONAUS/SG4/SG6/'; my %pattern_hash = ('MOA/C516/D_5004/' => 'amount', 'MOA/C516/D_5025/' => 'value', 'RFF/C506/D_1154/' => 'type', 'FTX/C108/D_4440/' => 'text', 'DTM/C507/D_2380/' => 'date'); my %result_hash; if (parse_pattern($start_tree, \%pattern_hash, $document, \%result_hash, \$error_reason)) { # dump_hash(\%result_hash, ""); # print "\n"; if (defined($result_hash{'array'})) { my $total_debit = 0; my $total_credit = 0; my %credit_types = ('210' => undef); foreach my $hash_ref (@{$result_hash{'array'}}) { my @required_fields = ('text', 'date', 'amount', 'type'); if (all_defined_in_hash($hash_ref, \@required_fields)) { print "ENREGISTREMENT\n"; foreach (@required_fields) { print " ", $_, " -> ", $hash_ref->{$_}, "\n"; } if ((exists $hash_ref->{'attributes'}) && (exists $hash_ref->{'attributes'}->{'value'})) { if (exists $credit_types{$hash_ref ->{'attributes'}->{'value'}} ) { $total_credit += $hash_ref->{'amount'}; print " CREDIT\n"; } else { $total_debit += $hash_ref->{'amount'}; print " DEBIT\n"; } } else { print "### MISSING ATTRIBUTE!\n"; } print "\n"; } } print "TOTAL CREDIT: ", $total_credit, "\n"; print "TOTAL DEBIT: ", $total_debit, "\n"; print "DIFFERENCE DE SOLDE: ", ($total_credit - $total_debit), "\n"; } } else { $error_reason = 'parse failed: ' . $error_reason; } } else { $error_reason = 'document instanciation failed'; } } else { $error_reason = 'parser builder instanciation failed'; } } else { $error_reason = 'grove builder instanciation failed'; } } if ($show_usage) { print STDERR $0, " xml-file-name\n"; } if ($result) { print STDERR $0, ": failed: ", $error_reason, ".\n"; } exit $result; sub parse_pattern { my ($start_tree, $pattern_hash_ref, $document, $result_hash_ref, $error_reason_ref) = @_; parse_grove_tree($start_tree, $pattern_hash_ref, $result_hash_ref, $document->{'Contents'}, ""); return 1; } sub dump_array { my ($array_ref, $spaces) = @_; print "[ARRAY]\n"; foreach (@{$array_ref}) { print $spaces, " "; dump_node($_, $spaces . " "); } } # BUGS # - Doesn't support receiving a array or hash instead of a array # reference or hash sub dump_node { my ($node, $spaces) = @_; if (my $type = ref($node)) { if ($type eq "HASH") { dump_hash($node, $spaces); } elsif ($type eq "SCALAR") { print '[REF] ', uri_escape($$node, "\x00-\x1f\x7f-\xff"), "\n"; } elsif ($type eq "ARRAY") { dump_array($node, $spaces); } } else { print uri_escape($node, "\x00-\x1f\x7f-\xff"), "\n"; } } # NAME # dump_hash # INPUTS # - $hash_ref # - $spaces # DESCRIPTION # Displays a hash recursively. # RESULT # NONE # NOTES # BUGS # TODO sub dump_hash { my ($hash_ref, $spaces) = @_; print "[HASH]\n"; foreach (keys %{$hash_ref}) { my $prefix = ' ' . $spaces . $_ . " -> "; print $prefix; dump_node($hash_ref->{$_}, ' ' x length($prefix)); } } sub parse_grove_tree { my ($start_tree, $pattern_hash_ref, $result_hash_ref, $element_array_ref, $prefix) = @_; foreach my $hash (@{$element_array_ref}) { my $type = ref($hash); if ($type eq "XML::Grove::Element") { my $new_prefix = $prefix . $hash->{'Name'} . '/'; my $temp_hash_ref = $result_hash_ref; if ($new_prefix eq $start_tree) { if (!exists $result_hash_ref->{'array'}) { $result_hash_ref->{'array'} = []; } my %temp_hash; $temp_hash_ref = \%temp_hash; push (@{$result_hash_ref->{'array'}}, $temp_hash_ref); } if (defined($hash->{'Attributes'})) { if ((substr($new_prefix, 0, length($start_tree)) eq $start_tree) && exists $pattern_hash_ref->{substr($new_prefix, length($start_tree))}) { my $name = $pattern_hash_ref->{substr($new_prefix, length($start_tree))}; my %the_hash; my $count = 0; foreach (keys %{$hash->{'Attributes'}}) { $the_hash{$name} = $hash->{'Attributes'}->{$_}; $count++; } if ($count) { $temp_hash_ref->{'attributes'} = \%the_hash; } } } parse_grove_tree($start_tree, $pattern_hash_ref, $temp_hash_ref, $hash->{'Contents'}, $new_prefix); } elsif ($type eq "XML::Grove::Characters") { my $data_unicode = utf8($hash->{'Data'}); my $data = $data_unicode->latin1; if (!($data =~ /^\s*$/)) { insert_hash($start_tree, $pattern_hash_ref, $result_hash_ref, $prefix, $data); } } else { print STDERR "unknown type ", $type, "\n"; } } } sub insert_hash { my ($start_tree, $pattern_hash_ref, $hash_ref, $key, $value) = @_; if (index($key, $start_tree) == 0) { $key = substr($key, length($start_tree)); foreach (keys %{$pattern_hash_ref}) { if ($key =~ /^$_/) { $key = $pattern_hash_ref->{$key}; if (!exists $hash_ref->{$key}) { $hash_ref->{$key} = $value; } else { $hash_ref->{$key} .= ' ' . $value; } } } } } sub all_defined_in_hash { my ($hash_ref, $array_ref) = @_; foreach (@{$array_ref}) { if (!defined($hash_ref->{$_})) { return 0; } } return 1; }