SL/SEPA/XML.pm

   1 package SL::SEPA::XML;
   2
   3 use strict;
   4 use utf8;
   5
   6 use Carp;
   7 use Encode;
   8 use List::Util qw(first sum);
   9 use List::MoreUtils qw(any);
  10 use POSIX qw(strftime);
  11 use XML::Writer;
  12
  13 use SL::Iconv;
  14 use SL::SEPA::XML::Transaction;
  15
  16 sub new {
  17   my $class = shift;
  18   my $self  = {};
  19
  20   bless $self, $class;
  21
  22   $self->_init(@_);
  23
  24   return $self;
  25 }
  26
  27 sub _init {
  28   my $self              = shift;
  29   my %params            = @_;
  30
  31   $self->{transactions} = [];
  32   $self->{src_charset}  = 'UTF-8';
  33   $self->{grouped}      = 0;
  34
  35   map { $self->{$_} = $params{$_} if (exists $params{$_}) } qw(src_charset company creditor_id message_id grouped collection);
  36
  37   $self->{iconv} = SL::Iconv->new($self->{src_charset}, "UTF-8") || croak "Unsupported source charset $self->{src_charset}.";
  38
  39   my $missing_parameter = first { !$self->{$_} } qw(company message_id);
  40   croak "Missing parameter: $missing_parameter" if ($missing_parameter);
  41   croak "Missing parameter: creditor_id"        if !$self->{creditor_id} && $self->{collection};
  42
  43   map { $self->{$_} = $self->_replace_special_chars($self->{iconv}->convert($self->{$_})) } qw(company message_id creditor_id);
  44 }
  45
  46 sub add_transaction {
  47   my $self = shift;
  48
  49   foreach my $transaction (@_) {
  50     croak "Expecting hash reference." if (ref $transaction ne 'HASH');
  51     push @{ $self->{transactions} }, SL::SEPA::XML::Transaction->new(%{ $transaction }, 'sepa' => $self);
  52   }
  53
  54   return 1;
  55 }
  56
  57 sub _replace_special_chars {
  58   my $self = shift;
  59   my $text = shift;
  60
  61   my %special_chars = (
  62     'ä' => 'ae',
  63     'ö' => 'oe',
  64     'ü' => 'ue',
  65     'Ä' => 'Ae',
  66     'Ö' => 'Oe',
  67     'Ü' => 'Ue',
  68     'ß' => 'ss',
  69     '&' => '+',
  70     '`' => '\'',
  71     );
  72
  73   map { $text =~ s/$_/$special_chars{$_}/g; } keys %special_chars;
  74
  75   # for all other non ascii chars 'OLÉ S.L.' and 'Årdberg AB'!
  76   use Text::Unidecode qw(unidecode);
  77   $text = unidecode($text);
  78
  79   return $text;
  80 }
  81
  82 sub _format_amount {
  83   my $self   = shift;
  84   my $amount = shift;
  85
  86   return sprintf '%.02f', $amount;
  87 }
  88
  89 sub _group_transactions {
  90   my $self    = shift;
  91
  92   my $grouped = {
  93     'sum_amount' => 0,
  94     'groups'     => { },
  95   };
  96
  97   foreach my $transaction (@{ $self->{transactions} }) {
  98     my $key                      = $self->{grouped} ? join("\t", map { $transaction->get($_) } qw(src_bic src_iban execution_date)) : 'all';
  99     $grouped->{groups}->{$key} ||= {
 100       'sum_amount'   => 0,
 101       'transactions' => [ ],
 102     };
 103
 104     push @{ $grouped->{groups}->{$key}->{transactions} }, $transaction;
 105
 106     $grouped->{groups}->{$key}->{sum_amount} += $transaction->{amount};
 107     $grouped->{sum_amount}                   += $transaction->{amount};
 108   }
 109
 110   return $grouped;
 111 }
 112
 113 sub _restricted_identification_sepa1 {
 114   my ($self, $string) = @_;
 115
 116   $string =~ s/[^A-Za-z0-9\+\?\/\-:\(\)\.,' ]//g;
 117   return substr $string, 0, 35;
 118 }
 119
 120 sub _restricted_identification_sepa2 {
 121   my ($self, $string) = @_;
 122
 123   $string =~ s/[^A-Za-z0-9\+\?\/\-:\(\)\.,']//g;
 124   return substr $string, 0, 35;
 125 }
 126
 127 sub to_xml {
 128   my $self = shift;
 129
 130   croak "No transactions added yet." if (!@{ $self->{transactions} });
 131
 132   my $output = '';
 133
 134   my $xml    = XML::Writer->new(OUTPUT      => \$output,
 135                                 DATA_MODE   => 1,
 136                                 DATA_INDENT => 2,
 137                                 ENCODING    => 'utf-8');
 138
 139   my @now       = localtime;
 140   my $time_zone = strftime "%z", @now;
 141   my $now_str   = strftime('%Y-%m-%dT%H:%M:%S', @now) . substr($time_zone, 0, 3) . ':' . substr($time_zone, 3, 2);
 142
 143   my $is_coll   = $self->{collection};
 144   my $cd_src    = $is_coll ? 'Cdtr'              : 'Dbtr';
 145   my $cd_dst    = $is_coll ? 'Dbtr'              : 'Cdtr';
 146   my $pain_id   = $is_coll ? 'pain.008.002.02'   : 'pain.001.002.03';
 147   my $pain_elmt = $is_coll ? 'CstmrDrctDbtInitn' : 'CstmrCdtTrfInitn';
 148   my @pii_base  = (strftime('PII%Y%m%d%H%M%S', @now), rand(1000000000));
 149
 150   my $grouped_transactions = $self->_group_transactions();
 151
 152   $xml->xmlDecl();
 153
 154   $xml->startTag('Document',
 155                  'xmlns'              => "urn:iso:std:iso:20022:tech:xsd:${pain_id}",
 156                  'xmlns:xsi'          => 'http://www.w3.org/2001/XMLSchema-instance',
 157                  'xsi:schemaLocation' => "urn:iso:std:iso:20022:tech:xsd:${pain_id} ${pain_id}.xsd");
 158
 159   $xml->startTag($pain_elmt);
 160
 161   $xml->startTag('GrpHdr');
 162   $xml->dataElement('MsgId', encode('UTF-8', $self->_restricted_identification_sepa1($self->{message_id})));
 163   $xml->dataElement('CreDtTm', $now_str);
 164   $xml->dataElement('NbOfTxs', scalar @{ $self->{transactions} });
 165   $xml->dataElement('CtrlSum', $self->_format_amount($grouped_transactions->{sum_amount}));
 166
 167   $xml->startTag('InitgPty');
 168   $xml->dataElement('Nm', encode('UTF-8', substr($self->{company}, 0, 70)));
 169   $xml->endTag('InitgPty');
 170
 171   $xml->endTag('GrpHdr');
 172
 173   foreach my $key (keys %{ $grouped_transactions->{groups} }) {
 174     my $transaction_group  = $grouped_transactions->{groups}->{$key};
 175     my $master_transaction = $transaction_group->{transactions}->[0];
 176
 177     $xml->startTag('PmtInf');
 178     $xml->dataElement('PmtInfId', sprintf('%s%010d', @pii_base));
 179     $pii_base[1]++;
 180     $xml->dataElement('PmtMtd', $is_coll ? 'DD' : 'TRF');
 181     $xml->dataElement('NbOfTxs', scalar @{ $transaction_group->{transactions} });
 182     $xml->dataElement('CtrlSum', $self->_format_amount($transaction_group->{sum_amount}));
 183
 184     $xml->startTag('PmtTpInf');
 185     $xml->startTag('SvcLvl');
 186     $xml->dataElement('Cd', 'SEPA');
 187     $xml->endTag('SvcLvl');
 188
 189     if ($is_coll) {
 190       $xml->startTag('LclInstrm');
 191       $xml->dataElement('Cd', 'CORE');
 192       $xml->endTag('LclInstrm');
 193       $xml->dataElement('SeqTp', 'OOFF');
 194     }
 195     $xml->endTag('PmtTpInf');
 196
 197     $xml->dataElement($is_coll ? 'ReqdColltnDt' : 'ReqdExctnDt', $master_transaction->get('execution_date'));
 198     $xml->startTag($cd_src);
 199     $xml->dataElement('Nm', encode('UTF-8', substr($self->{company}, 0, 70)));
 200     $xml->endTag($cd_src);
 201
 202     $xml->startTag($cd_src . 'Acct');
 203     $xml->startTag('Id');
 204     $xml->dataElement('IBAN', $master_transaction->get('src_iban', 34));
 205     $xml->endTag('Id');
 206     $xml->endTag($cd_src . 'Acct');
 207
 208     $xml->startTag($cd_src . 'Agt');
 209     $xml->startTag('FinInstnId');
 210     $xml->dataElement('BIC', $master_transaction->get('src_bic', 20));
 211     $xml->endTag('FinInstnId');
 212     $xml->endTag($cd_src . 'Agt');
 213
 214     $xml->dataElement('ChrgBr', 'SLEV');
 215
 216     foreach my $transaction (@{ $transaction_group->{transactions} }) {
 217       $xml->startTag($is_coll ? 'DrctDbtTxInf' : 'CdtTrfTxInf');
 218
 219       $xml->startTag('PmtId');
 220       $xml->dataElement('EndToEndId', $self->_restricted_identification_sepa1($transaction->get('end_to_end_id')));
 221       $xml->endTag('PmtId');
 222
 223       if ($is_coll) {
 224         $xml->startTag('InstdAmt', 'Ccy' => 'EUR');
 225         $xml->characters($self->_format_amount($transaction->{amount}));
 226         $xml->endTag('InstdAmt');
 227
 228         $xml->startTag('DrctDbtTx');
 229
 230         $xml->startTag('MndtRltdInf');
 231         $xml->dataElement('MndtId', $self->_restricted_identification_sepa2($transaction->get('mandator_id')));
 232         $xml->dataElement('DtOfSgntr', $self->_restricted_identification_sepa2($transaction->get('date_of_signature')));
 233         $xml->endTag('MndtRltdInf');
 234
 235         $xml->startTag('CdtrSchmeId');
 236         $xml->startTag('Id');
 237         $xml->startTag('PrvtId');
 238         $xml->startTag('Othr');
 239         $xml->dataElement('Id', encode('UTF-8', substr($self->{creditor_id}, 0, 35)));
 240         $xml->startTag('SchmeNm');
 241         $xml->dataElement('Prtry', 'SEPA');
 242         $xml->endTag('SchmeNm');
 243         $xml->endTag('Othr');
 244         $xml->endTag('PrvtId');
 245         $xml->endTag('Id');
 246         $xml->endTag('CdtrSchmeId');
 247
 248         $xml->endTag('DrctDbtTx');
 249
 250       } else {
 251         $xml->startTag('Amt');
 252         $xml->startTag('InstdAmt', 'Ccy' => 'EUR');
 253         $xml->characters($self->_format_amount($transaction->{amount}));
 254         $xml->endTag('InstdAmt');
 255         $xml->endTag('Amt');
 256       }
 257
 258       $xml->startTag("${cd_dst}Agt");
 259       $xml->startTag('FinInstnId');
 260       $xml->dataElement('BIC', $transaction->get('dst_bic', 20));
 261       $xml->endTag('FinInstnId');
 262       $xml->endTag("${cd_dst}Agt");
 263
 264       $xml->startTag("${cd_dst}");
 265       $xml->dataElement('Nm', $transaction->get('company', 70));
 266       $xml->endTag("${cd_dst}");
 267
 268       $xml->startTag("${cd_dst}Acct");
 269       $xml->startTag('Id');
 270       $xml->dataElement('IBAN', $transaction->get('dst_iban', 34));
 271       $xml->endTag('Id');
 272       $xml->endTag("${cd_dst}Acct");
 273
 274       $xml->startTag('RmtInf');
 275       $xml->dataElement('Ustrd', $transaction->get('reference', 140));
 276       $xml->endTag('RmtInf');
 277
 278       $xml->endTag($is_coll ? 'DrctDbtTxInf' : 'CdtTrfTxInf');
 279     }
 280
 281     $xml->endTag('PmtInf');
 282   }
 283
 284   $xml->endTag($pain_elmt);
 285   $xml->endTag('Document');
 286
 287   return $output;
 288 }
 289
 290 1;
 291
 292 # Local Variables:
 293 # coding: utf-8
 294 # End: