package Koha::EDI;

# Copyright 2014,2015 PTFS-Europe Ltd
#
# This file is part of Koha.
#
# Koha is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 3 of the License, or
# (at your option) any later version.
#
# Koha is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with Koha; if not, see <https://www.gnu.org/licenses>.

use Modern::Perl;
use base qw(Exporter);

BEGIN {
    our @EXPORT_OK = qw(
        process_quote
        process_invoice
        process_ordrsp
        create_edi_order
        get_edifact_ean
    );
}

use utf8;
use English qw{ -no_match_vars };
use Business::ISBN;
use DateTime;
use C4::Context;
use Koha::Database;
use Koha::DateUtils qw( dt_from_string );
use C4::Acquisition qw( ModOrder NewBasket );
use C4::Suggestions qw( ModSuggestion );
use C4::Biblio      qw(
    AddBiblio
    GetFrameworkCode
    GetMarcFromKohaField
    TransformKohaToMarc
);
use Koha::Edifact::Order;
use Koha::Edifact;
use C4::Log         qw( logaction );
use Text::Unidecode qw( unidecode );
use Koha::Logger;
use Koha::Plugins;    # Adds plugin dirs to @INC
use Koha::Plugins::Handler;
use Koha::Acquisition::Baskets;
use Koha::Acquisition::Booksellers;
use Koha::Util::FrameworkPlugin qw( biblio_008 );

our $VERSION = 1.1;

sub create_edi_order {
    my $parameters = shift;
    my $basketno   = $parameters->{basketno};
    my $ean        = $parameters->{ean};
    my $branchcode = $parameters->{branchcode};
    my $noingest   = $parameters->{noingest};
    my $logger     = Koha::Logger->get( { interface => 'edi' } );

    if ( !$basketno || !$ean ) {
        $logger->error('create_edi_order called with no basketno or ean');
        return;
    }

    my $schema = Koha::Database->new()->schema();

    my @orderlines = $schema->resultset('Aqorder')->search(
        {
            basketno    => $basketno,
            orderstatus => 'new',
        }
    )->all;

    if ( !@orderlines ) {
        $logger->warn("No orderlines for basket $basketno");
        return;
    }

    my $vendor = $schema->resultset('VendorEdiAccount')->search(
        {
            vendor_id => $orderlines[0]->basketno->booksellerid->id,
        }
    )->single;

    # Check for duplicate PO numbers when po_is_basketname is enabled
    if ( $vendor && $vendor->po_is_basketname ) {
        my $basket = $orderlines[0]->basketno;
        if ( $basket->basketname ) {
            my $existing_basket = $schema->resultset('Aqbasket')->search(
                {
                    basketname   => $basket->basketname,
                    booksellerid => $basket->booksellerid,
                    basketno     => { '!=' => $basketno },    # Exclude current basket
                }
            )->first;

            if ($existing_basket) {
                $logger->error( "EDI order blocked for basket $basketno due to duplicate PO number '"
                        . $basket->basketname
                        . "' (existing basket: "
                        . $existing_basket->basketno
                        . ")" );
                return {
                    error     => "duplicate_po_number", existing_basket => $existing_basket->basketno,
                    po_number => $basket->basketname
                };
            }
        }
    }

    my $ean_search_keys = { ean => $ean, };
    if ($branchcode) {
        $ean_search_keys->{branchcode} = $branchcode;
    }
    my $ean_obj = $schema->resultset('EdifactEan')->search($ean_search_keys)->single;

    # If no branch specific each can be found, look for a default ean
    unless ($ean_obj) {
        $ean_obj = $schema->resultset('EdifactEan')->search(
            {
                ean        => $ean,
                branchcode => undef,
            }
        )->single;
    }

    unless ($ean_obj) {
        $logger->warn("No matching EAN found for $ean");
        return;
    }

    my $dbh     = C4::Context->dbh;
    my $arr_ref = $dbh->selectcol_arrayref(
        'select id from edifact_messages where basketno = ? and message_type = \'QUOTE\'',
        {}, $basketno
    );
    my $response = @{$arr_ref} ? 1 : 0;

    my $edifact_order_params = {
        orderlines  => \@orderlines,
        vendor      => $vendor,
        ean         => $ean_obj,
        is_response => $response,
    };

    my $edifact;
    if ( $vendor->plugin ) {
        $edifact = Koha::Plugins::Handler->run(
            {
                class  => $vendor->plugin,
                method => 'edifact_order',
                params => {
                    params => $edifact_order_params,
                }
            }
        );
    } else {
        $edifact = Koha::Edifact::Order->new($edifact_order_params);
    }

    return unless $edifact;

    my $order_file = $edifact->encode();

    # ingest result
    if ($order_file) {
        my $m = unidecode($order_file);    # remove diacritics and non-latin chars
        if ($noingest) {                   # allows scripts to produce test files
            return $m;
        }
        my $order = {
            message_type  => 'ORDERS',
            raw_msg       => $m,
            vendor_id     => $vendor->vendor_id,
            status        => 'Pending',
            basketno      => $basketno,
            filename      => $edifact->filename(),
            transfer_date => $edifact->msg_date_string(),
            edi_acct      => $vendor->id,

        };
        $schema->resultset('EdifactMessage')->create($order);
        return 1;
    }

    return;
}

sub process_ordrsp {
    my $response_message = shift;
    $response_message->status('processing');
    $response_message->update;
    my $schema = Koha::Database->new()->schema();
    my $logger = Koha::Logger->get( { interface => 'edi' } );
    my $vendor_acct;
    my $edi      = Koha::Edifact->new( { transmission => $response_message->raw_msg, } );
    my $messages = $edi->message_array();

    if ( @{$messages} ) {
        foreach my $msg ( @{$messages} ) {
            my $lines = $msg->lineitems();
            foreach my $line ( @{$lines} ) {
                my $ordernumber = $line->ordernumber();

                # action cancelled:change_requested:no_action:accepted:not_found:recorded
                my $action = $line->action_notification();
                if ( $action eq 'cancelled' ) {
                    my $reason = $line->coded_orderline_text();
                    ModOrder(
                        {
                            ordernumber             => $ordernumber,
                            cancellationreason      => $reason,
                            orderstatus             => 'cancelled',
                            datecancellationprinted => dt_from_string()->ymd(),
                        }
                    );
                } else {    # record order as due with possible further info

                    my $report     = $line->coded_orderline_text();
                    my $date_avail = $line->availability_date();
                    $report ||= q{};
                    if ($date_avail) {
                        $report .= " Available: $date_avail";
                    }
                    ModOrder(
                        {
                            ordernumber      => $ordernumber,
                            suppliers_report => $report,
                        }
                    );
                }
            }
        }
    }

    $response_message->status('received');
    $response_message->update;
    return;
}

