|
Lines 4-10
use warnings;
Link Here
|
| 4 |
use FindBin qw( $Bin ); |
4 |
use FindBin qw( $Bin ); |
| 5 |
|
5 |
|
| 6 |
use Test::NoWarnings; |
6 |
use Test::NoWarnings; |
| 7 |
use Test::More tests => 53; |
7 |
use Test::More tests => 75; |
|
|
8 |
use JSON qw( decode_json ); |
| 8 |
use Koha::EDI; |
9 |
use Koha::EDI; |
| 9 |
|
10 |
|
| 10 |
BEGIN { |
11 |
BEGIN { |
|
Lines 224-230
my $mock_line_data = {
Link Here
|
| 224 |
sub_location_code => 'REFERENCE', # LSL field |
225 |
sub_location_code => 'REFERENCE', # LSL field |
| 225 |
branch => 'BRANCH2' |
226 |
branch => 'BRANCH2' |
| 226 |
|
227 |
|
| 227 |
# sequence_code missing for this item |
228 |
# sequence_code missing for this item |
| 228 |
} |
229 |
} |
| 229 |
] |
230 |
] |
| 230 |
}; |
231 |
}; |
|
Lines 254-256
is( $y, undef, 'LSQ field correctly returns undef when not present for occurrenc
Link Here
|
| 254 |
# Test LSL field when LSQ is missing |
255 |
# Test LSL field when LSQ is missing |
| 255 |
$y = $mock_line->girfield( 'sub_location_code', 1 ); |
256 |
$y = $mock_line->girfield( 'sub_location_code', 1 ); |
| 256 |
is( $y, 'REFERENCE', 'LSL field works correctly when LSQ is missing for that occurrence' ); |
257 |
is( $y, 'REFERENCE', 'LSL field works correctly when LSQ is missing for that occurrence' ); |
| 257 |
- |
258 |
|
|
|
259 |
# Test JSON output functionality |
| 260 |
my $json_output = $quote->to_json(); |
| 261 |
ok( $json_output, 'JSON output generated' ); |
| 262 |
|
| 263 |
my $parsed_json = decode_json($json_output); |
| 264 |
ok( $parsed_json, 'JSON output is valid JSON' ); |
| 265 |
|
| 266 |
# Test structure |
| 267 |
ok( exists $parsed_json->{header}, 'JSON has header field' ); |
| 268 |
ok( exists $parsed_json->{messages}, 'JSON has messages field' ); |
| 269 |
ok( exists $parsed_json->{trailer}, 'JSON has trailer field' ); |
| 270 |
|
| 271 |
# Test header content (should be UNB segment) |
| 272 |
like( $parsed_json->{header}, qr/^UNB\+/, 'Header starts with UNB' ); |
| 273 |
|
| 274 |
# Test messages array |
| 275 |
is( ref $parsed_json->{messages}, 'ARRAY', 'Messages is an array' ); |
| 276 |
is( scalar @{ $parsed_json->{messages} }, 1, 'Correct number of messages' ); |
| 277 |
|
| 278 |
# Test first message structure |
| 279 |
my $first_msg = $parsed_json->{messages}->[0]; |
| 280 |
ok( exists $first_msg->{header}, 'Message has header' ); |
| 281 |
ok( exists $first_msg->{segments}, 'Message has segments' ); |
| 282 |
ok( exists $first_msg->{trailer}, 'Message has trailer' ); |
| 283 |
|
| 284 |
# Test message header/trailer format |
| 285 |
like( $first_msg->{header}, qr/^UNH\+/, 'Message header starts with UNH' ); |
| 286 |
like( $first_msg->{trailer}, qr/^UNT\+/, 'Message trailer starts with UNT' ); |
| 287 |
|
| 288 |
# Test segments array |
| 289 |
is( ref $first_msg->{segments}, 'ARRAY', 'Segments is an array' ); |
| 290 |
ok( scalar @{ $first_msg->{segments} } > 0, 'Message has segments' ); |
| 291 |
|
| 292 |
# Find a LIN segment to test line_id functionality |
| 293 |
my $lin_segment; |
| 294 |
my $lin_related_segment; |
| 295 |
for my $seg ( @{ $first_msg->{segments} } ) { |
| 296 |
if ( $seg->{tag} eq 'LIN' ) { |
| 297 |
$lin_segment = $seg; |
| 298 |
} elsif ( $lin_segment && $seg->{tag} =~ /^(QTY|PRI|PIA)$/ && $seg->{line_id} ) { |
| 299 |
$lin_related_segment = $seg; |
| 300 |
last; |
| 301 |
} |
| 302 |
} |
| 303 |
|
| 304 |
ok( $lin_segment, 'Found LIN segment in JSON' ); |
| 305 |
if ($lin_segment) { |
| 306 |
ok( exists $lin_segment->{line_id}, 'LIN segment has line_id' ); |
| 307 |
ok( exists $lin_segment->{raw}, 'LIN segment has raw data' ); |
| 308 |
ok( exists $lin_segment->{elements}, 'LIN segment has elements array' ); |
| 309 |
like( $lin_segment->{raw}, qr/^LIN\+/, 'LIN raw data starts correctly' ); |
| 310 |
} |
| 311 |
|
| 312 |
ok( $lin_related_segment, 'Found line-related segment with line_id' ); |
| 313 |
if ( $lin_related_segment && $lin_segment ) { |
| 314 |
is( $lin_related_segment->{line_id}, $lin_segment->{line_id}, 'Line-related segment has matching line_id' ); |
| 315 |
} |