IBAN-Validierung bei Kunden-/Lieferantenstammdaten sowie bei Bankkonten
authorMoritz Bunkus <m.bunkus@linet-services.de>
Wed, 3 Feb 2016 09:33:41 +0000 (10:33 +0100)
committerMoritz Bunkus <m.bunkus@linet-services.de>
Wed, 3 Feb 2016 09:36:27 +0000 (10:36 +0100)
SL/DB/BankAccount.pm
SL/DB/Customer.pm
SL/DB/Helper/IBANValidation.pm [new file with mode: 0644]
SL/DB/Vendor.pm
SL/InstallationCheck.pm
doc/UPGRADE
doc/changelog
locale/de/all

index 5f4a3e4..fba783c 100644 (file)
@@ -1,6 +1,3 @@
-# This file has been auto-generated only because it didn't exist.
-# Feel free to modify it at will; it will not be overwritten automatically.
-
 package SL::DB::BankAccount;
 
 use strict;
@@ -8,6 +5,7 @@ use strict;
 use SL::DB::MetaSetup::BankAccount;
 use SL::DB::Manager::BankAccount;
 use SL::DB::Helper::ActsAsList;
+use SL::DB::Helper::IBANValidation;
 
 __PACKAGE__->meta->initialize;
 
@@ -39,6 +37,7 @@ sub validate {
   };
 
   push @errors, $::locale->text('The IBAN is missing.') unless $self->{iban};
+  push @errors, $self->validate_ibans;
 
   return @errors;
 }
index 048db7c..7a040ed 100644 (file)
@@ -6,6 +6,7 @@ use Rose::DB::Object::Helpers qw(as_tree);
 
 use SL::DB::MetaSetup::Customer;
 use SL::DB::Manager::Customer;