sub process_invoice {
    my $invoice_message = shift;
    $invoice_message->status('processing');
    $invoice_message->update;
    my $schema = Koha::Database->new()->schema();
    my $logger = Koha::Logger->get( { interface => 'edi' } );
    my $vendor_acct;

    my $plugin_class = $invoice_message->edi_acct()->plugin();

    # Plugin has its own invoice processor, only run it and not the standard invoice processor below
    if ($plugin_class) {
        eval "require $plugin_class"
            ;    # Import the class, eval is needed because requiring a string doesn't work like requiring a bareword
        my $plugin = $plugin_class->new();
        if ( $plugin->can('edifact_process_invoice') ) {
            Koha::Plugins::Handler->run(
                {
                    class  => $plugin_class,
                    method => 'edifact_process_invoice',
                    params => {
                        invoice => $invoice_message,
                    }
                }
            );
            return;
        }
    }

    my $edi_plugin;
    if ($plugin_class) {
        $edi_plugin = Koha::Plugins::Handler->run(
            {
                class  => $plugin_class,
                method => 'edifact',
                params => {
                    invoice_message => $invoice_message,
                    transmission    => $invoice_message->raw_msg,
                }
            }
        );
    }

    my $edi = $edi_plugin
        || Koha::Edifact->new( { transmission => $invoice_message->raw_msg, } );

    my $messages = $edi->message_array();

    if ( @{$messages} ) {

        # BGM contains an invoice number
        foreach my $msg ( @{$messages} ) {
            my $invoicenumber  = $msg->docmsg_number();
            my $shipmentcharge = $msg->shipment_charge();
            my $msg_date       = $msg->message_date;
            my $tax_date       = $msg->tax_point_date;
            if ( !defined $tax_date || $tax_date !~ m/^\d{8}/xms ) {
                $tax_date = $msg_date;
            }

            my $vendor_ean = $msg->supplier_ean;
            if ( !defined $vendor_acct || $vendor_ean ne $vendor_acct->san ) {
                $vendor_acct = $schema->resultset('VendorEdiAccount')->search(
                    {
                        san => $vendor_ean,
                    }
                )->single;
            }
            if ( !$vendor_acct ) {
                $invoice_message->add_to_edifact_errors(
                    {
                        section => "NAD+SU+" . $msg->supplier_ean,
                        details => "Skipped invoice $invoicenumber with unmatched vendor san: $vendor_ean"
                    }
                );
                $logger->error( "Cannot find vendor with ean $vendor_ean for invoice $invoicenumber in "
                        . $invoice_message->filename );
                next;
            }
            $invoice_message->edi_acct( $vendor_acct->id );
            $logger->trace("Adding invoice: $invoicenumber");
            my $new_invoice = $schema->resultset('Aqinvoice')->create(
                {
                    invoicenumber         => $invoicenumber,
                    booksellerid          => $invoice_message->vendor_id,
                    shipmentdate          => $msg_date,
                    billingdate           => $tax_date,
                    shipmentcost          => $shipmentcharge,
                    shipmentcost_budgetid => $vendor_acct->shipment_budget,
                    message_id            => $invoice_message->id,
                }
            );
            my $invoiceid = $new_invoice->invoiceid;
            $logger->trace("Added as invoiceno: $invoiceid");
            my $lines = $msg->lineitems();

            foreach my $line ( @{$lines} ) {
                my $ordernumber = $line->ordernumber;
                if ( !$ordernumber ) {
                    $invoice_message->add_to_edifact_errors(
                        {
                            section => join( "\n", map { $_->as_string } @{ $line->{segs} } ),
                            details => "Skipped invoice line " . $line->line_item_number . ", missing ordernumber"
                        }
                    );
                    $logger->error("Skipping invoice line, no associated ordernumber");
                    next;
                }

                # ModReceiveOrder does not validate that $ordernumber exists validate here
                my $order = $schema->resultset('Aqorder')->find($ordernumber);
                if ( !$order ) {
                    $invoice_message->add_to_edifact_errors(
                        {
                            section => join( "\n", map { $_->as_string } @{ $line->{segs} } ),
                            details => "Skipped invoice line "
                                . $line->line_item_number
                                . ", cannot find order with ordernumber "
                                . $ordernumber
                        }
                    );
                    $logger->error("Skipping invoice line, no order found for $ordernumber, invoice:$invoicenumber");
                    next;
                }

                my $bib = $order->biblionumber;
                if ( !$bib ) {
                    $invoice_message->add_to_edifact_errors(
                        {
                            section => join( "\n", map { $_->as_string } @{ $line->{segs} } ),
                            details => "Skipped invoice line "
                                . $line->line_item_number
                                . ", cannot find biblio for ordernumber "
                                . $ordernumber
                        }
                    );
                    $logger->error(
                        "Skipping invoice line, no bibliographic record found for $ordernumber, invoice:$invoicenumber"
                    );
                    next;
                }

                $logger->trace( "Receipting order:$ordernumber Qty: " . $line->quantity );
                $logger->trace( "Updating bib:" . $bib->biblionumber . " id:" . $line->item_number_id );

                # check suggestions
                my $s = $schema->resultset('Suggestion')->search(
                    {
                        biblionumber => $bib->biblionumber,
                    }
                )->single;
                if ($s) {
                    ModSuggestion(
                        {
                            suggestionid => $s->suggestionid,
                            STATUS       => 'AVAILABLE',
                        }
                    );
                }

                # If quantity_invoiced is present use it in preference
                my $quantity = $line->quantity_invoiced;
                if ( !$quantity ) {
                    $quantity = $line->quantity;
                }

                my ( $price, $price_excl_tax ) = _get_invoiced_price( $line, $quantity );
                my $tax_rate = $line->tax_rate;
                if ( $tax_rate && $tax_rate->{rate} != 0 ) {
                    $tax_rate->{rate} /= 100;
                }

                if ( $order->quantity > $quantity ) {
                    my $ordered = $order->quantity;

                    # part receipt
                    $order->orderstatus('partial');
                    $order->quantity( $ordered - $quantity );
                    $order->update;
                    my $received_order = $order->copy(
                        {
                            ordernumber            => undef,
                            quantity               => $quantity,
                            quantityreceived       => $quantity,
                            orderstatus            => 'complete',
                            unitprice              => $price,
                            unitprice_tax_included => $price,
                            unitprice_tax_excluded => $price_excl_tax,
                            invoiceid              => $invoiceid,
                            datereceived           => $msg_date,
                            tax_rate_on_receiving  => $tax_rate ? $tax_rate->{rate} : 0,
                            tax_value_on_receiving => $quantity *
                                $price_excl_tax *
                                ( $tax_rate ? $tax_rate->{rate} : 0 ),
                        }
                    );
                    transfer_items( $schema, $line, $order, $received_order, $quantity );
                    receipt_items(
                        $schema, $line,
                        $received_order->ordernumber, $quantity, $invoice_message
                    );
                } else {    # simple receipt all copies on order
                    $order->quantityreceived($quantity);
                    $order->datereceived($msg_date);
                    $order->invoiceid($invoiceid);
                    $order->unitprice($price);
                    $order->unitprice_tax_excluded($price_excl_tax);
                    $order->unitprice_tax_included($price);
                    $order->tax_rate_on_receiving( $tax_rate ? $tax_rate->{rate} : 0 );
                    $order->tax_value_on_receiving(
                        $quantity * $price_excl_tax * ( $tax_rate ? $tax_rate->{rate} : 0 ) );
                    $order->orderstatus('complete');
                    $order->update;
                    receipt_items( $schema, $line, $ordernumber, $quantity, $invoice_message );
                }
            }
        }
    }

    $invoice_message->status('received');
    $invoice_message->update;    # status and basketno link
    return;
}

