SL/GoBD.pm

   1 package SL::GoBD;
   2
   3 # TODO:
   4 # optional: background jobable
   5
   6 use strict;
   7 use utf8;
   8
   9 use parent qw(Rose::Object);
  10
  11 use Text::CSV_XS;
  12 use XML::Writer;
  13 use Archive::Zip;
  14 use File::Temp ();
  15 use File::Spec ();
  16 use List::MoreUtils qw(any);
  17 use List::UtilsBy qw(partition_by sort_by);
  18
  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);
  22
  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 csv_headers) ],
  26 );
  27
  28 # in this we find:
  29 # key:         table name
  30 # name:        short name, translated
  31 # description: long description, translated
  32 # columns:     list of columns to export. export all columns if not present
  33 # primary_key: override primary key
  34 my %known_tables = (
  35   chart    => { name => t8('Charts'),    description => t8('Chart of Accounts'),    primary_key => 'accno', columns => [ qw(id accno description) ],     },
  36   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) ] },
  37   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) ] },
  38 );
  39
  40 my %column_titles = (
  41    chart => {
  42      id             => t8('ID'),
  43      accno          => t8('Account Number'),
  44      description    => t8('Description'),
  45    },
  46    customer_vendor => {
  47      id             => t8('ID (lit)'),
  48      name           => t8('Name'),
  49      department_1   => t8('Department 1'),
  50      department_2   => t8('Department 2'),
  51      street         => t8('Street'),
  52      zipcode        => t8('Zipcode'),
  53      city           => t8('City'),
  54      country        => t8('Country'),
  55      contact        => t8('Contact'),
  56      phone          => t8('Phone'),
  57      fax            => t8('Fax'),
  58      email          => t8('E-mail'),
  59      notes          => t8('Notes'),
  60      customernumber => t8('Customer Number'),
  61      vendornumber   => t8('Vendor Number'),
  62      taxnumber      => t8('Tax Number'),
  63      obsolete       => t8('Obsolete'),
  64      ustid          => t8('Tax ID number'),
  65    },
  66 );
  67 $column_titles{$_} = $column_titles{customer_vendor} for qw(customer vendor);
  68
  69 my %datev_column_defs = (
  70   trans_id          => { type => 'Rose::DB::Object::Metadata::Column::Integer', text => t8('ID'), },
  71   amount            => { type => 'Rose::DB::Object::Metadata::Column::Numeric', text => t8('Amount'), },
  72   credit_accname    => { type => 'Rose::DB::Object::Metadata::Column::Text',    text => t8('Credit Account Name'), },
  73   credit_accno      => { type => 'Rose::DB::Object::Metadata::Column::Text',    text => t8('Credit Account'), },
  74   credit_amount     => { type => 'Rose::DB::Object::Metadata::Column::Text',    text => t8('Credit Amount'), },
  75   credit_tax        => { type => 'Rose::DB::Object::Metadata::Column::Numeric', text => t8('Credit Tax (lit)'), },
  76   debit_accname     => { type => 'Rose::DB::Object::Metadata::Column::Text',    text => t8('Debit Account Name'), },
  77   debit_accno       => { type => 'Rose::DB::Object::Metadata::Column::Text',    text => t8('Debit Account'), },
  78   debit_amount      => { type => 'Rose::DB::Object::Metadata::Column::Text',    text => t8('Debit Amount'), },
  79   debit_tax         => { type => 'Rose::DB::Object::Metadata::Column::Numeric', text => t8('Debit Tax (lit)'), },
  80   invnumber         => { type => 'Rose::DB::Object::Metadata::Column::Text',    text => t8('Reference'), },
  81   name              => { type => 'Rose::DB::Object::Metadata::Column::Text',    text => t8('Name'), },
  82   notes             => { type => 'Rose::DB::Object::Metadata::Column::Text',    text => t8('Notes'), },
  83   tax               => { type => 'Rose::DB::Object::Metadata::Column::Numeric', text => t8('Tax'), },
  84   taxdescription    => { type => 'Rose::DB::Object::Metadata::Column::Text',    text => t8('tax_taxdescription'), },
  85   taxkey            => { type => 'Rose::DB::Object::Metadata::Column::Integer', text => t8('Taxkey'), },
  86   tax_accname       => { type => 'Rose::DB::Object::Metadata::Column::Text',    text => t8('Tax Account Name'), },
  87   tax_accno         => { type => 'Rose::DB::Object::Metadata::Column::Text',    text => t8('Tax Account'), },
  88   transdate         => { type => 'Rose::DB::Object::Metadata::Column::Date',    text => t8('Invoice Date'), },
  89   vcnumber          => { type => 'Rose::DB::Object::Metadata::Column::Text',    text => t8('Customer/Vendor Number'), },
  90   customer_id       => { type => 'Rose::DB::Object::Metadata::Column::Integer', text => t8('Customer (database ID)'), },
  91   vendor_id         => { type => 'Rose::DB::Object::Metadata::Column::Integer', text => t8('Vendor (database ID)'), },
  92   itime             => { type => 'Rose::DB::Object::Metadata::Column::Date',    text => t8('Create Date'), },
  93 );
  94
  95 my @datev_columns = qw(
  96   trans_id
  97   customer_id vendor_id
  98   name           vcnumber
  99   transdate    invnumber      amount
 100   debit_accno  debit_accname debit_amount debit_tax
 101   credit_accno credit_accname credit_amount credit_tax
 102   taxdescription tax
 103   tax_accno    tax_accname    taxkey
 104   notes itime
 105 );
 106
 107 # rows in this listing are tiers.
 108 # tables may depend on ids in a tier above them
 109 my @export_table_order = qw(
 110   ar ap gl oe delivery_orders
 111   invoice orderitems delivery_order_items
 112   customer vendor
 113   parts
 114   acc_trans
 115   chart
 116 );
 117
 118 # needed because the standard dbh sets datestyle german and we don't want to mess with that
 119 my $date_format = 'DD.MM.YYYY';
 120 my $number_format = '1000.00';
 121
 122 my $myconfig = { numberformat => $number_format };
 123
 124 # callbacks that produce the xml spec for these column types
 125 my %column_types = (
 126   'Rose::DB::Object::Metadata::Column::Integer'   => sub { $_[0]->tag('Numeric') },  # see Caveats for integer issues
 127   'Rose::DB::Object::Metadata::Column::BigInt'    => sub { $_[0]->tag('Numeric') },  # see Caveats for integer issues
 128   'Rose::DB::Object::Metadata::Column::Text'      => sub { $_[0]->tag('AlphaNumeric') },
 129   'Rose::DB::Object::Metadata::Column::Varchar'   => sub { $_[0]->tag('AlphaNumeric') },
 130   'Rose::DB::Object::Metadata::Column::Character' => sub { $_[0]->tag('AlphaNumeric') },
 131   'Rose::DB::Object::Metadata::Column::Numeric'   => sub { $_[0]->tag('Numeric', sub { $_[0]->tag('Accuracy', 5) }) },
 132   'Rose::DB::Object::Metadata::Column::Date'      => sub { $_[0]->tag('Date', sub { $_[0]->tag('Format', $date_format) }) },
 133   'Rose::DB::Object::Metadata::Column::Timestamp' => sub { $_[0]->tag('Date', sub { $_[0]->tag('Format', $date_format) }) },
 134   'Rose::DB::Object::Metadata::Column::Float'     => sub { $_[0]->tag('Numeric') },
 135   'Rose::DB::Object::Metadata::Column::Boolean'   => sub { $_[0]
 136     ->tag('AlphaNumeric')
 137     ->tag('Map', sub { $_[0]
 138       ->tag('From', 1)
 139       ->tag('To', t8('true'))
 140     })
 141     ->tag('Map', sub { $_[0]
 142       ->tag('From', 0)
 143       ->tag('To', t8('false'))
 144     })
 145     ->tag('Map', sub { $_[0]
 146       ->tag('From', '')
 147       ->tag('To', t8('false'))
 148     })
 149   },
 150 );
 151
 152 sub generate_export {
 153   my ($self) = @_;
 154
 155   # verify data
 156   $self->from && 'DateTime' eq ref $self->from or die 'need from date';
 157   $self->to   && 'DateTime' eq ref $self->to   or die 'need to date';
 158   $self->from <= $self->to                     or die 'from date must be earlier or equal than to date';
 159   $self->tables && @{ $self->tables }          or die 'need tables';
 160   for (@{ $self->tables }) {
 161     next if $known_tables{$_};
 162     die "unknown table '$_'";
 163   }
 164
 165   # get data from those tables and save to csv
 166   # for that we need to build queries that fetch all the columns
 167   for ($self->sorted_tables) {
 168     $self->do_csv_export($_);
 169   }
 170
 171   $self->do_datev_csv_export;
 172
 173   # write xml file
 174   $self->do_xml_file;
 175
 176   # add dtd
 177   $self->files->{'gdpdu-01-08-2002.dtd'} = File::Spec->catfile('users', 'gdpdu-01-08-2002.dtd');
 178
 179   # make zip
 180   my ($fh, $zipfile) = File::Temp::tempfile();
 181   my $zip            = Archive::Zip->new;
 182
 183   while (my ($name, $file) = each %{ $self->files }) {
 184     $zip->addFile($file, $name);
 185   }
 186
 187   $zip->writeToFileHandle($fh) == Archive::Zip::AZ_OK() or die 'error writing zip file';
 188   close($fh);
 189
 190   return $zipfile;
 191 }
 192
 193 sub do_xml_file {
 194   my ($self) = @_;
 195
 196   my ($fh, $filename) = File::Temp::tempfile();
 197   binmode($fh, ':utf8');
 198
 199   $self->files->{'INDEX.XML'} = $filename;
 200   push @{ $self->tempfiles }, $filename;
 201
 202   my $writer = XML::Writer->new(
 203     OUTPUT      => $fh,
 204     ENCODING    => 'UTF-8',
 205   );
 206
 207   $self->writer($writer);
 208   $self->writer->xmlDecl('UTF-8');
 209   $self->writer->doctype('DataSet', undef, "gdpdu-01-08-2002.dtd");
 210   $self->tag('DataSet', sub { $self
 211     ->tag('Version', '1.0')
 212     ->tag('DataSupplier', sub { $self
 213       ->tag('Name', $self->client_name)
 214       ->tag('Location', $self->client_location)
 215       ->tag('Comment', $self->make_comment)
 216     })
 217     ->tag('Media', sub { $self
 218       ->tag('Name', t8('DataSet #1', 1));
 219       for (reverse $self->sorted_tables) { $self  # see CAVEATS for table order
 220         ->table($_)
 221       }
 222       $self->do_datev_xml_table;
 223     })
 224   });
 225   close($fh);
 226 }
 227
 228 sub table {
 229   my ($self, $table) = @_;
 230   my $writer = $self->writer;
 231
 232   $self->tag('Table', sub { $self
 233     ->tag('URL', "$table.csv")
 234     ->tag('Name', $known_tables{$table}{name})
 235     ->tag('Description', $known_tables{$table}{description})
 236     ->tag('Validity', sub { $self
 237       ->tag('Range', sub { $self
 238         ->tag('From', $self->from->to_kivitendo(dateformat => 'dd.mm.yyyy'))
 239         ->tag('To',   $self->to->to_kivitendo(dateformat => 'dd.mm.yyyy'))
 240       })
 241       ->tag('Format', $date_format)
 242     })
 243     ->tag('UTF8')
 244     ->tag('DecimalSymbol', '.')
 245     ->tag('DigitGroupingSymbol', '|')     # see CAVEATS in documentation
 246     ->tag('Range', sub { $self
 247       ->tag('From', $self->csv_headers ? 2 : 1)
 248     })
 249     ->tag('VariableLength', sub { $self
 250       ->tag('ColumnDelimiter', ',')       # see CAVEATS for missing RecordDelimiter
 251       ->tag('TextEncapsulator', '"')
 252       ->columns($table)
 253       ->foreign_keys($table)
 254     })
 255   });
 256 }
 257
 258 sub _table_columns {
 259   my ($table) = @_;
 260   my $package = SL::DB::Helper::Mappings::get_package_for_table($table);
 261
 262   my %white_list;
 263   my $use_white_list = 0;
 264   if ($known_tables{$table}{columns}) {
 265     $use_white_list = 1;
 266     $white_list{$_} = 1 for @{ $known_tables{$table}{columns} || [] };
 267   }
 268
 269   # PrimaryKeys must come before regular columns, so partition first
 270   partition_by {
 271     $known_tables{$table}{primary_key}
 272       ? 1 * ($_ eq $known_tables{$table}{primary_key})
 273       : 1 * $_->is_primary_key_member
 274   } grep {
 275     $use_white_list ? $white_list{$_->name} : 1
 276   } $package->meta->columns;
 277 }
 278
 279 sub columns {
 280   my ($self, $table) = @_;
 281
 282   my %cols_by_primary_key = _table_columns($table);
 283
 284   for my $column (@{ $cols_by_primary_key{1} }) {
 285     my $type = $column_types{ ref $column };
 286
 287     die "unknown col type @{[ ref $column ]}" unless $type;
 288
 289     $self->tag('VariablePrimaryKey', sub { $self
 290       ->tag('Name', $column_titles{$table}{$column->name});
 291       $type->($self);
 292     })
 293   }
 294
 295   for my $column (@{ $cols_by_primary_key{0} }) {
 296     my $type = $column_types{ ref $column };
 297
 298     die "unknown col type @{[ ref $column]}" unless $type;
 299
 300     $self->tag('VariableColumn', sub { $self
 301       ->tag('Name', $column_titles{$table}{$column->name});
 302       $type->($self);
 303     })
 304   }
 305
 306   $self;
 307 }
 308
 309 sub foreign_keys {
 310   my ($self, $table) = @_;
 311   my $package = SL::DB::Helper::Mappings::get_package_for_table($table);
 312
 313   my %requested = map { $_ => 1 } @{ $self->tables };
 314
 315   for my $rel ($package->meta->foreign_keys) {
 316     next unless $requested{ $rel->class->meta->table };
 317
 318     # ok, now extract the columns used as foreign key
 319     my %key_columns = $rel->key_columns;
 320
 321     if (1 != keys %key_columns) {
 322       die "multi keys? we don't support this currently. fix it please";
 323     }
 324
 325     if ($table eq $rel->class->meta->table) {
 326       # self referential foreign keys are a PITA to export correctly. skip!
 327       next;
 328     }
 329
 330     $self->tag('ForeignKey', sub {
 331       $_[0]->tag('Name',  $column_titles{$table}{$_}) for keys %key_columns;
 332       $_[0]->tag('References', $rel->class->meta->table);
 333    });
 334   }
 335 }
 336
 337 sub do_datev_xml_table {
 338   my ($self) = @_;
 339   my $writer = $self->writer;
 340
 341   $self->tag('Table', sub { $self
 342     ->tag('URL', "transactions.csv")
 343     ->tag('Name', t8('Transactions'))
 344     ->tag('Description', t8('Transactions'))
 345     ->tag('Validity', sub { $self
 346       ->tag('Range', sub { $self
 347         ->tag('From', $self->from->to_kivitendo(dateformat => 'dd.mm.yyyy'))
 348         ->tag('To',   $self->to->to_kivitendo(dateformat => 'dd.mm.yyyy'))
 349       })
 350       ->tag('Format', $date_format)
 351     })
 352     ->tag('UTF8')
 353     ->tag('DecimalSymbol', '.')
 354     ->tag('DigitGroupingSymbol', '|')     # see CAVEATS in documentation
 355     ->tag('Range', sub { $self
 356       ->tag('From', $self->csv_headers ? 2 : 1)
 357     })
 358     ->tag('VariableLength', sub { $self
 359       ->tag('ColumnDelimiter', ',')       # see CAVEATS for missing RecordDelimiter
 360       ->tag('TextEncapsulator', '"')
 361       ->datev_columns
 362       ->datev_foreign_keys
 363     })
 364   });
 365 }
 366
 367 sub datev_columns {
 368   my ($self, $table) = @_;
 369
 370   my %cols_by_primary_key = partition_by { 1 * $datev_column_defs{$_}{primary_key} } @datev_columns;
 371
 372   for my $column (@{ $cols_by_primary_key{1} }) {
 373     my $type = $column_types{ $datev_column_defs{$column}{type} };
 374
 375     die "unknown col type @{[ $column ]}" unless $type;
 376
 377     $self->tag('VariablePrimaryKey', sub { $self
 378       ->tag('Name', $datev_column_defs{$column}{text});
 379       $type->($self);
 380     })
 381   }
 382
 383   for my $column (@{ $cols_by_primary_key{0} }) {
 384     my $type = $column_types{ $datev_column_defs{$column}{type} };
 385
 386     die "unknown col type @{[ ref $column]}" unless $type;
 387
 388     $self->tag('VariableColumn', sub { $self
 389       ->tag('Name', $datev_column_defs{$column}{text});
 390       $type->($self);
 391     })
 392   }
 393
 394   $self;
 395 }
 396
 397 sub datev_foreign_keys {
 398   my ($self) = @_;
 399   # hard code weeee
 400   $self->tag('ForeignKey', sub { $_[0]
 401     ->tag('Name', $datev_column_defs{customer_id}{text})
 402     ->tag('References', 'customer')
 403   });
 404   $self->tag('ForeignKey', sub { $_[0]
 405     ->tag('Name', $datev_column_defs{vendor_id}{text})
 406     ->tag('References', 'vendor')
 407   });
 408   $self->tag('ForeignKey', sub { $_[0]
 409     ->tag('Name', $datev_column_defs{$_}{text})
 410     ->tag('References', 'chart')
 411   }) for qw(debit_accno credit_accno tax_accno);
 412 }
 413
 414 sub do_datev_csv_export {
 415   my ($self) = @_;
 416
 417   my $datev = SL::DATEV->new(from => $self->from, to => $self->to);
 418
 419   $datev->_get_transactions(from_to => $datev->fromto);
 420
 421   for my $transaction (@{ $datev->{DATEV} }) {
 422     for my $entry (@{ $transaction }) {
 423       $entry->{sortkey} = join '-', map { lc } (DateTime->from_kivitendo($entry->{transdate})->strftime('%Y%m%d'), $entry->{name}, $entry->{reference});
 424     }
 425   }
 426
 427   my @transactions = sort_by { $_->[0]->{sortkey} } @{ $datev->{DATEV} };
 428
 429   my $csv = Text::CSV_XS->new({ binary => 1, eol => "\r\n", sep_char => ",", quote_char => '"' });
 430
 431   my ($fh, $filename) = File::Temp::tempfile();
 432   binmode($fh, ':utf8');
 433
 434   $self->files->{"transactions.csv"} = $filename;
 435   push @{ $self->tempfiles }, $filename;
 436
 437   if ($self->csv_headers) {
 438     $csv->print($fh, [ map { _normalize_cell($datev_column_defs{$_}{text}) } @datev_columns ]);
 439   }
 440
 441   for my $transaction (@transactions) {
 442     my $is_payment     = any { $_->{link} =~ m{A[PR]_paid} } @{ $transaction };
 443
 444     my ($soll, $haben) = map { $transaction->[$_] } ($transaction->[0]->{amount} > 0 ? (1, 0) : (0, 1));
 445     my $tax            = defined($soll->{tax_accno}) ? $soll : defined($haben->{tax_accno}) ? $haben : {};
 446     my $amount         = defined($soll->{net_amount}) ? $soll : $haben;
 447     $haben->{notes}    = ($haben->{memo} || $soll->{memo}) if $haben->{memo} || $soll->{memo};
 448     $haben->{notes}  //= '';
 449     $haben->{notes}    =  SL::HTML::Util->strip($haben->{notes});
 450
 451     my $tax_amount = defined $amount->{net_amount}
 452                    ? $::form->format_amount($myconfig, abs($amount->{amount}) - abs($amount->{net_amount}), 5)
 453                    : 0;
 454
 455     my %row            = (
 456       amount           => $::form->format_amount($myconfig, abs($amount->{amount}),5),
 457       debit_accno      => $soll->{accno},
 458       debit_accname    => $soll->{accname},
 459       debit_amount     => $::form->format_amount($myconfig, abs(-$soll->{amount}),5),
 460       debit_tax        => $soll->{tax_accno} ? $tax_amount : 0,
 461       credit_accno     => $haben->{accno},
 462       credit_accname   => $haben->{accname},
 463       credit_amount    => $::form->format_amount($myconfig, abs($haben->{amount}),5),,
 464       credit_tax       => $haben->{tax_accno} ? $tax_amount : 0,
 465       tax              => $tax_amount,
 466       notes            => $haben->{notes},
 467       (map { ($_ => $tax->{$_})                    } qw(taxkey tax_accname tax_accno taxdescription)),
 468       (map { ($_ => ($haben->{$_} // $soll->{$_})) } qw(trans_id invnumber name vcnumber transdate itime customer_id vendor_id)),
 469     );
 470
 471 #     if ($row{debit_amount} + $row{debit_tax} - ($row{credit_amount} + $row{credit_tax}) > 0.005) {
 472 #       $::lxdebug->dump(0,  "broken taxes", [ $transaction, \%row,  $row{debit_amount} + $row{debit_tax}, $row{credit_amount} + $row{credit_tax} ]);
 473 #     }
 474
 475     _normalize_cell($_) for values %row; # see CAVEATS
 476
 477     $csv->print($fh, [ map { $row{$_} } @datev_columns ]);
 478   }
 479
 480   # and build xml spec for it
 481 }
 482
 483 sub do_csv_export {
 484   my ($self, $table) = @_;
 485
 486   my $csv = Text::CSV_XS->new({ binary => 1, eol => "\r\n", sep_char => ",", quote_char => '"' });
 487
 488   my ($fh, $filename) = File::Temp::tempfile();
 489   binmode($fh, ':utf8');
 490
 491   $self->files->{"$table.csv"} = $filename;
 492   push @{ $self->tempfiles }, $filename;
 493
 494   # in the right order (primary keys first)
 495   my %cols_by_primary_key = _table_columns($table);
 496   my @columns = (@{ $cols_by_primary_key{1} }, @{ $cols_by_primary_key{0} });
 497   my %col_index = do { my $i = 0; map {; "$_" => $i++ } @columns };
 498
 499   if ($self->csv_headers) {
 500     $csv->print($fh, [ map { _normalize_cell($column_titles{$table}{$_->name}) } @columns ]) or die $csv->error_diag;
 501   }
 502
 503   # and normalize date stuff
 504   my @select_tokens = map { (ref $_) =~ /Time/ ? $_->name . '::date' : $_->name } @columns;
 505
 506   my @where_tokens;
 507   my @values;
 508   if ($known_tables{$table}{transdate}) {
 509     if ($self->from) {
 510       push @where_tokens, "$known_tables{$table}{transdate} >= ?";
 511       push @values, $self->from;
 512     }
 513     if ($self->to) {
 514       push @where_tokens, "$known_tables{$table}{transdate} <= ?";
 515       push @values, $self->to;
 516     }
 517   }
 518   if ($known_tables{$table}{tables}) {
 519     my ($col, @col_specs) = @{ $known_tables{$table}{tables} };
 520     my %ids;
 521     for (@col_specs) {
 522       my ($ftable, $fkey) = split /\./, $_;
 523       if (!exists $self->export_ids->{$ftable}{$fkey}) {
 524          # check if we forgot to keep it
 525          if (!grep { $_ eq $fkey } @{ $known_tables{$ftable}{keep} || [] }) {
 526            die "unknown table spec '$_' for table $table, did you forget to keep $fkey in $ftable?"
 527          } else {
 528            # hmm, most likely just an empty set.
 529            $self->export_ids->{$ftable}{$fkey} = {};
 530          }
 531       }
 532       $ids{$_}++ for keys %{ $self->export_ids->{$ftable}{$fkey} };
 533     }
 534     if (keys %ids) {
 535       push @where_tokens, "$col IN (@{[ join ',', ('?') x keys %ids ]})";
 536       push @values, keys %ids;
 537     } else {
 538       push @where_tokens, '1=0';
 539     }
 540   }
 541
 542   my $where_clause = @where_tokens ? 'WHERE ' . join ' AND ', @where_tokens : '';
 543
 544   my $query = "SELECT " . join(', ', @select_tokens) . " FROM $table $where_clause";
 545
 546   my $sth = $::form->get_standard_dbh->prepare($query);
 547   $sth->execute(@values) or die "error executing query $query: " . $sth->errstr;
 548
 549   while (my $row = $sth->fetch) {
 550     for my $keep_col (@{ $known_tables{$table}{keep} || [] }) {
 551       next if !$row->[$col_index{$keep_col}];
 552       $self->export_ids->{$table}{$keep_col} ||= {};
 553       $self->export_ids->{$table}{$keep_col}{$row->[$col_index{$keep_col}]}++;
 554     }
 555     _normalize_cell($_) for @$row; # see CAVEATS
 556
 557     $csv->print($fh, $row) or $csv->error_diag;
 558   }
 559   $sth->finish();
 560 }
 561
 562 sub tag {
 563   my ($self, $tag, $content) = @_;
 564
 565   $self->writer->startTag($tag);
 566   if ('CODE' eq ref $content) {
 567     $content->($self);
 568   } else {
 569     $self->writer->characters($content);
 570   }
 571   $self->writer->endTag;
 572   return $self;
 573 }
 574
 575 sub make_comment {
 576   my $gobd_version  = API_VERSION();
 577   my $kivi_version  = $::form->read_version;
 578   my $person        = $::myconfig{name};
 579   my $contact       = join ', ',
 580     (t8("Email") . ": $::myconfig{email}" ) x!! $::myconfig{email},
 581     (t8("Tel")   . ": $::myconfig{tel}" )   x!! $::myconfig{tel},
 582     (t8("Fax")   . ": $::myconfig{fax}" )   x!! $::myconfig{fax};
 583
 584   t8('DataSet for GoBD version #1. Created with kivitendo #2 by #3 (#4)',
 585     $gobd_version, $kivi_version, $person, $contact
 586   );
 587 }
 588
 589 sub client_name {
 590   $_[0]->company
 591 }
 592
 593 sub client_location {
 594   $_[0]->location
 595 }
 596
 597 sub sorted_tables {
 598   my ($self) = @_;
 599
 600   my %given = map { $_ => 1 } @{ $self->tables };
 601
 602   grep { $given{$_} } @export_table_order;
 603 }
 604
 605 sub all_tables {
 606   my ($self, $yesno) = @_;
 607
 608   $self->tables(\@export_table_order) if $yesno;
 609 }
 610
 611 sub _normalize_cell {
 612   $_[0] =~ s/\r\n/ /g;
 613   $_[0] =~ s/,/;/g;
 614   $_[0] =~ s/"/'/g;
 615   $_[0] =~ s/!/./g;
 616   $_[0]
 617 }
 618
 619 sub init_files { +{} }
 620 sub init_export_ids { +{} }
 621 sub init_tempfiles { [] }
 622 sub init_tables { [ grep { $known_tables{$_} } @export_table_order ] }
 623 sub init_csv_headers { 1 }
 624
 625 sub API_VERSION {
 626   DateTime->new(year => 2002, month => 8, day => 14)->to_kivitendo;
 627 }
 628
 629 sub DESTROY {
 630   unlink $_ for @{ $_[0]->tempfiles || [] };
 631 }
 632
 633 1;
 634
 635 __END__
 636
 637 =encoding utf-8
 638
 639 =head1 NAME
 640
 641 SL::GoBD - IDEA export generator
 642
 643 =head1 FUNCTIONS
 644
 645 =over 4
 646
 647 =item C<new PARAMS>
 648
 649 Create new export object. C<PARAMS> may contain:
 650
 651 =over 4
 652
 653 =item company
 654
 655 The name of the company, needed for the supplier header
 656
 657 =item location
 658
 659 Location of the company, needed for the supplier header
 660
 661 =item from
 662
 663 =item to
 664
 665 Will only include records in the specified date range. Data pulled from other
 666 tables will be culled to match what is needed for these records.
 667
 668 =item csv_headers
 669
 670 Optional. If set, will include a header line in the exported CSV files. Default true.
 671
 672 =item tables
 673
 674 Ooptional list of tables to be exported. Defaults to all tables.
 675
 676 =item all_tables
 677
 678 Optional alternative to C<tables>, forces all known tables.
 679
 680 =back
 681
 682 =item C<generate_export>
 683
 684 Do the work. Will return an absolute path to a temp file where all export files
 685 are zipped together.
 686
 687 =back
 688
 689 =head1 CAVEATS
 690
 691 Sigh. There are a lot of issues with the IDEA software that were found out by
 692 trial and error.
 693
 694 =head2 Problems in the Specification
 695
 696 =over 4
 697
 698 =item *
 699
 700 The specced date format is capable of only C<YY>, C<YYYY>, C<MM>,
 701 and C<DD>. There are no timestamps or timezones.
 702
 703 =item *
 704
 705 Numbers have the same issue. There is not dedicated integer type, and hinting
 706 at an integer type by setting accuracy to 0 generates a warning for redundant
 707 accuracy.
 708
 709 Also the number parsing is documented to be fragile. Official docs state that
 710 behaviour for too low C<Accuracy> settings is undefined.
 711
 712 =item *
 713
 714 Foreign key definition is broken. Instead of giving column maps it assumes that
 715 foreign keys map to the primary keys given for the target table, and in that
 716 order. Also the target table must be known in full before defining a foreign key.
 717
 718 As a consequence any additional keys apart from primary keys are not possible.
 719 Self-referencing tables are also not possible.
 720
 721 =item *
 722
 723 The spec does not support splitting data sets into smaller chunks. For data
 724 sets that exceed 700MB the spec helpfully suggests: "Use a bigger medium, such
 725 as a DVD".
 726
 727 =item *
 728
 729 It is not possible to set an empty C<DigitGroupingSymbol> since then the import
 730 will just work with the default. This was asked in their forum, and the
 731 response actually was to use a bogus grouping symbol that is not used:
 732
 733   Einfache Lösung: Definieren Sie das Tausendertrennzeichen als Komma, auch
 734   wenn es nicht verwendet wird. Sollten Sie das Komma bereits als Feldtrenner
 735   verwenden, so wählen Sie als Tausendertrennzeichen eine Alternative wie das
 736   Pipe-Symbol |.
 737
 738 L<http://www.gdpdu-portal.com/forum/index.php?mode=thread&id=1392>
 739
 740 =item *
 741
 742 It is not possible to define a C<RecordDelimiter> with XML entities. &#x0A;
 743 generates the error message:
 744
 745   C<RecordDelimiter>-Wert (&#x0A;) sollte immer aus ein oder zwei Zeichen
 746   bestehen.
 747
 748 Instead we just use the implicit default RecordDelimiter CRLF.
 749
 750 =back
 751
 752 =head2 Bugs in the IDEA software
 753
 754 =over 4
 755
 756 =item *
 757
 758 The CSV import library used in IDEA is not able to parse newlines (or more
 759 exactly RecordDelimiter) in data. So this export substites all of these with
 760 spaces.
 761
 762 =item *
 763
 764 Neither it is able to parse escaped C<ColumnDelimiter> in data. It just splits
 765 on that symbol no matter what surrounds or preceeds it.
 766
 767 =item *
 768
 769 Oh and of course C<TextEncapsulator> is also not allowed in data. It's just
 770 stripped at the beginning and end of data.
 771
 772 =item *
 773
 774 And the character "!" is used internally as a warning signal and must not be
 775 present in the data as well.
 776
 777 =item *
 778
 779 C<VariableLength> data is truncated on import to 512 bytes (Note: it said
 780 characters, but since they are mutilating data into a single byte encoding
 781 anyway, they most likely meant bytes). The auditor recommends splitting into
 782 multiple columns.
 783
 784 =item *
 785
 786 Despite the standard specifying UTF-8 as a valid encoding the IDEA software
 787 will just downgrade everything to latin1.
 788
 789 =back
 790
 791 =head2 Problems outside of the software
 792
 793 =over 4
 794
 795 =item *
 796
 797 The law states that "all business related data" should be made available. In
 798 practice there's no definition for what makes data "business related", and
 799 different auditors seems to want different data.
 800
 801 Currently we export most of the transactional data with supplementing
 802 customers, vendors and chart of accounts.
 803
 804 =item *
 805
 806 While the standard explicitely state to provide data normalized, in practice
 807 autditors aren't trained database operators and can not create complex vies on
 808 normalized data on their own. The reason this works for other software is, that
 809 DATEV and SAP seem to have written import plugins for their internal formats in
 810 the IDEA software.
 811
 812 So what is really exported is not unlike a DATEV export. Each transaction gets
 813 splitted into chunks of 2 positions (3 with tax on one side). Those get
 814 denormalized into a single data row with credfit/debit/tax fields. The charts
 815 get denormalized into it as well, in addition to their account number serving
 816 as a foreign key.
 817
 818 Customers and vendors get denormalized into this as well, but are linked by ids
 819 to their tables. And the reason for this is...
 820
 821 =item *
 822
 823 Some auditors do not have a full license of the IDEA software, and
 824 can't do table joins.
 825
 826 =back
 827
 828 =head1 AUTHOR
 829
 830 Sven Schöling E<lt>s.schoeling@linet-services.deE<gt>
 831
 832 =cut