Projekt

Allgemein

Profil

« Zurück | Weiter » 

Revision 8326cedc

Von Steven Schubiger vor fast 3 Jahren hinzugefügt

  • ID 8326cedca10878329ad4d5bf6405f977e14a541c
  • Vorgänger 3008f8b7
  • Nachfolger a11b7df1

Swiss QR-Bill: QrBill.pm Modul

Rebase von 38 Commits.

Unterschiede anzeigen:

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

  
3
use strict;
4
use warnings;
5

  
6
use Imager;
7
use Imager::QRCode;
8

  
9
my %Config = (
10
  cross_file => 'image/CH-Kreuz_7mm.png',
11
  out_file   => 'out.png',
12
);
13

  
14
sub new {
15
  my $class = shift;
16

  
17
  my $self = bless {}, $class;
18

  
19
  $self->_init_check(@_);
20
  $self->_init(@_);
21

  
22
  return $self;
23
}
24

  
25
sub _init {
26
  my $self = shift;
27
  my ($biller_information, $biller_data, $payment_information, $invoice_recipient_data, $ref_nr_data) = @_;
28

  
29
  $self->{data}{header} = [
30
    'SPC',  # QRType
31
    '0200', # Version
32
     1,     # Coding Type
33
  ];
34
  $self->{data}{biller_information} = [
35
    $biller_information->{iban},
36
  ];
37
  $self->{data}{biller_data} = [
38
    $biller_data->{address_type},
39
    $biller_data->{company},
40
    $biller_data->{address_row1},
41
    $biller_data->{address_row2},
42
    '',
43
    '',
44
    $biller_data->{countrycode},
45
  ];
46
  $self->{data}{payment_information} = [
47
    $payment_information->{amount},
48
    $payment_information->{currency},
49
  ];
50
  $self->{data}{invoice_recipient_data} = [
51
    $invoice_recipient_data->{address_type},
52
    $invoice_recipient_data->{name},
53
    $invoice_recipient_data->{address_row1},
54
    $invoice_recipient_data->{address_row2},
55
    '',
56
    '',
57
    $invoice_recipient_data->{countrycode},
58
  ];
59
  $self->{data}{ref_nr_data} = [
60
    $ref_nr_data->{type},
61
    $ref_nr_data->{ref_number},
62
  ];
63
  $self->{data}{additional_information} = [
64
    '',
65
    'EPD', # End Payment Data
66
  ];
67
}
68

  
69
sub _init_check {
70
  my $self = shift;
71
  my ($biller_information, $biller_data, $payment_information, $invoice_recipient_data, $ref_nr_data) = @_;
72

  
73
  my $check_re = sub {
74
    my ($href, $elem, $regex) = @_;
75
    defined $href->{$elem} && $href->{$elem} =~ $regex
76
      or die "parameter '$elem' not valid", "\n";
77
  };
78

  
79
  $check_re->($biller_information, 'iban', qr{^(?:CH|LI)[0-9a-zA-Z]{19}$});
80

  
81
  $check_re->($biller_data, 'address_type', qr{^[KS]$});
82
  $check_re->($biller_data, 'company', qr{^.{1,70}$});
83
  $check_re->($biller_data, 'address_row1', qr{^.{0,70}$});
84
  $check_re->($biller_data, 'address_row2', qr{^.{0,70}$});
85
  $check_re->($biller_data, 'countrycode', qr{^[A-Z]{2}$});
86

  
87
  $check_re->($payment_information, 'amount', qr{^(?:(?:0|[1-9][0-9]{0,8})\.[0-9]{2})?$});
88
  $check_re->($payment_information, 'currency', qr{^(?:CHF|EUR)$});
89

  
90
  $check_re->($invoice_recipient_data, 'address_type', qr{^[KS]$});
91
  $check_re->($invoice_recipient_data, 'name', qr{^.{1,70}$});
92
  $check_re->($invoice_recipient_data, 'address_row1', qr{^.{0,70}$});
93
  $check_re->($invoice_recipient_data, 'address_row2', qr{^.{0,70}$});
94
  $check_re->($invoice_recipient_data, 'countrycode', qr{^[A-Z]{2}$});
95

  
96
  $check_re->($ref_nr_data, 'type', qr{^(?:QRR|SCOR|NON)$});
97
  $check_re->($ref_nr_data, 'ref_number', qr{^\d{27}$});
98
}
99

  
100
sub generate {
101
  my $self = shift;
102
  my $out_file = defined $_[0] ? $_[0] : $Config{out_file};
103

  
104
  $self->{qrcode} = $self->_qrcode();
105
  $self->{cross}  = $self->_cross();
106
  $self->{img}    = $self->_plot();
107

  
108
  $self->_paste();
109
  $self->_write($out_file);
110
}
111

  
112
sub _qrcode {
113
  my $self = shift;
114

  
115
  return Imager::QRCode->new(
116
    size   =>  3,
117
    margin =>  1,
118
    level  => 'M',
119
  );
120
}
121

  
122
sub _cross {
123
  my $self = shift;
124

  
125
  my $cross = Imager->new();
126
  $cross->read(file => $Config{cross_file}) or die $cross->errstr, "\n";
127

  
128
  return $cross->scale(xpixels => 27, ypixels => 27, qtype => 'mixing');
129
}
130

  
131
sub _plot {
132
  my $self = shift;
133

  
134
  my @data = (
135
    @{$self->{data}{header}},
136
    @{$self->{data}{biller_information}},
137
    @{$self->{data}{biller_data}},
138
    ('') x 7, # for future use
139
    @{$self->{data}{payment_information}},
140
    @{$self->{data}{invoice_recipient_data}},
141
    @{$self->{data}{ref_nr_data}},
142
    @{$self->{data}{additional_information}},
143
  );
144

  
145
  foreach (@data) {
146
    s/[\r\n]/ /g;
147
    s/ {2,}/ /g;
148
    s/^\s+//;
149
    s/\s+$//;
150
  }
151
                  # CR + LF
152
  my $text = join "\015\012", @data;
153

  
154
  return $self->{qrcode}->plot($text);
155
}
156

  
157
sub _paste {
158
  my $self = shift;
159

  
160
  $self->{img}->paste(
161
    src  => $self->{cross},
162
    left => ($self->{img}->getwidth  / 2) - ($self->{cross}->getwidth  / 2),
163
    top  => ($self->{img}->getheight / 2) - ($self->{cross}->getheight / 2),
164
  );
165
}
166

  
167
sub _write {
168
  my $self = shift;
169
  my ($out_file) = @_;
170

  
171
  $self->{img}->write(file => $out_file) or die $self->{img}->errstr, "\n";
172
}
173

  
174
1;
175

  
176
__END__
177

  
178
=encoding utf-8
179

  
180
=head1 NAME
181

  
182
SL::Helper::QrBill - Helper methods for generating Swiss QR-Code
183

  
184
=head1 SYNOPSIS
185

  
186
     use SL::Helper::QrBill;