sub _get_invoiced_price {
    my $line       = shift;
    my $qty        = shift;
    my $line_total = $line->amt_total;
    my $excl_tax   = $line->amt_lineitem;

    # If no tax some suppliers omit the total owed
    # If no total given calculate from cost exclusive of tax
    # + tax amount (if present, sometimes omitted if 0 )
    if ( !defined $line_total ) {
        my $x = $line->amt_taxoncharge;
        if ( !defined $x ) {
            $x = 0;
        }
        $line_total = $excl_tax + $x;
    }

    # invoices give amounts per orderline, Koha requires that we store
    # them per item
    if ( $qty != 1 ) {
        return ( $line_total / $qty, $excl_tax / $qty );
    }
    return ( $line_total, $excl_tax );    # return as is for most common case
}

sub receipt_items {
    my ( $schema, $inv_line, $ordernumber, $quantity, $invoice_message ) = @_;
    my $logger = Koha::Logger->get( { interface => 'edi' } );

    # itemnumber is not a foreign key ??? makes this a bit cumbersome
    my @item_links = $schema->resultset('AqordersItem')->search(
        {
            ordernumber => $ordernumber,
        }
    );
    my %branch_map;
    foreach my $ilink (@item_links) {
        my $item = $schema->resultset('Item')->find( $ilink->itemnumber );
        if ( !$item ) {
            my $i = $ilink->itemnumber;
            $invoice_message->add_to_edifact_errors(
                {
                    section => join( "\n", map { $_->as_string } @{ $inv_line->{segs} } ),
                    details => "Skipped invoice line "
                        . $inv_line->line_item_number
                        . ", Koha item with itemnumber "
                        . $i
                        . "is missing"
                }
            );
            $logger->warn("Cannot find aqorder item for $i: Order: $ordernumber");
            next;
        }
        my $b = $item->get_column('homebranch');
        if ( !exists $branch_map{$b} ) {
            $branch_map{$b} = [];
        }
        push @{ $branch_map{$b} }, $item;
    }

    # Handling for 'AcqItemSetSubfieldsWhenReceived'
    my @affects;
    my $biblionumber;
    my $itemfield;
    if ( C4::Context->preference('AcqCreateItem') eq 'ordering' ) {
        @affects = split q{\|},
            C4::Context->preference("AcqItemSetSubfieldsWhenReceived");
        if (@affects) {
            my $order = Koha::Acquisition::Orders->find($ordernumber);
            $biblionumber = $order->biblionumber;
            my $frameworkcode = GetFrameworkCode($biblionumber);
            ($itemfield) = GetMarcFromKohaField('items.itemnumber');
        }
    }

    my $gir_occurrence = 0;
    while ( $gir_occurrence < $quantity ) {
        my $branch = $inv_line->girfield( 'branch', $gir_occurrence );
        my $item   = shift @{ $branch_map{$branch} };
        if ($item) {
            my $barcode = $inv_line->girfield( 'barcode', $gir_occurrence );
            if ( $barcode && !$item->barcode ) {
                my $rs = $schema->resultset('Item')->search(
                    {
                        barcode => $barcode,
                    }
                );
                if ( $rs->count > 0 ) {
                    $invoice_message->add_to_edifact_errors(
                        {
                            section => join( "\n", map { $_->as_string } @{ $inv_line->{segs} } ),
                            details => "Failed to assign barcode "
                                . $barcode
                                . "for invoice line "
                                . $inv_line->line_item_number
                                . ", duplicate found"
                        }
                    );
                    $logger->warn("Barcode $barcode is a duplicate");
                } else {

                    $logger->trace("Adding barcode $barcode");
                    $item->barcode($barcode);
                }
            }

            # Handling for 'AcqItemSetSubfieldsWhenReceived'
            if (@affects) {
                my $item_marc = C4::Items::GetMarcItem( $biblionumber, $item->itemnumber );
                for my $affect (@affects) {
                    my ( $sf, $v ) = split q{=}, $affect, 2;
                    foreach ( $item_marc->field($itemfield) ) {
                        $_->update( $sf => $v );
                    }
                }
                C4::Items::ModItemFromMarc( $item_marc, $biblionumber, $item->itemnumber );
            }

            $item->update;
        } else {
            $invoice_message->add_to_edifact_errors(
                {
                    section => join( "\n", map { $_->as_string } @{ $inv_line->{segs} } ),
                    details => "No matching item found for invoice line "
                        . $inv_line->line_item_number . ":"
                        . $gir_occurrence
                        . " at branch $branch"
                }
            );
            $logger->warn("Unmatched item at branch:$branch");
        }
        ++$gir_occurrence;
    }
    return;
}

