projekt kivitendo

package SL::Helper::QrBillParser;

use strict;

use warnings;

use Rose::Object::MakeMethods::Generic(

  scalar                  => [ qw(is_valid error raw_data) ],

  'scalar --get_set_init' => [ qw(spec) ],

);

our $VERSION = '0.01';

use constant {

  REGEX_QRTYPE               => qr{^SPC$},

  REGEX_VERSION              => qr{^0200$},

  REGEX_CODING               => qr{^1$},

  REGEX_IBAN                 => qr{^(?:CH|LI)[0-9a-zA-Z]{19}$},

  REGEX_ADDRESS_TYPE         => qr{^[KS]$},

  REGEX_NAME                 => qr{^.{1,70}$},

  REGEX_ADDRESS_LINE         => qr{^.{0,70}$},

  REGEX_POSTAL_CODE          => qr{^.{0,16}$},

  REGEX_TOWN                 => qr{^.{0,35}$},

  REGEX_COUNTRY              => qr{^[A-Za-z]{2}$},

  REGEX_AMOUNT               => qr{^(?:(?:0|[1-9][0-9]{0,8})\.[0-9]{2})?$},

  REGEX_CURRENCY             => qr{^(?:CHF|EUR)$},

  REGEX_REFERENCE_TYPE       => qr{^(?:QRR|SCOR|NON)$},

  REGEX_REFERENCE            => qr{^.{0,27}$},

  REGEX_UNSTRUCTURED_MESSAGE => qr{^.{0,140}$},

  REGEX_TRAILER              => qr{^EPD$},

  REGEX_BILL_INFORMATION     => qr{^.{0,140}$},

  REGEX_ALTERNATIVE_SCHEME_PARAMETER      => qr{^.{0,100}$},

  REGEX_STREET_NAME_FROM_ADDRESS_LINE     => qr{^(.*)\s+\d.*$},

  REGEX_BUILDING_NUMBER_FROM_ADDRESS_LINE => qr{^.*\s+(\d+.*)$},

  REGEX_POSTAL_CODE_FROM_ADDRESS_LINE     => qr{^(\d+).*$},

  REGEX_TOWN_FROM_ADDRESS_LINE            => qr{^\d+\s(.*)$},

};

sub new {

  my $class = shift;

  my $self = bless {}, $class;

  $self->init(@_);

  return $self;

}

sub init {

  my $self = shift;

  my ($qrtext) = @_;

  my @lines = split /(?:\n|\r\n)/, $qrtext;

  $self->is_valid(1);

  $self->error('');

  $self->raw_data($qrtext);

  for my $section ( @{$self->spec} ) {

    for my $field ( @{$section->{fields}} ) {

      my $value = $lines[$field->{line_number}];

      if (!test_value($value, $field->{test}, $field->{status})) {

        $self->error("Test failed: Section: '$section->{section}' Field: '$field->{name}' Value: '$value'");

        $self->is_valid(0);

        last;

      }

      $self->{$section->{section}} = {} if (!$self->{$section->{section}});

      $self->{$section->{section}}->{$field->{name}} = $value;

    }

    last if $self->error;

  }

}

sub get_creditor_field {

  my $self = shift;

  my ($structured_field, $extract_field, $extract_regex) = @_;

  if ($self->{creditor}->{address_type} eq 'S') {

    return $self->{creditor}->{$structured_field};

  }

  # extract

  $self->{creditor}->{$extract_field} =~ $extract_regex;

  return $1 // '';

}

sub get_creditor_street_name {

  # extract street name from street_or_address_line_1

  # the regex matches everything until the first digit

  return shift->get_creditor_field(

    'street_or_address_line_1',

    'street_or_address_line_1',

    REGEX_STREET_NAME_FROM_ADDRESS_LINE

  );

}

sub get_creditor_building_number {

  # extract building number from street_or_address_line_1

  # the regex matches the first digit and everything after

  return shift->get_creditor_field(

    'building_number_or_address_line_2',

    'street_or_address_line_1',

    REGEX_BUILDING_NUMBER_FROM_ADDRESS_LINE

  );

}

sub get_creditor_post_code {

  # extract post code from building_number_or_address_line_2

  # the regex matches the first digits

  return shift->get_creditor_field(

    'postal_code',

    'building_number_or_address_line_2',

    REGEX_POSTAL_CODE_FROM_ADDRESS_LINE

  );

}

