Projekt

Allgemein

Profil

Herunterladen (8,66 KB) Statistiken
| Zweig: | Markierung: | Revision:

kivitendo/SL/Helper/QrBillFunctions.pm @ 68329cf0

package SL::Helper::QrBillFunctions;

use List::Util qw(first);

use SL::Util qw(trim);

use strict;
use warnings;

use Exporter qw(import);
our @EXPORT_OK = qw(
get_street_name_from_address_line
get_building_number_from_address_line
get_postal_code_from_address_line
get_town_name_from_address_line
get_qrbill_account
assemble_ref_number
get_ref_number_formatted
get_iban_formatted
get_amount_formatted
);

use constant {
REGEX_STREET_NAME_FROM_ADDRESS_LINE => qr{^([^\d]+)\s*},
REGEX_BUILDING_NUMBER_FROM_ADDRESS_LINE => qr{(\d+.*)},
REGEX_POSTAL_CODE_FROM_ADDRESS_LINE => qr{^(\d+).*$},
REGEX_TOWN_FROM_ADDRESS_LINE => qr{^\d+\s(.*)$},
};

sub get_street_name_from_address_line {
my $address_line = $_[0];

my ($street_name) = $address_line =~ REGEX_STREET_NAME_FROM_ADDRESS_LINE;

return trim($street_name) // '';
}

sub get_building_number_from_address_line {
my $address_line = $_[0];

my ($building_number) = $address_line =~ REGEX_BUILDING_NUMBER_FROM_ADDRESS_LINE;

return trim($building_number) // '';
}

sub get_postal_code_from_address_line {
my $address_line = $_[0];

my ($postal_code) = $address_line =~ REGEX_POSTAL_CODE_FROM_ADDRESS_LINE;

return trim($postal_code) // '';
}

sub get_town_name_from_address_line {
my $address_line = $_[0];

my ($town_name) = $address_line =~ REGEX_TOWN_FROM_ADDRESS_LINE;

return trim($town_name) // '';
}

sub get_qrbill_account {
$main::lxdebug->enter_sub();

my $qr_account;

my $bank_accounts = SL::DB::Manager::BankAccount->get_all_sorted;

$qr_account = first { $_->use_for_qrbill } @{ $bank_accounts };

if (!$qr_account) {
return undef, $::locale->text('No bank account flagged for QRBill usage was found.');
}

$main::lxdebug->leave_sub();
return $qr_account, undef;
}

sub assemble_ref_number {
$main::lxdebug->enter_sub();

my $bank_id = $_[0];
my $customer_number = $_[1];
my $invoice_number = $_[2] // "0";

# check values (analog to checks in makro)
# - bank_id
# in-/output: a string containing a 6 digit number
if (!($bank_id =~ /^\d*$/) || length($bank_id) != 6) {
return undef, $::locale->text('Bank account id number invalid. Must be 6 digits.');
}

# - customer_number
# input: a string containing up to 6 digits [0-9]
# output: non-digits removed, 6 digits, filled with leading zeros
$customer_number = remove_non_digits($customer_number);
if (!check_digits_and_max_length($customer_number, 6)) {
return undef, $::locale->text('Customer number invalid. Must be less then or equal to 6 digits after non-digits removed.');
}
# fill with zeros
$customer_number = sprintf "%06d", $customer_number;

# - invoice_number
# input: a string containing up to 14 digits, may be zero
# output: non-digits removed, 14 digits, filled with leading zeros
$invoice_number = remove_non_digits($invoice_number);
if (!check_digits_and_max_length($invoice_number, 14)) {
return undef, $::locale->text('Invoice number invalid. Must be less then or equal to 14 digits after non-digits removed.');
}
# fill with zeros
$invoice_number = sprintf "%014d", $invoice_number;

# assemble ref. number
my $ref_number = $bank_id . $customer_number . $invoice_number;

# calculate check digit
my $ref_number_cpl = $ref_number . calculate_check_digit($ref_number);

$main::lxdebug->leave_sub();
return $ref_number_cpl, undef;
}

sub get_ref_number_formatted {
$main::lxdebug->enter_sub();

my $ref_number = $_[0];

# create ref. number in format:
# 'XX XXXXX XXXXX XXXXX XXXXX XXXXX' (2 digits + 5 x 5 digits)
my $ref_number_spaced = substr($ref_number, 0, 2) . ' ' .
substr($ref_number, 2, 5) . ' ' .
substr($ref_number, 7, 5) . ' ' .
substr($ref_number, 12, 5) . ' ' .
substr($ref_number, 17, 5) . ' ' .
substr($ref_number, 22, 5);

$main::lxdebug->leave_sub();
return $ref_number_spaced;
}

sub get_iban_formatted {
$main::lxdebug->enter_sub();

my $iban = $_[0];

# create iban number in format:
# 'XXXX XXXX XXXX XXXX XXXX X' (5 x 4 + 1digits)
my $iban_spaced = substr($iban, 0, 4) . ' ' .
substr($iban, 4, 4) . ' ' .
substr($iban, 8, 4) . ' ' .
substr($iban, 12, 4) . ' ' .
substr($iban, 16, 4) . ' ' .
substr($iban, 20, 1);

$main::lxdebug->leave_sub();
return $iban_spaced;
}

sub get_amount_formatted {
$main::lxdebug->enter_sub();

my $amount = $_[0];

# parameter should be a string containing a number
# with 2 digits after the pointi'm also getting in the town
unless ($amount =~ /^\d+\.\d{2}$/) {
return undef;
}

my $r = reverse $amount;
# this matches the digits left of the '.'
$r =~ m/^\d{2}\./g;
# '\G' continuous the search where the last stopped,
# matches three digits and substitutes with a space
$r =~ s/\G(\d{3})(?=\d)/$1 /g;
$r = reverse $r;

$main::lxdebug->leave_sub();
return $r;
}

### internal functions

sub remove_non_digits {
my $s = $_[0];
$s =~ s/[