Projekt

Allgemein

Profil

« Zurück | Weiter » 

Revision b525a340

Von Johannes Grassler vor etwa 1 Jahr hinzugefügt

  • ID b525a3404fb0484bfc1b9634482695263078967b
  • Vorgänger 335b5ab6
  • Nachfolger 1522aeb7

ZUGFeRD-Import auf SL::XMLInvoice umgestellt

Wichtigste Aenderung dieses Commits ist die Umstellung des
ZUGFeRD-Imports in der Finanzbuchhaltung auf das neu
hinzugefuegte Modul SL::XMLInvoice, das auch die Verabeitung
von Rechnungen im XRechnung-Format erlaubt. Darueber hinaus
gibt es einige weitere Aenderungen:

  • Datenformate: Neben ZUGFeRD wird nun auch XRechnung
    unterstuetzt.
  • Fehlertoleranz: Fehlende ZUGFeRD-Metadaten erzeugen nur noch
    Warnungen, saemtliche XML-Anhaenge an PDF-Dateien werden
    automatisch erkannt und verarbeitet (egal ob es sich um
    ZUGFeRD/Faktur-X- oder XRechnung-Daten handelt).
  • Upload von reinen XML-Dateien ist nun auch moeglich (fuer
    Rechnungen im XRechnung-Format wichtig).
  • Die Posten der Rechnung werden nun auch automatisch in das
    Formular eingetragen, nicht mehr nur Rechnungsnummer und
    Datum.
  • Es muss keine Belegvorlage mehr fuer den Lieferanten
    existieren. Eine eigene Belegvorlage wird fuer jede
    importierte Rechnung automatisch angelegt.
  • Es wird automatisch ein Gegenkonto fuer die Buchung
    aus den Verbindlichkeitskonten ausgewaehlt.
  • Das Faelligkeitsdatum der Rechnung wird immer gesetzt.
    Enthaelt die Rechnung keines, wird es auf das Rechnungsdatum
    gesetzt.

Unterschiede anzeigen:

SL/Controller/ZUGFeRD.pm
1 1
package SL::Controller::ZUGFeRD;
2 2
use strict;
3
use warnings;
3 4
use parent qw(SL::Controller::Base);
4 5

  
5 6
use SL::DB::RecordTemplate;
6 7
use SL::Locale::String qw(t8);
7 8
use SL::Helper::DateTime;
9
use SL::XMLInvoice;
8 10
use SL::VATIDNr;
9 11
use SL::ZUGFeRD;
10 12
use SL::SessionFile;
......
21 23
  $self->render('zugferd/form', title => $::locale->text('Factur-X/ZUGFeRD import'));