+use SL::DB::Helper::IBANValidation;
 use SL::DB::Helper::TransNumberGenerator;
 use SL::DB::Helper::CustomVariables (
   module      => 'CT',
@@ -46,6 +47,7 @@ sub validate {
 
   my @errors;
   push @errors, $::locale->text('The customer name is missing.') if !$self->name;
+  push @errors, $self->validate_ibans;
 
   return @errors;
 }
diff --git a/SL/DB/Helper/IBANValidation.pm b/SL/DB/Helper/IBANValidation.pm
new file mode 100644 (file)
index 0000000..651b2e6
--- /dev/null
@@ -0,0 +1,121 @@
+package SL::DB::Helper::IBANValidation;
+
+use strict;
+
+use Algorithm::CheckDigits ();
+use Carp;
+use SL::Locale::String qw(t8);
+
+my $_validater;
+my %_countries = (
+  AT => { len => 20, name => t8('Austria') },
+  BE => { len => 16, name => t8('Belgium') },
+  CH => { len => 21, name => t8('Switzerland') },
+  CZ => { len => 24, name => t8('Czech Republic') },
+  DE => { len => 22, name => t8('Germany') },
+  DK => { len => 18, name => t8('Denmark') },
+  FR => { len => 27, name => t8('France') },
+  IT => { len => 27, name => t8('Italy') },
+  LU => { len => 20, name => t8('Luxembourg') },
+  NL => { len => 18, name => t8('Netherlands') },
+  PL => { len => 28, name => t8('Poland') },
+);
+
+sub _validate {
+  my ($self, $attribute) = @_;
+
+  my $iban =  $self->$attribute // '';
+  $iban    =~ s{\s+}{}g;
+
+  return () unless length($iban);
+
+  $_validater //= Algorithm::CheckDigits::CheckDigits('iban');
+
+  return ($::locale->text("The value '#1' is not a valid IBAN.", $iban)) if !$_validater->is_valid($iban);
+
+  my $country = $_countries{substr($iban, 0, 2)};
+
+  return () if !$country || (length($iban) == $country->{len});
+
+  return ($::locale->text("The IBAN '#1' is not valid as IBANs in #2 must be exactly #3 characters long.", $iban, $country->{name}, $country->{len}));
+}
+
+sub import {
+  my ($package, @attributes) = @_;
+
+  my $caller_package         = caller;
+  @attributes                = qw(iban) unless @attributes;
+
+  no strict 'refs';
+
+  *{ $caller_package . '::validate_ibans' } = sub {
+    my ($self) = @_;
+
+    return map { SL::DB::Helper::IBANValidation::_validate($self, $_) } @attributes;
+  };
+}
+
+1;
+
+__END__
+
+=pod
+
+=encoding utf8
+
+=head1 NAME
+
+SL::DB::Helper::IBANValidation - Mixin for validating IBAN attributes
+
+=head1 SYNOPSIS
+
+  package SL::DB::SomeObject;
+  use SL::DB::Helper::IBANValidation [ ATTRIBUTES ];
+
+  sub validate {
+    my ($self) = @_;
+
+    my @errors;
+    …
+    push @errors, $self->validate_ibans;
+
+    return @errors;
+  }
+
+This mixin provides a function C<validate_ibans> that returns an list
+of error messages, one for each attribute that fails the IBAN
+validation. If all attributes are valid or empty then an empty list
+is returned.
+
+The names of attributes to check can be given as a import list to the
+mixin package. If no attributes are given the single attribute C<iban>
+is used.
+
+=head1 FUNCTIONS
+
+=over 4
+
+=item C<validate_ibans>
+
+This function iterates over all configured attributes and validates
+their content according to the IBAN standard. An attribute that is
+undefined, empty or consists solely of whitespace is considered valid,
+too.
+
+The function returns a list of human-readable error messages suitable
+for use in a general C<validate> function (see SYNOPSIS). For each
+attribute failing the check the list will include one error message.
+
+If all attributes are valid then an empty list is returned.
+
+=back
+
+=head1 BUGS
+
+Nothing here yet.
+
+=head1 AUTHOR
+
+Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>
+
+=cut
index b1458ef..c88b9f7 100644 (file)
@@ -6,6 +6,7 @@ use Rose::DB::Object::Helpers qw(as_tree);
 
 use SL::DB::MetaSetup::Vendor;
 use SL::DB::Manager::Vendor;
+use SL::DB::Helper::IBANValidation;
 use SL::DB::Helper::TransNumberGenerator;
 use SL::DB::Helper::CustomVariables (
   module      => 'CT',
@@ -46,6 +47,7 @@ sub validate {
 
   my @errors;
   push @errors, $::locale->text('The vendor name is missing.') if !$self->name;
+  push @errors, $self->validate_ibans;
 
   return @errors;
 }
index 9882e0e..717e09b 100644 (file)
@@ -17,6 +17,7 @@ BEGIN {
 #   dist_name: name of the package in cpan if it differs from name (ex.: LWP != libwww-perl)
 @required_modules = (
   { name => "parent",                              url => "http://search.cpan.org/~corion/",    debian => 'libparent-perl' },
+  { name => "Algorithm::CheckDigits",              url => "http://search.cpan.org/dist/Algorithm-CheckDigits/", debian => 'libalgorithm-checkdigits-perl' },
   { name => "Archive::Zip",    version => '1.16',  url => "http://search.cpan.org/~phred/",     debian => 'libarchive-zip-perl' },
   { name => "CGI",             version => '3.43',  url => "http://search.cpan.org/~leejo/",     debian => 'libcgi-perl' }, # 3.43 is core 5.10.1
   { name => "Clone",                               url => "http://search.cpan.org/~rdf/",       debian => 'libclone-perl' },
index 64603f5..e4c48e1 100644 (file)
@@ -9,6 +9,7 @@ Upgrade auf v?????
 
 * Neue Perl-Modul-Abhängigkeiten:
 
+  * Algorithm::CheckDigits
   * PBKDF2::Tiny
 
   Wie immer bitte vor dem ersten Aufrufen einmal die Pakete überprüfen:
index 67358d6..5cc1ddc 100644 (file)
@@ -42,6 +42,9 @@ Größere neue Features:
 
 Kleinere neue Features und Detailverbesserungen:
 
+  - IBANs werden beim Speichern auf Gültigkeit geprüft (betrifft
+    Kunden-/Lieferantenstammdaten sowie Bankkonten)
+
   - Konkurrierende Schreibprozesse beim Speichern von Belegen verhindern.
 
   - SelfTest um einen Test erweitert. Hauptbuch-Nettowert weicht vom Nebenbuch-Netto-Wert ab
index 373c9fd..21fdfa1 100755 (executable)
@@ -310,6 +310,7 @@ $self->{texts} = {
   'Audit Control'               => 'Bücherkontrolle',
   'Aug'                         => 'Aug',
   'August'                      => 'August',
+  'Austria'                     => 'Österreich',
   'Authentification database creation' => 'Anlegen der Datenbank zur Benutzerauthentifizierung',
   'Authentification tables creation' => 'Anlegen der Tabellen zur Benutzerauthentifizierung',
   'Auto Send?'                  => 'Auto. Versand?',
@@ -376,6 +377,7 @@ $self->{texts} = {
   'Because the useability gets worse if one partnumber is used for several parts (for example if you are searching a position for an invoice), partnumbers should be unique.' => 'Da die Benutzerfreundlichkeit durch doppelte Artikelnummern erheblich verschlechtert wird (zum Beispiel, wenn man einen Artikel für eine Rechnung sucht), sollten Artikelnummern eindeutig vergeben sein.',
   'Before saving a sales order, this article will be checked and a warning is generated.' => 'Vor dem Speichern eines Angebots oder Auftrags wird überprüft, ob die hier definierte Artikelnummer vorhanden ist (Versandkosten01, etc.) und eine entsprechende Hinweiswarnung angezeigt',
   'Belegnummer'                 => 'Buchungsnummer',
+  'Belgium'                     => 'Belgien',
   'Beratername'                 => 'Beratername',
   'Beraternummer'               => 'Beraternummer',
   'Best Before'                 => 'Mindesthaltbarkeit',
@@ -758,6 +760,7 @@ $self->{texts} = {
   'Customers'                   => 'Kunden',
   'Customers and vendors'       => 'Kunden und Lieferanten',
   'Customized Report'           => 'Vorgewählte Zeiträume',
+  'Czech Republic'              => 'Tschechien',
   'DATEV - Export Assistent'    => 'DATEV-Exportassistent',
   'DATEV Angaben'               => 'DATEV-Angaben',
   'DATEV Export'                => 'DATEV-Export',
@@ -874,6 +877,7 @@ $self->{texts} = {
   'Delivery terms'              => 'Lieferbedingungen',
   'Delivery terms (database ID)' => 'Lieferbedingungen (Datenbank-ID)',
   'Delivery terms (name)'       => 'Lieferbedingungen (Name)',
+  'Denmark'                     => 'Dänemark',
   'Department'                  => 'Abteilung',
   'Department (database ID)'    => 'Abeilung (Datenbank-ID)',
   'Department (description)'    => 'Abteilung (Beschreibung)',
@@ -1259,6 +1263,7 @@ $self->{texts} = {
   'Formula'                     => 'Formel',
   'Found #1 errors.'            => '#1 Fehler gefunden.',
   'Found #1 objects of which #2 can be imported.' => 'Es wurden #1 Objekte gefunden, von denen #2 importiert werden können.',
+  'France'                      => 'Frankreich',
   'Free report period'          => 'Freier Zeitraum',
   'Free-form text'              => 'Textzeile',
   'Fristsetzung'                => 'Fristsetzung',
@@ -1288,6 +1293,7 @@ $self->{texts} = {
   'General ledger corrections'  => 'Korrekturen im Hauptbuch',
   'General settings'            => 'Allgemeine Einstellungen',
   'Generic Tax Report'          => 'USTVA Bericht',
+  'Germany'                     => 'Deutschland',
   'Git revision: #1, #2 #3'     => 'Git-Revision: #1, #2 #3',
   'Given Name'                  => 'Vorname',
   'Global Record BCC'           => 'Globale BCC-Adresse',
@@ -1468,6 +1474,7 @@ $self->{texts} = {
   'It is possible to make a quick DATEV export everytime you post a record to ensure things work nicely with their data requirements. This will result in a slight overhead though you can enable this for each type of record independently.' => 'Es ist möglich, bei jeder Buchung einen schnellen DATEV-Export durchzuführen, um sicherzustellen, dass die Datensätze den DATEV-Anforderungen genügen. Da dies einen kleinen Overhead bedeutet, lässt sich die Einstellung für jeden Buchungstyp getrennt einstellen.',
   'It will not be further modified by any other source, and will be offered in records like this.' => 'Er wird nicht weiter verändert werden und genau so im Beleg vorgeschlagen werden.',
   'It will simply set the taxkey to 0 (meaning "no taxes") which is the correct value for such inventory transactions.' => 'Es wird einfach die Steuerschlüssel auf  0 setzen, was "keine Steuer" bedeutet und für solche Warenbestandsbuchungen der richtige Wert ist.',
+  'Italy'                       => 'Italien',
   'Item deleted!'               => 'Artikel gelöscht!',
   'Item mode'                   => 'Artikelmodus',
   'Item multi selection with qty' => 'Artikel-Mehrfachauswahl mit Menge',
@@ -1583,6 +1590,7 @@ $self->{texts} = {
   'Logout now'                  => 'kivitendo jetzt verlassen',
   'Long Dates'                  => 'Lange Monatsnamen',
   'Long Description'            => 'Langtext',
+  'Luxembourg'                  => 'Luxemburg',
   'MAILED'                      => 'Gesendet',
   'MD'                          => 'PT',
   'MIME type'                   => 'MIME-Typ',
@@ -1672,6 +1680,7 @@ $self->{texts} = {
   'Net value in Order'          => 'Netto Auftrag',
   'Net value transferred in / out' => 'Netto ein- /ausgelagert',
   'Net value without delivery orders' => 'Netto ohne Lieferschein',
+  'Netherlands'                 => 'Niederlande',
   'Netto Terms'                 => 'Zahlungsziel netto',
   'New Password'                => 'Neues Passwort',
   'New Purchase Price Rule'     => 'Neue Einkaufspreisregel',
@@ -1992,6 +2001,7 @@ $self->{texts} = {
   'Please set another taxnumber for the following taxes and run the update again:' => 'Bitte wählen Sie ein anderes Steuerautomatik-Konto für die folgenden Steuern aus uns starten Sie dann das Update erneut.',
   'Please specify a description for the warehouse designated for these goods.' => 'Bitte geben Sie den Namen des Ziellagers f&uuml;r die &uuml;bernommenen Daten ein.',
   'Plural'                      => 'Plural',
+  'Poland'                      => 'Polen',
   'Port'                        => 'Port',
   'Portrait'                    => 'Hochformat',
   'Position type in quotation/order' => 'Positionstyp in Angebot/Auftrag',
@@ -2554,6 +2564,7 @@ $self->{texts} = {
   'Summen- und Saldenliste'     => 'Summen- und Saldenliste',
   'Superuser name'              => 'Datenbankadministrator',
   'Supplies'                    => 'Lieferungen',
+  'Switzerland'                 => 'Schweiz',
   'System'                      => 'System',
   'System currently down for maintenance!' => 'kivitendo ist momentan zwecks Wartungsarbeiten nicht zugänglich.',
   'TODO list'                   => 'Aufgabenliste',
@@ -2637,6 +2648,7 @@ $self->{texts} = {
   'The Buchungsgruppe has been saved.' => 'Die Buchungsgruppe wurde gespeichert.',
   'The Buchungsgruppe needs an inventory account.' => 'Die Buchungsgruppe braucht ein Warenbestandskonto.',
   'The GL transaction #1 has been deleted.' => 'Die Dialogbuchung #1 wurde gelöscht.',
+  'The IBAN \'#1\' is not valid as IBANs in #2 must be exactly #3 characters long.' => 'Die IBAN \'#1\' ist ungültig, da IBANs in #2 genau #3 Zeichen lang sein müssen.',
   'The IBAN is missing.'        => 'Die IBAN fehlt.',
   'The LDAP server "#1:#2" is unreachable. Please check config/kivitendo.conf.' => 'Der LDAP-Server "#1:#2" ist nicht erreichbar. Bitte &uuml;berpr&uuml;fen Sie die Angaben in config/kivitendo.conf.',
   'The MT940 import needs an import profile called MT940' => 'Der MT940 Import benötigt ein Importprofil mit dem Namen "MT940"',
@@ -2906,6 +2918,7 @@ $self->{texts} = {
   'The user has been created.'  => 'Der Benutzer wurde angelegt.',
   'The user has been deleted.'  => 'Der Benutzer wurde gelöscht.',
   'The user has been saved.'    => 'Der Benutzer wurde gespeichert.',
+  'The value \'#1\' is not a valid IBAN.' => 'Der Wert \'#1\' ist keine gültige IBAN.',
   'The variable name must only consist of letters, numbers and underscores. It must begin with a letter. Example: send_christmas_present' => 'Der Variablenname darf nur aus Zeichen (keine Umlaute), Ziffern und Unterstrichen bestehen. Er muss mit einem Buchstaben beginnen. Beispiel: weihnachtsgruss_verschicken',
   'The vendor name is missing.' => 'Der Liefeantenname fehlt.',
   'The version number is missing.' => 'Die Versionsnummer fehlt.',