Revision eada6c17
Von Johannes Grassler vor mehr als 1 Jahr hinzugefügt
| SL/Controller/ZUGFeRD.pm | ||
|---|---|---|
|
|
||
|
if ( ! ($metadata{'ustid'} or $metadata{'taxnumber'}) ) {
|
||
|
die t8("Cannot process this invoice: neither VAT ID nor tax ID present.");
|
||
|
}
|
||
|
}
|
||
|
|
||
|
$vendor = find_vendor($metadata{'ustid'}, $metadata{'taxnumber'});
|
||
|
|
||
| ... | ... | |
|
my $tax_rate = $item{'tax_rate'} / 100; # XML data is usually in percent
|
||
|
|
||
|
my $taxes = SL::DB::Manager::Tax->get_all(
|
||
|
where => [ chart_categories => { like => '%' . $default_ap_amount_chart->category . '%' },
|
||
|
rate => $tax_rate,
|
||
|
],
|
||
|
where => [
|
||
|
chart_categories => { like => '%' . $default_ap_amount_chart->category . '%' },
|
||
|
rate => $tax_rate,
|
||
|
],
|
||
|
);
|
||
|
|
||
|
# If we really can't find any tax definition (a simple rounding error may
|
||
| ... | ... | |
|
|
||
|
my $tax = ${$taxes}[0];
|
||
|
|
||
|
my $item_obj = SL::DB::RecordTemplateItem
|
||
|
->new(amount1 => $net_total,
|
||
|
record_template_id => $template_ap->id,
|
||
|
chart_id => $default_ap_amount_chart->id,
|
||
|
tax_id => $tax->id,
|
||
|
);
|
||
|
my $item_obj = SL::DB::RecordTemplateItem->new(
|
||
|
amount1 => $net_total,
|
||
|
record_template_id => $template_ap->id,
|
||
|
chart_id => $default_ap_amount_chart->id,
|
||
|
tax_id => $tax->id,
|
||
|
);
|
||
|
$item_obj->save;
|
||
|
}
|
||
|
|
||
| SL/XMLInvoice.pm | ||
|---|---|---|
|
package SL::XMLInvoice;
|
||
|
|
||
|
use strict;
|
||
|
use warnings;
|
||
|
|
||
|
use XML::LibXML;
|
||
|
|
||
|
use SL::XMLInvoice::UBL;
|
||
|
use SL::XMLInvoice::CrossIndustryInvoice;
|
||
|
|
||
|
use constant RES_OK => 0;
|
||
|
use constant RES_XML_PARSING_FAILED => 1;
|
||
|
use constant RES_UNKNOWN_ROOT_NODE_TYPE => 2;
|
||
|
|
||
|
=head1 NAME
|
||
|
|
||
|
SL::XMLInvoice - Top level factory class for XML Invoice parsers.
|
||
| ... | ... | |
|
|
||
|
=cut
|
||
|
|
||
|
use strict;
|
||
|
use warnings;
|
||
|
|
||
|
use XML::LibXML;
|
||
|
|
||
|
=head1 ATTRIBUTES
|
||
|
|
||
|
=over 4
|
||
| ... | ... | |
|
|
||
|
=cut
|
||
|
|
||
|
use constant RES_OK => 0;
|
||
|
use constant RES_XML_PARSING_FAILED => 1;
|
||
|
use constant RES_UNKNOWN_ROOT_NODE_TYPE => 2;
|
||
|
|
||
|
=head1 METHODS
|
||
|
|
||
|
=head2 Data structure definition methods (only in C<SL::XMLInvoice>)
|
||
| ... | ... | |
|
sub metadata {
|
||
|
my $self = shift;
|
||
|
die "Children of $self must implement a metadata() method returning the bill's metadata as a hash.";
|
||
|
}
|
||
|
}
|
||
|
|
||
|
=item items()
|
||
|
|
||
| ... | ... | |
|
sub items {
|
||
|
my $self = shift;
|
||
|
die "Children of $self must implement a item() method returning the bill's items as a hash.";
|
||
|
}
|
||
|
}
|
||
|
|
||
|
=item parse_xml()
|
||
|
|
||
| ... | ... | |
|
sub parse_xml {
|
||
|
my $self = shift;
|
||
|
die "Children of $self must implement a parse_xml() method.";
|
||
|
}
|
||
|
}
|
||
|
|
||
|
=head2 Internal methods
|
||
|
|
||
| ... | ... | |
|
|
||
|
=cut
|
||
|
|
||
|
use SL::XMLInvoice::UBL;
|
||
|
use SL::XMLInvoice::CrossIndustryInvoice;
|
||
|
|
||
|
sub _document_nodenames {
|
||
|
return {
|
||
|
'rsm:CrossIndustryInvoice' => 'SL::XMLInvoice::CrossIndustryInvoice',
|
||
| ... | ... | |
|
sub _data_keys {
|
||
|
my $self = shift;
|
||
|
die "Children of $self must implement a _data_keys() method returning the keys an invoice item hash will contain.";
|
||
|
}
|
||
|
}
|
||
|
|
||
|
=item _item_keys()
|
||
|
|
||
| ... | ... | |
|
sub _item_keys {
|
||
|
my $self = shift;
|
||
|
die "Children of $self must implement a _item_keys() method returning the keys an invoice item hash will contain.";
|
||
|
}
|
||
|
}
|
||
|
|
||
|
|
||
|
sub new
|
||
|
{
|
||
|
sub new {
|
||
|
my ($self, $xml_data) = @_;
|
||
|
my $type = undef;
|
||
|
$self = {};
|
||
| ... | ... | |
|
$self->{message} = $::locale->text("Parsing the XML data failed: $xml_data");
|
||
|
$self->{result} = RES_XML_PARSING_FAILED;
|
||
|
return $self;
|
||
|
}
|
||
|
}
|
||
|
|
||
|
# Determine parser class to use
|
||
|
my $document_nodename = $self->{dom}->documentElement->nodeName;
|
||
|
if ( ${$self->_document_nodenames}{$document_nodename} ) {
|
||
|
$type = ${$self->_document_nodenames}{$document_nodename}
|
||
|
}
|
||
|
}
|
||
|
|
||
|
unless ( $type ) {
|
||
|
$self->{result} = RES_UNKNOWN_ROOT_NODE_TYPE;
|
||
| ... | ... | |
|
$node_types,
|
||
|
$document_nodename);
|
||
|
return $self;
|
||
|
}
|
||
|
}
|
||
|
|
||
|
bless $self, $type;
|
||
|
|
||
|
# Implementation sanity check for child classes: make sure they are aware of
|
||
|
# the keys the hash returned by their metadata() method must contain.
|
||
|
my @missing_data_keys = ();
|
||
|
foreach my $data_key ( @{$self->data_keys} )
|
||
|
{
|
||
|
unless ( ${$self->_data_keys}{$data_key}) { push @missing_data_keys, $data_key; }
|
||
|
}
|
||
|
my @missing_data_keys = grep { !${$self->_data_keys}{$data_key} } @{ $self->data_keys };
|
||
|
if ( scalar(@missing_data_keys) > 0 ) {
|
||
|
die "Incomplete implementation: the following metadata keys appear to be missing from $type: " . join(", ", @missing_data_keys);
|
||
|
}
|
||
| ... | ... | |
|
# Implementation sanity check for child classes: make sure they are aware of
|
||
|
# the keys the hashes returned by their items() method must contain.
|
||
|
my @missing_item_keys = ();
|
||
|
foreach my $item_key ( @{$self->item_keys} )
|
||
|
{
|
||
|
foreach my $item_key ( @{$self->item_keys} ) {
|
||
|
unless ( ${$self->_item_keys}{$item_key}) { push @missing_item_keys, $item_key; }
|
||
|
}
|
||
|
}
|
||
|
if ( scalar(@missing_item_keys) > 0 ) {
|
||
|
die "Incomplete implementation: the following item keys appear to be missing from $type: " . join(", ", @missing_item_keys);
|
||
|
}
|
||
| ... | ... | |
|
|
||
|
$self->{result} = RES_OK;
|
||
|
return $self;
|
||
|
}
|
||
|
}
|
||
|
|
||
|
1;
|
||
|
|
||
| SL/XMLInvoice/CrossIndustryInvoice.pm | ||
|---|---|---|
|
package SL::XMLInvoice::CrossIndustryInvoice;
|
||
|
|
||
|
use strict;
|
||
|
use warnings;
|
||
|
|
||
|
use parent qw(SL::XMLInvoice);
|
||
|
|
||
|
use constant ITEMS_XPATH => '//ram:IncludedSupplyChainTradeLineItem';
|
||
|
|
||
|
=head1 NAME
|
||
|
|
||
|
SL::XMLInvoice::FakturX - XML parser for UN/CEFACT Cross Industry Invoice
|
||
| ... | ... | |
|
|
||
|
=cut
|
||
|
|
||
|
use strict;
|
||
|
use constant ITEMS_XPATH => '//ram:IncludedSupplyChainTradeLineItem';
|
||
|
|
||
|
# XML XPath expressions for global metadata
|
||
|
sub scalar_xpaths {
|
||
|
return {
|
||
| ... | ... | |
|
push @items, \%line_item;
|
||
|
}
|
||
|
|
||
|
|
||
|
}
|
||
|
|
||
|
1;
|
||
| SL/XMLInvoice/UBL.pm | ||
|---|---|---|
|
package SL::XMLInvoice::UBL;
|
||
|
|
||
|
use strict;
|
||
|
use warnings;
|
||
|
|
||
|
use parent qw(SL::XMLInvoice);
|
||
|
|
||
|
use constant ITEMS_XPATH => '//cac:InvoiceLine';
|
||
|
|
||
|
=head1 NAME
|
||
|
|
||
|
SL::XMLInvoice::UBL - XML parser for Universal Business Language invoices
|
||
| ... | ... | |
|
|
||
|
=cut
|
||
|
|
||
|
use strict;
|
||
|
use parent qw(SL::XMLInvoice);
|
||
|
|
||
|
use constant ITEMS_XPATH => '//cac:InvoiceLine';
|
||
|
|
||
|
# XML XPath expression for
|
||
|
sub scalar_xpaths {
|
||
|
return {
|
||
| ... | ... | |
|
# have to guess whether it's a tax ID or VAT ID (not using
|
||
|
# SL::VATIDNr->validate here to keep this code portable):
|
||
|
|
||
|
if ( ${$self->{_metadata}}{'ustid'} =~ qr"/" )
|
||
|
{
|
||
|
if ( ${$self->{_metadata}}{'ustid'} =~ qr"/" ) {
|
||
|
# Unset this since the 'taxid' key has been retrieved with the same xpath
|
||
|
# expression.
|
||
|
${$self->{_metadata}}{'ustid'} = undef;
|
||
|
} else {
|
||
|
} else {
|
||
|
# Unset this since the 'ustid' key has been retrieved with the same xpath
|
||
|
# expression.
|
||
|
${$self->{_metadata}}{'taxnumber'} = undef;
|
||
|
}
|
||
|
}
|
||
|
|
||
|
my @items;
|
||
|
$self->{_items} = \@items;
|
||
| SL/ZUGFeRD.pm | ||
|---|---|---|
|
use constant PROFILE_FACTURX_EXTENDED => 0;
|
||
|
use constant PROFILE_XRECHNUNG => 1;
|
||
|
|
||
|
use constant RES_OK => 0;
|
||
|
use constant RES_ERR_FILE_OPEN => -1;
|
||
|
use constant RES_ERR_NO_ATTACHMENT => -2;
|
||
|
use constant RES_OK => 0;
|
||
|
use constant RES_ERR_FILE_OPEN => -1;
|
||
|
use constant RES_ERR_NO_ATTACHMENT => -2;
|
||
|
|
||
|
our @customer_settings = (
|
||
|
[ 0, t8('Do not create Factur-X/ZUGFeRD invoices') ],
|
||
| ... | ... | |
|
if ( $parser->{status} == SL::XMLInvoice::RES_OK ){
|
||
|
return $parser;
|
||
|
} else {
|
||
|
push @res, t8("Could not parse PDF embedded attachment #1: #2",
|
||
|
$k,
|
||
|
$parser->{result});
|
||
|
push @res, t8(
|
||
|
"Could not parse PDF embedded attachment #1: #2",
|
||
|
$k,
|
||
|
$parser->{result}
|
||
|
);
|
||
|
}
|
||
|
}
|
||
|
}
|
||
| ... | ... | |
|
# this point - if there were no attachments at all, we would have bailed out
|
||
|
# a lot earlier.
|
||
|
|
||
|
%res_fail = ( result => RES_ERR_FILE_OPEN(),
|
||
|
message => join("; ", @res),
|
||
|
%res_fail = (
|
||
|
result => RES_ERR_FILE_OPEN(),
|
||
|
message => join("; ", @res),
|
||
|
);
|
||
|
|
||
|
return \%res_fail;
|
||
Auch abrufbar als: Unified diff
Einrueckungen und weitere Stilprobleme repariert