4 # optional: background jobable
9 use parent qw(Rose::Object);
16 use List::MoreUtils qw(any);
17 use List::UtilsBy qw(partition_by sort_by);
19 use SL::DB::Helper::ALL; # since we work on meta data, we need everything
20 use SL::DB::Helper::Mappings;
21 use SL::Locale::String qw(t8);
23 use Rose::Object::MakeMethods::Generic (
24 scalar => [ qw(from to writer company location) ],
25 'scalar --get_set_init' => [ qw(files tempfiles export_ids tables) ],
30 # name: short name, translated
31 # description: long description, translated
32 # transdate: column used to filter from/to, empty if table is filtered otherwise
33 # keep: arrayref of columns that should be saved for further referencing
34 # tables: arrayref with one column and one or many table.column references that were kept earlier
36 chart => { name => t8('Charts'), description => t8('Chart of Accounts'), primary_key => 'accno', columns => [ qw(id accno description) ], },
37 customer => { name => t8('Customers'), description => t8('Customer Master Data'), columns => [ qw(id name department_1 department_2 street zipcode city country contact phone fax email notes customernumber taxnumber obsolete ustid) ] },
38 vendor => { name => t8('Vendors'), description => t8('Vendor Master Data'), columns => [ qw(id name department_1 department_2 street zipcode city country contact phone fax email notes customernumber taxnumber obsolete ustid) ] },
41 my %datev_column_defs = (
42 acc_trans_id => { type => 'Rose::DB::Object::Metadata::Column::Integer', text => t8('ID'), primary_key => 1 },
43 amount => { type => 'Rose::DB::Object::Metadata::Column::Numeric', text => t8('Amount'), },
44 credit_accname => { type => 'Rose::DB::Object::Metadata::Column::Text', text => t8('Credit Account Name'), },
45 credit_accno => { type => 'Rose::DB::Object::Metadata::Column::Text', text => t8('Credit Account'), },
46 debit_accname => { type => 'Rose::DB::Object::Metadata::Column::Text', text => t8('Debit Account Name'), },
47 debit_accno => { type => 'Rose::DB::Object::Metadata::Column::Text', text => t8('Debit Account'), },
48 invnumber => { type => 'Rose::DB::Object::Metadata::Column::Text', text => t8('Reference'), },
49 name => { type => 'Rose::DB::Object::Metadata::Column::Text', text => t8('Name'), },
50 notes => { type => 'Rose::DB::Object::Metadata::Column::Text', text => t8('Notes'), },
51 tax => { type => 'Rose::DB::Object::Metadata::Column::Text', text => t8('Tax'), },
52 taxkey => { type => 'Rose::DB::Object::Metadata::Column::Integer', text => t8('Taxkey'), },
53 tax_accname => { type => 'Rose::DB::Object::Metadata::Column::Text', text => t8('Tax Account Name'), },
54 tax_accno => { type => 'Rose::DB::Object::Metadata::Column::Text', text => t8('Tax Account'), },
55 transdate => { type => 'Rose::DB::Object::Metadata::Column::Date', text => t8('Invoice Date'), },
56 vcnumber => { type => 'Rose::DB::Object::Metadata::Column::Text', text => t8('Customer/Vendor Number'), },
57 customer_id => { type => 'Rose::DB::Object::Metadata::Column::Integer', text => t8('Customer ID'), },
58 vendor_id => { type => 'Rose::DB::Object::Metadata::Column::Integer', text => t8('Vendor ID'), },
61 my @datev_columns = qw(
65 transdate invnumber amount
66 debit_accno debit_accname
67 credit_accno credit_accname
69 tax_accno tax_accname taxkey
73 # rows in this listing are tiers.
74 # tables may depend on ids in a tier above them
75 my @export_table_order = qw(
76 ar ap gl oe delivery_orders
77 invoice orderitems delivery_order_items
84 # needed because the standard dbh sets datestyle german and we don't want to mess with that
85 my $date_format = 'DD.MM.YYYY';
87 # callbacks that produce the xml spec for these column types
89 'Rose::DB::Object::Metadata::Column::Integer' => sub { $_[0]->tag('Numeric') }, # see Caveats for integer issues
90 'Rose::DB::Object::Metadata::Column::BigInt' => sub { $_[0]->tag('Numeric') }, # see Caveats for integer issues
91 'Rose::DB::Object::Metadata::Column::Text' => sub { $_[0]->tag('AlphaNumeric') },
92 'Rose::DB::Object::Metadata::Column::Varchar' => sub { $_[0]->tag('AlphaNumeric') },
93 'Rose::DB::Object::Metadata::Column::Character' => sub { $_[0]->tag('AlphaNumeric') },
94 'Rose::DB::Object::Metadata::Column::Numeric' => sub { $_[0]->tag('Numeric', sub { $_[0]->tag('Accuracy', 5) }) },
95 'Rose::DB::Object::Metadata::Column::Date' => sub { $_[0]->tag('Date', sub { $_[0]->tag('Format', $date_format) }) },
96 'Rose::DB::Object::Metadata::Column::Timestamp' => sub { $_[0]->tag('Date', sub { $_[0]->tag('Format', $date_format) }) },
97 'Rose::DB::Object::Metadata::Column::Float' => sub { $_[0]->tag('Numeric') },
98 'Rose::DB::Object::Metadata::Column::Boolean' => sub { $_[0]
100 ->tag('Map', sub { $_[0]
102 ->tag('To', t8('true'))
104 ->tag('Map', sub { $_[0]
106 ->tag('To', t8('false'))
108 ->tag('Map', sub { $_[0]
110 ->tag('To', t8('false'))
115 sub generate_export {
119 $self->from && 'DateTime' eq ref $self->from or die 'need from date';
120 $self->to && 'DateTime' eq ref $self->to or die 'need to date';
121 $self->from <= $self->to or die 'from date must be earlier or equal than to date';
122 $self->tables && @{ $self->tables } or die 'need tables';
123 for (@{ $self->tables }) {
124 next if $known_tables{$_};
125 die "unknown table '$_'";
128 # get data from those tables and save to csv
129 # for that we need to build queries that fetch all the columns
130 for ($self->sorted_tables) {
131 $self->do_csv_export($_);
134 $self->do_datev_csv_export;
140 $self->files->{'gdpdu-01-08-2002.dtd'} = File::Spec->catfile('users', 'gdpdu-01-08-2002.dtd');
143 my ($fh, $zipfile) = File::Temp::tempfile();
144 my $zip = Archive::Zip->new;
146 while (my ($name, $file) = each %{ $self->files }) {
147 $zip->addFile($file, $name);
150 $zip->writeToFileHandle($fh) == Archive::Zip::AZ_OK() or die 'error writing zip file';
159 my ($fh, $filename) = File::Temp::tempfile();
160 binmode($fh, ':utf8');
162 $self->files->{'INDEX.XML'} = $filename;
163 push @{ $self->tempfiles }, $filename;
165 my $writer = XML::Writer->new(
170 $self->writer($writer);
171 $self->writer->xmlDecl('UTF-8');
172 $self->writer->doctype('DataSet', undef, "gdpdu-01-08-2002.dtd");
173 $self->tag('DataSet', sub { $self
174 ->tag('Version', '1.0')
175 ->tag('DataSupplier', sub { $self
176 ->tag('Name', $self->client_name)
177 ->tag('Location', $self->client_location)
178 ->tag('Comment', $self->make_comment)
180 ->tag('Media', sub { $self
181 ->tag('Name', t8('DataSet #1', 1));
182 for (reverse $self->sorted_tables) { $self # see CAVEATS for table order
185 $self->do_datev_xml_table;
192 my ($self, $table) = @_;
193 my $writer = $self->writer;
195 $self->tag('Table', sub { $self
196 ->tag('URL', "$table.csv")
197 ->tag('Name', $known_tables{$table}{name})
198 ->tag('Description', $known_tables{$table}{description})
199 ->tag('Validity', sub { $self
200 ->tag('Range', sub { $self
201 ->tag('From', $self->from->to_kivitendo(dateformat => 'dd.mm.yyyy'))
202 ->tag('To', $self->to->to_kivitendo(dateformat => 'dd.mm.yyyy'))
204 ->tag('Format', $date_format)
207 ->tag('DecimalSymbol', '.')
208 ->tag('DigitGroupingSymbol', '|') # see CAVEATS in documentation
209 ->tag('VariableLength', sub { $self
210 ->tag('ColumnDelimiter', ',') # see CAVEATS for missing RecordDelimiter
211 ->tag('TextEncapsulator', '"')
213 ->foreign_keys($table)
220 my $package = SL::DB::Helper::Mappings::get_package_for_table($table);
223 my $use_white_list = 0;
224 if ($known_tables{$table}{columns}) {
226 $white_list{$_} = 1 for @{ $known_tables{$table}{columns} || [] };
229 # PrimaryKeys must come before regular columns, so partition first
231 $known_tables{$table}{primary_key}
232 ? 1 * ($_ eq $known_tables{$table}{primary_key})
233 : 1 * $_->is_primary_key_member
235 $use_white_list ? $white_list{$_->name} : 1
236 } $package->meta->columns;
240 my ($self, $table) = @_;
242 my %cols_by_primary_key = _table_columns($table);
244 for my $column (@{ $cols_by_primary_key{1} }) {
245 my $type = $column_types{ ref $column };
247 die "unknown col type @{[ ref $column ]}" unless $type;
249 $self->tag('VariablePrimaryKey', sub { $self
250 ->tag('Name', $column->name);
255 for my $column (@{ $cols_by_primary_key{0} }) {
256 my $type = $column_types{ ref $column };
258 die "unknown col type @{[ ref $column]}" unless $type;
260 $self->tag('VariableColumn', sub { $self
261 ->tag('Name', $column->name);
270 my ($self, $table) = @_;
271 my $package = SL::DB::Helper::Mappings::get_package_for_table($table);
273 my %requested = map { $_ => 1 } @{ $self->tables };
275 for my $rel ($package->meta->foreign_keys) {
276 next unless $requested{ $rel->class->meta->table };
278 # ok, now extract the columns used as foreign key
279 my %key_columns = $rel->key_columns;
281 if (1 != keys %key_columns) {
282 die "multi keys? we don't support this currently. fix it please";
285 if ($table eq $rel->class->meta->table) {
286 # self referential foreign keys are a PITA to export correctly. skip!
290 $self->tag('ForeignKey', sub {
291 $_[0]->tag('Name', $_) for keys %key_columns;
292 $_[0]->tag('References', $rel->class->meta->table);
297 sub do_datev_xml_table {
299 my $writer = $self->writer;
301 $self->tag('Table', sub { $self
302 ->tag('URL', "transaction.csv")
303 ->tag('Name', t8('Transactions'))
304 ->tag('Description', t8('Transactions'))
305 ->tag('Validity', sub { $self
306 ->tag('Range', sub { $self
307 ->tag('From', $self->from->to_kivitendo(dateformat => 'dd.mm.yyyy'))
308 ->tag('To', $self->to->to_kivitendo(dateformat => 'dd.mm.yyyy'))
310 ->tag('Format', $date_format)
313 ->tag('DecimalSymbol', '.')
314 ->tag('DigitGroupingSymbol', '|') # see CAVEATS in documentation
315 ->tag('VariableLength', sub { $self
316 ->tag('ColumnDelimiter', ',') # see CAVEATS for missing RecordDelimiter
317 ->tag('TextEncapsulator', '"')
325 my ($self, $table) = @_;
327 my %cols_by_primary_key = partition_by { $datev_column_defs{$_}{primary_key} } @datev_columns;
328 $::lxdebug->dump(0, "cols", \%cols_by_primary_key);
330 for my $column (@{ $cols_by_primary_key{1} }) {
331 my $type = $column_types{ $datev_column_defs{$column}{type} };
333 die "unknown col type @{[ $column ]}" unless $type;
335 $self->tag('VariablePrimaryKey', sub { $self
336 ->tag('Name', $column);
341 for my $column (@{ $cols_by_primary_key{''} }) {
342 my $type = $column_types{ $datev_column_defs{$column}{type} };
344 die "unknown col type @{[ ref $column]}" unless $type;
346 $self->tag('VariableColumn', sub { $self
347 ->tag('Name', $column);
355 sub datev_foreign_keys {
358 $self->tag('ForeignKey', sub { $_[0]
359 ->tag('Name', 'customer_id')
360 ->tag('References', 'customer')
362 $self->tag('ForeignKey', sub { $_[0]
363 ->tag('Name', 'vendor_id')
364 ->tag('References', 'vendor')
366 $self->tag('ForeignKey', sub { $_[0]
368 ->tag('References', 'chart')
369 }) for qw(debit_accno credit_accno tax_accno);
372 sub do_datev_csv_export {
375 my $datev = SL::DATEV->new(from => $self->from, to => $self->to);
377 $datev->_get_transactions(from_to => $datev->fromto);
379 for my $transaction (@{ $datev->{DATEV} }) {
380 for my $entry (@{ $transaction }) {
381 $entry->{sortkey} = join '-', map { lc } (DateTime->from_kivitendo($entry->{transdate})->strftime('%Y%m%d'), $entry->{name}, $entry->{reference});
385 my @transactions = sort_by { $_->[0]->{sortkey} } @{ $datev->{DATEV} };
387 my $csv = Text::CSV_XS->new({ binary => 1, eol => "\r\n", sep_char => ",", quote_char => '"' });
389 my ($fh, $filename) = File::Temp::tempfile();
390 binmode($fh, ':utf8');
392 $self->files->{"transactions.csv"} = $filename;
393 push @{ $self->tempfiles }, $filename;
395 for my $transaction (@transactions) {
396 my $is_payment = any { $_->{link} =~ m{A[PR]_paid} } @{ $transaction };
398 my ($soll, $haben) = map { $transaction->[$_] } ($transaction->[0]->{amount} > 0 ? (1, 0) : (0, 1));
399 my $tax = defined($soll->{tax_accno}) ? $soll : $haben;
400 my $amount = defined($soll->{net_amount}) ? $soll : $haben;
401 $haben->{notes} = ($haben->{memo} || $soll->{memo}) if $haben->{memo} || $soll->{memo};
402 $haben->{notes} //= '';
403 $haben->{notes} = SL::HTML::Util->strip($haben->{notes});
404 $haben->{notes} =~ s{\r}{}g;
405 $haben->{notes} =~ s{\n+}{ }g;
408 customer_id => $soll->{customer_id} || $haben->{customer_id},
409 vendor_id => $soll->{vendor_id} || $haben->{vendor_id},
410 amount => abs($amount->{amount}),
411 debit_accno => $soll->{accno},
412 debit_accname => $soll->{accname},
413 credit_accno => $haben->{accno},
414 credit_accname => $haben->{accname},
415 tax => defined $amount->{net_amount} ? abs($amount->{amount}) - abs($amount->{net_amount}) : 0,
416 notes => $haben->{notes},
417 (map { ($_ => $tax->{$_}) } qw(taxkey tax_accname tax_accno)),
418 (map { ($_ => ($haben->{$_} // $soll->{$_})) } qw(acc_trans_id invnumber name vcnumber transdate)),
421 $csv->print($fh, [ map { $row{$_} } @datev_columns ]);
424 # and build xml spec for it
428 my ($self, $table) = @_;
430 my $csv = Text::CSV_XS->new({ binary => 1, eol => "\r\n", sep_char => ",", quote_char => '"' });
432 my ($fh, $filename) = File::Temp::tempfile();
433 binmode($fh, ':utf8');
435 $self->files->{"$table.csv"} = $filename;
436 push @{ $self->tempfiles }, $filename;
438 # in the right order (primary keys first)
439 my %cols_by_primary_key = _table_columns($table);
440 my @columns = (@{ $cols_by_primary_key{1} }, @{ $cols_by_primary_key{0} });
441 my %col_index = do { my $i = 0; map {; "$_" => $i++ } @columns };
443 # and normalize date stuff
444 my @select_tokens = map { (ref $_) =~ /Time/ ? $_->name . '::date' : $_->name } @columns;
448 if ($known_tables{$table}{transdate}) {
450 push @where_tokens, "$known_tables{$table}{transdate} >= ?";
451 push @values, $self->from;
454 push @where_tokens, "$known_tables{$table}{transdate} <= ?";
455 push @values, $self->to;
458 if ($known_tables{$table}{tables}) {
459 my ($col, @col_specs) = @{ $known_tables{$table}{tables} };
462 my ($ftable, $fkey) = split /\./, $_;
463 if (!exists $self->export_ids->{$ftable}{$fkey}) {
464 # check if we forgot to keep it
465 if (!grep { $_ eq $fkey } @{ $known_tables{$ftable}{keep} || [] }) {
466 die "unknown table spec '$_' for table $table, did you forget to keep $fkey in $ftable?"
468 # hmm, most likely just an empty set.
469 $self->export_ids->{$ftable}{$fkey} = {};
472 $ids{$_}++ for keys %{ $self->export_ids->{$ftable}{$fkey} };
475 push @where_tokens, "$col IN (@{[ join ',', ('?') x keys %ids ]})";
476 push @values, keys %ids;
478 push @where_tokens, '1=0';
482 my $where_clause = @where_tokens ? 'WHERE ' . join ' AND ', @where_tokens : '';
484 my $query = "SELECT " . join(', ', @select_tokens) . " FROM $table $where_clause";
486 my $sth = $::form->get_standard_dbh->prepare($query);
487 $sth->execute(@values) or die "error executing query $query: " . $sth->errstr;
489 while (my $row = $sth->fetch) {
490 for my $keep_col (@{ $known_tables{$table}{keep} || [] }) {
491 next if !$row->[$col_index{$keep_col}];
492 $self->export_ids->{$table}{$keep_col} ||= {};
493 $self->export_ids->{$table}{$keep_col}{$row->[$col_index{$keep_col}]}++;
495 s/\r\n/ /g for @$row; # see CAVEATS
497 $csv->print($fh, $row) or $csv->error_diag;
503 my ($self, $tag, $content) = @_;
505 $self->writer->startTag($tag);
506 if ('CODE' eq ref $content) {
509 $self->writer->characters($content);
511 $self->writer->endTag;
516 my $gdpdu_version = API_VERSION();
517 my $kivi_version = $::form->read_version;
518 my $person = $::myconfig{name};
519 my $contact = join ', ',
520 (t8("Email") . ": $::myconfig{email}" ) x!! $::myconfig{email},
521 (t8("Tel") . ": $::myconfig{tel}" ) x!! $::myconfig{tel},
522 (t8("Fax") . ": $::myconfig{fax}" ) x!! $::myconfig{fax};
524 t8('DataSet for GDPdU version #1. Created with kivitendo #2 by #3 (#4)',
525 $gdpdu_version, $kivi_version, $person, $contact
533 sub client_location {
540 my %given = map { $_ => 1 } @{ $self->tables };
542 grep { $given{$_} } @export_table_order;
546 my ($self, $yesno) = @_;
548 $self->tables(\@export_table_order) if $yesno;
551 sub init_files { +{} }
552 sub init_export_ids { +{} }
553 sub init_tempfiles { [] }
554 sub init_tables { [ grep { $known_tables{$_} } @export_table_order ] }
557 DateTime->new(year => 2002, month => 8, day => 14)->to_kivitendo;
561 unlink $_ for @{ $_[0]->tempfiles || [] };
572 SL::GDPDU - IDEA export generator
580 Create new export object. C<PARAMS> may contain:
586 The name of the company, needed for the supplier header
590 Location of the company, needed for the suupplier header
596 Will only include records in the specified date range. Data pulled from other
597 tables will be culled to match what is needed for these records.
601 A list of tables to be exported.
605 Alternative to C<tables>, enables all known tables.
609 =item C<generate_export>
611 Do the work. Will return an absolut path to a temp file where all export files
622 Date format is shit. The official docs state that only C<YY>, C<YYYY>, C<MM>,
623 and C<DD> are supported, timestamps do not exist.
627 Number parsing seems to be fragile. Official docs state that behaviour for too
628 low C<Accuracy> settings is undefined. Accuracy of 0 is not taken to mean
629 Integer but instead generates a warning for redudancy.
631 There is no dedicated integer type.
635 Currently C<ar> and C<ap> have a foreign key to themself with the name
636 C<storno_id>. If this foreign key is present in the C<INDEX.XML> then the
637 storno records have to be too. Since this is extremely awkward to code and
638 confusing for the examiner as to why there are records outside of the time
639 range, this export skips all self-referential foreign keys.
643 Documentation for foreign keys is extremely weird. Instead of giving column
644 maps it assumes that foreign keys map to the primary keys given for the target
645 table, and in that order. Foreign keys to keys that are not primary seems to be
646 impossible. Changing type is also not allowed (which actually makes sense).
647 Hopefully there are no bugs there.
651 It's currently disallowed to export the whole dataset. It's not clear if this
656 It is not possible to set an empty C<DigiGroupingSymbol> since then the import
657 will just work with the default. This was asked in their forum, and the
658 response actually was:
660 Einfache Lösung: Definieren Sie das Tausendertrennzeichen als Komma, auch
661 wenn es nicht verwendet wird. Sollten Sie das Komma bereits als Feldtrenner
662 verwenden, so wählen Sie als Tausendertrennzeichen eine Alternative wie das
665 L<http://www.gdpdu-portal.com/forum/index.php?mode=thread&id=1392>
669 It is not possible to define a C<RecordDelimiter> with XML entities. 

670 generates the error message:
672 C<RecordDelimiter>-Wert (
) sollte immer aus ein oder zwei Zeichen
675 Instead we just use the implicit default RecordDelimiter CRLF.
681 Foreign keys seem only to work with previously defined tables (which would be
686 The CSV import library used in IDEA is not able to parse newlines (or more
687 exactly RecordDelimiter) in data. So this export substites all of these with
694 Sven Schöling E<lt>s.schoeling@linet-services.deE<gt>