sub get_creditor_town_name {

  # extract town name from building_number_or_address_line_2

  # the regex matches everything after the first digits

  return shift->get_creditor_field(

    'town',

    'building_number_or_address_line_2',

    REGEX_TOWN_FROM_ADDRESS_LINE

  );

}

sub init_spec {

  [

    {

      section => 'header',

      fields  => [

        {

          name        => 'qrtype',

          line_number => 0,

          test        => REGEX_QRTYPE,

          status      => 'M'

        },

        {

          name        => 'version',

          line_number => 1,

          test        => REGEX_VERSION,

          status      => 'M'

        },

        {

          name        => 'coding',

          line_number => 2,

          test        => REGEX_CODING,

          status      => 'M'

        }

      ]

    },

    {

      section => 'creditor_information',

      fields  => [

        {

          name        => 'iban',

          line_number => 3,

          test        => REGEX_IBAN,

          status      => 'M'

        }

      ]

    },

    {

      section => 'creditor',

      fields  => [

        {

          name        => 'address_type',

          line_number => 4,

          test        => REGEX_ADDRESS_TYPE,

          status      => 'M',

        },

        {

          name        => 'name',

          line_number => 5,

          test        => REGEX_NAME,

          status      => 'M',

        },

        {

          name        => 'street_or_address_line_1',

          line_number => 6,

          test        => REGEX_ADDRESS_LINE,

          status      => 'O'

        },

        {

          name        => 'building_number_or_address_line_2',

          line_number => 7,

          test        => REGEX_ADDRESS_LINE,

          status      => 'O'

        },

        {

          name        => 'postal_code',

          line_number => 8,

          test        => REGEX_POSTAL_CODE,

          status      => 'D'

        },

        {

          name        => 'town',

          line_number => 9,

          test        => REGEX_TOWN,

          status      => 'D'

        },

        {

          name        => 'country',

          line_number => 10,

          test        => REGEX_COUNTRY,

          status      => 'M'

        }

      ]

    },

    {

      section => 'ultimate_creditor',

      fields  => [

        {

          name        => 'address_type',

          line_number => 11,

          test        => REGEX_ADDRESS_TYPE,

          status      => 'X'

        },

        {

          name        => 'name',

          line_number => 12,

          test        => REGEX_NAME,

          status      => 'X'

        },

        {

          name        => 'street_or_address_line_1',

          line_number => 13,

          test        => REGEX_ADDRESS_LINE,

          status      => 'X'

        },

        {

          name        => 'building_number_or_address_line_2',

          line_number => 14,

          test        => REGEX_ADDRESS_LINE,

          status      => 'X'

        },

        {

          name        => 'postal_code',

          line_number => 15,

          test        => REGEX_POSTAL_CODE,

          status      => 'X'

        },

        {

          name        => 'town',

          line_number => 16,

          test        => REGEX_TOWN,

          status      => 'X'

        },

        {

          name        => 'country',

          line_number => 17,

          test        => REGEX_COUNTRY,

          status      => 'X'

        }

      ]

    },

    {

      section => 'payment_amount_information',

      fields  => [

        {

          name        => 'amount',

          line_number => 18,

          test        => REGEX_AMOUNT,

          status      => 'O'

        },

        {

          name        => 'currency',

          line_number => 19,

          test        => REGEX_CURRENCY,

          status      => 'M'

        }

      ]

    },

    {

      section => 'ultimate_debtor',

      fields  => [

        {

          name        => 'address_type',

          line_number => 20,

          test        => REGEX_ADDRESS_TYPE,

          status      => 'D'

        },

        {

          name        => 'name',

          line_number => 21,

          test        => REGEX_NAME,

          status      => 'D'

        },

        {

          name        => 'street_or_address_line_1',

          line_number => 22,

          test        => REGEX_ADDRESS_LINE,

          status      => 'O'

        },

        {

          name        => 'building_number_or_address_line_2',

          line_number => 23,

          test        => REGEX_ADDRESS_LINE,

          status      => 'O'

        },

        {

          name        => 'postal_code',

          line_number => 24,

          test        => REGEX_POSTAL_CODE,

          status      => 'D'

        },

        {

          name        => 'town',

          line_number => 25,

          test        => REGEX_TOWN,

          status      => 'D'

        },

        {

          name        => 'country',

          line_number => 26,

          test        => REGEX_COUNTRY,

          status      => 'D'

        }

      ]

    },

    {

      section => 'payment_reference',

      fields  => [

        {

          name        => 'reference_type',

          line_number => 27,

          test        => REGEX_REFERENCE_TYPE,

          status      => 'M'

        },

        {

          name        => 'reference',

          line_number => 28,

          test        => REGEX_REFERENCE,

          status      => 'D'

        }

      ]

    },

    {

      section => 'additional_information',

      fields  => [

        {

          name        => 'unstructured_message',

          line_number => 29,

          test        => REGEX_UNSTRUCTURED_MESSAGE,

          status      => 'O'

        },

        {

          name        => 'trailer',

          line_number => 30,

          test        => REGEX_TRAILER,

          status      => 'M'

        },

        {

          name        => 'bill_information',

          line_number => 31,

          test        => REGEX_BILL_INFORMATION,

          status      => 'A'

        }

      ]

    },

    {

      section => 'alternative_scheme',

      fields  => [

        {

          name        => 'alternative_scheme_parameter1',

          line_number => 32,

          test        => REGEX_ALTERNATIVE_SCHEME_PARAMETER,

          status      => 'A'

        },

        {

          name        => 'alternative_scheme_parameter2',

          line_number => 33,

          test        => REGEX_ALTERNATIVE_SCHEME_PARAMETER,

          status      => 'A'

        }

      ]

    }

  ];

}

