Projekt

Allgemein

Profil

Herunterladen (45,5 KB) Statistiken
| Zweig: | Markierung: | Revision:
d319704a Moritz Bunkus
#=====================================================================
008c2e15 Moritz Bunkus
# kivitendo ERP
d319704a Moritz Bunkus
# Copyright (c) 2004
#
# Author: Philip Reetz
# Email: p.reetz@linet-services.de
# Web: http://www.lx-office.org
#
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# 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
f7b15d43 Christian Wittmer
# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston,
# MA 02110-1335, USA.
d319704a Moritz Bunkus
#======================================================================
#
# Datev export module
#======================================================================

631b4c04 Sven Schöling
package SL::DATEV;
d319704a Moritz Bunkus
05c6840d Moritz Bunkus
use utf8;
use strict;
e20f3f0d Moritz Bunkus
032e5fcd Moritz Bunkus
use SL::DBUtils;
ef5b4b39 Jan Büren
use SL::DATEV::CSV;
040aa711 Sven Schöling
use SL::DB;
3c1390b8 Jan Büren
use Encode qw(encode);
00b6dc22 Sven Schöling
use SL::HTML::Util ();
324726ac Jan Büren
use SL::Iconv;
28fc2476 Sven Schöling
use SL::Locale::String qw(t8);
c20ee3de Moritz Bunkus
use SL::VATIDNr;
032e5fcd Moritz Bunkus
ca3b14ff Jan Büren
use Archive::Zip;
d319704a Moritz Bunkus
use Data::Dumper;
631b4c04 Sven Schöling
use DateTime;
use Exporter qw(import);
f8138d17 Moritz Bunkus
use File::Path;
00b6dc22 Sven Schöling
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;
f8138d17 Moritz Bunkus
use Time::HiRes qw(gettimeofday);
ca3b14ff Jan Büren
use XML::LibXML;
f8138d17 Moritz Bunkus
631b4c04 Sven Schöling
{
my $i = 0;
use constant {
DATEV_ET_BUCHUNGEN => $i++,
DATEV_ET_STAMM => $i++,
00b6dc22 Sven Schöling
DATEV_ET_CSV => $i++,
631b4c04 Sven Schöling
DATEV_FORMAT_KNE => $i++,
DATEV_FORMAT_OBE => $i++,
b14b1780 Geoffrey Richardson
DATEV_FORMAT_CSV => $i++,
631b4c04 Sven Schöling
};
}

b14b1780 Geoffrey Richardson
my @export_constants = qw(DATEV_ET_BUCHUNGEN DATEV_ET_STAMM DATEV_ET_CSV DATEV_FORMAT_KNE DATEV_FORMAT_OBE DATEV_FORMAT_CSV);
631b4c04 Sven Schöling
our @EXPORT_OK = (@export_constants);
our %EXPORT_TAGS = (CONSTANTS => [ @export_constants ]);


sub new {
my $class = shift;
my %data = @_;

my $obj = bless {}, $class;

$obj->$_($data{$_}) for keys %data;

$obj;
}

sub exporttype {
my $self = shift;
$self->{exporttype} = $_[0] if @_;
return $self->{exporttype};
}

sub has_exporttype {
defined $_[0]->{exporttype};
}

sub format {
my $self = shift;
$self->{format} = $_[0] if @_;
return $self->{format};
}

sub has_format {
defined $_[0]->{format};
}

f8138d17 Moritz Bunkus
sub _get_export_path {
$main::lxdebug->enter_sub();

my ($a, $b) = gettimeofday();
631b4c04 Sven Schöling
my $path = _get_path_for_download_token("${a}-${b}-${$}");
f8138d17 Moritz Bunkus
mkpath($path) unless (-d $path);

$main::lxdebug->leave_sub();

return $path;
}

631b4c04 Sven Schöling
sub _get_path_for_download_token {
f8138d17 Moritz Bunkus
$main::lxdebug->enter_sub();

631b4c04 Sven Schöling
my $token = shift || '';
f8138d17 Moritz Bunkus
my $path;

if ($token =~ m|^(\d+)-(\d+)-(\d+)$|) {
631b4c04 Sven Schöling
$path = $::lx_office_conf{paths}->{userspath} . "/datev-export-${1}-${2}-${3}/";
f8138d17 Moritz Bunkus
}

$main::lxdebug->leave_sub();

return $path;
}

631b4c04 Sven Schöling
sub _get_download_token_for_path {
f8138d17 Moritz Bunkus
$main::lxdebug->enter_sub();

my $path = shift;
my $token;

if ($path =~ m|.*datev-export-(\d+)-(\d+)-(\d+)/?$|) {
$token = "${1}-${2}-${3}";
}

$main::lxdebug->leave_sub();

return $token;
}

631b4c04 Sven Schöling
sub download_token {
my $self = shift;
$self->{download_token} = $_[0] if @_;
return $self->{download_token} ||= _get_download_token_for_path($self->export_path);
}

sub export_path {
my ($self) = @_;

return $self->{export_path} ||= _get_path_for_download_token($self->{download_token}) || _get_export_path();
}

sub add_filenames {
my $self = shift;
push @{ $self->{filenames} ||= [] }, @_;
}

sub filenames {
return @{ $_[0]{filenames} || [] };
}

sub add_error {
my $self = shift;
push @{ $self->{errors} ||= [] }, @_;
}

sub errors {
return @{ $_[0]{errors} || [] };
}

sub add_net_gross_differences {
my $self = shift;
push @{ $self->{net_gross_differences} ||= [] }, @_;
}

sub net_gross_differences {
return @{ $_[0]{net_gross_differences} || [] };
}

sub sum_net_gross_differences {
return sum $_[0]->net_gross_differences;
}

sub from {
my $self = shift;

if (@_) {
0e71a0c8 Jan Büren
die "Invalid type, need DateTime Object" unless ref $_[0] eq 'DateTime';
631b4c04 Sven Schöling
$self->{from} = $_[0];
}

return $self->{from};
}

sub to {
my $self = shift;

if (@_) {
0e71a0c8 Jan Büren
die "Invalid type, need DateTime Object" unless ref $_[0] eq 'DateTime';
631b4c04 Sven Schöling
$self->{to} = $_[0];
}

return $self->{to};
}

e04c32d3 Niclas Zimmermann
sub trans_id {
my $self = shift;

if (@_) {
$self->{trans_id} = $_[0];
}

6a349447 Geoffrey Richardson
die "illegal trans_id passed for DATEV export: " . $self->{trans_id} . "\n" unless $self->{trans_id} =~ m/^\d+$/;

e04c32d3 Niclas Zimmermann
return $self->{trans_id};
}

9e99dce5 Jan Büren
sub warnings {
my $self = shift;

if (@_) {
84345dad Jan Büren
$self->{warnings} = [@_];
9e99dce5 Jan Büren
} else {
return $self->{warnings};
}
}

a3a6ec06 Geoffrey Richardson
sub use_pk {
my $self = shift;

if (@_) {
$self->{use_pk} = $_[0];
}

return $self->{use_pk};
}

631b4c04 Sven Schöling
sub accnofrom {
my $self = shift;

if (@_) {
$self->{accnofrom} = $_[0];
}

return $self->{accnofrom};
}

