Projekt

Allgemein

Profil

« Zurück | Weiter » 

Revision 16485ecf

Von Cem Aydin vor mehr als 2 Jahren hinzugefügt

  • ID 16485ecf955c49e0be6e6bc221c91ba02ef94cb0
  • Vorgänger 07cd1c32
  • Nachfolger 824edcc4

Swiss QR-Bill: Helfer Funktionen in separate Datei ausgelagert

Unterschiede anzeigen:

SL/Helper/QrBillFunctions.pm
1
package SL::Helper::QrBillFunctions;
2

  
3
use strict;
4
use warnings;
5

  
6
use Exporter qw(import);
7
our @EXPORT_OK = qw(get_qrbill_account assemble_ref_number get_ref_number_formatted
8
  get_iban_formatted get_amount_formatted);
9

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

  
13
  my $qr_account;
14

  
15
  my $bank_accounts     = SL::DB::Manager::BankAccount->get_all;
16
  $qr_account = scalar(@{ $bank_accounts }) == 1 ?
17
    $bank_accounts->[0] :
18
    first { $_->use_for_qrbill } @{ $bank_accounts };
19

  
20
  if (!$qr_account) {
21
    $::form->error($::locale->text('No bank account flagged for QRBill usage was found.'));
22
  }
23

  
24
  $main::lxdebug->leave_sub();
25
  return $qr_account;
26
}
27

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

  
31
  my $bank_id = $_[0];
32
  my $customer_number = $_[1];
33
  my $order_number = $_[2] // "0";
34
  my $invoice_number = $_[3] // "0";
35

  
36
  # check values (analog to checks in makro)
37
  # - bank_id
38
  #     input: 6 digits, only numbers
39
  #     output: 6 digits, only numbers
40
  if (!($bank_id =~ /^\d*$/) || length($bank_id) != 6) {
41
    $::form->error($::locale->text('Bank account id number invalid. Must be 6 digits.'));
42
  }
43

  
44
  # - customer_number
45
  #     input: prefix (letters) + up to 6 digits (numbers)
46
  #     output: prefix removed, 6 digits, filled with leading zeros
47
  $customer_number = remove_letters_prefix($customer_number);
48
  if (!check_digits_and_max_length($customer_number, 6)) {
49
    $::form->error($::locale->text('Customer number invalid. Must be less then or equal to 6 digits after prefix.'));
50
  }
51
  # fill with zeros
52
  $customer_number = sprintf "%06d", $customer_number;
53

  
54
  # - order_number
55
  #     input: prefix (letters) + up to 7 digits, may be zero
56
  #     output: prefix removed, 7 digits, filled with leading zeros
57
  $order_number = remove_letters_prefix($order_number);
58
  if (!check_digits_and_max_length($order_number, 7)) {
59
    $::form->error($::locale->text('Order number invalid. Must be less then or equal to 7 digits after prefix.'));
60
  }
61
  # fill with zeros
62
  $order_number = sprintf "%07d", $order_number;
63

  
64
  # - invoice_number
65
  #     input: prefix (letters) + up to 7 digits, may be zero
66
  #     output: prefix removed, 7 digits, filled with leading zeros
67
  $invoice_number = remove_letters_prefix($invoice_number);
68
  if (!check_digits_and_max_length($invoice_number, 7)) {
69
    $::form->error($::locale->text('Invoice number invalid. Must be less then or equal to 7 digits after prefix.'));
70
  }
71
  # fill with zeros
72
  $invoice_number = sprintf "%07d", $invoice_number;
73

  
74
  # assemble ref. number
75
  my $ref_number = $bank_id . $customer_number . $order_number . $invoice_number;
76

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

  
80
  $main::lxdebug->leave_sub();
81
  return $ref_number_cpl;
82
}
83

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

  
87
  my $ref_number = $_[0];
88

  
89
  # create ref. number in format:
90
  # 'XX XXXXX XXXXX XXXXX XXXXX XXXXX' (2 digits + 5 x 5 digits)
91
  my $ref_number_spaced = substr($ref_number, 0, 2) . ' ' .
92
                          substr($ref_number, 2, 5) . ' ' .
93
                          substr($ref_number, 7, 5) . ' ' .
94
                          substr($ref_number, 12, 5) . ' ' .
95
                          substr($ref_number, 17, 5) . ' ' .
96
                          substr($ref_number, 22, 5);
97

  
98
  $main::lxdebug->leave_sub();
99
  return $ref_number_spaced;
100
}
101

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

  
105
  my $iban = $_[0];
106

  
107
  # create iban number in format:
108
  # 'XXXX XXXX XXXX XXXX XXXX X' (5 x 4 + 1digits)
109
  my $iban_spaced = substr($iban, 0, 4) . ' ' .
110
                    substr($iban, 4, 4) . ' ' .
111
                    substr($iban, 8, 4) . ' ' .
112
                    substr($iban, 12, 4) . ' ' .
113
                    substr($iban, 16, 4) . ' ' .
114
                    substr($iban, 20, 1);