### helper

sub test_value {

  my ($value, $test, $status) = @_;

  # mandatory fields must have a content

  return 0 if $status eq 'M' && length $value <= 0;

  # optional fields can be empty

  return 1 if $status eq 'O' && length $value == 0;

  # dependent fields can be empty

  return 1 if $status eq 'D' && length $value == 0;

  # "do not fill" fields cannot have a content

  if ($status eq 'X') {

    return 1 if ($value eq '');

    return 0;

  }

  # additional fields can be undefined

  if ($status eq 'A') {

    return 1 if !defined($value);

    return 0 if $value !~ $test;

    return 1;

  }

  return 0 if !defined($value);

  return 0 if $value !~ $test;

  return 1;

}

1;

__END__

=pod

=encoding utf8

=head1 NAME

SL::Helper::QrBillParser - Helper for parsing QR bill data

=head1 SYNOPSIS

  use SL::Helper::QrBillParser;

  my $qr_obj = SL::Helper::QrBillParser->new($item->{qrbill_data});

  my $valid = $qr_obj->is_valid;

  my $error_message = $qr_obj->error;

  my $qrtext = $qr_obj->raw_data;

  # data for remittance information

  my $reference = $qr_obj->{payment_reference}->{reference};

  my $unstructured_message = $qr_obj->{additional_information}->{unstructured_message}

  # set currency and amount

  my $currency = $qr_obj->{payment_amount_information}->{currency};

  my $amount = $qr_obj->{payment_amount_information}->{amount}

  # set creditor name and address from qr data

  my $creditor_name = $qr_obj->{creditor}->{name};

  my $creditor_street_name = $qr_obj->get_creditor_street_name;

  my $creditor_building_number = $qr_obj->get_creditor_building_number;

  my $creditor_postal_code = $qr_obj->get_creditor_post_code;

  my $creditor_town_name = $qr_obj->get_creditor_town_name;

  my $creditor_country = $qr_obj->{creditor}->{country}

  # set creditor iban

  my $creditor_iban = $qr_obj->{creditor_information}->{iban};

=head1 DESCRIPTION

This is simple helper to parse swiss qr bill data from a string into an object.

Some methods are provided to easily retrieve the creditor address data.

=head1 FUNCTIONS

=over 4

=item C<new>

  my $qr_obj = SL::Helper::QrBillParser->new($item->{qrbill_data});

Creates a new object from the qr bill data string.

=item C<is_valid>

  my $valid = $qr_obj->is_valid;

Returns true if the qr bill data is valid.

=item C<error>

  my $error_message = $qr_obj->error;

Returns the error message if the qr bill data is invalid.

=item C<raw_data>

  my $qrtext = $qr_obj->raw_data;

Returns the raw qr bill data string.

