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