Revision 16485ecf
Von Cem Aydin vor mehr als 2 Jahren hinzugefügt
SL/Template/OpenDocument.pm | ||
---|---|---|
13 | 13 |
|
14 | 14 |
use SL::DB::BankAccount; |
15 | 15 |
use SL::Helper::QrBill; |
16 |
use SL::Helper::QrBillFunctions qw(get_qrbill_account assemble_ref_number |
|
17 |
get_ref_number_formatted get_iban_formatted get_amount_formatted); |
|
16 | 18 |
use SL::Helper::ISO3166; |
17 | 19 |
|
18 | 20 |
use Cwd; |
... | ... | |
473 | 475 |
return $res; |
474 | 476 |
} |
475 | 477 |
|
476 |
sub get_qrbill_account { |
|
477 |
$main::lxdebug->enter_sub(); |
|
478 |
my ($self) = @_; |
|
479 |
|
|
480 |
my $qr_account; |
|
481 |
|
|
482 |
my $bank_accounts = SL::DB::Manager::BankAccount->get_all; |
|
483 |
$qr_account = scalar(@{ $bank_accounts }) == 1 ? |
|
484 |
$bank_accounts->[0] : |
|
485 |
first { $_->use_for_qrbill } @{ $bank_accounts }; |
|
486 |
|
|
487 |
if (!$qr_account) { |
|
488 |
$::form->error($::locale->text('No bank account flagged for QRBill usage was found.')); |
|
489 |
} |
|
490 |
|
|
491 |
$main::lxdebug->leave_sub(); |
|
492 |
return $qr_account; |
|
493 |
} |
|
494 |
|
|
495 |
sub remove_letters_prefix { |
|
496 |
my $s = $_[0]; |
|
497 |
$s =~ s/^[a-zA-Z]+//; |
|
498 |
return $s; |
|
499 |
} |
|
500 |
|
|
501 |
sub check_digits_and_max_length { |
|
502 |
my $s = $_[0]; |
|
503 |
my $length = $_[1]; |
|
504 |
|
|
505 |
return 0 if (!($s =~ /^\d*$/) || length($s) > $length); |
|
506 |
return 1; |
|
507 |
} |
|
508 |
|
|
509 |
sub calculate_check_digit { |
|
510 |
# calculate ESR check digit using algorithm: "modulo 10, recursive" |
|
511 |
my $ref_number_str = $_[0]; |
|
512 |
|
|
513 |
my @m = (0, 9, 4, 6, 8, 2, 7, 1, 3, 5); |
|
514 |
my $carry = 0; |
|
515 |
|
|
516 |
my @ref_number_split = map int($_), split(//, $ref_number_str); |
|
517 |
|
|
518 |
for my $v (@ref_number_split) { |
|
519 |
$carry = @m[($carry + $v) % 10]; |
|
520 |
} |
|
521 |
|
|
522 |
return (10 - $carry) % 10; |
|
523 |
} |
|
524 |
|
|
525 |
sub assemble_ref_number { |
|
526 |
$main::lxdebug->enter_sub(); |
|
527 |
|
|
528 |
my $bank_id = $_[0]; |
|
529 |
my $customer_number = $_[1]; |
|
530 |
my $order_number = $_[2] // "0"; |
|
531 |
my $invoice_number = $_[3] // "0"; |
|
532 |
|
|
533 |
# check values (analog to checks in makro) |
|
534 |
# - bank_id |
|
535 |
# input: 6 digits, only numbers |
|
536 |
# output: 6 digits, only numbers |
|
537 |
if (!($bank_id =~ /^\d*$/) || length($bank_id) != 6) { |
|
538 |
$::form->error($::locale->text('Bank account id number invalid. Must be 6 digits.')); |
|
539 |
} |
|
540 |
|
|
541 |
# - customer_number |
|
542 |
# input: prefix (letters) + up to 6 digits (numbers) |
|
543 |
# output: prefix removed, 6 digits, filled with leading zeros |
|
544 |
$customer_number = remove_letters_prefix($customer_number); |
|
545 |
if (!check_digits_and_max_length($customer_number, 6)) { |
|
546 |
$::form->error($::locale->text('Customer number invalid. Must be less then or equal to 6 digits after prefix.')); |
|
547 |
} |
|
548 |
# fill with zeros |
|
549 |
$customer_number = sprintf "%06d", $customer_number; |
|
550 |
|
|
551 |
# - order_number |
|
552 |
# input: prefix (letters) + up to 7 digits, may be zero |
|
553 |
# output: prefix removed, 7 digits, filled with leading zeros |
|
554 |
$order_number = remove_letters_prefix($order_number); |
|
555 |
if (!check_digits_and_max_length($order_number, 7)) { |
|
556 |
$::form->error($::locale->text('Order number invalid. Must be less then or equal to 7 digits after prefix.')); |
|
557 |
} |
|
558 |
# fill with zeros |
|
559 |
$order_number = sprintf "%07d", $order_number; |
|
560 |
|
|
561 |
# - invoice_number |
|
562 |
# input: prefix (letters) + up to 7 digits, may be zero |
|
563 |
# output: prefix removed, 7 digits, filled with leading zeros |
|
564 |
$invoice_number = remove_letters_prefix($invoice_number); |
|
565 |
if (!check_digits_and_max_length($invoice_number, 7)) { |
|
566 |
$::form->error($::locale->text('Invoice number invalid. Must be less then or equal to 7 digits after prefix.')); |
|
567 |
} |
|
568 |
# fill with zeros |
|
569 |
$invoice_number = sprintf "%07d", $invoice_number; |
|
570 |
|
|
571 |
# assemble ref. number |
|
572 |
my $ref_number = $bank_id . $customer_number . $order_number . $invoice_number; |
|
573 |
|
|
574 |
# calculate check digit |
|
575 |
my $ref_number_cpl = $ref_number . calculate_check_digit($ref_number); |
|
576 |
|
|
577 |
$main::lxdebug->leave_sub(); |
|
578 |
return $ref_number_cpl; |
|
579 |
} |
|
580 |
|
|
581 |
sub get_ref_number_formatted { |
|
582 |
$main::lxdebug->enter_sub(); |
|
583 |
|
|
584 |
my $ref_number = $_[0]; |
|
585 |
|
|
586 |
# create ref. number in format: |
|
587 |
# 'XX XXXXX XXXXX XXXXX XXXXX XXXXX' (2 digits + 5 x 5 digits) |
|
588 |
my $ref_number_spaced = substr($ref_number, 0, 2) . ' ' . |
|
589 |
substr($ref_number, 2, 5) . ' ' . |
|
590 |
substr($ref_number, 7, 5) . ' ' . |
|
591 |
substr($ref_number, 12, 5) . ' ' . |
|
592 |
substr($ref_number, 17, 5) . ' ' . |
|
593 |
substr($ref_number, 22, 5); |
|
594 |
|
|
595 |
$main::lxdebug->leave_sub(); |
|
596 |
return $ref_number_spaced; |
|
597 |
} |
|
598 |
|
|
599 |
sub get_iban_formatted { |
|
600 |
$main::lxdebug->enter_sub(); |
|
601 |
|
|
602 |
my $iban = $_[0]; |
|
603 |
|
|
604 |
# create iban number in format: |
|
605 |
# 'XXXX XXXX XXXX XXXX XXXX X' (5 x 4 + 1digits) |
|
606 |
my $iban_spaced = substr($iban, 0, 4) . ' ' . |
|
607 |
substr($iban, 4, 4) . ' ' . |
|
608 |
substr($iban, 8, 4) . ' ' . |
|
609 |
substr($iban, 12, 4) . ' ' . |
|
610 |
substr($iban, 16, 4) . ' ' . |
|
611 |
substr($iban, 20, 1); |
|
612 |
|
|
613 |
$main::lxdebug->leave_sub(); |
|
614 |
return $iban_spaced; |
|
615 |
} |
|
616 |
|
|
617 |
sub get_amount_formatted { |
|
618 |
$main::lxdebug->enter_sub(); |
|
619 |
|
|
620 |
unless ($_[0] =~ /^\d+\.\d{2}$/) { |
|
621 |
$::form->error($::locale->text('Amount has wrong format.')); |
|
622 |
} |
|
623 |
|
|
624 |
local $_ = shift; |
|
625 |
$_ = reverse split //; |
|
626 |
m/^\d{2}\./g; |
|
627 |
s/\G(\d{3})(?=\d)/$1 /g; |
|
628 |
|
|
629 |
$main::lxdebug->leave_sub(); |
|
630 |
return scalar reverse split //; |
|
631 |
} |
|
632 |
|
|
633 | 478 |
sub generate_qr_code { |
634 | 479 |
$main::lxdebug->enter_sub(); |
635 | 480 |
my $self = $_[0]; |
... | ... | |
638 | 483 |
# assemble data for QR-Code |
639 | 484 |
|
640 | 485 |
# get qr-account data |
641 |
my $qr_account = $self->get_qrbill_account();
|
|
486 |
my $qr_account = get_qrbill_account(); |
|
642 | 487 |
|
643 | 488 |
my %biller_information = ( |
644 | 489 |
'iban' => $qr_account->{'iban'} |
Auch abrufbar als: Unified diff
Swiss QR-Bill: Helfer Funktionen in separate Datei ausgelagert