Attachment #94874 for bug #23926

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




    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     => $item_fields
            }
        )
    );

sub gir_segments {
    my ($params) = @_;

    my $basket       = $params->{basket};
    my $orderfields  = $params->{ol_fields};
    my @onorderitems = @{ $params->{items} };


    my @segments;
    my $sequence_no = 1;
    foreach my $item (@onorderitems) {
        my $elements_added = 0;
        my @gir_elements;
        if ($budget_code) {
            push @gir_elements,
              { identity_number => 'LFN', data => $budget_code };
            $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
        }
        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} ) {
            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;
    }




use warnings;
use FindBin qw( $Bin );

use Test::More tests => 13;

BEGIN { use_ok('Koha::Edifact::Order') }


# The following tests are for internal methods but they could
# error spectacularly so best
# Check that quoting is done correctly
#
my $processed_text =

# 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'
);

$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' );

$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' );

Return to bug 23926

Lines 406-417 sub order_line { Link Here

(-)a/Koha/Edifact/Order.pm (-21 / +51 lines)
406	if ( $orderline->order_vendornote ) {	406	if ( $orderline->order_vendornote ) {
407	$ol_fields->{servicing_instruction} = $orderline->order_vendornote;	407	$ol_fields->{servicing_instruction} = $orderline->order_vendornote;
408	}	408	}
		409	my $item_fields = [];
		410	for my $item (@items) {
		411	push @{$item_fields},
		412	{
		413	branchcode => $item->homebranch->branchcode,
		414	itype => $item->itype,
		415	location => $item->location,
		416	itemcallnumber => $item->itemcallnumber,
		417	};
		418	}
409	$self->add_seg(	419	$self->add_seg(
410	gir_segments(	420	gir_segments(
411	{	421	{
412	basket => $basket,
413	ol_fields => $ol_fields,	422	ol_fields => $ol_fields,
414	items => \@items	423	items => $item_fields
415	}	424	}
416	)	425	)
417	);	426	);
Lines 521-527 sub imd_segment { Link Here
521	sub gir_segments {	530	sub gir_segments {
522	my ($params) = @_;	531	my ($params) = @_;
523		532
524	my $basket = $params->{basket};
525	my $orderfields = $params->{ol_fields};	533	my $orderfields = $params->{ol_fields};
526	my @onorderitems = @{ $params->{items} };	534	my @onorderitems = @{ $params->{items} };
527		535
Lines 529-556 sub gir_segments { Link Here
529	my @segments;	537	my @segments;
530	my $sequence_no = 1;	538	my $sequence_no = 1;
531	foreach my $item (@onorderitems) {	539	foreach my $item (@onorderitems) {
532	my $seg = sprintf 'GIR+%03d', $sequence_no;	540	my $elements_added = 0;
533	$seg .= add_gir_identity_number( 'LFN', $budget_code );	541	my @gir_elements;
534	if ( $basket->effective_create_items eq 'ordering' ) {	542	if ($budget_code) {
535	$seg .=	543	push @gir_elements,
536	add_gir_identity_number( 'LLO', $item->homebranch->branchcode );	544	{ identity_number => 'LFN', data => $budget_code };
537	$seg .= add_gir_identity_number( 'LST', $item->itype );
538	$seg .= add_gir_identity_number( 'LSQ', $item->location );
539	$seg .= add_gir_identity_number( 'LSM', $item->itemcallnumber );
540
541	# itemcallnumber -> shelfmark
542	}	545	}
543	else {	546	if ( $item->{branchcode} ) {
544	if ( $item->{branch} ) {	547	push @gir_elements,
545	$seg .= add_gir_identity_number( 'LLO', $item->{branch} );	548	{ identity_number => 'LLO', data => $item->{branchcode} };
546	}	549	}
547	$seg .= add_gir_identity_number( 'LST', $item->{itemtype} );	550	if ( $item->{itype} ) {
548	$seg .= add_gir_identity_number( 'LSM', $item->{shelfmark} );	551	push @gir_elements,
		552	{ identity_number => 'LST', data => $item->{itype} };
		553	}
		554	if ( $item->{location} ) {
		555	push @gir_elements,
		556	{ identity_number => 'LSQ', data => $item->{location} };
549	}	557	}
		558	if ( $item->{itemcallnumber} ) {
		559	push @gir_elements,
		560	{ identity_number => 'LSM', data => $item->{itemcallnumber} };
		561	}
		562
		563	# itemcallnumber -> shelfmark
550	if ( $orderfields->{servicing_instruction} ) {	564	if ( $orderfields->{servicing_instruction} ) {
551	$seg .= add_gir_identity_number( 'LVT',	565	push @gir_elements,
552	$orderfields->{servicing_instruction} );	566	{
		567	identity_number => 'LVT',
		568	data => $orderfields->{servicing_instruction}
		569	};
		570	}
		571	my $e_cnt = 0; # count number of elements so we dont exceed 5 per segment
		572	my $copy_no = sprintf 'GIR+%03d', $sequence_no;
		573	my $seg = $copy_no;
		574	foreach my $e (@gir_elements) {
		575	if ( $e_cnt == 5 ) {
		576	push @segments, $seg;
		577	$seg = $copy_no;
		578	}
		579	$seg .=
		580	add_gir_identity_number( $e->{identity_number}, $e->{data} );
		581	++$e_cnt;
553	}	582	}
		583
554	$sequence_no++;	584	$sequence_no++;
555	push @segments, $seg;	585	push @segments, $seg;
556	}	586	}

Lines 3-15 use strict; Link Here

(-)a/t/Ediorder.t (-7 / +52 lines)
3	use warnings;	3	use warnings;
4	use FindBin qw( $Bin );	4	use FindBin qw( $Bin );
5		5
6	use Test::More tests => 10;	6	use Test::More tests => 13;
7		7
8	BEGIN { use_ok('Koha::Edifact::Order') }	8	BEGIN { use_ok('Koha::Edifact::Order') }
9		9
10
11	# The following tests are for internal methods but they could	10	# The following tests are for internal methods but they could
12	# error spectacularly so yest	11	# error spectacularly so best
13	# Check that quoting is done correctly	12	# Check that quoting is done correctly
14	#	13	#
15	my $processed_text =	14	my $processed_text =
Lines 58-67 cmp_ok( $segs[1], 'eq', q{IMD+L+010+:::CCCCCCCCCC??'}, Link Here
58	# special case for text ending in apostrophe e.g. nuthin'	57	# special case for text ending in apostrophe e.g. nuthin'
59	$data_to_encode .= q{?'};	58	$data_to_encode .= q{?'};
60	@segs = Koha::Edifact::Order::imd_segment( $code, $data_to_encode );	59	@segs = Koha::Edifact::Order::imd_segment( $code, $data_to_encode );
61	cmp_ok( $segs[1], 'eq', q{IMD+L+010+:::CCCCCCCCCC???''},	60	cmp_ok(
62	'IMD segment deals with quoted apostrophe at end' );	61	$segs[1], 'eq',
		62	q{IMD+L+010+:::CCCCCCCCCC???''},
		63	'IMD segment deals with quoted apostrophe at end'
		64	);
63		65
64	$data_to_encode =~s/\?'$//;	66	$data_to_encode =~ s/\?'$//;
65	@segs = Koha::Edifact::Order::imd_segment( $code, $data_to_encode );	67	@segs = Koha::Edifact::Order::imd_segment( $code, $data_to_encode );
66	cmp_ok( $segs[1], 'eq', q{IMD+L+010+:::CCCCCCCCCC??'},	68	cmp_ok( $segs[1], 'eq', q{IMD+L+010+:::CCCCCCCCCC??'},
67	'IMD segment deals with apostrophe preceded by quoted ? at end' );	69	'IMD segment deals with apostrophe preceded by quoted ? at end' );
Lines 76-78 cmp_ok( $seg, 'eq', q{PIA+5+3540556753:IB'}, Link Here
76	$seg = Koha::Edifact::Order::additional_product_id($ean);	78	$seg = Koha::Edifact::Order::additional_product_id($ean);
77	cmp_ok( $seg, 'eq', q{PIA+5+9783540556756:EN'},	79	cmp_ok( $seg, 'eq', q{PIA+5+9783540556756:EN'},
78	'ean correctly encoded in PIA segment' );	80	'ean correctly encoded in PIA segment' );
79	-	81
		82	my $orderfields = { budget_code => 'BUDGET', };
		83	my @items = (
		84	{
		85	itype => 'TYPE',
		86	location => 'LOCATION',
		87	itemcallnumber => 'CALL',
		88	branchcode => 'BRANCH',
		89	},
		90	{
		91	itype => 'TYPE',
		92	location => 'LOCATION',
		93	itemcallnumber => 'CALL',
		94	branchcode => 'BRANCH',
		95	}
		96	);
		97
		98	my @gsegs = Koha::Edifact::Order::gir_segments(
		99	{
		100	ol_fields => $orderfields,
		101	items => \@items
		102	}
		103	);
		104	cmp_ok(
		105	$gsegs[0], 'eq',
		106	q{GIR+001+BUDGET:LFN+BRANCH:LLO+TYPE:LST+LOCATION:LSQ+CALL:LSM},
		107	'Single Gir field OK'
		108	);
		109
		110	$orderfields->{servicing_instruction} = 'S_I';
		111	@gsegs = Koha::Edifact::Order::gir_segments(
		112	{
		113	ol_fields => $orderfields,
		114	items => \@items
		115	}
		116	);
		117	cmp_ok(
		118	$gsegs[2], 'eq',
		119	q{GIR+002+BUDGET:LFN+BRANCH:LLO+TYPE:LST+LOCATION:LSQ+CALL:LSM},
		120	'First part of split Gir field OK'
		121	);
		122
		123	cmp_ok( $gsegs[3], 'eq', q{GIR+002+S_I:LVT},
		124	'Second part of split GIR field OK' );