projekt kivitendo

package SL::Helper::QrBill;

use strict;

use warnings;

use Imager;

use Imager::QRCode;

my %Config = (

  cross_file => 'image/CH-Kreuz_7mm.png',

  out_file   => 'out.png',

);

sub new {

  my $class = shift;

  my $self = bless {}, $class;

  $self->_init_check(@_);

  $self->_init(@_);

  return $self;

}

sub _init {

  my $self = shift;

  my ($biller_information, $biller_data, $payment_information, $invoice_recipient_data, $ref_nr_data) = @_;

  $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},

    $biller_data->{address_row1},

    $biller_data->{address_row2},

    '',

    '',

    $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},

    $invoice_recipient_data->{address_row1},

    $invoice_recipient_data->{address_row2},

    '',

    '',

    $invoice_recipient_data->{countrycode},

  ];

  $self->{data}{ref_nr_data} = [

    $ref_nr_data->{type},

    $ref_nr_data->{ref_number},

  ];

  $self->{data}{additional_information} = [

    '',

    'EPD', # End Payment Data

  ];

}

sub _init_check {

  my $self = shift;

  my ($biller_information, $biller_data, $payment_information, $invoice_recipient_data, $ref_nr_data) = @_;

  my $check_re = sub {

    my ($href, $elem, $regex) = @_;

    defined $href->{$elem} && $href->{$elem} =~ $regex

      or die "parameter '$elem' not valid", "\n";

  };

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

  $check_re->($biller_data, 'address_type', qr{^[KS]$});

  $check_re->($biller_data, 'company', qr{^.{1,70}$});

  $check_re->($biller_data, 'address_row1', qr{^.{0,70}$});

  $check_re->($biller_data, 'address_row2', qr{^.{0,70}$});

  $check_re->($biller_data, 'countrycode', qr{^[A-Z]{2}$});

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

  $check_re->($payment_information, 'currency', qr{^(?:CHF|EUR)$});

  $check_re->($invoice_recipient_data, 'address_type', qr{^[KS]$});

  $check_re->($invoice_recipient_data, 'name', qr{^.{1,70}$});

  $check_re->($invoice_recipient_data, 'address_row1', qr{^.{0,70}$});

  $check_re->($invoice_recipient_data, 'address_row2', qr{^.{0,70}$});

  $check_re->($invoice_recipient_data, 'countrycode', qr{^[A-Z]{2}$});

  $check_re->($ref_nr_data, 'type', qr{^(?:QRR|SCOR|NON)$});

  $check_re->($ref_nr_data, 'ref_number', qr{^\d{27}$});

}

sub generate {

  my $self = shift;

  my $out_file = defined $_[0] ? $_[0] : $Config{out_file};

  $self->{qrcode} = $self->_qrcode();

  $self->{cross}  = $self->_cross();

  $self->{img}    = $self->_plot();

  $self->_paste();

  $self->_write($out_file);

}

sub _qrcode {

  my $self = shift;

  return Imager::QRCode->new(

    size   =>  3,

    margin =>  1,

    level  => 'M',

  );

}

sub _cross {

  my $self = shift;

  my $cross = Imager->new();

  $cross->read(file => $Config{cross_file}) or die $cross->errstr, "\n";

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

}

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);

}

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),

  );

}

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

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

=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,

       );

       $qr_image->generate($outfile);

     } or do {

       local $_ = $@; chomp; my $error = $_;

       $::form->error($::locale->text('QR-Image generation failed: ' . $error));

     };

=head1 DESCRIPTION

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

=head1 METHODS

=head2 C<new>

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

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>

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

=over 4

=item C<address_type>

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

=item C<company>

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

=item C<address_row1>

Maximum of 70 characters, street/nr.

=item C<address_row2>

Maximum of 70 characters, postal code/place.

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

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

=over 4

=item C<address_type>

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

=item C<name>

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

=item C<address_row1>

Maximum of 70 characters, street/nr.

=item C<address_row2>

Maximum of 70 characters, postal code/place.

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

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

=item C<ref_number>

27 characters, numerical. QR-Reference.

=back

=back

=head2 C<generate>

Generates the QR-Code image. Accepts filename of image as argument.

Defaults to C<out.png>.

=head1 AUTHOR

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

=cut

  { name => "Imager",                              url => "http://search.cpan.org/~tonyc/",     debian => 'libimager-perl' },

  { name => "Imager::QRCode",                      url => "http://search.cpan.org/~kurihara/",  debian => 'libimager-qrcode-perl' },