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 ($group, $href, $elem, $regex) = @_;
  75     defined $href->{$elem} && $href->{$elem} =~ $regex
  76       or die "field '$elem' in group '$group' not valid", "\n";
  77   };
  78
  79   my $group = 'biller information';
  80   $check_re->($group, $biller_information, 'iban', qr{^(?:CH|LI)[0-9a-zA-Z]{19}$});
  81
  82   $group = 'biller data';
  83   $check_re->($group, $biller_data, 'address_type', qr{^[KS]$});
  84   $check_re->($group, $biller_data, 'company', qr{^.{1,70}$});
  85   $check_re->($group, $biller_data, 'address_row1', qr{^.{0,70}$});
  86   $check_re->($group, $biller_data, 'address_row2', qr{^.{0,70}$});
  87   $check_re->($group, $biller_data, 'countrycode', qr{^[A-Z]{2}$});
  88
  89   $group = 'payment information';
  90   $check_re->($group, $payment_information, 'amount', qr{^(?:(?:0|[1-9][0-9]{0,8})\.[0-9]{2})?$});
  91   $check_re->($group, $payment_information, 'currency', qr{^(?:CHF|EUR)$});
  92
  93   $group = 'invoice recipient data';
  94   $check_re->($group, $invoice_recipient_data, 'address_type', qr{^[KS]$});
  95   $check_re->($group, $invoice_recipient_data, 'name', qr{^.{1,70}$});
  96   $check_re->($group, $invoice_recipient_data, 'address_row1', qr{^.{0,70}$});
  97   $check_re->($group, $invoice_recipient_data, 'address_row2', qr{^.{0,70}$});
  98   $check_re->($group, $invoice_recipient_data, 'countrycode', qr{^[A-Z]{2}$});
  99
 100   $group = 'reference number data';
 101   my %ref_nr_regexes = (
 102     QRR => qr{^\d{27}$},
 103     NON => qr{^$},
 104   );
 105   $check_re->($group, $ref_nr_data, 'type', qr{^(?:QRR|SCOR|NON)$});
 106   $check_re->($group, $ref_nr_data, 'ref_number', $ref_nr_regexes{$ref_nr_data->{type}});
 107 }
 108
 109 sub generate {
 110   my $self = shift;
 111   my $out_file = defined $_[0] ? $_[0] : $Config{out_file};
 112
 113   $self->{qrcode} = $self->_qrcode();
 114   $self->{cross}  = $self->_cross();
 115   $self->{img}    = $self->_plot();
 116
 117   $self->_paste();
 118   $self->_write($out_file);
 119 }
 120
 121 sub _qrcode {
 122   my $self = shift;
 123
 124   return Imager::QRCode->new(
 125     size   =>  4,
 126     margin =>  0,
 127     level  => 'M',
 128   );
 129 }
 130
 131 sub _cross {
 132   my $self = shift;
 133
 134   my $cross = Imager->new();
 135   $cross->read(file => $Config{cross_file}) or die $cross->errstr, "\n";
 136
 137   return $cross->scale(xpixels => 35, ypixels => 35, qtype => 'mixing');
 138 }
 139
 140 sub _plot {
 141   my $self = shift;
 142
 143   my @data = (
 144     @{$self->{data}{header}},
 145     @{$self->{data}{biller_information}},
 146     @{$self->{data}{biller_data}},
 147     ('') x 7, # for future use
 148     @{$self->{data}{payment_information}},
 149     @{$self->{data}{invoice_recipient_data}},
 150     @{$self->{data}{ref_nr_data}},
 151     @{$self->{data}{additional_information}},
 152   );
 153
 154   foreach (@data) {
 155     s/[\r\n]/ /g;
 156     s/ {2,}/ /g;
 157     s/^\s+//;
 158     s/\s+$//;
 159   }
 160                   # CR + LF
 161   my $text = join "\015\012", @data;
 162
 163   return $self->{qrcode}->plot($text);
 164 }
 165
 166 sub _paste {
 167   my $self = shift;
 168
 169   $self->{img}->paste(
 170     src  => $self->{cross},
 171     left => ($self->{img}->getwidth  / 2) - ($self->{cross}->getwidth  / 2),
 172     top  => ($self->{img}->getheight / 2) - ($self->{cross}->getheight / 2),
 173   );
 174 }
 175
 176 sub _write {
 177   my $self = shift;
 178   my ($out_file) = @_;
 179
 180   $self->{img}->write(file => $out_file) or die $self->{img}->errstr, "\n";
 181 }
 182
 183 1;
 184
 185 __END__
 186
 187 =encoding utf-8
 188
 189 =head1 NAME
 190
 191 SL::Helper::QrBill - Helper methods for generating Swiss QR-Code
 192
 193 =head1 SYNOPSIS
 194
 195      use SL::Helper::QrBill;
 196
 197      eval {
 198        my $qr_image = SL::Helper::QrBill->new(
 199          \%biller_information,
 200          \%biller_data,
 201          \%payment_information,
 202          \%invoice_recipient_data,
 203          \%ref_nr_data,
 204        );
 205        $qr_image->generate($outfile);
 206      } or do {
 207        local $_ = $@; chomp; my $error = $_;
 208        $::form->error($::locale->text('QR-Image generation failed: ' . $error));
 209      };
 210
 211 =head1 DESCRIPTION
 212
 213 This module generates the Swiss QR-Code with data provided to the constructor.
 214
 215 =head1 METHODS
 216
 217 =head2 C<new>
 218
 219 Creates a new object. Expects five references to hashes as arguments.
 220
 221 The hashes are structured as follows:
 222
 223 =over 4
 224
 225 =item C<%biller_information>
 226
 227 Fields: iban.
 228
 229 =over 4
 230
 231 =item C<iban>
 232
 233 Fixed length; 21 alphanumerical characters, only IBANs with CH- or LI-
 234 country code.
 235
 236 =back
 237
 238 =item C<%biller_data>
 239
 240 Fields: address_type, company, address_row1, address_row2 and countrycode.
 241
 242 =over 4
 243
 244 =item C<address_type>
 245
 246 Fixed length; 1-digit, alphanumerical. 'K' implemented only.
 247
 248 =item C<company>
 249
 250 Maximum of 70 characters, name (surname allowable) or company.
 251
 252 =item C<address_row1>
 253
 254 Maximum of 70 characters, street/nr.
 255
 256 =item C<address_row2>
 257
 258 Maximum of 70 characters, postal code/place.
 259
 260 =item C<countrycode>
 261
 262 2-digit country code according to ISO 3166-1.
 263
 264 =back
 265
 266 =item C<%payment_information>
 267
 268 Fields: amount and currency.
 269
 270 =over 4
 271
 272 =item C<amount>
 273
 274 Decimal, no leading zeroes, maximum of 12 digits (inclusive decimal
 275 separator and places). Only dot as decimal separator is permitted.
 276
 277 =item C<currency>
 278
 279 CHF/EUR.
 280
 281 =back
 282
 283 =item C<%invoice_recipient_data>
 284
 285 Fields: address_type, name, address_row1, address_row2 and countrycode.
 286
 287 =over 4
 288
 289 =item C<address_type>
 290
 291 Fixed length; 1-digit, alphanumerical. 'K' implemented only.
 292
 293 =item C<name>
 294
 295 Maximum of 70 characters, name (surname allowable) or company.
 296
 297 =item C<address_row1>
 298
 299 Maximum of 70 characters, street/nr.
 300
 301 =item C<address_row2>
 302
 303 Maximum of 70 characters, postal code/place.
 304
 305 =item C<countrycode>
 306
 307 2-digit country code according to ISO 3166-1.
 308
 309 =back
 310
 311 =item C<%ref_nr_data>
 312
 313 Fields: type and ref_number.
 314
 315 =over 4
 316
 317 =item C<type>
 318
 319 Maximum of 4 characters, alphanumerical. QRR/SCOR/NON.
 320
 321 =item C<ref_number>
 322
 323 QR-Reference: 27 characters, numerical; without Reference: empty.
 324
 325 =back
 326
 327 =back
 328
 329 =head2 C<generate>
 330
 331 Generates the QR-Code image. Accepts filename of image as argument.
 332 Defaults to C<out.png>.
 333
 334 =head1 AUTHOR
 335
 336 Steven Schubiger E<lt>stsc@refcnt.orgE<gt>
 337
 338 =cut