SL/Helper/QrBillFunctions.pm

   1 package SL::Helper::QrBillFunctions;
   2
   3 use List::Util qw(first);
   4
   5 use SL::Util qw(trim);
   6
   7 use strict;
   8 use warnings;
   9
  10 use Exporter qw(import);
  11 our @EXPORT_OK = qw(
  12   get_street_name_from_address_line
  13   get_building_number_from_address_line
  14   get_postal_code_from_address_line
  15   get_town_name_from_address_line
  16   get_qrbill_account
  17   assemble_ref_number
  18   get_ref_number_formatted
  19   get_iban_formatted
  20   get_amount_formatted
  21 );
  22
  23 use constant {
  24   REGEX_STREET_NAME_FROM_ADDRESS_LINE     => qr{^([^\d]+)\s*},
  25   REGEX_BUILDING_NUMBER_FROM_ADDRESS_LINE => qr{(\d+.*)},
  26   REGEX_POSTAL_CODE_FROM_ADDRESS_LINE     => qr{^(\d+).*$},
  27   REGEX_TOWN_FROM_ADDRESS_LINE            => qr{^\d+\s(.*)$},
  28 };
  29
  30 sub get_street_name_from_address_line {
  31   my $address_line = $_[0];
  32
  33   my ($street_name) = $address_line =~ REGEX_STREET_NAME_FROM_ADDRESS_LINE;
  34
  35   return trim($street_name) // '';
  36 }
  37
  38 sub get_building_number_from_address_line {
  39   my $address_line = $_[0];
  40
  41   my ($building_number) = $address_line =~ REGEX_BUILDING_NUMBER_FROM_ADDRESS_LINE;
  42
  43   return trim($building_number) // '';
  44 }
  45
  46 sub get_postal_code_from_address_line {
  47   my $address_line = $_[0];
  48
  49   my ($postal_code) = $address_line =~ REGEX_POSTAL_CODE_FROM_ADDRESS_LINE;
  50
  51   return trim($postal_code) // '';
  52 }
  53
  54 sub get_town_name_from_address_line {
  55   my $address_line = $_[0];
  56
  57   my ($town_name) = $address_line =~ REGEX_TOWN_FROM_ADDRESS_LINE;
  58
  59   return trim($town_name) // '';
  60 }
  61
  62 sub get_qrbill_account {
  63   $main::lxdebug->enter_sub();
  64
  65   my $qr_account;
  66
  67   my $bank_accounts = SL::DB::Manager::BankAccount->get_all_sorted;
  68
  69   $qr_account = first { $_->use_for_qrbill } @{ $bank_accounts };
  70
  71   if (!$qr_account) {
  72     return undef, $::locale->text('No bank account flagged for QRBill usage was found.');
  73   }
  74
  75   $main::lxdebug->leave_sub();
  76   return $qr_account, undef;
  77 }
  78
  79 sub assemble_ref_number {
  80   $main::lxdebug->enter_sub();
  81
  82   my $bank_id = $_[0];
  83   my $customer_number = $_[1];
  84   my $invoice_number = $_[2] // "0";
  85
  86   # check values (analog to checks in makro)
  87   # - bank_id
  88   #     in-/output: a string containing a 6 digit number
  89   if (!($bank_id =~ /^\d*$/) || length($bank_id) != 6) {
  90     return undef, $::locale->text('Bank account id number invalid. Must be 6 digits.');
  91   }
  92
  93   # - customer_number
  94   #     input: a string containing up to 6 digits [0-9]
  95   #     output: non-digits removed, 6 digits, filled with leading zeros
  96   $customer_number = remove_non_digits($customer_number);
  97   if (!check_digits_and_max_length($customer_number, 6)) {
  98     return undef, $::locale->text('Customer number invalid. Must be less then or equal to 6 digits after non-digits removed.');
  99   }
 100   # fill with zeros
 101   $customer_number = sprintf "%06d", $customer_number;
 102
 103   # - invoice_number
 104   #     input: a string containing up to 14 digits, may be zero
 105   #     output: non-digits removed, 14 digits, filled with leading zeros
 106   $invoice_number = remove_non_digits($invoice_number);
 107   if (!check_digits_and_max_length($invoice_number, 14)) {
 108     return undef, $::locale->text('Invoice number invalid. Must be less then or equal to 14 digits after non-digits removed.');
 109   }
 110   # fill with zeros
 111   $invoice_number = sprintf "%014d", $invoice_number;
 112
 113   # assemble ref. number
 114   my $ref_number = $bank_id . $customer_number . $invoice_number;
 115
 116   # calculate check digit
 117   my $ref_number_cpl = $ref_number . calculate_check_digit($ref_number);
 118
 119   $main::lxdebug->leave_sub();
 120   return $ref_number_cpl, undef;
 121 }
 122
 123 sub get_ref_number_formatted {
 124   $main::lxdebug->enter_sub();
 125
 126   my $ref_number = $_[0];
 127
 128   # create ref. number in format:
 129   # 'XX XXXXX XXXXX XXXXX XXXXX XXXXX' (2 digits + 5 x 5 digits)
 130   my $ref_number_spaced = substr($ref_number, 0, 2) . ' ' .
 131                           substr($ref_number, 2, 5) . ' ' .
 132                           substr($ref_number, 7, 5) . ' ' .
 133                           substr($ref_number, 12, 5) . ' ' .
 134                           substr($ref_number, 17, 5) . ' ' .
 135                           substr($ref_number, 22, 5);
 136
 137   $main::lxdebug->leave_sub();
 138   return $ref_number_spaced;
 139 }
 140
 141 sub get_iban_formatted {
 142   $main::lxdebug->enter_sub();
 143
 144   my $iban = $_[0];
 145
 146   # create iban number in format:
 147   # 'XXXX XXXX XXXX XXXX XXXX X' (5 x 4 + 1digits)
 148   my $iban_spaced = substr($iban, 0, 4) . ' ' .
 149                     substr($iban, 4, 4) . ' ' .
 150                     substr($iban, 8, 4) . ' ' .
 151                     substr($iban, 12, 4) . ' ' .
 152                     substr($iban, 16, 4) . ' ' .
 153                     substr($iban, 20, 1);
 154
 155   $main::lxdebug->leave_sub();
 156   return $iban_spaced;
 157 }
 158
 159 sub get_amount_formatted {
 160   $main::lxdebug->enter_sub();
 161
 162   my $amount = $_[0];
 163
 164   # parameter should be a string containing a number
 165   # with 2 digits after the pointi'm also getting in the town
 166   unless ($amount =~ /^\d+\.\d{2}$/) {
 167     return undef;
 168   }
 169
 170   my $r = reverse $amount;
 171   # this matches the digits left of the '.'
 172   $r =~ m/^\d{2}\./g;
 173   # '\G' continuous the search where the last stopped,
 174   # matches three digits and substitutes with a space
 175   $r =~ s/\G(\d{3})(?=\d)/$1 /g;
 176   $r = reverse $r;
 177
 178   $main::lxdebug->leave_sub();
 179   return $r;
 180 }
 181
 182 ### internal functions
 183
 184 sub remove_non_digits {
 185   my $s = $_[0];
 186   $s =~ s/[^0-9]//g;
 187   return $s;
 188 }
 189
 190 sub check_digits_and_max_length {
 191   my $s = $_[0];
 192   my $length = $_[1];
 193
 194   return 0 if (!($s =~ /^\d*$/) || length($s) > $length);
 195   return 1;
 196 }
 197
 198 sub calculate_check_digit {
 199   # calculate ESR check digit using algorithm: "modulo 10, recursive"
 200   my $ref_number_str = $_[0];
 201
 202   my @m = (0, 9, 4, 6, 8, 2, 7, 1, 3, 5);
 203   my $carry = 0;
 204
 205   my @ref_number_split = map int($_), split(//, $ref_number_str);
 206
 207   for my $v (@ref_number_split) {
 208     $carry = @m[($carry + $v) % 10];
 209   }
 210
 211   return (10 - $carry) % 10;
 212 }
 213
 214 1;
 215
 216 __END__
 217
 218 =encoding utf-8
 219
 220 =head1 NAME
 221
 222 SL::Helper::QrBillFunctions - Additional helper functions for the swiss QR bill
 223
 224 =head1 SYNOPSIS
 225
 226   use SL::Helper::QrBillFunctions qw(get_qrbill_account assemble_ref_number
 227     get_ref_number_formatted get_iban_formatted get_amount_formatted);
 228
 229   # get qr-account data
 230   my ($qr_account, $error) = get_qrbill_account();
 231
 232   my ($ref_number, $error) = assemble_ref_number(
 233     $qr_account->{'bank_account_id'},
 234     $form->{'customernumber'},
 235     $form->{'invnumber'},
 236   );
 237
 238   # get ref. number/iban formatted with spaces and set into form for template
 239   # processing
 240   $form->{'ref_number_formatted'} = get_ref_number_formatted($ref_number);
 241   $form->{'iban_formatted'} = get_iban_formatted($qr_account->{'iban'});
 242
 243   # format amount for template
 244   my $amount = sprintf("%.2f", $form->parse_amount(\%::myconfig, $form->{'total'}));
 245   my $amount_formatted = get_amount_formatted($amount);
 246
 247 =head1 DESCRIPTION
 248
 249 Helper functions moved from SL::Template::OpenDocument.
 250
 251 =head1 FUNCTIONS
 252
 253 =over 4
 254
 255 =item C<get_street_name_from_address_line>
 256
 257 Returns the street name from a combined street name and number.
 258
 259 =item C<get_street_number_from_address_line>
 260
 261 Returns the street number from a combined street name and number.
 262
 263 =item C<get_postal_code_from_address_line>
 264
 265 Returns the postal code from an combined postal code and town.
 266
 267 =item C<get_town_name_from_address_line>
 268
 269 Returns the town name from an combined postal code and town.
 270
 271 =item C<get_qrbill_account>
 272
 273 Return the bank account flagged for the QR bill. And a string containing an
 274 error message as second return value or undef if no error occurred.
 275
 276 =item C<assemble_ref_number>
 277
 278 Assembles and returns the Swiss reference number. 27 digits, formed
 279 from the parameters plus one check digit. And a string containing an error
 280 message as second return value or undef if no error occurred.
 281
 282 Non-digits will be removed and remaining numbers filled up with leading zeros.
 283
 284 Parameters:
 285
 286 =over 4
 287
 288 =item C<bank_id>
 289
 290 "Bankkonto Identifikationsnummer". A string containing a 6 digit number.
 291
 292 =item C<customer_number>
 293
 294 Kivitendo customer number. A string containing up to 6 digits.
 295
 296 =item C<invoice_number>
 297
 298 Kivitendo invoice number. A string containing up to 14 digits, may be zero.
 299
 300 =back
 301
 302 =item C<get_ref_number_formatted>
 303
 304 Given a reference number, return it in format:
 305
 306 'XX XXXXX XXXXX XXXXX XXXXX XXXXX' (2 digits + 5 x 5 digits)
 307
 308 =item C<get_iban_formatted>
 309
 310 Given a IBAN number, return it in format:
 311
 312 'XXXX XXXX XXXX XXXX XXXX X' (5 x 4 + 1digits)
 313
 314 =item C<get_amount_formatted>
 315
 316 Given an amount, return it in format: 'X XXX.XX'
 317 Or undef if an error occurred.
 318
 319 =back
 320
 321 =head1 ERROR HANDLING
 322
 323 The functions C<get_qrbill_account> and C<assemble_ref_number> return
 324 undef when an error occurs and a string containing an error message as
 325 second return value.
 326
 327 The function C<get_amount_formatted> returns undef if an error occurred.
 328
 329 The other functions always return a result.
 330
 331 =head1 TESTS
 332
 333 Tests for functions see t/helper/qrbill_functions.t.
 334
 335 Run: C<t/test.pl t/helper/qrbill_functions.t>
 336
 337 =head1 AUTHOR
 338
 339 Cem Aydin E<lt>cem.aydin@gmx.chE<gt>
 340
 341 =cut