sub transfer_items {
    my ( $schema, $inv_line, $order_from, $order_to, $quantity ) = @_;

    # Transfer x items from the orig order to a completed partial order
    my $gocc = 0;
    my %mapped_by_branch;
    while ( $gocc < $quantity ) {
        my $branch = $inv_line->girfield( 'branch', $gocc );
        if ( !exists $mapped_by_branch{$branch} ) {
            $mapped_by_branch{$branch} = 1;
        } else {
            $mapped_by_branch{$branch}++;
        }
        ++$gocc;
    }
    my $logger = Koha::Logger->get( { interface => 'edi' } );
    my $o1     = $order_from->ordernumber;
    my $o2     = $order_to->ordernumber;
    $logger->warn("transferring $quantity copies from order $o1 to order $o2");

    my @item_links = $schema->resultset('AqordersItem')->search(
        {
            ordernumber => $order_from->ordernumber,
        }
    );
    foreach my $ilink (@item_links) {
        my $ino      = $ilink->itemnumber;
        my $item     = $schema->resultset('Item')->find( $ilink->itemnumber );
        my $i_branch = $item->get_column('homebranch');
        if ( exists $mapped_by_branch{$i_branch}
            && $mapped_by_branch{$i_branch} > 0 )
        {
            $ilink->ordernumber( $order_to->ordernumber );
            $ilink->update;
            --$quantity;
            --$mapped_by_branch{$i_branch};
            $logger->warn( "Transferred item " . $item->itemnumber );
        } else {
            $logger->warn( "Skipped item " . $item->itemnumber );
        }
        if ( $quantity < 1 ) {
            last;
        }
    }

    return;
}

sub process_quote {
    my $quote_message = shift;

    $quote_message->status('processing');
    $quote_message->update;

    my $edi = Koha::Edifact->new( { transmission => $quote_message->raw_msg, } );

    my $messages       = $edi->message_array();
    my $process_errors = 0;
    my $logger         = Koha::Logger->get( { interface => 'edi' } );
    my $schema         = Koha::Database->new()->schema();
    my $message_count  = 0;
    my $split_message;
    my @added_baskets;                # if auto & multiple baskets need to order all
    my %baskets_with_po_conflicts;    # track baskets that have PO number conflicts

    # Get vendor EDI account configuration
    my $v = $schema->resultset('VendorEdiAccount')->search(
        {
            vendor_id => $quote_message->vendor_id,
        }
    )->single;

    if ( @{$messages} && $quote_message->vendor_id ) {

        foreach my $msg ( @{$messages} ) {
            ++$message_count;

            # Determine basket name based on vendor configuration
            my $basket_name = $quote_message->filename;
            my $purchase_order_number;
            my $existing_basket;

            if ( $v && $v->po_is_basketname ) {
                $purchase_order_number = $msg->purchase_order_number;
                if ($purchase_order_number) {
                    $basket_name = $purchase_order_number;

                    # Check for duplicate purchase order numbers for this vendor (including closed baskets)
                    $existing_basket = $schema->resultset('Aqbasket')->search(
                        {
                            basketname   => $basket_name,
                            booksellerid => $quote_message->vendor_id,
                        }
                    )->first;

                    if ($existing_basket) {

                        # Log error for duplicate purchase order number but continue processing
                        my $rff_segment = "RFF+ON:$purchase_order_number";
                        $quote_message->add_to_edifact_errors(
                            {
                                section => $rff_segment,
                                details => "Duplicate purchase order number '$purchase_order_number' found for vendor "
                                    . $quote_message->vendor_id . "."
                            }
                        );
                        $logger->warn( "Duplicate purchase order number '$purchase_order_number' for vendor "
                                . $quote_message->vendor_id
                                . " (existing basket: "
                                . $existing_basket->basketno
                                . ")" );
                    }
                }
            }

            my $basketno = NewBasket(
                $quote_message->vendor_id, 0, $basket_name, q{},
                q{} . q{}
            );
            push @added_baskets, $basketno;

            # Record if this basket has a PO conflict (for auto_orders blocking)
            if ($existing_basket) {
                $baskets_with_po_conflicts{$basketno} = {
                    po_number       => $purchase_order_number,
                    existing_basket => $existing_basket->basketno
                };
            }
            if ( $message_count > 1 ) {
                my $m_filename = $quote_message->filename;
                $m_filename .= "_$message_count";
                $split_message = $schema->resultset('EdifactMessage')->create(
                    {
                        message_type  => $quote_message->message_type,
                        transfer_date => $quote_message->transfer_date,
                        vendor_id     => $quote_message->vendor_id,
                        edi_acct      => $quote_message->edi_acct,
                        status        => 'recmsg',
                        basketno      => $basketno,
                        raw_msg       => q{},
                        filename      => $m_filename,
                    }
                );
            } else {
                $quote_message->basketno($basketno);
            }
            $logger->trace("Created basket: $basketno");
            my $items  = $msg->lineitems();
            my $refnum = $msg->message_refno;

            for my $item ( @{$items} ) {
                my $message = $split_message // $quote_message;
                if ( !quote_item( $item, $message, $basketno ) ) {
                    ++$process_errors;
                }
            }
        }
    }
    my $status = 'received';
    if ($process_errors) {
        $status = 'error';
    }

    $quote_message->status($status);
    $quote_message->update;    # status and basketno link
                               # Do we automatically generate orders for this vendor
    if ( $v && $v->auto_orders ) {
        for my $i ( 0 .. $#added_baskets ) {
            my $basketno = $added_baskets[$i];

            # Check if this basket has a PO number conflict
            if ( exists $baskets_with_po_conflicts{$basketno} ) {
                my $conflict_info = $baskets_with_po_conflicts{$basketno};
                $logger->warn( "Auto-order blocked for basket $basketno due to duplicate PO number '"
                        . $conflict_info->{po_number}
                        . "' (existing basket: "
                        . $conflict_info->{existing_basket}
                        . ")" );
                $logger->info("Basket $basketno remains open due to PO number conflict");
                next;
            }

            # Use the correct buyer_ean for each message/basket
            my $buyer_ean = $messages->[$i] ? $messages->[$i]->buyer_ean : $messages->[0]->buyer_ean;

            create_edi_order(
                {
                    ean      => $buyer_ean,
                    basketno => $basketno,
                }
            );
            Koha::Acquisition::Baskets->find($basketno)->close;

            # Log the approval
            if ( C4::Context->preference("AcquisitionLog") ) {
                my $approved = Koha::Acquisition::Baskets->find($basketno);
                logaction(
                    'ACQUISITIONS',
                    'APPROVE_BASKET',
                    $basketno,
                    to_json( $approved->unblessed )
                );
            }
        }
    }

    return;
}

