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);
  16 our @EXPORT_OK       = (@EXPORT_PROFILES);
  17 our %EXPORT_TAGS     = (PROFILES => \@EXPORT_PROFILES);
  18
  19 use constant PROFILE_FACTURX_EXTENDED => 0;
  20
  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;
  27
  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)') ],
  32 );
  33
  34 sub convert_customer_setting {
  35   my ($class, $customer_setting) = @_;
  36
  37   return () if ($customer_setting <= 0) || ($customer_setting >= scalar(@customer_settings));
  38
  39   return (
  40     profile   => int(($customer_setting - 1) / 2),
  41     test_mode => ($customer_setting - 1) % 2,
  42   );
  43 }
  44
  45 sub _extract_zugferd_invoice_xml {
  46   my $doc        = shift;
  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;
  50   my $ret        = {};
  51
  52   # Hardly ever more than single leaf, but...
  53
  54   while (@agenda) {
  55     my $item = $doc->getValue(shift @agenda);
  56
  57     if ($item->{Kids}) {
  58       my $kids = $doc->getValue($item->{Kids});
  59       push @agenda, @$kids
  60
  61     } else {
  62       my $nodes = $doc->getValue($item->{Names});
  63       my @names = map { $doc->getValue($_)} @$nodes;
  64
  65       while (@names) {
  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) // '';
  73
  74         #print "1\n";
  75
  76         next if $content !~ m{<rsm:CrossIndustryInvoice};
  77         #print "2\n";
  78
  79         my $dom = eval { XML::LibXML->load_xml(string => $content) };
  80         return $content if $dom && ($dom->documentElement->nodeName eq 'rsm:CrossIndustryInvoice');
  81       }
  82     }
  83   }
  84
  85   return undef;
  86 }
  87
  88 sub _get_xmp_metadata {
  89   my ($doc) = @_;
  90
  91   my $node = $doc->getValue($doc->getRootDict->{Metadata});
  92   if ($node && $node->{StreamData} && defined($node->{StreamData}->{value})) {
  93     return $node->{StreamData}->{value};
  94   }
  95
  96   return undef;
  97 }
  98
  99 sub extract_from_pdf {
 100   my ($self, $file_name) = @_;
 101
 102   my $pdf_doc = CAM::PDF->new($file_name);
 103
 104   if (!$pdf_doc) {
 105     return {
 106       result  => RES_ERR_FILE_OPEN(),
 107       message => $::locale->text('The file \'#1\' could not be opened for reading.', $file_name),
 108     };
 109   }
 110
 111   my $xmp = _get_xmp_metadata($pdf_doc);
 112   if (!defined $xmp) {
 113     return {
 114       result  => RES_ERR_NO_XMP_METADATA(),
 115       message => $::locale->text('The file \'#1\' does not contain the required XMP meta data.', $file_name),
 116     };
 117   }
 118
 119   my $bad = {
 120     result  => RES_ERR_NO_XMP_METADATA(),
 121     message => $::locale->text('Parsing the XMP metadata failed.'),
 122   };
 123
 124   my $dom = eval { XML::LibXML->load_xml(string => $xmp) };
 125
 126   return $bad if !$dom;
 127
 128   my $xpc = XML::LibXML::XPathContext->new($dom);
 129   $xpc->registerNs('rdf', 'http://www.w3.org/1999/02/22-rdf-syntax-ns#');
 130
 131   my $zugferd_version;
 132
 133   foreach my $node ($xpc->findnodes('/x:xmpmeta/rdf:RDF/rdf:Description')) {
 134     my $ns = first { ref($_) eq 'XML::LibXML::Namespace' } $node->attributes;
 135     next unless $ns;
 136
 137     if ($ns->getData =~ m{urn:zugferd:pdfa:CrossIndustryDocument:invoice:2p0}) {
 138       $zugferd_version = 'zugferd:2p0';
 139       last;
 140     }
 141
 142     if ($ns->getData =~ m{urn:factur-x:pdfa:CrossIndustryDocument:invoice:1p0}) {
 143       $zugferd_version = 'factur-x:1p0';
 144       last;
 145     }
 146
 147     if ($ns->getData =~ m{zugferd|factur-x}i) {
 148       $zugferd_version = 'unsupported';
 149       last;
 150     }
 151   }
 152
 153   if (!$zugferd_version) {
 154     return {
 155       result  => RES_ERR_NOT_ZUGFERD(),
 156       message => $::locale->text('The XMP metadata does not declare the Factur-X/ZUGFeRD data.'),
 157     };
 158   }
 159
 160   if ($zugferd_version eq 'unsupported') {
 161     return {
 162       result  => RES_ERR_UNSUPPORTED_ZUGFERD_VERSION(),
 163       message => $::locale->text('The Factur-X/ZUGFeRD version used is not supported.'),
 164     };
 165   }
 166
 167   my $invoice_xml = _extract_zugferd_invoice_xml($pdf_doc);
 168
 169   if (!defined $invoice_xml) {
 170     return {
 171       result  => RES_ERR_NO_XML_INVOICE(),
 172       message => $::locale->text('The Factur-X/ZUGFeRD XML invoice was not found.'),
 173     };
 174   }
 175
 176   return {
 177     result       => RES_OK(),
 178     metadata_xmp => $xmp,
 179     invoice_xml  => $invoice_xml,
 180   };
 181 }
 182
 183 1;
 184
 185 __END__
 186
 187 =pod
 188
 189 =encoding utf8
 190
 191 =head1 NAME
 192
 193 SL::ZUGFeRD - Helper functions for dealing with PDFs containing Factur-X/ZUGFeRD invoice data
 194
 195 =head1 SYNOPSIS
 196
 197     my $pdf  = '/path/to/my.pdf';
 198     my $info = SL::ZUGFeRD->extract_from_pdf($pdf);
 199
 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});
 203       return;
 204     }
 205
 206     # Parse & handle invoice XML:
 207     my $dom = XML::LibXML->load_xml(string => $info->{invoice_xml});
 208
 209
 210 =head1 FUNCTIONS
 211
 212 =over 4
 213
 214 =item C<extract_from_pdf> C<$file_name>
 215
 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
 220 returned.
 221
 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.
 225
 226 Always returns a hash ref containing the key C<result>, a number that
 227 can be one of the following constants:
 228
 229 =over 4
 230
 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.
 234
 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.
 238
 239 =back
 240
 241 =back
 242
 243 =head1 BUGS
 244
 245 Nothing here yet.
 246
 247 =head1 AUTHOR
 248
 249 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>
 250
 251 =cut