projekt kivitendo

package SL::ZUGFeRD;

use strict;

use warnings;

use utf8;

use CAM::PDF;

use Data::Dumper;

use List::Util qw(first);

use XML::LibXML;

use parent qw(Exporter);

our %EXPORT_TAGS = (PROFILES => \@EXPORT_PROFILES);

use constant PROFILE_FACTURX_EXTENDED => 0;

use constant RES_ERR_FILE_OPEN => 1;

use constant RES_ERR_NO_XMP_METADATA => 2;

use constant RES_ERR_NO_XML_INVOICE => 3;

use constant RES_ERR_NOT_ZUGFERD => 4;

use constant RES_ERR_UNSUPPORTED_ZUGFERD_VERSION => 5;

[ 0, t8('Do not create Factur-X/ZUGFeRD invoices') ],

[ PROFILE_FACTURX_EXTENDED() * 2 + 1, t8('Create with profile \'Factur-X 1.0.05/ZUGFeRD 2.1.1 extended\'') ],

[ PROFILE_FACTURX_EXTENDED() * 2 + 2, t8('Create with profile \'Factur-X 1.0.05/ZUGFeRD 2.1.1 extended\' (test mode)') ],

[ PROFILE_XRECHNUNG() * 2 + 2, t8('Create with profile \'XRechnung 2.0.0\' (test mode)') ],

sub convert_customer_setting {

my ($class, $customer_setting) = @_;

return () if ($customer_setting <= 0) || ($customer_setting >= scalar(@customer_settings));

return (

profile => int(($customer_setting - 1) / 2),

test_mode => ($customer_setting - 1) % 2,

);

}

my $doc = shift;

my $names_dict = $doc->getValue($doc->getRootDict->{Names}) or return {};

my $files_tree = $names_dict->{EmbeddedFiles} or return {};

my @agenda = $files_tree;

my $ret = {};

# Hardly ever more than single leaf, but...

while (@agenda) {

my $item = $doc->getValue(shift @agenda);

if ($item->{Kids}) {

my $kids = $doc->getValue($item->{Kids});

push @agenda, @$kids

} else {

my $nodes = $doc->getValue($item->{Names});

my @names = map { $doc->getValue($_)} @$nodes;

while (@names) {

my ($k, $v) = splice @names, 0, 2;

my $ef_node = $v->{EF};

my $ef_dict = $doc->getValue($ef_node);

my $fnode = (values %$ef_dict)[0];

my $any_num = $fnode->{value};

my $obj_node = $doc->dereference($any_num);

my $content = $doc->decodeOne($obj_node->{value}, 0) // '';

next if $content !~ m{<rsm:CrossIndustryInvoice};

my $dom = eval { XML::LibXML->load_xml(string => $content) };

return $content if $dom && ($dom->documentElement->nodeName eq 'rsm:CrossIndustryInvoice');

}

}

}

return undef;

}

sub _get_xmp_metadata {

my ($doc) = @_;

my $node = $doc->getValue($doc->getRootDict->{Metadata});

if ($node && $node->{StreamData} && defined($node->{StreamData}->{value})) {

return $node->{StreamData}->{value};

}

return undef;

}

sub extract_from_pdf {

my ($self, $file_name) = @_;

my $pdf_doc = CAM::PDF->new($file_name);

if (!$pdf_doc) {

return {

result => RES_ERR_FILE_OPEN(),

message => $::locale->text('The file \'#1\' could not be opened for reading.', $file_name),

};

}

my $xmp = _get_xmp_metadata($pdf_doc);

if (!defined $xmp) {

return {

result => RES_ERR_NO_XMP_METADATA(),

message => $::locale->text('The file \'#1\' does not contain the required XMP meta data.', $file_name),

};

}

my $bad = {

result => RES_ERR_NO_XMP_METADATA(),

message => $::locale->text('Parsing the XMP metadata failed.'),

};

my $dom = eval { XML::LibXML->load_xml(string => $xmp) };

return $bad if !$dom;

my $xpc = XML::LibXML::XPathContext->new($dom);

$xpc->registerNs('rdf', 'http://www.w3.org/1999/02/22-rdf-syntax-ns#');

my $zugferd_version;

foreach my $node ($xpc->findnodes('/x:xmpmeta/rdf:RDF/rdf:Description')) {

my $ns = first { ref($_) eq 'XML::LibXML::Namespace' } $node->attributes;

next unless $ns;

if ($ns->getData =~ m{urn:zugferd:pdfa:CrossIndustryDocument:invoice:2p0}) {

last;

}

if ($ns->getData =~ m{urn:factur-x:pdfa:CrossIndustryDocument:invoice:1p0}) {

$zugferd_version = 'factur-x:1p0';

}

last;

}

}

if (!$zugferd_version) {

return {

result => RES_ERR_NOT_ZUGFERD(),

}

result => RES_ERR_UNSUPPORTED_ZUGFERD_VERSION(),

}

my $invoice_xml = _extract_zugferd_invoice_xml($pdf_doc);

if (!defined $invoice_xml) {

return {

result => RES_ERR_NO_XML_INVOICE(),

}

return {

result => RES_OK(),

metadata_xmp => $xmp,

invoice_xml => $invoice_xml,

};

}

1;

__END__

=pod

=encoding utf8

=head1 NAME

=head1 SYNOPSIS

my $pdf = '/path/to/my.pdf';

my $info = SL::ZUGFeRD->extract_from_pdf($pdf);

if ($info->{result} != SL::ZUGFeRD::RES_OK()) {

# An error occurred; log message from parser:

$::lxdebug->message(LXDebug::DEBUG1(), "Could not extract ZUGFeRD data from $pdf: " . $info->{message});

return;

}

# Parse & handle invoice XML:

my $dom = XML::LibXML->load_xml(string => $info->{invoice_xml});

=head1 FUNCTIONS

=over 4

=item C<extract_from_pdf> C<$file_name>

Factur-X/ZUGFeRD invoice data from it. First it'll parse the XMP

metadata and look for the Factur-X/ZUGFeRD declaration inside. If the

declaration isn't found or the declared version isn't 2p0, an error is

returned.

Otherwise it'll continue to look through all embedded files in the

PDF. The first embedded XML file with a root node of

C<rsm:CrossCountryInvoice> will be returnd.

Always returns a hash ref containing the key C<result>, a number that

can be one of the following constants:

=over 4

=item C<RES_OK> (0): parsing was OK; the returned hash will also

contain the keys C<xmp_metadata> and C<invoice_xml> which will contain

=item C<RES_ERR_…> (all values E<gt> 0): parsing failed; the hash will

also contain a key C<message> which contains a human-readable

information about what exactly failed.

=back

=back

=head1 BUGS

Nothing here yet.

=head1 AUTHOR

Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>

=cut