sub quote_item {
    my ( $item, $quote_message, $basketno ) = @_;

    my $schema = Koha::Database->new()->schema();
    my $logger = Koha::Logger->get( { interface => 'edi' } );

    # $basketno is the return from AddBasket in the calling routine
    # So this call should not fail unless that has
    my $basket = Koha::Acquisition::Baskets->find($basketno);
    unless ($basket) {
        $quote_message->add_to_edifact_errors(
            {
                section => "",
                details => "Failed to create basket"
            }
        );
        $logger->error('Skipped order creation no valid basketno');
        return;
    }
    $logger->trace( 'Checking db for matches with ' . $item->item_number_id() );
    my $bib = _check_for_existing_bib( $item->item_number_id() );
    if ( !defined $bib ) {
        $bib = {};
        my $bib_record = _create_bib_from_quote( $item, $quote_message );

        # Check for and add default 008 as this is a mandatory field
        $bib_record = _handle_008_field($bib_record);

        ( $bib->{biblionumber}, $bib->{biblioitemnumber} ) =
            AddBiblio( $bib_record, q{} );
        $logger->trace( "Added biblio: " . $bib->{biblionumber} );
    } else {
        $logger->trace( "Match found: " . $bib->{biblionumber} );
    }

    # Create an orderline
    my $order_note = $item->{orderline_free_text};
    $order_note ||= q{};
    my $order_quantity = $item->quantity();
    my $gir_count      = $item->number_of_girs();
    $order_quantity ||= 1;    # quantity not necessarily present
    if ( $gir_count > 1 ) {
        if ( $gir_count != $order_quantity ) {
            $quote_message->add_to_edifact_errors(
                {
                    section => join( '\n', @{ $item->{GIR} } ),
                    details => "Order for $order_quantity items, $gir_count segments present"
                }
            );
            $logger->error("Order for $order_quantity items, $gir_count segments present");
        }
        $order_quantity = 1;    # attempts to create an orderline for each gir
    }
    my $price = $item->price_info;

    # Howells do not send an info price but do have a gross price
    if ( !$price ) {
        $price = $item->price_gross;
    }
    my $vendor = Koha::Acquisition::Booksellers->find( $quote_message->vendor_id );

    # NB quote will not include tax info it only contains the list price
    my $ecost = _discounted_price( $vendor->discount, $price, $item->price_info_inclusive );

    # database definitions should set some of these defaults but dont
    my $order_hash = {
        biblionumber       => $bib->{biblionumber},
        entrydate          => dt_from_string()->ymd(),
        basketno           => $basketno,
        listprice          => $price,
        quantity           => $order_quantity,
        quantityreceived   => 0,
        order_vendornote   => q{},
        order_internalnote => q{},
        replacementprice   => $price,
        rrp_tax_included   => $price,
        rrp_tax_excluded   => $price,
        rrp                => $price,
        ecost              => $ecost,
        ecost_tax_included => $ecost,
        ecost_tax_excluded => $ecost,
        uncertainprice     => 0,
        sort1              => q{},
        sort2              => q{},
        currency           => $vendor->listprice(),
    };

    # suppliers references
    if ( $item->reference() ) {
        $order_hash->{suppliers_reference_number}    = $item->reference;
        $order_hash->{suppliers_reference_qualifier} = 'QLI';
    } elsif ( $item->orderline_reference_number() ) {
        $order_hash->{suppliers_reference_number}    = $item->orderline_reference_number;
        $order_hash->{suppliers_reference_qualifier} = 'SLI';
    }
    if ( $item->item_number_id ) {    # suppliers ean
        $order_hash->{line_item_id} = $item->item_number_id;
    }

    if ( $item->girfield('servicing_instruction') ) {
        my $occ = 0;
        my $txt = q{};
        my $si;
        while ( $si = $item->girfield( 'servicing_instruction', $occ ) ) {
            if ($occ) {
                $txt .= q{: };
            }
            $txt .= $si;
            ++$occ;
        }
    }
    if ($order_note) {
        $order_hash->{order_vendornote} = $order_note;
    }

    if ( $item->internal_notes() ) {
        if ( $order_hash->{order_internalnote} ) {    # more than ''
            $order_hash->{order_internalnote} .= q{ };
        }
        $order_hash->{order_internalnote} .= $item->internal_notes;
    }

    my $budget = _get_budget( $schema, $item->girfield('fund_allocation') );

    my $skip = '0';
    if ( !$budget ) {
        if ( $item->quantity > 1 ) {
            $quote_message->add_to_edifact_errors(
                {
                    section => join( '\n', @{ $item->{GIR} } ),
                    details => "Skipped GIR line with invalid budget: " . $item->girfield('fund_allocation')
                }
            );
            $logger->trace( 'Skipping item with invalid budget: ' . $item->girfield('fund_allocation') );
            $skip++;
        } else {
            $quote_message->add_to_edifact_errors(
                {
                    section => join( "\n", map { $_->as_string } @{ $item->{segs} } ),
                    details => "Skipped orderline line with invalid budget: " . $item->girfield('fund_allocation')
                }
            );
            $logger->trace( 'Skipping orderline with invalid budget: ' . $item->girfield('fund_allocation') );
            return;
        }
    }

    my %ordernumber;
    my %budgets;
    my $item_hash;

    if ( !$skip ) {
        $order_hash->{budget_id} = $budget->budget_id;
        my $first_order = $schema->resultset('Aqorder')->create($order_hash);
        my $o           = $first_order->ordernumber();
        $logger->trace("Order created: $o");

        # should be done by database settings
        $first_order->parent_ordernumber( $first_order->ordernumber() );
        $first_order->update();

        # add to $budgets to prevent duplicate orderlines
        $budgets{ $budget->budget_id } = '1';

        # record ordernumber against budget
        $ordernumber{ $budget->budget_id } = $o;

        if ( C4::Context->preference('AcqCreateItem') eq 'ordering' ) {
            $item_hash = _create_item_from_quote( $item, $quote_message );

            my $created = 0;
            while ( $created < $order_quantity ) {
                $item_hash->{biblionumber}     = $bib->{biblionumber};
                $item_hash->{biblioitemnumber} = $bib->{biblioitemnumber};
                my $kitem      = Koha::Item->new($item_hash)->store;
                my $itemnumber = $kitem->itemnumber;
                $logger->trace( "Added item: " . $itemnumber );
                $schema->resultset('AqordersItem')->create(
                    {
                        ordernumber => $first_order->ordernumber,
                        itemnumber  => $itemnumber,
                    }
                );
                ++$created;

                my $lrp = $item->girfield('library_rotation_plan');
                if ($lrp) {
                    my $rota = Koha::StockRotationRotas->find(
                        { title => $lrp },
                        { key   => 'stockrotationrotas_title' }
                    );
                    if ($rota) {
                        $rota->add_item($itemnumber);
                        $logger->trace( "Item added to rota " . $rota->title );
                    } else {
                        $quote_message->add_to_edifact_errors(
                            {
                                section => "$item->{GIR}->[0]",
                                details => "No rota found for passed LRP:$lrp in orderline"
                            }
                        );
                        $logger->error("No rota found matching $lrp in orderline");
                    }
                }
            }
        }
    }

    if ( $order_quantity == 1 && $item->quantity > 1 ) {
        my $occurrence = 1;    # occ zero already added
        while ( $occurrence < $item->quantity ) {

            # check budget code
            $budget = _get_budget(
                $schema,
                $item->girfield( 'fund_allocation', $occurrence )
            );

            if ( !$budget ) {
                my $bad_budget = $item->girfield( 'fund_allocation', $occurrence );
                $quote_message->add_to_edifact_errors(
                    {
                        section => "$item->{GIR}->[$occurrence]",
                        details => "Invalid budget $bad_budget found"
                    }
                );
                $logger->trace( "Skipping item with invalid budget: " . $bad_budget );
                ++$occurrence;    ## lets look at the next one not this one again
                next;
            }

            # add orderline for NEW budget in $budgets
            if ( !exists $budgets{ $budget->budget_id } ) {

                # $order_hash->{quantity} = 1; by default above
                # we should handle both 1:1 GIR & 1:n GIR (with LQT values) here

                $order_hash->{budget_id} = $budget->budget_id;

                my $new_order = $schema->resultset('Aqorder')->create($order_hash);
                my $o         = $new_order->ordernumber();
                $logger->trace("Order created: $o");

                # should be done by database settings
                $new_order->parent_ordernumber( $new_order->ordernumber() );
                $new_order->update();

                # add to $budgets to prevent duplicate orderlines
                $budgets{ $budget->budget_id } = '1';

                # record ordernumber against budget
                $ordernumber{ $budget->budget_id } = $o;

                if ( C4::Context->preference('AcqCreateItem') eq 'ordering' ) {
                    if ( !defined $item_hash ) {
                        $item_hash = _create_item_from_quote( $item, $quote_message );
                    }
                    my $new_item = {
                        itype          => $item->girfield( 'stock_category', $occurrence ),
                        itemcallnumber => $item->girfield( 'shelfmark',      $occurrence )
                            || $item->girfield( 'classification', $occurrence )
                            || title_level_class($item),
                        holdingbranch => $item->girfield( 'branch', $occurrence ),
                        homebranch    => $item->girfield( 'branch', $occurrence ),
                    };

                    my $lsq_field = C4::Context->preference('EdifactLSQ');
                    $new_item->{$lsq_field} = $item->girfield( 'sequence_code', $occurrence );

                    if ( $new_item->{itype} ) {
                        $item_hash->{itype} = $new_item->{itype};
                    }
                    if ( $new_item->{$lsq_field} ) {
                        $item_hash->{$lsq_field} = $new_item->{$lsq_field};
                    }
                    if ( $new_item->{itemcallnumber} ) {
                        $item_hash->{itemcallnumber} = $new_item->{itemcallnumber};
                    }
                    if ( $new_item->{holdingbranch} ) {
                        $item_hash->{holdingbranch} = $new_item->{holdingbranch};
                    }
                    if ( $new_item->{homebranch} ) {
                        $item_hash->{homebranch} = $new_item->{homebranch};
                    }

                    $item_hash->{biblionumber}     = $bib->{biblionumber};
                    $item_hash->{biblioitemnumber} = $bib->{biblioitemnumber};
                    my $kitem      = Koha::Item->new($item_hash)->store;
                    my $itemnumber = $kitem->itemnumber;
                    $logger->trace("New item $itemnumber added");
                    $schema->resultset('AqordersItem')->create(
                        {
                            ordernumber => $new_order->ordernumber,
                            itemnumber  => $itemnumber,
                        }
                    );

                    my $lrp = $item->girfield( 'library_rotation_plan', $occurrence );
                    if ($lrp) {
                        my $rota = Koha::StockRotationRotas->find(
                            { title => $lrp },
                            { key   => 'stockrotationrotas_title' }
                        );
                        if ($rota) {
                            $rota->add_item($itemnumber);
                            $logger->trace( "Item added to rota " . $rota->id );
                        } else {
                            $quote_message->add_to_edifact_errors(
                                {
                                    section => "$item->{GIR}->[$occurrence]",
                                    details => "No rota found for passed LRP:$lrp in orderline"
                                }
                            );
                            $logger->error("No rota found matching $lrp in orderline");
                        }
                    }
                }

                ++$occurrence;
            }

            # increment quantity in orderline for EXISTING budget in $budgets
            else {
                my $row = $schema->resultset('Aqorder')->find( { ordernumber => $ordernumber{ $budget->budget_id } } );
                if ($row) {
                    my $qty = $row->quantity;
                    $qty++;
                    $row->update(
                        {
                            quantity => $qty,
                        }
                    );
                }

                # Do not use the basket level value as it is always NULL
                # See calling subs call to AddBasket
                if ( C4::Context->preference('AcqCreateItem') eq 'ordering' ) {
                    my $new_item = {
                        notforloan       => -1,
                        cn_sort          => q{},
                        cn_source        => 'ddc',
                        price            => $price,
                        replacementprice => $price,
                        itype            => $item->girfield( 'stock_category', $occurrence ),
                        itemcallnumber   => $item->girfield( 'shelfmark',      $occurrence )
                            || $item->girfield( 'classification', $occurrence )
                            || $item_hash->{itemcallnumber},
                        holdingbranch => $item->girfield( 'branch', $occurrence ),
                        homebranch    => $item->girfield( 'branch', $occurrence ),
                    };
                    my $lsq_field = C4::Context->preference('EdifactLSQ');
                    $new_item->{$lsq_field}       = $item->girfield( 'sequence_code', $occurrence );
                    $new_item->{biblionumber}     = $bib->{biblionumber};
                    $new_item->{biblioitemnumber} = $bib->{biblioitemnumber};
                    my $kitem      = Koha::Item->new($new_item)->store;
                    my $itemnumber = $kitem->itemnumber;
                    $logger->trace("New item $itemnumber added");
                    $schema->resultset('AqordersItem')->create(
                        {
                            ordernumber => $ordernumber{ $budget->budget_id },
                            itemnumber  => $itemnumber,
                        }
                    );

                    my $lrp = $item->girfield( 'library_rotation_plan', $occurrence );
                    if ($lrp) {
                        my $rota = Koha::StockRotationRotas->find(
                            { title => $lrp },
                            { key   => 'stockrotationrotas_title' }
                        );
                        if ($rota) {
                            $rota->add_item($itemnumber);
                            $logger->trace("Item added to rota $rota->id");
                        } else {
                            $quote_message->add_to_edifact_errors(
                                {
                                    section => "$item->{GIR}->[$occurrence]",
                                    details => "No rota found for passed LRP:$lrp in orderline"
                                }
                            );
                            $logger->error("No rota found matching $lrp in orderline");
                        }
                    }
                }

                ++$occurrence;
            }
        }
    }
    return 1;
}

