kivitendo/SL/Helper/QrBill.pm @ 94f827e0
| a642ab4b | Steven Schubiger | # This module consists of helper methods for generating Swiss
|
||
# billing QR-Code.
|
||||
| 8326cedc | Steven Schubiger | package SL::Helper::QrBill;
|
||
use strict;
|
||||
use warnings;
|
||||
| 1570b866 | Steven Schubiger | use File::Spec ();
|
||
| 9c81991b | Steven Schubiger | use Imager ();
|
||
use Imager::QRCode ();
|
||||
| 8326cedc | Steven Schubiger | |||
| 99af8f9b | Steven Schubiger | our $VERSION = '0.01';
|
||
| 8326cedc | Steven Schubiger | my %Config = (
|
||
| 1570b866 | Steven Schubiger | img_dir => 'image',
|
||
cross_file => 'CH-Kreuz_7mm.png',
|
||||
| 8326cedc | Steven Schubiger | out_file => 'out.png',
|
||
);
|
||||
| 3ed0f2ce | Steven Schubiger | # Validate data, populate structures and return a
|
||
# SL::Helper::QrBill object.
|
||||
| 8326cedc | Steven Schubiger | sub new {
|
||
my $class = shift;
|
||||
my $self = bless {}, $class;
|
||||
$self->_init_check(@_);
|
||||
$self->_init(@_);
|
||||
return $self;
|
||||
}
|
||||
| 3ed0f2ce | Steven Schubiger | # Populate the data structures with data received by the
|
||
# constructor.
|
||||
| 8326cedc | Steven Schubiger | sub _init {
|
||
my $self = shift;
|
||||
| d21df2ea | Steven Schubiger | my ($biller_information, $biller_data, $payment_information, $invoice_recipient_data, $ref_nr_data, $additional_information) = @_;
|
||
| 8326cedc | Steven Schubiger | |||
| 07edce60 | Steven Schubiger | my $address = sub {
|
||
my ($href) = @_;
|
||||
my $address_type = $href->{address_type};
|
||||
return ((map $href->{$_}, qw(address_row1 address_row2)), '', '')
|
||||
if $address_type eq 'K';
|
||||
return (map $href->{$_}, qw(street street_no postalcode city))
|
||||
if $address_type eq 'S';
|
||||
};
|
||||
| 8326cedc | Steven Schubiger | $self->{data}{header} = [
|
||
'SPC', # QRType
|
||||
'0200', # Version
|
||||
1, # Coding Type
|
||||
];
|
||||
$self->{data}{biller_information} = [
|
||||
$biller_information->{iban},
|
||||
];
|
||||
$self->{data}{biller_data} = [
|
||||
$biller_data->{address_type},
|
||||
$biller_data->{company},
|
||||
| 07edce60 | Steven Schubiger | $address->($biller_data),
|
||
| 8326cedc | Steven Schubiger | $biller_data->{countrycode},
|
||
];
|
||||
$self->{data}{payment_information} = [
|
||||
$payment_information->{amount},
|
||||
$payment_information->{currency},
|
||||
];
|
||||
$self->{data}{invoice_recipient_data} = [
|
||||
$invoice_recipient_data->{address_type},
|
||||
$invoice_recipient_data->{name},
|
||||
| 07edce60 | Steven Schubiger | $address->($invoice_recipient_data),
|
||
| 8326cedc | Steven Schubiger | $invoice_recipient_data->{countrycode},
|
||
];
|
||||
$self->{data}{ref_nr_data} = [
|
||||
$ref_nr_data->{type},
|
||||
$ref_nr_data->{ref_number},
|
||||
];
|
||||
$self->{data}{additional_information} = [
|
||||
| d21df2ea | Steven Schubiger | $additional_information->{unstructured_message},
|
||
| 8326cedc | Steven Schubiger | 'EPD', # End Payment Data
|
||
];
|
||||
}
|
||||
| 3ed0f2ce | Steven Schubiger | # Validate the data with regular expressions and exit ungracefully
|
||
# if conditions are not matched.
|
||||
| 8326cedc | Steven Schubiger | sub _init_check {
|
||
my $self = shift;
|
||||
| d21df2ea | Steven Schubiger | my ($biller_information, $biller_data, $payment_information, $invoice_recipient_data, $ref_nr_data, $additional_information) = @_;
|
||
| 8326cedc | Steven Schubiger | |||
my $check_re = sub {
|
||||
| 62b01d9c | Steven Schubiger | my ($group, $href, $elem, $regex) = @_;
|
||
| 9c49e265 | Steven Schubiger | my $error = undef;
|
||
if (!exists $href->{$elem}) {
|
||||
$error = 'does not exist';
|
||||
} elsif (!defined $href->{$elem}) {
|
||||
$error = 'is not defined';
|
||||
} elsif ($href->{$elem} !~ $regex) {
|
||||
$error = 'is not valid';
|
||||
}
|
||||
die "field '$elem' in group '$group' $error", "\n" if defined $error;
|
||||
| 8326cedc | Steven Schubiger | };
|
||
| 824edcc4 | Steven Schubiger | my %regexes = (
|
||
'biller information' => [
|
||||
[ 'iban', qr{^(?:CH|LI)[0-9a-zA-Z]{19}$} ],
|
||||
],
|
||||
'biller data' => [
|
||||
[ 'address_type', qr{^[KS]$} ],
|
||||
[ 'company', qr{^.{1,70}$} ],
|
||||
| 2f2de4f2 | Steven Schubiger | [ 'address_row1', qr{^.{0,70}$} ], # combined (K)
|
||
[ 'address_row2', qr{^.{0,70}$} ], # "
|
||||
[ 'street', qr{^.{0,70}$} ], # structured (S)
|
||||
[ 'street_no', qr{^.{0,16}$} ], # "
|
||||
[ 'postalcode', qr{^.{0,16}$} ], # "
|
||||
[ 'city', qr{^.{0,35}$} ], # "
|
||||
| 824edcc4 | Steven Schubiger | [ 'countrycode', qr{^[A-Z]{2}$} ],
|
||
],
|
||||
'payment information' => [
|
||||
[ 'amount', qr{^(?:(?:0|[1-9][0-9]{0,8})\.[0-9]{2})?$} ],
|
||||
[ 'currency', qr{^(?:CHF|EUR)$} ],
|
||||
],
|
||||
'invoice recipient data' => [
|
||||
[ 'address_type', qr{^[KS]$} ],
|
||||
[ 'name', qr{^.{1,70}$} ],
|
||||
| 2f2de4f2 | Steven Schubiger | [ 'address_row1', qr{^.{0,70}$} ], # combined (K)
|
||
[ 'address_row2', qr{^.{0,70}$} ], # "
|
||||
[ 'street', qr{^.{0,70}$} ], # structured (S)
|
||||
[ 'street_no', qr{^.{0,16}$} ], # "
|
||||
[ 'postalcode', qr{^.{0,16}$} ], # "
|
||||
[ 'city', qr{^.{0,35}$} ], # "
|
||||
| 824edcc4 | Steven Schubiger | [ 'countrycode', qr{^[A-Z]{2}$} ],
|
||
],
|
||||
'reference number data' => [
|
||||
| 1726954a | Steven Schubiger | [ 'type', qr{^(?:QRR|NON)$} ],
|
||
| 824edcc4 | Steven Schubiger | ],
|
||
| d21df2ea | Steven Schubiger | 'additional information' => [
|
||
[ 'unstructured_message', qr{^.{0,140}$} ],
|
||||
],
|
||||
| 69a27305 | Steven Schubiger | additional => {
|
||
| 766c828a | Steven Schubiger | 'ref_nr' => {
|
||
QRR => qr{^\d{27}$},
|
||||
NON => qr{^$},
|
||||
},
|
||||
| 69a27305 | Steven Schubiger | 'qr_iban' => qr{^.{4}3[01][0-9]{3}.{12}$},
|
||
},
|
||||
| 824edcc4 | Steven Schubiger | );
|
||
| 62b01d9c | Steven Schubiger | my $group = 'biller information';
|
||
| 824edcc4 | Steven Schubiger | foreach my $re (@{$regexes{$group}}) {
|
||
$check_re->($group, $biller_information, @$re);
|
||||
}
|
||||
| 8326cedc | Steven Schubiger | |||
| 62b01d9c | Steven Schubiger | $group = 'biller data';
|
||
| 824edcc4 | Steven Schubiger | foreach my $re (grep $_->[0] =~ /^(?:address_type|company)$/, @{$regexes{$group}}) {
|
||
$check_re->($group, $biller_data, @$re);
|
||||
}
|
||||
| 07edce60 | Steven Schubiger | if ($biller_data->{address_type} eq 'K') {
|
||
| 824edcc4 | Steven Schubiger | foreach my $re (grep $_->[0] =~ /^address_row[12]$/, @{$regexes{$group}}) {
|
||
$check_re->($group, $biller_data, @$re);
|
||||
}
|
||||
| 07edce60 | Steven Schubiger | } elsif ($biller_data->{address_type} eq 'S') {
|
||
| 824edcc4 | Steven Schubiger | foreach my $re (grep $_->[0] =~ /^(?:street(?:_no)?|postalcode|city)$/, @{$regexes{$group}}) {
|
||
$check_re->($group, $biller_data, @$re);
|
||||
}
|
||||
}
|
||||
foreach my $re (grep $_->[0] =~ /^countrycode$/, @{$regexes{$group}}) {
|
||||
$check_re->($group, $biller_data, @$re);
|
||||
| 07edce60 | Steven Schubiger | }
|
||
| 8326cedc | Steven Schubiger | |||
| 62b01d9c | Steven Schubiger | $group = 'payment information';
|
||
| 824edcc4 | Steven Schubiger | foreach my $re (@{$regexes{$group}}) {
|
||
$check_re->($group, $payment_information, @$re);
|
||||
}
|
||||
| 8326cedc | Steven Schubiger | |||
| 62b01d9c | Steven Schubiger | $group = 'invoice recipient data';
|
||
| 824edcc4 | Steven Schubiger | foreach my $re (grep $_->[0] =~ /^(?:address_type|name)$/, @{$regexes{$group}}) {
|
||
$check_re->($group, $invoice_recipient_data, @$re);
|
||||
}
|
||||
| 07edce60 | Steven Schubiger | if ($invoice_recipient_data->{address_type} eq 'K') {
|
||
| 824edcc4 | Steven Schubiger | foreach my $re (grep $_->[0] =~ /^address_row[12]$/, @{$regexes{$group}}) {
|
||
$check_re->($group, $invoice_recipient_data, @$re);
|
||||
}
|
||||
| 07edce60 | Steven Schubiger | } elsif ($invoice_recipient_data->{address_type} eq 'S') {
|
||
| 824edcc4 | Steven Schubiger | foreach my $re (grep $_->[0] =~ /^(?:street(?:_no)?|postalcode|city)$/, @{$regexes{$group}}) {
|
||
$check_re->($group, $invoice_recipient_data, @$re);
|
||||
}
|
||||
}
|
||||
foreach my $re (grep $_->[0] =~ /^countrycode$/, @{$regexes{$group}}) {
|
||||
$check_re->($group, $invoice_recipient_data, @$re);
|
||||
| 07edce60 | Steven Schubiger | }
|
||
| 8326cedc | Steven Schubiger | |||
| 62b01d9c | Steven Schubiger | $group = 'reference number data';
|
||
| 824edcc4 | Steven Schubiger | foreach my $re (@{$regexes{$group}}) {
|
||
$check_re->($group, $ref_nr_data, @$re);
|
||||
}
|
||||
| 766c828a | Steven Schubiger | $check_re->($group, $ref_nr_data, 'ref_number', $regexes{additional}->{ref_nr}{$ref_nr_data->{type}});
|
||
| 69a27305 | Steven Schubiger | |||
$group = 'biller information';
|
||||
if ($ref_nr_data->{type} eq 'QRR') {
|
||||
$check_re->($group, $biller_information, 'iban', $regexes{additional}->{qr_iban});
|
||||
}
|
||||
| d21df2ea | Steven Schubiger | |||
$group = 'additional information';
|
||||
foreach my $re (@{$regexes{$group}}) {
|
||||
$check_re->($group, $additional_information, @$re);
|
||||
}
|
||||
| 8326cedc | Steven Schubiger | }
|
||
| 3ed0f2ce | Steven Schubiger | # Generate the QR-Code image by calling internal methods.
|
||
| 8326cedc | Steven Schubiger | sub generate {
|
||
my $self = shift;
|
||||
| 97031bd9 | Steven Schubiger | my $out_file = $_[0] // $Config{out_file};
|
||
| 8326cedc | Steven Schubiger | |||
$self->{qrcode} = $self->_qrcode();
|
||||
$self->{cross} = $self->_cross();
|
||||
$self->{img} = $self->_plot();
|
||||
$self->_paste();
|
||||
$self->_write($out_file);
|
||||
}
|
||||
| 3ed0f2ce | Steven Schubiger | # Return a new Imager::QRCode object.
|
||
| 8326cedc | Steven Schubiger | sub _qrcode {
|
||
my $self = shift;
|
||||
return Imager::QRCode->new(
|
||||
| 12508054 | Steven Schubiger | size => 4,
|
||
margin => 0,
|
||||
| 8326cedc | Steven Schubiger | level => 'M',
|
||
);
|
||||
}
|
||||
| 3ed0f2ce | Steven Schubiger | # Read the cross file and scale the resulting image.
|
||
| 8326cedc | Steven Schubiger | sub _cross {
|
||
my $self = shift;
|
||||
my $cross = Imager->new();
|
||||
| 1570b866 | Steven Schubiger | $cross->read(file => File::Spec->catfile(@Config{qw(img_dir cross_file)})) or die $cross->errstr, "\n";
|
||
| 8326cedc | Steven Schubiger | |||
| 50b0d77d | Cem Aydin | return $cross->scale(xpixels => 35, ypixels => 35, qtype => 'mixing');
|
||
| 8326cedc | Steven Schubiger | }
|
||
| 3ed0f2ce | Steven Schubiger | # Order and modify the structured data, form the text and plot it.
|
||
| 8326cedc | Steven Schubiger | sub _plot {
|
||
my $self = shift;
|
||||
my @data = (
|
||||
@{$self->{data}{header}},
|
||||
@{$self->{data}{biller_information}},
|
||||
@{$self->{data}{biller_data}},
|
||||
('') x 7, # for future use
|
||||
@{$self->{data}{payment_information}},
|
||||
@{$self->{data}{invoice_recipient_data}},
|
||||
@{$self->{data}{ref_nr_data}},
|
||||
@{$self->{data}{additional_information}},
|
||||
);
|
||||
foreach (@data) {
|
||||
s/[\r\n]/ /g;
|
||||
s/ {2,}/ /g;
|
||||
s/^\s+//;
|
||||
s/\s+$//;
|
||||
}
|
||||
# CR + LF
|
||||
my $text = join "\015\012", @data;
|
||||
return $self->{qrcode}->plot($text);
|
||||
}
|
||||
| 3ed0f2ce | Steven Schubiger | # Paste cross image onto the middle of the QR-Code image.
|
||
| 8326cedc | Steven Schubiger | sub _paste {
|
||
my $self = shift;
|
||||
$self->{img}->paste(
|
||||
src => $self->{cross},
|
||||
left => ($self->{img}->getwidth / 2) - ($self->{cross}->getwidth / 2),
|
||||
top => ($self->{img}->getheight / 2) - ($self->{cross}->getheight / 2),
|
||||
);
|
||||
}
|
||||
| 3ed0f2ce | Steven Schubiger | # Write the QR-Code image to a file.
|
||
| 8326cedc | Steven Schubiger | sub _write {
|
||
my $self = shift;
|
||||
my ($out_file) = @_;
|
||||
$self->{img}->write(file => $out_file) or die $self->{img}->errstr, "\n";
|
||||
}
|
||||
1;
|
||||
__END__
|
||||
=encoding utf-8
|
||||
=head1 NAME
|
||||
| a642ab4b | Steven Schubiger | SL::Helper::QrBill - Helper methods for generating Swiss billing QR-Code
|
||
| 8326cedc | Steven Schubiger | |||
=head1 SYNOPSIS
|
||||
use SL::Helper::QrBill;
|
||||
eval {
|
||||
my $qr_image = SL::Helper::QrBill->new(
|
||||
\%biller_information,
|
||||
\%biller_data,
|
||||
\%payment_information,
|
||||
\%invoice_recipient_data,
|
||||
\%ref_nr_data,
|
||||
| d21df2ea | Steven Schubiger | \%additional_information,
|
||
| 8326cedc | Steven Schubiger | );
|
||
| 97031bd9 | Steven Schubiger | $qr_image->generate($out_file);
|
||
| 8326cedc | Steven Schubiger | } or do {
|
||
local $_ = $@; chomp; my $error = $_;
|
||||
$::form->error($::locale->text('QR-Image generation failed: ' . $error));
|
||||
};
|
||||
=head1 DESCRIPTION
|
||||
| a642ab4b | Steven Schubiger | This module generates the Swiss billing QR-Code with data provided to the constructor.
|
||
| 8326cedc | Steven Schubiger | |||
=head1 METHODS
|
||||
=head2 C<new>
|
||||
| d21df2ea | Steven Schubiger | Creates a new object. Expects six references to hashes as arguments.
|
||
| 8326cedc | Steven Schubiger | |||
The hashes are structured as follows:
|
||||
=over 4
|
||||
=item C<%biller_information>
|
||||
Fields: iban.
|
||||
=over 4
|
||||
=item C<iban>
|
||||
Fixed length; 21 alphanumerical characters, only IBANs with CH- or LI-
|
||||
country code.
|
||||
=back
|
||||
=item C<%biller_data>
|
||||
| 07edce60 | Steven Schubiger | Fields (mandatory): address_type, company and countrycode.
|
||
Fields (combined): address_row1 and address_row2.
|
||||
Fields (structured): street, street_no, postalcode and city.
|
||||
| 8326cedc | Steven Schubiger | |||
=over 4
|
||||
=item C<address_type>
|
||||
| 07edce60 | Steven Schubiger | Fixed length; 1-digit, alphanumerical.
|
||
| 8326cedc | Steven Schubiger | |||
=item C<company>
|
||||
Maximum of 70 characters, name (surname allowable) or company.
|
||||
=item C<address_row1>
|
||||
| 07edce60 | Steven Schubiger | Maximum of 70 characters, street/no.
|
||
| 8326cedc | Steven Schubiger | |||
=item C<address_row2>
|
||||
| 07edce60 | Steven Schubiger | Maximum of 70 characters, postal code/city.
|
||
=item C<street>
|
||||
Maximum of 70 characters, street.
|
||||
=item C<street_no>
|
||||
Maximum of 16 characters, street no.
|
||||
=item C<postalcode>
|
||||
Maximum of 16 characters, postal code.
|
||||
=item C<city>
|
||||
Maximum of 35 characters, city.
|
||||
| 8326cedc | Steven Schubiger | |||
=item C<countrycode>
|
||||
2-digit country code according to ISO 3166-1.
|
||||
=back
|
||||
=item C<%payment_information>
|
||||
Fields: amount and currency.
|
||||
=over 4
|
||||
=item C<amount>
|
||||
Decimal, no leading zeroes, maximum of 12 digits (inclusive decimal
|
||||
separator and places). Only dot as decimal separator is permitted.
|
||||
=item C<currency>
|
||||
CHF/EUR.
|
||||
=back
|
||||
=item C<%invoice_recipient_data>
|
||||
| 07edce60 | Steven Schubiger | Fields (mandatory): address_type, name and countrycode.
|
||
Fields (combined): address_row1 and address_row2.
|
||||
Fields (structured): street, street_no, postalcode and city.
|
||||
| 8326cedc | Steven Schubiger | |||
=over 4
|
||||
=item C<address_type>
|
||||
| 07edce60 | Steven Schubiger | Fixed length; 1-digit, alphanumerical.
|
||
| 8326cedc | Steven Schubiger | |||
=item C<name>
|
||||
Maximum of 70 characters, name (surname allowable) or company.
|
||||
=item C<address_row1>
|
||||
| 07edce60 | Steven Schubiger | Maximum of 70 characters, street/no.
|
||
| 8326cedc | Steven Schubiger | |||
=item C<address_row2>
|
||||
| 07edce60 | Steven Schubiger | Maximum of 70 characters, postal code/city.
|
||
=item C<street>
|
||||
Maximum of 70 characters, street.
|
||||
=item C<street_no>
|
||||
Maximum of 16 characters, street no.
|
||||
=item C<postalcode>
|
||||
Maximum of 16 characters, postal code.
|
||||
=item C<city>
|
||||
Maximum of 35 characters, city.
|
||||
| 8326cedc | Steven Schubiger | |||
=item C<countrycode>
|
||||
2-digit country code according to ISO 3166-1.
|
||||
=back
|
||||
=item C<%ref_nr_data>
|
||||
Fields: type and ref_number.
|
||||
=over 4
|
||||
=item C<type>
|
||||
| 1726954a | Steven Schubiger | Maximum of 4 characters, alphanumerical. QRR/NON.
|
||
| 8326cedc | Steven Schubiger | |||
=item C<ref_number>
|
||||
| 13aed1fc | Steven Schubiger | QR-Reference: 27 characters, numerical; without Reference: empty.
|
||
| 8326cedc | Steven Schubiger | |||
=back
|
||||
| d21df2ea | Steven Schubiger | =item C<%additional_information>
|
||
Fields: unstructured_message.
|
||||
=over 4
|
||||
=item C<unstructured_message>
|
||||
Maximum of 140 characters, unstructured message.
|
||||
=back
|
||||
| 8326cedc | Steven Schubiger | =back
|
||
=head2 C<generate>
|
||||
Generates the QR-Code image. Accepts filename of image as argument.
|
||||
Defaults to C<out.png>.
|
||||
| 53b1e8a6 | Steven Schubiger | =head1 TESTS
|
||
Tests may be invoked by executing C<t/test.pl t/helper/qrbill.t>
|
||||
within the root directory of the repository.
|
||||
| 8326cedc | Steven Schubiger | =head1 AUTHOR
|
||
Steven Schubiger E<lt>stsc@refcnt.orgE<gt>
|
||||
=cut
|