DATEV::CSV Bessere wartbarer Aufruf für _format_amount

[mfinanz.git] / SL / DATEV / CSV.pm

diff --git a/SL/DATEV/CSV.pm b/SL/DATEV/CSV.pm
index 4dfa06b35fd77fce309fd43ecd7ba9f7b7b63340..4a5fb9e2326b9c057f2a15e21438b3168b9f41f8 100644 (file)
--- a/SL/DATEV/CSV.pm
+++ b/SL/DATEV/CSV.pm
@@ -4,9 +4,12 @@ use strict;
 
 use SL::Locale::String qw(t8);
 use SL::DB::Datev;
 
 use SL::Locale::String qw(t8);
 use SL::DB::Datev;

+use SL::Helper::DateTime;

 
 use Carp;
 use DateTime;
 
 use Carp;
 use DateTime;

+use Encode qw(decode);
+use Scalar::Util qw(looks_like_number);

 
 
 my @kivitendo_to_datev = (
 
 
 my @kivitendo_to_datev = (


@@ -15,32 +18,42 @@ my @kivitendo_to_datev = (
                               csv_header_name => t8('Transaction Value'),
                               max_length      => 13,
                               type            => 'Value',
                               csv_header_name => t8('Transaction Value'),
                               max_length      => 13,
                               type            => 'Value',

-                              valid_check     => sub { return (shift =~ m/^\d{1,10}(\,\d{1,2})?$/) },
+                              required        => 1,
+                              input_check     => sub { my ($input) = @_; return (looks_like_number($input) && length($input) <= 13) },
+                              formatter       => \&_format_amount,
+                              valid_check     => sub { my ($check) = @_; return ($check =~ m/^\d{1,10}(\,\d{1,2})?$/) },

                             },
                             {
                               kivi_datev_name => 'soll_haben_kennzeichen',
                               csv_header_name => t8('Debit/Credit Label'),
                               max_length      => 1,
                               type            => 'Text',
                             },
                             {
                               kivi_datev_name => 'soll_haben_kennzeichen',
                               csv_header_name => t8('Debit/Credit Label'),
                               max_length      => 1,
                               type            => 'Text',

-                              valid_check     => sub { return (shift =~ m/^(S|H)$/) },
+                              required        => 1,
+                              default         => 'S',
+                              input_check     => sub { my ($check) = @_; return ($check =~ m/^(S|H)$/) },
+                              formatter       => sub { my ($input) = @_; return $input eq 'H' ? 'H' : 'S' },
+                              valid_check     => sub { my ($check) = @_; return ($check =~ m/^(S|H)$/) },

                             },
                             {
                               kivi_datev_name => 'waehrung',
                               csv_header_name => t8('Transaction Value Currency Code'),
                               max_length      => 3,
                               type            => 'Text',
                             },
                             {
                               kivi_datev_name => 'waehrung',
                               csv_header_name => t8('Transaction Value Currency Code'),
                               max_length      => 3,
                               type            => 'Text',

-                              valid_check     => sub { return (shift =~ m/^[A-Z]{3}$/) },
+                              default         => '',
+                              input_check     => sub { my ($check) = @_; return ($check eq '' || $check =~ m/^[A-Z]{3}$/) },
+                              valid_check     => sub { my ($check) = @_; return ($check =~ m/^[A-Z]{3}$/) },

                             },
                             {
                               kivi_datev_name => 'wechselkurs',
                               csv_header_name => t8('Exchange Rate'),
                               max_length      => 11,
                               type            => 'Number',
                             },
                             {
                               kivi_datev_name => 'wechselkurs',
                               csv_header_name => t8('Exchange Rate'),
                               max_length      => 11,
                               type            => 'Number',

-                              valid_check     => sub { return (shift =~ m/^[0-9]*\.?[0-9]*$/) },
+                              default         => '',
+                              valid_check     => sub { my ($check) = @_; return ($check =~ m/^[0-9]*\.?[0-9]*$/) },

                             },
                             {
                               kivi_datev_name => 'not yet implemented',
                             },
                             {
                               kivi_datev_name => 'not yet implemented',

-                              csv_header_name => t8('Base Transaction Value'),
+                              sv_header_name => t8('Base Transaction Value'),

                             },
                             {
                               kivi_datev_name => 'not yet implemented',
                             },
                             {
                               kivi_datev_name => 'not yet implemented',


@@ -49,44 +62,53 @@ my @kivitendo_to_datev = (
                             {
                               kivi_datev_name => 'konto',
                               csv_header_name => t8('Account'),
                             {
                               kivi_datev_name => 'konto',
                               csv_header_name => t8('Account'),

-                              max_length      => 9, # May contain a maximum of 8 or 9 digits -> perldoc
+                              max_length      => 9,

                               type            => 'Account',
                               type            => 'Account',

-                              valid_check     => sub { return (shift =~ m/^[0-9]{4,9}$/) },
+                              required        => 1,
+                              input_check     => sub { my ($check) = @_; return ($check =~ m/^[0-9]{4,9}$/) },

                             },
                             {
                               kivi_datev_name => 'gegenkonto',
                               csv_header_name => t8('Contra Account'),
                             },
                             {
                               kivi_datev_name => 'gegenkonto',
                               csv_header_name => t8('Contra Account'),

-                              max_length      => 9, # May contain a maximum of 8 or 9 digits -> perldoc
+                              max_length      => 9,

                               type            => 'Account',
                               type            => 'Account',

-                              valid_check     => sub { return (shift =~ m/^[0-9]{4,9}$/) },
+                              required        => 1,
+                              input_check     => sub { my ($check) = @_; return ($check =~ m/^[0-9]{4,9}$/) },

                             },
                             {
                               kivi_datev_name => 'buchungsschluessel',
                               csv_header_name => t8('Posting Key'),
                               max_length      => 2,
                               type            => 'Text',
                             },
                             {
                               kivi_datev_name => 'buchungsschluessel',
                               csv_header_name => t8('Posting Key'),
                               max_length      => 2,
                               type            => 'Text',

-                              valid_check     => sub { return (shift =~ m/^[0-9]{0,2}$/) },
+                              default         => '',
+                              input_check     => sub { my ($check) = @_; return ($check =~ m/^[0-9]{0,2}$/) },

                             },
                             {
                               kivi_datev_name => 'datum',
                               csv_header_name => t8('Invoice Date'),
                               max_length      => 4,
                               type            => 'Date',
                             },
                             {
                               kivi_datev_name => 'datum',
                               csv_header_name => t8('Invoice Date'),
                               max_length      => 4,
                               type            => 'Date',

-                              valid_check     => sub { return (shift =~ m/^[0-9]{4}$/) },
+                              required        => 1,
+                              input_check     => sub { my ($check) = @_; return (ref (DateTime->from_kivitendo($check)) eq 'DateTime') },
+                              formatter       => sub { my ($input) = @_; return DateTime->from_kivitendo($input)->strftime('%d%m') },
+                              valid_check     => sub { my ($check) = @_; return ($check =~ m/^[0-9]{4}$/) },

                             },
                             {
                               kivi_datev_name => 'belegfeld1',
                               csv_header_name => t8('Invoice Field 1'),
                               max_length      => 12,
                               type            => 'Text',
                             },
                             {
                               kivi_datev_name => 'belegfeld1',
                               csv_header_name => t8('Invoice Field 1'),
                               max_length      => 12,
                               type            => 'Text',

-                              valid_check     => sub { my $text = shift; check_encoding($text); },
+                              default         => '',
+                              input_check     => sub { my ($text) = @_; check_encoding($text); },
+                              formatter       => sub { my ($input) = @_; return substr($input, 0, 12) },

                             },
                             {
                               kivi_datev_name => 'not yet implemented',
                               csv_header_name => t8('Invoice Field 2'),
                             },
                             {
                               kivi_datev_name => 'not yet implemented',
                               csv_header_name => t8('Invoice Field 2'),

-                             max_length      => 12,
+                              max_length      => 12,

                               type            => 'Text',
                               type            => 'Text',

-                              valid_check     => sub { return (shift =~ m/[ -~]{1,12}/) },
+                              default         => '',
+                              valid_check     => sub { my ($check) = @_; return ($check =~ m/[ -~]{1,12}/) },

                             },
                             {
                               kivi_datev_name => 'not yet implemented',
                             },
                             {
                               kivi_datev_name => 'not yet implemented',


@@ -98,7 +120,9 @@ my @kivitendo_to_datev = (
                               csv_header_name => t8('Posting Text'),
                               max_length      => 60,
                               type            => 'Text',
                               csv_header_name => t8('Posting Text'),
                               max_length      => 60,
                               type            => 'Text',

-                              valid_check     => sub { my $text = shift; return 1 unless $text; check_encoding($text);  },
+                              default         => '',
+                              input_check     => sub { my ($text) = @_; return 1 unless $text; check_encoding($text);  },
+                              formatter       => sub { my ($input) = @_; return substr($input, 0, 60) },

                             },  # pos 14
                             {
                               kivi_datev_name => 'not yet implemented',
                             },  # pos 14
                             {
                               kivi_datev_name => 'not yet implemented',


@@ -175,39 +199,64 @@ my @kivitendo_to_datev = (
                               csv_header_name => t8('Cost Center'),
                               max_length      => 8,
                               type            => 'Text',
                               csv_header_name => t8('Cost Center'),
                               max_length      => 8,
                               type            => 'Text',

-                              valid_check     => sub { my $text = shift; return 1 unless $text; check_encoding($text);  },
+                              default         => '',
+                              input_check     => sub { my ($text) = @_; return 1 unless $text; check_encoding($text);  },
+                              formatter       => sub { my ($input) = @_; return substr($input, 0, 8) },

                             }, # pos 37
                             {
                               kivi_datev_name => 'kost2',
                               csv_header_name => t8('Cost Center'),
                               max_length      => 8,
                               type            => 'Text',
                             }, # pos 37
                             {
                               kivi_datev_name => 'kost2',
                               csv_header_name => t8('Cost Center'),
                               max_length      => 8,
                               type            => 'Text',

-                              valid_check     => sub { my $text = shift; return 1 unless $text; check_encoding($text);  },
+                              default         => '',
+                              input_check     => sub { my ($text) = @_; return 1 unless $text; check_encoding($text);  },
+                              formatter       => sub { my ($input) = @_; return substr($input, 0, 8) },

                             }, # pos 38
                             {
                               kivi_datev_name => 'not yet implemented',
                               csv_header_name => t8('KOST Quantity'),
                               max_length      => 9,
                               type            => 'Number',
                             }, # pos 38
                             {
                               kivi_datev_name => 'not yet implemented',
                               csv_header_name => t8('KOST Quantity'),
                               max_length      => 9,
                               type            => 'Number',

-                              valid_check     => sub { return (shift =~ m/^[0-9]{0,9}$/) },
+                              valid_check     => sub { my ($check) = @_; return ($check =~ m/^[0-9]{0,9}$/) },

                             }, # pos 39
                             {
                               kivi_datev_name => 'ustid',
                               csv_header_name => t8('EU Member State and VAT ID Number'),
                               max_length      => 15,
                               type            => 'Text',
                             }, # pos 39
                             {
                               kivi_datev_name => 'ustid',
                               csv_header_name => t8('EU Member State and VAT ID Number'),
                               max_length      => 15,
                               type            => 'Text',

+                              default         => '',
+                              input_check     => sub { my ($check) = @_; return ($check eq '' || $check =~ m/[A-Z]{2}\w{5,13}/) },
+                              formatter       => sub { my ($input) = @_; return ($input =~ s/\s//g) },

                               valid_check     => sub {
                               valid_check     => sub {

-                                                       my $ustid = shift;
-                                                       return 1 unless defined($ustid);
+                                                       my ($ustid) = @_;
+                                                       return 1 if ('' eq $ustid);

                                                        return ($ustid =~ m/^CH|^[A-Z]{2}\w{5,13}$/);
                                                      },
                             }, # pos 40
   );
 
                                                        return ($ustid =~ m/^CH|^[A-Z]{2}\w{5,13}$/);
                                                      },
                             }, # pos 40
   );
 

+sub new {
+  my $class = shift;
+  my %data  = @_;
+
+  my $obj = bless {}, $class;
+
+  croak(t8('We need a valid from date'))      unless (ref $data{from} eq 'DateTime');
+  croak(t8('We need a valid to date'))        unless (ref $data{to}   eq 'DateTime');
+  croak(t8('We need a array of datev_lines')) unless (ref $data{datev_lines} eq 'ARRAY');
+
+  # TODO no params here, better class variables/values
+  return _csv_buchungsexport(from        => $data{from},
+                             to          => $data{to},
+                             datev_lines => $data{datev_lines},
+                             locked      => $data{locked},
+                            );
+
+  $obj;
+}
+

 sub check_encoding {
 sub check_encoding {

-  use Encode qw( decode );
-  # counter test: arabic doesnt work: ݐ
-  my $test = shift;
+  my ($test) = @_;

   return undef unless $test;
   if (eval {
     decode('Windows-1252', $test, Encode::FB_CROAK|Encode::LEAVE_SRC);
   return undef unless $test;
   if (eval {
     decode('Windows-1252', $test, Encode::FB_CROAK|Encode::LEAVE_SRC);


@@ -217,23 +266,24 @@ sub check_encoding {
   }
 }
 
   }
 }
 

-sub kivitendo_to_datev {
-  my $self = shift;
+sub _kivitendo_to_datev {
+  my ($self) = @_;

 
   my $entries = scalar (@kivitendo_to_datev);
   push @kivitendo_to_datev, { kivi_datev_name => 'not yet implemented' } for 1 .. (116 - $entries);
   return @kivitendo_to_datev;
 }
 
 
   my $entries = scalar (@kivitendo_to_datev);
   push @kivitendo_to_datev, { kivi_datev_name => 'not yet implemented' } for 1 .. (116 - $entries);
   return @kivitendo_to_datev;
 }
 

-sub generate_csv_header {
-  my ($self, %params)   = @_;
+sub _generate_csv_header {
+  my %params  = @_;

 
   # we need from and to in YYYYDDMM
 
   # we need from and to in YYYYDDMM

-  croak "Wrong format for from" unless $params{from} =~ m/^[0-9]{8}$/;
-  croak "Wrong format for to"   unless $params{to} =~ m/^[0-9]{8}$/;
+  croak "Wrong format for from $params{from}" unless $params{from} =~ m/^[0-9]{8}$/;
+  croak "Wrong format for to $params{to}"     unless $params{to} =~ m/^[0-9]{8}$/;

 
   # who knows if we want locking and when our fiscal year starts
 
   # who knows if we want locking and when our fiscal year starts

-  croak "Wrong state of locking"      unless $params{locked} =~ m/(0|1)/;
+  # croak "Wrong state of locking"      unless $params{locked} =~ m/^(0|1)$/;
+  my $locked = defined($params{locked}) ? 1 : 0;

   croak "No startdate of fiscal year" unless $params{first_day_of_fiscal_year} =~ m/^[0-9]{8}$/;
 
 
   croak "No startdate of fiscal year" unless $params{first_day_of_fiscal_year} =~ m/^[0-9]{8}$/;
 
 


@@ -254,6 +304,7 @@ sub generate_csv_header {
   my $datev = SL::DB::Manager::Datev->get_first();
 
   while (my ($k, $v) = each %meta_datev_to_valid_length) {
   my $datev = SL::DB::Manager::Datev->get_first();
 
   while (my ($k, $v) = each %meta_datev_to_valid_length) {

+    next unless $datev->{$k};

     $meta_datev{$k} = substr $datev->{$k}, 0, $v;
   }
 
     $meta_datev{$k} = substr $datev->{$k}, 0, $v;
   }
 


@@ -261,12 +312,76 @@ sub generate_csv_header {
     "EXTF", "300", 21, "Buchungsstapel", 7, $created_on, "", "ki",
     "kivitendo-datev", "", $meta_datev{beraternr}, $meta_datev{mandantennr},
     $params{first_day_of_fiscal_year}, $length_of_accounts,
     "EXTF", "300", 21, "Buchungsstapel", 7, $created_on, "", "ki",
     "kivitendo-datev", "", $meta_datev{beraternr}, $meta_datev{mandantennr},
     $params{first_day_of_fiscal_year}, $length_of_accounts,

-    $params{from}, $params{to}, "", "", 1, "", $params{locked},
+    $params{from}, $params{to}, "", "", 1, "", $locked,

     $default_curr, "", "", "",""
   );
 
   return @header;
 }
     $default_curr, "", "", "",""
   );
 
   return @header;
 }

+
+sub _csv_buchungsexport {
+  my %params = @_;
+
+  my @csv_columns = _kivitendo_to_datev();
+  my @csv_headers = _generate_csv_header(
+                      from                     => $params{from}->ymd(''),
+                      to                       => $params{to}->ymd(''),
+                      first_day_of_fiscal_year => $params{to}->year . '0101',
+                      locked                   => $params{locked}
+                    );
+
+  my @array_of_datev;
+
+  # 2 Headers
+  push @array_of_datev, \@csv_headers;
+  push @array_of_datev, [ map { $_->{csv_header_name} } @csv_columns ];
+
+  my @warnings;
+  foreach my $row (@{ $params{datev_lines} }) {
+    my @current_datev_row;
+
+    # 1. check all datev_lines and see if we have a defined value
+    # 2. if we don't have a defined value set a default if exists
+    # 3. otherwise die
+    foreach my $column (@csv_columns) {
+      if ($column->{kivi_datev_name} eq 'not yet implemented') {
+        push @current_datev_row, '';
+        next;
+      }
+      my $data = $row->{$column->{kivi_datev_name}};
+      if (!defined $data) {
+        if (defined $column->{default}) {
+          $data = $column->{default};
+        } else {
+           die 'No sensible value or a sensible default found for the entry: ' . $column->{kivi_datev_name};
+        }
+      }
+      # checkpoint a: no undefined data. All strict checks now!
+      if (exists $column->{input_check}) {
+        die t8("Wrong field value '#1' for field '#2' for the transaction with amount '#3'",
+                $data, $column->{kivi_datev_name}, $row->{umsatz})
+          unless  $column->{input_check}->($data);
+      }
+      # checkpoint b: we can safely format the input
+      if ($column->{formatter}) {
+        $data = $column->{formatter}->($data);
+      }
+      # checkpoint c: all soft checks now, will pop up as a user warning
+      if (exists $column->{valid_check} && !$column->{valid_check}->($data)) {
+        push @warnings, t8("Wrong field value '#1' for field '#2' for the transaction" .
+                           " with amount '#3'", $data, $column->{kivi_datev_name}, $row->{umsatz});
+      }
+      push @current_datev_row, $data;
+    }
+    push @array_of_datev, \@current_datev_row;
+  }
+  return (\@array_of_datev, \@warnings);
+}
+
+sub _format_amount {
+  $::form->format_amount({ numberformat => '1000,00' }, @_);
+}
+

 1;
 
 __END__
 1;
 
 __END__


@@ -279,6 +394,27 @@ SL::DATEV::CSV - kivitendo DATEV CSV Specification
 
 =head1 SYNOPSIS
 
 
 =head1 SYNOPSIS
 

+  use SL::DATEV qw(:CONSTANTS);
+  use SL::DATEV::CSV;
+
+  my $startdate = DateTime->new(year => 2014, month => 9, day => 1);
+  my $enddate   = DateTime->new(year => 2014, month => 9, day => 31);
+  my $datev = SL::DATEV->new(
+    exporttype => DATEV_ET_BUCHUNGEN,
+    format     => DATEV_FORMAT_CSV,
+    from       => $startdate,
+    to         => $enddate,
+  );
+  $datev->generate_datev_data;
+
+  my $datev_ref = SL::DATEV::CSV->new(datev_lines  => $datev->generate_datev_lines,
+                                      from         => $datev->from,
+                                      to           => $datev->to,
+                                      locked       => $datev->locked,
+                                     );
+
+=head1 DESCRIPTION
+

 The parsing of the DATEV CSV is index based, therefore the correct
 column must be present at the corresponding index, i.e.:
  Index 2
 The parsing of the DATEV CSV is index based, therefore the correct
 column must be present at the corresponding index, i.e.:
  Index 2


@@ -344,9 +480,15 @@ Line 3 - n:  must contain 116 fields, a smaller subset is mandatory.
 
 =over 4
 
 
 =over 4
 

+=item new PARAMS
+
+Constructor for CSV-DATEV export.
+Checks mandantory params as described in section synopsis.
+

 =item check_encoding
 
 Helper function, returns true if a string is not empty and cp1252 encoded
 =item check_encoding
 
 Helper function, returns true if a string is not empty and cp1252 encoded

+For example some arabic utf-8 like  ݐ  will return false

 
 =item generate_csv_header(from => 'YYYYDDMM', to => 'YYYYDDMM', locked => 0,
                           first_day_of_fiscal_year => 'YYYYDDMM')
 
 =item generate_csv_header(from => 'YYYYDDMM', to => 'YYYYDDMM', locked => 0,
                           first_day_of_fiscal_year => 'YYYYDDMM')


@@ -361,11 +503,35 @@ All params are mandatory:
 C<params{from}>,  C<params{to}>
 and C<params{first_day_of_fiscal_year}> have to be in YYYYDDMM date string
 format.
 C<params{from}>,  C<params{to}>
 and C<params{first_day_of_fiscal_year}> have to be in YYYYDDMM date string
 format.

-Furthermore C<params{locked}> needs to be a boolean in number format (0|1).
+Furthermore C<params{locked}> is a perlish boolean.

 
 
 =item kivitendo_to_datev
 
 Returns the data structure C<@datev_data> as an array
 
 
 
 =item kivitendo_to_datev
 
 Returns the data structure C<@datev_data> as an array
 

+=item _format_amount
+
+Lightweight wrapper for form->format_amount.
+Expects a number in kivitendo database format and returns the same number
+in DATEV format.
+
+=item _csv_buchungsexport
+
+Generates the CSV-Format data for the CSV DATEV export and returns
+an 2-dimensional array as an array_ref.
+May additionally return a second array_ref with warnings.
+
+Requires the same date fields as the constructor for a valid DATEV header.
+
+Furthermore we assume that the first day of the fiscal year is
+the first of January and we cannot guarantee that our data in kivitendo
+is locked, that means a booking cannot be modified after a defined (vat tax)
+period.
+Some validity checks (max_length and regex) will be done if the
+data structure contains them and the field is defined.
+
+To add or alter the structure of the data take a look at the C<@kivitendo_to_datev> structure.
+
+

 =back
 =back