sub get_edifact_ean {

    my $dbh = C4::Context->dbh;

    my $eans = $dbh->selectcol_arrayref('select ean from edifact_ean');

    return $eans->[0];
}

# We should not need to have a routine to do this here
sub _discounted_price {
    my ( $discount, $price, $discounted_price ) = @_;
    if ( defined $discounted_price ) {
        return $discounted_price;
    }
    if ( !$price ) {
        return 0;
    }
    return $price - ( ( $discount * $price ) / 100 );
}

sub _check_for_existing_bib {
    my $isbn = shift;

    my $search_isbn = $isbn;
    $search_isbn =~ s/^\s*/%/xms;
    $search_isbn =~ s/\s*$/%/xms;
    my $dbh = C4::Context->dbh;
    my $sth = $dbh->prepare(
        'select biblionumber, biblioitemnumber from biblioitems where isbn like ?',
    );
    my $tuple_arr =
        $dbh->selectall_arrayref( $sth, { Slice => {} }, $search_isbn );

    if ( @{$tuple_arr} ) {
        return $tuple_arr->[0];
    } elsif ( length($isbn) == 13 && $isbn !~ /^97[89]/ ) {
        my $tarr = $dbh->selectall_arrayref(
            'select biblionumber, biblioitemnumber from biblioitems where ean = ?',
            { Slice => {} },
            $isbn
        );
        if ( @{$tarr} ) {
            return $tarr->[0];
        }
    } else {
        undef $search_isbn;
        $isbn =~ s/\-//xmsg;
        if ( $isbn =~ m/(\d{13})/xms ) {
            my $b_isbn = Business::ISBN->new($1);
            if ( $b_isbn && $b_isbn->is_valid && $b_isbn->as_isbn10 ) {
                $search_isbn = $b_isbn->as_isbn10->as_string( [] );
            }

        } elsif ( $isbn =~ m/(\d{9}[xX]|\d{10})/xms ) {
            my $b_isbn = Business::ISBN->new($1);
            if ( $b_isbn && $b_isbn->is_valid ) {
                $search_isbn = $b_isbn->as_isbn13->as_string( [] );
            }

        }
        if ($search_isbn) {
            $search_isbn = "%$search_isbn%";
            $tuple_arr =
                $dbh->selectall_arrayref( $sth, { Slice => {} }, $search_isbn );
            if ( @{$tuple_arr} ) {
                return $tuple_arr->[0];
            }
        }
    }
    return;
}

