SL/Helper/QrBillParser.pm

   1 package SL::Helper::QrBillParser;
   2
   3 use strict;
   4 use warnings;
   5
   6 use SL::Helper::QrBillFunctions qw(
   7   get_street_name_from_address_line
   8   get_building_number_from_address_line
   9   get_postal_code_from_address_line
  10   get_town_name_from_address_line
  11 );
  12
  13 use Rose::Object::MakeMethods::Generic(
  14   scalar                  => [ qw(is_valid error raw_data) ],
  15   'scalar --get_set_init' => [ qw(spec) ],
  16 );
  17
  18 our $VERSION = '0.01';
  19
  20 use constant {
  21   REGEX_QRTYPE               => qr{^SPC$},
  22   REGEX_VERSION              => qr{^0200$},
  23   REGEX_CODING               => qr{^1$},
  24   REGEX_IBAN                 => qr{^(?:CH|LI)[0-9a-zA-Z]{19}$},
  25   REGEX_ADDRESS_TYPE         => qr{^[KS]$},
  26   REGEX_NAME                 => qr{^.{1,70}$},
  27   REGEX_ADDRESS_LINE         => qr{^.{0,70}$},
  28   REGEX_POSTAL_CODE          => qr{^.{0,16}$},
  29   REGEX_TOWN                 => qr{^.{0,35}$},
  30   REGEX_COUNTRY              => qr{^[A-Za-z]{2}$},
  31   REGEX_AMOUNT               => qr{^(?:(?:0|[1-9][0-9]{0,8})\.[0-9]{2})?$},
  32   REGEX_CURRENCY             => qr{^(?:CHF|EUR)$},
  33   REGEX_REFERENCE_TYPE       => qr{^(?:QRR|SCOR|NON)$},
  34   REGEX_REFERENCE            => qr{^.{0,27}$},
  35   REGEX_UNSTRUCTURED_MESSAGE => qr{^.{0,140}$},
  36   REGEX_TRAILER              => qr{^EPD$},
  37   REGEX_BILL_INFORMATION     => qr{^.{0,140}$},
  38   REGEX_ALTERNATIVE_SCHEME_PARAMETER      => qr{^.{0,100}$},
  39 };
  40
  41 sub new {
  42   my $class = shift;
  43
  44   my $self = bless {}, $class;
  45
  46   $self->init(@_);
  47
  48   return $self;
  49 }
  50
  51 sub init {
  52   my $self = shift;
  53   my ($qrtext) = @_;
  54
  55   my @lines = split /(?:\n|\r\n)/, $qrtext;
  56
  57   $self->is_valid(1);
  58   $self->error('');
  59   $self->raw_data($qrtext);
  60
  61   for my $section ( @{$self->spec} ) {
  62     for my $field ( @{$section->{fields}} ) {
  63       my $value = $lines[$field->{line_number}];
  64
  65       if (!test_value($value, $field->{test}, $field->{status})) {
  66         $self->error("Test failed: Section: '$section->{section}' Field: '$field->{name}' Value: '$value'");
  67         $self->is_valid(0);
  68         last;
  69       }
  70
  71       $self->{$section->{section}} = {} if (!$self->{$section->{section}});
  72       $self->{$section->{section}}->{$field->{name}} = $value;
  73     }
  74     last if $self->error;
  75   }
  76 }
  77
  78 sub get_creditor_field {
  79   my $self = shift;
  80   my ($structured_field, $extract_field, $extract_fn) = @_;
  81
  82   if ($self->{creditor}->{address_type} eq 'S') {
  83     return $self->{creditor}->{$structured_field};
  84   }
  85   # extract
  86   my $r = $extract_fn->($self->{creditor}->{$extract_field});
  87
  88   return $r // '';
  89 }
  90
  91 sub get_creditor_street_name {
  92   return shift->get_creditor_field(
  93     'street_or_address_line_1',
  94     'street_or_address_line_1',
  95     \&get_street_name_from_address_line
  96   );
  97 }
  98
  99 sub get_creditor_building_number {
 100   return shift->get_creditor_field(
 101     'building_number_or_address_line_2',
 102     'street_or_address_line_1',
 103     \&get_building_number_from_address_line
 104   );
 105 }
 106
 107 sub get_creditor_post_code {
 108   return shift->get_creditor_field(
 109     'postal_code',
 110     'building_number_or_address_line_2',
 111     \&get_postal_code_from_address_line
 112   );
 113 }
 114
 115 sub get_creditor_town_name {
 116   return shift->get_creditor_field(
 117     'town',
 118     'building_number_or_address_line_2',
 119     \&get_town_name_from_address_line
 120   );
 121 }
 122
 123 sub init_spec {
 124   [
 125     {
 126       section => 'header',
 127       fields  => [
 128         {
 129           name        => 'qrtype',
 130           line_number => 0,
 131           test        => REGEX_QRTYPE,
 132           status      => 'M'
 133         },
 134         {
 135           name        => 'version',
 136           line_number => 1,
 137           test        => REGEX_VERSION,
 138           status      => 'M'
 139         },
 140         {
 141           name        => 'coding',
 142           line_number => 2,
 143           test        => REGEX_CODING,
 144           status      => 'M'
 145         }
 146       ]
 147     },
 148     {
 149       section => 'creditor_information',
 150       fields  => [
 151         {
 152           name        => 'iban',
 153           line_number => 3,
 154           test        => REGEX_IBAN,
 155           status      => 'M'
 156         }
 157       ]
 158     },
 159     {
 160       section => 'creditor',
 161       fields  => [
 162         {
 163           name        => 'address_type',
 164           line_number => 4,
 165           test        => REGEX_ADDRESS_TYPE,
 166           status      => 'M',
 167         },
 168         {
 169           name        => 'name',
 170           line_number => 5,
 171           test        => REGEX_NAME,
 172           status      => 'M',
 173         },
 174         {
 175           name        => 'street_or_address_line_1',
 176           line_number => 6,
 177           test        => REGEX_ADDRESS_LINE,
 178           status      => 'O'
 179         },
 180         {
 181           name        => 'building_number_or_address_line_2',
 182           line_number => 7,
 183           test        => REGEX_ADDRESS_LINE,
 184           status      => 'O'
 185         },
 186         {
 187           name        => 'postal_code',
 188           line_number => 8,
 189           test        => REGEX_POSTAL_CODE,
 190           status      => 'D'
 191         },
 192         {
 193           name        => 'town',
 194           line_number => 9,
 195           test        => REGEX_TOWN,
 196           status      => 'D'
 197         },
 198         {
 199           name        => 'country',
 200           line_number => 10,
 201           test        => REGEX_COUNTRY,
 202           status      => 'M'
 203         }
 204       ]
 205     },
 206     {
 207       section => 'ultimate_creditor',
 208       fields  => [
 209         {
 210           name        => 'address_type',
 211           line_number => 11,
 212           test        => REGEX_ADDRESS_TYPE,
 213           status      => 'X'
 214         },
 215         {
 216           name        => 'name',
 217           line_number => 12,
 218           test        => REGEX_NAME,
 219           status      => 'X'
 220         },
 221         {
 222           name        => 'street_or_address_line_1',
 223           line_number => 13,
 224           test        => REGEX_ADDRESS_LINE,
 225           status      => 'X'
 226         },
 227         {
 228           name        => 'building_number_or_address_line_2',
 229           line_number => 14,
 230           test        => REGEX_ADDRESS_LINE,
 231           status      => 'X'
 232         },
 233         {
 234           name        => 'postal_code',
 235           line_number => 15,
 236           test        => REGEX_POSTAL_CODE,
 237           status      => 'X'
 238         },
 239         {
 240           name        => 'town',
 241           line_number => 16,
 242           test        => REGEX_TOWN,
 243           status      => 'X'
 244         },
 245         {
 246           name        => 'country',
 247           line_number => 17,
 248           test        => REGEX_COUNTRY,
 249           status      => 'X'
 250         }
 251       ]
 252     },
 253     {
 254       section => 'payment_amount_information',
 255       fields  => [
 256         {
 257           name        => 'amount',
 258           line_number => 18,
 259           test        => REGEX_AMOUNT,
 260           status      => 'O'
 261         },
 262         {
 263           name        => 'currency',
 264           line_number => 19,
 265           test        => REGEX_CURRENCY,
 266           status      => 'M'
 267         }
 268       ]
 269     },
 270     {
 271       section => 'ultimate_debtor',
 272       fields  => [
 273         {
 274           name        => 'address_type',
 275           line_number => 20,
 276           test        => REGEX_ADDRESS_TYPE,
 277           status      => 'D'
 278         },
 279         {
 280           name        => 'name',
 281           line_number => 21,
 282           test        => REGEX_NAME,
 283           status      => 'D'
 284         },
 285         {
 286           name        => 'street_or_address_line_1',
 287           line_number => 22,
 288           test        => REGEX_ADDRESS_LINE,
 289           status      => 'O'
 290         },
 291         {
 292           name        => 'building_number_or_address_line_2',
 293           line_number => 23,
 294           test        => REGEX_ADDRESS_LINE,
 295           status      => 'O'
 296         },
 297         {
 298           name        => 'postal_code',
 299           line_number => 24,
 300           test        => REGEX_POSTAL_CODE,
 301           status      => 'D'
 302         },
 303         {
 304           name        => 'town',
 305           line_number => 25,
 306           test        => REGEX_TOWN,
 307           status      => 'D'
 308         },
 309         {
 310           name        => 'country',
 311           line_number => 26,
 312           test        => REGEX_COUNTRY,
 313           status      => 'D'
 314         }
 315       ]
 316     },
 317     {
 318       section => 'payment_reference',
 319       fields  => [
 320         {
 321           name        => 'reference_type',
 322           line_number => 27,
 323           test        => REGEX_REFERENCE_TYPE,
 324           status      => 'M'
 325         },
 326         {
 327           name        => 'reference',
 328           line_number => 28,
 329           test        => REGEX_REFERENCE,
 330           status      => 'D'
 331         }
 332       ]
 333     },
 334     {
 335       section => 'additional_information',
 336       fields  => [
 337         {
 338           name        => 'unstructured_message',
 339           line_number => 29,
 340           test        => REGEX_UNSTRUCTURED_MESSAGE,
 341           status      => 'O'
 342         },
 343         {
 344           name        => 'trailer',
 345           line_number => 30,
 346           test        => REGEX_TRAILER,
 347           status      => 'M'
 348         },
 349         {
 350           name        => 'bill_information',
 351           line_number => 31,
 352           test        => REGEX_BILL_INFORMATION,
 353           status      => 'A'
 354         }
 355       ]
 356     },
 357     {
 358       section => 'alternative_scheme',
 359       fields  => [
 360         {
 361           name        => 'alternative_scheme_parameter1',
 362           line_number => 32,
 363           test        => REGEX_ALTERNATIVE_SCHEME_PARAMETER,
 364           status      => 'A'
 365         },
 366         {
 367           name        => 'alternative_scheme_parameter2',
 368           line_number => 33,
 369           test        => REGEX_ALTERNATIVE_SCHEME_PARAMETER,
 370           status      => 'A'
 371         }
 372       ]
 373     }
 374   ];
 375 }
 376
 377 ### helper
 378
 379 sub test_value {
 380   my ($value, $test, $status) = @_;
 381
 382   # mandatory fields must have a content
 383   return 0 if $status eq 'M' && length $value <= 0;
 384
 385   # optional fields can be empty
 386   return 1 if $status eq 'O' && length $value == 0;
 387
 388   # dependent fields can be empty
 389   return 1 if $status eq 'D' && length $value == 0;
 390
 391   # "do not fill" fields cannot have a content
 392   if ($status eq 'X') {
 393     return 1 if ($value eq '');
 394     return 0;
 395   }
 396
 397   # additional fields can be undefined
 398   if ($status eq 'A') {
 399     return 1 if !defined($value);
 400     return 0 if $value !~ $test;
 401     return 1;
 402   }
 403
 404   return 0 if !defined($value);
 405   return 0 if $value !~ $test;
 406   return 1;
 407 }
 408
 409 1;
 410
 411 __END__
 412
 413 =pod
 414
 415 =encoding utf8
 416
 417 =head1 NAME
 418
 419 SL::Helper::QrBillParser - Helper for parsing QR bill data
 420
 421 =head1 SYNOPSIS
 422
 423   use SL::Helper::QrBillParser;
 424
 425   my $qr_obj = SL::Helper::QrBillParser->new($item->{qrbill_data});
 426
 427   my $valid = $qr_obj->is_valid;
 428   my $error_message = $qr_obj->error;
 429   my $qrtext = $qr_obj->raw_data;
 430
 431   # data for remittance information
 432   my $reference = $qr_obj->{payment_reference}->{reference};
 433   my $unstructured_message = $qr_obj->{additional_information}->{unstructured_message}
 434
 435   # set currency and amount
 436   my $currency = $qr_obj->{payment_amount_information}->{currency};
 437   my $amount = $qr_obj->{payment_amount_information}->{amount}
 438
 439   # set creditor name and address from qr data
 440   my $creditor_name = $qr_obj->{creditor}->{name};
 441   my $creditor_street_name = $qr_obj->get_creditor_street_name;
 442   my $creditor_building_number = $qr_obj->get_creditor_building_number;
 443   my $creditor_postal_code = $qr_obj->get_creditor_post_code;
 444   my $creditor_town_name = $qr_obj->get_creditor_town_name;
 445   my $creditor_country = $qr_obj->{creditor}->{country}
 446
 447   # set creditor iban
 448   my $creditor_iban = $qr_obj->{creditor_information}->{iban};
 449
 450 =head1 DESCRIPTION
 451
 452 This is simple helper to parse swiss qr bill data from a string into an object.
 453
 454 Some methods are provided to easily retrieve the creditor address data.
 455
 456 =head1 FUNCTIONS
 457
 458 =over 4
 459
 460 =item C<new>
 461
 462   my $qr_obj = SL::Helper::QrBillParser->new($item->{qrbill_data});
 463
 464 Creates a new object from the qr bill data string.
 465
 466 =item C<is_valid>
 467
 468   my $valid = $qr_obj->is_valid;
 469
 470 Returns true if the qr bill data is valid.
 471
 472 =item C<error>
 473
 474   my $error_message = $qr_obj->error;
 475
 476 Returns the error message if the qr bill data is invalid.
 477
 478 =item C<raw_data>
 479
 480   my $qrtext = $qr_obj->raw_data;
 481
 482 Returns the raw qr bill data string.
 483
 484 =item C<get_creditor_street_name>
 485
 486   my $creditor_street_name = $qr_obj->get_creditor_street_name;
 487
 488 Returns the creditor street name.
 489
 490 =item C<get_creditor_building_number>
 491
 492   my $creditor_building_number = $qr_obj->get_creditor_building_number;
 493
 494 Returns the creditor building number.
 495
 496 =item C<get_creditor_post_code>
 497
 498   my $creditor_postal_code = $qr_obj->get_creditor_post_code;
 499
 500 Returns the creditor postal code.
 501
 502 =item C<get_creditor_town_name>
 503
 504   my $creditor_town_name = $qr_obj->get_creditor_town_name;
 505
 506 Returns the creditor town name.
 507
 508 =back
 509
 510 =head1 TESTS
 511
 512 Tests for functions see t/helper/qrbill_parser.t.
 513
 514 Run: C<t/test.pl t/helper/qrbill_parser.t>
 515
 516 =head1 LIMITATIONS
 517
 518 Basic validation is performed based on the status code and regular expressions.
 519 However complete checks of dependent fields would require more elaborate logic.
 520
 521 =head1 BUGS
 522
 523 Nothing here yet.
 524
 525 =head1 AUTHOR
 526
 527 Cem Aydin E<lt>cem.aydin@revamp-it.chE<gt>
 528 Steven Schubiger E<lt>stsc@refcnt.orgE<gt>
 529
 530 =cut