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 taxdescription => { type => 'Rose::DB::Object::Metadata::Column::Text', text => t8('tax_taxdescription'), },
53 taxkey => { type => 'Rose::DB::Object::Metadata::Column::Integer', text => t8('Taxkey'), },
54 tax_accname => { type => 'Rose::DB::Object::Metadata::Column::Text', text => t8('Tax Account Name'), },
55 tax_accno => { type => 'Rose::DB::Object::Metadata::Column::Text', text => t8('Tax Account'), },
56 transdate => { type => 'Rose::DB::Object::Metadata::Column::Date', text => t8('Invoice Date'), },
57 vcnumber => { type => 'Rose::DB::Object::Metadata::Column::Text', text => t8('Customer/Vendor Number'), },
58 customer_id => { type => 'Rose::DB::Object::Metadata::Column::Integer', text => t8('Customer (database ID)'), },
59 vendor_id => { type => 'Rose::DB::Object::Metadata::Column::Integer', text => t8('Vendor (database ID)'), },
60 itime => { type => 'Rose::DB::Object::Metadata::Column::Date', text => t8('Create Date'), },
63 my @datev_columns = qw(
67 transdate invnumber amount
68 debit_accno debit_accname
69 credit_accno credit_accname
71 tax_accno tax_accname taxkey
75 # rows in this listing are tiers.
76 # tables may depend on ids in a tier above them
77 my @export_table_order = qw(
78 ar ap gl oe delivery_orders
79 invoice orderitems delivery_order_items
86 # needed because the standard dbh sets datestyle german and we don't want to mess with that
87 my $date_format = 'DD.MM.YYYY';
88 my $number_format = '1000.00';
90 my $myconfig = { numberformat => $number_format };
92 # callbacks that produce the xml spec for these column types
94 'Rose::DB::Object::Metadata::Column::Integer' => sub { $_[0]->tag('Numeric') }, # see Caveats for integer issues
95 'Rose::DB::Object::Metadata::Column::BigInt' => sub { $_[0]->tag('Numeric') }, # see Caveats for integer issues
96 'Rose::DB::Object::Metadata::Column::Text' => sub { $_[0]->tag('AlphaNumeric') },
97 'Rose::DB::Object::Metadata::Column::Varchar' => sub { $_[0]->tag('AlphaNumeric') },
98 'Rose::DB::Object::Metadata::Column::Character' => sub { $_[0]->tag('AlphaNumeric') },
99 'Rose::DB::Object::Metadata::Column::Numeric' => sub { $_[0]->tag('Numeric', sub { $_[0]->tag('Accuracy', 5) }) },
100 'Rose::DB::Object::Metadata::Column::Date' => sub { $_[0]->tag('Date', sub { $_[0]->tag('Format', $date_format) }) },
101 'Rose::DB::Object::Metadata::Column::Timestamp' => sub { $_[0]->tag('Date', sub { $_[0]->tag('Format', $date_format) }) },
102 'Rose::DB::Object::Metadata::Column::Float' => sub { $_[0]->tag('Numeric') },
103 'Rose::DB::Object::Metadata::Column::Boolean' => sub { $_[0]
104 ->tag('AlphaNumeric')
105 ->tag('Map', sub { $_[0]
107 ->tag('To', t8('true'))
109 ->tag('Map', sub { $_[0]
111 ->tag('To', t8('false'))
113 ->tag('Map', sub { $_[0]
115 ->tag('To', t8('false'))
120 sub generate_export {
124 $self->from && 'DateTime' eq ref $self->from or die 'need from date';
125 $self->to && 'DateTime' eq ref $self->to or die 'need to date';
126 $self->from <= $self->to or die 'from date must be earlier or equal than to date';
127 $self->tables && @{ $self->tables } or die 'need tables';
128 for (@{ $self->tables }) {
129 next if $known_tables{$_};
130 die "unknown table '$_'";
133 # get data from those tables and save to csv
134 # for that we need to build queries that fetch all the columns
135 for ($self->sorted_tables) {
136 $self->do_csv_export($_);
139 $self->do_datev_csv_export;
145 $self->files->{'gdpdu-01-08-2002.dtd'} = File::Spec->catfile('users', 'gdpdu-01-08-2002.dtd');
148 my ($fh, $zipfile) = File::Temp::tempfile();
149 my $zip = Archive::Zip->new;
151 while (my ($name, $file) = each %{ $self->files }) {
152 $zip->addFile($file, $name);
155 $zip->writeToFileHandle($fh) == Archive::Zip::AZ_OK() or die 'error writing zip file';
164 my ($fh, $filename) = File::Temp::tempfile();
165 binmode($fh, ':utf8');
167 $self->files->{'INDEX.XML'} = $filename;
168 push @{ $self->tempfiles }, $filename;
170 my $writer = XML::Writer->new(
175 $self->writer($writer);
176 $self->writer->xmlDecl('UTF-8');
177 $self->writer->doctype('DataSet', undef, "gdpdu-01-08-2002.dtd");
178 $self->tag('DataSet', sub { $self
179 ->tag('Version', '1.0')
180 ->tag('DataSupplier', sub { $self
181 ->tag('Name', $self->client_name)
182 ->tag('Location', $self->client_location)
183 ->tag('Comment', $self->make_comment)
185 ->tag('Media', sub { $self
186 ->tag('Name', t8('DataSet #1', 1));
187 for (reverse $self->sorted_tables) { $self # see CAVEATS for table order
190 $self->do_datev_xml_table;
197 my ($self, $table) = @_;
198 my $writer = $self->writer;
200 $self->tag('Table', sub { $self
201 ->tag('URL', "$table.csv")
202 ->tag('Name', $known_tables{$table}{name})
203 ->tag('Description', $known_tables{$table}{description})
204 ->tag('Validity', sub { $self
205 ->tag('Range', sub { $self
206 ->tag('From', $self->from->to_kivitendo(dateformat => 'dd.mm.yyyy'))
207 ->tag('To', $self->to->to_kivitendo(dateformat => 'dd.mm.yyyy'))
209 ->tag('Format', $date_format)
212 ->tag('DecimalSymbol', '.')
213 ->tag('DigitGroupingSymbol', '|') # see CAVEATS in documentation
214 ->tag('VariableLength', sub { $self
215 ->tag('ColumnDelimiter', ',') # see CAVEATS for missing RecordDelimiter
216 ->tag('TextEncapsulator', '"')
218 ->foreign_keys($table)
225 my $package = SL::DB::Helper::Mappings::get_package_for_table($table);
228 my $use_white_list = 0;
229 if ($known_tables{$table}{columns}) {
231 $white_list{$_} = 1 for @{ $known_tables{$table}{columns} || [] };
234 # PrimaryKeys must come before regular columns, so partition first
236 $known_tables{$table}{primary_key}
237 ? 1 * ($_ eq $known_tables{$table}{primary_key})
238 : 1 * $_->is_primary_key_member
240 $use_white_list ? $white_list{$_->name} : 1
241 } $package->meta->columns;
245 my ($self, $table) = @_;
247 my %cols_by_primary_key = _table_columns($table);
249 for my $column (@{ $cols_by_primary_key{1} }) {
250 my $type = $column_types{ ref $column };
252 die "unknown col type @{[ ref $column ]}" unless $type;
254 $self->tag('VariablePrimaryKey', sub { $self
255 ->tag('Name', $column->name);
260 for my $column (@{ $cols_by_primary_key{0} }) {
261 my $type = $column_types{ ref $column };
263 die "unknown col type @{[ ref $column]}" unless $type;
265 $self->tag('VariableColumn', sub { $self
266 ->tag('Name', $column->name);
275 my ($self, $table) = @_;
276 my $package = SL::DB::Helper::Mappings::get_package_for_table($table);
278 my %requested = map { $_ => 1 } @{ $self->tables };
280 for my $rel ($package->meta->foreign_keys) {
281 next unless $requested{ $rel->class->meta->table };
283 # ok, now extract the columns used as foreign key
284 my %key_columns = $rel->key_columns;
286 if (1 != keys %key_columns) {
287 die "multi keys? we don't support this currently. fix it please";
290 if ($table eq $rel->class->meta->table) {
291 # self referential foreign keys are a PITA to export correctly. skip!
295 $self->tag('ForeignKey', sub {
296 $_[0]->tag('Name', $_) for keys %key_columns;
297 $_[0]->tag('References', $rel->class->meta->table);
302 sub do_datev_xml_table {
304 my $writer = $self->writer;
306 $self->tag('Table', sub { $self
307 ->tag('URL', "transaction.csv")
308 ->tag('Name', t8('Transactions'))
309 ->tag('Description', t8('Transactions'))
310 ->tag('Validity', sub { $self
311 ->tag('Range', sub { $self
312 ->tag('From', $self->from->to_kivitendo(dateformat => 'dd.mm.yyyy'))
313 ->tag('To', $self->to->to_kivitendo(dateformat => 'dd.mm.yyyy'))
315 ->tag('Format', $date_format)
318 ->tag('DecimalSymbol', '.')
319 ->tag('DigitGroupingSymbol', '|') # see CAVEATS in documentation
320 ->tag('VariableLength', sub { $self
321 ->tag('ColumnDelimiter', ',') # see CAVEATS for missing RecordDelimiter
322 ->tag('TextEncapsulator', '"')
330 my ($self, $table) = @_;
332 my %cols_by_primary_key = partition_by { 1 * $datev_column_defs{$_}{primary_key} } @datev_columns;
333 $::lxdebug->dump(0, "cols", \%cols_by_primary_key);
335 for my $column (@{ $cols_by_primary_key{1} }) {
336 my $type = $column_types{ $datev_column_defs{$column}{type} };
338 die "unknown col type @{[ $column ]}" unless $type;
340 $self->tag('VariablePrimaryKey', sub { $self
341 ->tag('Name', $column);
346 for my $column (@{ $cols_by_primary_key{0} }) {
347 my $type = $column_types{ $datev_column_defs{$column}{type} };
349 die "unknown col type @{[ ref $column]}" unless $type;
351 $self->tag('VariableColumn', sub { $self
352 ->tag('Name', $column);
360 sub datev_foreign_keys {
363 $self->tag('ForeignKey', sub { $_[0]
364 ->tag('Name', 'customer_id')
365 ->tag('References', 'customer')
367 $self->tag('ForeignKey', sub { $_[0]
368 ->tag('Name', 'vendor_id')
369 ->tag('References', 'vendor')
371 $self->tag('ForeignKey', sub { $_[0]
373 ->tag('References', 'chart')
374 }) for qw(debit_accno credit_accno tax_accno);
377 sub do_datev_csv_export {
380 my $datev = SL::DATEV->new(from => $self->from, to => $self->to);
382 $datev->_get_transactions(from_to => $datev->fromto);
384 for my $transaction (@{ $datev->{DATEV} }) {
385 for my $entry (@{ $transaction }) {
386 $entry->{sortkey} = join '-', map { lc } (DateTime->from_kivitendo($entry->{transdate})->strftime('%Y%m%d'), $entry->{name}, $entry->{reference});
390 my @transactions = sort_by { $_->[0]->{sortkey} } @{ $datev->{DATEV} };
392 my $csv = Text::CSV_XS->new({ binary => 1, eol => "\r\n", sep_char => ",", quote_char => '"' });
394 my ($fh, $filename) = File::Temp::tempfile();
395 binmode($fh, ':utf8');
397 $self->files->{"transactions.csv"} = $filename;
398 push @{ $self->tempfiles }, $filename;
400 for my $transaction (@transactions) {
401 my $is_payment = any { $_->{link} =~ m{A[PR]_paid} } @{ $transaction };
403 my ($soll, $haben) = map { $transaction->[$_] } ($transaction->[0]->{amount} > 0 ? (1, 0) : (0, 1));
404 my $tax = defined($soll->{tax_accno}) ? $soll : $haben;
405 my $amount = defined($soll->{net_amount}) ? $soll : $haben;
406 $haben->{notes} = ($haben->{memo} || $soll->{memo}) if $haben->{memo} || $soll->{memo};
407 $haben->{notes} //= '';
408 $haben->{notes} = SL::HTML::Util->strip($haben->{notes});
409 $haben->{notes} =~ s{\r}{}g;
410 $haben->{notes} =~ s{\n+}{ }g;
413 amount => $::form->format_amount($myconfig, abs($amount->{amount}),5),
414 debit_accno => $soll->{accno},
415 debit_accname => $soll->{accname},
416 credit_accno => $haben->{accno},
417 credit_accname => $haben->{accname},
418 tax => defined $amount->{net_amount} ? $::form->format_amount($myconfig, abs($amount->{amount}) - abs($amount->{net_amount}), 5) : 0,
419 notes => $haben->{notes},
420 (map { ($_ => $tax->{$_}) } qw(taxkey tax_accname tax_accno taxdescription)),
421 (map { ($_ => ($haben->{$_} // $soll->{$_})) } qw(acc_trans_id invnumber name vcnumber transdate itime customer_id vendor_id)),
424 $csv->print($fh, [ map { $row{$_} } @datev_columns ]);
427 # and build xml spec for it
431 my ($self, $table) = @_;
433 my $csv = Text::CSV_XS->new({ binary => 1, eol => "\r\n", sep_char => ",", quote_char => '"' });
435 my ($fh, $filename) = File::Temp::tempfile();
436 binmode($fh, ':utf8');
438 $self->files->{"$table.csv"} = $filename;
439 push @{ $self->tempfiles }, $filename;
441 # in the right order (primary keys first)
442 my %cols_by_primary_key = _table_columns($table);
443 my @columns = (@{ $cols_by_primary_key{1} }, @{ $cols_by_primary_key{0} });
444 my %col_index = do { my $i = 0; map {; "$_" => $i++ } @columns };
446 # and normalize date stuff
447 my @select_tokens = map { (ref $_) =~ /Time/ ? $_->name . '::date' : $_->name } @columns;
451 if ($known_tables{$table}{transdate}) {
453 push @where_tokens, "$known_tables{$table}{transdate} >= ?";
454 push @values, $self->from;
457 push @where_tokens, "$known_tables{$table}{transdate} <= ?";
458 push @values, $self->to;
461 if ($known_tables{$table}{tables}) {
462 my ($col, @col_specs) = @{ $known_tables{$table}{tables} };
465 my ($ftable, $fkey) = split /\./, $_;
466 if (!exists $self->export_ids->{$ftable}{$fkey}) {
467 # check if we forgot to keep it
468 if (!grep { $_ eq $fkey } @{ $known_tables{$ftable}{keep} || [] }) {
469 die "unknown table spec '$_' for table $table, did you forget to keep $fkey in $ftable?"
471 # hmm, most likely just an empty set.
472 $self->export_ids->{$ftable}{$fkey} = {};
475 $ids{$_}++ for keys %{ $self->export_ids->{$ftable}{$fkey} };
478 push @where_tokens, "$col IN (@{[ join ',', ('?') x keys %ids ]})";
479 push @values, keys %ids;
481 push @where_tokens, '1=0';
485 my $where_clause = @where_tokens ? 'WHERE ' . join ' AND ', @where_tokens : '';
487 my $query = "SELECT " . join(', ', @select_tokens) . " FROM $table $where_clause";
489 my $sth = $::form->get_standard_dbh->prepare($query);
490 $sth->execute(@values) or die "error executing query $query: " . $sth->errstr;
492 while (my $row = $sth->fetch) {
493 for my $keep_col (@{ $known_tables{$table}{keep} || [] }) {
494 next if !$row->[$col_index{$keep_col}];
495 $self->export_ids->{$table}{$keep_col} ||= {};
496 $self->export_ids->{$table}{$keep_col}{$row->[$col_index{$keep_col}]}++;
498 s/\r\n/ /g for @$row; # see CAVEATS
500 $csv->print($fh, $row) or $csv->error_diag;
506 my ($self, $tag, $content) = @_;
508 $self->writer->startTag($tag);
509 if ('CODE' eq ref $content) {
512 $self->writer->characters($content);
514 $self->writer->endTag;
519 my $gdpdu_version = API_VERSION();
520 my $kivi_version = $::form->read_version;
521 my $person = $::myconfig{name};
522 my $contact = join ', ',
523 (t8("Email") . ": $::myconfig{email}" ) x!! $::myconfig{email},
524 (t8("Tel") . ": $::myconfig{tel}" ) x!! $::myconfig{tel},
525 (t8("Fax") . ": $::myconfig{fax}" ) x!! $::myconfig{fax};
527 t8('DataSet for GDPdU version #1. Created with kivitendo #2 by #3 (#4)',
528 $gdpdu_version, $kivi_version, $person, $contact
536 sub client_location {
543 my %given = map { $_ => 1 } @{ $self->tables };
545 grep { $given{$_} } @export_table_order;
549 my ($self, $yesno) = @_;
551 $self->tables(\@export_table_order) if $yesno;
554 sub init_files { +{} }
555 sub init_export_ids { +{} }
556 sub init_tempfiles { [] }
557 sub init_tables { [ grep { $known_tables{$_} } @export_table_order ] }
560 DateTime->new(year => 2002, month => 8, day => 14)->to_kivitendo;
564 unlink $_ for @{ $_[0]->tempfiles || [] };
575 SL::GDPDU - IDEA export generator
583 Create new export object. C<PARAMS> may contain:
589 The name of the company, needed for the supplier header
593 Location of the company, needed for the suupplier header
599 Will only include records in the specified date range. Data pulled from other
600 tables will be culled to match what is needed for these records.
604 A list of tables to be exported.
608 Alternative to C<tables>, enables all known tables.
612 =item C<generate_export>
614 Do the work. Will return an absolut path to a temp file where all export files
625 Date format is shit. The official docs state that only C<YY>, C<YYYY>, C<MM>,
626 and C<DD> are supported, timestamps do not exist.
630 Number parsing seems to be fragile. Official docs state that behaviour for too
631 low C<Accuracy> settings is undefined. Accuracy of 0 is not taken to mean
632 Integer but instead generates a warning for redudancy.
634 There is no dedicated integer type.
638 Currently C<ar> and C<ap> have a foreign key to themself with the name
639 C<storno_id>. If this foreign key is present in the C<INDEX.XML> then the
640 storno records have to be too. Since this is extremely awkward to code and
641 confusing for the examiner as to why there are records outside of the time
642 range, this export skips all self-referential foreign keys.
646 Documentation for foreign keys is extremely weird. Instead of giving column
647 maps it assumes that foreign keys map to the primary keys given for the target
648 table, and in that order. Foreign keys to keys that are not primary seems to be
649 impossible. Changing type is also not allowed (which actually makes sense).
650 Hopefully there are no bugs there.
654 It's currently disallowed to export the whole dataset. It's not clear if this
659 It is not possible to set an empty C<DigiGroupingSymbol> since then the import
660 will just work with the default. This was asked in their forum, and the
661 response actually was:
663 Einfache Lösung: Definieren Sie das Tausendertrennzeichen als Komma, auch
664 wenn es nicht verwendet wird. Sollten Sie das Komma bereits als Feldtrenner
665 verwenden, so wählen Sie als Tausendertrennzeichen eine Alternative wie das
668 L<http://www.gdpdu-portal.com/forum/index.php?mode=thread&id=1392>
672 It is not possible to define a C<RecordDelimiter> with XML entities. 

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