9 use List::Util qw(first);
12 use SL::Locale::String qw(t8);
14 use parent qw(Exporter);
15 our @EXPORT_PROFILES = qw(PROFILE_FACTURX_EXTENDED);
16 our @EXPORT_OK = (@EXPORT_PROFILES);
17 our %EXPORT_TAGS = (PROFILES => \@EXPORT_PROFILES);
19 use constant PROFILE_FACTURX_EXTENDED => 0;
21 use constant RES_OK => 0;
22 use constant RES_ERR_FILE_OPEN => 1;
23 use constant RES_ERR_NO_XMP_METADATA => 2;
24 use constant RES_ERR_NO_XML_INVOICE => 3;
25 use constant RES_ERR_NOT_ZUGFERD => 4;
26 use constant RES_ERR_UNSUPPORTED_ZUGFERD_VERSION => 5;
28 our @customer_settings = (
29 [ 0, t8('Do not create Factur-X/ZUGFeRD invoices') ],
30 [ PROFILE_FACTURX_EXTENDED() * 2 + 1, t8('Create with profile \'Factur-X 1.0.05/ZUGFeRD 2.1.1 extended\'') ],
31 [ PROFILE_FACTURX_EXTENDED() * 2 + 2, t8('Create with profile \'Factur-X 1.0.05/ZUGFeRD 2.1.1 extended\' (test mode)') ],
34 sub convert_customer_setting {
35 my ($class, $customer_setting) = @_;
37 return () if ($customer_setting <= 0) || ($customer_setting >= scalar(@customer_settings));
40 profile => int(($customer_setting - 1) / 2),
41 test_mode => ($customer_setting - 1) % 2,
45 sub _extract_zugferd_invoice_xml {
47 my $names_dict = $doc->getValue($doc->getRootDict->{Names}) or return {};
48 my $files_tree = $names_dict->{EmbeddedFiles} or return {};
49 my @agenda = $files_tree;
52 # Hardly ever more than single leaf, but...
55 my $item = $doc->getValue(shift @agenda);
58 my $kids = $doc->getValue($item->{Kids});
62 my $nodes = $doc->getValue($item->{Names});
63 my @names = map { $doc->getValue($_)} @$nodes;
66 my ($k, $v) = splice @names, 0, 2;
67 my $ef_node = $v->{EF};
68 my $ef_dict = $doc->getValue($ef_node);
69 my $fnode = (values %$ef_dict)[0];
70 my $any_num = $fnode->{value};
71 my $obj_node = $doc->dereference($any_num);
72 my $content = $doc->decodeOne($obj_node->{value}, 0) // '';
76 next if $content !~ m{<rsm:CrossIndustryInvoice};
79 my $dom = eval { XML::LibXML->load_xml(string => $content) };
80 return $content if $dom && ($dom->documentElement->nodeName eq 'rsm:CrossIndustryInvoice');
88 sub _get_xmp_metadata {
91 my $node = $doc->getValue($doc->getRootDict->{Metadata});
92 if ($node && $node->{StreamData} && defined($node->{StreamData}->{value})) {
93 return $node->{StreamData}->{value};
99 sub extract_from_pdf {
100 my ($self, $file_name) = @_;
102 my $pdf_doc = CAM::PDF->new($file_name);
106 result => RES_ERR_FILE_OPEN(),
107 message => $::locale->text('The file \'#1\' could not be opened for reading.', $file_name),
111 my $xmp = _get_xmp_metadata($pdf_doc);
114 result => RES_ERR_NO_XMP_METADATA(),
115 message => $::locale->text('The file \'#1\' does not contain the required XMP meta data.', $file_name),
120 result => RES_ERR_NO_XMP_METADATA(),
121 message => $::locale->text('Parsing the XMP metadata failed.'),
124 my $dom = eval { XML::LibXML->load_xml(string => $xmp) };
126 return $bad if !$dom;
128 my $xpc = XML::LibXML::XPathContext->new($dom);
129 $xpc->registerNs('rdf', 'http://www.w3.org/1999/02/22-rdf-syntax-ns#');
133 foreach my $node ($xpc->findnodes('/x:xmpmeta/rdf:RDF/rdf:Description')) {
134 my $ns = first { ref($_) eq 'XML::LibXML::Namespace' } $node->attributes;
137 if ($ns->getData =~ m{urn:zugferd:pdfa:CrossIndustryDocument:invoice:2p0}) {
138 $zugferd_version = 'zugferd:2p0';
142 if ($ns->getData =~ m{urn:factur-x:pdfa:CrossIndustryDocument:invoice:1p0}) {
143 $zugferd_version = 'factur-x:1p0';
147 if ($ns->getData =~ m{zugferd|factur-x}i) {
148 $zugferd_version = 'unsupported';
153 if (!$zugferd_version) {
155 result => RES_ERR_NOT_ZUGFERD(),
156 message => $::locale->text('The XMP metadata does not declare the Factur-X/ZUGFeRD data.'),
160 if ($zugferd_version eq 'unsupported') {
162 result => RES_ERR_UNSUPPORTED_ZUGFERD_VERSION(),
163 message => $::locale->text('The Factur-X/ZUGFeRD version used is not supported.'),
167 my $invoice_xml = _extract_zugferd_invoice_xml($pdf_doc);
169 if (!defined $invoice_xml) {
171 result => RES_ERR_NO_XML_INVOICE(),
172 message => $::locale->text('The Factur-X/ZUGFeRD XML invoice was not found.'),
178 metadata_xmp => $xmp,
179 invoice_xml => $invoice_xml,
193 SL::ZUGFeRD - Helper functions for dealing with PDFs containing Factur-X/ZUGFeRD invoice data
197 my $pdf = '/path/to/my.pdf';
198 my $info = SL::ZUGFeRD->extract_from_pdf($pdf);
200 if ($info->{result} != SL::ZUGFeRD::RES_OK()) {
201 # An error occurred; log message from parser:
202 $::lxdebug->message(LXDebug::DEBUG1(), "Could not extract ZUGFeRD data from $pdf: " . $info->{message});
206 # Parse & handle invoice XML:
207 my $dom = XML::LibXML->load_xml(string => $info->{invoice_xml});
214 =item C<extract_from_pdf> C<$file_name>
216 Opens an existing PDF in the file system and tries to extract
217 Factur-X/ZUGFeRD invoice data from it. First it'll parse the XMP
218 metadata and look for the Factur-X/ZUGFeRD declaration inside. If the
219 declaration isn't found or the declared version isn't 2p0, an error is
222 Otherwise it'll continue to look through all embedded files in the
223 PDF. The first embedded XML file with a root node of
224 C<rsm:CrossCountryInvoice> will be returnd.
226 Always returns a hash ref containing the key C<result>, a number that
227 can be one of the following constants:
231 =item C<RES_OK> (0): parsing was OK; the returned hash will also
232 contain the keys C<xmp_metadata> and C<invoice_xml> which will contain
233 the XML text of the metadata & the Factur-X/ZUGFeRD invoice.
235 =item C<RES_ERR_…> (all values E<gt> 0): parsing failed; the hash will
236 also contain a key C<message> which contains a human-readable
237 information about what exactly failed.
249 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>