SL/DB/Helper/IBANValidation.pm

   1 package SL::DB::Helper::IBANValidation;
   2
   3 use strict;
   4
   5 use Algorithm::CheckDigits ();
   6 use Carp;
   7 use SL::Locale::String qw(t8);
   8
   9 my $_validator;
  10 my %_countries = (
  11   AT => { len => 20, name => t8('Austria') },
  12   BE => { len => 16, name => t8('Belgium') },
  13   CH => { len => 21, name => t8('Switzerland') },
  14   CZ => { len => 24, name => t8('Czech Republic') },
  15   DE => { len => 22, name => t8('Germany') },
  16   DK => { len => 18, name => t8('Denmark') },
  17   FR => { len => 27, name => t8('France') },
  18   IT => { len => 27, name => t8('Italy') },
  19   LU => { len => 20, name => t8('Luxembourg') },
  20   NL => { len => 18, name => t8('Netherlands') },
  21   PL => { len => 28, name => t8('Poland') },
  22 );
  23
  24 sub _validate {
  25   my ($self, $attribute) = @_;
  26
  27   my $iban =  $self->$attribute // '';
  28   $iban    =~ s{\s+}{}g;
  29
  30   return () unless length($iban);
  31
  32   $_validator //= Algorithm::CheckDigits::CheckDigits('iban');
  33
  34   return ($::locale->text("The value '#1' is not a valid IBAN.", $iban)) if !$_validator->is_valid($iban);
  35
  36   my $country = $_countries{substr($iban, 0, 2)};
  37
  38   return () if !$country || (length($iban) == $country->{len});
  39
  40   return ($::locale->text("The IBAN '#1' is not valid as IBANs in #2 must be exactly #3 characters long.", $iban, $country->{name}, $country->{len}));
  41 }
  42
  43 sub import {
  44   my ($package, @attributes) = @_;
  45
  46   my $caller_package         = caller;
  47   @attributes                = qw(iban) unless @attributes;
  48
  49   no strict 'refs';
  50
  51   *{ $caller_package . '::validate_ibans' } = sub {
  52     my ($self) = @_;
  53
  54     return map { SL::DB::Helper::IBANValidation::_validate($self, $_) } @attributes;
  55   };
  56 }
  57
  58 1;
  59
  60 __END__
  61
  62 =pod
  63
  64 =encoding utf8
  65
  66 =head1 NAME
  67
  68 SL::DB::Helper::IBANValidation - Mixin for validating IBAN attributes
  69
  70 =head1 SYNOPSIS
  71
  72   package SL::DB::SomeObject;
  73   use SL::DB::Helper::IBANValidation [ ATTRIBUTES ];
  74
  75   sub validate {
  76     my ($self) = @_;
  77
  78     my @errors;
  79     …
  80     push @errors, $self->validate_ibans;
  81
  82     return @errors;
  83   }
  84
  85 This mixin provides a function C<validate_ibans> that returns a list
  86 of error messages, one for each attribute that fails the IBAN
  87 validation. If all attributes are valid or empty then an empty list
  88 is returned.
  89
  90 The names of attributes to check can be given as an import list to the
  91 mixin package. If no attributes are given the single attribute C<iban>
  92 is used.
  93
  94 =head1 FUNCTIONS
  95
  96 =over 4
  97
  98 =item C<validate_ibans>
  99
 100 This function iterates over all configured attributes and validates
 101 their content according to the IBAN standard. An attribute that is
 102 undefined, empty or consists solely of whitespace is considered valid,
 103 too.
 104
 105 The function returns a list of human-readable error messages suitable
 106 for use in a general C<validate> function (see SYNOPSIS). For each
 107 attribute failing the check the list will include one error message.
 108
 109 If all attributes are valid then an empty list is returned.
 110
 111 =back
 112
 113 =head1 BUGS
 114
 115 Nothing here yet.
 116
 117 =head1 AUTHOR
 118
 119 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>
 120
 121 =cut