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