# returns a budget obj or undef
# fact we need this shows what a mess Acq API is
sub _get_budget {
    my ( $schema, $budget_code ) = @_;
    my $period_rs = $schema->resultset('Aqbudgetperiod')->search(
        {
            budget_period_active => 1,
        }
    );

    # db does not ensure budget code is unique
    return $schema->resultset('Aqbudget')->single(
        {
            budget_code      => $budget_code,
            budget_period_id => { -in => $period_rs->get_column('budget_period_id')->as_query },
        }
    );
}

# try to get title level classification from incoming quote
sub title_level_class {
    my ($item)         = @_;
    my $class          = q{};
    my $default_scheme = C4::Context->preference('DefaultClassificationSource');
    if ( $default_scheme eq 'ddc' ) {
        $class = $item->dewey_class();
    } elsif ( $default_scheme eq 'lcc' ) {
        $class = $item->lc_class();
    }
    if ( !$class ) {
        $class =
               $item->girfield('shelfmark')
            || $item->girfield('classification')
            || q{};
    }
    return $class;
}

sub _create_bib_from_quote {

    #TBD we should flag this for updating from an external source
    #As biblio (&biblioitems) has no candidates flag in order
    my ( $item, $quote ) = @_;
    my $itemid                       = $item->item_number_id;
    my $defalt_classification_source = C4::Context->preference('DefaultClassificationSource');
    my $bib_hash                     = {
        'biblioitems.cn_source' => $defalt_classification_source,
        'items.cn_source'       => $defalt_classification_source,
        'items.notforloan'      => -1,
        'items.cn_sort'         => q{},
    };
    $bib_hash->{'biblio.seriestitle'} = $item->series;

    $bib_hash->{'biblioitems.publishercode'}   = $item->publisher;
    $bib_hash->{'biblioitems.publicationyear'} = $bib_hash->{'biblio.copyrightdate'} = $item->publication_date;

    $bib_hash->{'biblio.title'}         = $item->title;
    $bib_hash->{'biblio.author'}        = $item->author;
    $bib_hash->{'biblioitems.isbn'}     = $item->item_number_id;
    $bib_hash->{'biblioitems.itemtype'} = $item->girfield('stock_category');

    # If we have a 13 digit id we are assuming its an ean
    # (it may also be an isbn or issn)
    if ( $itemid =~ /^\d{13}$/ ) {
        $bib_hash->{'biblioitems.ean'} = $itemid;
        if ( $itemid =~ /^977/ ) {
            $bib_hash->{'biblioitems.issn'} = $itemid;
        }
    }
    for my $key ( keys %{$bib_hash} ) {
        if ( !defined $bib_hash->{$key} ) {
            delete $bib_hash->{$key};
        }
    }
    return TransformKohaToMarc($bib_hash);

}

