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 message_id grouped);
  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
  42   map { $self->{$_} = $self->_replace_special_chars($self->{iconv}->convert($self->{$_})) } qw(company message_id);
  43 }
  44
  45 sub add_transaction {
  46   my $self = shift;
  47
  48   foreach my $transaction (@_) {
  49     croak "Expecting hash reference." if (ref $transaction ne 'HASH');
  50     push @{ $self->{transactions} }, SL::SEPA::XML::Transaction->new(%{ $transaction }, 'sepa' => $self);
  51   }
  52
  53   return 1;
  54 }
  55
  56 sub _replace_special_chars {
  57   my $self = shift;
  58   my $text = shift;
  59
  60   my %special_chars = (
  61     'ä' => 'ae',
  62     'ö' => 'oe',
  63     'ü' => 'ue',
  64     'Ä' => 'Ae',
  65     'Ö' => 'Oe',
  66     'Ü' => 'Ue',
  67     'ß' => 'ss',
  68     '&' => '+',
  69     );
  70
  71   map { $text =~ s/$_/$special_chars{$_}/g; } keys %special_chars;
  72
  73   return $text;
  74 }
  75
  76 sub _format_amount {
  77   my $self   = shift;
  78   my $amount = shift;
  79
  80   return sprintf '%d.%02d', int($amount), int($amount * 100) % 100;
  81 }
  82
  83 sub _group_transactions {
  84   my $self    = shift;
  85
  86   my $grouped = {
  87     'sum_amount' => 0,
  88     'groups'     => { },
  89   };
  90
  91   foreach my $transaction (@{ $self->{transactions} }) {
  92     my $key                      = $self->{grouped} ? join("\t", map { $transaction->get($_) } qw(src_bic src_iban execution_date)) : 'all';
  93     $grouped->{groups}->{$key} ||= {
  94       'sum_amount'   => 0,
  95       'transactions' => [ ],
  96     };
  97
  98     push @{ $grouped->{groups}->{$key}->{transactions} }, $transaction;
  99
 100     $grouped->{groups}->{$key}->{sum_amount} += $transaction->{amount};
 101     $grouped->{sum_amount}                   += $transaction->{amount};
 102   }
 103
 104   return $grouped;
 105 }
 106
 107 sub to_xml {
 108   my $self = shift;
 109
 110   croak "No transactions added yet." if (!@{ $self->{transactions} });
 111
 112   my $output = '';
 113
 114   my $xml    = XML::Writer->new(OUTPUT      => \$output,
 115                                 DATA_MODE   => 1,
 116                                 DATA_INDENT => 2,
 117                                 ENCODING    => 'utf-8');
 118
 119   my @now        = localtime;
 120   my $time_zone  = strftime "%z", @now;
 121   my $now_str    = strftime('%Y-%m-%dT%H:%M:%S', @now) . substr($time_zone, 0, 3) . ':' . substr($time_zone, 3, 2);
 122
 123   my $grouped_transactions = $self->_group_transactions();
 124
 125   $xml->xmlDecl();
 126   $xml->startTag('Document',
 127                  'xmlns'              => 'urn:sepade:xsd:pain.001.001.02.grp',
 128                  'xmlns:xsi'          => 'http://www.w3.org/2001/XMLSchema-instance',
 129                  'xsi:schemaLocation' => 'urn:sepade:xsd:pain.001.001.02.grp pain.001.001.02.grp.xsd');
 130
 131   $xml->startTag('pain.001.001.02');
 132
 133   $xml->startTag('GrpHdr');
 134   $xml->dataElement('MsgId', encode('UTF-8', substr($self->{message_id}, 0, 35)));
 135   $xml->dataElement('CreDtTm', $now_str);
 136   $xml->dataElement('NbOfTxs', scalar @{ $self->{transactions} });
 137   $xml->dataElement('CtrlSum', $self->_format_amount($grouped_transactions->{sum_amount}));
 138   $xml->dataElement('Grpg', 'MIXD');
 139
 140   $xml->startTag('InitgPty');
 141   $xml->dataElement('Nm', encode('UTF-8', substr($self->{company}, 0, 70)));
 142   $xml->endTag('InitgPty');
 143
 144   $xml->endTag('GrpHdr');
 145
 146   foreach my $key (keys %{ $grouped_transactions->{groups} }) {
 147     my $transaction_group  = $grouped_transactions->{groups}->{$key};
 148     my $master_transaction = $transaction_group->{transactions}->[0];
 149
 150     $xml->startTag('PmtInf');
 151     $xml->dataElement('PmtMtd', 'TRF');
 152
 153     $xml->startTag('PmtTpInf');
 154     $xml->startTag('SvcLvl');
 155     $xml->dataElement('Cd', 'SEPA');
 156     $xml->endTag('SvcLvl');
 157     $xml->endTag('PmtTpInf');
 158
 159     $xml->dataElement('ReqdExctnDt', $master_transaction->get('execution_date'));
 160     $xml->startTag('Dbtr');
 161     $xml->dataElement('Nm', encode('UTF-8', substr($self->{company}, 0, 70)));
 162     $xml->endTag('Dbtr');
 163
 164     $xml->startTag('DbtrAcct');
 165     $xml->startTag('Id');
 166     $xml->dataElement('IBAN', $master_transaction->get('src_iban', 34));
 167     $xml->endTag('Id');
 168     $xml->endTag('DbtrAcct');
 169
 170     $xml->startTag('DbtrAgt');
 171     $xml->startTag('FinInstnId');
 172     $xml->dataElement('BIC', $master_transaction->get('src_bic', 20));
 173     $xml->endTag('FinInstnId');
 174     $xml->endTag('DbtrAgt');
 175
 176     $xml->dataElement('ChrgBr', 'SLEV');
 177
 178     foreach my $transaction (@{ $transaction_group->{transactions} }) {
 179       $xml->startTag('CdtTrfTxInf');
 180
 181       $xml->startTag('PmtId');
 182       $xml->dataElement('EndToEndId', $transaction->get('end_to_end_id', 35));
 183       $xml->endTag('PmtId');
 184
 185       $xml->startTag('Amt');
 186       $xml->startTag('InstdAmt', 'Ccy' => 'EUR');
 187       $xml->characters($self->_format_amount($transaction->{amount}));
 188       $xml->endTag('InstdAmt');
 189       $xml->endTag('Amt');
 190
 191       $xml->startTag('CdtrAgt');
 192       $xml->startTag('FinInstnId');
 193       $xml->dataElement('BIC', $transaction->get('dst_bic', 20));
 194       $xml->endTag('FinInstnId');
 195       $xml->endTag('CdtrAgt');
 196
 197       $xml->startTag('Cdtr');
 198       $xml->dataElement('Nm', $transaction->get('recipient', 70));
 199       $xml->endTag('Cdtr');
 200
 201       $xml->startTag('CdtrAcct');
 202       $xml->startTag('Id');
 203       $xml->dataElement('IBAN', $transaction->get('dst_iban', 34));
 204       $xml->endTag('Id');
 205       $xml->endTag('CdtrAcct');
 206
 207       $xml->startTag('RmtInf');
 208       $xml->dataElement('Ustrd', $transaction->get('reference', 140));
 209       $xml->endTag('RmtInf');
 210
 211       $xml->endTag('CdtTrfTxInf');
 212     }
 213
 214     $xml->endTag('PmtInf');
 215   }
 216
 217   $xml->endTag('pain.001.001.02');
 218   $xml->endTag('Document');
 219
 220   return $output;
 221 }
 222
 223 1;
 224
 225 # Local Variables:
 226 # coding: utf-8
 227 # End: