Revision 9c0429ad
Von Moritz Bunkus vor 4 Monaten hinzugefügt
- ID 9c0429ad0bd57173c8e7139d8d5959455805f2aa
- Vorgänger 642565a3
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