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