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

(-)a/Koha/EDI.pm (-34 / +46 lines)
Lines 917-965 sub quote_item { Link Here
917
        $order_hash->{line_item_id} = $item->item_number_id;
917
        $order_hash->{line_item_id} = $item->item_number_id;
918
    }
918
    }
919
919
920
    # Extract servicing instructions (LVT freetext and/or LVC coded)
920
    # Helper function to extract servicing instructions for a specific GIR occurrence
921
    # Build JSON array structure: [[{type,value},...]]
921
    my $extract_servicing_instructions = sub {
922
    my @servicing_groups;
922
        my ($occurrence) = @_;
923
    my @current_group;
923
        my @group;
924
924
925
    # Read LVC (coded) instructions
925
        # Read LVC (coded) instruction for this occurrence
926
    my $occ = 0;
926
        my $lvc_val = $item->girfield( 'coded_servicing_instruction', $occurrence );
927
    my $lvc_val;
927
        if ($lvc_val) {
928
    while ( $lvc_val = $item->girfield( 'coded_servicing_instruction', $occ ) ) {
929
928
930
        # Validate against EDIFACT_SI authorized values
929
            # Validate against EDIFACT_SI authorized values
931
        my $av = Koha::AuthorisedValues->find(
930
            my $av = Koha::AuthorisedValues->find(
932
            {
933
                category         => 'EDIFACT_SI',
934
                authorised_value => $lvc_val
935
            }
936
        );
937
        if ($av) {
938
            push @current_group, { type => 'LVC', value => $lvc_val };
939
        } else {
940
            $quote_message->add_to_edifact_errors(
941
                {
931
                {
942
                    section => "GIR+LVC validation",
932
                    category         => 'EDIFACT_SI',
943
                    details =>
933
                    authorised_value => $lvc_val
944
                        "Invalid servicing instruction code '$lvc_val' - not found in EDIFACT_SI authorized values"
945
                }
934
                }
946
            );
935
            );
947
            $logger->trace("Invalid servicing instruction code: $lvc_val");
936
            if ($av) {
937
                push @group, { type => 'LVC', value => $lvc_val };
938
            } else {
939
                $quote_message->add_to_edifact_errors(
940
                    {
941
                        section => "GIR+LVC validation",
942
                        details =>
943
                            "Invalid servicing instruction code '$lvc_val' - not found in EDIFACT_SI authorized values"
944
                    }
945
                );
946
                $logger->trace("Invalid servicing instruction code: $lvc_val");
947
            }
948
        }
948
        }
949
        ++$occ;
950
    }
951
949
952
    # Read LVT (freetext) instructions
950
        # Read LVT (freetext) instruction for this occurrence
953
    $occ = 0;
951
        my $lvt_val = $item->girfield( 'servicing_instruction', $occurrence );
954
    my $lvt_val;
952
        if ($lvt_val) {
955
    while ( $lvt_val = $item->girfield( 'servicing_instruction', $occ ) ) {
953
            push @group, { type => 'LVT', value => $lvt_val };
956
        push @current_group, { type => 'LVT', value => $lvt_val };
954
        }
957
        ++$occ;
955
958
    }
956
        return \@group;
957
    };
958
959
    # Extract servicing instructions for first order (occurrence 0)
960
    my @servicing_groups;
961
    my $current_group = $extract_servicing_instructions->(0);
959
962
960
    # Store as JSON if we have any instructions
963
    # Store as JSON if we have any instructions
961
    if (@current_group) {
964
    if (@$current_group) {
962
        push @servicing_groups, \@current_group;
965
        push @servicing_groups, $current_group;
963
        $order_hash->{servicing_instruction} = encode_json( \@servicing_groups );
966
        $order_hash->{servicing_instruction} = encode_json( \@servicing_groups );
964
    }
967
    }
