View | Details | Raw Unified | Return to bug 40383
Collapse All | Expand All

(-)a/t/Edifact.t (-2 / +60 lines)
Lines 3-9 use strict; Link Here
3
use warnings;
3
use warnings;
4
use FindBin qw( $Bin );
4
use FindBin qw( $Bin );
5
5
6
use Test::More tests => 41;
6
use Test::More tests => 63;
7
use JSON qw( decode_json );
7
use Koha::EDI;
8
use Koha::EDI;
8
9
9
BEGIN { use_ok('Koha::Edifact') }
10
BEGIN { use_ok('Koha::Edifact') }
Lines 138-140 is( $dp, 9.0, 'Discount calculated with discount = 0' ); Link Here
138
139
139
$dp = Koha::EDI::_discounted_price( 0.0, 9, 8.0 );
140
$dp = Koha::EDI::_discounted_price( 0.0, 9, 8.0 );
140
is( $dp, 8.0, 'Discount overridden by incoming calculated value' );
141
is( $dp, 8.0, 'Discount overridden by incoming calculated value' );
141
- 
142
143
# Test JSON output functionality
144
my $json_output = $quote->to_json();
145
ok( $json_output, 'JSON output generated' );
146
147
my $parsed_json = decode_json($json_output);
148
ok( $parsed_json, 'JSON output is valid JSON' );
149
150
# Test structure
151
ok( exists $parsed_json->{header},   'JSON has header field' );
152
ok( exists $parsed_json->{messages}, 'JSON has messages field' );
153
ok( exists $parsed_json->{trailer},  'JSON has trailer field' );
154
155
# Test header content (should be UNB segment)
156
like( $parsed_json->{header}, qr/^UNB\+/, 'Header starts with UNB' );
157
158
# Test messages array
159
is( ref $parsed_json->{messages},         'ARRAY', 'Messages is an array' );
160
is( scalar @{ $parsed_json->{messages} }, 1,       'Correct number of messages' );
161
162
# Test first message structure
163
my $first_msg = $parsed_json->{messages}->[0];
164
ok( exists $first_msg->{header},   'Message has header' );
165
ok( exists $first_msg->{segments}, 'Message has segments' );
166
ok( exists $first_msg->{trailer},  'Message has trailer' );
167
168
# Test message header/trailer format
169
like( $first_msg->{header},  qr/^UNH\+/, 'Message header starts with UNH' );
170
like( $first_msg->{trailer}, qr/^UNT\+/, 'Message trailer starts with UNT' );
171
172
# Test segments array
173
is( ref $first_msg->{segments}, 'ARRAY', 'Segments is an array' );
174
ok( scalar @{ $first_msg->{segments} } > 0, 'Message has segments' );
175
176
# Find a LIN segment to test line_id functionality
177
my $lin_segment;
178
my $lin_related_segment;
179
for my $seg ( @{ $first_msg->{segments} } ) {
180
    if ( $seg->{tag} eq 'LIN' ) {
181
        $lin_segment = $seg;
182
    } elsif ( $lin_segment && $seg->{tag} =~ /^(QTY|PRI|PIA)$/ && $seg->{line_id} ) {
183
        $lin_related_segment = $seg;
184
        last;
185
    }
186
}
187
188
ok( $lin_segment, 'Found LIN segment in JSON' );
189
if ($lin_segment) {
190
    ok( exists $lin_segment->{line_id},  'LIN segment has line_id' );
191
    ok( exists $lin_segment->{raw},      'LIN segment has raw data' );
192
    ok( exists $lin_segment->{elements}, 'LIN segment has elements array' );
193
    like( $lin_segment->{raw}, qr/^LIN\+/, 'LIN raw data starts correctly' );
194
}
195
196
ok( $lin_related_segment, 'Found line-related segment with line_id' );
197
if ( $lin_related_segment && $lin_segment ) {
198
    is( $lin_related_segment->{line_id}, $lin_segment->{line_id}, 'Line-related segment has matching line_id' );
199
}

Return to bug 40383