22 24
}
23 25

  
24
sub action_import_zugferd {
25
  my ($self, %params) = @_;
26
  my $file = $::form->{file};
27
  my $file_name = $::form->{file_name};
26
sub find_vendor_by_taxnumber {
27
  my $taxnumber = shift @_;
28 28

  
29
  die t8("missing file for action import") unless $file;
30
  die t8("can only parse a pdf file")      unless $file =~ m/^%PDF/;
29
  # 1.1 check if we a have a vendor with this tax number (vendor.taxnumber)
30
  my $vendor = SL::DB::Manager::Vendor->find_by(
31
    taxnumber => $taxnumber,
32
    or    => [
33
      obsolete => undef,
34
      obsolete => 0,
35
    ]);
36

  
37
  if (!$vendor) {
38
    # 1.2 If no vendor with the exact VAT ID number is found, the
39
    # number might be stored slightly different in the database
40
    # (e.g. with spaces breaking up groups of numbers). Iterate over
41
    # all existing vendors with VAT ID numbers, normalize their
42
    # representation and compare those.
31 43

  
32
  my $info = SL::ZUGFeRD->extract_from_pdf($file);
44
    my $vendors = SL::DB::Manager::Vendor->get_all(
45
      where => [
46
        '!taxnumber' => undef,
47
        '!taxnumber' => '',
48
        or       => [
49
          obsolete => undef,
50
          obsolete => 0,
51
        ],
52
      ]);
33 53

  
34
  if ($info->{result} != SL::ZUGFeRD::RES_OK()) {
35
    # An error occurred; log message from parser:
36
    $::lxdebug->message(LXDebug::DEBUG1(), "Could not extract ZUGFeRD data, error message: " . $info->{message});
37
    die t8("Could not extract Factur-X/ZUGFeRD data, data and error message:") . $info->{message};
54
    foreach my $other_vendor (@{ $vendors }) {
55
      next unless $other_vendor->taxnumber eq $taxnumber;
56

  
57
      $vendor = $other_vendor;
58
      last;
59
    }
38 60
  }
39
  # valid ZUGFeRD metadata
40
  my $dom   = XML::LibXML->load_xml(string => $info->{invoice_xml});
61
}
41 62

  
42
  # 1. check if ZUGFeRD SellerTradeParty has a VAT-ID
43
  my $ustid = $dom->findnodes('//ram:SellerTradeParty/ram:SpecifiedTaxRegistration')->string_value;
44
  die t8("No VAT Info for this Factur-X/ZUGFeRD invoice," .
45
         " please ask your vendor to add this for his Factur-X/ZUGFeRD data.") unless $ustid;
63
sub find_vendor_by_ustid {
64
  my $ustid = shift @_;
46 65

  
47 66
  $ustid = SL::VATIDNr->normalize($ustid);
48 67

  
49 68
  # 1.1 check if we a have a vendor with this VAT-ID (vendor.ustid)
50
  my $vc     = $dom->findnodes('//ram:SellerTradeParty/ram:Name')->string_value;
51 69
  my $vendor = SL::DB::Manager::Vendor->find_by(
52 70
    ustid => $ustid,
53 71
    or    => [
......
80 98
    }
81 99
  }
82 100

  
83
  die t8("Please add a valid VAT-ID for this vendor: #1", $vc) unless (ref $vendor eq 'SL::DB::Vendor');
101
  return $vendor;
102
}
84 103

  
85
  # 2. check if we have a ap record template for this vendor (TODO only the oldest template is choosen)
86
  my $template_ap = SL::DB::Manager::RecordTemplate->get_first(where => [vendor_id => $vendor->id]);
87
  die t8("No AP Record Template for this vendor found, please add one") unless (ref $template_ap eq 'SL::DB::RecordTemplate');
104
sub find_vendor {
105
  my ($ustid, $taxnumber) = @_;
106
  my $vendor;
88 107

  
108
  if ( $ustid ) {
109
    $vendor = find_vendor_by_ustid($ustid);
110
  }
89 111

  
90
  # 3. parse the zugferd data and fill the ap record template
91
  # -> no need to check sign (credit notes will be negative) just record thei ZUGFeRD type in ap.notes
92
  # -> check direct debit (defaults to no)
93
  # -> set amount (net amount) and unset taxincluded
94
  #    (template and user cares for tax and if there is more than one booking accno)
95
  # -> date (can be empty)
96
  # -> duedate (may be empty)
97
  # -> compare record iban and generate a warning if this differs from vendor's master data iban
98
  my $total     = $dom->findnodes('//ram:SpecifiedTradeSettlementHeaderMonetarySummation' .
99
                                  '/ram:TaxBasisTotalAmount')->string_value;
112
  if (ref $vendor eq 'SL::DB::Vendor') { return $vendor; }
100 113

  
101
  my $invnumber = $dom->findnodes('//rsm:ExchangedDocument/ram:ID')->string_value;
114
  if ( $taxnumber ) {
115
    $vendor = find_vendor_by_taxnumber($taxnumber);
116
  }
102 117

  
103
  # parse dates to kivi if set/valid
104
  my ($transdate, $duedate, $dt_to_kivi, $due_dt_to_kivi);
105
  $transdate = $dom->findnodes('//ram:IssueDateTime')->string_value;
106
  $duedate   = $dom->findnodes('//ram:DueDateDateTime')->string_value;
107
  $transdate =~ s/^\s+|\s+$//g;
108
  $duedate   =~ s/^\s+|\s+$//g;
109

  
110
  if ($transdate =~ /^[0-9]{8}$/) {
111
    $dt_to_kivi = DateTime->new(year  => substr($transdate,0,4),
112
                                month => substr ($transdate,4,2),
113
                                day   => substr($transdate,6,2))->to_kivitendo;
118
  if (ref $vendor eq 'SL::DB::Vendor') { return $vendor; }
119

  
120
  return undef;
121
}
122

  
123
sub action_import_zugferd {
124
  my ($self, %params) = @_;
125

  
126
  my $file = $::form->{file};
127
  my $file_name = $::form->{file_name};
128

  
129
  my %res;          # result data structure returned by SL::ZUGFeRD->extract_from_{pdf,xml}()
130
  my $parser;       # SL::XMLInvoice object created by SL::ZUGFeRD->extract_from_{pdf,xml}()
131
  my $dom;          # DOM object for parsed XML data
132
  my $template_ap;  # SL::DB::RecordTemplate object
133
  my $vendor;       # SL::DB::Vendor object
134

  
135
  my $ibanmessage;  # Message to display if vendor's database and invoice IBANs don't match up
136

  
137
  die t8("missing file for action import") unless $file;
138
  die t8("can only parse a pdf or xml file")      unless $file =~ m/^%PDF|<\?xml/;
139

  
140
  if ( $::form->{file} =~ m/^%PDF/ ) {
141
    %res = %{SL::ZUGFeRD->extract_from_pdf($::form->{file})}
142
  } else {
143
    %res = %{SL::ZUGFeRD->extract_from_xml($::form->{file})};
114 144
  }
115
  if ($duedate =~ /^[0-9]{8}$/) {
116
    $due_dt_to_kivi = DateTime->new(year  => substr($duedate,0,4),
117
                                    month => substr ($duedate,4,2),
118
                                    day   => substr($duedate,6,2))->to_kivitendo;
145

  
146
  if ($res{'result'} != SL::ZUGFeRD::RES_OK()) {
147
    # An error occurred; log message from parser:
148
    $::lxdebug->message(LXDebug::DEBUG1(), "Could not extract ZUGFeRD data, error message: " . $res{'message'});
149
    die(t8("Could not extract Factur-X/ZUGFeRD data, data and error message:") . " $res{'message'}");
119 150
  }
120 151

  
121
  my $type = $dom->findnodes('//rsm:ExchangedDocument/ram:TypeCode')->string_value;
152
  $parser = $res{'invoice_xml'};
153

  
154
  # Shouldn't be neccessary with SL::XMLInvoice doing the heavy lifting, but
155
  # let's grab it, just in case.
156
  $dom  = $parser->{dom};
157

  
158
  my %metadata = %{$parser->metadata};
159
  my @items = @{$parser->items};
122 160

  
123
  my $dd   = $dom->findnodes('//ram:ApplicableHeaderTradeSettlement' .
124
                             '/ram:SpecifiedTradeSettlementPaymentMeans/ram:TypeCode')->string_value;
125
  my $direct_debit = $dd == 59 ? 1 : 0;
161
  my $iban = $metadata{'iban'};
162
  my $invnumber = $metadata{'invnumber'};
126 163

  
127
  my $iban = $dom->findnodes('//ram:ApplicableHeaderTradeSettlement/ram:SpecifiedTradeSettlementPaymentMeans' .
128
                             '/ram:PayeePartyCreditorFinancialAccount/ram:IBANID')->string_value;
129
  my $ibanmessage;
164
  if ( ! ($metadata{'ustid'} or $metadata{'taxnumber'}) ) {
165
    die t8("Cannot process this invoice: neither VAT ID nor tax ID present.");
166
    }
167

  
168
  $vendor = find_vendor($metadata{'ustid'}, $metadata{'taxnumber'});
169

  
170
  die t8("Please add a valid VAT ID or tax number for this vendor: #1", $metadata{'vendor_name'}) unless $vendor;
171

  
172

  
173
  # Create a record template for this imported invoice
174
  $template_ap = SL::DB::RecordTemplate->new(
175
      vendor_id=>$vendor->id,
176
  );
177

  
178
  # Check IBAN specified on bill matches the one we've got in
179
  # the database for this vendor.
130 180
  $ibanmessage = $iban ne $vendor->iban ? "Record IBAN $iban doesn't match vendor IBAN " . $vendor->iban : $iban if $iban;
131 181

  
132 182
  # save the zugferd file to session file for reuse in ap.pl
......
134 184
  $session_file->fh->print($file);
135 185
  $session_file->fh->close;
136 186

  
187
  # Use invoice creation date as due date if there's no due date
188
  $metadata{'duedate'} = $metadata{'transdate'} unless defined $metadata{'duedate'};
189

  
190
  # parse dates to kivi if set/valid
191
  foreach my $key ( qw(transdate duedate) ) {
192
    next unless defined $metadata{$key};
193
    $metadata{$key} =~ s/^\s+|\s+$//g;
194

  
195
    if ($metadata{$key} =~ /^([0-9]{4})-?([0-9]{2})-?([0-9]{2})$/) {
196
    $metadata{$key} = DateTime->new(year  => $1,
197
                                    month => $2,
198
                                    day   => $3)->to_kivitendo;
199
    }
200
  }
201

  
202
  # Try to fill in AP account to book against
203
  my $ap_chart_id = $::instance_conf->get_ap_chart_id;
204

  
205
  unless ( defined $ap_chart_id ) {
206
    # If no default account is configured, just use the first AP account found.
207
    my $ap_chart = SL::DB::Manager::Chart->get_all(
208
      where   => [ link => 'AP' ],
209
      sort_by => [ 'accno' ],
210
    );
211
    $ap_chart_id = ${$ap_chart}[0]->id;
212
  }
213

  
214
  my $currency = SL::DB::Manager::Currency->find_by(
215
    name => $metadata{'currency'},
216
    );
217

  
218
  $template_ap->assign_attributes(
219
    template_name       => "Faktur-X/ZUGFeRD/XRechnung Import $vendor->name, $invnumber",
220
    template_type       => 'ap_transaction',
221
    direct_debit        => $metadata{'direct_debit'},
222
    notes               => "Faktur-X/ZUGFeRD/XRechnung Import. Type: $metadata{'type'}\nIBAN: " . $ibanmessage,
223
    taxincluded         => 0,
224
    currency_id         => $currency->id,
225
    ar_ap_chart_id      => $ap_chart_id,
226
    );
227

  
228
  $template_ap->save;
229

  
230
  my $default_ap_amount_chart = SL::DB::Manager::Chart->find_by(charttype => 'A');
231

  
232
  foreach my $i ( @items )
233
    {
234
    my %item = %{$i};
235

  
236
    my $net_total = $item{'subtotal'};
237
    my $desc = $item{'description'};
238
    my $tax_rate = $item{'tax_rate'} / 100; # XML data is usually in percent
239

  
240
    my $taxes = SL::DB::Manager::Tax->get_all(
241
      where   => [ chart_categories => { like => '%' . $default_ap_amount_chart->category . '%' },
242
                   rate => $tax_rate,
243
                 ],
244
    );
245

  
246
    # If we really can't find any tax definition (a simple rounding error may
247
    # be sufficient for that to happen), grab the first tax fitting the default
248
    # category, just like the AP form would do it for manual entry.
249
    if ( scalar @{$taxes} == 0 ) {
250
      $taxes = SL::D::ManagerTax->get_all(
251
        where   => [ chart_categories => { like => '%' . $default_ap_amount_chart->category . '%' } ],
252
      );
253
    }
254

  
255
    my $tax = ${$taxes}[0];
256

  
257
    my $item_obj = SL::DB::RecordTemplateItem
258
      ->new(amount1 => $net_total,
259
            record_template_id => $template_ap->id,
260
            chart_id      => $default_ap_amount_chart->id,
261
            tax_id      => $tax->id,
262
        );
263
    $item_obj->save;
264
    }
265

  
137 266
  $self->redirect_to(
138 267
    controller                           => 'ap.pl',
139 268
    action                               => 'load_record_template',
140 269
    id                                   => $template_ap->id,
141
    'form_defaults.amount_1'             => $::form->format_amount(\%::myconfig, $total, 2),
142
    'form_defaults.transdate'            => $dt_to_kivi,
143
    'form_defaults.invnumber'            => $invnumber,
144
    'form_defaults.duedate'              => $due_dt_to_kivi,
145 270
    'form_defaults.no_payment_bookings'  => 0,
146
    'form_defaults.paid_1_suggestion'    => $::form->format_amount(\%::myconfig, $total, 2),
147
    'form_defaults.notes'                => "ZUGFeRD Import. Type: $type\nIBAN: " . $ibanmessage,
271
    'form_defaults.paid_1_suggestion'    => $::form->format_amount(\%::myconfig, $metadata{'total'}, 2),
272
    'form_defaults.invnumber'            => $invnumber,
273
    'form_defaults.duedate'              => $metadata{'duedate'},
274
    'form_defaults.transdate'            => $metadata{'transdate'},
275
    'form_defaults.notes'                => "ZUGFeRD Import. Type: $metadata{'type'}\nIBAN: " . $ibanmessage,
148 276
    'form_defaults.taxincluded'          => 0,
149
    'form_defaults.direct_debit'         => $direct_debit,
277
    'form_defaults.direct_debit'         => $metadata{'direct_debit'},
150 278
    'form_defaults.zugferd_session_file' => $file_name,
151 279
  );
152 280

  
......
189 317

  
190 318
=head1 NAME
191 319

  
192
SL::Controller::ZUGFeRD
193
Controller for importing ZUGFeRD pdf files to kivitendo
320
SL::Controller::ZUGFeRD - Controller for importing ZUGFeRD PDF files or XML invoices to kivitendo
194 321

  
195 322
=head1 FUNCTIONS
196 323

  
......
200 327

  
201 328
Creates a web from with a single upload dialog.
202 329

  
203
=item C<action_import_zugferd $pdf>
330
=item C<action_import_zugferd $file>
204 331

  
205
Expects a single pdf with ZUGFeRD 2.0 metadata.
206
Checks if the param <C$pdf> is set and a valid pdf file.
207
Calls helper functions to validate and extract the ZUGFeRD data.
208
Needs a valid VAT ID (EU) for this vendor and
209
expects one ap template for this vendor in kivitendo.
332
Expects a single PDF with ZUGFeRD, Factur-X or XRechnung
333
metadata. Alternatively, it can also process said data as a
334
standalone XML file.
210 335

  
211
Parses some basic ZUGFeRD data (invnumber, total net amount,
212
transdate, duedate, vendor VAT ID, IBAN) and uses the first
213
found ap template for this vendor to fill this template with
214
ZUGFeRD data.
215
If the vendor's master data contain a IBAN and the
216
ZUGFeRD record has a IBAN also these values will be compared.
217
If they  don't match a warning will be writte in ap.notes.
218
Furthermore the ZUGFeRD type code will be written to ap.notes.
219
No callback implemented.
336
Checks if the param <C$pdf> is set and a valid PDF or XML
337
file. Calls helper functions to validate and extract the
338
ZUGFeRD/Factur-X/XRechnung data. The invoice needs to have a
339
valid VAT ID (EU) or tax number (Germany) and a vendor with
340
the same VAT ID or tax number enrolled in Kivitendo.
341

  
342
It parses some basic ZUGFeRD data (invnumber, total net amount,
343
transdate, duedate, vendor VAT ID, IBAN, etc.) and also
344
extracts the invoice's items.
345

  
346
If the invoice has a IBAN also, it will be be compared to the
347
IBAN saved for the vendor (if any). If they  don't match a
348
warning will be writte in ap.notes. Furthermore the ZUGFeRD
349
type code will be written to ap.notes. No callback
350
implemented.
220 351

  
221 352
=back
222 353

  
223
=head1 TODO and CAVEAT
354
=head1 CAVEAT
355

  
356
This is just a very basic Parser for ZUGFeRD/Factur-X/XRechnung invoices.
357
We assume that the invoice's creator is a company with a valid
358
European VAT ID or German tax number and enrolled in
359
Kivitendo. Currently, implementation is a bit hacky because
360
invoice import uses AP record templates as a vessel for
361
generating the AP record form with the imported data filled
362
in.
363

  
364
=head1 TODO
365

  
366
This implementation could be improved as follows:
367

  
368
=over 4
369

  
370
=item Direct creation of the filled in AP record form
371

  
372
Creating an AP record template in the database is not
373
very elegant, since it will spam the database with record
374
templates that become redundant once the invoice has been
375
booked. It would be preferable to fill in the form directly.
376

  
377
=item Automatic upload of invoice
378

  
379
Right now, one has to use the "Book and upload" button to
380
upload the raw invoice document to WebDAV or DMS and attach it
381
to the invoice. This should be a simple matter of setting a
382
check box when uploading.
383

  
384
=item Handling of vendor invoices
385

  
386
There is no reason this functionality could not be used to
387
import vendor invoices as well. Since these tend to be very
388
lengthy, the ability to import them would be very beneficial.
224 389

  
225
This is just a very basic Parser for ZUGFeRD data.
226
We assume that the ZUGFeRD generator is a company with a
227
valid European VAT ID. Furthermore this vendor needs only
228
one and just noe ap template (the first match will be used).
390
=item Automatic handling of payment purpose
229 391

  
230
The ZUGFeRD data should also be extracted in the helper package
231
and maybe a model should be used for this.
232
The user should set one ap template as a default for ZUGFeRD.
233
The ZUGFeRD pdf should be written to WebDAV or DMS.
234 392
If the ZUGFeRD data has a payment purpose set, this should
235 393
be the default for the SEPA-XML export.
236 394

  
395
=back
396

  
397
=head1 AUTHORS
398

  
399
=over 4
400

  
401
=item Jan Büren E<lt>jan@kivitendo-premium.deE<gt>,
237 402

  
238
=head1 AUTHOR
403
=item Johannes Graßler E<lt>info@computer-grassler.deE<gt>,
239 404

  
240
Jan Büren E<lt>jan@kivitendo-premium.deE<gt>,
405
=back
241 406

  
242 407
=cut
SL/ZUGFeRD.pm
10 10
use XML::LibXML;
11 11

  
12 12
use SL::Locale::String qw(t8);
13
use SL::XMLInvoice;
13 14

  
14 15
use parent qw(Exporter);
15 16
our @EXPORT_PROFILES = qw(PROFILE_FACTURX_EXTENDED PROFILE_XRECHNUNG);
......
20 21
use constant PROFILE_XRECHNUNG        => 1;
21 22

  
22 23
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;
24
use constant RES_ERR_FILE_OPEN                   => -1;
25
use constant RES_ERR_NO_ATTACHMENT               => -2;
28 26

  
29 27
our @customer_settings = (
30 28
  [ 0,                                  t8('Do not create Factur-X/ZUGFeRD invoices')                                    ],
......
47 45

  
48 46
sub _extract_zugferd_invoice_xml {
49 47
  my $doc        = shift;
50
  my $names_dict = $doc->getValue($doc->getRootDict->{Names}) or return {};
51
  my $files_tree = $names_dict->{EmbeddedFiles}               or return {};
48
  my %res_fail;
49

  
50
  $res_fail{'result'}  = RES_ERR_NO_ATTACHMENT();
51
  $res_fail{'message'} = "PDF does not have a Names dictionary.";
52
  my $names_dict = $doc->getValue($doc->getRootDict->{Names}) or return \%res_fail;
53

  
54
  $res_fail{'message'} = "PDF does not have a EmbeddedFiles tree.";
55
  my $files_tree = $names_dict->{EmbeddedFiles}               or return \%res_fail;
56

  
52 57
  my @agenda     = $files_tree;
53
  my $ret        = {};
58

  
59
  my $parser;  # SL::XMLInvoice object used as return value
60
  my @res;     # Temporary storage for error messages encountered during
61
               # attempts to process attachments.
54 62

  
55 63
  # Hardly ever more than single leaf, but...
56 64

  
......
74 82
        my $obj_node = $doc->dereference($any_num);
75 83
        my $content  = $doc->decodeOne($obj_node->{value}, 0) // '';
76 84

  
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');
85
        $parser = $parser = SL::XMLInvoice->new($content);
86

  
87
        # Caveat: this will only ever catch the first attachment looking like
88
        #         an XML invoice.
89
        if ( $parser->{status} == SL::XMLInvoice::RES_OK ){
90
          return $parser;
91
        } else {
92
          push @res, t8("Could not parse PDF embedded attachment #1: #2",
93
                       $k,
94
                       $parser->{result});
95
        }
84 96
      }
85 97
    }
86 98
  }
87 99

  
88
  return undef;
100
  # There's going to be at least one attachment that failed to parse as XML by
101
  # this point - if there were no attachments at all, we would have bailed out
102
  # a lot earlier.
103

  
104
  %res_fail = ( result  => RES_ERR_FILE_OPEN(),
105
                message => join("; ", @res),
106
  );
107

  
108
  return \%res_fail;
89 109
}
90 110

  
91 111
sub _get_xmp_metadata {
......
95 115
  if ($node && $node->{StreamData} && defined($node->{StreamData}->{value})) {
96 116
    return $node->{StreamData}->{value};
97 117
  }
98

  
99 118
  return undef;
100 119
}
101 120

  
102 121
sub extract_from_pdf {
103 122
  my ($self, $file_name) = @_;
123
  my @warnings;
104 124

  
105 125
  my $pdf_doc = CAM::PDF->new($file_name);
106 126

  
107 127
  if (!$pdf_doc) {
108
    return {
128
    return \{
109 129
      result  => RES_ERR_FILE_OPEN(),
110 130
      message => $::locale->text('The file \'#1\' could not be opened for reading.', $file_name),
111 131
    };
112 132
  }
113 133

  
114 134
  my $xmp = _get_xmp_metadata($pdf_doc);
135

  
115 136
  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
  }
137
      push @warnings, $::locale->text('The file \'#1\' does not contain the required XMP meta data.', $file_name);
138
  } else {
139
    my $dom = eval { XML::LibXML->load_xml(string => $xmp) };
121 140

  
122
  my $bad = {
123
    result  => RES_ERR_NO_XMP_METADATA(),
124
    message => $::locale->text('Parsing the XMP metadata failed.'),
125
  };
141
    push @warnings, $::locale->text('Parsing the XMP metadata failed.'), if !$dom;
126 142

  
127
  my $dom = eval { XML::LibXML->load_xml(string => $xmp) };
143
    my $xpc = XML::LibXML::XPathContext->new($dom);
144
    $xpc->registerNs('rdf', 'http://www.w3.org/1999/02/22-rdf-syntax-ns#');
128 145

  
129
  return $bad if !$dom;
146
    my $zugferd_version;
130 147

  
131
  my $xpc = XML::LibXML::XPathContext->new($dom);
132
  $xpc->registerNs('rdf', 'http://www.w3.org/1999/02/22-rdf-syntax-ns#');
148
    my $test = $xpc->findnodes('/x:xmpmeta/rdf:RDF/rdf:Description');
133 149

  
134
  my $zugferd_version;
150
    foreach my $node ($xpc->findnodes('/x:xmpmeta/rdf:RDF/rdf:Description')) {
151
      my $ns = first { ref($_) eq 'XML::LibXML::Namespace' } $node->attributes;
152
      next unless $ns;
135 153

  
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;
154
      if ($ns->getData =~ m{urn:zugferd:pdfa:CrossIndustryDocument:invoice:2p0}) {
155
        $zugferd_version = 'zugferd:2p0';
156
        last;
157
      }
139 158

  
140
    if ($ns->getData =~ m{urn:zugferd:pdfa:CrossIndustryDocument:invoice:2p0}) {
141
      $zugferd_version = 'zugferd:2p0';
142
      last;
143
    }
159
      if ($ns->getData =~ m{urn:factur-x:pdfa:CrossIndustryDocument:invoice:1p0}) {
160
        $zugferd_version = 'factur-x:1p0';
161
        last;
162
      }
144 163

  
145
    if ($ns->getData =~ m{urn:factur-x:pdfa:CrossIndustryDocument:invoice:1p0}) {
146
      $zugferd_version = 'factur-x:1p0';
147
      last;
164
      if ($ns->getData =~ m{zugferd|factur-x}i) {
165
        $zugferd_version = 'unsupported';
166
        last;
167
      }
148 168
    }
149 169

  
150
    if ($ns->getData =~ m{zugferd|factur-x}i) {
151
      $zugferd_version = 'unsupported';
152
      last;
170
    if (!$zugferd_version) {
171
        push @warnings, $::locale->text('The XMP metadata does not declare the Factur-X/ZUGFeRD data.'),
153 172
    }
154
  }
155 173

  
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
    };
174
    if ($zugferd_version eq 'unsupported') {
175
        push @warnings, $::locale->text('The Factur-X/ZUGFeRD version used is not supported.'),
176
    }
168 177
  }
169 178

  
170 179
  my $invoice_xml = _extract_zugferd_invoice_xml($pdf_doc);
171 180

  
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
  }
181
  my %res;
178 182

  
179
  return {
180
    result       => RES_OK(),
183
  %res = (
184
    result       => $invoice_xml->{result},
185
    message      => $invoice_xml->{message},
181 186
    metadata_xmp => $xmp,
182 187
    invoice_xml  => $invoice_xml,
183
  };
188
    warnings     => \@warnings,
189
  );
190

  
191
  return \%res;
192
}
193

  
194
sub extract_from_xml {
195
  my ($self, $data) = @_;
196

  
197
  my %res;
198

  
199
  my $invoice_xml = SL::XMLInvoice->new($data);
200
  
201
  %res = (
202
    result       => $invoice_xml->{result},
203
    message      => $invoice_xml->{message},
204
    metadata_xmp => undef,
205
    invoice_xml  => $invoice_xml,
206
    warnings     => (),
207
  );
208

  
209
  return \%res;
184 210
}
185 211

  
186 212
1;
......
200 226
    my $pdf  = '/path/to/my.pdf';
201 227
    my $info = SL::ZUGFeRD->extract_from_pdf($pdf);
202 228

  
229
    my $xml  = '<?xml version="1.0" encoding="UTF-8"?> ...';
230
    my $info = SL::ZUGFeRD->extract_from_xml($xml);
231

  
203 232
    if ($info->{result} != SL::ZUGFeRD::RES_OK()) {
204 233
      # An error occurred; log message from parser:
205 234
      $::lxdebug->message(LXDebug::DEBUG1(), "Could not extract ZUGFeRD data from $pdf: " . $info->{message});
206 235
      return;
207 236
    }
208 237

  
209
    # Parse & handle invoice XML:
210
    my $dom = XML::LibXML->load_xml(string => $info->{invoice_xml});
238
    # Access invoice XML data:
239
    my $inv = ${$info}{'invoice_xml};
240
    my %metadata = %{$inv->metadata};
241
    my @items = @{$inv->items};
242
    my $dom = $inv->dom;
211 243

  
212 244

  
213 245
=head1 FUNCTIONS
214 246

  
215
=over 4
216

  
217
=item C<extract_from_pdf> C<$file_name>
247
=head2 extract_from_pdf E<lt>file_nameE<gt>
218 248

  
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
249
Opens an existing PDF file in the file system and tries to extract
250
Factur-X/XRechnung/ZUGFeRD invoice data from it. First it'll parse the XMP
221 251
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.
252
declaration isn't found or the declared version isn't 2p0, an warning is
253
recorded in the returned data structure's C<warnings> key.
224 254

  
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.
255
Regardless of metadata presence, it will continue to iterate over all files
256
embedded in the PDF and attempt to parse them with SL::XMLInvoice. If it
257
succeeds, the first SL::XMLInvoice object that indicates successful parsing is
258
returned.
228 259

  
229 260
Always returns a hash ref containing the key C<result>, a number that
230 261
can be one of the following constants:
231 262

  
232 263
=over 4
233 264

  
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.
265
=item C<RES_OK> (0): parsing was OK.
266

  
267
=item C<RES_ERR_…> (all values E<!=> 0): parsing failed. Values > 0 indicate a failure
268
in C<SL::XMLInvoice>, Values < 0 indicate a failure in C<SL::ZUGFeRD>.
269

  
270
=back
271

  
272
Other than that, the hash ref contains the following keys:
273

  
274
=over 4
275

  
276
=item C<message> - An error message detailing the problem upon nonzero C<result>, undef otherwise.
277

  
278
=item C<metadata_xmp> - The XMP metadata extracted from the Factur-X/ZUGFeRD invoice (if present)
279

  
280
=item C<invoice_xml> - An SL::XMLInvoice object holding the data extracted from the parsed XML invoice.
281

  
282
=item C<warnings> - Warnings encountered upon extracting/parsing XML files (if any)
283

  
284
=back
285

  
286
=head2 extract_from_xml E<lt>stringE<gt>
287

  
288
Takes a string containing an XML document with Factur-X/XRechnung/ZUGFeRD
289
invoice data and attempts to parse it using C<SL::XMLInvoice>.
290

  
291
If parsing is successful, an SL::XMLInvoice object containing the document's
292
parsed data is returned.
293

  
294
This method always returns a hash ref containing the key C<result>, a number that
295
can be one of the following constants:
296

  
297
=over 4
298

  
299
=item C<RES_OK> (0): parsing was OK.
237 300

  
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.
301
=item C<RES_ERR_…> (all values E<!=> 0): parsing failed. Values > 0 indicate a failure
302
in C<SL::XMLInvoice>, Values < 0 indicate a failure in C<SL::ZUGFeRD>.
241 303

  
242 304
=back
243 305

  
306
Other than that, the hash ref contains the following keys:
307

  
308
=over 4
309

  
310
=item C<message> - An error message detailing the problem upon nonzero C<result>, undef otherwise.
311

  
312
=item C<metadata_xmp> - Always undef and only present to let downstream code expecting its presence fail gracefully.
313

  
314
=item C<invoice_xml> - An SL::XMLInvoice object holding the data extracted from the parsed XML invoice.
315

  
316
=item C<warnings> - Warnings encountered upon extracting/parsing XML data (if any)
317

  
244 318
=back
245 319

  
246 320
=head1 BUGS
247 321

  
248 322
Nothing here yet.
249 323

  
250
=head1 AUTHOR
324
=head1 AUTHORS
251 325

  
252
Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>
326
=over 4
327

  
328
=item Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>
329

  
330
=item Johannes Graßler E<lt>info@computer-grassler.deE<gt>
331

  
332
=back
253 333

  
254 334
=cut
templates/webpages/zugferd/form.html
10 10
 </p>
11 11

  
12 12
 <form method="post" action="controller.pl" enctype="multipart/form-data" id="form">
13
    [% L.input_tag('file', '', type => 'file', accept => '.pdf', onchange='kivi.ZUGFeRD.update_file_name();') %]
13
    [% L.input_tag('file', '', type => 'file', accept => '.pdf,.xml', onchange='kivi.ZUGFeRD.update_file_name();') %]
14 14
    [% L.hidden_tag('file_name', '') %]
15 15
 </form>

Auch abrufbar als: Unified diff