projekt kivitendo

  { name => "CAM::PDF",                            url => "https://metacpan.org/pod/CAM::PDF",  debian => 'libcap-pdf-perl' },

  { name => "XML::LibXML",                         url => "https://metacpan.org/pod/XML::LibXML", debian => 'libxml-libxml-perl' },

package SL::ZUGFeRD;

use strict;

use warnings;

use utf8;

use CAM::PDF;

use Data::Dumper;

use List::Util qw(first);

use XML::LibXML;

use constant RES_OK                              => 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;

sub _extract_zugferd_invoice_xml {

  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) // '';

        print "1\n";

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

        print "2\n";

        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}) {

      $zugferd_version = '2p0';

      last;

    }

    if ($ns->getData =~ m{zugferd}i) {

      $zugferd_version = 'unsupported';

      last;

    }

  }

  if (!$zugferd_version) {

    return {

      result  => RES_ERR_NOT_ZUGFERD(),

      message => $::locale->text('The XMP metadata does not declare the ZUGFeRD data.'),

    };

  }

  if ($zugferd_version !~ m{^2p}) {

    return {

      result  => RES_ERR_UNSUPPORTED_ZUGFERD_VERSION(),

      message => $::locale->text('The ZUGFeRD version used is not supported.'),

    };

  }

  my $invoice_xml = _extract_zugferd_invoice_xml($pdf_doc);

  if (!defined $invoice_xml) {

    return {

      result  => RES_ERR_NO_XML_INVOICE(),

      message => $::locale->text('The ZUGFeRD XML invoice was not found.'),

    };

  }

  return {

    result       => RES_OK(),

    metadata_xmp => $xmp,

    invoice_xml  => $invoice_xml,

  };

}

1;

__END__

=pod

=encoding utf8

=head1 NAME

SL::ZUGFeRD - Helper functions for dealing with PDFs containing ZUGFeRD invoice data

=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>

Opens an existing PDF in the file system and tries to extract ZUGFeRD

invoice data from it. First it'll parse the XMP metadata and look for

the 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

the XML text of the metadata & the ZUGFeRD invoice.

=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