187

  
188
     eval {
189
       my $qr_image = SL::Helper::QrBill->new(
190
         \%biller_information,
191
         \%biller_data,
192
         \%payment_information,
193
         \%invoice_recipient_data,
194
         \%ref_nr_data,
195
       );
196
       $qr_image->generate($outfile);
197
     } or do {
198
       local $_ = $@; chomp; my $error = $_;
199
       $::form->error($::locale->text('QR-Image generation failed: ' . $error));
200
     };
201

  
202
=head1 DESCRIPTION
203

  
204
This module generates the Swiss QR-Code with data provided to the constructor.
205

  
206
=head1 METHODS
207

  
208
=head2 C<new>
209

  
210
Creates a new object. Expects five references to hashes as arguments.
211

  
212
The hashes are structured as follows:
213

  
214
=over 4
215

  
216
=item C<%biller_information>
217

  
218
Fields: iban.
219

  
220
=over 4
221

  
222
=item C<iban>
223

  
224
Fixed length; 21 alphanumerical characters, only IBANs with CH- or LI-
225
country code.
226

  
227
=back
228

  
229
=item C<%biller_data>
230

  
231
Fields: address_type, company, address_row1, address_row2 and countrycode.
232

  
233
=over 4
234

  
235
=item C<address_type>
236

  
237
Fixed length; 1-digit, alphanumerical. 'K' implemented only.
238

  
239
=item C<company>
240

  
241
Maximum of 70 characters, name (surname allowable) or company.
242

  
243
=item C<address_row1>
244

  
245
Maximum of 70 characters, street/nr.
246

  
247
=item C<address_row2>
248

  
249
Maximum of 70 characters, postal code/place.
250

  
251
=item C<countrycode>
252

  
253
2-digit country code according to ISO 3166-1.
254

  
255
=back
256

  
257
=item C<%payment_information>
258

  
259
Fields: amount and currency.
260

  
261
=over 4
262

  
263
=item C<amount>
264

  
265
Decimal, no leading zeroes, maximum of 12 digits (inclusive decimal
266
separator and places). Only dot as decimal separator is permitted.
267

  
268
=item C<currency>
269

  
270
CHF/EUR.
271

  
272
=back
273

  
274
=item C<%invoice_recipient_data>
275

  
276
Fields: address_type, name, address_row1, address_row2 and countrycode.
277

  
278
=over 4
279

  
280
=item C<address_type>
281

  
282
Fixed length; 1-digit, alphanumerical. 'K' implemented only.
283

  
284
=item C<name>
285

  
286
Maximum of 70 characters, name (surname allowable) or company.
287

  
288
=item C<address_row1>
289

  
290
Maximum of 70 characters, street/nr.
291

  
292
=item C<address_row2>
293

  
294
Maximum of 70 characters, postal code/place.
295

  
296
=item C<countrycode>
297

  
298
2-digit country code according to ISO 3166-1.
299

  
300
=back
301

  
302
=item C<%ref_nr_data>
303

  
304
Fields: type and ref_number.
305

  
306
=over 4
307

  
308
=item C<type>
309

  
310
Maximum of 4 characters, alphanumerical. QRR/SCOR/NON.
311

  
312
=item C<ref_number>
313

  
314
27 characters, numerical. QR-Reference.
315

  
316
=back
317

  
318
=back
319

  
320
=head2 C<generate>
321

  
322
Generates the QR-Code image. Accepts filename of image as argument.
323
Defaults to C<out.png>.
324

  
325
=head1 AUTHOR
326

  
327
Steven Schubiger E<lt>stsc@refcnt.orgE<gt>
328

  
329
=cut
SL/InstallationCheck.pm
43 43
  { name => 'HTML::Parser',                        url => 'http://search.cpan.org/~gaas/',      debian => 'libhtml-parser-perl', },
44 44
  { name => 'HTML::Restrict',                      url => 'http://search.cpan.org/~oalders/',   debian => 'libhtml-restrict-perl'},
45 45
  { name => "Image::Info",                         url => "http://search.cpan.org/~srezic/",    debian => 'libimage-info-perl' },
46
  { name => "Imager",                              url => "http://search.cpan.org/~tonyc/",     debian => 'libimager-perl' },
47
  { name => "Imager::QRCode",                      url => "http://search.cpan.org/~kurihara/",  debian => 'libimager-qrcode-perl' },
46 48
  { name => "JSON",                                url => "http://search.cpan.org/~makamaka",   debian => 'libjson-perl' },
47 49
  { name => "List::MoreUtils", version => '0.30',  url => "http://search.cpan.org/~vparseval/", debian => 'liblist-moreutils-perl' },
48 50
  { name => "List::UtilsBy",   version => '0.09',  url => "http://search.cpan.org/~pevans/",    debian => 'liblist-utilsby-perl' },

Auch abrufbar als: Unified diff