sub accnoto {
my $self = shift;

if (@_) {
$self->{accnoto} = $_[0];
}

return $self->{accnoto};
}


sub dbh {
my $self = shift;

if (@_) {
$self->{dbh} = $_[0];
$self->{provided_dbh} = 1;
}

040aa711 Sven Schöling
$self->{dbh} ||= SL::DB->client->dbh;
631b4c04 Sven Schöling
}

sub provided_dbh {
$_[0]{provided_dbh};
}

f8138d17 Moritz Bunkus
sub clean_temporary_directories {
631b4c04 Sven Schöling
$::lxdebug->enter_sub;
f8138d17 Moritz Bunkus
8cd05ad6 Moritz Bunkus
foreach my $path (glob($::lx_office_conf{paths}->{userspath} . "/datev-export-*")) {
631b4c04 Sven Schöling
next unless -d $path;
f8138d17 Moritz Bunkus
my $mtime = (stat($path))[9];
next if ((time() - $mtime) < 8 * 60 * 60);

rmtree $path;
}

631b4c04 Sven Schöling
$::lxdebug->leave_sub;
f8138d17 Moritz Bunkus
}
d319704a Moritz Bunkus
sub get_datev_stamm {
631b4c04 Sven Schöling
return $_[0]{stamm} ||= selectfirst_hashref_query($::form, $_[0]->dbh, 'SELECT * FROM datev');
}
d319704a Moritz Bunkus
631b4c04 Sven Schöling
sub save_datev_stamm {
my ($self, $data) = @_;
d319704a Moritz Bunkus
040aa711 Sven Schöling
SL::DB->client->with_transaction(sub {
do_query($::form, $self->dbh, 'DELETE FROM datev');
d319704a Moritz Bunkus
040aa711 Sven Schöling
my @columns = qw(beraternr beratername dfvkz mandantennr datentraegernr abrechnungsnr);
d319704a Moritz Bunkus
040aa711 Sven Schöling
my $query = "INSERT INTO datev (" . join(', ', @columns) . ") VALUES (" . join(', ', ('?') x @columns) . ")";
do_query($::form, $self->dbh, $query, map { $data->{$_} } @columns);
6b23fb21 Sven Schöling
1;
}) or do { die SL::DB->client->error };
d319704a Moritz Bunkus
}

631b4c04 Sven Schöling
sub export {
my ($self) = @_;

476d2c57 Jan Büren
return $self->csv_export;
d319704a Moritz Bunkus
}

b14b1780 Geoffrey Richardson
sub csv_export {
ef5b4b39 Jan Büren
my ($self) = @_;
my $result;

die 'no exporttype set!' unless $self->has_exporttype;

if ($self->exporttype == DATEV_ET_BUCHUNGEN) {
1d559eff Jan Büren
e8f87db4 Jan Büren
$self->generate_datev_data(from_to => $self->fromto);
return if $self->errors;
7130c4c1 Jan Büren
my $datev_csv = SL::DATEV::CSV->new(
datev_lines => $self->generate_datev_lines,
from => $self->from,
to => $self->to,
locked => $self->locked,
);

e8f87db4 Jan Büren
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();

324726ac Jan Büren
# 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: $!";

7130c4c1 Jan Büren
$csv->print($csv_file, $_) for @{ $datev_csv->header };
$csv->print($csv_file, $_) for @{ $datev_csv->lines };
e8f87db4 Jan Büren
$csv_file->close;
7130c4c1 Jan Büren
$self->{warnings} = $datev_csv->warnings;
e8f87db4 Jan Büren
3c1390b8 Jan Büren
$self->_create_xml_and_documents if $self->{documents} && %{ $self->{guids} };
ca3b14ff Jan Büren
324726ac Jan Büren
# 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;
}

e8f87db4 Jan Büren
return { download_token => $self->download_token, filenames => $filename };
ef5b4b39 Jan Büren
} else {
die 'unrecognized exporttype';
}

e8f87db4 Jan Büren
return $result;
b14b1780 Geoffrey Richardson
}

631b4c04 Sven Schöling
sub fromto {
my ($self) = @_;
d319704a Moritz Bunkus
631b4c04 Sven Schöling
return unless $self->from && $self->to;
d319704a Moritz Bunkus
631b4c04 Sven Schöling
return "transdate >= '" . $self->from->to_lxoffice . "' and transdate <= '" . $self->to->to_lxoffice . "'";
d319704a Moritz Bunkus
}

e20f3f0d Moritz Bunkus
sub _sign {
631b4c04 Sven Schöling
$_[0] <=> 0;
e20f3f0d Moritz Bunkus
}

1d559eff Jan Büren
sub locked {
my $self = shift;

if (@_) {
$self->{locked} = $_[0];
}
return $self->{locked};
}
c7cff765 Jan Büren
sub imported {
my $self = shift;

if (@_) {
$self->{imported} = $_[0];
}
return $self->{imported};
}
ca3b14ff Jan Büren
sub documents {
my $self = shift;

if (@_) {
$self->{documents} = $_[0];
}
return $self->{documents};
}
sub _create_xml_and_documents {
my $self = shift;

3c1390b8 Jan Büren
die "No guids" unless %{ $self->{guids} };
ca3b14ff Jan Büren
my $today = DateTime->now_local;
my $doc = XML::LibXML::Document->new('1.0', 'utf-8');

my $root = $doc->createElement('archive');
#<archive xmlns="http://xml.datev.de/bedi/tps/document/v05.0" xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xsi:schemaLocation="http://xml.datev.de/bedi/tps/document/v05.0 Document_v050.xsd" version="5.0" generatingSystem="DATEV-Musterdaten">

$root->setAttribute('xmlns' => 'http://xml.datev.de/bedi/tps/document/v05.0');
$root->setAttribute('xmlns:xsi' => 'http://www.w3.org/2001/XMLSchema-instance');
$root->setAttribute('xsi:schemaLocation' => 'http://xml.datev.de/bedi/tps/document/v05.0 Document_v050.xsd');
$root->setAttribute('version' => '5.0');
$root->setAttribute('generatingSystem' => 'kivitendo');

# header with timestamp
my $header_tag = $doc->createElement('header');
$root->appendChild($header_tag);
my $date_tag = $doc->createElement('date');
$date_tag->appendTextNode($today);
$header_tag->appendChild($date_tag);


# content
my $content_node = $doc->createElement('content');
$root->appendChild($content_node);
# we have n document childs
3c1390b8 Jan Büren
foreach my $guid (keys %{ $self->{guids} }) {
ca3b14ff Jan Büren
# 1. get filename and file location
my $file_version = SL::DB::Manager::FileVersion->find_by(guid => $guid);
die "Invalid guid $guid" unless ref $file_version eq 'SL::DB::FileVersion';
# file_name has to be unique add guid if needed
my $filename_for_zip = (exists $self->{files}{$file_version->file_name})
? $file_version->file_name . '__' . $guid
: $file_version->file_name;
3b281141 Jan Büren
$filename_for_zip = $guid . '.pdf';
ca3b14ff Jan Büren
$self->{files}{$filename_for_zip} = $file_version->get_system_location;
# create xml metadata for files
my $document_node = $doc->createElement('document');
# set attr
$document_node->setAttribute('guid' => $guid);
$document_node->setAttribute('processID' => '1');
$document_node->setAttribute('type' => '1');
$content_node->appendChild($document_node);
my $extension_node = $doc->createElement('extension');
$extension_node->setAttribute('xsi:type' => 'File');
$extension_node->setAttribute('name' => $filename_for_zip);
$document_node->appendChild($extension_node);
}
$doc->setDocumentElement($root);

# create Archive::Zip in Export Path
my $zip = Archive::Zip->new();
# add metadata document
$zip->addString($doc->toString(), 'document.xml');
# add real files
foreach my $filename (keys %{ $self->{files} }) {
3b281141 Jan Büren
# my $enc_filename = encode('Windows-1252', $filename);
$zip->addFile($self->{files}{$filename}, $filename);
ca3b14ff Jan Büren
}
die "Cannot write Belege-XML.zip" unless ($zip->writeToFileNamed($self->export_path . 'Belege-XML.zip')
== Archive::Zip::AZ_OK());
}
1d559eff Jan Büren
8b8570b3 Geoffrey Richardson
sub generate_datev_data {
d319704a Moritz Bunkus
$main::lxdebug->enter_sub();
00b6dc22 Sven Schöling
my ($self, %params) = @_;
975304c7 Sven Schöling
my $fromto = $params{from_to} // '';
00b6dc22 Sven Schöling
my $progress_callback = $params{progress_callback} || sub {};
d319704a Moritz Bunkus
ea711360 Moritz Bunkus
my $form = $main::form;
d319704a Moritz Bunkus
e04c32d3 Niclas Zimmermann
my $trans_id_filter = '';
975304c7 Sven Schöling
my $ar_department_id_filter = '';
my $ap_department_id_filter = '';
my $gl_department_id_filter = '';
c0f873c1 Geoffrey Richardson
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 = ? ";
}
e04c32d3 Niclas Zimmermann
1a3b9961 Geoffrey Richardson
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 >= ? ";
d2b58cf5 Sven Schöling
} else {
$gl_itime_filter = "";
$ar_itime_filter = "";
$ap_itime_filter = "";
1a3b9961 Geoffrey Richardson
}

