X-Git-Url: http://wagnertech.de/git?a=blobdiff_plain;ds=inline;f=SL%2FDATEV.pm;h=1db417c9a42c03437695fbfeb85e745d57dcd1bd;hb=bcdc9f7040d4bc0c0b4d7ce77f1afc29543b04a4;hp=9c617dbb8a6809b67f63dde69e7835fd627599de;hpb=081a4f9736f3bc345872be8f61632cbed4a8d9b3;p=kivitendo-erp.git diff --git a/SL/DATEV.pm b/SL/DATEV.pm index 9c617dbb8..1db417c9a 100644 --- a/SL/DATEV.pm +++ b/SL/DATEV.pm @@ -1,5 +1,5 @@ #===================================================================== -# Lx-Office ERP +# kivitendo ERP # Copyright (c) 2004 # # Author: Philip Reetz @@ -18,911 +18,1308 @@ # GNU General Public License for more details. # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software -# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. +# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, +# MA 02110-1335, USA. #====================================================================== # # Datev export module #====================================================================== -package DATEV; +package SL::DATEV; + +use utf8; +use strict; + +use SL::DBUtils; +use SL::DATEV::CSV; +use SL::DB; +use SL::HTML::Util (); +use SL::Iconv; +use SL::Locale::String qw(t8); +use SL::VATIDNr; use Data::Dumper; +use DateTime; +use Exporter qw(import); +use File::Path; +use IO::File; +use List::MoreUtils qw(any); +use List::Util qw(min max sum); +use List::UtilsBy qw(partition_by sort_by); +use Text::CSV_XS; +use Time::HiRes qw(gettimeofday); + +{ + my $i = 0; + use constant { + DATEV_ET_BUCHUNGEN => $i++, + DATEV_ET_STAMM => $i++, + DATEV_ET_CSV => $i++, + + DATEV_FORMAT_KNE => $i++, + DATEV_FORMAT_OBE => $i++, + DATEV_FORMAT_CSV => $i++, + }; +} + +my @export_constants = qw(DATEV_ET_BUCHUNGEN DATEV_ET_STAMM DATEV_ET_CSV DATEV_FORMAT_KNE DATEV_FORMAT_OBE DATEV_FORMAT_CSV); +our @EXPORT_OK = (@export_constants); +our %EXPORT_TAGS = (CONSTANTS => [ @export_constants ]); -sub get_datev_stamm { - $main::lxdebug->enter_sub(); - my ($self, $myconfig, $form) = @_; +sub new { + my $class = shift; + my %data = @_; - # connect to database - my $dbh = $form->dbconnect($myconfig); + my $obj = bless {}, $class; - $query = qq|SELECT * FROM datev|; - $sth = $dbh->prepare($query); - $sth->execute || $form->dberror($query); + $obj->$_($data{$_}) for keys %data; - my $ref = $sth->fetchrow_hashref(NAME_lc); + $obj; +} - map { $form->{$_} = $ref->{$_} } keys %$ref; +sub exporttype { + my $self = shift; + $self->{exporttype} = $_[0] if @_; + return $self->{exporttype}; +} - $sth->finish; - $dbh->disconnect; - $main::lxdebug->leave_sub(); +sub has_exporttype { + defined $_[0]->{exporttype}; } -sub save_datev_stamm { +sub format { + my $self = shift; + $self->{format} = $_[0] if @_; + return $self->{format}; +} + +sub has_format { + defined $_[0]->{format}; +} + +sub _get_export_path { $main::lxdebug->enter_sub(); - my ($self, $myconfig, $form) = @_; - - # connect to database - my $dbh = $form->dbconnect_noauto($myconfig); - - $query = qq|DELETE FROM datev|; - $dbh->do($query) || $form->dberror($query); - - $query = qq|INSERT INTO datev - (beraternr, beratername, dfvkz, mandantennr, datentraegernr, abrechnungsnr) VALUES - (| - . $dbh->quote($form->{beraternr}) . qq|,| - . $dbh->quote($form->{beratername}) . qq|,| - . $dbh->quote($form->{dfvkz}) . qq|, - | - . $dbh->quote($form->{mandantennr}) . qq|,| - . $dbh->quote($form->{datentraegernr}) . qq|,| - . $dbh->quote($form->{abrechnungsnr}) . qq|)|; - $sth = $dbh->prepare($query); - $sth->execute || $form->dberror($query); - $sth->finish; - - $dbh->commit; - $dbh->disconnect; + my ($a, $b) = gettimeofday(); + my $path = _get_path_for_download_token("${a}-${b}-${$}"); + + mkpath($path) unless (-d $path); + $main::lxdebug->leave_sub(); + + return $path; } -sub kne_export { +sub _get_path_for_download_token { $main::lxdebug->enter_sub(); - my ($self, $myconfig, $form) = @_; - my $rc; + my $token = shift || ''; + my $path; - if ($form->{exporttype} == 0) { - $rc = &kne_buchungsexport($myconfig, $form); - } else { - $rc = &kne_stammdatenexport($myconfig, $form); + if ($token =~ m|^(\d+)-(\d+)-(\d+)$|) { + $path = $::lx_office_conf{paths}->{userspath} . "/datev-export-${1}-${2}-${3}/"; } $main::lxdebug->leave_sub(); - return $rc; + return $path; } -sub obe_export { +sub _get_download_token_for_path { $main::lxdebug->enter_sub(); - my ($self, $myconfig, $form) = @_; + my $path = shift; + my $token; + + if ($path =~ m|.*datev-export-(\d+)-(\d+)-(\d+)/?$|) { + $token = "${1}-${2}-${3}"; + } - # connect to database - my $dbh = $form->dbconnect_noauto($myconfig); - $dbh->commit; - $dbh->disconnect; $main::lxdebug->leave_sub(); + + return $token; } -sub get_dates { - $main::lxdebug->enter_sub(); +sub download_token { + my $self = shift; + $self->{download_token} = $_[0] if @_; + return $self->{download_token} ||= _get_download_token_for_path($self->export_path); +} - my ($zeitraum, $monat, $quartal, $transdatefrom, $transdateto) = @_; +sub export_path { + my ($self) = @_; - $fromto = "transdate >= "; + return $self->{export_path} ||= _get_path_for_download_token($self->{download_token}) || _get_export_path(); +} - my @a = localtime; - $a[5] += 1900; - $jahr = $a[5]; - if ($zeitraum eq "monat") { - SWITCH: { - $monat eq "1" && do { - $form->{fromdate} = "1.1.$jahr"; - $form->{todate} = "31.1.$jahr"; - last SWITCH; - }; - $monat eq "2" && do { - $form->{fromdate} = "1.2.$jahr"; +sub add_filenames { + my $self = shift; + push @{ $self->{filenames} ||= [] }, @_; +} - #this works from 1901 to 2099, 1900 and 2100 fail. - $leap = ($jahr % 4 == 0) ? "29" : "28"; - $form->{todate} = "$leap.2.$jahr"; - last SWITCH; - }; - $monat eq "3" && do { - $form->{fromdate} = "1.3.$jahr"; - $form->{todate} = "31.3.$jahr"; - last SWITCH; - }; - $monat eq "4" && do { - $form->{fromdate} = "1.4.$jahr"; - $form->{todate} = "30.4.$jahr"; - last SWITCH; - }; - $monat eq "5" && do { - $form->{fromdate} = "1.5.$jahr"; - $form->{todate} = "31.5.$jahr"; - last SWITCH; - }; - $monat eq "6" && do { - $form->{fromdate} = "1.6.$jahr"; - $form->{todate} = "30.6.$jahr"; - last SWITCH; - }; - $monat eq "7" && do { - $form->{fromdate} = "1.7.$jahr"; - $form->{todate} = "31.7.$jahr"; - last SWITCH; - }; - $monat eq "8" && do { - $form->{fromdate} = "1.8.$jahr"; - $form->{todate} = "31.8.$jahr"; - last SWITCH; - }; - $monat eq "9" && do { - $form->{fromdate} = "1.9.$jahr"; - $form->{todate} = "30.9.$jahr"; - last SWITCH; - }; - $monat eq "10" && do { - $form->{fromdate} = "1.10.$jahr"; - $form->{todate} = "31.10.$jahr"; - last SWITCH; - }; - $monat eq "11" && do { - $form->{fromdate} = "1.11.$jahr"; - $form->{todate} = "30.11.$jahr"; - last SWITCH; - }; - $monat eq "12" && do { - $form->{fromdate} = "1.12.$jahr"; - $form->{todate} = "31.12.$jahr"; - last SWITCH; - }; - } - $fromto .= - "'" . $form->{fromdate} . "' and transdate <= '" . $form->{todate} . "'"; - } +sub filenames { + return @{ $_[0]{filenames} || [] }; +} - elsif ($zeitraum eq "quartal") { - if ($quartal == 1) { - $fromto .= - "'01.01." . $jahr . "' and transdate <= '31.03." . $jahr . "'"; - } elsif ($quartal == 2) { - $fromto .= - "'01.04." . $jahr . "' and transdate <= '30.06." . $jahr . "'"; - } elsif ($quartal == 3) { - $fromto .= - "'01.07." . $jahr . "' and transdate <= '30.09." . $jahr . "'"; - } elsif ($quartal == 4) { - $fromto .= - "'01.10." . $jahr . "' and transdate <= '31.12." . $jahr . "'"; - } - } +sub add_error { + my $self = shift; + push @{ $self->{errors} ||= [] }, @_; +} - elsif ($zeitraum eq "zeit") { - $fromto .= - "'" . $transdatefrom . "' and transdate <= '" . $transdateto . "'"; - } +sub errors { + return @{ $_[0]{errors} || [] }; +} - $main::lxdebug->leave_sub(); +sub add_net_gross_differences { + my $self = shift; + push @{ $self->{net_gross_differences} ||= [] }, @_; +} - return $fromto; +sub net_gross_differences { + return @{ $_[0]{net_gross_differences} || [] }; } -sub get_transactions { - $main::lxdebug->enter_sub(); +sub sum_net_gross_differences { + return sum $_[0]->net_gross_differences; +} + +sub from { + my $self = shift; + + if (@_) { + $self->{from} = $_[0]; + } + + return $self->{from}; +} - my ($myconfig, $form, $fromto) = @_; +sub to { + my $self = shift; - # connect to database - my $dbh = $form->dbconnect($myconfig); + if (@_) { + $self->{to} = $_[0]; + } - $fromto =~ s/transdate/ac\.transdate/g; + return $self->{to}; +} - $query = qq|SELECT taxkey, rate FROM tax|; - $sth = $dbh->prepare($query); - $sth->execute || $form->dberror($query); +sub trans_id { + my $self = shift; - while (my $ref = $sth->fetchrow_hashref(NAME_lc)) { - $taxes{ $ref->{taxkey} } = $ref->{rate}; + if (@_) { + $self->{trans_id} = $_[0]; } - $sth->finish(); + die "illegal trans_id passed for DATEV export: " . $self->{trans_id} . "\n" unless $self->{trans_id} =~ m/^\d+$/; - $query = - qq|SELECT ac.oid, ac.transdate, ac.trans_id,ar.id, ac.amount, ac.taxkey, ar.invnumber, ar.duedate, ar.amount as umsatz, - ct.name, c.accno, c.taxkey_id as charttax, c.datevautomatik, c.id, t.chart_id, t.rate FROM acc_trans ac,ar ar, customer ct, - chart c LEFT JOIN tax t ON - (t.chart_id=c.id)WHERE $fromto AND ac.trans_id=ar.id AND ac.trans_id=ar.id - AND ar.customer_id=ct.id AND ac.chart_id=c.id - UNION ALL - SELECT ac.oid, ac.transdate, ac.trans_id,ap.id, ac.amount, ac.taxkey, ap.invnumber, ap.duedate, ap.amount as umsatz, - ct.name, c.accno, c.taxkey_id as charttax, c.datevautomatik, c.id, t.chart_id, t.rate FROM acc_trans ac, ap ap, vendor ct, chart c LEFT JOIN tax t ON - (t.chart_id=c.id) - WHERE $fromto AND ac.trans_id=ap.id AND ap.vendor_id=ct.id AND ac.chart_id=c.id - UNION ALL - SELECT ac.oid, ac.transdate, ac.trans_id,gl.id, ac.amount, ac.taxkey, gl.reference AS invnumber, gl.transdate AS duedate, ac.amount as umsatz, - gl.description AS name, c.accno, c.taxkey_id as charttax, c.datevautomatik, c.id, t.chart_id, t.rate FROM acc_trans ac, gl gl, - chart c LEFT JOIN tax t ON - (t.chart_id=c.id) WHERE $fromto AND ac.trans_id=gl.id AND ac.chart_id=c.id - ORDER BY trans_id, oid|; - - $sth = $dbh->prepare($query); - $sth->execute || $form->dberror($query); - $i = 0; - $g = 0; - my $counter = 0; - @splits; - while (my $ref = $sth->fetchrow_hashref(NAME_lc)) { - $count = 0; - $firstrun = 1; - $counter++; - if (($counter % 500) == 0) { - print("$counter "); - } + return $self->{trans_id}; +} - $count += $ref->{amount}; - push @{$i}, $ref; - while (abs($count) > 0.01 || $firstrun) { - $ref2 = $sth->fetchrow_hashref(NAME_lc); - last unless ($ref2); - $count += $ref2->{amount}; - push @{$i}, $ref2; - $firstrun = 0; - } - $absumsatz = 0; - if (scalar(@{$i}) > 2) { - for my $j (0 .. (scalar(@{$i}) - 1)) { - if (abs($i->[$j]->{'amount'}) > abs($absumsatz)) { - $absumsatz = $i->[$j]->{'amount'}; - $notsplitindex = $j; - } - } - $ml = ($i->[0]->{'umsatz'} > 0) ? 1 : -1; - for my $j (0 .. (scalar(@{$i}) - 1)) { - if ( ($j != $notsplitindex) - && ($i->[$j]->{'chart_id'} eq "") - && ( $i->[$j]->{'taxkey'} eq "" - || $i->[$j]->{'taxkey'} eq "0" - || $i->[$j]->{'taxkey'} eq "1" - || $i->[$j]->{'taxkey'} eq "10" - || $i->[$j]->{'taxkey'} eq "11") - ) { - my %blubb = {}; - map({ $blubb{$_} = $i->[$notsplitindex]->{$_}; } - keys(%{ $i->[$notsplitindex] })); - $absumsatz += $i->[$j]->{'amount'}; - $blubb{'amount'} = $i->[$j]->{'amount'} * (-1); - $blubb{'umsatz'} = abs($i->[$j]->{'amount'}) * $ml; - $i->[$j]->{'umsatz'} = abs($i->[$j]->{'amount'}) * $ml; - push @{ $splits[$g] }, \%blubb; #$i->[$notsplitindex]; - push @{ $splits[$g] }, $i->[$j]; - push @{ $form->{DATEV} }, \@{ $splits[$g] }; - $g++; - } elsif (($j != $notsplitindex) && ($i->[$j]->{'chart_id'} eq "")) { - $absumsatz += - ($i->[$j]->{'amount'} * (1 + $taxes{ $i->[$j]->{'taxkey'} })); - my %blubb = {}; - map({ $blubb{$_} = $i->[$notsplitindex]->{$_}; } - keys(%{ $i->[$notsplitindex] })); - $test = 1 + $taxes{ $i->[$j]->{'taxkey'} }; - $blubb{'amount'} = - $form->round_amount(($i->[$j]->{'amount'} * $test * -1), 2); - - $blubb{'umsatz'} = - abs($form->round_amount(($i->[$j]->{'amount'} * $test), 2)) * $ml; - - $i->[$j]->{'umsatz'} = - abs($form->round_amount(($i->[$j]->{'amount'} * $test), 2)) * $ml; - - push @{ $splits[$g] }, \%blubb; - push @{ $splits[$g] }, $i->[$j]; - push @{ $form->{DATEV} }, \@{ $splits[$g] }; - $g++; - } else { - next; - } - } - if (abs($absumsatz) > 0.01) { - $form->error("Datev-Export fehlgeschlagen!"); - } - } else { - push @{ $form->{DATEV} }, \@{$i}; - } - $i++; +sub warnings { + my $self = shift; + + if (@_) { + $self->{warnings} = [@_]; + } else { + return $self->{warnings}; } - $sth->finish; - $dbh->disconnect; +} - $main::lxdebug->leave_sub(); +sub use_pk { + my $self = shift; + + if (@_) { + $self->{use_pk} = $_[0]; + } + + return $self->{use_pk}; } -sub make_kne_data_header { - $main::lxdebug->enter_sub(); +sub accnofrom { + my $self = shift; - my ($myconfig, $form, $fromto) = @_; + if (@_) { + $self->{accnofrom} = $_[0]; + } - # connect to database - my $dbh = $form->dbconnect($myconfig); + return $self->{accnofrom}; +} - my @a = localtime; - $jahr = $a[5]; +sub accnoto { + my $self = shift; - #Header - $anwendungsnr = ($fromto) ? "\x31\x31" : "\x31\x33"; - while (length($form->{datentraegernr}) < 3) { - $form->{datentraegernr} = "\x30" . $form->{datentraegernr}; - } + if (@_) { + $self->{accnoto} = $_[0]; + } - $header = "\x1D\x18\x31" . $form->{datentraegernr} . $anwendungsnr; + return $self->{accnoto}; +} - $dfvkz = $form->{dfvkz}; - while (length($dfvkz) < 2) { - $dfvkz = "\x30" . $dfvkz; - } - $header .= $dfvkz; - $beraternr = $form->{beraternr}; - while (length($beraternr) < 7) { - $beraternr = "\x30" . $beraternr; - } - $header .= $beraternr; +sub dbh { + my $self = shift; - $mandantennr = $form->{mandantennr}; - while (length($mandantennr) < 5) { - $mandantennr = "\x30" . $mandantennr; + if (@_) { + $self->{dbh} = $_[0]; + $self->{provided_dbh} = 1; } - $header .= $mandantennr; - $abrechnungsnr = $form->{abrechnungsnr} . $jahr; - while (length($abrechnungsnr) < 6) { - $abrechnungsnr = "\x30" . $abrechnungsnr; - } - $header .= $abrechnungsnr; + $self->{dbh} ||= SL::DB->client->dbh; +} - $fromto =~ s/transdate|>=|and|\'|<=//g; - my ($from, $to) = split / /, $fromto; - $from =~ s/ //g; - $to =~ s/ //g; +sub provided_dbh { + $_[0]{provided_dbh}; +} - if ($from ne "") { - my ($fday, $fmonth, $fyear) = split /\./, $from; - if (length($fmonth) < 2) { - $fmonth = "0" . $fmonth; - } - if (length($fday) < 2) { - $fday = "0" . $fday; - } - $from = $fday . $fmonth . substr($fyear, -2, 2); - } else { - $from = ""; - } +sub clean_temporary_directories { + $::lxdebug->enter_sub; - $header .= $from; + foreach my $path (glob($::lx_office_conf{paths}->{userspath} . "/datev-export-*")) { + next unless -d $path; - if ($to ne "") { - my ($tday, $tmonth, $tyear) = split /\./, $to; - if (length($tmonth) < 2) { - $tmonth = "0" . $tmonth; - } - if (length($tday) < 2) { - $tday = "0" . $tday; - } - $to = $tday . $tmonth . substr($tyear, -2, 2); - } else { - $to = ""; - } - $header .= $to; - if ($fromto ne "") { - $primanota = "\x30\x30\x31"; - $header .= $primanota; - } + my $mtime = (stat($path))[9]; + next if ((time() - $mtime) < 8 * 60 * 60); - $passwort = $form->{passwort}; - while (length($passwort) < 4) { - $passwort = "\x30" . $passwort; + rmtree $path; } - $header .= $passwort; - $anwendungsinfo = "\x20" x 16; - $header .= $anwendungsinfo; - $inputinfo = "\x20" x 16; - $header .= $inputinfo; + $::lxdebug->leave_sub; +} - $header .= "\x79"; +sub get_datev_stamm { + return $_[0]{stamm} ||= selectfirst_hashref_query($::form, $_[0]->dbh, 'SELECT * FROM datev'); +} + +sub save_datev_stamm { + my ($self, $data) = @_; + + SL::DB->client->with_transaction(sub { + do_query($::form, $self->dbh, 'DELETE FROM datev'); + + my @columns = qw(beraternr beratername dfvkz mandantennr datentraegernr abrechnungsnr); + + my $query = "INSERT INTO datev (" . join(', ', @columns) . ") VALUES (" . join(', ', ('?') x @columns) . ")"; + do_query($::form, $self->dbh, $query, map { $data->{$_} } @columns); + 1; + }) or do { die SL::DB->client->error }; +} + +sub export { + my ($self) = @_; + + return $self->csv_export; +} + +sub csv_export { + my ($self) = @_; + my $result; + + die 'no exporttype set!' unless $self->has_exporttype; + + if ($self->exporttype == DATEV_ET_BUCHUNGEN) { + + $self->generate_datev_data(from_to => $self->fromto); + return if $self->errors; + + my $datev_csv = SL::DATEV::CSV->new( + datev_lines => $self->generate_datev_lines, + from => $self->from, + to => $self->to, + locked => $self->locked, + ); + + + my $filename = "EXTF_DATEV_kivitendo" . $self->from->ymd() . '-' . $self->to->ymd() . ".csv"; + + my $csv = Text::CSV_XS->new({ + binary => 1, + sep_char => ";", + always_quote => 1, + eol => "\r\n", + }) or die "Cannot use CSV: ".Text::CSV_XS->error_diag(); + + # get encoding from defaults - use cp1252 if DATEV strict export is used + my $enc = ($::instance_conf->get_datev_export_format eq 'cp1252') ? 'cp1252' : 'utf-8'; + my $csv_file = IO::File->new($self->export_path . '/' . $filename, ">:encoding($enc)") or die "Can't open: $!"; + + $csv->print($csv_file, $_) for @{ $datev_csv->header }; + $csv->print($csv_file, $_) for @{ $datev_csv->lines }; + $csv_file->close; + $self->{warnings} = $datev_csv->warnings; + + # convert utf-8 to cp1252//translit if set + if ($::instance_conf->get_datev_export_format eq 'cp1252-translit') { + + my $filename_translit = "EXTF_DATEV_kivitendo_translit" . $self->from->ymd() . '-' . $self->to->ymd() . ".csv"; + open my $fh_in, '<:encoding(UTF-8)', $self->export_path . '/' . $filename or die "could not open $filename for reading: $!"; + open my $fh_out, '>', $self->export_path . '/' . $filename_translit or die "could not open $filename_translit for writing: $!"; + + my $converter = SL::Iconv->new("utf-8", "cp1252//translit"); + + print $fh_out $converter->convert($_) while <$fh_in>; + close $fh_in; + close $fh_out; + + unlink $self->export_path . '/' . $filename or warn "Could not unlink $filename: $!"; + $filename = $filename_translit; + } + + return { download_token => $self->download_token, filenames => $filename }; - #Versionssatz - if ($form->{exporttype} == 0) { - $versionssatz = "\xB5" . "1,"; } else { - $versionssatz = "\xB6" . "1,"; + die 'unrecognized exporttype'; } - $query = qq| select accno from chart limit 1|; - $sth = $dbh->prepare($query); - $sth->execute || $form->dberror($query); - my $ref = $sth->fetchrow_hashref(NAME_lc); + return $result; +} + +sub fromto { + my ($self) = @_; - $accnolength = $ref->{accno}; - $sth->finish; + return unless $self->from && $self->to; - $versionssatz .= length($accnolength); - $versionssatz .= ","; - $versionssatz .= length($accnolength); - $versionssatz .= ",SELF" . "\x1C\x79"; + return "transdate >= '" . $self->from->to_lxoffice . "' and transdate <= '" . $self->to->to_lxoffice . "'"; +} - $dbh->disconnect; +sub _sign { + $_[0] <=> 0; +} - $header .= $versionssatz; +sub locked { + my $self = shift; - $main::lxdebug->leave_sub(); + if (@_) { + $self->{locked} = $_[0]; + } + return $self->{locked}; +} +sub imported { + my $self = shift; - return $header; + if (@_) { + $self->{imported} = $_[0]; + } + return $self->{imported}; } -sub datetofour { +sub generate_datev_data { $main::lxdebug->enter_sub(); - my ($date, $six) = @_; + my ($self, %params) = @_; + my $fromto = $params{from_to} // ''; + my $progress_callback = $params{progress_callback} || sub {}; - ($day, $month, $year) = split /\./, $date; + my $form = $main::form; - if ($day =~ /^0/) { - $day = substr($day, 1, 1); - } - if (length($month) < 2) { - $month = "0" . $month; - } - if (length($year) > 2) { - $year = substr($year, -2, 2); + my $trans_id_filter = ''; + my $ar_department_id_filter = ''; + my $ap_department_id_filter = ''; + my $gl_department_id_filter = ''; + if ( $form->{department_id} ) { + $ar_department_id_filter = " AND ar.department_id = ? "; + $ap_department_id_filter = " AND ap.department_id = ? "; + $gl_department_id_filter = " AND gl.department_id = ? "; } - if ($six) { - $date = $day . $month . $year; + my ($gl_itime_filter, $ar_itime_filter, $ap_itime_filter); + if ( $form->{gldatefrom} ) { + $gl_itime_filter = " AND gl.itime >= ? "; + $ar_itime_filter = " AND ar.itime >= ? "; + $ap_itime_filter = " AND ap.itime >= ? "; } else { - $date = $day . $month; + $gl_itime_filter = ""; + $ar_itime_filter = ""; + $ap_itime_filter = ""; } - $main::lxdebug->leave_sub(); + if ( $self->{trans_id} ) { + # ignore dates when trans_id is passed so that the entire transaction is + # checked, not just either the initial bookings or the subsequent payments + # (the transdates will likely differ) + $fromto = ''; + $trans_id_filter = 'ac.trans_id = ' . $self->trans_id; + } else { + $fromto =~ s/transdate/ac\.transdate/g; + }; - return $date; -} + my ($notsplitindex); -sub formatumsatz { - $main::lxdebug->enter_sub(); + my $filter = ''; # Useful for debugging purposes - my ($umsatz, $stellen) = @_; + my %all_taxchart_ids = selectall_as_map($form, $self->dbh, qq|SELECT DISTINCT chart_id, TRUE AS is_set FROM tax|, 'chart_id', 'is_set'); - $umsatz =~ s/-//; - ($vorkomma, $nachkomma) = split /\./, $umsatz; - $umsatz = ""; - if ($stellen > 0) { - for ($i = $stellen; $i >= $stellen + 2 - length($vorkomma); $i--) { - $umsatz .= "0"; - } + my $ar_accno = "c.accno"; + my $ap_accno = "c.accno"; + if ( $self->use_pk ) { + $ar_accno = "CASE WHEN ac.chart_link = 'AR' THEN ct.customernumber ELSE c.accno END as accno"; + $ap_accno = "CASE WHEN ac.chart_link = 'AP' THEN ct.vendornumber ELSE c.accno END as accno"; } - for ($i = 3; $i > length($nachkomma); $i--) { - $nachkomma .= "0"; + my $gl_imported; + if ( !$self->imported ) { + $gl_imported = " AND NOT imported"; } - $umsatz = $vorkomma . substr($nachkomma, 0, 2); - $main::lxdebug->leave_sub(); + my $query = + qq|SELECT ac.acc_trans_id, ac.transdate, ac.gldate, ac.trans_id,ar.id, ac.amount, ac.taxkey, ac.memo, + ar.invnumber, ar.duedate, ar.amount as umsatz, COALESCE(ar.tax_point, ar.deliverydate) AS deliverydate, ar.itime::date, + ct.name, ct.ustid, ct.customernumber AS vcnumber, ct.id AS customer_id, NULL AS vendor_id, + $ar_accno, c.description AS accname, c.taxkey_id as charttax, c.datevautomatik, c.id, ac.chart_link AS link, + ar.invoice, + t.rate AS taxrate, t.taxdescription, + 'ar' as table, + tc.accno AS tax_accno, tc.description AS tax_accname, + ar.department_id, + ar.notes, + project.projectnumber as projectnumber, project.description as projectdescription, + department.description as departmentdescription + FROM acc_trans ac + LEFT JOIN ar ON (ac.trans_id = ar.id) + LEFT JOIN customer ct ON (ar.customer_id = ct.id) + LEFT JOIN chart c ON (ac.chart_id = c.id) + LEFT JOIN tax t ON (ac.tax_id = t.id) + LEFT JOIN chart tc ON (t.chart_id = tc.id) + LEFT JOIN department ON (department.id = ar.department_id) + LEFT JOIN project ON (project.id = ar.globalproject_id) + WHERE (ar.id IS NOT NULL) + AND $fromto + $trans_id_filter + $ar_itime_filter + $ar_department_id_filter + $filter + + UNION ALL + + SELECT ac.acc_trans_id, ac.transdate, ac.gldate, ac.trans_id,ap.id, ac.amount, ac.taxkey, ac.memo, + ap.invnumber, ap.duedate, ap.amount as umsatz, COALESCE(ap.tax_point, ap.deliverydate) AS deliverydate, ap.itime::date, + ct.name, ct.ustid, ct.vendornumber AS vcnumber, NULL AS customer_id, ct.id AS vendor_id, + $ap_accno, c.description AS accname, c.taxkey_id as charttax, c.datevautomatik, c.id, ac.chart_link AS link, + ap.invoice, + t.rate AS taxrate, t.taxdescription, + 'ap' as table, + tc.accno AS tax_accno, tc.description AS tax_accname, + ap.department_id, + ap.notes, + project.projectnumber as projectnumber, project.description as projectdescription, + department.description as departmentdescription + FROM acc_trans ac + LEFT JOIN ap ON (ac.trans_id = ap.id) + LEFT JOIN vendor ct ON (ap.vendor_id = ct.id) + LEFT JOIN chart c ON (ac.chart_id = c.id) + LEFT JOIN tax t ON (ac.tax_id = t.id) + LEFT JOIN chart tc ON (t.chart_id = tc.id) + LEFT JOIN department ON (department.id = ap.department_id) + LEFT JOIN project ON (project.id = ap.globalproject_id) + WHERE (ap.id IS NOT NULL) + AND $fromto + $trans_id_filter + $ap_itime_filter + $ap_department_id_filter + $filter + + UNION ALL + + SELECT ac.acc_trans_id, ac.transdate, ac.gldate, ac.trans_id,gl.id, ac.amount, ac.taxkey, ac.memo, + gl.reference AS invnumber, NULL AS duedate, ac.amount as umsatz, COALESCE(gl.tax_point, gl.deliverydate) AS deliverydate, gl.itime::date, + gl.description AS name, NULL as ustid, '' AS vcname, NULL AS customer_id, NULL AS vendor_id, + c.accno, c.description AS accname, c.taxkey_id as charttax, c.datevautomatik, c.id, ac.chart_link AS link, + FALSE AS invoice, + t.rate AS taxrate, t.taxdescription, + 'gl' as table, + tc.accno AS tax_accno, tc.description AS tax_accname, + gl.department_id, + gl.notes, + '' as projectnumber, '' as projectdescription, + department.description as departmentdescription + FROM acc_trans ac + LEFT JOIN gl ON (ac.trans_id = gl.id) + LEFT JOIN chart c ON (ac.chart_id = c.id) + LEFT JOIN tax t ON (ac.tax_id = t.id) + LEFT JOIN chart tc ON (t.chart_id = tc.id) + LEFT JOIN department ON (department.id = gl.department_id) + WHERE (gl.id IS NOT NULL) + AND $fromto + $trans_id_filter + $gl_itime_filter + $gl_department_id_filter + $gl_imported + $filter + + ORDER BY trans_id, acc_trans_id|; + + my @query_args; + if ( $form->{gldatefrom} or $form->{department_id} ) { + + for ( 1 .. 3 ) { + if ( $form->{gldatefrom} ) { + my $glfromdate = $::locale->parse_date_to_object($form->{gldatefrom}); + die "illegal data" unless ref($glfromdate) eq 'DateTime'; + push(@query_args, $glfromdate); + } + if ( $form->{department_id} ) { + push(@query_args, $form->{department_id}); + } + } + } - return $umsatz; -} + my $sth = prepare_execute_query($form, $self->dbh, $query, @query_args); + $self->{DATEV} = []; -sub make_ed_versionset { - $main::lxdebug->enter_sub(); + my $counter = 0; + my $continue = 1; # + my $name; + while ( $continue && (my $ref = $sth->fetchrow_hashref("NAME_lc")) ) { + last unless $ref; # for single transactions + $counter++; + if (($counter % 500) == 0) { + $progress_callback->($counter); + } - my ($header, $filename, $blockcount, $fromto) = @_; + my $trans = [ $ref ]; - $versionset = "V" . substr($filename, 2, 5); - $versionset .= substr($header, 6, 22); - if ($fromto ne "") { - $versionset .= "0000" . substr($header, 28, 19); - } else { - $datum = "\x20" x 16; - $versionset .= $datum . "001" . substr($header, 28, 4); - } - while (length($blockcount) < 5) { - $blockcount = "0" . $blockcount; - } - $versionset .= $blockcount; - $versionset .= "001"; - $versionset .= "\x20\x31"; - $versionset .= substr($header, -12, 10) . " "; - $versionset .= "\x20" x 53; + my $count = $ref->{amount}; + my $firstrun = 1; - $main::lxdebug->leave_sub(); + # if the amount of a booking in a group is smaller than 0.02, any tax + # amounts will likely be smaller than 1 cent, so go into subcent mode + my $subcent = abs($count) < 0.02; - return $versionset; -} + # records from acc_trans are ordered by trans_id and acc_trans_id + # first check for unbalanced ledger inside one trans_id + # there may be several groups inside a trans_id, e.g. the original booking and the payment + # each group individually should be exactly balanced and each group + # individually needs its own datev lines -sub make_ev_header { - $main::lxdebug->enter_sub(); + # keep fetching new acc_trans lines until the end of a balanced group is reached + while (abs($count) > 0.01 || $firstrun || ($subcent && abs($count) > 0.005)) { + my $ref2 = $sth->fetchrow_hashref("NAME_lc"); + unless ( $ref2 ) { + $continue = 0; + last; + }; - my ($form, $fileno) = @_; - $datentraegernr = $form->{datentraegernr}; - $beraternummer = $form->{beraternr}; - $beratername = $form->{beratername}; - $anzahl_dateien = $fileno; + # check if trans_id of current acc_trans line is still the same as the + # trans_id of the first line in group, i.e. we haven't finished a 0-group + # before moving on to the next trans_id, error will likely be in the old + # trans_id. + + if ($ref2->{trans_id} != $trans->[0]->{trans_id}) { + require SL::DB::Manager::AccTransaction; + if ( $trans->[0]->{trans_id} ) { + my $acc_trans_obj = SL::DB::Manager::AccTransaction->get_first(where => [ trans_id => $trans->[0]->{trans_id} ]); + $self->add_error(t8("Export error in transaction #1: Unbalanced ledger before next transaction (#2)", + $acc_trans_obj->transaction_name, $ref2->{trans_id}) + ); + }; + return; + } - while (length($datentraegernr) < 3) { - $datentraegernr .= " "; - } + push @{ $trans }, $ref2; - while (length($beraternummer) < 7) { - $beraternummer .= " "; - } + $count += $ref2->{amount}; + $firstrun = 0; + } - while (length($beratername) < 9) { - $beratername .= " "; - } + foreach my $i (0 .. scalar(@{ $trans }) - 1) { + my $ref = $trans->[$i]; + my $prev_ref = 0 < $i ? $trans->[$i - 1] : undef; + if ( $all_taxchart_ids{$ref->{id}} + && ($ref->{link} =~ m/(?:AP_tax|AR_tax)/) + && ( ($prev_ref && $prev_ref->{taxkey} && (_sign($ref->{amount}) == _sign($prev_ref->{amount}))) + || $ref->{invoice})) { + $ref->{is_tax} = 1; + } - while (length($anzahl_dateien) < 5) { - $anzahl_dateien = "0" . $anzahl_dateien; - } + if ( !$ref->{invoice} # we have a non-invoice booking (=gl) + && $ref->{is_tax} # that has "is_tax" set + && !($prev_ref->{is_tax}) # previous line wasn't is_tax + && (_sign($ref->{amount}) == _sign($prev_ref->{amount}))) { # and sign same as previous sign + $trans->[$i - 1]->{tax_amount} = $ref->{amount}; + } + } - $ev_header = - $datentraegernr . "\x20\x20\x20" . $beraternummer . $beratername . "\x20"; - $ev_header .= $anzahl_dateien . $anzahl_dateien; - $ev_header .= "\x20" x 95; + my $absumsatz = 0; + if (scalar(@{$trans}) <= 2) { + push @{ $self->{DATEV} }, $trans; + next; + } - $main::lxdebug->leave_sub(); + # determine at which array position the reference value (called absumsatz) is + # and which amount it has - return $ev_header; -} + for my $j (0 .. (scalar(@{$trans}) - 1)) { -sub kne_buchungsexport { - $main::lxdebug->enter_sub(); + # Three cases: + # 1: gl transaction (Dialogbuchung), invoice is false, no double split booking allowed - my ($myconfig, $form) = @_; - - my $export_path = "datev/"; - my $filename = "ED00000"; - my $evfile = "EV01"; - my @ed_versionsets; - my $fileno = 0; - - $form->header; - print qq| - -
Export in Bearbeitung