From f9efa7a99c3ea1a803b00e53ccb0b8e3020b0edb Mon Sep 17 00:00:00 2001 From: Colin Campbell Date: Wed, 30 Oct 2019 12:34:45 +0000 Subject: [PATCH] Bug 23926: Limit GIR segment to 5 pieces of info Strictly if a GIR segment contains more than 5 pieces of information the it should be encoded in repeated segments each of 5 elements or less each sharing the same copy sequence number Signed-off-by: Kyle M Hall Signed-off-by: Martin Renvoize --- Koha/Edifact/Order.pm | 72 ++++++++++++++++++++++++++++++------------- t/Ediorder.t | 58 ++++++++++++++++++++++++++++++---- 2 files changed, 103 insertions(+), 27 deletions(-) diff --git a/Koha/Edifact/Order.pm b/Koha/Edifact/Order.pm index 062a2f930a..5dbe1e047f 100644 --- a/Koha/Edifact/Order.pm +++ b/Koha/Edifact/Order.pm @@ -406,12 +406,21 @@ sub order_line { if ( $orderline->order_vendornote ) { $ol_fields->{servicing_instruction} = $orderline->order_vendornote; } + my $item_fields = []; + for my $item (@items) { + push @{$item_fields}, + { + branchcode => $item->homebranch->branchcode, + itype => $item->itype, + location => $item->location, + itemcallnumber => $item->itemcallnumber, + }; + } $self->add_seg( gir_segments( { - basket => $basket, ol_fields => $ol_fields, - items => \@items + items => $item_fields } ) ); @@ -521,7 +530,6 @@ sub imd_segment { sub gir_segments { my ($params) = @_; - my $basket = $params->{basket}; my $orderfields = $params->{ol_fields}; my @onorderitems = @{ $params->{items} }; @@ -529,28 +537,50 @@ sub gir_segments { my @segments; my $sequence_no = 1; foreach my $item (@onorderitems) { - my $seg = sprintf 'GIR+%03d', $sequence_no; - $seg .= add_gir_identity_number( 'LFN', $budget_code ); - if ( $basket->effective_create_items eq 'ordering' ) { - $seg .= - add_gir_identity_number( 'LLO', $item->homebranch->branchcode ); - $seg .= add_gir_identity_number( 'LST', $item->itype ); - $seg .= add_gir_identity_number( 'LSQ', $item->location ); - $seg .= add_gir_identity_number( 'LSM', $item->itemcallnumber ); - - # itemcallnumber -> shelfmark + my $elements_added = 0; + my @gir_elements; + if ($budget_code) { + push @gir_elements, + { identity_number => 'LFN', data => $budget_code }; } - else { - if ( $item->{branch} ) { - $seg .= add_gir_identity_number( 'LLO', $item->{branch} ); - } - $seg .= add_gir_identity_number( 'LST', $item->{itemtype} ); - $seg .= add_gir_identity_number( 'LSM', $item->{shelfmark} ); + if ( $item->{branchcode} ) { + push @gir_elements, + { identity_number => 'LLO', data => $item->{branchcode} }; + } + if ( $item->{itype} ) { + push @gir_elements, + { identity_number => 'LST', data => $item->{itype} }; + } + if ( $item->{location} ) { + push @gir_elements, + { identity_number => 'LSQ', data => $item->{location} }; } + if ( $item->{itemcallnumber} ) { + push @gir_elements, + { identity_number => 'LSM', data => $item->{itemcallnumber} }; + } + + # itemcallnumber -> shelfmark if ( $orderfields->{servicing_instruction} ) { - $seg .= add_gir_identity_number( 'LVT', - $orderfields->{servicing_instruction} ); + push @gir_elements, + { + identity_number => 'LVT', + data => $orderfields->{servicing_instruction} + }; + } + my $e_cnt = 0; # count number of elements so we dont exceed 5 per segment + my $copy_no = sprintf 'GIR+%03d', $sequence_no; + my $seg = $copy_no; + foreach my $e (@gir_elements) { + if ( $e_cnt == 5 ) { + push @segments, $seg; + $seg = $copy_no; + } + $seg .= + add_gir_identity_number( $e->{identity_number}, $e->{data} ); + ++$e_cnt; } + $sequence_no++; push @segments, $seg; } diff --git a/t/Ediorder.t b/t/Ediorder.t index ceeb647371..30767a9671 100755 --- a/t/Ediorder.t +++ b/t/Ediorder.t @@ -3,13 +3,12 @@ use strict; use warnings; use FindBin qw( $Bin ); -use Test::More tests => 10; +use Test::More tests => 13; BEGIN { use_ok('Koha::Edifact::Order') } - # The following tests are for internal methods but they could -# error spectacularly so yest +# error spectacularly so best # Check that quoting is done correctly # my $processed_text = @@ -58,10 +57,13 @@ cmp_ok( $segs[1], 'eq', q{IMD+L+010+:::CCCCCCCCCC??'}, # special case for text ending in apostrophe e.g. nuthin' $data_to_encode .= q{?'}; @segs = Koha::Edifact::Order::imd_segment( $code, $data_to_encode ); -cmp_ok( $segs[1], 'eq', q{IMD+L+010+:::CCCCCCCCCC???''}, - 'IMD segment deals with quoted apostrophe at end' ); +cmp_ok( + $segs[1], 'eq', + q{IMD+L+010+:::CCCCCCCCCC???''}, + 'IMD segment deals with quoted apostrophe at end' +); -$data_to_encode =~s/\?'$//; +$data_to_encode =~ s/\?'$//; @segs = Koha::Edifact::Order::imd_segment( $code, $data_to_encode ); cmp_ok( $segs[1], 'eq', q{IMD+L+010+:::CCCCCCCCCC??'}, 'IMD segment deals with apostrophe preceded by quoted ? at end' ); @@ -76,3 +78,47 @@ cmp_ok( $seg, 'eq', q{PIA+5+3540556753:IB'}, $seg = Koha::Edifact::Order::additional_product_id($ean); cmp_ok( $seg, 'eq', q{PIA+5+9783540556756:EN'}, 'ean correctly encoded in PIA segment' ); + +my $orderfields = { budget_code => 'BUDGET', }; +my @items = ( + { + itype => 'TYPE', + location => 'LOCATION', + itemcallnumber => 'CALL', + branchcode => 'BRANCH', + }, + { + itype => 'TYPE', + location => 'LOCATION', + itemcallnumber => 'CALL', + branchcode => 'BRANCH', + } +); + +my @gsegs = Koha::Edifact::Order::gir_segments( + { + ol_fields => $orderfields, + items => \@items + } +); +cmp_ok( + $gsegs[0], 'eq', + q{GIR+001+BUDGET:LFN+BRANCH:LLO+TYPE:LST+LOCATION:LSQ+CALL:LSM}, + 'Single Gir field OK' +); + +$orderfields->{servicing_instruction} = 'S_I'; +@gsegs = Koha::Edifact::Order::gir_segments( + { + ol_fields => $orderfields, + items => \@items + } +); +cmp_ok( + $gsegs[2], 'eq', + q{GIR+002+BUDGET:LFN+BRANCH:LLO+TYPE:LST+LOCATION:LSQ+CALL:LSM}, + 'First part of split Gir field OK' +); + +cmp_ok( $gsegs[3], 'eq', q{GIR+002+S_I:LVT}, + 'Second part of split GIR field OK' ); -- 2.39.5