6a349447 Geoffrey Richardson
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;
};
e04c32d3 Niclas Zimmermann
c510d88b Sven Schöling
my ($notsplitindex);
a3501388 Moritz Bunkus
e20f3f0d Moritz Bunkus
my $filter = ''; # Useful for debugging purposes

631b4c04 Sven Schöling
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');
ea711360 Moritz Bunkus
a3a6ec06 Geoffrey Richardson
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";
}
c7cff765 Jan Büren
my $gl_imported;
if ( !$self->imported ) {
$gl_imported = " AND NOT imported";
}
a3a6ec06 Geoffrey Richardson
ea711360 Moritz Bunkus
my $query =
39fc1390 Sven Schöling
qq|SELECT ac.acc_trans_id, ac.transdate, ac.gldate, ac.trans_id,ar.id, ac.amount, ac.taxkey, ac.memo,
142ea3bf Moritz Bunkus
ar.invnumber, ar.duedate, ar.amount as umsatz, COALESCE(ar.tax_point, ar.deliverydate) AS deliverydate, ar.itime::date,
00b6dc22 Sven Schöling
ct.name, ct.ustid, ct.customernumber AS vcnumber, ct.id AS customer_id, NULL AS vendor_id,
a3a6ec06 Geoffrey Richardson
$ar_accno, c.description AS accname, c.taxkey_id as charttax, c.datevautomatik, c.id, ac.chart_link AS link,
9d2d867c Niclas Zimmermann
ar.invoice,
0e1c16fd Sven Schöling
t.rate AS taxrate, t.taxdescription,
ae278b58 Sven Schöling
'ar' as table,
00b6dc22 Sven Schöling
tc.accno AS tax_accno, tc.description AS tax_accname,
c0f873c1 Geoffrey Richardson
ar.department_id,
66bea0e4 Jan Büren
ar.notes,
project.projectnumber as projectnumber, project.description as projectdescription,
department.description as departmentdescription
e20f3f0d Moritz Bunkus
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)
9d2d867c Niclas Zimmermann
LEFT JOIN tax t ON (ac.tax_id = t.id)
00b6dc22 Sven Schöling
LEFT JOIN chart tc ON (t.chart_id = tc.id)
66bea0e4 Jan Büren
LEFT JOIN department ON (department.id = ar.department_id)
LEFT JOIN project ON (project.id = ar.globalproject_id)
e20f3f0d Moritz Bunkus
WHERE (ar.id IS NOT NULL)
AND $fromto
e04c32d3 Niclas Zimmermann
$trans_id_filter
1a3b9961 Geoffrey Richardson
$ar_itime_filter
c0f873c1 Geoffrey Richardson
$ar_department_id_filter
e20f3f0d Moritz Bunkus
$filter
032e5fcd Moritz Bunkus
UNION ALL

39fc1390 Sven Schöling
SELECT ac.acc_trans_id, ac.transdate, ac.gldate, ac.trans_id,ap.id, ac.amount, ac.taxkey, ac.memo,
142ea3bf Moritz Bunkus
ap.invnumber, ap.duedate, ap.amount as umsatz, COALESCE(ap.tax_point, ap.deliverydate) AS deliverydate, ap.itime::date,
00b6dc22 Sven Schöling
ct.name, ct.ustid, ct.vendornumber AS vcnumber, NULL AS customer_id, ct.id AS vendor_id,
a3a6ec06 Geoffrey Richardson
$ap_accno, c.description AS accname, c.taxkey_id as charttax, c.datevautomatik, c.id, ac.chart_link AS link,
9d2d867c Niclas Zimmermann
ap.invoice,
0e1c16fd Sven Schöling
t.rate AS taxrate, t.taxdescription,
ae278b58 Sven Schöling
'ap' as table,
00b6dc22 Sven Schöling
tc.accno AS tax_accno, tc.description AS tax_accname,
c0f873c1 Geoffrey Richardson
ap.department_id,
66bea0e4 Jan Büren
ap.notes,
project.projectnumber as projectnumber, project.description as projectdescription,
department.description as departmentdescription
e20f3f0d Moritz Bunkus
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)
9d2d867c Niclas Zimmermann
LEFT JOIN tax t ON (ac.tax_id = t.id)
00b6dc22 Sven Schöling
LEFT JOIN chart tc ON (t.chart_id = tc.id)
66bea0e4 Jan Büren
LEFT JOIN department ON (department.id = ap.department_id)
LEFT JOIN project ON (project.id = ap.globalproject_id)
e20f3f0d Moritz Bunkus
WHERE (ap.id IS NOT NULL)
AND $fromto
e04c32d3 Niclas Zimmermann
$trans_id_filter
1a3b9961 Geoffrey Richardson
$ap_itime_filter
c0f873c1 Geoffrey Richardson
$ap_department_id_filter
e20f3f0d Moritz Bunkus
$filter
032e5fcd Moritz Bunkus
UNION ALL