115

  
116
  $main::lxdebug->leave_sub();
117
  return $iban_spaced;
118
}
119

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

  
123
  unless ($_[0] =~ /^\d+\.\d{2}$/) {
124
    $::form->error($::locale->text('Amount has wrong format.'));
125
  }
126

  
127
  local $_ = shift;
128
  $_ = reverse split //;
129
  m/^\d{2}\./g;
130
  s/\G(\d{3})(?=\d)/$1 /g;
131

  
132
  $main::lxdebug->leave_sub();
133
  return scalar reverse split //;
134
}
135

  
136
### internal functions
137

  
138
sub remove_letters_prefix {
139
  my $s = $_[0];
140
  $s =~ s/^[a-zA-Z]+//;
141
  return $s;
142
}
143

  
144
sub check_digits_and_max_length {
145
  my $s = $_[0];
146
  my $length = $_[1];
147

  
148
  return 0 if (!($s =~ /^\d*$/) || length($s) > $length);
149
  return 1;
150
}
151

  
152
sub calculate_check_digit {
153
  # calculate ESR check digit using algorithm: "modulo 10, recursive"
154
  my $ref_number_str = $_[0];
155

  
156
  my @m = (0, 9, 4, 6, 8, 2, 7, 1, 3, 5);
157
  my $carry = 0;
158

  
159
  my @ref_number_split = map int($_), split(//, $ref_number_str);
160

  
161
  for my $v (@ref_number_split) {
162
    $carry = @m[($carry + $v) % 10];
163
  }
164

  
165
  return (10 - $carry) % 10;
166
}
167

  
168
1;
169

  
170
__END__
171

  
172
=encoding utf-8
173

  
174
=head1 NAME
175

  
176
SL::Helper::QrBillFunctions - Additional helper functions for the swiss QR bill
177

  
178
=head1 SYNOPSIS
179

  
180
  use SL::Helper::QrBillFunctions qw(get_qrbill_account assemble_ref_number
181
    get_ref_number_formatted get_iban_formatted get_amount_formatted);
182

  
183
  # get qr-account data
184
  my $qr_account = get_qrbill_account();
185

  
186
  my $ref_number = assemble_ref_number(
187
    $qr_account->{'bank_account_id'},
188
    $form->{'customernumber'},
189
    $form->{'ordnumber'},
190
    $form->{'invnumber'},
191
  );
192

  
193
  # get ref. number/iban formatted with spaces and set into form for template
194
  # processing
195
  $form->{'ref_number_formatted'} = get_ref_number_formatted($ref_number);
196
  $form->{'iban_formatted'} = get_iban_formatted($qr_account->{'iban'});
197

  
198
  # format amount for template
199
  $form->{'amount_formatted'} = get_amount_formatted(
200
    sprintf(
201
      "%.2f",
202
      $form->parse_amount(\%::myconfig, $form->{'total'})
203
    )
204
  );
205

  
206
=head1 DESCRIPTION
207

  
208
Helper functions moved from SL::Template::OpenDocument.
209

  
210
=head1 FUNCTIONS
211

  
212
=over 4
213

  
214
=item C<get_qrbill_account>
215

  
216
Return the bank account flagged for the QR bill.
217

  
218
=item C<assemble_ref_number>
219

  
220
Assembles and returns the Swiss reference number. 27 digits, formed
221
from the parameters plus one check digit.
222

  
223
Prefixes will be removed and numbers filled up with leading zeros.
224

  
225
Parameters:
226

  
227
=over 4
228

  
229
=item C<bank_id>
230

  
231
"Bankkonto Identifikationsnummer". 6 digit number.
232

  
233
=item C<customer_number>
234

  
235
Kivitendo customer number. Prefix (letters) and up to 6 digits.
236

  
237
=item C<order_number>
238

  
239
Kivitendo order number. Prefix (letters) and up to 7 digits, may be zero.
240

  
241
=item C<invoice_number>
242

  
243
Kivitendo invoice number. Prefix (letters) and up to 7 digits, may be zero.
244

  
245
=back
246

  
247
=item C<get_ref_number_formatted>
248

  
249
Given a reference number, return it in format:
250

  
251
'XX XXXXX XXXXX XXXXX XXXXX XXXXX' (2 digits + 5 x 5 digits)
252

  
253
=item C<get_iban_formatted>
254

  
255
Given a IBAN number, return it in format:
256

  
257
'XXXX XXXX XXXX XXXX XXXX X' (5 x 4 + 1digits)
258

  
259
=item C<get_amount_formatted>
260

  
261
Given an amount, return it in format: 'X XXX.XX'
262

  
263
=back
264

  
265
=head1 ERROR HANDLING
266

  
267
Currently errors are thrown via form e.g.:
268

  
269
  $::form->error($::locale->text('Bank account id number invalid. Must be 6 digits.'));
270

  
271
=head1 AUTHOR
272

  
273
Cem Aydin E<lt>cem.aydin@gmx.chE<gt>
274

  
275
=cut
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