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 $net_amount = defined $amount->{net_amount}
 452                    ? $::form->format_amount($myconfig, abs($amount->{net_amount}), 5)
 453                    : 0;
 454     my $tax_amount = defined $amount->{net_amount}
 455                    ? $::form->format_amount($myconfig, abs($amount->{amount}) - abs($amount->{net_amount}), 5)
 456                    : 0;
 457
 458     my %row            = (
 459       amount           => $::form->format_amount($myconfig, abs($amount->{amount}),5),
 460       debit_accno      => $soll->{accno},
 461       debit_accname    => $soll->{accname},
 462       debit_amount     => -$soll->{amount},
 463       debit_tax        => $soll->{tax_accno} ? $tax_amount : 0,
 464       credit_accno     => $haben->{accno},
 465       credit_accname   => $haben->{accname},
 466       credit_amount    => $haben->{amount},
 467       credit_tax       => $haben->{tax_accno} ? $tax_amount : 0,
 468       tax              => $tax_amount,
 469       notes            => $haben->{notes},
 470       (map { ($_ => $tax->{$_})                    } qw(taxkey tax_accname tax_accno taxdescription)),
 471       (map { ($_ => ($haben->{$_} // $soll->{$_})) } qw(trans_id invnumber name vcnumber transdate itime customer_id vendor_id)),
 472     );
 473
 474 #     if ($row{debit_amount} + $row{debit_tax} - ($row{credit_amount} + $row{credit_tax}) > 0.005) {
 475 #       $::lxdebug->dump(0,  "broken taxes", [ $transaction, \%row,  $row{debit_amount} + $row{debit_tax}, $row{credit_amount} + $row{credit_tax} ]);
 476 #     }
 477
 478     _normalize_cell($_) for values %row; # see CAVEATS
 479
 480     $csv->print($fh, [ map { $row{$_} } @datev_columns ]);
 481   }
 482
 483   # and build xml spec for it
 484 }
 485
 486 sub do_csv_export {
 487   my ($self, $table) = @_;
 488
 489   my $csv = Text::CSV_XS->new({ binary => 1, eol => "\r\n", sep_char => ",", quote_char => '"' });
 490
 491   my ($fh, $filename) = File::Temp::tempfile();
 492   binmode($fh, ':utf8');
 493
 494   $self->files->{"$table.csv"} = $filename;
 495   push @{ $self->tempfiles }, $filename;
 496
 497   # in the right order (primary keys first)
 498   my %cols_by_primary_key = _table_columns($table);
 499   my @columns = (@{ $cols_by_primary_key{1} }, @{ $cols_by_primary_key{0} });
 500   my %col_index = do { my $i = 0; map {; "$_" => $i++ } @columns };
 501
 502   if ($self->csv_headers) {
 503     $csv->print($fh, [ map { _normalize_cell($column_titles{$table}{$_->name}) } @columns ]) or die $csv->error_diag;
 504   }
 505
 506   # and normalize date stuff
 507   my @select_tokens = map { (ref $_) =~ /Time/ ? $_->name . '::date' : $_->name } @columns;
 508
 509   my @where_tokens;
 510   my @values;
 511   if ($known_tables{$table}{transdate}) {
 512     if ($self->from) {
 513       push @where_tokens, "$known_tables{$table}{transdate} >= ?";
 514       push @values, $self->from;
 515     }
 516     if ($self->to) {
 517       push @where_tokens, "$known_tables{$table}{transdate} <= ?";
 518       push @values, $self->to;
 519     }
 520   }
 521   if ($known_tables{$table}{tables}) {
 522     my ($col, @col_specs) = @{ $known_tables{$table}{tables} };
 523     my %ids;
 524     for (@col_specs) {
 525       my ($ftable, $fkey) = split /\./, $_;
 526       if (!exists $self->export_ids->{$ftable}{$fkey}) {
 527          # check if we forgot to keep it
 528          if (!grep { $_ eq $fkey } @{ $known_tables{$ftable}{keep} || [] }) {
 529            die "unknown table spec '$_' for table $table, did you forget to keep $fkey in $ftable?"
 530          } else {
 531            # hmm, most likely just an empty set.
 532            $self->export_ids->{$ftable}{$fkey} = {};
 533          }
 534       }
 535       $ids{$_}++ for keys %{ $self->export_ids->{$ftable}{$fkey} };
 536     }
 537     if (keys %ids) {
 538       push @where_tokens, "$col IN (@{[ join ',', ('?') x keys %ids ]})";
 539       push @values, keys %ids;
 540     } else {
 541       push @where_tokens, '1=0';
 542     }
 543   }
 544
 545   my $where_clause = @where_tokens ? 'WHERE ' . join ' AND ', @where_tokens : '';
 546
 547   my $query = "SELECT " . join(', ', @select_tokens) . " FROM $table $where_clause";
 548
 549   my $sth = $::form->get_standard_dbh->prepare($query);
 550   $sth->execute(@values) or die "error executing query $query: " . $sth->errstr;
 551
 552   while (my $row = $sth->fetch) {
 553     for my $keep_col (@{ $known_tables{$table}{keep} || [] }) {
 554       next if !$row->[$col_index{$keep_col}];
 555       $self->export_ids->{$table}{$keep_col} ||= {};
 556       $self->export_ids->{$table}{$keep_col}{$row->[$col_index{$keep_col}]}++;
 557     }
 558     _normalize_cell($_) for @$row; # see CAVEATS
 559
 560     $csv->print($fh, $row) or $csv->error_diag;
 561   }
 562   $sth->finish();
 563 }
 564
 565 sub tag {
 566   my ($self, $tag, $content) = @_;
 567
 568   $self->writer->startTag($tag);
 569   if ('CODE' eq ref $content) {
 570     $content->($self);
 571   } else {
 572     $self->writer->characters($content);
 573   }
 574   $self->writer->endTag;
 575   return $self;
 576 }
 577
 578 sub make_comment {
 579   my $gobd_version  = API_VERSION();
 580   my $kivi_version  = $::form->read_version;
 581   my $person        = $::myconfig{name};
 582   my $contact       = join ', ',
 583     (t8("Email") . ": $::myconfig{email}" ) x!! $::myconfig{email},
 584     (t8("Tel")   . ": $::myconfig{tel}" )   x!! $::myconfig{tel},
 585     (t8("Fax")   . ": $::myconfig{fax}" )   x!! $::myconfig{fax};
 586
 587   t8('DataSet for GoBD version #1. Created with kivitendo #2 by #3 (#4)',
 588     $gobd_version, $kivi_version, $person, $contact
 589   );
 590 }
 591
 592 sub client_name {
 593   $_[0]->company
 594 }
 595
 596 sub client_location {
 597   $_[0]->location
 598 }
 599
 600 sub sorted_tables {
 601   my ($self) = @_;
 602
 603   my %given = map { $_ => 1 } @{ $self->tables };
 604
 605   grep { $given{$_} } @export_table_order;
 606 }
 607
 608 sub all_tables {
 609   my ($self, $yesno) = @_;
 610
 611   $self->tables(\@export_table_order) if $yesno;
 612 }
 613
 614 sub _normalize_cell {
 615   $_[0] =~ s/\r\n/ /g;
 616   $_[0] =~ s/,/;/g;
 617   $_[0] =~ s/"/'/g;
 618   $_[0] =~ s/!/./g;
 619   $_[0]
 620 }
 621
 622 sub init_files { +{} }
 623 sub init_export_ids { +{} }
 624 sub init_tempfiles { [] }
 625 sub init_tables { [ grep { $known_tables{$_} } @export_table_order ] }
 626 sub init_csv_headers { 1 }
 627
 628 sub API_VERSION {
 629   DateTime->new(year => 2002, month => 8, day => 14)->to_kivitendo;
 630 }
 631
 632 sub DESTROY {
 633   unlink $_ for @{ $_[0]->tempfiles || [] };
 634 }
 635
 636 1;
 637
 638 __END__
 639
 640 =encoding utf-8
 641
 642 =head1 NAME
 643
 644 SL::GoBD - IDEA export generator
 645
 646 =head1 FUNCTIONS
 647
 648 =over 4
 649
 650 =item C<new PARAMS>
 651
 652 Create new export object. C<PARAMS> may contain:
 653
 654 =over 4
 655
 656 =item company
 657
 658 The name of the company, needed for the supplier header
 659
 660 =item location
 661
 662 Location of the company, needed for the supplier header
 663
 664 =item from
 665
 666 =item to
 667
 668 Will only include records in the specified date range. Data pulled from other
 669 tables will be culled to match what is needed for these records.
 670
 671 =item csv_headers
 672
 673 Optional. If set, will include a header line in the exported CSV files. Default true.
 674
 675 =item tables
 676
 677 Ooptional list of tables to be exported. Defaults to all tables.
 678
 679 =item all_tables
 680
 681 Optional alternative to C<tables>, forces all known tables.
 682
 683 =back
 684
 685 =item C<generate_export>
 686
 687 Do the work. Will return an absolute path to a temp file where all export files
 688 are zipped together.
 689
 690 =back
 691
 692 =head1 CAVEATS
 693
 694 Sigh. There are a lot of issues with the IDEA software that were found out by
 695 trial and error.
 696
 697 =head2 Problems in the Specification
 698
 699 =over 4
 700
 701 =item *
 702
 703 The specced date format is capable of only C<YY>, C<YYYY>, C<MM>,
 704 and C<DD>. There are no timestamps or timezones.
 705
 706 =item *
 707
 708 Numbers have the same issue. There is not dedicated integer type, and hinting
 709 at an integer type by setting accuracy to 0 generates a warning for redundant
 710 accuracy.
 711
 712 Also the number parsing is documented to be fragile. Official docs state that
 713 behaviour for too low C<Accuracy> settings is undefined.
 714
 715 =item *
 716
 717 Foreign key definition is broken. Instead of giving column maps it assumes that
 718 foreign keys map to the primary keys given for the target table, and in that
 719 order. Also the target table must be known in full before defining a foreign key.
 720
 721 As a consequence any additional keys apart from primary keys are not possible.
 722 Self-referencing tables are also not possible.
 723
 724 =item *
 725
 726 The spec does not support splitting data sets into smaller chunks. For data
 727 sets that exceed 700MB the spec helpfully suggests: "Use a bigger medium, such
 728 as a DVD".
 729
 730 =item *
 731
 732 It is not possible to set an empty C<DigitGroupingSymbol> since then the import
 733 will just work with the default. This was asked in their forum, and the
 734 response actually was to use a bogus grouping symbol that is not used:
 735
 736   Einfache Lösung: Definieren Sie das Tausendertrennzeichen als Komma, auch
 737   wenn es nicht verwendet wird. Sollten Sie das Komma bereits als Feldtrenner
 738   verwenden, so wählen Sie als Tausendertrennzeichen eine Alternative wie das
 739   Pipe-Symbol |.
 740
 741 L<http://www.gdpdu-portal.com/forum/index.php?mode=thread&id=1392>
 742
 743 =item *
 744
 745 It is not possible to define a C<RecordDelimiter> with XML entities. &#x0A;
 746 generates the error message:
 747
 748   C<RecordDelimiter>-Wert (&#x0A;) sollte immer aus ein oder zwei Zeichen
 749   bestehen.
 750
 751 Instead we just use the implicit default RecordDelimiter CRLF.
 752
 753 =back
 754
 755 =head2 Bugs in the IDEA software
 756
 757 =over 4
 758
 759 =item *
 760
 761 The CSV import library used in IDEA is not able to parse newlines (or more
 762 exactly RecordDelimiter) in data. So this export substites all of these with
 763 spaces.
 764
 765 =item *
 766
 767 Neither it is able to parse escaped C<ColumnDelimiter> in data. It just splits
 768 on that symbol no matter what surrounds or preceeds it.
 769
 770 =item *
 771
 772 Oh and of course C<TextEncapsulator> is also not allowed in data. It's just
 773 stripped at the beginning and end of data.
 774
 775 =item *
 776
 777 And the character "!" is used internally as a warning signal and must not be
 778 present in the data as well.
 779
 780 =item *
 781
 782 C<VariableLength> data is truncated on import to 512 bytes (Note: it said
 783 characters, but since they are mutilating data into a single byte encoding
 784 anyway, they most likely meant bytes). The auditor recommends splitting into
 785 multiple columns.
 786
 787 =item *
 788
 789 Despite the standard specifying UTF-8 as a valid encoding the IDEA software
 790 will just downgrade everything to latin1.
 791
 792 =back
 793
 794 =head2 Problems outside of the software
 795
 796 =over 4
 797
 798 =item *
 799
 800 The law states that "all business related data" should be made available. In
 801 practice there's no definition for what makes data "business related", and
 802 different auditors seems to want different data.
 803
 804 Currently we export most of the transactional data with supplementing
 805 customers, vendors and chart of accounts.
 806
 807 =item *
 808
 809 While the standard explicitely state to provide data normalized, in practice
 810 autditors aren't trained database operators and can not create complex vies on
 811 normalized data on their own. The reason this works for other software is, that
 812 DATEV and SAP seem to have written import plugins for their internal formats in
 813 the IDEA software.
 814
 815 So what is really exported is not unlike a DATEV export. Each transaction gets
 816 splitted into chunks of 2 positions (3 with tax on one side). Those get
 817 denormalized into a single data row with credfit/debit/tax fields. The charts
 818 get denormalized into it as well, in addition to their account number serving
 819 as a foreign key.
 820
 821 Customers and vendors get denormalized into this as well, but are linked by ids
 822 to their tables. And the reason for this is...
 823
 824 =item *
 825
 826 Some auditors do not have a full license of the IDEA software, and
 827 can't do table joins.
 828
 829 =back
 830
 831 =head1 AUTHOR
 832
 833 Sven Schöling E<lt>s.schoeling@linet-services.deE<gt>
 834
 835 =cut