39fc1390 Sven Schöling
SELECT ac.acc_trans_id, ac.transdate, ac.gldate, ac.trans_id,gl.id, ac.amount, ac.taxkey, ac.memo,
142ea3bf Moritz Bunkus
gl.reference AS invnumber, NULL AS duedate, ac.amount as umsatz, COALESCE(gl.tax_point, gl.deliverydate) AS deliverydate, gl.itime::date,
00b6dc22 Sven Schöling
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,
9d2d867c Niclas Zimmermann
FALSE AS invoice,
0e1c16fd Sven Schöling
t.rate AS taxrate, t.taxdescription,
ae278b58 Sven Schöling
'gl' as table,
00b6dc22 Sven Schöling
tc.accno AS tax_accno, tc.description AS tax_accname,
c0f873c1 Geoffrey Richardson
gl.department_id,
66bea0e4 Jan Büren
gl.notes,
'' as projectnumber, '' as projectdescription,
department.description as departmentdescription
e20f3f0d Moritz Bunkus
FROM acc_trans ac
LEFT JOIN gl ON (ac.trans_id = gl.id)
LEFT JOIN chart c ON (ac.chart_id = c.id)
9d2d867c Niclas Zimmermann
LEFT JOIN tax t ON (ac.tax_id = t.id)
00b6dc22 Sven Schöling
LEFT JOIN chart tc ON (t.chart_id = tc.id)
66bea0e4 Jan Büren
LEFT JOIN department ON (department.id = gl.department_id)
e20f3f0d Moritz Bunkus
WHERE (gl.id IS NOT NULL)
AND $fromto
e04c32d3 Niclas Zimmermann
$trans_id_filter
1a3b9961 Geoffrey Richardson
$gl_itime_filter
c0f873c1 Geoffrey Richardson
$gl_department_id_filter
c7cff765 Jan Büren
$gl_imported
a44bb343 Jan Büren
AND NOT EXISTS (SELECT gl_id from ap_gl where gl_id = gl.id)
e20f3f0d Moritz Bunkus
$filter
032e5fcd Moritz Bunkus
6ff01fdb Moritz Bunkus
ORDER BY trans_id, acc_trans_id|;
032e5fcd Moritz Bunkus
c0f873c1 Geoffrey Richardson
my @query_args;
1a3b9961 Geoffrey Richardson
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});
}
}
c0f873c1 Geoffrey Richardson
}

my $sth = prepare_execute_query($form, $self->dbh, $query, @query_args);
631b4c04 Sven Schöling
$self->{DATEV} = [];
d319704a Moritz Bunkus
bbd8da97 Moritz Bunkus
my $counter = 0;
6a349447 Geoffrey Richardson
my $continue = 1; #
my $name;
while ( $continue && (my $ref = $sth->fetchrow_hashref("NAME_lc")) ) {
last unless $ref; # for single transactions
43550a3d Stephan Köhler
$counter++;
if (($counter % 500) == 0) {
631b4c04 Sven Schöling
$progress_callback->($counter);
43550a3d Stephan Köhler
}

aea509f8 Moritz Bunkus
my $trans = [ $ref ];
ea711360 Moritz Bunkus
my $count = $ref->{amount};
my $firstrun = 1;
49db7a8e Geoffrey Richardson
# 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
0802cc15 Sven Schöling
my $subcent = abs($count) < 0.02;
ea711360 Moritz Bunkus
49db7a8e Geoffrey Richardson
# 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

# keep fetching new acc_trans lines until the end of a balanced group is reached
1071846d Sven Schöling
while (abs($count) > 0.01 || $firstrun || ($subcent && abs($count) > 0.005)) {
c510d88b Sven Schöling
my $ref2 = $sth->fetchrow_hashref("NAME_lc");
6a349447 Geoffrey Richardson
unless ( $ref2 ) {
$continue = 0;
last;
};
ea711360 Moritz Bunkus
49db7a8e Geoffrey Richardson
# check if trans_id of current acc_trans line is still the same as the
6a349447 Geoffrey Richardson
# 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.
49db7a8e Geoffrey Richardson
e20f3f0d Moritz Bunkus
if ($ref2->{trans_id} != $trans->[0]->{trans_id}) {
6a349447 Geoffrey Richardson
require SL::DB::Manager::AccTransaction;
if ( $trans->[0]->{trans_id} ) {
28fc2476 Sven Schöling
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})
);
6a349447 Geoffrey Richardson
};
631b4c04 Sven Schöling
return;
e20f3f0d Moritz Bunkus
}

aea509f8 Moritz Bunkus
push @{ $trans }, $ref2;
ea711360 Moritz Bunkus
$count += $ref2->{amount};
$firstrun = 0;
d319704a Moritz Bunkus
}
ea711360 Moritz Bunkus
e20f3f0d Moritz Bunkus
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;
}

1422e28a Geoffrey Richardson
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
c1f307ca Jan Büren
&& (_sign($ref->{amount}) == _sign($prev_ref->{amount}))) { # and sign same as previous sign
e20f3f0d Moritz Bunkus
$trans->[$i - 1]->{tax_amount} = $ref->{amount};
}
}

ea711360 Moritz Bunkus
my $absumsatz = 0;
aea509f8 Moritz Bunkus
if (scalar(@{$trans}) <= 2) {
631b4c04 Sven Schöling
push @{ $self->{DATEV} }, $trans;
ea711360 Moritz Bunkus
next;
}

c2796317 Bernd Bleßmann
# determine at which array position the reference value (called absumsatz) is
49db7a8e Geoffrey Richardson
# and which amount it has

aea509f8 Moritz Bunkus
for my $j (0 .. (scalar(@{$trans}) - 1)) {
c2796317 Bernd Bleßmann
49db7a8e Geoffrey Richardson
# Three cases:
# 1: gl transaction (Dialogbuchung), invoice is false, no double split booking allowed

# 2: sales or vendor invoice (Verkaufs- und Einkaufsrechnung): invoice is
# true, instead of absumsatz use link AR/AP (there should only be one
# entry)

# 3. AR/AP transaction (Kreditoren- und Debitorenbuchung): invoice is false,
# instead of absumsatz use link AR/AP (there should only be one, so jump
# out of search as soon as you find it )

# case 1 and 2
1422e28a Geoffrey Richardson
# for gl-bookings no split is allowed and there is no AR/AP account, so we always use the maximum value as a reference
# for ap/ar bookings we can always search for AR/AP in link and use that
if ( ( not $trans->[$j]->{'invoice'} and abs($trans->[$j]->{'amount'}) > abs($absumsatz) )
or ($trans->[$j]->{'invoice'} and ($trans->[$j]->{'link'} eq 'AR' or $trans->[$j]->{'link'} eq 'AP'))) {
aea509f8 Moritz Bunkus
$absumsatz = $trans->[$j]->{'amount'};
ea711360 Moritz Bunkus
$notsplitindex = $j;
d319704a Moritz Bunkus
}
49db7a8e Geoffrey Richardson
# case 3
# Problem: we can't distinguish between AR and AP and normal invoices via boolean "invoice"
# for AR and AP transaction exit the loop as soon as an AR or AP account is found
# there must be only one AR or AP chart in the booking
dd48c9b7 Sven Schöling
# since it is possible to do this kind of things with GL too, make sure those don't get aborted in case someone
# manually pays an invoice in GL.
if ($trans->[$j]->{table} ne 'gl' and ($trans->[$j]->{'link'} eq 'AR' or $trans->[$j]->{'link'} eq 'AP')) {
49db7a8e Geoffrey Richardson
$notsplitindex = $j; # position in booking with highest amount
$absumsatz = $trans->[$j]->{'amount'};
last;
};
ea711360 Moritz Bunkus
}
bbd8da97 Moritz Bunkus
e20f3f0d Moritz Bunkus
my $ml = ($trans->[0]->{'umsatz'} > 0) ? 1 : -1;
my $rounding_error = 0;
bf3b6966 Moritz Bunkus
my @taxed;
e20f3f0d Moritz Bunkus
49db7a8e Geoffrey Richardson
# go through each line and determine if it is a tax booking or not
# skip all tax lines and notsplitindex line
# push all other accounts (e.g. income or expense) with corresponding taxkey

