Revision d62a113d
Von Moritz Bunkus vor etwa 1 Monat hinzugefügt
| SL/SEPA/XML.pm | ||
|---|---|---|
| 5 | 5 |
|
| 6 | 6 |
use Carp; |
| 7 | 7 |
use Encode; |
| 8 |
use List::Util qw(first sum); |
|
| 9 | 8 |
use List::MoreUtils qw(any); |
| 9 |
use List::Util qw(first sum); |
|
| 10 | 10 |
use POSIX qw(strftime); |
| 11 | 11 |
use XML::Writer; |
| 12 | 12 |
|
| 13 | 13 |
use SL::Iconv; |
| 14 | 14 |
use SL::SEPA::XML::Transaction; |
| 15 | 15 |
|
| 16 |
use constant V3_0_0 => 3_000_000; |
|
| 17 |
use constant V3_8_0 => 3_800_000; |
|
| 18 |
|
|
| 19 |
sub get_supported_versions {
|
|
| 20 |
return ( |
|
| 21 |
versions => [ |
|
| 22 |
{ id => V3_0_0(), description => "v3.0.0" },
|
|
| 23 |
{ id => V3_8_0(), description => "v3.8.0" },
|
|
| 24 |
], |
|
| 25 |
default => get_default_version(), |
|
| 26 |
); |
|
| 27 |
} |
|
| 28 |
|
|
| 29 |
sub get_default_version {
|
|
| 30 |
my $today = DateTime->today_local; |
|
| 31 |
my $cutoff_v3_8_0 = DateTime->new_local(year => 2025, month => 10, day => 1); |
|
| 32 |
|
|
| 33 |
return V3_8_0() if $today >= $cutoff_v3_8_0; |
|
| 34 |
return V3_0_0(); |
|
| 35 |
} |
|
| 36 |
|
|
| 37 |
sub is_version_valid {
|
|
| 38 |
shift while @_ && ref($_[0]); |
|
| 39 |
|
|
| 40 |
my $id = $_[0]; |
|
| 41 |
my %versions = get_supported_versions(); |
|
| 42 |
|
|
| 43 |
return any { $_->{id} == $id } @{ $versions{versions} };
|
|
| 44 |
} |
|
| 45 |
|
|
| 16 | 46 |
sub new {
|
| 17 | 47 |
my $class = shift; |
| 18 | 48 |
my $self = {};
|
| ... | ... | |
| 31 | 61 |
$self->{transactions} = [];
|
| 32 | 62 |
$self->{src_charset} = 'UTF-8';
|
| 33 | 63 |
$self->{grouped} = 0;
|
| 64 |
$self->{version} = get_default_version();
|
|
| 34 | 65 |
|
| 35 |
map { $self->{$_} = $params{$_} if (exists $params{$_}) } qw(src_charset company creditor_id message_id grouped collection);
|
|
| 66 |
map { $self->{$_} = $params{$_} if (exists $params{$_}) } qw(src_charset company creditor_id message_id grouped collection version);
|
|
| 36 | 67 |
|
| 37 | 68 |
$self->{iconv} = SL::Iconv->new($self->{src_charset}, "UTF-8") || croak "Unsupported source charset $self->{src_charset}.";
|
| 38 | 69 |
|
| 39 | 70 |
my $missing_parameter = first { !$self->{$_} } qw(company message_id);
|
| 40 | 71 |
croak "Missing parameter: $missing_parameter" if ($missing_parameter); |
| 41 | 72 |
croak "Missing parameter: creditor_id" if !$self->{creditor_id} && $self->{collection};
|
| 73 |
croak "Invalid parameter: version" if !is_version_valid($self->{version});
|
|
| 42 | 74 |
|
| 43 | 75 |
map { $self->{$_} = $self->_replace_special_chars($self->{iconv}->convert($self->{$_})) } qw(company message_id creditor_id);
|
| 44 | 76 |
} |
| ... | ... | |
| 124 | 156 |
return substr $string, 0, 35; |
| 125 | 157 |
} |
| 126 | 158 |
|
| 159 |
sub _emit_cdtr_scheme_id {
|
|
| 160 |
my ($self, $xml) = @_; |
|
| 161 |
|
|
| 162 |
$xml->startTag('CdtrSchmeId');
|
|
| 163 |
$xml->startTag('Id');
|
|
| 164 |
$xml->startTag('PrvtId');
|
|
| 165 |
$xml->startTag('Othr');
|
|
| 166 |
$xml->dataElement('Id', encode('UTF-8', substr($self->{creditor_id}, 0, 35)));
|
|
| 167 |
$xml->startTag('SchmeNm');
|
|
| 168 |
$xml->dataElement('Prtry', 'SEPA');
|
|
| 169 |
$xml->endTag('SchmeNm');
|
|
| 170 |
$xml->endTag('Othr');
|
|
| 171 |
$xml->endTag('PrvtId');
|
|
| 172 |
$xml->endTag('Id');
|
|
| 173 |
$xml->endTag('CdtrSchmeId');
|
|
| 174 |
} |
|
| 175 |
|
|
| 127 | 176 |
sub to_xml {
|
| 128 | 177 |
my $self = shift; |
| 129 | 178 |
|
| ... | ... | |
| 143 | 192 |
my $is_coll = $self->{collection};
|
| 144 | 193 |
my $cd_src = $is_coll ? 'Cdtr' : 'Dbtr'; |
| 145 | 194 |
my $cd_dst = $is_coll ? 'Dbtr' : 'Cdtr'; |
| 146 |
my $pain_id = $is_coll ? 'pain.008.001.08' : 'pain.001.001.09'; |
|
| 147 | 195 |
my $pain_elmt = $is_coll ? 'CstmrDrctDbtInitn' : 'CstmrCdtTrfInitn'; |
| 148 | 196 |
my @pii_base = (strftime('PII%Y%m%d%H%M%S', @now), rand(1000000000));
|
| 197 |
my $pain_id = $is_coll && ($self->{version} == V3_0_0()) ? 'pain.008.001.02'
|
|
| 198 |
: $is_coll && ($self->{version} == V3_8_0()) ? 'pain.008.001.08'
|
|
| 199 |
: !$is_coll && ($self->{version} == V3_0_0()) ? 'pain.001.001.03'
|
|
| 200 |
: !$is_coll && ($self->{version} == V3_8_0()) ? 'pain.001.001.09'
|
|
| 201 |
: die("programming error: version not handled for pain ID");
|
|
| 202 |
my $bic_elt = $self->{version} == V3_0_0() ? 'BIC'
|
|
| 203 |
: $self->{version} == V3_8_0() ? 'BICFI'
|
|
| 204 |
: die("programming error: version not handled for BIC element name");
|
|
| 149 | 205 |
|
| 150 | 206 |
my $grouped_transactions = $self->_group_transactions(); |
| 151 | 207 |
|
| ... | ... | |
| 194 | 250 |
} |
| 195 | 251 |
$xml->endTag('PmtTpInf');
|
| 196 | 252 |
|
| 197 |
if ($is_coll) {
|
|
| 198 |
$xml->dataElement('ReqdColltnDt', $master_transaction->get('execution_date'));
|
|
| 253 |
if ($self->{version} == V3_0_0()) {
|
|
| 254 |
$xml->dataElement($is_coll ? 'ReqdColltnDt' : 'ReqdExctnDt', $master_transaction->get('execution_date'));
|
|
| 255 |
|
|
| 256 |
} elsif ($self->{version} == V3_8_0()) {
|
|
| 257 |
if ($is_coll) {
|
|
| 258 |
$xml->dataElement('ReqdColltnDt', $master_transaction->get('execution_date'));
|
|
| 259 |
} else {
|
|
| 260 |
$xml->startTag('ReqdExctnDt');
|
|
| 261 |
$xml->dataElement('Dt', $master_transaction->get('execution_date'));
|
|
| 262 |
$xml->endTag('ReqdExctnDt');
|
|
| 263 |
} |
|
| 264 |
|
|
| 199 | 265 |
} else {
|
| 200 |
$xml->startTag('ReqdExctnDt');
|
|
| 201 |
$xml->dataElement('Dt', $master_transaction->get('execution_date'));
|
|
| 202 |
$xml->endTag('ReqdExctnDt');
|
|
| 266 |
die("programming error: version not handled for ReqdColl/ExctnDt");
|
|
| 203 | 267 |
} |
| 204 | 268 |
|
| 205 | 269 |
$xml->startTag($cd_src); |
| ... | ... | |
| 214 | 278 |
|
| 215 | 279 |
$xml->startTag($cd_src . 'Agt'); |
| 216 | 280 |
$xml->startTag('FinInstnId');
|
| 217 |
$xml->dataElement('BICFI', $master_transaction->get('src_bic', 20));
|
|
| 281 |
$xml->dataElement($bic_elt, $master_transaction->get('src_bic', 20));
|
|
| 218 | 282 |
$xml->endTag('FinInstnId');
|
| 219 | 283 |
$xml->endTag($cd_src . 'Agt'); |
| 220 | 284 |
|
| 221 | 285 |
$xml->dataElement('ChrgBr', 'SLEV');
|
| 222 | 286 |
|
| 223 |
if ($is_coll) {
|
|
| 224 |
$xml->startTag('CdtrSchmeId');
|
|
| 225 |
$xml->startTag('Id');
|
|
| 226 |
$xml->startTag('PrvtId');
|
|
| 227 |
$xml->startTag('Othr');
|
|
| 228 |
$xml->dataElement('Id', encode('UTF-8', substr($self->{creditor_id}, 0, 35)));
|
|
| 229 |
$xml->startTag('SchmeNm');
|
|
| 230 |
$xml->dataElement('Prtry', 'SEPA');
|
|
| 231 |
$xml->endTag('SchmeNm');
|
|
| 232 |
$xml->endTag('Othr');
|
|
| 233 |
$xml->endTag('PrvtId');
|
|
| 234 |
$xml->endTag('Id');
|
|
| 235 |
$xml->endTag('CdtrSchmeId');
|
|
| 287 |
if ($is_coll && ($self->{version} == V3_8_0())) {
|
|
| 288 |
$self->_emit_cdtr_scheme_id($xml); |
|
| 236 | 289 |
} |
| 237 | 290 |
|
| 238 | 291 |
foreach my $transaction (@{ $transaction_group->{transactions} }) {
|
| ... | ... | |
| 253 | 306 |
$xml->dataElement('MndtId', $self->_restricted_identification_sepa2($transaction->get('mandator_id')));
|
| 254 | 307 |
$xml->dataElement('DtOfSgntr', $self->_restricted_identification_sepa2($transaction->get('date_of_signature')));
|
| 255 | 308 |
|
| 309 |
if ($self->{version} == V3_0_0()) {
|
|
| 310 |
$self->_emit_cdtr_scheme_id($xml); |
|
| 311 |
} |
|
| 312 |
|
|
| 256 | 313 |
$xml->endTag('MndtRltdInf');
|
| 257 | 314 |
|
| 258 | 315 |
$xml->endTag('DrctDbtTx');
|
| ... | ... | |
| 267 | 324 |
|
| 268 | 325 |
$xml->startTag("${cd_dst}Agt");
|
| 269 | 326 |
$xml->startTag('FinInstnId');
|
| 270 |
$xml->dataElement('BICFI', $transaction->get('dst_bic', 20));
|
|
| 327 |
$xml->dataElement($bic_elt, $transaction->get('dst_bic', 20));
|
|
| 271 | 328 |
$xml->endTag('FinInstnId');
|
| 272 | 329 |
$xml->endTag("${cd_dst}Agt");
|
| 273 | 330 |
|
Auch abrufbar als: Unified diff
SEPA: XML-Version beim Download auswählbar