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