aea509f8 Moritz Bunkus
for my $j (0 .. (scalar(@{$trans}) - 1)) {
ea711360 Moritz Bunkus
if ( ($j != $notsplitindex)
e20f3f0d Moritz Bunkus
&& !$trans->[$j]->{is_tax}
aea509f8 Moritz Bunkus
&& ( $trans->[$j]->{'taxkey'} eq ""
|| $trans->[$j]->{'taxkey'} eq "0"
|| $trans->[$j]->{'taxkey'} eq "1"
|| $trans->[$j]->{'taxkey'} eq "10"
|| $trans->[$j]->{'taxkey'} eq "11")) {
4c5ca4c0 Moritz Bunkus
my %new_trans = ();
map { $new_trans{$_} = $trans->[$notsplitindex]->{$_}; } keys %{ $trans->[$notsplitindex] };
ea711360 Moritz Bunkus
aea509f8 Moritz Bunkus
$absumsatz += $trans->[$j]->{'amount'};
bbd8da97 Moritz Bunkus
$new_trans{'amount'} = $trans->[$j]->{'amount'} * (-1);
$new_trans{'umsatz'} = abs($trans->[$j]->{'amount'}) * $ml;
aea509f8 Moritz Bunkus
$trans->[$j]->{'umsatz'} = abs($trans->[$j]->{'amount'}) * $ml;
ea711360 Moritz Bunkus
631b4c04 Sven Schöling
push @{ $self->{DATEV} }, [ \%new_trans, $trans->[$j] ];
ea711360 Moritz Bunkus
e20f3f0d Moritz Bunkus
} elsif (($j != $notsplitindex) && !$trans->[$j]->{is_tax}) {
ea711360 Moritz Bunkus
4c5ca4c0 Moritz Bunkus
my %new_trans = ();
map { $new_trans{$_} = $trans->[$notsplitindex]->{$_}; } keys %{ $trans->[$notsplitindex] };
ea711360 Moritz Bunkus
9d2d867c Niclas Zimmermann
my $tax_rate = $trans->[$j]->{'taxrate'};
e20f3f0d Moritz Bunkus
$new_trans{'net_amount'} = $trans->[$j]->{'amount'} * -1;
$new_trans{'tax_rate'} = 1 + $tax_rate;
ea711360 Moritz Bunkus
e20f3f0d Moritz Bunkus
if (!$trans->[$j]->{'invoice'}) {
$new_trans{'amount'} = $form->round_amount(-1 * ($trans->[$j]->{amount} + $trans->[$j]->{tax_amount}), 2);
$new_trans{'umsatz'} = abs($new_trans{'amount'}) * $ml;
$trans->[$j]->{'umsatz'} = $new_trans{'umsatz'};
$absumsatz += -1 * $new_trans{'amount'};

} else {
474247d8 Moritz Bunkus
my $unrounded = $trans->[$j]->{'amount'} * (1 + $tax_rate) * -1 + $rounding_error;
e20f3f0d Moritz Bunkus
my $rounded = $form->round_amount($unrounded, 2);
474247d8 Moritz Bunkus
$rounding_error = $unrounded - $rounded;
e20f3f0d Moritz Bunkus
$new_trans{'amount'} = $rounded;
474247d8 Moritz Bunkus
$new_trans{'umsatz'} = abs($rounded) * $ml;
$trans->[$j]->{'umsatz'} = $new_trans{umsatz};
$absumsatz -= $rounded;
e20f3f0d Moritz Bunkus
}

631b4c04 Sven Schöling
push @{ $self->{DATEV} }, [ \%new_trans, $trans->[$j] ];
push @taxed, $self->{DATEV}->[-1];
e20f3f0d Moritz Bunkus
}
}

my $idx = 0;
my $correction = 0;
bf3b6966 Moritz Bunkus
while ((abs($absumsatz) >= 0.01) && (abs($absumsatz) < 1.00)) {
e20f3f0d Moritz Bunkus
if ($idx >= scalar @taxed) {
last if (!$correction);

$correction = 0;
$idx = 0;
d319704a Moritz Bunkus
}
e20f3f0d Moritz Bunkus
my $transaction = $taxed[$idx]->[0];

my $old_amount = $transaction->{amount};
my $old_correction = $correction;
my @possible_diffs;

if (!$transaction->{diff}) {
@possible_diffs = (0.01, -0.01);
} else {
@possible_diffs = ($transaction->{diff});
}

foreach my $diff (@possible_diffs) {
my $net_amount = $form->round_amount(($transaction->{amount} + $diff) / $transaction->{tax_rate}, 2);
next if ($net_amount != $transaction->{net_amount});

$transaction->{diff} = $diff;
$transaction->{amount} += $diff;
$transaction->{umsatz} += $diff;
$absumsatz -= $diff;
$correction = 1;

last;
}

$idx++;
d319704a Moritz Bunkus
}
ea711360 Moritz Bunkus
a3501388 Moritz Bunkus
$absumsatz = $form->round_amount($absumsatz, 2);
if (abs($absumsatz) >= (0.01 * (1 + scalar @taxed))) {
6a349447 Geoffrey Richardson
require SL::DB::Manager::AccTransaction;
my $acc_trans_obj = SL::DB::Manager::AccTransaction->get_first(where => [ trans_id => $trans->[0]->{trans_id} ]);
28fc2476 Sven Schöling
$self->add_error(t8("Export error in transaction #1: Rounding error too large #2",
$acc_trans_obj->transaction_name, $absumsatz)
);
a3501388 Moritz Bunkus
} elsif (abs($absumsatz) >= 0.01) {
631b4c04 Sven Schöling
$self->add_net_gross_differences($absumsatz);
ea711360 Moritz Bunkus
}
d319704a Moritz Bunkus
}
6683b7fb Moritz Bunkus
$sth->finish();

631b4c04 Sven Schöling
$::lxdebug->leave_sub;
d319704a Moritz Bunkus
}