965
    if ($order_note) {
968
    if ($order_note) {
Lines 1090-1095 sub quote_item { Link Here
1090
1093
1091
                $order_hash->{budget_id} = $budget->budget_id;
1094
                $order_hash->{budget_id} = $budget->budget_id;
1092
1095
1096
                # Extract servicing instructions for this occurrence
1097
                my $si_group = $extract_servicing_instructions->($occurrence);
1098
                if (@$si_group) {
1099
                    my @si_groups = ($si_group);
1100
                    $order_hash->{servicing_instruction} = encode_json( \@si_groups );
1101
                } else {
1102
                    $order_hash->{servicing_instruction} = undef;
1103
                }
1104
1093
                my $new_order = $schema->resultset('Aqorder')->create($order_hash);
1105
                my $new_order = $schema->resultset('Aqorder')->create($order_hash);
1094
                my $o         = $new_order->ordernumber();
1106
                my $o         = $new_order->ordernumber();
1095
                $logger->trace("Order created: $o");
1107
                $logger->trace("Order created: $o");
(-)a/t/db_dependent/Koha/EDI.t (-1 / +197 lines)
Lines 21-28 use Modern::Perl; Link Here
21
use FindBin qw( $Bin );
21
use FindBin qw( $Bin );
22
22
23
use Test::NoWarnings;
23
use Test::NoWarnings;
24
use Test::More tests => 8;
24
use Test::More tests => 9;
25
use Test::MockModule;
25
use Test::MockModule;
26
use JSON qw( decode_json );
26
27
27
use t::lib::Mocks;
28
use t::lib::Mocks;
28
use t::lib::Mocks::Logger;
29
use t::lib::Mocks::Logger;
Lines 1907-1909 subtest 'LSL and LSQ field copy to item_hash' => sub { Link Here
1907
1908
1908
    $schema->storage->txn_rollback;
1909
    $schema->storage->txn_rollback;
1909
};
1910
};
1911
1912
subtest 'servicing_instructions_quote_processing' => sub {
1913
    plan tests => 29;
1914
1915
    $schema->storage->txn_begin;
1916
1917
    # Setup test data
1918
    my $test_san = '5013546098818';
1919
    my $dirname  = ( $Bin =~ /^(.*\/t\/)/ ? $1 . 'edi_testfiles/' : q{} );
1920
1921
    my $active_period = $builder->build(
1922
        {
1923
            source => 'Aqbudgetperiod',
1924
            value  => { budget_period_active => 1 }
1925
        }
1926
    );
1927
1928
    # Create file transport
1929
    my $file_transport = $builder->build(
1930
        {
1931
            source => 'FileTransport',
1932
            value  => {
1933
                name               => 'Test Servicing Transport',
1934
                transport          => 'local',
1935
                download_directory => $dirname,
1936
                upload_directory   => $dirname,
1937
            }
1938
        }
1939
    );
1940
1941
    # Create vendor EDI account
1942
    my $account = $builder->build(
1943
        {
1944
            source => 'VendorEdiAccount',
1945
            value  => {
1946
                description       => 'servicing instruction vendor',
1947
                file_transport_id => $file_transport->{file_transport_id},
1948
                plugin            => '',
1949
                san               => $test_san,
1950
                orders_enabled    => 1,
1951
                auto_orders       => 0,
1952
            }
1953
        }
1954
    );
1955
1956
    my $ean = $builder->build(
1957
        {
1958
            source => 'EdifactEan',
1959
            value  => {
1960
                description => 'test ean',
1961
                branchcode  => undef,
1962
                ean         => $test_san
1963
            }
1964
        }
1965
    );
1966
1967
    # Setup branches used in test file
1968
    for my $code (qw(CPL MPL FPL)) {
1969
        local $SIG{__WARN__} = sub { };    # Suppress warnings
1970
        eval {
1971
            $builder->build(
1972
                {
1973
                    source => 'Branch',
1974
                    value  => { branchcode => $code }
1975
                }
1976
            );
1977
        };                                 # Ignore duplicate key errors
1978
    }
1979
1980
    # Setup funds used in test file
1981
    for my $code (qw(REF LOAN)) {
1982
        $builder->build(
1983
            {
1984
                source => 'Aqbudget',
1985
                value  => {
1986
                    budget_code      => $code,
1987
                    budget_period_id => $active_period->{budget_period_id}
1988
                }
1989
            }
1990
        );
1991
    }
1992
1993
    # Add EDIFACT_SI authorized values for servicing instruction codes
1994
    for my $code ( [ 'BB', 'Barcode labelling' ], [ 'BI', 'Binding' ], [ 'BJ', 'Sleeving' ] ) {
1995
        $builder->build(
1996
            {
1997
                source => 'AuthorisedValue',
1998
                value  => {
1999
                    category         => 'EDIFACT_SI',
2000
                    authorised_value => $code->[0],
2001
                    lib              => $code->[1]
2002
                }
2003
            }
2004
        );
2005
    }
2006
2007
    my $filename = 'QUOTES_SERVICING.CEQ';
2008
    ok( -e $dirname . $filename, 'File QUOTES_SERVICING.CEQ found' );
2009
2010
    my $trans = Koha::Edifact::Transport->new( $account->{id} );
2011
    $trans->working_directory($dirname);
2012
2013
    my $mhash = $trans->message_hash();
2014
    $mhash->{message_type} = 'QUOTE';
2015
    $trans->ingest( $mhash, $filename );
2016
2017
    my $quote = $schema->resultset('EdifactMessage')->find( { filename => $filename } );
2018
    ok( $quote, 'Quote message created' );
2019
2020
    t::lib::Mocks::mock_preference( 'AcqCreateItem', 'ordering' );
2021
2022
    # Process quote
2023
    my $die;
2024
    eval {
2025
        process_quote($quote);
2026
        1;
2027
    } or do {
2028
        $die = $@;
2029
    };
2030
    ok( !$die, 'Quote with servicing instructions processed without dying' );
2031
2032
    # Get the basket
2033
    my $baskets = Koha::Acquisition::Baskets->search( { booksellerid => $account->{vendor_id} } );
2034
    is( $baskets->count, 1, 'One basket created' );
2035
2036
    my $basket = $baskets->next;
2037
    my $orders = $basket->orders->search( {}, { order_by => 'ordernumber' } );
2038
    is( $orders->count, 4, 'Four order lines created (1 + 2 + 1)' );
2039
2040
    # Test Case 1: First order - both LVC (BB) and LVT in same group
2041
    my $order1 = $orders->next;
2042
    ok( $order1->servicing_instruction, 'First order has servicing_instruction' );
2043
2044
    my $si1 = decode_json( $order1->servicing_instruction );
2045
    is( ref($si1),    'ARRAY', 'servicing_instruction is an array' );
2046
    is( scalar @$si1, 1,       'First order has 1 servicing instruction group' );
2047
2048
    my $group1 = $si1->[0];
2049
    is( ref($group1),    'ARRAY', 'First group is an array' );
2050
    is( scalar @$group1, 2,       'First group has 2 instructions (LVC + LVT)' );
2051
2052
    # Find LVC and LVT entries
2053
    my ($lvc1) = grep { $_->{type} eq 'LVC' } @$group1;
2054
    my ($lvt1) = grep { $_->{type} eq 'LVT' } @$group1;
2055
2056
    ok( $lvc1, 'First order has LVC instruction' );
2057
    is( $lvc1->{value}, 'BB', 'LVC value is BB (Barcode labelling)' );
2058
2059
    ok( $lvt1, 'First order has LVT instruction' );
2060
    is( $lvt1->{value}, 'Spine label required', 'LVT value is correct freetext' );
2061
2062
    # Test Case 2: Second order - only LVC (BI)
2063
    my $order2 = $orders->next;
2064
    ok( $order2->servicing_instruction, 'Second order has servicing_instruction' );
2065
2066
    my $si2 = decode_json( $order2->servicing_instruction );
2067
    is( scalar @$si2, 1, 'Second order has 1 servicing instruction group' );
2068
2069
    my $group2 = $si2->[0];
2070
    is( scalar @$group2, 1, 'Second group has 1 instruction (LVC only)' );
2071
2072
    is( $group2->[0]->{type},  'LVC', 'Second order has LVC type' );
2073
    is( $group2->[0]->{value}, 'BI',  'LVC value is BI (Binding)' );
2074
2075
    # Test Case 3: Third order - LVC (BJ) and LVT in same group
2076
    my $order3 = $orders->next;
2077
    ok( $order3->servicing_instruction, 'Third order has servicing_instruction' );
2078
2079
    my $si3 = decode_json( $order3->servicing_instruction );
2080
    is( scalar @$si3, 1, 'Third order has 1 servicing instruction group' );
2081
2082
    my $group3 = $si3->[0];
2083
    is( scalar @$group3, 2, 'Third group has 2 instructions (LVC + LVT)' );
2084
2085
    my ($lvc3) = grep { $_->{type} eq 'LVC' } @$group3;
2086
    my ($lvt3) = grep { $_->{type} eq 'LVT' } @$group3;
2087
2088
    is( $lvc3->{value}, 'BJ',               'Third order LVC is BJ (Sleeving)' );
2089
    is( $lvt3->{value}, 'Handle with care', 'Third order LVT has correct text' );
2090
2091
    # Test Case 4: Fourth order - only LVT
2092
    my $order4 = $orders->next;
2093
    ok( $order4->servicing_instruction, 'Fourth order has servicing_instruction' );
2094
2095
    my $si4 = decode_json( $order4->servicing_instruction );
2096
    is( scalar @$si4, 1, 'Fourth order has 1 servicing instruction group' );
2097
2098
    my $group4 = $si4->[0];
2099
    is( scalar @$group4, 1, 'Fourth group has 1 instruction (LVT only)' );
2100
2101
    is( $group4->[0]->{type},  'LVT',                      'Fourth order has LVT type' );
2102
    is( $group4->[0]->{value}, 'Rush processing required', 'Fourth order LVT has correct text' );
2103
2104
    $schema->storage->txn_rollback;
2105
};
(-)a/t/edi_testfiles/QUOTES_SERVICING.CEQ (-1 / +1 lines)
Line 0 Link Here
0
- 
1
UNA:+.? 'UNB+UNOC:3+5013546027173+5013546098818+240123:0945+1044417+ASKEDI:+QUOTES++++'UNH+1044417001+QUOTES:D:96A:UN:EAN002'BGM+31C::28+WO0800132+9'DTM+137:20240123:102'RFF+ON:orders 24/1'CUX+2:GBP:12'NAD+BY+5013546098818::9'NAD+SU+5013546027173::9'LIN+1++9781234567890:EN'PIA+5+1234567890:IB'IMD+L+010+:::Smith'IMD+L+011+:::John'IMD+L+050+:::Test Book with Servicing'IMD+L+060+:::test description'IMD+L+120+:::Test Publisher'IMD+L+170+:::2024'IMD+L+180+:::200'IMD+L+220+:::Hbk'IMD+L+230+:::123.45'IMD+L+250+:::AN'QTY+1:1'GIR+001+BOOK:LST+ANF:LSQ+CPL:LLO+REF:LFN+123.45:LCL'GIR+001+BB:LVC+Spine label required:LVT'GIR+001+15.00:LCV'PRI+AAE:15.00'RFF+QLI:WO0800132000001'LIN+2++9781234567891:EN'PIA+5+1234567891:IB'IMD+L+010+:::Jones'IMD+L+011+:::Sarah'IMD+L+050+:::Another Test Book'IMD+L+060+:::second test'IMD+L+120+:::Another Publisher'IMD+L+170+:::2024'IMD+L+180+:::150'IMD+L+220+:::Pbk'IMD+L+230+:::456.78'IMD+L+250+:::AN'QTY+1:2'GIR+001+BOOK:LST+FIC:LSQ+MPL:LLO+LOAN:LFN+456.78:LCL'GIR+001+BI:LVC'GIR+001+20.00:LCV'GIR+002+BOOK:LST+FIC:LSQ+CPL:LLO+REF:LFN+456.78:LCL'GIR+002+BJ:LVC+Handle with care:LVT'GIR+002+20.00:LCV'PRI+AAE:20.00'RFF+QLI:WO0800132000002'LIN+3++9781234567892:EN'PIA+5+1234567892:IB'IMD+L+010+:::Brown'IMD+L+011+:::Emily'IMD+L+050+:::Third Test Book'IMD+L+060+:::third test'IMD+L+120+:::Third Publisher'IMD+L+170+:::2024'IMD+L+180+:::180'IMD+L+220+:::Hbk'IMD+L+230+:::789.00'IMD+L+250+:::AN'QTY+1:1'GIR+001+BOOK:LST+REF:LSQ+FPL:LLO+LOAN:LFN+789.00:LCL'GIR+001+Rush processing required:LVT'GIR+001+25.00:LCV'PRI+AAE:25.00'RFF+QLI:WO0800132000003'UNS+S'CNT+2:3'UNT+58+1044417001'UNZ+1+1044417'

Return to bug 30144