kivitendo/SL/GoBD.pm @ c45403f9
| e2b04039 | Sven Schöling | package SL::GoBD;
|
||
| 11e50931 | Sven Schöling | |||
# TODO:
|
||||
# optional: background jobable
|
||||
use strict;
|
||||
use utf8;
|
||||
use parent qw(Rose::Object);
|
||||
use Text::CSV_XS;
|
||||
use XML::Writer;
|
||||
use Archive::Zip;
|
||||
use File::Temp ();
|
||||
use File::Spec ();
|
||||
| 00b6dc22 | Sven Schöling | use List::MoreUtils qw(any);
|
||
use List::UtilsBy qw(partition_by sort_by);
|
||||
| 11e50931 | Sven Schöling | |||
use SL::DB::Helper::ALL; # since we work on meta data, we need everything
|
||||
use SL::DB::Helper::Mappings;
|
||||
use SL::Locale::String qw(t8);
|
||||
| 4a395995 | Sven Schöling | use SL::Version;
|
||
| 11e50931 | Sven Schöling | |||
use Rose::Object::MakeMethods::Generic (
|
||||
| 00b6dc22 | Sven Schöling | scalar => [ qw(from to writer company location) ],
|
||
| b21776d2 | Sven Schöling | 'scalar --get_set_init' => [ qw(files tempfiles export_ids tables csv_headers) ],
|
||
| 11e50931 | Sven Schöling | );
|
||
# in this we find:
|
||||
# key: table name
|
||||
# name: short name, translated
|
||||
# description: long description, translated
|
||||
| b21776d2 | Sven Schöling | # columns: list of columns to export. export all columns if not present
|
||
# primary_key: override primary key
|
||||
| 11e50931 | Sven Schöling | my %known_tables = (
|
||
| ba9e2e01 | Sven Schöling | chart => { name => t8('Charts'), description => t8('Chart of Accounts'), primary_key => 'accno', columns => [ qw(id accno description) ], },
|
||
| b21776d2 | Sven Schöling | customer => { name => t8('Customers'), description => t8('Customer Master Data'), columns => [ qw(id customernumber name department_1 department_2 street zipcode city country contact phone fax email notes taxnumber obsolete ustid) ] },
|
||
vendor => { name => t8('Vendors'), description => t8('Vendor Master Data'), columns => [ qw(id vendornumber name department_1 department_2 street zipcode city country contact phone fax email notes taxnumber obsolete ustid) ] },
|
||||
| 00b6dc22 | Sven Schöling | );
|
||
| b21776d2 | Sven Schöling | my %column_titles = (
|
||
chart => {
|
||||
id => t8('ID'),
|
||||
accno => t8('Account Number'),
|
||||
description => t8('Description'),
|
||||
},
|
||||
customer_vendor => {
|
||||
| ce1e79d3 | Sven Schöling | id => t8('ID (lit)'),
|
||
| b21776d2 | Sven Schöling | name => t8('Name'),
|
||
department_1 => t8('Department 1'),
|
||||
department_2 => t8('Department 2'),
|
||||
street => t8('Street'),
|
||||
zipcode => t8('Zipcode'),
|
||||
city => t8('City'),
|
||||
country => t8('Country'),
|
||||
contact => t8('Contact'),
|
||||
phone => t8('Phone'),
|
||||
fax => t8('Fax'),
|
||||
email => t8('E-mail'),
|
||||
notes => t8('Notes'),
|
||||
customernumber => t8('Customer Number'),
|
||||
vendornumber => t8('Vendor Number'),
|
||||
taxnumber => t8('Tax Number'),
|
||||
obsolete => t8('Obsolete'),
|
||||
ustid => t8('Tax ID number'),
|
||||
},
|
||||
);
|
||||
$column_titles{$_} = $column_titles{customer_vendor} for qw(customer vendor);
|
||||
| 00b6dc22 | Sven Schöling | my %datev_column_defs = (
|
||
| 2ecfde54 | Sven Schöling | trans_id => { type => 'Rose::DB::Object::Metadata::Column::Integer', text => t8('ID'), },
|
||
| 00b6dc22 | Sven Schöling | amount => { type => 'Rose::DB::Object::Metadata::Column::Numeric', text => t8('Amount'), },
|
||
credit_accname => { type => 'Rose::DB::Object::Metadata::Column::Text', text => t8('Credit Account Name'), },
|
||||
credit_accno => { type => 'Rose::DB::Object::Metadata::Column::Text', text => t8('Credit Account'), },
|
||||
| a832d0e5 | Sven Schöling | credit_amount => { type => 'Rose::DB::Object::Metadata::Column::Text', text => t8('Credit Amount'), },
|
||
credit_tax => { type => 'Rose::DB::Object::Metadata::Column::Numeric', text => t8('Credit Tax (lit)'), },
|
||||
| 00b6dc22 | Sven Schöling | debit_accname => { type => 'Rose::DB::Object::Metadata::Column::Text', text => t8('Debit Account Name'), },
|
||
debit_accno => { type => 'Rose::DB::Object::Metadata::Column::Text', text => t8('Debit Account'), },
|
||||
| a832d0e5 | Sven Schöling | debit_amount => { type => 'Rose::DB::Object::Metadata::Column::Text', text => t8('Debit Amount'), },
|
||
debit_tax => { type => 'Rose::DB::Object::Metadata::Column::Numeric', text => t8('Debit Tax (lit)'), },
|
||||
| 00b6dc22 | Sven Schöling | invnumber => { type => 'Rose::DB::Object::Metadata::Column::Text', text => t8('Reference'), },
|
||
name => { type => 'Rose::DB::Object::Metadata::Column::Text', text => t8('Name'), },
|
||||
notes => { type => 'Rose::DB::Object::Metadata::Column::Text', text => t8('Notes'), },
|
||||
| 9b80a860 | Sven Schöling | tax => { type => 'Rose::DB::Object::Metadata::Column::Numeric', text => t8('Tax'), },
|
||
| 0e1c16fd | Sven Schöling | taxdescription => { type => 'Rose::DB::Object::Metadata::Column::Text', text => t8('tax_taxdescription'), },
|
||
| 00b6dc22 | Sven Schöling | taxkey => { type => 'Rose::DB::Object::Metadata::Column::Integer', text => t8('Taxkey'), },
|
||
tax_accname => { type => 'Rose::DB::Object::Metadata::Column::Text', text => t8('Tax Account Name'), },
|
||||
tax_accno => { type => 'Rose::DB::Object::Metadata::Column::Text', text => t8('Tax Account'), },
|
||||
| 0070a250 | Andreas Rudin | transdate => { type => 'Rose::DB::Object::Metadata::Column::Date', text => t8('Transdate'), },
|
||
| 00b6dc22 | Sven Schöling | vcnumber => { type => 'Rose::DB::Object::Metadata::Column::Text', text => t8('Customer/Vendor Number'), },
|
||
| 0e1c16fd | Sven Schöling | customer_id => { type => 'Rose::DB::Object::Metadata::Column::Integer', text => t8('Customer (database ID)'), },
|
||
vendor_id => { type => 'Rose::DB::Object::Metadata::Column::Integer', text => t8('Vendor (database ID)'), },
|
||||
| 470cd722 | Sven Schöling | itime => { type => 'Rose::DB::Object::Metadata::Column::Date', text => t8('Create Date'), },
|
||
| 0070a250 | Andreas Rudin | gldate => { type => 'Rose::DB::Object::Metadata::Column::Date', text => t8('Gldate'), },
|
||
| 00b6dc22 | Sven Schöling | );
|
||
my @datev_columns = qw(
|
||||
| 2ecfde54 | Sven Schöling | trans_id
|
||
| 00b6dc22 | Sven Schöling | customer_id vendor_id
|
||
name vcnumber
|
||||
transdate invnumber amount
|
||||
| a832d0e5 | Sven Schöling | debit_accno debit_accname debit_amount debit_tax
|
||
credit_accno credit_accname credit_amount credit_tax
|
||||
| 0e1c16fd | Sven Schöling | taxdescription tax
|
||
| 00b6dc22 | Sven Schöling | tax_accno tax_accname taxkey
|
||
| 39fc1390 | Sven Schöling | notes itime gldate
|
||
| 11e50931 | Sven Schöling | );
|
||
# rows in this listing are tiers.
|
||||
# tables may depend on ids in a tier above them
|
||||
my @export_table_order = qw(
|
||||
ar ap gl oe delivery_orders
|
||||
invoice orderitems delivery_order_items
|
||||
customer vendor
|
||||
parts
|
||||
acc_trans
|
||||
chart
|
||||
);
|
||||
# needed because the standard dbh sets datestyle german and we don't want to mess with that
|
||||
my $date_format = 'DD.MM.YYYY';
|
||||
| f63bc3db | Sven Schöling | my $number_format = '1000.00';
|
||
my $myconfig = { numberformat => $number_format };
|
||||
| 11e50931 | Sven Schöling | |||
# callbacks that produce the xml spec for these column types
|
||||
my %column_types = (
|
||||
| 3bb3a4a5 | Sven Schöling | 'Rose::DB::Object::Metadata::Column::Integer' => sub { $_[0]->tag('Numeric') }, # see Caveats for integer issues
|
||
'Rose::DB::Object::Metadata::Column::BigInt' => sub { $_[0]->tag('Numeric') }, # see Caveats for integer issues
|
||||
| 11e50931 | Sven Schöling | 'Rose::DB::Object::Metadata::Column::Text' => sub { $_[0]->tag('AlphaNumeric') },
|
||
'Rose::DB::Object::Metadata::Column::Varchar' => sub { $_[0]->tag('AlphaNumeric') },
|
||||
'Rose::DB::Object::Metadata::Column::Character' => sub { $_[0]->tag('AlphaNumeric') },
|
||||
'Rose::DB::Object::Metadata::Column::Numeric' => sub { $_[0]->tag('Numeric', sub { $_[0]->tag('Accuracy', 5) }) },
|
||||
'Rose::DB::Object::Metadata::Column::Date' => sub { $_[0]->tag('Date', sub { $_[0]->tag('Format', $date_format) }) },
|
||||
'Rose::DB::Object::Metadata::Column::Timestamp' => sub { $_[0]->tag('Date', sub { $_[0]->tag('Format', $date_format) }) },
|
||||
'Rose::DB::Object::Metadata::Column::Float' => sub { $_[0]->tag('Numeric') },
|
||||
| 561d4521 | Sven Schöling | 'Rose::DB::Object::Metadata::Column::Boolean' => sub { $_[0]
|
||
->tag('AlphaNumeric')
|
||||
| 11e50931 | Sven Schöling | ->tag('Map', sub { $_[0]
|
||
->tag('From', 1)
|
||||
->tag('To', t8('true'))
|
||||
})
|
||||
->tag('Map', sub { $_[0]
|
||||
->tag('From', 0)
|
||||
->tag('To', t8('false'))
|
||||
})
|
||||
->tag('Map', sub { $_[0]
|
||||
| 561d4521 | Sven Schöling | ->tag('From', '')
|
||
| 11e50931 | Sven Schöling | ->tag('To', t8('false'))
|
||
})
|
||||
| 561d4521 | Sven Schöling | },
|
||
| 11e50931 | Sven Schöling | );
|
||
sub generate_export {
|
||||
my ($self) = @_;
|
||||
# verify data
|
||||
$self->from && 'DateTime' eq ref $self->from or die 'need from date';
|
||||
$self->to && 'DateTime' eq ref $self->to or die 'need to date';
|
||||
$self->from <= $self->to or die 'from date must be earlier or equal than to date';
|
||||
$self->tables && @{ $self->tables } or die 'need tables';
|
||||
for (@{ $self->tables }) {
|
||||
next if $known_tables{$_};
|
||||
die "unknown table '$_'";
|
||||
}
|
||||
# get data from those tables and save to csv
|
||||
# for that we need to build queries that fetch all the columns
|
||||
for ($self->sorted_tables) {
|
||||
$self->do_csv_export($_);
|
||||
}
|
||||
| 00b6dc22 | Sven Schöling | $self->do_datev_csv_export;
|
||
| 11e50931 | Sven Schöling | # write xml file
|
||
$self->do_xml_file;
|
||||
# add dtd
|
||||
$self->files->{'gdpdu-01-08-2002.dtd'} = File::Spec->catfile('users', 'gdpdu-01-08-2002.dtd');
|
||||
# make zip
|
||||
my ($fh, $zipfile) = File::Temp::tempfile();
|
||||
my $zip = Archive::Zip->new;
|
||||
while (my ($name, $file) = each %{ $self->files }) {
|
||||
$zip->addFile($file, $name);
|
||||
}
|
||||
$zip->writeToFileHandle($fh) == Archive::Zip::AZ_OK() or die 'error writing zip file';
|
||||
close($fh);
|
||||
return $zipfile;
|
||||
}
|
||||
sub do_xml_file {
|
||||
my ($self) = @_;
|
||||
my ($fh, $filename) = File::Temp::tempfile();
|
||||
binmode($fh, ':utf8');
|
||||
$self->files->{'INDEX.XML'} = $filename;
|
||||
push @{ $self->tempfiles }, $filename;
|
||||
my $writer = XML::Writer->new(
|
||||
OUTPUT => $fh,
|
||||
ENCODING => 'UTF-8',
|
||||
);
|
||||
$self->writer($writer);
|
||||
$self->writer->xmlDecl('UTF-8');
|
||||
$self->writer->doctype('DataSet', undef, "gdpdu-01-08-2002.dtd");
|
||||
$self->tag('DataSet', sub { $self
|
||||
->tag('Version', '1.0')
|
||||
->tag('DataSupplier', sub { $self
|
||||
->tag('Name', $self->client_name)
|
||||
->tag('Location', $self->client_location)
|
||||
->tag('Comment', $self->make_comment)
|
||||
})
|
||||
->tag('Media', sub { $self
|
||||
->tag('Name', t8('DataSet #1', 1));
|
||||
| 8b374ce4 | Sven Schöling | for (reverse $self->sorted_tables) { $self # see CAVEATS for table order
|
||
| 11e50931 | Sven Schöling | ->table($_)
|
||
}
|
||||
| 00b6dc22 | Sven Schöling | $self->do_datev_xml_table;
|
||
| 11e50931 | Sven Schöling | })
|
||
});
|
||||
close($fh);
|
||||
}
|
||||
sub table {
|
||||
my ($self, $table) = @_;
|
||||
my $writer = $self->writer;
|
||||
$self->tag('Table', sub { $self
|
||||
->tag('URL', "$table.csv")
|
||||
->tag('Name', $known_tables{$table}{name})
|
||||
->tag('Description', $known_tables{$table}{description})
|
||||
->tag('Validity', sub { $self
|
||||
->tag('Range', sub { $self
|
||||
->tag('From', $self->from->to_kivitendo(dateformat => 'dd.mm.yyyy'))
|
||||
->tag('To', $self->to->to_kivitendo(dateformat => 'dd.mm.yyyy'))
|
||||
})
|
||||
->tag('Format', $date_format)
|
||||
})
|
||||
| 192f0245 | Sven Schöling | ->tag('UTF8')
|
||
| 11e50931 | Sven Schöling | ->tag('DecimalSymbol', '.')
|
||
| 161b9e70 | Sven Schöling | ->tag('DigitGroupingSymbol', '|') # see CAVEATS in documentation
|
||
| b21776d2 | Sven Schöling | ->tag('Range', sub { $self
|
||
->tag('From', $self->csv_headers ? 2 : 1)
|
||||
})
|
||||
| 11e50931 | Sven Schöling | ->tag('VariableLength', sub { $self
|
||
| 3bb3a4a5 | Sven Schöling | ->tag('ColumnDelimiter', ',') # see CAVEATS for missing RecordDelimiter
|
||
| f16b7735 | Sven Schöling | ->tag('TextEncapsulator', '"')
|
||
| 11e50931 | Sven Schöling | ->columns($table)
|
||
->foreign_keys($table)
|
||||
})
|
||||
});
|
||||
}
|
||||
sub _table_columns {
|
||||
my ($table) = @_;
|
||||
my $package = SL::DB::Helper::Mappings::get_package_for_table($table);
|
||||
| ba9e2e01 | Sven Schöling | my %white_list;
|
||
my $use_white_list = 0;
|
||||
if ($known_tables{$table}{columns}) {
|
||||
$use_white_list = 1;
|
||||
$white_list{$_} = 1 for @{ $known_tables{$table}{columns} || [] };
|
||||
}
|
||||
| 11e50931 | Sven Schöling | # PrimaryKeys must come before regular columns, so partition first
|
||
| 00b6dc22 | Sven Schöling | partition_by {
|
||
$known_tables{$table}{primary_key}
|
||||
? 1 * ($_ eq $known_tables{$table}{primary_key})
|
||||
: 1 * $_->is_primary_key_member
|
||||
| ba9e2e01 | Sven Schöling | } grep {
|
||
$use_white_list ? $white_list{$_->name} : 1
|
||||
| 00b6dc22 | Sven Schöling | } $package->meta->columns;
|
||
| 11e50931 | Sven Schöling | }
|
||
sub columns {
|
||||
my ($self, $table) = @_;
|
||||
my %cols_by_primary_key = _table_columns($table);
|
||||
for my $column (@{ $cols_by_primary_key{1} }) {
|
||||
my $type = $column_types{ ref $column };
|
||||
die "unknown col type @{[ ref $column ]}" unless $type;
|
||||
$self->tag('VariablePrimaryKey', sub { $self
|
||||
| b21776d2 | Sven Schöling | ->tag('Name', $column_titles{$table}{$column->name});
|
||
| 11e50931 | Sven Schöling | $type->($self);
|
||
})
|
||||
}
|
||||
for my $column (@{ $cols_by_primary_key{0} }) {
|
||||
my $type = $column_types{ ref $column };
|
||||
die "unknown col type @{[ ref $column]}" unless $type;
|
||||
$self->tag('VariableColumn', sub { $self
|
||||
| b21776d2 | Sven Schöling | ->tag('Name', $column_titles{$table}{$column->name});
|
||
| 11e50931 | Sven Schöling | $type->($self);
|
||
})
|
||||
}
|
||||
$self;
|
||||
}
|
||||
sub foreign_keys {
|
||||
my ($self, $table) = @_;
|
||||
my $package = SL::DB::Helper::Mappings::get_package_for_table($table);
|
||||
my %requested = map { $_ => 1 } @{ $self->tables };
|
||||
for my $rel ($package->meta->foreign_keys) {
|
||||
next unless $requested{ $rel->class->meta->table };
|
||||
# ok, now extract the columns used as foreign key
|
||||
my %key_columns = $rel->key_columns;
|
||||
if (1 != keys %key_columns) {
|
||||
die "multi keys? we don't support this currently. fix it please";
|
||||
}
|
||||
if ($table eq $rel->class->meta->table) {
|
||||
# self referential foreign keys are a PITA to export correctly. skip!
|
||||
next;
|
||||
}
|
||||
$self->tag('ForeignKey', sub {
|
||||
| b21776d2 | Sven Schöling | $_[0]->tag('Name', $column_titles{$table}{$_}) for keys %key_columns;
|
||
| 11e50931 | Sven Schöling | $_[0]->tag('References', $rel->class->meta->table);
|
||
});
|
||||
}
|
||||
}
|
||||
| 00b6dc22 | Sven Schöling | sub do_datev_xml_table {
|
||
my ($self) = @_;
|
||||
my $writer = $self->writer;
|
||||
$self->tag('Table', sub { $self
|
||||
| 2b880445 | Peter Schulgin | ->tag('URL', "transactions.csv")
|
||
| 00b6dc22 | Sven Schöling | ->tag('Name', t8('Transactions'))
|
||
->tag('Description', t8('Transactions'))
|
||||
->tag('Validity', sub { $self
|
||||
->tag('Range', sub { $self
|
||||
->tag('From', $self->from->to_kivitendo(dateformat => 'dd.mm.yyyy'))
|
||||
->tag('To', $self->to->to_kivitendo(dateformat => 'dd.mm.yyyy'))
|
||||
})
|
||||
->tag('Format', $date_format)
|
||||
})
|
||||
->tag('UTF8')
|
||||
->tag('DecimalSymbol', '.')
|
||||
->tag('DigitGroupingSymbol', '|') # see CAVEATS in documentation
|
||||
| b21776d2 | Sven Schöling | ->tag('Range', sub { $self
|
||
->tag('From', $self->csv_headers ? 2 : 1)
|
||||
})
|
||||
| 00b6dc22 | Sven Schöling | ->tag('VariableLength', sub { $self
|
||
->tag('ColumnDelimiter', ',') # see CAVEATS for missing RecordDelimiter
|
||||
->tag('TextEncapsulator', '"')
|
||||
->datev_columns
|
||||
->datev_foreign_keys
|
||||
})
|
||||
});
|
||||
}
|
||||
sub datev_columns {
|
||||
my ($self, $table) = @_;
|
||||
| 0e1c16fd | Sven Schöling | my %cols_by_primary_key = partition_by { 1 * $datev_column_defs{$_}{primary_key} } @datev_columns;
|
||
| 00b6dc22 | Sven Schöling | |||
for my $column (@{ $cols_by_primary_key{1} }) {
|
||||
my $type = $column_types{ $datev_column_defs{$column}{type} };
|
||||
die "unknown col type @{[ $column ]}" unless $type;
|
||||
$self->tag('VariablePrimaryKey', sub { $self
|
||||
| b21776d2 | Sven Schöling | ->tag('Name', $datev_column_defs{$column}{text});
|
||
| 00b6dc22 | Sven Schöling | $type->($self);
|
||
})
|
||||
}
|
||||
| 0e1c16fd | Sven Schöling | for my $column (@{ $cols_by_primary_key{0} }) {
|
||
| 00b6dc22 | Sven Schöling | my $type = $column_types{ $datev_column_defs{$column}{type} };
|
||
die "unknown col type @{[ ref $column]}" unless $type;
|
||||
$self->tag('VariableColumn', sub { $self
|
||||
| b21776d2 | Sven Schöling | ->tag('Name', $datev_column_defs{$column}{text});
|
||
| 00b6dc22 | Sven Schöling | $type->($self);
|
||
})
|
||||
}
|
||||
$self;
|
||||
}
|
||||
sub datev_foreign_keys {
|
||||
my ($self) = @_;
|
||||
# hard code weeee
|
||||
$self->tag('ForeignKey', sub { $_[0]
|
||||
| b21776d2 | Sven Schöling | ->tag('Name', $datev_column_defs{customer_id}{text})
|
||
| 00b6dc22 | Sven Schöling | ->tag('References', 'customer')
|
||
});
|
||||
$self->tag('ForeignKey', sub { $_[0]
|
||||
| b21776d2 | Sven Schöling | ->tag('Name', $datev_column_defs{vendor_id}{text})
|
||
| 00b6dc22 | Sven Schöling | ->tag('References', 'vendor')
|
||
});
|
||||
$self->tag('ForeignKey', sub { $_[0]
|
||||
| b21776d2 | Sven Schöling | ->tag('Name', $datev_column_defs{$_}{text})
|
||
| 00b6dc22 | Sven Schöling | ->tag('References', 'chart')
|
||
}) for qw(debit_accno credit_accno tax_accno);
|
||||
}
|
||||
sub do_datev_csv_export {
|
||||
my ($self) = @_;
|
||||
my $datev = SL::DATEV->new(from => $self->from, to => $self->to);
|
||||
| b90426d3 | Geoffrey Richardson | $datev->generate_datev_data(from_to => $datev->fromto);
|
||
| 00b6dc22 | Sven Schöling | |||
| b019bd39 | Sven Schöling | if ($datev->errors) {
|
||
die [ $datev->errors ];
|
||||
}
|
||||
| 00b6dc22 | Sven Schöling | for my $transaction (@{ $datev->{DATEV} }) {
|
||
for my $entry (@{ $transaction }) {
|
||||
$entry->{sortkey} = join '-', map { lc } (DateTime->from_kivitendo($entry->{transdate})->strftime('%Y%m%d'), $entry->{name}, $entry->{reference});
|
||||
}
|
||||
}
|
||||
my @transactions = sort_by { $_->[0]->{sortkey} } @{ $datev->{DATEV} };
|
||||
| 15363af3 | Sven Schöling | my $csv = Text::CSV_XS->new({ binary => 1, eol => "\r\n", sep_char => ",", quote_char => '"' });
|
||
| 00b6dc22 | Sven Schöling | |||
my ($fh, $filename) = File::Temp::tempfile();
|
||||
binmode($fh, ':utf8');
|
||||
$self->files->{"transactions.csv"} = $filename;
|
||||
push @{ $self->tempfiles }, $filename;
|
||||
| b21776d2 | Sven Schöling | if ($self->csv_headers) {
|
||
$csv->print($fh, [ map { _normalize_cell($datev_column_defs{$_}{text}) } @datev_columns ]);
|
||||
}
|
||||
| 00b6dc22 | Sven Schöling | for my $transaction (@transactions) {
|
||
my $is_payment = any { $_->{link} =~ m{A[PR]_paid} } @{ $transaction };
|
||||
my ($soll, $haben) = map { $transaction->[$_] } ($transaction->[0]->{amount} > 0 ? (1, 0) : (0, 1));
|
||||
| 6468e05d | Sven Schöling | my $tax = defined($soll->{tax_accno}) ? $soll : defined($haben->{tax_accno}) ? $haben : {};
|
||
| 00b6dc22 | Sven Schöling | my $amount = defined($soll->{net_amount}) ? $soll : $haben;
|
||
$haben->{notes} = ($haben->{memo} || $soll->{memo}) if $haben->{memo} || $soll->{memo};
|
||||
$haben->{notes} //= '';
|
||||
$haben->{notes} = SL::HTML::Util->strip($haben->{notes});
|
||||
| bddc0f6c | Sven Schöling | my $tax_amount = defined $amount->{net_amount} ? abs($amount->{amount}) - abs($amount->{net_amount}) : 0;
|
||
$tax = {} if abs($tax_amount) < 0.001;
|
||||
| a832d0e5 | Sven Schöling | |||
| 00b6dc22 | Sven Schöling | my %row = (
|
||
| f63bc3db | Sven Schöling | amount => $::form->format_amount($myconfig, abs($amount->{amount}),5),
|
||
| 00b6dc22 | Sven Schöling | debit_accno => $soll->{accno},
|
||
debit_accname => $soll->{accname},
|
||||
| 43e21b93 | Sven Schöling | debit_amount => $::form->format_amount($myconfig, abs(-$soll->{amount}),5),
|
||
| bddc0f6c | Sven Schöling | debit_tax => $soll->{tax_accno} ? $::form->format_amount($myconfig, $tax_amount, 5) : 0,
|
||
| 00b6dc22 | Sven Schöling | credit_accno => $haben->{accno},
|
||
credit_accname => $haben->{accname},
|
||||
| 43e21b93 | Sven Schöling | credit_amount => $::form->format_amount($myconfig, abs($haben->{amount}),5),,
|
||
| bddc0f6c | Sven Schöling | credit_tax => $haben->{tax_accno} ? $::form->format_amount($myconfig, $tax_amount, 5) : 0,
|
||
tax => $::form->format_amount($myconfig, $tax_amount, 5),
|
||||
| 00b6dc22 | Sven Schöling | notes => $haben->{notes},
|
||
| f63bc3db | Sven Schöling | (map { ($_ => $tax->{$_}) } qw(taxkey tax_accname tax_accno taxdescription)),
|
||
| 39fc1390 | Sven Schöling | (map { ($_ => ($haben->{$_} // $soll->{$_})) } qw(trans_id invnumber name vcnumber transdate gldate itime customer_id vendor_id)),
|
||
| 00b6dc22 | Sven Schöling | );
|
||
| 62302cce | Moritz Bunkus | |||
| a832d0e5 | Sven Schöling | # if ($row{debit_amount} + $row{debit_tax} - ($row{credit_amount} + $row{credit_tax}) > 0.005) {
|
||
# $::lxdebug->dump(0, "broken taxes", [ $transaction, \%row, $row{debit_amount} + $row{debit_tax}, $row{credit_amount} + $row{credit_tax} ]);
|
||||
# }
|
||||
| e1f93c18 | Sven Schöling | _normalize_cell($_) for values %row; # see CAVEATS
|
||
| 00b6dc22 | Sven Schöling | |||
$csv->print($fh, [ map { $row{$_} } @datev_columns ]);
|
||||
}
|
||||
# and build xml spec for it
|
||||
}
|
||||
| 11e50931 | Sven Schöling | sub do_csv_export {
|
||
my ($self, $table) = @_;
|
||||
| 3bb3a4a5 | Sven Schöling | my $csv = Text::CSV_XS->new({ binary => 1, eol => "\r\n", sep_char => ",", quote_char => '"' });
|
||
| 11e50931 | Sven Schöling | |||
my ($fh, $filename) = File::Temp::tempfile();
|
||||
binmode($fh, ':utf8');
|
||||
$self->files->{"$table.csv"} = $filename;
|
||||
push @{ $self->tempfiles }, $filename;
|
||||
# in the right order (primary keys first)
|
||||
my %cols_by_primary_key = _table_columns($table);
|
||||
my @columns = (@{ $cols_by_primary_key{1} }, @{ $cols_by_primary_key{0} });
|
||||
my %col_index = do { my $i = 0; map {; "$_" => $i++ } @columns };
|
||||
| b21776d2 | Sven Schöling | if ($self->csv_headers) {
|
||
$csv->print($fh, [ map { _normalize_cell($column_titles{$table}{$_->name}) } @columns ]) or die $csv->error_diag;
|
||||
}
|
||||
| 11e50931 | Sven Schöling | # and normalize date stuff
|
||
my @select_tokens = map { (ref $_) =~ /Time/ ? $_->name . '::date' : $_->name } @columns;
|
||||
my @where_tokens;
|
||||
my @values;
|
||||
if ($known_tables{$table}{transdate}) {
|
||||
if ($self->from) {
|
||||
push @where_tokens, "$known_tables{$table}{transdate} >= ?";
|
||||
push @values, $self->from;
|
||||
}
|
||||
if ($self->to) {
|
||||
push @where_tokens, "$known_tables{$table}{transdate} <= ?";
|
||||
push @values, $self->to;
|
||||
}
|
||||
}
|
||||
if ($known_tables{$table}{tables}) {
|
||||
my ($col, @col_specs) = @{ $known_tables{$table}{tables} };
|
||||
my %ids;
|
||||
for (@col_specs) {
|
||||
my ($ftable, $fkey) = split /\./, $_;
|
||||
if (!exists $self->export_ids->{$ftable}{$fkey}) {
|
||||
# check if we forgot to keep it
|
||||
if (!grep { $_ eq $fkey } @{ $known_tables{$ftable}{keep} || [] }) {
|
||||
die "unknown table spec '$_' for table $table, did you forget to keep $fkey in $ftable?"
|
||||
} else {
|
||||
# hmm, most likely just an empty set.
|
||||
$self->export_ids->{$ftable}{$fkey} = {};
|
||||
}
|
||||
}
|
||||
$ids{$_}++ for keys %{ $self->export_ids->{$ftable}{$fkey} };
|
||||
}
|
||||
if (keys %ids) {
|
||||
push @where_tokens, "$col IN (@{[ join ',', ('?') x keys %ids ]})";
|
||||
push @values, keys %ids;
|
||||
} else {
|
||||
push @where_tokens, '1=0';
|
||||
}
|
||||
}
|
||||
my $where_clause = @where_tokens ? 'WHERE ' . join ' AND ', @where_tokens : '';
|
||||
my $query = "SELECT " . join(', ', @select_tokens) . " FROM $table $where_clause";
|
||||
my $sth = $::form->get_standard_dbh->prepare($query);
|
||||
| e2332bfd | Sven Schöling | $sth->execute(@values) or $::form->dberror($query);
|
||
| 11e50931 | Sven Schöling | |||
while (my $row = $sth->fetch) {
|
||||
for my $keep_col (@{ $known_tables{$table}{keep} || [] }) {
|
||||
next if !$row->[$col_index{$keep_col}];
|
||||
$self->export_ids->{$table}{$keep_col} ||= {};
|
||||
$self->export_ids->{$table}{$keep_col}{$row->[$col_index{$keep_col}]}++;
|
||||
}
|
||||
| e1f93c18 | Sven Schöling | _normalize_cell($_) for @$row; # see CAVEATS
|
||
| 8a76038a | Sven Schöling | |||
| 11e50931 | Sven Schöling | $csv->print($fh, $row) or $csv->error_diag;
|
||
}
|
||||
$sth->finish();
|
||||
}
|
||||
sub tag {
|
||||
my ($self, $tag, $content) = @_;
|
||||
$self->writer->startTag($tag);
|
||||
if ('CODE' eq ref $content) {
|
||||
$content->($self);
|
||||
} else {
|
||||
$self->writer->characters($content);
|
||||
}
|
||||
$self->writer->endTag;
|
||||
return $self;
|
||||
}
|
||||
sub make_comment {
|
||||
| e2b04039 | Sven Schöling | my $gobd_version = API_VERSION();
|
||
| 4a395995 | Sven Schöling | my $kivi_version = SL::Version->get_version;
|
||
| 11e50931 | Sven Schöling | my $person = $::myconfig{name};
|
||
my $contact = join ', ',
|
||||
(t8("Email") . ": $::myconfig{email}" ) x!! $::myconfig{email},
|
||||
(t8("Tel") . ": $::myconfig{tel}" ) x!! $::myconfig{tel},
|
||||
(t8("Fax") . ": $::myconfig{fax}" ) x!! $::myconfig{fax};
|
||||
| e2b04039 | Sven Schöling | t8('DataSet for GoBD version #1. Created with kivitendo #2 by #3 (#4)',
|
||
$gobd_version, $kivi_version, $person, $contact
|
||||
| 11e50931 | Sven Schöling | );
|
||
}
|
||||
sub client_name {
|
||||
$_[0]->company
|
||||
}
|
||||
sub client_location {
|
||||
$_[0]->location
|
||||
}
|
||||
sub sorted_tables {
|
||||
my ($self) = @_;
|
||||
my %given = map { $_ => 1 } @{ $self->tables };
|
||||
grep { $given{$_} } @export_table_order;
|
||||
}
|
||||
sub all_tables {
|
||||
my ($self, $yesno) = @_;
|
||||
$self->tables(\@export_table_order) if $yesno;
|
||||
}
|
||||
| e1f93c18 | Sven Schöling | sub _normalize_cell {
|
||
$_[0] =~ s/\r\n/ /g;
|
||||
$_[0] =~ s/,/;/g;
|
||||
| b1a7cdb8 | Sven Schöling | $_[0] =~ s/"/'/g;
|
||
$_[0] =~ s/!/./g;
|
||||
| b21776d2 | Sven Schöling | $_[0]
|
||
| e1f93c18 | Sven Schöling | }
|
||
| 11e50931 | Sven Schöling | sub init_files { +{} }
|
||
sub init_export_ids { +{} }
|
||||
sub init_tempfiles { [] }
|
||||
| 00b6dc22 | Sven Schöling | sub init_tables { [ grep { $known_tables{$_} } @export_table_order ] }
|
||
| b21776d2 | Sven Schöling | sub init_csv_headers { 1 }
|
||
| 11e50931 | Sven Schöling | |||
sub API_VERSION {
|
||||
DateTime->new(year => 2002, month => 8, day => 14)->to_kivitendo;
|
||||
}
|
||||
sub DESTROY {
|
||||
unlink $_ for @{ $_[0]->tempfiles || [] };
|
||||
}
|
||||
1;
|
||||
__END__
|
||||
=encoding utf-8
|
||||
=head1 NAME
|
||||
| e2b04039 | Sven Schöling | SL::GoBD - IDEA export generator
|
||
| 11e50931 | Sven Schöling | |||
=head1 FUNCTIONS
|
||||
=over 4
|
||||
=item C<new PARAMS>
|
||||
Create new export object. C<PARAMS> may contain:
|
||||
=over 4
|
||||
=item company
|
||||
The name of the company, needed for the supplier header
|
||||
=item location
|
||||
| 413addb3 | Sven Schöling | Location of the company, needed for the supplier header
|
||
| 11e50931 | Sven Schöling | |||
=item from
|
||||
=item to
|
||||
Will only include records in the specified date range. Data pulled from other
|
||||
tables will be culled to match what is needed for these records.
|
||||
| b21776d2 | Sven Schöling | =item csv_headers
|
||
Optional. If set, will include a header line in the exported CSV files. Default true.
|
||||
| 11e50931 | Sven Schöling | =item tables
|
||
| 413addb3 | Sven Schöling | Ooptional list of tables to be exported. Defaults to all tables.
|
||
| 11e50931 | Sven Schöling | |||
=item all_tables
|
||||
| 413addb3 | Sven Schöling | Optional alternative to C<tables>, forces all known tables.
|
||
| 11e50931 | Sven Schöling | |||
=back
|
||||
=item C<generate_export>
|
||||
| 413addb3 | Sven Schöling | Do the work. Will return an absolute path to a temp file where all export files
|
||
| 11e50931 | Sven Schöling | are zipped together.
|
||
=back
|
||||
=head1 CAVEATS
|
||||
| 413addb3 | Sven Schöling | Sigh. There are a lot of issues with the IDEA software that were found out by
|
||
trial and error.
|
||||
=head2 Problems in the Specification
|
||||
| 11e50931 | Sven Schöling | =over 4
|
||
=item *
|
||||
| 413addb3 | Sven Schöling | The specced date format is capable of only C<YY>, C<YYYY>, C<MM>,
|
||
and C<DD>. There are no timestamps or timezones.
|
||||
| 11e50931 | Sven Schöling | |||
=item *
|
||||
| 413addb3 | Sven Schöling | Numbers have the same issue. There is not dedicated integer type, and hinting
|
||
at an integer type by setting accuracy to 0 generates a warning for redundant
|
||||
accuracy.
|
||||
| 11e50931 | Sven Schöling | |||
| 413addb3 | Sven Schöling | Also the number parsing is documented to be fragile. Official docs state that
|
||
behaviour for too low C<Accuracy> settings is undefined.
|
||||
| 11e50931 | Sven Schöling | |||
=item *
|
||||
| 413addb3 | Sven Schöling | Foreign key definition is broken. Instead of giving column maps it assumes that
|
||
foreign keys map to the primary keys given for the target table, and in that
|
||||
order. Also the target table must be known in full before defining a foreign key.
|
||||
| 11e50931 | Sven Schöling | |||
| 413addb3 | Sven Schöling | As a consequence any additional keys apart from primary keys are not possible.
|
||
Self-referencing tables are also not possible.
|
||||
| 11e50931 | Sven Schöling | |||
=item *
|
||||
| 413addb3 | Sven Schöling | The spec does not support splitting data sets into smaller chunks. For data
|
||
sets that exceed 700MB the spec helpfully suggests: "Use a bigger medium, such
|
||||
as a DVD".
|
||||
| 11e50931 | Sven Schöling | |||
| 161b9e70 | Sven Schöling | =item *
|
||
| 413addb3 | Sven Schöling | It is not possible to set an empty C<DigitGroupingSymbol> since then the import
|
||
| 161b9e70 | Sven Schöling | will just work with the default. This was asked in their forum, and the
|
||
| 413addb3 | Sven Schöling | response actually was to use a bogus grouping symbol that is not used:
|
||
| 161b9e70 | Sven Schöling | |||
Einfache Lösung: Definieren Sie das Tausendertrennzeichen als Komma, auch
|
||||
wenn es nicht verwendet wird. Sollten Sie das Komma bereits als Feldtrenner
|
||||
verwenden, so wählen Sie als Tausendertrennzeichen eine Alternative wie das
|
||||
Pipe-Symbol |.
|
||||
L<http://www.gdpdu-portal.com/forum/index.php?mode=thread&id=1392>
|
||||
| 3bb3a4a5 | Sven Schöling | =item *
|
||
It is not possible to define a C<RecordDelimiter> with XML entities. 

|
||||
generates the error message:
|
||||
C<RecordDelimiter>-Wert (
) sollte immer aus ein oder zwei Zeichen
|
||||
bestehen.
|
||||
Instead we just use the implicit default RecordDelimiter CRLF.
|
||||
| 413addb3 | Sven Schöling | =back
|
||
| 3bb3a4a5 | Sven Schöling | |||
| 413addb3 | Sven Schöling | =head2 Bugs in the IDEA software
|
||
| 3bb3a4a5 | Sven Schöling | |||
| 413addb3 | Sven Schöling | =over 4
|
||
| 3bb3a4a5 | Sven Schöling | |||
| 8a76038a | Sven Schöling | =item *
|
||
The CSV import library used in IDEA is not able to parse newlines (or more
|
||||
exactly RecordDelimiter) in data. So this export substites all of these with
|
||||
spaces.
|
||||
| e1f93c18 | Sven Schöling | =item *
|
||
Neither it is able to parse escaped C<ColumnDelimiter> in data. It just splits
|
||||
on that symbol no matter what surrounds or preceeds it.
|
||||
| b21776d2 | Sven Schöling | =item *
|
||
| 0ae147db | Sven Schöling | Oh and of course C<TextEncapsulator> is also not allowed in data. It's just
|
||
stripped at the beginning and end of data.
|
||||
=item *
|
||||
And the character "!" is used internally as a warning signal and must not be
|
||||
present in the data as well.
|
||||
=item *
|
||||
C<VariableLength> data is truncated on import to 512 bytes (Note: it said
|
||||
characters, but since they are mutilating data into a single byte encoding
|
||||
anyway, they most likely meant bytes). The auditor recommends splitting into
|
||||
multiple columns.
|
||||
=item *
|
||||
| b21776d2 | Sven Schöling | Despite the standard specifying UTF-8 as a valid encoding the IDEA software
|
||
will just downgrade everything to latin1.
|
||||
| 413addb3 | Sven Schöling | =back
|
||
=head2 Problems outside of the software
|
||||
=over 4
|
||||
=item *
|
||||
The law states that "all business related data" should be made available. In
|
||||
practice there's no definition for what makes data "business related", and
|
||||
different auditors seems to want different data.
|
||||
Currently we export most of the transactional data with supplementing
|
||||
customers, vendors and chart of accounts.
|
||||
=item *
|
||||
While the standard explicitely state to provide data normalized, in practice
|
||||
autditors aren't trained database operators and can not create complex vies on
|
||||
normalized data on their own. The reason this works for other software is, that
|
||||
DATEV and SAP seem to have written import plugins for their internal formats in
|
||||
the IDEA software.
|
||||
So what is really exported is not unlike a DATEV export. Each transaction gets
|
||||
splitted into chunks of 2 positions (3 with tax on one side). Those get
|
||||
denormalized into a single data row with credfit/debit/tax fields. The charts
|
||||
get denormalized into it as well, in addition to their account number serving
|
||||
as a foreign key.
|
||||
Customers and vendors get denormalized into this as well, but are linked by ids
|
||||
to their tables. And the reason for this is...
|
||||
| e1f93c18 | Sven Schöling | =item *
|
||
| 413addb3 | Sven Schöling | Some auditors do not have a full license of the IDEA software, and
|
||
can't do table joins.
|
||||
| e1f93c18 | Sven Schöling | |||
| 11e50931 | Sven Schöling | =back
|
||
=head1 AUTHOR
|
||||
Sven Schöling E<lt>s.schoeling@linet-services.deE<gt>
|
||||
=cut
|