8b8570b3 Geoffrey Richardson
sub generate_datev_lines {
631b4c04 Sven Schöling
my ($self) = @_;

8b8570b3 Geoffrey Richardson
my @datev_lines = ();

foreach my $transaction ( @{ $self->{DATEV} } ) {

# each $transaction entry contains data from several acc_trans entries
# belonging to the same trans_id

my %datev_data = (); # data for one transaction
my $trans_lines = scalar(@{$transaction});

my $umsatz = 0;
my $gegenkonto = "";
my $konto = "";
my $belegfeld1 = "";
my $datum = "";
my $waehrung = "";
my $buchungstext = "";
my $belegfeld2 = "";
my $datevautomatik = 0;
my $taxkey = 0;
my $charttax = 0;
my $ustid ="";
my ($haben, $soll);
for (my $i = 0; $i < $trans_lines; $i++) {
if ($trans_lines == 2) {
if (abs($transaction->[$i]->{'amount'}) > abs($umsatz)) {
$umsatz = $transaction->[$i]->{'amount'};
d319704a Moritz Bunkus
}
8b8570b3 Geoffrey Richardson
} else {
if (abs($transaction->[$i]->{'umsatz'}) > abs($umsatz)) {
$umsatz = $transaction->[$i]->{'umsatz'};
d319704a Moritz Bunkus
}
}
8b8570b3 Geoffrey Richardson
if ($transaction->[$i]->{'datevautomatik'}) {
$datevautomatik = 1;
}
if ($transaction->[$i]->{'taxkey'}) {
$taxkey = $transaction->[$i]->{'taxkey'};
a44bb343 Jan Büren
# $taxkey = 0 if $taxkey == 94; # taxbookings are in gl
8b8570b3 Geoffrey Richardson
}
if ($transaction->[$i]->{'charttax'}) {
$charttax = $transaction->[$i]->{'charttax'};
}
if ($transaction->[$i]->{'amount'} > 0) {
$haben = $i;
} else {
$soll = $i;
}
}
d319704a Moritz Bunkus
8b8570b3 Geoffrey Richardson
if ($trans_lines >= 2) {
3c147670 Geoffrey Richardson
a3a6ec06 Geoffrey Richardson
# Personenkontenerweiterung: accno has already been replaced if use_pk was set
8b8570b3 Geoffrey Richardson
$datev_data{'gegenkonto'} = $transaction->[$haben]->{'accno'};
$datev_data{'konto'} = $transaction->[$soll]->{'accno'};
if ($transaction->[$haben]->{'invnumber'} ne "") {
$datev_data{belegfeld1} = $transaction->[$haben]->{'invnumber'};
d319704a Moritz Bunkus
}
8b8570b3 Geoffrey Richardson
$datev_data{datum} = $transaction->[$haben]->{'transdate'};
$datev_data{waehrung} = 'EUR';
b9e792cc Jan Büren
$datev_data{kost1} = $transaction->[$haben]->{'departmentdescription'};
$datev_data{kost2} = $transaction->[$haben]->{'projectdescription'};
d319704a Moritz Bunkus
8b8570b3 Geoffrey Richardson
if ($transaction->[$haben]->{'name'} ne "") {
$datev_data{buchungstext} = $transaction->[$haben]->{'name'};
}
if (($transaction->[$haben]->{'ustid'} // '') ne "") {
c20ee3de Moritz Bunkus
$datev_data{ustid} = SL::VATIDNr->normalize($transaction->[$haben]->{'ustid'});
d319704a Moritz Bunkus
}
8b8570b3 Geoffrey Richardson
if (($transaction->[$haben]->{'duedate'} // '') ne "") {
$datev_data{belegfeld2} = $transaction->[$haben]->{'duedate'};
}
09a2093d Geoffrey Richardson
# if deliverydate exists, add it to datev export if it is
# * an ar/ap booking that is not a payment
# * a gl booking
if ( ($transaction->[$haben]->{'deliverydate'} // '') ne ''
&& (
( $transaction->[$haben]->{'table'} =~ /^(ar|ap)$/
&& $transaction->[$haben]->{'link'} !~ m/_paid/
&& $transaction->[$soll]->{'link'} !~ m/_paid/
)
|| $transaction->[$haben]->{'table'} eq 'gl'
)
) {
46f028ef Bernd Bleßmann
$datev_data{leistungsdatum} = $transaction->[$haben]->{'deliverydate'};
}
8b8570b3 Geoffrey Richardson
}
$datev_data{umsatz} = abs($umsatz); # sales invoices without tax have a different sign???

# Dies ist die einzige Stelle die datevautomatik auswertet. Was soll gesagt werden?
# Im Prinzip hat jeder acc_trans Eintrag einen Steuerschlüssel, außer, bei gewissen Fällen
# wie: Kreditorenbuchung mit negativen Vorzeichen, SEPA-Export oder Rechnungen die per
# Skript angelegt werden.
# Also falls ein Steuerschlüssel da ist und NICHT datevautomatik diesen Block hinzufügen.
# Oder aber datevautomatik ist WAHR, aber der Steuerschlüssel in der acc_trans weicht
# von dem in der Chart ab: Also wahrscheinlich Programmfehler (NULL übergeben, statt
# DATEV-Steuerschlüssel) oder der Steuerschlüssel des Kontos weicht WIRKLICH von dem Eintrag in der
# acc_trans ab. Gibt es für diesen Fall eine plausiblen Grund?
#

# only set buchungsschluessel if the following conditions are met:
if ( ( $datevautomatik || $taxkey)
&& (!$datevautomatik || ($datevautomatik && ($charttax ne $taxkey)))) {
# $datev_data{buchungsschluessel} = !$datevautomatik ? $taxkey : "4";
$datev_data{buchungsschluessel} = $taxkey;
d319704a Moritz Bunkus
}
e4edba05 Jan Büren
# set lock for each transaction
$datev_data{locked} = $self->locked;
ca3b14ff Jan Büren
# add guids if datev export with documents is requested
6fe0118b Jan Büren
# no records for bank transactions with ar or ap
# die Dumper($transaction->[$haben]->{link}) if $transaction->[$haben]->{link} =~ m/paid/;
if ( $self->documents && ($transaction->[$haben]->{table} eq 'gl'
|| ($datev_data{konto} !~ m/(1810|1370)/ && $datev_data{gegenkonto} !~ m/(1810|1370)/ )) ) {
# add all document links for the latest created/uploaded document
3b281141 Jan Büren
my $latest_document = SL::DB::Manager::File->get_first(query =>
ca3b14ff Jan Büren
[
6fe0118b Jan Büren
object_id => $transaction->[$haben]->{trans_id},
file_type => 'document',
3b281141 Jan Büren
mime_type => 'application/pdf',
6fe0118b Jan Büren
or => [
object_type => 'gl_transaction',
object_type => 'purchase_invoice',
object_type => 'invoice',
object_type => 'credit_note',
],
ca3b14ff Jan Büren
],
sort_by => 'itime DESC');
3b281141 Jan Büren
if (ref $latest_document eq 'SL::DB::File') {
#if (scalar @{ $latest_documents }) {
ca3b14ff Jan Büren
# if we have a booking document add guid from the latest version
6fe0118b Jan Büren
# one record may be referenced to more transaction (credit booking with different accounts)
# therefore collect guids in hash
3b281141 Jan Büren
# not yet implemented -> datev steigt aus, sobald ein komma getrennter wert erscheint
#foreach my $latest_document (@{ $latest_documents }) {
6fe0118b Jan Büren
die "No file datatype:" . ref $latest_document unless (ref $latest_document eq 'SL::DB::File');
267550f0 Bernd Bleßmann
my $latest_guid = $latest_document->file_versions_sorted->[-1]->guid;
6fe0118b Jan Büren
$self->{guids}{$latest_guid} = 1;
$datev_data{document_guid} .= $datev_data{document_guid} ? ',' : '';
$datev_data{document_guid} .= $latest_guid;
3b281141 Jan Büren
# }
ca3b14ff Jan Büren
}
}
3c1390b8 Jan Büren
# keine kommerzbank daten exportieren
next if ($datev_data{konto} eq '1800' || $datev_data{gegenkonto} eq '1800');

c10e2110 Moritz Bunkus
push(@datev_lines, \%datev_data) if $datev_data{umsatz};
8b8570b3 Geoffrey Richardson
}
3c147670 Geoffrey Richardson
8b8570b3 Geoffrey Richardson
# example of modifying export data:
# foreach my $datev_line ( @datev_lines ) {
# if ( $datev_line{"konto"} eq '1234' ) {
# $datev_line{"konto"} = '9999';
# }
# }
#
3c147670 Geoffrey Richardson
8b8570b3 Geoffrey Richardson
return \@datev_lines;
}
3c147670 Geoffrey Richardson
69b298a0 Geoffrey Richardson
sub check_vcnumbers_are_valid_pk_numbers {
my ($self) = @_;

821cc706 Jan Büren
# better use a class variable and set this in sub new (also needed in DATEV::CSV)
# calculation is also a bit more sane in sub check_valid_length_of_accounts
69b298a0 Geoffrey Richardson
my $length_of_accounts = length(SL::DB::Manager::Chart->get_first(where => [charttype => 'A'])->accno) // 4;
my $pk_length = $length_of_accounts + 1;
my $query = <<"SQL";
SELECT customernumber AS vcnumber FROM customer WHERE customernumber !~ '^[[:digit:]]{$pk_length}\$'
UNION
SELECT vendornumber AS vcnumber FROM vendor WHERE vendornumber !~ '^[[:digit:]]{$pk_length}\$'
LIMIT 1;
SQL
my ($has_non_pk_accounts) = selectrow_query($::form, SL::DB->client->dbh, $query);
return defined $has_non_pk_accounts ? 0 : 1;
}

254ef1b2 Jan Büren
sub check_valid_length_of_accounts {
my ($self) = @_;

my $query = <<"SQL";
SELECT DISTINCT char_length (accno) FROM chart WHERE charttype='A' AND id in (select chart_id from acc_trans);
SQL

my $accno_length = selectall_hashref_query($::form, SL::DB->client->dbh, $query);
821cc706 Jan Büren
if (1 < scalar @$accno_length) {
254ef1b2 Jan Büren
$::form->error(t8("Invalid combination of ledger account number length." .
" Mismatch length of #1 with length of #2. Please check your account settings. ",
$accno_length->[0]->{char_length}, $accno_length->[1]->{char_length}));
}
return 1;
}

ca3b14ff Jan Büren
sub check_document_export {
my ($self) = @_;

# no dms enabled and works only for type Filesystem
return 0 unless $::instance_conf->get_doc_storage
&& $::instance_conf->get_doc_storage_for_documents eq 'Filesystem';

return 1;

# TODO maybe needed
# not all last month ar ap gl booking have an entry -> rent ?
my $query = <<"SQL";
select distinct trans_id,object_id from acc_trans
left join files on files.object_id=trans_id
where date_trunc('month', transdate) = date_trunc('month', current_date - interval '1 month')
and object_id is null
LIMIT 1
SQL
my ($booking_has_no_document) = selectrow_query($::form, SL::DB->client->dbh, $query);
return defined $booking_has_no_document ? 0 : 1;

}
3c1390b8 Jan Büren

sub _u8 {
my ($value) = @_;
return encode('UTF-8', $value // '');
}


631b4c04 Sven Schöling
sub DESTROY {
clean_temporary_directories();
d319704a Moritz Bunkus
}

1;
631b4c04 Sven Schöling
__END__

=encoding utf-8

=head1 NAME

008c2e15 Moritz Bunkus
SL::DATEV - kivitendo DATEV Export module
631b4c04 Sven Schöling
=head1 SYNOPSIS

use SL::DATEV qw(:CONSTANTS);

6a349447 Geoffrey Richardson
my $startdate = DateTime->new(year => 2014, month => 9, day => 1);
my $enddate = DateTime->new(year => 2014, month => 9, day => 31);
631b4c04 Sven Schöling
my $datev = SL::DATEV->new(
exporttype => DATEV_ET_BUCHUNGEN,
format => DATEV_FORMAT_KNE,
from => $startdate,
to => $enddate,
);

6a349447 Geoffrey Richardson
# To only export transactions from a specific trans_id: (from and to are ignored)
my $invoice = SL::DB::Manager::Invoice->find_by( invnumber => '216' );
my $datev = SL::DATEV->new(
exporttype => DATEV_ET_BUCHUNGEN,
format => DATEV_FORMAT_KNE,
trans_id => $invoice->trans_id,
);

631b4c04 Sven Schöling
my $datev = SL::DATEV->new(
exporttype => DATEV_ET_STAMM,
format => DATEV_FORMAT_KNE,
accnofrom => $start_account_number,
accnoto => $end_account_number,
);

# get or set datev stamm
my $hashref = $datev->get_datev_stamm;
$datev->save_datev_stamm($hashref);

6a349447 Geoffrey Richardson
# manually clean up temporary directories older than 8 hours
631b4c04 Sven Schöling
$datev->clean_temporary_directories;

# export
$datev->export;

if ($datev->errors) {
die join "\n", $datev->error;
}

# get relevant data for saving the export:
my $dl_token = $datev->download_token;
my $path = $datev->export_path;
my @files = $datev->filenames;

# retrieving an export at a later time
my $datev = SL::DATEV->new(
download_token => $dl_token_from_user,
);

my $path = $datev->export_path;
my @files = glob("$path/*");

8b8570b3 Geoffrey Richardson
# Only test the datev data of a specific trans_id, without generating an
# export file, but filling $datev->errors if errors exist

my $datev = SL::DATEV->new(
trans_id => $invoice->trans_id,
);
$datev->generate_datev_data;
# if ($datev->errors) { ...


631b4c04 Sven Schöling
=head1 DESCRIPTION

This module implements the DATEV export standard. For usage see above.

=head1 FUNCTIONS

=over 4

=item new PARAMS

6a349447 Geoffrey Richardson
Generic constructor. See section attributes for information about what to pass.
631b4c04 Sven Schöling
8b8570b3 Geoffrey Richardson
=item generate_datev_data

Fetches all transactions from the database (via a trans_id or a date range),
and does an initial transformation (e.g. filters out tax, determines
the brutto amount, checks split transactions ...) and stores this data in
$self->{DATEV}.

If any errors are found these are collected in $self->errors.

This function is needed for all the exports, but can be also called
independently in order to check transactions for DATEV compatibility.

=item generate_datev_lines

Parse the data in $self->{DATEV} and transform it into a format that can be
used by DATEV, e.g. determines Konto and Gegenkonto, the taxkey, ...

The transformed data is returned as an arrayref, which is ready to be converted
to a DATEV data format, e.g. KNE, OBE, CSV, ...

At this stage the "DATEV rule" has already been applied to the taxkeys, i.e.
entries with datevautomatik have an empty taxkey, as the taxkey is already
determined by the chart.

631b4c04 Sven Schöling
=item get_datev_stamm

Loads DATEV Stammdaten and returns as hashref.

=item save_datev_stamm HASHREF

Saves DATEV Stammdaten from provided hashref.

=item exporttype

See L<CONSTANTS> for possible values

=item has_exporttype

Returns true if an exporttype has been set. Without exporttype most report functions won't work.

=item format

Specifies the designated format of the export. Currently only KNE export is implemented.

See L<CONSTANTS> for possible values

=item has_format

Returns true if a format has been set. Without format most report functions won't work.

=item download_token

Returns a download token for this DATEV object.

Note: If either a download_token or export_path were set at the creation these are infered, otherwise randomly generated.

=item export_path

Returns an export_path for this DATEV object.

Note: If either a download_token or export_path were set at the creation these are infered, otherwise randomly generated.

=item filenames

6a349447 Geoffrey Richardson
Returns a list of filenames generated by this DATEV object. This only works if the files were generated during its lifetime, not if the object was created from a download_token.
631b4c04 Sven Schöling
=item net_gross_differences

If there were any net gross differences during calculation they will be collected here.

=item sum_net_gross_differences

Sum of all differences.

=item clean_temporary_directories

Forces a garbage collection on previous exports which will delete all exports that are older than 8 hours. It will be automatically called on destruction of the object, but is advised to be called manually before delivering results of an export to the user.

=item errors

37f2ab4d Geoffrey Richardson
Returns a list of errors that occurred. If no errors occurred, the export was a success.
631b4c04 Sven Schöling
=item export

Exports data. You have to have set L<exporttype> and L<format> or an error will
occur. OBE exports are currently not implemented.

be4e1d78 Geoffrey Richardson
=item csv_export_for_tax_accountant

Generates up to four downloadable csv files containing data about sales and
purchase invoices, and their respective payments:

Example:
my $startdate = DateTime->new(year => 2012, month => 1, day => 1);
my $enddate = DateTime->new(year => 2012, month => 12, day => 31);
SL::DATEV->new(from => $startdate, to => $enddate)->csv_export_for_tax_accountant;
# {
# 'download_token' => '1488551625-815654-22430',
# 'filenames' => [
# 'Zahlungen Kreditorenbuchungen 2012-01-01 - 2012-12-31.csv',
# 'Kreditorenbuchungen 2012-01-01 - 2012-12-31.csv',
# 'Zahlungen Debitorenbuchungen 2012-01-01 - 2012-12-31.csv',
# 'Debitorenbuchungen 2012-01-01 - 2012-12-31.csv'
# ]
# };

ef5b4b39 Jan Büren
69b298a0 Geoffrey Richardson
=item check_vcnumbers_are_valid_pk_numbers

Returns 1 if all vcnumbers are suitable for the DATEV export, 0 if not.

Finds the default length of charts (e.g. 4), adds 1 for the pk chart length
(e.g. 5), and checks the database for any customers or vendors whose customer-
or vendornumber doesn't consist of only numbers with exactly that length. E.g.
for a chart length of four "10001" would be ok, but not "10001b" or "1000".

All vcnumbers are checked, obsolete customers or vendors aren't exempt.

There is also no check for the typical customer range 10000-69999 and the
typical vendor range 70000-99999.
ef5b4b39 Jan Büren
254ef1b2 Jan Büren
=item check_valid_length_of_accounts

Returns 1 if all currently booked accounts have only one common number length domain (e.g. 4 or 6).
Will throw an error if more than one distinct size is detected.
The error message gives a short hint with the value of the (at least)
two mismatching number length domains.
53b300ce Jan Büren
631b4c04 Sven Schöling
=back

=head1 ATTRIBUTES

This is a list of attributes set in either the C<new> or a method of the same name.

=over 4

=item dbh

Set a database handle to use in the process. This allows for an export to be
done on a transaction in progress without committing first.

040aa711 Sven Schöling
Note: If you don't want this code to commit, simply providing a dbh is not
enough enymore. You'll have to wrap the call into a transaction yourself, so
that the internal transaction does not commit.

631b4c04 Sven Schöling
=item exporttype

See L<CONSTANTS> for possible values. This MUST be set before export is called.

=item format

See L<CONSTANTS> for possible values. This MUST be set before export is called.

=item download_token

Can be set on creation to retrieve a prior export for download.

=item from

=item to

6a349447 Geoffrey Richardson
Set boundary dates for the export. Unless a trans_id is passed these MUST be
set for the export to work.

=item trans_id

To check only one gl/ar/ap transaction, pass the trans_id. The attributes
L<from> and L<to> are currently still needed for the query to be assembled
correctly.
631b4c04 Sven Schöling
=item accnofrom

=item accnoto

Set boundary account numbers for the export. Only useful for a stammdaten export.

1d559eff Jan Büren
=item locked

Boolean if the transactions are locked (read-only in kivitenod) or not.
Default value is false

631b4c04 Sven Schöling
=back

=head1 CONSTANTS

=head2 Supplied to L<exporttype>

=over 4

=item DATEV_ET_BUCHUNGEN

=item DATEV_ET_STAMM

=back

=head2 Supplied to L<format>.

=over 4

=item DATEV_FORMAT_KNE

=item DATEV_FORMAT_OBE

=back

=head1 ERROR HANDLING

This module will die in the following cases:

=over 4

=item *

No or unrecognized exporttype or format was provided for an export

=item *

6a349447 Geoffrey Richardson
OBE export was called, which is not yet implemented.
631b4c04 Sven Schöling
=item *

general I/O errors

=back

Errors that occur during th actual export will be collected in L<errors>. The following types can occur at the moment:

=over 4

=item *

C<Unbalanced Ledger!>. Exactly that, your ledger is unbalanced. Should never occur.

=item *

C<Datev-Export fehlgeschlagen! Bei Transaktion %d (%f).> This error occurs if a
6a349447 Geoffrey Richardson
transaction could not be reliably sorted out, or had rounding errors above the acceptable threshold.
631b4c04 Sven Schöling
=back

=head1 BUGS AND CAVEATS

=over 4

=item *

6a349447 Geoffrey Richardson
Handling of Vollvorlauf is currently not fully implemented. You must provide both from and to in order to get a working export.
631b4c04 Sven Schöling
=item *

OBE export is currently not implemented.

=back

=head1 TODO

- handling of export_path and download token is a bit dodgy, clean that up.

=head1 SEE ALSO

L<SL::DATEV::KNEFile>
ef5b4b39 Jan Büren
L<SL::DATEV::CSV>
631b4c04 Sven Schöling
=head1 AUTHORS

Philip Reetz E<lt>p.reetz@linet-services.deE<gt>,

Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>,

Jan Büren E<lt>jan@lx-office-hosting.deE<gt>,

Geoffrey Richardson E<lt>information@lx-office-hosting.deE<gt>,

Sven Schöling E<lt>s.schoeling@linet-services.deE<gt>,

Stephan Köhler

=cut