=item C<get_creditor_street_name>

  my $creditor_street_name = $qr_obj->get_creditor_street_name;

Returns the creditor street name.

=item C<get_creditor_building_number>

  my $creditor_building_number = $qr_obj->get_creditor_building_number;

Returns the creditor building number.

=item C<get_creditor_post_code>

  my $creditor_postal_code = $qr_obj->get_creditor_post_code;

Returns the creditor postal code.

=item C<get_creditor_town_name>

  my $creditor_town_name = $qr_obj->get_creditor_town_name;

Returns the creditor town name.

=back

=head1 TESTS

Tests for functions see t/helper/qrbill_parser.t.

Run: C<t/test.pl t/helper/qrbill_parser.t>

=head1 LIMITATIONS

Basic validation is performed based on the status code and regular expressions.

However complete checks of dependent fields would require more elaborate logic.

=head1 BUGS

Nothing here yet.

=head1 AUTHOR

Cem Aydin E<lt>cem.aydin@revamp-it.chE<gt>

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

=cut

use Test::More tests => 40;

use strict;

use lib 't';

use Support::TestSetup;

use_ok('SL::Helper::QrBillParser');

Support::TestSetup::login();

my $code1 = "SPC\n0200\n1\nCH5204835012345671000\nS\nSample Foundation\nPO Box\n\n3001\nBern\nCH\n\n\n\n\n\n\n\n\nCHF\n\n\n\n\n\n\n\nNON\n\n\nEPD\n";

my $obj1 = SL::Helper::QrBillParser->new($code1);

is($obj1->is_valid, 1, 'code1valid');

is($obj1->{creditor_information}->{iban}, "CH5204835012345671000", 'code1iban');

is($obj1->{creditor}->{name}, "Sample Foundation", 'code1name');

is($obj1->{payment_amount_information}->{amount}, "", 'code1amount');

my $code2 = "SPC\r\n0200\r\n1\r\nCH4431999123000889012\r\nS\r\nMax Muster & Söhne\r\nMusterstrasse\r\n123\r\n8000\r\nSeldwyla\r\nCH\r\n\r\n\r\n\r\n\r\n\r\n\r\n\r\n1949.75\r\nCHF\r\nS\r\nSimon Muster\r\nMusterstrasse\r\n1\r\n8000\r\nSeldwyla\r\nCH\r\nQRR\r\n210000000003139471430009017\r\nOrder from 15.10.2020\r\nEPD\r\n//S1/10/1234/11/201021/30/102673386/32/7.7/40/0:30\r\nName AV1: UV;UltraPay005;12345\r\nName AV2: XY;XYService;54321";

my $obj2 = SL::Helper::QrBillParser->new($code2);

is($obj2->is_valid, 1, 'code2valid');

is($obj2->{creditor_information}->{iban}, "CH4431999123000889012", 'code2iban');

is($obj2->{creditor}->{name}, "Max Muster & Söhne", 'code2name');

is($obj2->{payment_amount_information}->{amount}, "1949.75", 'code2amount');

is($obj2->{payment_reference}->{reference}, "210000000003139471430009017", 'code2reference');

is($obj2->{additional_information}->{unstructured_message}, "Order from 15.10.2020", 'code2unstructured_message');

is($obj2->get_creditor_street_name(), 'Musterstrasse', 'code2street_name');

is($obj2->get_creditor_building_number(), '123', 'code2building_number');

is($obj2->get_creditor_post_code(), '8000', 'code2post_code');

is($obj2->get_creditor_town_name(), 'Seldwyla', 'code2town_name');

my $code3 = "SPC\n0200\n1\nCH5800791123000889012\nS\nMuster Krankenkasse\nMusterstrasse\n12\n8000\nSeldwyla\nCH\n\n\n\n\n\n\n\n211.00\nCHF\nS\nSarah Beispiel\nMusterstrasse\n1\n8000\nSeldwyla\nCH\nSCOR\nRF240191230100405JSH0438\n\nEPD\n";

my $obj3 = SL::Helper::QrBillParser->new($code3);

is($obj3->is_valid, 1, 'code3valid');

is($obj3->{creditor_information}->{iban}, "CH5800791123000889012", 'code3iban');

is($obj3->{creditor}->{name}, "Muster Krankenkasse", 'code3name');

