locales
[kivitendo-erp.git] / SL / ZUGFeRD.pm
1 package SL::ZUGFeRD;
2
3 use strict;
4 use warnings;
5 use utf8;
6
7 use CAM::PDF;
8 use Data::Dumper;
9 use List::Util qw(first);
10 use XML::LibXML;
11
12 use SL::Locale::String qw(t8);
13
14 use parent qw(Exporter);
15 our @EXPORT_PROFILES = qw(PROFILE_FACTURX_EXTENDED PROFILE_XRECHNUNG);
16 our @EXPORT_OK       = (@EXPORT_PROFILES);
17 our %EXPORT_TAGS     = (PROFILES => \@EXPORT_PROFILES);
18
19 use constant PROFILE_FACTURX_EXTENDED => 0;
20 use constant PROFILE_XRECHNUNG        => 1;
21
22 use constant RES_OK                              => 0;
23 use constant RES_ERR_FILE_OPEN                   => 1;
24 use constant RES_ERR_NO_XMP_METADATA             => 2;
25 use constant RES_ERR_NO_XML_INVOICE              => 3;
26 use constant RES_ERR_NOT_ZUGFERD                 => 4;
27 use constant RES_ERR_UNSUPPORTED_ZUGFERD_VERSION => 5;
28
29 our @customer_settings = (
30   [ 0,                                  t8('Do not create Factur-X/ZUGFeRD invoices')                                    ],
31   [ PROFILE_FACTURX_EXTENDED() * 2 + 1, t8('Create with profile \'Factur-X 1.0.05/ZUGFeRD 2.1.1 extended\'')             ],
32   [ PROFILE_FACTURX_EXTENDED() * 2 + 2, t8('Create with profile \'Factur-X 1.0.05/ZUGFeRD 2.1.1 extended\' (test mode)') ],
33   [ PROFILE_XRECHNUNG()        * 2 + 1, t8('Create with profile \'XRechnung 2.0.0\'')                                    ],
34   [ PROFILE_XRECHNUNG()        * 2 + 2, t8('Create with profile \'XRechnung 2.0.0\' (test mode)')                        ],
35 );
36
37 sub convert_customer_setting {
38   my ($class, $customer_setting) = @_;
39
40   return () if ($customer_setting <= 0) || ($customer_setting >= scalar(@customer_settings));
41
42   return (
43     profile   => int(($customer_setting - 1) / 2),
44     test_mode => ($customer_setting - 1) % 2,
45   );
46 }
47
48 sub _extract_zugferd_invoice_xml {
49   my $doc        = shift;
50   my $names_dict = $doc->getValue($doc->getRootDict->{Names}) or return {};
51   my $files_tree = $names_dict->{EmbeddedFiles}               or return {};
52   my @agenda     = $files_tree;
53   my $ret        = {};
54
55   # Hardly ever more than single leaf, but...
56
57   while (@agenda) {
58     my $item = $doc->getValue(shift @agenda);
59
60     if ($item->{Kids}) {
61       my $kids = $doc->getValue($item->{Kids});
62       push @agenda, @$kids
63
64     } else {
65       my $nodes = $doc->getValue($item->{Names});
66       my @names = map { $doc->getValue($_)} @$nodes;
67
68       while (@names) {
69         my ($k, $v)  = splice @names, 0, 2;
70         my $ef_node  = $v->{EF};
71         my $ef_dict  = $doc->getValue($ef_node);
72         my $fnode    = (values %$ef_dict)[0];
73         my $any_num  = $fnode->{value};
74         my $obj_node = $doc->dereference($any_num);
75         my $content  = $doc->decodeOne($obj_node->{value}, 0) // '';
76
77         #print "1\n";
78
79         next if $content !~ m{<rsm:CrossIndustryInvoice};
80         #print "2\n";
81
82         my $dom = eval { XML::LibXML->load_xml(string => $content) };
83         return $content if $dom && ($dom->documentElement->nodeName eq 'rsm:CrossIndustryInvoice');
84       }
85     }
86   }
87
88   return undef;
89 }
90
91 sub _get_xmp_metadata {
92   my ($doc) = @_;
93
94   my $node = $doc->getValue($doc->getRootDict->{Metadata});
95   if ($node && $node->{StreamData} && defined($node->{StreamData}->{value})) {
96     return $node->{StreamData}->{value};
97   }
98
99   return undef;
100 }
101
102 sub extract_from_pdf {
103   my ($self, $file_name) = @_;
104
105   my $pdf_doc = CAM::PDF->new($file_name);
106
107   if (!$pdf_doc) {
108     return {
109       result  => RES_ERR_FILE_OPEN(),
110       message => $::locale->text('The file \'#1\' could not be opened for reading.', $file_name),
111     };
112   }
113
114   my $xmp = _get_xmp_metadata($pdf_doc);
115   if (!defined $xmp) {
116     return {
117       result  => RES_ERR_NO_XMP_METADATA(),
118       message => $::locale->text('The file \'#1\' does not contain the required XMP meta data.', $file_name),
119     };
120   }
121
122   my $bad = {
123     result  => RES_ERR_NO_XMP_METADATA(),
124     message => $::locale->text('Parsing the XMP metadata failed.'),
125   };
126
127   my $dom = eval { XML::LibXML->load_xml(string => $xmp) };
128
129   return $bad if !$dom;
130
131   my $xpc = XML::LibXML::XPathContext->new($dom);
132   $xpc->registerNs('rdf', 'http://www.w3.org/1999/02/22-rdf-syntax-ns#');
133
134   my $zugferd_version;
135
136   foreach my $node ($xpc->findnodes('/x:xmpmeta/rdf:RDF/rdf:Description')) {
137     my $ns = first { ref($_) eq 'XML::LibXML::Namespace' } $node->attributes;
138     next unless $ns;
139
140     if ($ns->getData =~ m{urn:zugferd:pdfa:CrossIndustryDocument:invoice:2p0}) {
141       $zugferd_version = 'zugferd:2p0';
142       last;
143     }
144
145     if ($ns->getData =~ m{urn:factur-x:pdfa:CrossIndustryDocument:invoice:1p0}) {
146       $zugferd_version = 'factur-x:1p0';
147       last;
148     }
149
150     if ($ns->getData =~ m{zugferd|factur-x}i) {
151       $zugferd_version = 'unsupported';
152       last;
153     }
154   }
155
156   if (!$zugferd_version) {
157     return {
158       result  => RES_ERR_NOT_ZUGFERD(),
159       message => $::locale->text('The XMP metadata does not declare the Factur-X/ZUGFeRD data.'),
160     };
161   }
162
163   if ($zugferd_version eq 'unsupported') {
164     return {
165       result  => RES_ERR_UNSUPPORTED_ZUGFERD_VERSION(),
166       message => $::locale->text('The Factur-X/ZUGFeRD version used is not supported.'),
167     };
168   }
169
170   my $invoice_xml = _extract_zugferd_invoice_xml($pdf_doc);
171
172   if (!defined $invoice_xml) {
173     return {
174       result  => RES_ERR_NO_XML_INVOICE(),
175       message => $::locale->text('The Factur-X/ZUGFeRD XML invoice was not found.'),
176     };
177   }
178
179   return {
180     result       => RES_OK(),
181     metadata_xmp => $xmp,
182     invoice_xml  => $invoice_xml,
183   };
184 }
185
186 1;
187
188 __END__
189
190 =pod
191
192 =encoding utf8
193
194 =head1 NAME
195
196 SL::ZUGFeRD - Helper functions for dealing with PDFs containing Factur-X/ZUGFeRD invoice data
197
198 =head1 SYNOPSIS
199
200     my $pdf  = '/path/to/my.pdf';
201     my $info = SL::ZUGFeRD->extract_from_pdf($pdf);
202
203     if ($info->{result} != SL::ZUGFeRD::RES_OK()) {
204       # An error occurred; log message from parser:
205       $::lxdebug->message(LXDebug::DEBUG1(), "Could not extract ZUGFeRD data from $pdf: " . $info->{message});
206       return;
207     }
208
209     # Parse & handle invoice XML:
210     my $dom = XML::LibXML->load_xml(string => $info->{invoice_xml});
211
212
213 =head1 FUNCTIONS
214
215 =over 4
216
217 =item C<extract_from_pdf> C<$file_name>
218
219 Opens an existing PDF in the file system and tries to extract
220 Factur-X/ZUGFeRD invoice data from it. First it'll parse the XMP
221 metadata and look for the Factur-X/ZUGFeRD declaration inside. If the
222 declaration isn't found or the declared version isn't 2p0, an error is
223 returned.
224
225 Otherwise it'll continue to look through all embedded files in the
226 PDF. The first embedded XML file with a root node of
227 C<rsm:CrossCountryInvoice> will be returnd.
228
229 Always returns a hash ref containing the key C<result>, a number that
230 can be one of the following constants:
231
232 =over 4
233
234 =item C<RES_OK> (0): parsing was OK; the returned hash will also
235 contain the keys C<xmp_metadata> and C<invoice_xml> which will contain
236 the XML text of the metadata & the Factur-X/ZUGFeRD invoice.
237
238 =item C<RES_ERR_…> (all values E<gt> 0): parsing failed; the hash will
239 also contain a key C<message> which contains a human-readable
240 information about what exactly failed.
241
242 =back
243
244 =back
245
246 =head1 BUGS
247
248 Nothing here yet.
249
250 =head1 AUTHOR
251
252 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>
253
254 =cut