|
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 => 46; |
7 |
use Test::More tests => 68; |
|
|
8 |
use JSON qw( decode_json ); |
| 8 |
use Koha::EDI; |
9 |
use Koha::EDI; |
| 9 |
|
10 |
|
| 10 |
BEGIN { |
11 |
BEGIN { |
|
Lines 209-211
is( $message->purchase_order_number, undef, 'RFF+ON after LIN segment is ignored
Link Here
|
| 209 |
|
210 |
|
| 210 |
$message = Koha::Edifact::Message->new( [ $header, $bgm, @datasegs ] ); |
211 |
$message = Koha::Edifact::Message->new( [ $header, $bgm, @datasegs ] ); |
| 211 |
is( $message->purchase_order_number, 'CORRECT_PO_NUM', 'Correct RFF+ON extracted when multiple RFF segments present' ); |
212 |
is( $message->purchase_order_number, 'CORRECT_PO_NUM', 'Correct RFF+ON extracted when multiple RFF segments present' ); |
| 212 |
- |
213 |
|
|
|
214 |
# Test JSON output functionality |
| 215 |
my $json_output = $quote->to_json(); |
| 216 |
ok( $json_output, 'JSON output generated' ); |
| 217 |
|
| 218 |
my $parsed_json = decode_json($json_output); |
| 219 |
ok( $parsed_json, 'JSON output is valid JSON' ); |
| 220 |
|
| 221 |
# Test structure |
| 222 |
ok( exists $parsed_json->{header}, 'JSON has header field' ); |
| 223 |
ok( exists $parsed_json->{messages}, 'JSON has messages field' ); |
| 224 |
ok( exists $parsed_json->{trailer}, 'JSON has trailer field' ); |
| 225 |
|
| 226 |
# Test header content (should be UNB segment) |
| 227 |
like( $parsed_json->{header}, qr/^UNB\+/, 'Header starts with UNB' ); |
| 228 |
|
| 229 |
# Test messages array |
| 230 |
is( ref $parsed_json->{messages}, 'ARRAY', 'Messages is an array' ); |
| 231 |
is( scalar @{ $parsed_json->{messages} }, 1, 'Correct number of messages' ); |
| 232 |
|
| 233 |
# Test first message structure |
| 234 |
my $first_msg = $parsed_json->{messages}->[0]; |
| 235 |
ok( exists $first_msg->{header}, 'Message has header' ); |
| 236 |
ok( exists $first_msg->{segments}, 'Message has segments' ); |
| 237 |
ok( exists $first_msg->{trailer}, 'Message has trailer' ); |
| 238 |
|
| 239 |
# Test message header/trailer format |
| 240 |
like( $first_msg->{header}, qr/^UNH\+/, 'Message header starts with UNH' ); |
| 241 |
like( $first_msg->{trailer}, qr/^UNT\+/, 'Message trailer starts with UNT' ); |
| 242 |
|
| 243 |
# Test segments array |
| 244 |
is( ref $first_msg->{segments}, 'ARRAY', 'Segments is an array' ); |
| 245 |
ok( scalar @{ $first_msg->{segments} } > 0, 'Message has segments' ); |
| 246 |
|
| 247 |
# Find a LIN segment to test line_id functionality |
| 248 |
my $lin_segment; |
| 249 |
my $lin_related_segment; |
| 250 |
for my $seg ( @{ $first_msg->{segments} } ) { |
| 251 |
if ( $seg->{tag} eq 'LIN' ) { |
| 252 |
$lin_segment = $seg; |
| 253 |
} elsif ( $lin_segment && $seg->{tag} =~ /^(QTY|PRI|PIA)$/ && $seg->{line_id} ) { |
| 254 |
$lin_related_segment = $seg; |
| 255 |
last; |
| 256 |
} |
| 257 |
} |
| 258 |
|
| 259 |
ok( $lin_segment, 'Found LIN segment in JSON' ); |
| 260 |
if ($lin_segment) { |
| 261 |
ok( exists $lin_segment->{line_id}, 'LIN segment has line_id' ); |
| 262 |
ok( exists $lin_segment->{raw}, 'LIN segment has raw data' ); |
| 263 |
ok( exists $lin_segment->{elements}, 'LIN segment has elements array' ); |
| 264 |
like( $lin_segment->{raw}, qr/^LIN\+/, 'LIN raw data starts correctly' ); |
| 265 |
} |
| 266 |
|
| 267 |
ok( $lin_related_segment, 'Found line-related segment with line_id' ); |
| 268 |
if ( $lin_related_segment && $lin_segment ) { |
| 269 |
is( $lin_related_segment->{line_id}, $lin_segment->{line_id}, 'Line-related segment has matching line_id' ); |
| 270 |
} |