sub _create_item_from_quote {
    my ( $item, $quote ) = @_;
    my $defalt_classification_source = C4::Context->preference('DefaultClassificationSource');
    my $item_hash                    = {
        cn_source  => $defalt_classification_source,
        notforloan => -1,
        cn_sort    => q{},
    };
    $item_hash->{booksellerid} = $quote->vendor_id;
    $item_hash->{price}        = $item_hash->{replacementprice} = $item->price;
    $item_hash->{itype}        = $item->girfield('stock_category');
    my $lsq_field = C4::Context->preference('EdifactLSQ');
    $item_hash->{$lsq_field} = $item->girfield('sequence_code');

    my $note = {};

    $item_hash->{itemcallnumber} =
           $item->girfield('shelfmark')
        || $item->girfield('classification')
        || title_level_class($item);

    my $branch = $item->girfield('branch');
    $item_hash->{holdingbranch} = $item_hash->{homebranch} = $branch;
    return $item_hash;
}

sub _handle_008_field {
    my ($bib_record) = @_;

    if ( !$bib_record->field('008') ) {
        my $default008 = biblio_008();
        $bib_record->insert_fields_ordered( MARC::Field->new( '008', $default008 ) );
    }

    return $bib_record;
}

1;
__END__

=head1 NAME

Koha::EDI

=head1 SYNOPSIS

   Module exporting subroutines used in EDI processing for Koha

=head1 DESCRIPTION

   Subroutines called by batch processing to handle Edifact
   messages of various types and related utilities

=head1 BUGS

   These routines should really be methods of some object.
   get_edifact_ean is a stopgap which should be replaced

=head1 SUBROUTINES

=head2 process_quote

    process_quote(quote_message);

   passed a message object for a quote, parses it creating an order basket
   and orderlines in the database
   updates the message's status to received in the database and adds the
   link to basket

=head2 process_invoice

    process_invoice(invoice_message)

    passed a message object for an invoice, add the contained invoices
    and update the orderlines referred to in the invoice
    As an Edifact invoice is in effect a dispatch note this receipts the
    appropriate quantities in the orders

    no meaningful return value

=head2 process_ordrsp

     process_ordrsp(ordrsp_message)

     passed a message object for a supplier response, process the contents
     If an orderline is cancelled cancel the corresponding orderline in koha
     otherwise record the supplier message against it

     no meaningful return value

=head2 create_edi_order

    create_edi_order( { parameter_hashref } )

    parameters must include basketno and ean

    branchcode can optionally be passed

    returns 1 on success undef otherwise

    if the parameter noingest is set the formatted order is returned
    and not saved in the database. This functionality is intended for debugging only

=head2 receipt_items

    receipt_items( schema_obj, invoice_line, ordernumber, $quantity, $invoice_message)

    receipts the items recorded on this invoice line

    no meaningful return

=head2 transfer_items

    transfer_items(schema, invoice_line, originating_order, receiving_order, $quantity)

    Transfer the items covered by this invoice line from their original
    order to another order recording the partial fulfillment of the original
    order

    no meaningful return

=head2 get_edifact_ean

    $ean = get_edifact_ean();

    routine to return the ean.

=head2 quote_item

     quote_item(lineitem, quote_message);

      Called by process_quote to handle an individual lineitem
     Generate the biblios and items if required and orderline linking to them

     Returns 1 on success undef on error

     Most usual cause of error is a line with no or incorrect budget codes
     which woild cause order creation to abort
     If other correct lines exist these are processed and the erroneous line os logged

=head2 title_level_class

      classmark = title_level_class(edi_item)

      Tries to return a title level classmark from a quote message line
      Will return a dewey or lcc classmark if one exists according to the
      value in DefaultClassificationSource syspref

      If unable to returns the shelfmark or classification from the GIR segment

      If all else fails returns empty string

=head2 _create_bib_from_quote

       marc_record_obj = _create_bib_from_quote(lineitem, quote)

       Returns a MARC::Record object based on the  info in the quote's lineitem

=head2 _create_item_from_quote

       item_hashref = _create_item_from_quote( lineitem, quote)

       returns a hashref representing the item fields specified in the quote

=head2 _get_invoiced_price

      (price, price_tax_excluded) = _get_invoiced_price(line_object, $quantity)

      Returns an array of unitprice and unitprice_tax_excluded derived from the lineitem
      monetary fields

=head2 _discounted_price

      ecost = _discounted_price(discount, item_price, discounted_price)

      utility subroutine to return a price calculated from the
      vendors discount and quoted price
      if invoice has a field containing discounted price that is returned
      instead of recalculating

=head2 _check_for_existing_bib

     (biblionumber, biblioitemnumber) = _check_for_existing_bib(isbn_or_ean)

     passed an isbn or ean attempts to locate a match bib
     On success returns biblionumber and biblioitemnumber
     On failure returns undefined/an empty list

=head2 _get_budget

     b = _get_budget(schema_obj, budget_code)

     Returns the Aqbudget object for the active budget given the passed budget_code
     or undefined if one does not exist

=head2 _handle_008_field

     bib_record = _handle_008_field($bib_record)

     Checks whether an 008 field exists on the record and adds a default field it does not

     Returns the bib_record

=head1 AUTHOR

   Colin Campbell <colin.campbell@ptfs-europe.com>


=head1 COPYRIGHT

   Copyright 2014,2015 PTFS-Europe Ltd
   This program is free software, You may redistribute it under
   under the terms of the GNU General Public License


=cut