is($obj3->{payment_amount_information}->{amount}, "211.00", 'code3amount');

is($obj3->{payment_reference}->{reference}, "RF240191230100405JSH0438", 'code3reference');

my $code4 = "SPC\n0200\n1\nCH5800791123000889012\nS\nMax Muster & Söhne\nMusterstrasse\n123\n8000\nSeldwyla\nCH\n\n\n\n\n\n\n\n199.95\nCHF\nS\nSarah Beispiel\nMusterstrasse\n1\n78462\nKonstanz\nDE\nSCOR\nRF18539007547034\n\nEPD\n";

my $obj4 = SL::Helper::QrBillParser->new($code4);

is($obj4->is_valid, 1, 'code4valid');

is($obj4->{creditor_information}->{iban}, "CH5800791123000889012", 'code4iban');

is($obj4->{creditor}->{name}, "Max Muster & Söhne", 'code4name');

is($obj4->{payment_amount_information}->{amount}, "199.95", 'code4amount');

is($obj4->{payment_reference}->{reference}, "RF18539007547034", 'code4reference');

my $code5 = "SP\n0200\n1\nCH5800791123000889012\nS\nMax Muster & Söhne\nMusterstrasse\n123\n8000\nSeldwyla\nCH\n\n\n\n\n\n199.95\nCHF\nS\nSarah Beispiel\nMusterstrasse\n1\n78462\nKonstanz\nDE\nSCOR\nRF18539007547034\n\nEPD\n";

my $obj5 = SL::Helper::QrBillParser->new($code5);

is($obj5->is_valid, 0, 'code5invalid');

is($obj5->error, "Test failed: Section: 'header' Field: 'qrtype' Value: 'SP'", 'code5error');

my $code6 = "SPC\n0200\n1\nCH5800791123889012\nS\nMax Muster & Söhne\nMusterstrasse\n123\n8000\nSeldwyla\nCH\n\n\n\n\n\n\n\n199.95\nCHF\nS\nSarah Beispiel\nMusterstrasse\n1\n78462\nKonstanz\nDE\nSCOR\nRF18539007547034\n\nEPD\n";

my $obj6 = SL::Helper::QrBillParser->new($code6);

is($obj6->is_valid, 0, 'code6invalid');

is($obj6->error, "Test failed: Section: 'creditor_information' Field: 'iban' Value: 'CH5800791123889012'", 'code6error');

my $code7 = "SPC\n0200\n1\nCH5204835012345671000\nK\nSample Foundation\nMusterstrasse 55\n3005 Bern\n\n\nCH\n\n\n\n\n\n\n\n\nCHF\n\n\n\n\n\n\n\nNON\n\n\nEPD\n";

my $obj7 = SL::Helper::QrBillParser->new($code7);

is($obj7->is_valid, 1, 'code7valid');

is($obj7->get_creditor_street_name(), 'Musterstrasse', 'code7street_name');

is($obj7->get_creditor_building_number(), '55', 'code7building_number');

is($obj7->get_creditor_post_code(), '3005', 'code7post_code');

is($obj7->get_creditor_town_name(), 'Bern', 'code7town_name');

my $code8 = "SPC\n0200\n1\nCH5204835012345671000\nK\nSample Foundation\nMusterstrasse 25b\n3005 Bern\n\n\nCH\n\n\n\n\n\n\n\n\nCHF\n\n\n\n\n\n\n\nNON\n\n\nEPD\n";

my $obj8 = SL::Helper::QrBillParser->new($code8);

is($obj8->is_valid, 1, 'code8valid');

is($obj8->get_creditor_street_name(), 'Musterstrasse', 'code8street_name');

is($obj8->get_creditor_building_number(), '25b', 'code8building_number');

my $code9 = "SPC\n0200\n1\nCH5204835012345671000\nK\nSample Foundation\nMusterstrasse 25 c\n3005 Bern\n\n\nCH\n\n\n\n\n\n\n\n\nCHF\n\n\n\n\n\n\n\nNON\n\n\nEPD\n";

my $obj9 = SL::Helper::QrBillParser->new($code9);

is($obj9->is_valid, 1, 'code9valid');

is($obj9->get_creditor_street_name(), 'Musterstrasse', 'code9street_name');

is($obj9->get_creditor_building_number(), '25 c', 'code9building_number');