From e2e991634854d940405593cb1e05945de2295d4c Mon Sep 17 00:00:00 2001 From: Colin Campbell Date: Wed, 20 Jan 2016 11:31:31 +0000 Subject: [PATCH] Bug 7736: Support Ordering via Edifact EDI messages Add support for processing incoming Edifact Quotes, Invoices and order responses and generating and transmission of Edifact Orders. Basic workflow is that an incoming quote generates an aquisition basket in Koha, with each line corresponding to an order record The user can then generate an edifact order from this (or another) basket, which is transferred to the vendor's site The supplier generates an invoice on despatch and this will result in corresponding invoices being generated in Koha The orderlines on the invoice are receipted automatically. We also support order response messages. This may include simple order acknowledgements, supplier reports/amendments on availability. Cancellation messages cause the koha order to be cancelled, other messages are recorded against the order Which messages are to be supported/processed is specifiable on a vendor by vendor basis via the admin screens You can also specify auto order i.e. to generate orders from quotes without user intervention - This reflects existing workflows where most work is done on the suppliers website then generating a dummy quote Received messages are stored in the edifact_messages table and the original can be viewed via the online Database changes are in installer/data/mysql/atomicchanges/edifact.sql Note new perl dependencies: Net::SFTP:Foreign Text::Unidecode Signed-off-by: Paul Johnson Signed-off-by: Sally Healey Signed-off-by: Kyle M Hall Signed-off-by: Brendan A Gallagher --- C4/Acquisition.pm | 6 +- C4/Installer/PerlDependencies.pm | 10 + Koha/EDI.pm | 1150 +++++++++++++++++ Koha/Edifact.pm | 337 +++++ Koha/Edifact/Line.pm | 864 +++++++++++++ Koha/Edifact/Message.pm | 249 ++++ Koha/Edifact/Order.pm | 831 ++++++++++++ Koha/Edifact/Segment.pm | 204 +++ Koha/Edifact/Transport.pm | 479 +++++++ Koha/Schema/Result/Aqbasket.pm | 19 +- Koha/Schema/Result/Aqbookseller.pm | 36 +- Koha/Schema/Result/Aqbudget.pm | 19 +- Koha/Schema/Result/Aqinvoice.pm | 32 +- Koha/Schema/Result/Aqorder.pm | 37 +- Koha/Schema/Result/Branch.pm | 21 +- Koha/Schema/Result/EdifactEan.pm | 117 ++ Koha/Schema/Result/EdifactMessage.pm | 202 +++ Koha/Schema/Result/MsgInvoice.pm | 115 ++ Koha/Schema/Result/VendorEdiAccount.pm | 249 ++++ acqui/basket.pl | 77 ++ acqui/basketgroup.pl | 17 + acqui/edi_ean.pl | 64 + acqui/edifactmsgs.pl | 62 + acqui/edimsg.pl | 72 ++ acqui/invoices.pl | 4 +- admin/edi_accounts.pl | 155 +++ admin/edi_ean_accounts.pl | 158 +++ installer/data/mysql/atomicupdate/edifact.sql | 78 ++ installer/data/mysql/kohastructure.sql | 76 ++ installer/data/mysql/sysprefs.sql | 1 + installer/data/mysql/userpermissions.sql | 1 + .../prog/en/includes/acquisitions-menu.inc | 3 + .../prog/en/includes/admin-menu.inc | 2 + .../prog/en/modules/acqui/basket.tt | 38 +- .../prog/en/modules/acqui/basketgroup.tt | 2 + .../prog/en/modules/acqui/edi_ean.tt | 38 + .../prog/en/modules/acqui/edifactmsgs.tt | 90 ++ .../prog/en/modules/acqui/edimsg.tt | 35 + .../prog/en/modules/admin/admin-home.tt | 5 + .../prog/en/modules/admin/edi_accounts.tt | 299 +++++ .../prog/en/modules/admin/edi_ean_accounts.tt | 153 +++ .../prog/en/modules/tools/tools-home.tt | 5 + misc/cronjobs/edi_cron.pl | 163 +++ misc/cronjobs/remove_temporary_edifiles.pl | 41 + t/EdiInvoice.t | 75 ++ t/Edifact.t | 121 ++ t/Ediorder.t | 56 + t/Ediordrsp.t | 59 + t/edi_testfiles/BLSINV337023.CEI | 1 + t/edi_testfiles/QUOTES_413514.CEQ | 1 + t/edi_testfiles/ordrsp1.CEA | 1 + t/edi_testfiles/ordrsp2.CEA | 1 + t/edi_testfiles/ordrsp3.CEA | 1 + t/edi_testfiles/ordrsp4.CEA | 1 + t/edi_testfiles/prquotes_73050_20140430.CEQ | 1 + 55 files changed, 6916 insertions(+), 18 deletions(-) create mode 100644 Koha/EDI.pm create mode 100644 Koha/Edifact.pm create mode 100644 Koha/Edifact/Line.pm create mode 100644 Koha/Edifact/Message.pm create mode 100644 Koha/Edifact/Order.pm create mode 100644 Koha/Edifact/Segment.pm create mode 100644 Koha/Edifact/Transport.pm create mode 100644 Koha/Schema/Result/EdifactEan.pm create mode 100644 Koha/Schema/Result/EdifactMessage.pm create mode 100644 Koha/Schema/Result/MsgInvoice.pm create mode 100644 Koha/Schema/Result/VendorEdiAccount.pm create mode 100755 acqui/edi_ean.pl create mode 100755 acqui/edifactmsgs.pl create mode 100755 acqui/edimsg.pl create mode 100755 admin/edi_accounts.pl create mode 100755 admin/edi_ean_accounts.pl create mode 100644 installer/data/mysql/atomicupdate/edifact.sql create mode 100644 koha-tmpl/intranet-tmpl/prog/en/modules/acqui/edi_ean.tt create mode 100644 koha-tmpl/intranet-tmpl/prog/en/modules/acqui/edifactmsgs.tt create mode 100644 koha-tmpl/intranet-tmpl/prog/en/modules/acqui/edimsg.tt create mode 100644 koha-tmpl/intranet-tmpl/prog/en/modules/admin/edi_accounts.tt create mode 100644 koha-tmpl/intranet-tmpl/prog/en/modules/admin/edi_ean_accounts.tt create mode 100755 misc/cronjobs/edi_cron.pl create mode 100755 misc/cronjobs/remove_temporary_edifiles.pl create mode 100755 t/EdiInvoice.t create mode 100755 t/Edifact.t create mode 100755 t/Ediorder.t create mode 100755 t/Ediordrsp.t create mode 100644 t/edi_testfiles/BLSINV337023.CEI create mode 100644 t/edi_testfiles/QUOTES_413514.CEQ create mode 100644 t/edi_testfiles/ordrsp1.CEA create mode 100644 t/edi_testfiles/ordrsp2.CEA create mode 100644 t/edi_testfiles/ordrsp3.CEA create mode 100644 t/edi_testfiles/ordrsp4.CEA create mode 100644 t/edi_testfiles/prquotes_73050_20140430.CEQ diff --git a/C4/Acquisition.pm b/C4/Acquisition.pm index f51cbdf423..db6c45acb6 100644 --- a/C4/Acquisition.pm +++ b/C4/Acquisition.pm @@ -2476,6 +2476,10 @@ sub GetInvoices { push @bind_strs, " borrowers.branchcode = ? "; push @bind_args, $args{branchcode}; } + if($args{message_id}) { + push @bind_strs, " aqinvoices.message_id = ? "; + push @bind_args, $args{message_id}; + } $query .= " WHERE " . join(" AND ", @bind_strs) if @bind_strs; $query .= " GROUP BY aqinvoices.invoiceid "; @@ -2600,7 +2604,7 @@ sub AddInvoice { return unless(%invoice and $invoice{invoicenumber}); my @columns = qw(invoicenumber booksellerid shipmentdate billingdate - closedate shipmentcost shipmentcost_budgetid); + closedate shipmentcost shipmentcost_budgetid message_id); my @set_strs; my @set_args; diff --git a/C4/Installer/PerlDependencies.pm b/C4/Installer/PerlDependencies.pm index 0d6363f606..09dafc4e19 100644 --- a/C4/Installer/PerlDependencies.pm +++ b/C4/Installer/PerlDependencies.pm @@ -782,6 +782,16 @@ our $PERL_DEPS = { 'required' => '0', 'min_ver' => '0.56', }, + 'Net::SFTP::Foreign' => { + 'usage' => 'Edifact', + 'required' => '0', + 'min_ver' => '1.73', + }, + 'Text::Unidecode' => { + 'usage' => 'Edifact', + 'required' => '0', + 'min_ver' => '0.04', + }, }; 1; diff --git a/Koha/EDI.pm b/Koha/EDI.pm new file mode 100644 index 0000000000..2f4a0ca29c --- /dev/null +++ b/Koha/EDI.pm @@ -0,0 +1,1150 @@ +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 . + +use strict; +use warnings; +use base qw(Exporter); +use utf8; +use Carp; +use English qw{ -no_match_vars }; +use Business::ISBN; +use DateTime; +use C4::Context; +use Koha::Database; +use C4::Acquisition qw( NewBasket CloseBasket ModOrder); +use C4::Suggestions qw( ModSuggestion ); +use C4::Items qw(AddItem); +use C4::Biblio qw( AddBiblio TransformKohaToMarc GetMarcBiblio ); +use Koha::Edifact::Order; +use Koha::Edifact; +use Log::Log4perl; +use Text::Unidecode; + +our $VERSION = 1.1; +our @EXPORT_OK = + qw( process_quote process_invoice process_ordrsp create_edi_order get_edifact_ean ); + +sub create_edi_order { + my $parameters = shift; + my $basketno = $parameters->{basketno}; + my $ean = $parameters->{ean}; + my $branchcode = $parameters->{branchcode}; + my $noingest = $parameters->{noingest}; + $ean ||= C4::Context->preference('EDIfactEAN'); + if ( !$basketno || !$ean ) { + carp '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 ) { + carp "No orderlines for basket $basketno"; + return; + } + + my $vendor = $schema->resultset('VendorEdiAccount')->search( + { + vendor_id => $orderlines[0]->basketno->booksellerid->id, + } + )->single; + + my $ean_search_keys = { ean => $ean, }; + if ($branchcode) { + $ean_search_keys->{branchcode} = $branchcode; + } + my $ean_obj = + $schema->resultset('EdifactEan')->search($ean_search_keys)->single; + + 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 = Koha::Edifact::Order->new( + { + orderlines => \@orderlines, + vendor => $vendor, + ean => $ean_obj, + is_response => $response, + } + ); + if ( !$edifact ) { + return; + } + + 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 = Log::Log4perl->get_logger(); + 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 => DateTime->now()->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 = Log::Log4perl->get_logger(); + my $vendor_acct; + my $edi = + 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 ) { + carp +"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; + $logger->trace( "Receipting order:$ordernumber Qty: ", + $line->quantity ); + + my $order = $schema->resultset('Aqorder')->find($ordernumber); + + # ModReceiveOrder does not validate that $ordernumber exists validate here + if ($order) { + + # check suggestions + my $s = $schema->resultset('Suggestion')->search( + { + biblionumber => $order->biblionumber->biblionumber, + } + )->single; + if ($s) { + ModSuggestion( + { + suggestionid => $s->suggestionid, + STATUS => 'AVAILABLE', + } + ); + } + + my $price = _get_invoiced_price($line); + + if ( $order->quantity > $line->quantity ) { + my $ordered = $order->quantity; + + # part receipt + $order->orderstatus('partial'); + $order->quantity( $ordered - $line->quantity ); + $order->update; + my $received_order = $order->copy( + { + ordernumber => undef, + quantity => $line->quantity, + quantityreceived => $line->quantity, + orderstatus => 'complete', + unitprice => $price, + invoiceid => $invoiceid, + datereceived => $msg_date, + } + ); + transfer_items( $schema, $line, $order, + $received_order ); + receipt_items( $schema, $line, + $received_order->ordernumber ); + } + else { # simple receipt all copies on order + $order->quantityreceived( $line->quantity ); + $order->datereceived($msg_date); + $order->invoiceid($invoiceid); + $order->unitprice($price); + $order->orderstatus('complete'); + $order->update; + receipt_items( $schema, $line, $ordernumber ); + } + } + else { + $logger->error( + "No order found for $ordernumber Invoice:$invoicenumber" + ); + next; + } + + } + + } + } + + $invoice_message->status('received'); + $invoice_message->update; # status and basketno link + return; +} + +sub _get_invoiced_price { + my $line = shift; + my $price = $line->price_net; + if ( !defined $price ) { # no net price so generate it from lineitem amount + $price = $line->amt_lineitem; + if ( $price and $line->quantity > 1 ) { + $price /= $line->quantity; # div line cost by qty + } + } + return $price; +} + +sub receipt_items { + my ( $schema, $inv_line, $ordernumber ) = @_; + my $logger = Log::Log4perl->get_logger(); + my $quantity = $inv_line->quantity; + + # 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; + $logger->warn( + "Cannot find aqorder item for $i :Order:$ordernumber"); + next; + } + my $b = $item->homebranch->branchcode; + if ( !exists $branch_map{$b} ) { + $branch_map{$b} = []; + } + push @{ $branch_map{$b} }, $item; + } + my $gir_occurence = 0; + while ( $gir_occurence < $quantity ) { + my $branch = $inv_line->girfield( 'branch', $gir_occurence ); + my $item = shift @{ $branch_map{$branch} }; + if ($item) { + my $barcode = $inv_line->girfield( 'barcode', $gir_occurence ); + if ( $barcode && !$item->barcode ) { + my $rs = $schema->resultset('Item')->search( + { + barcode => $barcode, + } + ); + if ( $rs->count > 0 ) { + $logger->warn("Barcode $barcode is a duplicate"); + } + else { + + $logger->trace("Adding barcode $barcode"); + $item->barcode($barcode); + } + } + + $item->update; + } + else { + $logger->warn("Unmatched item at branch:$branch"); + } + ++$gir_occurence; + } + return; + +} + +sub transfer_items { + my ( $schema, $inv_line, $order_from, $order_to ) = @_; + + # Transfer x items from the orig order to a completed partial order + my $quantity = $inv_line->quantity; + 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 = Log::Log4perl->get_logger(); + 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->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"); + } + else { + $logger->warn("Skipped item $item"); + } + if ( $quantity < 1 ) { + last; + } + } + + return; +} + +sub process_quote { + my $quote = shift; + + $quote->status('processing'); + $quote->update; + + my $edi = Koha::Edifact->new( { transmission => $quote->raw_msg, } ); + + my $messages = $edi->message_array(); + my $process_errors = 0; + my $logger = Log::Log4perl->get_logger(); + my $schema = Koha::Database->new()->schema(); + my $message_count = 0; + my @added_baskets; # if auto & multiple baskets need to order all + + if ( @{$messages} && $quote->vendor_id ) { + foreach my $msg ( @{$messages} ) { + ++$message_count; + my $basketno = + NewBasket( $quote->vendor_id, 0, $quote->filename, q{}, + q{} . q{} ); + push @added_baskets, $basketno; + if ( $message_count > 1 ) { + my $m_filename = $quote->filename; + $m_filename .= "_$message_count"; + $schema->resultset('EdifactMessage')->create( + { + message_type => $quote->message_type, + transfer_date => $quote->transfer_date, + vendor_id => $quote->vendor_id, + edi_acct => $quote->edi_acct, + status => 'recmsg', + basketno => $basketno, + raw_msg => q{}, + filename => $m_filename, + } + ); + } + else { + $quote->basketno($basketno); + } + $logger->trace("Created basket :$basketno"); + my $items = $msg->lineitems(); + my $refnum = $msg->message_refno; + + for my $item ( @{$items} ) { + if ( !quote_item( $item, $quote, $basketno ) ) { + ++$process_errors; + } + } + } + } + my $status = 'received'; + if ($process_errors) { + $status = 'error'; + } + + $quote->status($status); + $quote->update; # status and basketno link + # Do we automatically generate orders for this vendor + my $v = $schema->resultset('VendorEdiAccount')->search( + { + vendor_id => $quote->vendor_id, + } + )->single; + if ( $v->auto_orders ) { + for my $b (@added_baskets) { + create_edi_order( + { + + basketno => $b, + } + ); + CloseBasket($b); + } + } + + return; +} + +sub quote_item { + my ( $item, $quote, $basketno ) = @_; + + my $schema = Koha::Database->new()->schema(); + + # create biblio record + my $logger = Log::Log4perl->get_logger(); + if ( !$basketno ) { + $logger->error('Skipping order creation no 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 ); + ( $bib->{biblionumber}, $bib->{biblioitemnumber} ) = + AddBiblio( $bib_record, q{} ); + $logger->trace("New biblio added $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 ) { + $logger->error( + "Order for $order_quantity items, $gir_count segments present"); + } + $order_quantity = 1; # attempts to create an orderline for each gir + } + + # database definitions should set some of these defaults but dont + my $order_hash = { + biblionumber => $bib->{biblionumber}, + entrydate => DateTime->now( time_zone => 'local' )->ymd(), + basketno => $basketno, + listprice => $item->price, + quantity => $order_quantity, + quantityreceived => 0, + order_vendornote => q{}, + order_internalnote => $order_note, + rrp => $item->price, + ecost => _discounted_price( $quote->vendor->discount, $item->price ), + uncertainprice => 0, + sort1 => q{}, + sort2 => q{}, + }; + + # 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; + } + $order_hash->{order_vendornote} = $txt; + } + + 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 ) { + carp 'Skipping line with no budget info'; + $logger->trace('girfield skipped for invalid budget'); + $skip++; + } + else { + carp 'Skipping line with no budget info'; + $logger->trace('orderline skipped for invalid budget'); + 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 ); + + my $created = 0; + while ( $created < $order_quantity ) { + my $itemnumber; + ( $bib->{biblionumber}, $bib->{biblioitemnumber}, $itemnumber ) + = AddItem( $item_hash, $bib->{biblionumber} ); + $logger->trace("Added item:$itemnumber"); + $schema->resultset('AqordersItem')->create( + { + ordernumber => $first_order->ordernumber, + itemnumber => $itemnumber, + } + ); + ++$created; + } + } + } + + if ( $order_quantity == 1 && $item->quantity > 1 ) { + my $occurence = 1; # occ zero already added + while ( $occurence < $item->quantity ) { + + # check budget code + $budget = _get_budget( $schema, + $item->girfield( 'fund_allocation', $occurence ) ); + + if ( !$budget ) { + my $bad_budget = + $item->girfield( 'fund_allocation', $occurence ); + carp 'Skipping line with no budget info'; + $logger->trace( + "girfield skipped for invalid budget:$bad_budget"); + ++$occurence; ## 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 ); + } + my $new_item = { + itype => + $item->girfield( 'stock_category', $occurence ), + location => + $item->girfield( 'collection_code', $occurence ), + itemcallnumber => + $item->girfield( 'shelfmark', $occurence ) + || $item->girfield( 'classification', $occurence ) + || title_level_class($item), + holdingbranch => + $item->girfield( 'branch', $occurence ), + homebranch => $item->girfield( 'branch', $occurence ), + }; + if ( $new_item->{itype} ) { + $item_hash->{itype} = $new_item->{itype}; + } + if ( $new_item->{location} ) { + $item_hash->{location} = $new_item->{location}; + } + 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}; + } + + my $itemnumber; + ( undef, undef, $itemnumber ) = + AddItem( $item_hash, $bib->{biblionumber} ); + $logger->trace("New item $itemnumber added"); + $schema->resultset('AqordersItem')->create( + { + ordernumber => $new_order->ordernumber, + itemnumber => $itemnumber, + } + ); + } + + ++$occurence; + } + + # 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, + } + ); + } + + if ( C4::Context->preference('AcqCreateItem') eq 'ordering' ) { + my $new_item = { + notforloan => -1, + cn_sort => q{}, + cn_source => 'ddc', + price => $item->price, + replacementprice => $item->price, + itype => + $item->girfield( 'stock_category', $occurence ), + location => + $item->girfield( 'collection_code', $occurence ), + itemcallnumber => + $item->girfield( 'shelfmark', $occurence ) + || $item->girfield( 'classification', $occurence ) + || $item_hash->{itemcallnumber}, + holdingbranch => + $item->girfield( 'branch', $occurence ), + homebranch => $item->girfield( 'branch', $occurence ), + }; + my $itemnumber; + ( undef, undef, $itemnumber ) = + AddItem( $new_item, $bib->{biblionumber} ); + $logger->trace("New item $itemnumber added"); + $schema->resultset('AqordersItem')->create( + { + ordernumber => $ordernumber{ $budget->budget_id }, + itemnumber => $itemnumber, + } + ); + } + + ++$occurence; + } + } + } + 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 ) = @_; + 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 ) { + $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 unque + 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'); + $item_hash->{location} = $item->girfield('collection_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; +} + +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 despatch 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) + + receipts the items recorded on this invoice line + + no meaningful return + +=head2 transfer_items + + transfer_items(schema, invoice_line, originating_order, receiving_order) + + 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) + + Trys 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 + + _get_invoiced_price(line_object) + + Returns the net price or an equivalent calculated from line cost / qty + +=head2 _discounted_price + + ecost = _discounted_price(discount, item_price) + + utility subroutine to return a price calculated from the + vendors discount and quoted price + +=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 + +=head1 AUTHOR + + Colin Campbell + + +=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 diff --git a/Koha/Edifact.pm b/Koha/Edifact.pm new file mode 100644 index 0000000000..38756270b2 --- /dev/null +++ b/Koha/Edifact.pm @@ -0,0 +1,337 @@ +package Koha::Edifact; + +# 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 . + +use strict; +use warnings; +use File::Slurp; +use Carp; +use Encode qw( from_to ); +use Koha::Edifact::Segment; +use Koha::Edifact::Message; + +my $separator = { + component => q{\:}, + data => q{\+}, + decimal => q{.}, + release => q{\?}, + reserved => q{ }, + segment => q{\'}, +}; + +sub new { + my ( $class, $param_hashref ) = @_; + my $transmission; + my $self = (); + + if ( $param_hashref->{filename} ) { + if ( $param_hashref->{transmission} ) { + carp +"Cannot instantiate $class : both filename and transmission passed"; + return; + } + $transmission = read_file( $param_hashref->{filename} ); + } + else { + $transmission = $param_hashref->{transmission}; + } + $self->{transmission} = _init($transmission); + + bless $self, $class; + return $self; +} + +sub interchange_header { + my ( $self, $field ) = @_; + + my %element = ( + sender => 1, + recipient => 2, + datetime => 3, + interchange_control_reference => 4, + application_reference => 6, + ); + if ( !exists $element{$field} ) { + carp "No interchange header field $field available"; + return; + } + my $data = $self->{transmission}->[0]->elem( $element{$field} ); + return $data; +} + +sub interchange_trailer { + my ( $self, $field ) = @_; + my $trailer = $self->{transmission}->[-1]; + if ( $field eq 'interchange_control_count' ) { + return $trailer->elem(0); + } + elsif ( $field eq 'interchange_control_reference' ) { + return $trailer->elem(1); + } + carp "Trailer field $field not recognized"; + return; +} + +sub new_data_iterator { + my $self = shift; + my $offset = 0; + while ( $self->{transmission}->[$offset]->tag() ne 'UNH' ) { + ++$offset; + if ( $offset == @{ $self->{transmission} } ) { + carp 'Cannot find message start'; + return; + } + } + $self->{data_iterator} = $offset; + return 1; +} + +sub next_segment { + my $self = shift; + if ( defined $self->{data_iterator} ) { + my $seg = $self->{transmission}->[ $self->{data_iterator} ]; + if ( $seg->tag eq 'UNH' ) { + + $self->{msg_type} = $seg->elem( 1, 0 ); + } + elsif ( $seg->tag eq 'LIN' ) { + $self->{msg_type} = 'detail'; + } + + if ( $seg->tag ne 'UNZ' ) { + $self->{data_iterator}++; + } + else { + $self->{data_iterator} = undef; + } + return $seg; + } + return; +} + +# for debugging return whole transmission +sub get_transmission { + my $self = shift; + + return $self->{transmission}; +} + +sub message_type { + my $self = shift; + return $self->{msg_type}; +} + +sub _init { + my $msg = shift; + if ( !$msg ) { + return; + } + if ( $msg =~ s/^UNA(.{6})// ) { + if ( service_string_advice($1) ) { + return segmentize($msg); + + } + return; + } + else { + my $s = substr $msg, 10; + croak "File does not start with a Service string advice :$s"; + } +} + +# return an array of Message objects +sub message_array { + my $self = shift; + + # return an array of array_refs 1 ref to a message + my $msg_arr = []; + my $msg = []; + my $in_msg = 0; + foreach my $seg ( @{ $self->{transmission} } ) { + if ( $seg->tag eq 'UNH' ) { + $in_msg = 1; + push @{$msg}, $seg; + } + elsif ( $seg->tag eq 'UNT' ) { + $in_msg = 0; + if ( @{$msg} ) { + push @{$msg_arr}, Koha::Edifact::Message->new($msg); + $msg = []; + } + } + elsif ($in_msg) { + push @{$msg}, $seg; + } + } + return $msg_arr; +} + +# +# internal parsing routines used in _init +# +sub service_string_advice { + my $ssa = shift; + + # At present this just validates that the ssa + # is standard Edifact + # TBD reset the seps if non standard + if ( $ssa ne q{:+.? '} ) { + carp " Non standard Service String Advice [$ssa]"; + return; + } + + # else use default separators + return 1; +} + +sub segmentize { + my $raw = shift; + + # In practice edifact uses latin-1 but check + # Transport now converts to utf-8 on ingest + # Do not convert here + #my $char_set = 'iso-8859-1'; + #if ( $raw =~ m/^UNB[+]UNO(.)/ ) { + # $char_set = msgcharset($1); + #} + #from_to( $raw, $char_set, 'utf8' ); + + my $re = qr{ +(?> # dont backtrack into this group + [?]. # either the escape character + # followed by any other character + | # or + [^'?] # a character that is neither escape + # nor split + )+ +}x; + my @segmented; + while ( $raw =~ /($re)/g ) { + push @segmented, Koha::Edifact::Segment->new( { seg_string => $1 } ); + } + return \@segmented; +} + +sub msgcharset { + my $code = shift; + if ( $code =~ m/^[^ABCDEF]$/ ) { + $code = 'default'; + } + my %encoding_map = ( + A => 'ascii', + B => 'ascii', + C => 'iso-8859-1', + D => 'iso-8859-1', + E => 'iso-8859-1', + F => 'iso-8859-1', + default => 'iso-8859-1', + ); + return $encoding_map{$code}; +} + +1; +__END__ + +=head1 NAME + +Edifact - Edifact message handler + +=head1 DESCRIPTION + + Koha module for parsing Edifact messages + +=head1 SUBROUTINES + +=head2 new + + my $e = Koha::Edifact->new( { filename => 'myfilename' } ); + or + my $e = Koha::Edifact->new( { transmission => $msg_variable } ); + + instantiate the Edifact parser, requires either to be passed an in-memory + edifact message as transmission or a filename which it will read on creation + +=head2 interchange_header + + will return the data in the header field designated by the parameter + specified. Valid parameters are: 'sender', 'recipient', 'datetime', + 'interchange_control_reference', and 'application_reference' + +=head2 interchange_trailer + + called either with the string 'interchange_control_count' or + 'interchange_control_reference' will return the corresponding field from + the interchange trailer + +=head2 new_data_iterator + + Sets the object's data_iterator to point to the UNH segment + +=head2 next_segment + + Returns the next segment pointed to by the data_iterator. Increments the + data_iterator member or destroys it if segment UNZ has been reached + +=head2 get_transmission + + This method is useful in debugg:ing. Call on an Edifact object + it returns the object's transmission member + +=head2 message_type + + return the object's message type + +=head2 message_array + + return an array of Message objects contained in the Edifact transmission + +=head1 Internal Methods + +=head2 _init + + Called by the constructor to do the parsing of the transmission + +=head2 service_string_advice + + Examines the Service String Advice returns 1 if the default separartors are in use + undef otherwise + +=head2 segmentize + + takes a raw Edifact message and returns a reference to an array of + its segments + +=head2 msgcharset + + Return the character set the message was encoded in. The default is iso-8859-1 + + We preserve this info but will have converted to utf-8 on ingest + +=head1 AUTHOR + + Colin Campbell + + +=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 diff --git a/Koha/Edifact/Line.pm b/Koha/Edifact/Line.pm new file mode 100644 index 0000000000..ed59f5008d --- /dev/null +++ b/Koha/Edifact/Line.pm @@ -0,0 +1,864 @@ +package Koha::Edifact::Line; + +# 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 . + +use strict; +use warnings; +use utf8; + +use MARC::Record; +use MARC::Field; +use Carp; + +sub new { + my ( $class, $data_array_ref ) = @_; + my $self = _parse_lines($data_array_ref); + + bless $self, $class; + return $self; +} + +# helper routine used by constructor +# creates the hashref used as a data structure by the Line object + +sub _parse_lines { + my $aref = shift; + + my $lin = shift @{$aref}; + + my $id = $lin->elem( 2, 0 ); # may be undef in ordrsp + my $action = $lin->elem( 1, 0 ); + my $d = { + line_item_number => $lin->elem(0), + action_notification => $action, + item_number_id => $id, + additional_product_ids => [], + }; + my @item_description; + + foreach my $s ( @{$aref} ) { + if ( $s->tag eq 'PIA' ) { + push @{ $d->{additional_product_ids} }, + { + function_code => $s->elem(0), + item_number => $s->elem( 1, 0 ), + number_type => $s->elem( 1, 1 ), + }; + } + elsif ( $s->tag eq 'IMD' ) { + push @item_description, $s; + } + elsif ( $s->tag eq 'QTY' ) { + $d->{quantity} = $s->elem( 0, 1 ); + } + elsif ( $s->tag eq 'DTM' ) { + if ( $s->elem( 0, 0 ) eq '44' ) { + $d->{availability_date} = $s->elem( 0, 1 ); + } + } + elsif ( $s->tag eq 'GIR' ) { + + # we may get a Gir for each copy if QTY > 1 + if ( !$d->{GIR} ) { + $d->{GIR} = []; + push @{ $d->{GIR} }, extract_gir($s); + } + else { + my $gir = extract_gir($s); + if ( $gir->{copy} ) { # may have to merge + foreach my $g ( @{ $d->{GIR} } ) { + if ( $gir->{copy} eq $g->{copy} ) { + foreach my $field ( keys %{$gir} ) { + if ( !exists $g->{$field} ) { + $g->{$field} = $gir->{$field}; + } + } + undef $gir; + last; + } + } + if ( defined $gir ) { + push @{ $d->{GIR} }, $gir; + } + } + } + } + elsif ( $s->tag eq 'FTX' ) { + + my $type = $s->elem(0); + my $ctype = 'coded_free_text'; + if ( $type eq 'LNO' ) { # Ingrams Oasis Internal Notes field + $type = 'internal_notes'; + $ctype = 'coded_internal_note'; + } + elsif ( $type eq 'LIN' ) { + $type = 'orderline_free_text'; + $ctype = 'coded_orderline_text'; + } + elsif ( $type eq 'SUB' ) { + $type = 'coded_substitute_text'; + } + else { + $type = 'free_text'; + } + + my $coded_text = $s->elem(2); + if ( ref $coded_text eq 'ARRAY' && $coded_text->[0] ) { + $d->{$ctype}->{table} = $coded_text->[1]; + $d->{$ctype}->{code} = $coded_text->[0]; + } + + my $ftx = $s->elem(3); + if ( ref $ftx eq 'ARRAY' ) { # it comes in 70 character components + $ftx = join q{ }, @{$ftx}; + } + if ( exists $d->{$type} ) { # we can only catenate repeats + $d->{$type} .= q{ }; + $d->{$type} .= $ftx; + } + else { + $d->{$type} = $ftx; + } + } + elsif ( $s->tag eq 'MOA' ) { + + $d->{monetary_amount} = $s->elem( 0, 1 ); + } + elsif ( $s->tag eq 'PRI' ) { + + $d->{price} = $s->elem( 0, 1 ); + } + elsif ( $s->tag eq 'RFF' ) { + my $qualifier = $s->elem( 0, 0 ); + if ( $qualifier eq 'QLI' ) { # Suppliers unique quotation reference + $d->{reference} = $s->elem( 0, 1 ); + } + elsif ( $qualifier eq 'LI' ) { # Buyer's unique orderline number + $d->{ordernumber} = $s->elem( 0, 1 ); + } + elsif ( $qualifier eq 'SLI' ) + { # Suppliers unique order line reference number + $d->{orderline_reference_number} = $s->elem( 0, 1 ); + } + } + } + $d->{item_description} = _format_item_description(@item_description); + $d->{segs} = $aref; + + return $d; +} + +sub _format_item_description { + my @imd = @_; + my $bibrec = {}; + + # IMD : +Type code 'L' + characteristic code 3 char + Description in comp 3 & 4 + foreach my $imd (@imd) { + my $type_code = $imd->elem(0); + my $ccode = $imd->elem(1); + my $desc = $imd->elem( 2, 3 ); + if ( $imd->elem( 2, 4 ) ) { + $desc .= $imd->elem( 2, 4 ); + } + if ( $type_code ne 'L' ) { + carp + "Only handles text item descriptions at present: code=$type_code"; + next; + } + if ( exists $bibrec->{$ccode} ) { + $bibrec->{$ccode} .= q{ }; + $bibrec->{$ccode} .= $desc; + } + else { + $bibrec->{$ccode} = $desc; + } + } + return $bibrec; +} + +sub marc_record { + my $self = shift; + my $b = $self->{item_description}; + + my $bib = MARC::Record->new(); + + my @spec; + my @fields; + if ( exists $b->{'010'} ) { + @spec = qw( 100 a 011 c 012 b 013 d 014 e ); + push @fields, new_field( $b, [ 100, 1, q{ } ], @spec ); + } + if ( exists $b->{'020'} ) { + @spec = qw( 020 a 021 c 022 b 023 d 024 e ); + push @fields, new_field( $b, [ 700, 1, q{ } ], @spec ); + } + + # corp conf + if ( exists $b->{'030'} ) { + push @fields, $self->corpcon(1); + } + if ( exists $b->{'040'} ) { + push @fields, $self->corpcon(7); + } + if ( exists $b->{'050'} ) { + @spec = qw( '050' a '060' b '065' c ); + push @fields, new_field( $b, [ 245, 1, 0 ], @spec ); + } + if ( exists $b->{100} ) { + @spec = qw( 100 a 101 b); + push @fields, new_field( $b, [ 250, q{ }, q{ } ], @spec ); + } + @spec = qw( 110 a 120 b 170 c ); + my $f = new_field( $b, [ 260, q{ }, q{ } ], @spec ); + if ($f) { + push @fields, $f; + } + @spec = qw( 180 a 181 b 182 c 183 e); + $f = new_field( $b, [ 300, q{ }, q{ } ], @spec ); + if ($f) { + push @fields, $f; + } + if ( exists $b->{190} ) { + @spec = qw( 190 a); + push @fields, new_field( $b, [ 490, q{ }, q{ } ], @spec ); + } + + if ( exists $b->{200} ) { + @spec = qw( 200 a); + push @fields, new_field( $b, [ 490, q{ }, q{ } ], @spec ); + } + if ( exists $b->{210} ) { + @spec = qw( 210 a); + push @fields, new_field( $b, [ 490, q{ }, q{ } ], @spec ); + } + if ( exists $b->{300} ) { + @spec = qw( 300 a); + push @fields, new_field( $b, [ 500, q{ }, q{ } ], @spec ); + } + if ( exists $b->{310} ) { + @spec = qw( 310 a); + push @fields, new_field( $b, [ 520, q{ }, q{ } ], @spec ); + } + if ( exists $b->{320} ) { + @spec = qw( 320 a); + push @fields, new_field( $b, [ 521, q{ }, q{ } ], @spec ); + } + if ( exists $b->{260} ) { + @spec = qw( 260 a); + push @fields, new_field( $b, [ 600, q{ }, q{ } ], @spec ); + } + if ( exists $b->{270} ) { + @spec = qw( 270 a); + push @fields, new_field( $b, [ 650, q{ }, q{ } ], @spec ); + } + if ( exists $b->{280} ) { + @spec = qw( 280 a); + push @fields, new_field( $b, [ 655, q{ }, q{ } ], @spec ); + } + + # class + if ( exists $b->{230} ) { + @spec = qw( 230 a); + push @fields, new_field( $b, [ '082', q{ }, q{ } ], @spec ); + } + if ( exists $b->{240} ) { + @spec = qw( 240 a); + push @fields, new_field( $b, [ '084', q{ }, q{ } ], @spec ); + } + $bib->insert_fields_ordered(@fields); + + return $bib; +} + +sub corpcon { + my ( $self, $level ) = @_; + my $test_these = { + 1 => [ '033', '032', '034' ], + 7 => [ '043', '042', '044' ], + }; + my $conf = 0; + foreach my $t ( @{ $test_these->{$level} } ) { + if ( exists $self->{item_description}->{$t} ) { + $conf = 1; + } + } + my $tag; + my @spec; + my ( $i1, $i2 ) = ( q{ }, q{ } ); + if ($conf) { + $tag = ( $level * 100 ) + 11; + if ( $level == 1 ) { + @spec = qw( 030 a 031 e 032 n 033 c 034 d); + } + else { + @spec = qw( 040 a 041 e 042 n 043 c 044 d); + } + } + else { + $tag = ( $level * 100 ) + 10; + if ( $level == 1 ) { + @spec = qw( 030 a 031 b); + } + else { + @spec = qw( 040 a 041 b); + } + } + return new_field( $self->{item_description}, [ $tag, $i1, $i2 ], @spec ); +} + +sub new_field { + my ( $b, $tag_ind, @sfd_elem ) = @_; + my @sfd; + while (@sfd_elem) { + my $e = shift @sfd_elem; + my $c = shift @sfd_elem; + if ( exists $b->{$e} ) { + push @sfd, $c, $b->{$e}; + } + } + if (@sfd) { + my $field = MARC::Field->new( @{$tag_ind}, @sfd ); + return $field; + } + return; +} + +# Accessor methods to line data + +sub item_number_id { + my $self = shift; + return $self->{item_number_id}; +} + +sub line_item_number { + my $self = shift; + return $self->{line_item_number}; +} + +sub additional_product_ids { + my $self = shift; + return $self->{additional_product_ids}; +} + +sub action_notification { + my $self = shift; + my $a = $self->{action_notification}; + if ($a) { + $a = _translate_action($a); # return the associated text string + } + return $a; +} + +sub item_description { + my $self = shift; + return $self->{item_description}; +} + +sub monetary_amount { + my $self = shift; + return $self->{monetary_amount}; +} + +sub quantity { + my $self = shift; + return $self->{quantity}; +} + +sub price { + my $self = shift; + return $self->{price}; +} + +sub reference { + my $self = shift; + return $self->{reference}; +} + +sub orderline_reference_number { + my $self = shift; + return $self->{orderline_reference_number}; +} + +sub ordernumber { + my $self = shift; + return $self->{ordernumber}; +} + +sub free_text { + my $self = shift; + return $self->{free_text}; +} + +sub coded_free_text { + my $self = shift; + return $self->{coded_free_text}->{code}; +} + +sub internal_notes { + my $self = shift; + return $self->{internal_notes}; +} + +sub coded_internal_note { + my $self = shift; + return $self->{coded_internal_note}->{code}; +} + +sub orderline_free_text { + my $self = shift; + return $self->{orderline_free_text}; +} + +sub coded_orderline_text { + my $self = shift; + my $code = $self->{coded_orderline_text}->{code}; + my $table = $self->{coded_orderline_text}->{table}; + my $txt; + if ( $table eq '8B' || $table eq '7B' ) { + $txt = translate_8B($code); + } + elsif ( $table eq '12B' ) { + $txt = translate_12B($code); + } + if ( !$txt || $txt eq 'no match' ) { + $txt = $code; + } + return $txt; +} + +sub substitute_free_text { + my $self = shift; + return $self->{substitute_free_text}; +} + +sub coded_substitute_text { + my $self = shift; + return $self->{coded_substitute_text}->{code}; +} + +# This will take a standard code as returned +# by (orderline|substitue)-free_text (FTX seg LIN) +# and expand it useing EditEUR code list 8B +sub translate_8B { + my ($code) = @_; + + # list 7B is a subset of this + my %code_list_8B = ( + AB => 'Publication abandoned', + AD => 'Apply direct', + AU => 'Publisher address unknown', + CS => 'Status uncertain', + FQ => 'Only available abroad', + HK => 'Paperback OP: Hardback available', + IB => 'In stock', + IP => 'In print and in stock at publisher', + MD => 'Manufactured on demand', + NK => 'Item not known', + NN => 'We do not supply this item', + NP => 'Not yet published', + NQ => 'Not stocked', + NS => 'Not sold separately', + OB => 'Temporarily out of stock', + OF => 'This format out of print: other format available', + OP => 'Out of print', + OR => 'Out pf print; New Edition coming', + PK => 'Hardback out of print: paperback available', + PN => 'Publisher no longer in business', + RE => 'Awaiting reissue', + RF => 'refer to other publisher or distributor', + RM => 'Remaindered', + RP => 'Reprinting', + RR => 'Rights restricted: cannot supply in this market', + SD => 'Sold', + SN => 'Our supplier cannot trace', + SO => 'Pack or set not available: single items only', + ST => 'Stocktaking: temporarily unavailable', + TO => 'Only to order', + TU => 'Temporarily unavailable', + UB => 'Item unobtainable from our suppliers', + UC => 'Unavailable@ reprint under consideration', + ); + + if ( exists $code_list_8B{$code} ) { + return $code_list_8B{$code}; + } + else { + return 'no match'; + } +} + +sub translate_12B { + my ($code) = @_; + + my %code_list_12B = ( + 100 => 'Order line accepted', + 101 => 'Price query: orderline will be held awaiting customer response', + 102 => + 'Discount query: order line will be held awaiting customer response', + 103 => 'Minimum order value not reached: order line will be held', + 104 => +'Firm order required: order line will be held awaiting customer response', + 110 => 'Order line accepted, substitute product will be supplied', + 200 => 'Order line not accepted', + 201 => 'Price query: order line not accepted', + 202 => 'Discount query: order line not accepted', + 203 => 'Minimum order value not reached: order line not accepted', + 205 => 'Order line not accepted: quoted promotion is invalid', + 206 => 'Order line not accepted: quoted promotion has ended', + 207 => + 'Order line not accepted: customer ineligible for quoted promotion', + 210 => 'Order line not accepted: substitute product is offered', + 220 => 'Oustanding order line cancelled: reason unspecified', + 221 => 'Oustanding order line cancelled: past order expiry date', + 222 => 'Oustanding order line cancelled by customer request', + 223 => 'Oustanding order line cancelled: unable to supply', + 300 => 'Order line passed to new supplier', + 301 => 'Order line passed to secondhand department', + 400 => 'Backordered - awaiting supply', + 401 => 'On order from our supplier', + 402 => 'On order from abroad', + 403 => 'Backordered, waiting to reach minimum order value', + 404 => 'Despatched from our supplier, awaiting delivery', + 405 => 'Our supplier sent wrong item(s), re-ordered', + 406 => 'Our supplier sent short, re-ordered', + 407 => 'Our supplier sent damaged item(s), re-ordered', + 408 => 'Our supplier sent imperfect item(s), re-ordered', + 409 => 'Our supplier cannot trace order, re-ordered', + 410 => 'Ordered item(s) being processed by bookseller', + 411 => +'Ordered item(s) being processed by bookseller, awaiting customer action', + 412 => 'Order line held awaiting customer instruction', + 500 => 'Order line on hold - contact customer service', + 800 => 'Order line already despatched', + 900 => 'Cannot trace order line', + 901 => 'Order line held: note title change', + 902 => 'Order line held: note availability date delay', + 903 => 'Order line held: note price change', + 999 => 'Temporary hold: order action not yet determined', + ); + + if ( exists $code_list_12B{$code} ) { + return $code_list_12B{$code}; + } + else { + return 'no match'; + } +} + +# item_desription_fields accessors + +sub title { + my $self = shift; + my $titlefield = q{050}; + if ( exists $self->{item_description}->{$titlefield} ) { + return $self->{item_description}->{$titlefield}; + } + return; +} + +sub author { + my $self = shift; + my $field = q{010}; + if ( exists $self->{item_description}->{$field} ) { + my $a = $self->{item_description}->{$field}; + my $forename_field = q{011}; + if ( exists $self->{item_description}->{$forename_field} ) { + $a .= ', '; + $a .= $self->{item_description}->{$forename_field}; + } + return $a; + } + return; +} + +sub series { + my $self = shift; + my $field = q{190}; + if ( exists $self->{item_description}->{$field} ) { + return $self->{item_description}->{$field}; + } + return; +} + +sub publisher { + my $self = shift; + my $field = q{120}; + if ( exists $self->{item_description}->{$field} ) { + return $self->{item_description}->{$field}; + } + return; +} + +sub publication_date { + my $self = shift; + my $field = q{170}; + if ( exists $self->{item_description}->{$field} ) { + return $self->{item_description}->{$field}; + } + return; +} + +sub dewey_class { + my $self = shift; + my $field = q{230}; + if ( exists $self->{item_description}->{$field} ) { + return $self->{item_description}->{$field}; + } + return; +} + +sub lc_class { + my $self = shift; + my $field = q{240}; + if ( exists $self->{item_description}->{$field} ) { + return $self->{item_description}->{$field}; + } + return; +} + +sub girfield { + my ( $self, $field, $occ ) = @_; + if ( $self->number_of_girs ) { + + # defaults to occurence 0 returns undef if occ requested > occs + if ( defined $occ && $occ >= @{ $self->{GIR} } ) { + return; + } + $occ ||= 0; + return $self->{GIR}->[$occ]->{$field}; + } + else { + return; + } +} + +sub number_of_girs { + my $self = shift; + if ( $self->{GIR} ) { + + my $qty = @{ $self->{GIR} }; + + return $qty; + } + else { + return 0; + } +} + +sub extract_gir { + my $s = shift; + my %qmap = ( + LAC => 'barcode', + LAF => 'first_accession_number', + LAL => 'last_accession_number', + LCL => 'classification', + LCO => 'item_unique_id', + LCV => 'copy_value', + LFH => 'feature_heading', + LFN => 'fund_allocation', + LFS => 'filing_suffix', + LLN => 'loan_category', + LLO => 'branch', + LLS => 'label_sublocation', + LQT => 'part_order_quantity', + LRS => 'record_sublocation', + LSM => 'shelfmark', + LSQ => 'collection_code', + LST => 'stock_category', + LSZ => 'size_code', + LVC => 'coded_servicing_instruction', + LVT => 'servicing_instruction', + ); + + my $set_qualifier = $s->elem( 0, 0 ); # copy number + my $gir_element = { copy => $set_qualifier, }; + my $element = 1; + while ( my $e = $s->elem($element) ) { + ++$element; + if ( exists $qmap{ $e->[1] } ) { + my $qualifier = $qmap{ $e->[1] }; + $gir_element->{$qualifier} = $e->[0]; + } + else { + + carp "Unrecognized GIR code : $e->[1] for $e->[0]"; + } + } + return $gir_element; +} + +# mainly for invoice processing amt_ will derive from MOA price_ from PRI and tax_ from TAX/MOA pairsn +sub moa_amt { + my ( $self, $qualifier ) = @_; + foreach my $s ( @{ $self->{segs} } ) { + if ( $s->tag eq 'MOA' && $s->elem( 0, 0 ) eq $qualifier ) { + return $s->elem( 0, 1 ); + } + } + return; +} + +sub amt_discount { + my $self = shift; + return $self->moa_amt('52'); +} + +sub amt_prepayment { + my $self = shift; + return $self->moa_amt('113'); +} + +# total including allowances & tax +sub amt_total { + my $self = shift; + return $self->moa_amt('128'); +} + +# Used to give price in currency other than that given in price +sub amt_unitprice { + my $self = shift; + return $self->moa_amt('146'); +} + +# item amount after allowances excluding tax +sub amt_lineitem { + my $self = shift; + return $self->moa_amt('203'); +} + +sub pri_price { + my ( $self, $price_qualifier ) = @_; + foreach my $s ( @{ $self->{segs} } ) { + if ( $s->tag eq 'PRI' && $s->elem( 0, 0 ) eq $price_qualifier ) { + return { + price => $s->elem( 0, 1 ), + type => $s->elem( 0, 2 ), + type_qualifier => $s->elem( 0, 3 ), + }; + } + } + return; +} + +# unit price that will be chaged excl tax +sub price_net { + my $self = shift; + my $p = $self->pri_price('AAA'); + if ( defined $p ) { + return $p->{price}; + } + return; +} + +# unit price excluding all allowances, charges and taxes +sub price_gross { + my $self = shift; + my $p = $self->pri_price('AAB'); + if ( defined $p ) { + return $p->{price}; + } + return; +} + +# information price incl tax excluding allowances, charges +sub price_info { + my $self = shift; + my $p = $self->pri_price('AAE'); + if ( defined $p ) { + return $p->{price}; + } + return; +} + +# information price incl tax,allowances, charges +sub price_info_inclusive { + my $self = shift; + my $p = $self->pri_price('AAE'); + if ( defined $p ) { + return $p->{price}; + } + return; +} + +sub tax { + my $self = shift; + return $self->moa_amt('124'); +} + +sub availability_date { + my $self = shift; + if ( exists $self->{availability_date} ) { + return $self->{availability_date}; + } + return; +} + +# return text string representing action code +sub _translate_action { + my $code = shift; + my %action = ( + 2 => 'cancelled', + 3 => 'change_requested', + 4 => 'no_action', + 5 => 'accepted', + 10 => 'not_found', + 24 => 'recorded', # Order accepted but a change notified + ); + if ( $code && exists $action{$code} ) { + return $action{$code}; + } + return $code; + +} +1; +__END__ + +=head1 NAME + +Koha::Edifact::Line + +=head1 SYNOPSIS + + Class to abstractly handle a Line in an Edifact Transmission + +=head1 DESCRIPTION + + Allows access to Edifact line elements by name + +=head1 BUGS + + None documented at present + +=head1 Methods + +=head2 new + + Called with an array ref of segments constituting the line + +=head1 AUTHOR + + Colin Campbell + +=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 diff --git a/Koha/Edifact/Message.pm b/Koha/Edifact/Message.pm new file mode 100644 index 0000000000..96eb680d2e --- /dev/null +++ b/Koha/Edifact/Message.pm @@ -0,0 +1,249 @@ +package Koha::Edifact::Message; + +# 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 . + +use strict; +use warnings; +use utf8; + +use Koha::Edifact::Line; + +sub new { + my ( $class, $data_array_ref ) = @_; + my $header = shift @{$data_array_ref}; + my $bgm = shift @{$data_array_ref}; + my $msg_function = $bgm->elem(2); + my $dtm = []; + while ( $data_array_ref->[0]->tag eq 'DTM' ) { + push @{$dtm}, shift @{$data_array_ref}; + } + + my $self = { + function => $msg_function, + header => $header, + bgm => $bgm, + message_reference_number => $header->elem(0), + dtm => $dtm, + datasegs => $data_array_ref, + }; + + bless $self, $class; + return $self; +} + +sub message_refno { + my $self = shift; + return $self->{message_reference_number}; +} + +sub function { + my $self = shift; + my $msg_function = $self->{bgm}->elem(2); + if ( $msg_function == 9 ) { + return 'original'; + } + elsif ( $msg_function == 7 ) { + return 'retransmission'; + } + return; +} + +sub message_reference_number { + my $self = shift; + return $self->{header}->elem(0); +} + +sub message_type { + my $self = shift; + return $self->{header}->elem( 1, 0 ); +} + +sub message_code { + my $self = shift; + return $self->{bgm}->elem( 0, 0 ); +} + +sub docmsg_number { + my $self = shift; + return $self->{bgm}->elem(1); +} + +sub message_date { + my $self = shift; + + # usually the first if not only dtm + foreach my $d ( @{ $self->{dtm} } ) { + if ( $d->elem( 0, 0 ) eq '137' ) { + return $d->elem( 0, 1 ); + } + } + return; # this should not happen +} + +sub tax_point_date { + my $self = shift; + if ( $self->message_type eq 'INVOIC' ) { + foreach my $d ( @{ $self->{dtm} } ) { + if ( $d->elem( 0, 0 ) eq '131' ) { + return $d->elem( 0, 1 ); + } + } + } + return; +} + +sub expiry_date { + my $self = shift; + if ( $self->message_type eq 'QUOTES' ) { + foreach my $d ( @{ $self->{dtm} } ) { + if ( $d->elem( 0, 0 ) eq '36' ) { + return $d->elem( 0, 1 ); + } + } + } + return; +} + +sub shipment_charge { + my $self = shift; + + # A large number of different charges can be expressed at invoice and + # item level but the only one koha takes cognizance of is shipment + # should we wrap all invoice level charges into it?? + if ( $self->message_type eq 'INVOIC' ) { + my $delivery = 0; + my $amt = 0; + foreach my $s ( @{ $self->{datasegs} } ) { + if ( $s->tag eq 'LIN' ) { + last; + } + if ( $s->tag eq 'ALC' ) { + if ( $s->elem(0) eq 'C' ) { # Its a charge + if ( $s->elem( 4, 0 ) eq 'DL' ) { # delivery charge + $delivery = 1; + } + } + next; + } + if ( $s->tag eq 'MOA' ) { + $amt += $s->elem( 0, 1 ); + } + } + return $amt; + } + return; +} + +# return NAD fields + +sub buyer_ean { + my $self = shift; + foreach my $s ( @{ $self->{datasegs} } ) { + if ( $s->tag eq 'LIN' ) { + last; + } + if ( $s->tag eq 'NAD' ) { + my $qualifier = $s->elem(0); + if ( $qualifier eq 'BY' ) { + return $s->elem( 1, 0 ); + } + } + } + return; +} + +sub supplier_ean { + my $self = shift; + foreach my $s ( @{ $self->{datasegs} } ) { + if ( $s->tag eq 'LIN' ) { + last; + } + if ( $s->tag eq 'NAD' ) { + my $qualifier = $s->elem(0); + if ( $qualifier eq 'SU' ) { + return $s->elem( 1, 0 ); + } + } + } + return; + +} + +sub lineitems { + my $self = shift; + if ( $self->{quotation_lines} ) { + return $self->{quotation_lines}; + } + else { + my $items = []; + my $item_arr = []; + foreach my $seg ( @{ $self->{datasegs} } ) { + my $tag = $seg->tag; + if ( $tag eq 'LIN' ) { + if ( @{$item_arr} ) { + push @{$items}, Koha::Edifact::Line->new($item_arr); + } + $item_arr = [$seg]; + next; + } + elsif ( $tag =~ m/^(UNS|CNT|UNT)$/sxm ) { + if ( @{$item_arr} ) { + push @{$items}, Koha::Edifact::Line->new($item_arr); + } + last; + } + else { + if ( @{$item_arr} ) { + push @{$item_arr}, $seg; + } + } + } + $self->{quotation_lines} = $items; + return $items; + } +} + +1; +__END__ + +=head1 NAME + +Koha::Edifact::Message + +=head1 DESCRIPTION + +Class modelling an Edifact Message for parsing + +=head1 METHODS + +=head2 new + + Passed an array of segments extracts message level info + and parses lineitems as Line objects + +=head1 AUTHOR + + Colin Campbell + +=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 diff --git a/Koha/Edifact/Order.pm b/Koha/Edifact/Order.pm new file mode 100644 index 0000000000..f1e5811777 --- /dev/null +++ b/Koha/Edifact/Order.pm @@ -0,0 +1,831 @@ +package Koha::Edifact::Order; + +use strict; +use warnings; +use utf8; + +# 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 . + +use Carp; +use DateTime; +use Readonly; +use Business::ISBN; +use Koha::Database; +use C4::Budgets qw( GetBudget ); + +Readonly::Scalar my $seg_terminator => q{'}; +Readonly::Scalar my $separator => q{+}; +Readonly::Scalar my $component_separator => q{:}; +Readonly::Scalar my $release_character => q{?}; + +Readonly::Scalar my $NINES_12 => 999_999_999_999; +Readonly::Scalar my $NINES_14 => 99_999_999_999_999; +Readonly::Scalar my $CHUNKSIZE => 35; + +sub new { + my ( $class, $parameter_hashref ) = @_; + + my $self = {}; + if ( ref $parameter_hashref ) { + $self->{orderlines} = $parameter_hashref->{orderlines}; + $self->{recipient} = $parameter_hashref->{vendor}; + $self->{sender} = $parameter_hashref->{ean}; + $self->{is_response} = $parameter_hashref->{is_response}; + + # convenient alias + $self->{basket} = $self->{orderlines}->[0]->basketno; + $self->{message_date} = DateTime->now( time_zone => 'local' ); + } + + # validate that its worth proceeding + if ( !$self->{orderlines} ) { + carp 'No orderlines passed to create order'; + return; + } + if ( !$self->{recipient} ) { + carp +"No vendor passed to order creation: basket = $self->{basket}->basketno()"; + return; + } + if ( !$self->{sender} ) { + carp +"No sender ean passed to order creation: basket = $self->{basket}->basketno()"; + return; + } + + # do this once per object not once per orderline + my $database = Koha::Database->new(); + $self->{schema} = $database->schema; + + bless $self, $class; + return $self; +} + +sub filename { + my $self = shift; + if ( !$self->{orderlines} ) { + return; + } + my $filename = 'ordr' . $self->{basket}->basketno; + $filename .= '.CEP'; + return $filename; +} + +sub encode { + my ($self) = @_; + + $self->{interchange_control_reference} = int rand($NINES_14); + $self->{message_count} = 0; + + # $self->{segs}; # Message segments + + $self->{transmission} = q{}; + + $self->{transmission} .= $self->initial_service_segments(); + + $self->{transmission} .= $self->user_data_message_segments(); + + $self->{transmission} .= $self->trailing_service_segments(); + return $self->{transmission}; +} + +sub msg_date_string { + my $self = shift; + return $self->{message_date}->ymd(); +} + +sub initial_service_segments { + my $self = shift; + + #UNA service string advice - specifies standard separators + my $segs = _const('service_string_advice'); + + #UNB interchange header + $segs .= $self->interchange_header(); + + #UNG functional group header NOT USED + return $segs; +} + +sub interchange_header { + my $self = shift; + + # syntax identifier + my $hdr = + 'UNB+UNOC:3'; # controling agency character set syntax version number + # Interchange Sender + $hdr .= _interchange_sr_identifier( $self->{sender}->ean, + $self->{sender}->id_code_qualifier ); # interchange sender + $hdr .= _interchange_sr_identifier( $self->{recipient}->san, + $self->{recipient}->id_code_qualifier ); # interchange Recipient + + $hdr .= $separator; + + # DateTime of preparation + $hdr .= $self->{message_date}->format_cldr('yyMMdd:HHmm'); + $hdr .= $separator; + $hdr .= $self->interchange_control_reference(); + $hdr .= $separator; + + # Recipents reference password not usually used in edifact + $hdr .= q{+ORDERS}; # application reference + +#Edifact does not usually include the following +# $hdr .= $separator; # Processing priority not usually used in edifact +# $hdr .= $separator; # Acknowledgewment request : not usually used in edifact +# $hdr .= q{+EANCOM} # Communications agreement id +# $hdr .= q{+1} # Test indicator +# + $hdr .= $seg_terminator; + return $hdr; +} + +sub user_data_message_segments { + my $self = shift; + + #UNH message_header :: seg count begins here + $self->message_header(); + + $self->order_msg_header(); + + my $line_number = 0; + foreach my $ol ( @{ $self->{orderlines} } ) { + ++$line_number; + $self->order_line( $line_number, $ol ); + } + + $self->message_trailer(); + + my $data_segment_string = join q{}, @{ $self->{segs} }; + return $data_segment_string; +} + +sub message_trailer { + my $self = shift; + + # terminate the message + $self->add_seg("UNS+S$seg_terminator"); + + # CNT Control_Total + # Could be (code 1) total value of QTY segments + # or ( code = 2 ) number of lineitems + my $num_orderlines = @{ $self->{orderlines} }; + $self->add_seg("CNT+2:$num_orderlines$seg_terminator"); + + # UNT Message Trailer + my $segments_in_message = + 1 + @{ $self->{segs} }; # count incl UNH & UNT (!!this one) + my $reference = $self->message_reference('current'); + $self->add_seg("UNT+$segments_in_message+$reference$seg_terminator"); + return; +} + +sub trailing_service_segments { + my $self = shift; + my $trailer = q{}; + + #UNE functional group trailer NOT USED + #UNZ interchange trailer + $trailer .= $self->interchange_trailer(); + + return $trailer; +} + +sub interchange_control_reference { + my $self = shift; + if ( $self->{interchange_control_reference} ) { + return sprintf '%014d', $self->{interchange_control_reference}; + } + else { + carp 'calling for ref of unencoded order'; + return 'NONE ASSIGNED'; + } +} + +sub message_reference { + my ( $self, $function ) = @_; + if ( $function eq 'new' || !$self->{message_reference_no} ) { + + # unique 14 char mesage ref + $self->{message_reference_no} = sprintf 'ME%012d', int rand($NINES_12); + } + return $self->{message_reference_no}; +} + +sub message_header { + my $self = shift; + + $self->{segs} = []; # initialize the message + $self->{message_count}++; # In practice alwaya 1 + + my $hdr = q{UNH+} . $self->message_reference('new'); + $hdr .= _const('message_identifier'); + $self->add_seg($hdr); + return; +} + +sub interchange_trailer { + my $self = shift; + + my $t = "UNZ+$self->{message_count}+"; + $t .= $self->interchange_control_reference; + $t .= $seg_terminator; + return $t; +} + +sub order_msg_header { + my $self = shift; + my @header; + + # UNH see message_header + # BGM + push @header, + beginning_of_message( + $self->{basket}->basketno, + $self->{recipient}->san, + $self->{is_response} + ); + + # DTM + push @header, message_date_segment( $self->{message_date} ); + + # NAD-RFF buyer supplier ids + push @header, + name_and_address( + 'BUYER', + $self->{sender}->ean, + $self->{sender}->id_code_qualifier + ); + push @header, + name_and_address( + 'SUPPLIER', + $self->{recipient}->san, + $self->{recipient}->id_code_qualifier + ); + + # repeat for for other relevant parties + + # CUX currency + # ISO 4217 code to show default currency prices are quoted in + # e.g. CUX+2:GBP:9' + # TBD currency handling + + $self->add_seg(@header); + return; +} + +sub beginning_of_message { + my $basketno = shift; + my $supplier_san = shift; + my $response = shift; + my $document_message_no = sprintf '%011d', $basketno; + + # Peters & Bolinda use the BIC recommendation to use 22V a code not in Edifact + # If the order is in response to a quote + my %bic_sans = ( + '5013546025065' => 'Peters', + '9377779308820' => 'Bolinda', + ); + + # my $message_function = 9; # original 7 = retransmission + # message_code values + # 220 prder + # 224 rush order + # 228 sample order :: order for approval / inspection copies + # 22C continuation order for volumes in a set etc. + # my $message_code = '220'; + if ( exists $bic_sans{$supplier_san} && $response ) { + return "BGM+22V+$document_message_no+9$seg_terminator"; + } + + return "BGM+220+$document_message_no+9$seg_terminator"; +} + +sub name_and_address { + my ( $party, $id_code, $id_agency ) = @_; + my %qualifier_code = ( + BUYER => 'BY', + DELIVERY => 'DP', # delivery location if != buyer + INVOICEE => 'IV', # if different from buyer + SUPPLIER => 'SU', + ); + if ( !exists $qualifier_code{$party} ) { + carp "No qualifier code for $party"; + return; + } + if ( $id_agency eq '14' ) { + $id_agency = '9'; # ean coded differently in this seg + } + + return "NAD+$qualifier_code{$party}+${id_code}::$id_agency$seg_terminator"; +} + +sub order_line { + my ( $self, $linenumber, $orderline ) = @_; + + my $schema = $self->{schema}; + if ( !$orderline->biblionumber ) + { # cannot generate an orderline without a bib record + return; + } + my $biblionumber = $orderline->biblionumber->biblionumber; + my @biblioitems = $schema->resultset('Biblioitem') + ->search( { biblionumber => $biblionumber, } ); + my $biblioitem = $biblioitems[0]; # makes the assumption there is 1 only + # or else all have same details + + my $id_string = $orderline->line_item_id; + + # LIN line-number in msg :: if we had a 13 digit ean we could add + $self->add_seg( lin_segment( $linenumber, $id_string ) ); + + # PIA isbn or other id + my @identifiers; + foreach my $id ( $biblioitem->ean, $biblioitem->issn, $biblioitem->isbn ) { + if ( $id && $id ne $id_string ) { + push @identifiers, $id; + } + } + $self->add_seg( additional_product_id( join( ' ', @identifiers ) ) ); + + # biblio description + $self->add_seg( item_description( $orderline->biblionumber, $biblioitem ) ); + + # QTY order quantity + my $qty = join q{}, 'QTY+21:', $orderline->quantity, $seg_terminator; + $self->add_seg($qty); + + # DTM Optional date constraints on delivery + # we dont currently support this in koha + # GIR copy-related data + my @items; + if ( C4::Context->preference('AcqCreateItem') eq 'ordering' ) { + my @linked_itemnumbers = $orderline->aqorders_items; + + foreach my $item (@linked_itemnumbers) { + my $i_obj = $schema->resultset('Item')->find( $item->itemnumber ); + if ( defined $i_obj ) { + push @items, $i_obj; + } + } + } + else { + my $item_hash = { + itemtype => $biblioitem->itemtype, + shelfmark => $biblioitem->cn_class, + }; + my $branch = $orderline->basketno->deliveryplace; + if ($branch) { + $item_hash->{branch} = $branch; + } + for ( 1 .. $orderline->quantity ) { + push @items, $item_hash; + } + } + my $budget = GetBudget( $orderline->budget_id ); + my $ol_fields = { budget_code => $budget->{budget_code}, }; + if ( $orderline->order_vendornote ) { + $ol_fields->{servicing_instruction} = $orderline->order_vendornote; + } + $self->add_seg( gir_segments( $ol_fields, @items ) ); + + # TBD what if #items exceeds quantity + + # FTX free text for current orderline TBD + # dont really have a special instructions field to encode here + # Encode notes here + # PRI-CUX-DTM unit price on which order is placed : optional + # Coutts read this as 0.00 if not present + if ( $orderline->listprice ) { + my $price = sprintf 'PRI+AAE:%.2f:CA', $orderline->listprice; + $price .= $seg_terminator; + $self->add_seg($price); + } + + # RFF unique orderline reference no + my $rff = join q{}, 'RFF+LI:', $orderline->ordernumber, $seg_terminator; + $self->add_seg($rff); + + # RFF : suppliers unique quotation reference number + if ( $orderline->suppliers_reference_number ) { + $rff = join q{}, 'RFF+', $orderline->suppliers_reference_qualifier, + ':', $orderline->suppliers_reference_number, $seg_terminator; + $self->add_seg($rff); + } + + # LOC-QTY multiple delivery locations + #TBD to specify extra delivery locs + # NAD order line name and address + #TBD Optionally indicate a name & address or order originator + # TDT method of delivey ol-specific + # TBD requests a special delivery option + + return; +} + +sub item_description { + my ( $bib, $biblioitem ) = @_; + my $bib_desc = { + author => $bib->author, + title => $bib->title, + publisher => $biblioitem->publishercode, + year => $biblioitem->publicationyear, + }; + + my @itm = (); + + # 009 Author + # 050 Title :: title + # 080 Vol/Part no + # 100 Edition statement + # 109 Publisher :: publisher + # 110 place of pub + # 170 Date of publication :: year + # 220 Binding :: binding + my %code = ( + author => '009', + title => '050', + publisher => '109', + year => '170', + binding => '220', + ); + for my $field (qw(author title publisher year binding )) { + if ( $bib_desc->{$field} ) { + my $data = encode_text( $bib_desc->{$field} ); + push @itm, imd_segment( $code{$field}, $data ); + } + } + + return @itm; +} + +sub imd_segment { + my ( $code, $data ) = @_; + + my $seg_prefix = "IMD+L+$code+:::"; + + # chunk_line + my @chunks; + while ( my $x = substr $data, 0, $CHUNKSIZE, q{} ) { + if ( length $x == $CHUNKSIZE ) { + if ( $x =~ s/([?]{1,2})$// ) { + $data = "$1$data"; # dont breakup ?' ?? etc + } + } + push @chunks, $x; + } + my @segs; + my $odd = 1; + foreach my $c (@chunks) { + if ($odd) { + push @segs, "$seg_prefix$c"; + } + else { + $segs[-1] .= ":$c$seg_terminator"; + } + $odd = !$odd; + } + if ( @segs && $segs[-1] !~ m/$seg_terminator$/o ) { + $segs[-1] .= $seg_terminator; + } + return @segs; +} + +sub gir_segments { + my ( $orderfields, @onorderitems ) = @_; + + my $budget_code = $orderfields->{budget_code}; + 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 ( C4::Context->preference('AcqCreateItem') 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 + } + 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 ( $orderfields->{servicing_instruction} ) { + $seg .= add_gir_identity_number( 'LVT', + $orderfields->{servicing_instruction} ); + } + $sequence_no++; + push @segments, $seg; + } + return @segments; +} + +sub add_gir_identity_number { + my ( $number_qualifier, $number ) = @_; + if ($number) { + return "+${number}:${number_qualifier}"; + } + return q{}; +} + +sub add_seg { + my ( $self, @s ) = @_; + foreach my $segment (@s) { + if ( $segment !~ m/$seg_terminator$/o ) { + $segment .= $seg_terminator; + } + } + push @{ $self->{segs} }, @s; + return; +} + +sub lin_segment { + my ( $line_number, $item_number_id ) = @_; + + if ($item_number_id) { + $item_number_id = "++${item_number_id}:EN"; + } + else { + $item_number_id = q||; + } + + return "LIN+$line_number$item_number_id$seg_terminator"; +} + +sub additional_product_id { + my $isbn_field = shift; + my ( $product_id, $product_code ); + if ( $isbn_field =~ m/(\d{13})/ ) { + $product_id = $1; + $product_code = 'EN'; + } + elsif ( $isbn_field =~ m/(\d{9})[Xx\d]/ ) { + $product_id = $1; + $product_code = 'IB'; + } + + # TBD we could have a manufacturers no issn etc + if ( !$product_id ) { + return; + } + + # function id set to 5 states this is the main product id + return "PIA+5+$product_id:$product_code$seg_terminator"; +} + +sub message_date_segment { + my $dt = shift; + + # qualifier:message_date:format_code + + my $message_date = $dt->ymd(q{}); # no sep in edifact format + + return "DTM+137:$message_date:102$seg_terminator"; +} + +sub _const { + my $key = shift; + Readonly my %S => { + service_string_advice => q{UNA:+.? '}, + message_identifier => q{+ORDERS:D:96A:UN:EAN008'}, + }; + return ( $S{$key} ) ? $S{$key} : q{}; +} + +sub _interchange_sr_identifier { + my ( $identification, $qualifier ) = @_; + + if ( !$identification ) { + $identification = 'RANDOM'; + $qualifier = '92'; + carp 'undefined identifier'; + } + + # 14 EAN International + # 31B US SAN (preferred) + # also 91 assigned by supplier + # also 92 assigned by buyer + if ( $qualifier !~ m/^(?:14|31B|91|92)/xms ) { + $qualifier = '92'; + } + + return "+$identification:$qualifier"; +} + +sub encode_text { + my $string = shift; + if ($string) { + $string =~ s/[?]/??/g; + $string =~ s/'/?'/g; + $string =~ s/:/?:/g; + $string =~ s/[+]/?+/g; + } + return $string; +} + +1; +__END__ + +=head1 NAME + +Koha::Edifact::Order + +=head1 SYNOPSIS + +Format an Edifact Order message from a Koha basket + +=head1 DESCRIPTION + +Generates an Edifact format Order message for a Koha basket. +Normally the only methods used directly by the caller would be +new to set up the message, encode to return the formatted message +and filename to obtain a name under which to store the message + +=head1 BUGS + +Should integrate into Koha::Edifact namespace +Can caller interface be made cleaner? +Make handling of GIR segments more customizable + +=head1 METHODS + +=head2 new + + my $edi_order = Edifact::Order->new( + orderlines => \@orderlines, + vendor => $vendor_edi_account, + ean => $library_ean + ); + + instantiate the Edifact::Order object, all parameters are Schema::Resultset objects + Called in Koha::Edifact create_edi_order + +=head2 filename + + my $filename = $edi_order->filename() + + returns a filename for the edi order. The filename embeds a reference to the + basket the message was created to encode + +=head2 encode + + my $edifact_message = $edi_order->encode(); + + Encodes the basket as a valid edifact message ready for transmission + +=head2 initial_service_segments + + Creates the service segments which begin the message + +=head2 interchange_header + + Return an interchange header encoding sender and recipient + ids message date and standards + +=head2 user_data_message_segments + + Include message data within the encoded message + +=head2 message_trailer + + Terminate message data including control data on number + of messages and segments included + +=head2 trailing_service_segments + + Include the service segments occuring at the end of the message +=head2 interchange_control_reference + + Returns the unique interchange control reference as a 14 digit number + +=head2 message_reference + + On generates and subsequently returns the unique message + reference number as a 12 digit number preceded by ME, to generate a new number + pass the string 'new'. + In practice we encode 1 message per transmission so there is only one message + referenced. were we to encode multiple messages a new reference would be + neaded for each + +=head2 message_header + + Commences a new message + +=head2 interchange_trailer + + returns the UNZ segment which ends the tranmission encoding the + message count and control reference for the interchange + +=head2 order_msg_header + + Formats the message header segments + +=head2 beginning_of_message + + Returns the BGM segment which includes the Koha basket number + +=head2 name_and_address + + Parameters: Function ( BUYER, DELIVERY, INVOICE, SUPPLIER) + Id + Agency + + Returns a NAD segment containg the id and agency for for the Function + value. Handles the fact that NAD segments encode the value for 'EAN' differently + to elsewhere. + +=head2 order_line + + Creates the message segments wncoding an order line + +=head2 item_description + + Encodes the biblio item fields Author, title, publisher, date of publication + binding + +=head2 imd_segment + + Formats an IMD segment, handles the chunking of data into the 35 character + lengths required and the creation of repeat segments + +=head2 gir_segments + + Add item level information + +=head2 add_gir_identity_number + + Handle the formatting of a GIR element + return empty string if no data + +=head2 add_seg + + Adds a parssed array of segments to the objects segment list + ensures all segments are properly terminated by ' + +=head2 lin_segment + + Adds a LIN segment consisting of the line number and the ean number + if the passed isbn is valid + +=head2 additional_product_id + + Add a PIA segment for an additional product id + +=head2 message_date_segment + + Passed a DateTime object returns a correctly formatted DTM segment + +=head2 _const + + Stores and returns constant strings for service_string_advice + and message_identifier + TBD replace with class variables + +=head2 _interchange_sr_identifier + + Format sender and receipient identifiers for use in the interchange header + +=head2 encode_text + + Encode textual data into the standard character set ( iso 8859-1 ) + and quote any Edifact metacharacters + +=head2 msg_date_string + + Convenient routine which returns message date as a Y-m-d string + useful if the caller wants to log date of creation + +=head1 AUTHOR + + Colin Campbell + + +=head1 COPYRIGHT + + Copyright 2014,2015,2016 PTFS-Europe Ltd + This program is free software, You may redistribute it under + under the terms of the GNU General Public License + + +=cut diff --git a/Koha/Edifact/Segment.pm b/Koha/Edifact/Segment.pm new file mode 100644 index 0000000000..8a29e57c18 --- /dev/null +++ b/Koha/Edifact/Segment.pm @@ -0,0 +1,204 @@ +package Koha::Edifact::Segment; + +# Copyright 2014,2016 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 . + +use strict; +use warnings; +use utf8; + +sub new { + my ( $class, $parm_ref ) = @_; + my $self = {}; + if ( $parm_ref->{seg_string} ) { + $self = _parse_seg( $parm_ref->{seg_string} ); + } + + bless $self, $class; + return $self; +} + +sub tag { + my $self = shift; + return $self->{tag}; +} + +# return specified element may be data or an array ref if components +sub elem { + my ( $self, $element_number, $component_number ) = @_; + if ( $element_number < @{ $self->{elem_arr} } ) { + + my $e = $self->{elem_arr}->[$element_number]; + if ( defined $component_number ) { + if ( ref $e eq 'ARRAY' ) { + if ( $component_number < @{$e} ) { + return $e->[$component_number]; + } + } + elsif ( $component_number == 0 ) { + + # a string could be an element with a single component + return $e; + } + return; + } + else { + return $e; + } + } + return; #element undefined ( out of range +} + +sub element { + my ( $self, @params ) = @_; + + return $self->elem(@params); +} + +sub as_string { + my $self = shift; + + my $string = $self->{tag}; + foreach my $e ( @{ $self->{elem_arr} } ) { + $string .= q|+|; + if ( ref $e eq 'ARRAY' ) { + $string .= join q{:}, @{$e}; + } + else { + $string .= $e; + } + } + + return $string; +} + +# parse a string into fields +sub _parse_seg { + my $s = shift; + my $e = { + tag => substr( $s, 0, 3 ), + elem_arr => _get_elements( substr( $s, 3 ) ), + }; + return $e; +} + +## +# String parsing +# + +sub _get_elements { + my $seg = shift; + + $seg =~ s/^[+]//; # dont start with a dummy element` + my @elem_array = map { _components($_) } split /(?new( { seg_string => $raw }); + + passed a string representation of the segment, parses it + and retums a Segment object + +=head2 tag + + returns the three character segment tag + +=head2 elem + + $data = $s->elem($element_number, $component_number) + return the contents of a specified element and if specified + component of that element + +=head2 element + + syntactic sugar this wraps the rlem method in a fuller name + +=head2 as_string + + returns a string representation of the segment + +=head2 _parse_seg + + passed a string representation of a segment returns a hash ref with + separate tag and data elements + +=head2 _get_elements + + passed the data portion of a segment, splits it into elements, passing each to + components to further parse them. Returns a reference to an array of + elements + +=head2 _components + + Passed a string element splits it into components and returns a reference + to an array of components, if only one component is present that is returned + directly. + quote characters are removed from the components + +=head2 de_escape + + Removes Edifact escapes from the passed string and returns the modified + string + + +=head1 AUTHOR + + Colin Campbell + + +=head1 COPYRIGHT + + Copyright 2014,2016, PTFS-Europe Ltd + This program is free software, You may redistribute it under + under the terms of the GNU General Public License + + +=cut diff --git a/Koha/Edifact/Transport.pm b/Koha/Edifact/Transport.pm new file mode 100644 index 0000000000..caf2f5def3 --- /dev/null +++ b/Koha/Edifact/Transport.pm @@ -0,0 +1,479 @@ +package Koha::Edifact::Transport; + +# 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 . + +use strict; +use warnings; +use utf8; +use DateTime; +use Carp; +use English qw{ -no_match_vars }; +use Net::FTP; +use Net::SFTP::Foreign; +use File::Slurp; +use File::Copy; +use File::Basename qw( fileparse ); +use File::Spec; +use Koha::Database; +use Encode qw( from_to ); + +sub new { + my ( $class, $account_id ) = @_; + my $database = Koha::Database->new(); + my $schema = $database->schema(); + my $acct = $schema->resultset('VendorEdiAccount')->find($account_id); + my $self = { + account => $acct, + schema => $schema, + working_dir => File::Spec->tmpdir(), #temporary work directory + transfer_date => DateTime->now( time_zone => 'local' ), + }; + + bless $self, $class; + return $self; +} + +sub working_directory { + my ( $self, $new_value ) = @_; + if ($new_value) { + $self->{working_directory} = $new_value; + } + return $self->{working_directory}; +} + +sub download_messages { + my ( $self, $message_type ) = @_; + $self->{message_type} = $message_type; + + my @retrieved_files; + + if ( $self->{account}->transport eq 'SFTP' ) { + @retrieved_files = $self->sftp_download(); + } + elsif ( $self->{account}->transport eq 'FILE' ) { + @retrieved_files = $self->file_download(); + } + else { # assume FTP + @retrieved_files = $self->ftp_download(); + } + return @retrieved_files; +} + +sub upload_messages { + my ( $self, @messages ) = @_; + if (@messages) { + if ( $self->{account}->transport eq 'SFTP' ) { + $self->sftp_upload(@messages); + } + elsif ( $self->{account}->transport eq 'FILE' ) { + $self->file_upload(@messages); + } + else { # assume FTP + $self->ftp_upload(@messages); + } + } + return; +} + +sub file_download { + my $self = shift; + my @downloaded_files; + + my $file_ext = _get_file_ext( $self->{message_type} ); + + my $dir = $self->{account}->download_directory; # makes code more readable + # C = ready to retrieve E = Edifact + my $msg_hash = $self->message_hash(); + if ( opendir my $dh, $dir ) { + my @file_list = readdir $dh; + closedir $dh; + foreach my $filename (@file_list) { + + if ( $filename =~ m/[.]$file_ext$/ ) { + if ( copy( "$dir/$filename", $self->{working_dir} ) ) { + } + else { + carp "copy of $filename failed"; + next; + } + push @downloaded_files, $filename; + my $processed_name = $filename; + substr $processed_name, -3, 1, 'E'; + move( "$dir/$filename", "$dir/$processed_name" ); + } + } + $self->ingest( $msg_hash, @downloaded_files ); + } + else { + carp "Cannot open $dir"; + return; + } + return @downloaded_files; +} + +sub sftp_download { + my $self = shift; + + my $file_ext = _get_file_ext( $self->{message_type} ); + + # C = ready to retrieve E = Edifact + my $msg_hash = $self->message_hash(); + my @downloaded_files; + my $sftp = Net::SFTP::Foreign->new( + host => $self->{account}->host, + user => $self->{account}->username, + password => $self->{account}->password, + timeout => 10, + ); + if ( $sftp->error ) { + return $self->_abort_download( undef, + 'Unable to connect to remote host: ' . $sftp->error ); + } + $sftp->setcwd( $self->{account}->download_directory ) + or return $self->_abort_download( $sftp, + "Cannot change remote dir : $sftp->error" ); + my $file_list = $sftp->ls() + or return $self->_abort_download( $sftp, + "cannot get file list from server: $sftp->error" ); + foreach my $file ( @{$file_list} ) { + my $filename = $file->{filename}; + + if ( $filename =~ m/[.]$file_ext$/ ) { + $sftp->get( $filename, "$self->{working_dir}/$filename" ); + if ( $sftp->error ) { + $self->_abort_download( $sftp, + "Error retrieving $filename: $sftp->error" ); + last; + } + push @downloaded_files, $filename; + my $processed_name = $filename; + substr $processed_name, -3, 1, 'E'; + + #$sftp->atomic_rename( $filename, $processed_name ); + my $ret = $sftp->rename( $filename, $processed_name ); + if ( !$ret ) { + $self->_abort_download( $sftp, + "Error renaming $filename: $sftp->error" ); + last; + } + + } + } + $sftp->disconnect; + $self->ingest( $msg_hash, @downloaded_files ); + + return @downloaded_files; +} + +sub ingest { + my ( $self, $msg_hash, @downloaded_files ) = @_; + foreach my $f (@downloaded_files) { + $msg_hash->{filename} = $f; + my $file_content = + read_file( "$self->{working_dir}/$f", binmode => ':raw' ); + if ( !defined $file_content ) { + carp "Unable to read download file $f"; + next; + } + from_to( $file_content, 'iso-8859-1', 'utf8' ); + $msg_hash->{raw_msg} = $file_content; + $self->{schema}->resultset('EdifactMessage')->create($msg_hash); + } + return; +} + +sub ftp_download { + my $self = shift; + + my $file_ext = _get_file_ext( $self->{message_type} ); + + # C = ready to retrieve E = Edifact + + my $msg_hash = $self->message_hash(); + my @downloaded_files; + my $ftp = Net::FTP->new( + $self->{account}->host, + Timeout => 10, + Passive => 1 + ) + or return $self->_abort_download( undef, + "Cannot connect to $self->{account}->host: $EVAL_ERROR" ); + $ftp->login( $self->{account}->username, $self->{account}->password ) + or return $self->_abort_download( $ftp, "Cannot login: $ftp->message()" ); + $ftp->cwd( $self->{account}->download_directory ) + or return $self->_abort_download( $ftp, + "Cannot change remote dir : $ftp->message()" ); + my $file_list = $ftp->ls() + or + return $self->_abort_download( $ftp, 'cannot get file list from server' ); + + foreach my $filename ( @{$file_list} ) { + + if ( $filename =~ m/[.]$file_ext$/ ) { + + if ( !$ftp->get( $filename, "$self->{working_dir}/$filename" ) ) { + $self->_abort_download( $ftp, + "Error retrieving $filename: $ftp->message" ); + last; + } + + push @downloaded_files, $filename; + my $processed_name = $filename; + substr $processed_name, -3, 1, 'E'; + $ftp->rename( $filename, $processed_name ); + } + } + $ftp->quit; + + $self->ingest( $msg_hash, @downloaded_files ); + + return @downloaded_files; +} + +sub ftp_upload { + my ( $self, @messages ) = @_; + my $ftp = Net::FTP->new( + $self->{account}->host, + Timeout => 10, + Passive => 1 + ) + or return $self->_abort_download( undef, + "Cannot connect to $self->{account}->host: $EVAL_ERROR" ); + $ftp->login( $self->{account}->username, $self->{account}->password ) + or return $self->_abort_download( $ftp, "Cannot login: $ftp->message()" ); + $ftp->cwd( $self->{account}->upload_directory ) + or return $self->_abort_download( $ftp, + "Cannot change remote dir : $ftp->message()" ); + foreach my $m (@messages) { + my $content = $m->raw_msg; + if ($content) { + open my $fh, '<', \$content; + if ( $ftp->put( $fh, $m->filename ) ) { + close $fh; + $m->transfer_date( $self->{transfer_date} ); + $m->status('sent'); + $m->update; + } + else { + # error in transfer + + } + } + } + + $ftp->quit; + return; +} + +sub sftp_upload { + my ( $self, @messages ) = @_; + my $sftp = Net::SFTP::Foreign->new( + host => $self->{account}->host, + user => $self->{account}->username, + password => $self->{account}->password, + timeout => 10, + ); + $sftp->die_on_error("Cannot ssh to $self->{account}->host"); + $sftp->setcwd( $self->{account}->upload_directory ) + or return $self->_abort_download( $sftp, + "Cannot change remote dir : $sftp->error" ); + foreach my $m (@messages) { + my $content = $m->raw_msg; + if ($content) { + open my $fh, '<', \$content; + if ( $sftp->put( $fh, $m->filename ) ) { + close $fh; + $m->transfer_date( $self->{transfer_date} ); + $m->status('sent'); + $m->update; + } + else { + # error in transfer + + } + } + } + + # sftp will be closed on object destructor + return; +} + +sub file_upload { + my ( $self, @messages ) = @_; + my $dir = $self->{account}->upload_directory; + if ( -d $dir ) { + foreach my $m (@messages) { + my $content = $m->raw_msg; + if ($content) { + my $filename = $m->filename; + my $new_filename = "$dir/$filename"; + if ( open my $fh, '>', $new_filename ) { + print {$fh} $content; + close $fh; + $m->transfer_date( $self->{transfer_date} ); + $m->status('sent'); + $m->update; + } + else { + carp "Could not transfer $m->filename : $ERRNO"; + next; + } + } + } + } + else { + carp "Upload directory $dir does not exist"; + } + return; +} + +sub _abort_download { + my ( $self, $handle, $log_message ) = @_; + + my $a = $self->{account}->description; + + if ($handle) { + $handle->abort(); + } + $log_message .= ": $a"; + carp $log_message; + + #returns undef i.e. an empty array + return; +} + +sub _get_file_ext { + my $type = shift; + + # Extension format + # 1st char Status C = Ready For pickup A = Completed E = Extracted + # 2nd Char Standard E = Edifact + # 3rd Char Type of message + my %file_types = ( + QUOTE => 'CEQ', + INVOICE => 'CEI', + ORDRSP => 'CEA', + ALL => 'CE.', + ); + if ( exists $file_types{$type} ) { + return $file_types{$type}; + } + return 'XXXX'; # non matching type +} + +sub message_hash { + my $self = shift; + my $msg = { + message_type => $self->{message_type}, + vendor_id => $self->{account}->vendor_id, + edi_acct => $self->{account}->id, + status => 'new', + deleted => 0, + transfer_date => $self->{transfer_date}->ymd(), + }; + + return $msg; +} + +1; +__END__ + +=head1 NAME + +Koha::Edifact::Transport + +=head1 SYNOPSIS + +my $download = Koha::Edifact::Transport->new( $vendor_edi_account_id ); +$downlowd->download_messages('QUOTE'); + + +=head1 DESCRIPTION + +Module that handles Edifact download and upload transport +currently can use sftp or ftp +Or FILE to access a local directory (useful for testing) + + +=head1 METHODS + +=head2 new + + Creates an object of Edifact::Transport requires to be passed the id + identifying the relevant edi vendor account + +=head2 working_directory + + getter and setter for the working_directory attribute + +=head2 download_messages + + called with the message type to download will perform the download + using the appropriate transport method + +=head2 upload_messages + + passed an array of messages will upload them to the supplier site + +=head2 sftp_download + + called by download_messages to perform the download using SFTP + +=head2 ingest + + loads downloaded files into the database + +=head2 ftp_download + + called by download_messages to perform the download using FTP + +=head2 ftp_upload + + called by upload_messages to perform the upload using ftp + +=head2 sftp_upload + + called by upload_messages to perform the upload using sftp + +=head2 _abort_download + + internal routine to halt operation on error and supply a stacktrace + +=head2 _get_file_ext + + internal method returning standard suffix for file names + according to message type + +=head2 set_transport_direct + + sets the direct ingest flag so that the object reads files from + the local file system useful in debugging + +=head1 AUTHOR + + Colin Campbell + + +=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 diff --git a/Koha/Schema/Result/Aqbasket.pm b/Koha/Schema/Result/Aqbasket.pm index fbf11851c5..52cc708041 100644 --- a/Koha/Schema/Result/Aqbasket.pm +++ b/Koha/Schema/Result/Aqbasket.pm @@ -263,6 +263,21 @@ __PACKAGE__->belongs_to( }, ); +=head2 edifact_messages + +Type: has_many + +Related object: L + +=cut + +__PACKAGE__->has_many( + "edifact_messages", + "Koha::Schema::Result::EdifactMessage", + { "foreign.basketno" => "self.basketno" }, + { cascade_copy => 0, cascade_delete => 0 }, +); + =head2 borrowernumbers Type: many_to_many @@ -274,8 +289,8 @@ Composing rels: L -> borrowernumber __PACKAGE__->many_to_many("borrowernumbers", "aqbasketusers", "borrowernumber"); -# Created by DBIx::Class::Schema::Loader v0.07039 @ 2014-07-11 09:26:55 -# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:pT+YFf9nfD/dmBuE4RNCFw +# Created by DBIx::Class::Schema::Loader v0.07033 @ 2014-09-02 11:37:47 +# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:tsMzwP7eofOR27sfZSTqFQ # You can replace this text with custom content, and it will be preserved on regeneration diff --git a/Koha/Schema/Result/Aqbookseller.pm b/Koha/Schema/Result/Aqbookseller.pm index 86024568ef..5cd4ec3cb4 100644 --- a/Koha/Schema/Result/Aqbookseller.pm +++ b/Koha/Schema/Result/Aqbookseller.pm @@ -311,6 +311,21 @@ __PACKAGE__->has_many( { cascade_copy => 0, cascade_delete => 0 }, ); +=head2 edifact_messages + +Type: has_many + +Related object: L + +=cut + +__PACKAGE__->has_many( + "edifact_messages", + "Koha::Schema::Result::EdifactMessage", + { "foreign.vendor_id" => "self.id" }, + { cascade_copy => 0, cascade_delete => 0 }, +); + =head2 invoiceprice Type: belongs_to @@ -351,10 +366,25 @@ __PACKAGE__->belongs_to( }, ); +=head2 vendor_edi_accounts + +Type: has_many + +Related object: L + +=cut + +__PACKAGE__->has_many( + "vendor_edi_accounts", + "Koha::Schema::Result::VendorEdiAccount", + { "foreign.vendor_id" => "self.id" }, + { cascade_copy => 0, cascade_delete => 0 }, +); + -# Created by DBIx::Class::Schema::Loader v0.07042 @ 2016-03-09 15:14:35 -# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:JPswQh/s5S4nZnUzMckLnw +# Created by DBIx::Class::Schema::Loader v0.07042 @ 2016-03-10 19:36:24 +# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:mNH0CKfuRQqoOLXieV43DQ -# You can replace this text with custom content, and it will be preserved on regeneration +# You can replace this text with custom code or comments, and it will be preserved on regeneration 1; diff --git a/Koha/Schema/Result/Aqbudget.pm b/Koha/Schema/Result/Aqbudget.pm index fa28dfb91d..12a8c8d730 100644 --- a/Koha/Schema/Result/Aqbudget.pm +++ b/Koha/Schema/Result/Aqbudget.pm @@ -257,6 +257,21 @@ __PACKAGE__->has_many( { cascade_copy => 0, cascade_delete => 0 }, ); +=head2 vendor_edi_accounts + +Type: has_many + +Related object: L + +=cut + +__PACKAGE__->has_many( + "vendor_edi_accounts", + "Koha::Schema::Result::VendorEdiAccount", + { "foreign.shipment_budget" => "self.budget_id" }, + { cascade_copy => 0, cascade_delete => 0 }, +); + =head2 borrowernumbers Type: many_to_many @@ -268,8 +283,8 @@ Composing rels: L -> borrowernumber __PACKAGE__->many_to_many("borrowernumbers", "aqbudgetborrowers", "borrowernumber"); -# Created by DBIx::Class::Schema::Loader v0.07039 @ 2015-02-09 15:51:54 -# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:SZKnWPCMNFUm/TzeBxeDZA +# Created by DBIx::Class::Schema::Loader v0.07033 @ 2015-03-04 10:26:49 +# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:E4J/D0+2j0/8JZd0YRnoeA # You can replace this text with custom content, and it will be preserved on regeneration diff --git a/Koha/Schema/Result/Aqinvoice.pm b/Koha/Schema/Result/Aqinvoice.pm index ce6809367d..365379e58e 100644 --- a/Koha/Schema/Result/Aqinvoice.pm +++ b/Koha/Schema/Result/Aqinvoice.pm @@ -70,6 +70,12 @@ __PACKAGE__->table("aqinvoices"); is_foreign_key: 1 is_nullable: 1 +=head2 message_id + + data_type: 'integer' + is_foreign_key: 1 + is_nullable: 1 + =cut __PACKAGE__->add_columns( @@ -89,6 +95,8 @@ __PACKAGE__->add_columns( { data_type => "decimal", is_nullable => 1, size => [28, 6] }, "shipmentcost_budgetid", { data_type => "integer", is_foreign_key => 1, is_nullable => 1 }, + "message_id", + { data_type => "integer", is_foreign_key => 1, is_nullable => 1 }, ); =head1 PRIMARY KEY @@ -135,6 +143,26 @@ __PACKAGE__->belongs_to( { is_deferrable => 1, on_delete => "CASCADE", on_update => "CASCADE" }, ); +=head2 message + +Type: belongs_to + +Related object: L + +=cut + +__PACKAGE__->belongs_to( + "message", + "Koha::Schema::Result::EdifactMessage", + { id => "message_id" }, + { + is_deferrable => 1, + join_type => "LEFT", + on_delete => "SET NULL", + on_update => "RESTRICT", + }, +); + =head2 shipmentcost_budgetid Type: belongs_to @@ -156,8 +184,8 @@ __PACKAGE__->belongs_to( ); -# Created by DBIx::Class::Schema::Loader v0.07039 @ 2014-07-11 09:26:55 -# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:3se4f767VfvBKaZ8tlXwHQ +# Created by DBIx::Class::Schema::Loader v0.07033 @ 2014-09-18 16:21:46 +# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:FPZXlNt8dkjhgt2Rtc+krQ # You can replace this text with custom content, and it will be preserved on regeneration diff --git a/Koha/Schema/Result/Aqorder.pm b/Koha/Schema/Result/Aqorder.pm index e7d6fd3b07..a86ae28482 100644 --- a/Koha/Schema/Result/Aqorder.pm +++ b/Koha/Schema/Result/Aqorder.pm @@ -228,6 +228,29 @@ __PACKAGE__->table("aqorders"); is_nullable: 1 size: 16 +=head2 line_item_id + + data_type: 'varchar' + is_nullable: 1 + size: 35 + +=head2 suppliers_reference_number + + data_type: 'varchar' + is_nullable: 1 + size: 35 + +=head2 suppliers_reference_qualifier + + data_type: 'varchar' + is_nullable: 1 + size: 3 + +=head2 suppliers_report + + data_type: 'text' + is_nullable: 1 + =cut __PACKAGE__->add_columns( @@ -311,6 +334,14 @@ __PACKAGE__->add_columns( is_nullable => 1, size => 16, }, + "line_item_id", + { data_type => "varchar", is_nullable => 1, size => 35 }, + "suppliers_reference_number", + { data_type => "varchar", is_nullable => 1, size => 35 }, + "suppliers_reference_qualifier", + { data_type => "varchar", is_nullable => 1, size => 3 }, + "suppliers_report", + { data_type => "text", is_nullable => 1 }, ); =head1 PRIMARY KEY @@ -513,9 +544,9 @@ Composing rels: L -> borrowernumber __PACKAGE__->many_to_many("borrowernumbers", "aqorder_users", "borrowernumber"); -# Created by DBIx::Class::Schema::Loader v0.07042 @ 2016-03-09 15:14:35 -# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:somjoqKl7W2FYfhmgw4LQQ +# Created by DBIx::Class::Schema::Loader v0.07042 @ 2016-03-10 19:38:20 +# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:2kQhxUE0pZ3PpwOqGtvB+g -# You can replace this text with custom content, and it will be preserved on regeneration +# You can replace this text with custom code or comments, and it will be preserved on regeneration 1; diff --git a/Koha/Schema/Result/Branch.pm b/Koha/Schema/Result/Branch.pm index 106123a834..9d84ab9036 100644 --- a/Koha/Schema/Result/Branch.pm +++ b/Koha/Schema/Result/Branch.pm @@ -397,6 +397,21 @@ __PACKAGE__->might_have( { cascade_copy => 0, cascade_delete => 0 }, ); +=head2 edifact_eans + +Type: has_many + +Related object: L + +=cut + +__PACKAGE__->has_many( + "edifact_eans", + "Koha::Schema::Result::EdifactEan", + { "foreign.branchcode" => "self.branchcode" }, + { cascade_copy => 0, cascade_delete => 0 }, +); + =head2 hold_fill_targets Type: has_many @@ -513,9 +528,9 @@ Composing rels: L -> categorycode __PACKAGE__->many_to_many("categorycodes", "branchrelations", "categorycode"); -# Created by DBIx::Class::Schema::Loader v0.07039 @ 2014-11-06 15:26:36 -# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:CGNPB/MkGLOihDThj43/4A +# Created by DBIx::Class::Schema::Loader v0.07033 @ 2014-11-26 11:08:29 +# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:FjNI9OEpa5OKfwwCkggu0w -# You can replace this text with custom content, and it will be preserved on regeneration +# You can replace this text with custom code or comments, and it will be preserved on regeneration 1; diff --git a/Koha/Schema/Result/EdifactEan.pm b/Koha/Schema/Result/EdifactEan.pm new file mode 100644 index 0000000000..a9e5011c3c --- /dev/null +++ b/Koha/Schema/Result/EdifactEan.pm @@ -0,0 +1,117 @@ +use utf8; +package Koha::Schema::Result::EdifactEan; + +# Created by DBIx::Class::Schema::Loader +# DO NOT MODIFY THE FIRST PART OF THIS FILE + +=head1 NAME + +Koha::Schema::Result::EdifactEan + +=cut + +use strict; +use warnings; + +use base 'DBIx::Class::Core'; + +=head1 TABLE: C + +=cut + +__PACKAGE__->table("edifact_ean"); + +=head1 ACCESSORS + +=head2 ee_id + + data_type: 'integer' + extra: {unsigned => 1} + is_auto_increment: 1 + is_nullable: 0 + +=head2 branchcode + + data_type: 'varchar' + is_foreign_key: 1 + is_nullable: 0 + size: 10 + +=head2 ean + + data_type: 'varchar' + is_nullable: 0 + size: 15 + +=head2 id_code_qualifier + + data_type: 'varchar' + default_value: 14 + is_nullable: 0 + size: 3 + +=cut + +__PACKAGE__->add_columns( + "ee_id", + { + data_type => "integer", + extra => { unsigned => 1 }, + is_auto_increment => 1, + is_nullable => 0, + }, + "branchcode", + { data_type => "varchar", is_foreign_key => 1, is_nullable => 0, size => 10 }, + "ean", + { data_type => "varchar", is_nullable => 0, size => 15 }, + "id_code_qualifier", + { data_type => "varchar", default_value => 14, is_nullable => 0, size => 3 }, +); + +=head1 PRIMARY KEY + +=over 4 + +=item * L + +=back + +=cut + +__PACKAGE__->set_primary_key("ee_id"); + +=head1 RELATIONS + +=head2 branchcode + +Type: belongs_to + +Related object: L + +=cut + +__PACKAGE__->belongs_to( + "branchcode", + "Koha::Schema::Result::Branch", + { branchcode => "branchcode" }, + { is_deferrable => 1, on_delete => "RESTRICT", on_update => "RESTRICT" }, +); + + +# Created by DBIx::Class::Schema::Loader v0.07042 @ 2015-06-12 10:22:04 +# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:WWcMBSXeuzgCPqM0KMxfBg + + +# You can replace this text with custom code or comments, and it will be preserved on regeneration +__PACKAGE__->belongs_to('branch', + "Koha::Schema::Result::Branch", + { 'branchcode' => 'branchcode' }, + { + is_deferrable => 1, + join_type => 'LEFT', + on_delete => 'CASCADE', + on_update => 'CASCADE', + }, +); + +1; diff --git a/Koha/Schema/Result/EdifactMessage.pm b/Koha/Schema/Result/EdifactMessage.pm new file mode 100644 index 0000000000..3250a57e75 --- /dev/null +++ b/Koha/Schema/Result/EdifactMessage.pm @@ -0,0 +1,202 @@ +use utf8; +package Koha::Schema::Result::EdifactMessage; + +# Created by DBIx::Class::Schema::Loader +# DO NOT MODIFY THE FIRST PART OF THIS FILE + +=head1 NAME + +Koha::Schema::Result::EdifactMessage + +=cut + +use strict; +use warnings; + +use base 'DBIx::Class::Core'; + +=head1 TABLE: C + +=cut + +__PACKAGE__->table("edifact_messages"); + +=head1 ACCESSORS + +=head2 id + + data_type: 'integer' + is_auto_increment: 1 + is_nullable: 0 + +=head2 message_type + + data_type: 'varchar' + is_nullable: 0 + size: 10 + +=head2 transfer_date + + data_type: 'date' + datetime_undef_if_invalid: 1 + is_nullable: 1 + +=head2 vendor_id + + data_type: 'integer' + is_foreign_key: 1 + is_nullable: 1 + +=head2 edi_acct + + data_type: 'integer' + is_foreign_key: 1 + is_nullable: 1 + +=head2 status + + data_type: 'text' + is_nullable: 1 + +=head2 basketno + + data_type: 'integer' + is_foreign_key: 1 + is_nullable: 1 + +=head2 raw_msg + + data_type: 'mediumtext' + is_nullable: 1 + +=head2 filename + + data_type: 'text' + is_nullable: 1 + +=head2 deleted + + data_type: 'tinyint' + default_value: 0 + is_nullable: 0 + +=cut + +__PACKAGE__->add_columns( + "id", + { data_type => "integer", is_auto_increment => 1, is_nullable => 0 }, + "message_type", + { data_type => "varchar", is_nullable => 0, size => 10 }, + "transfer_date", + { data_type => "date", datetime_undef_if_invalid => 1, is_nullable => 1 }, + "vendor_id", + { data_type => "integer", is_foreign_key => 1, is_nullable => 1 }, + "edi_acct", + { data_type => "integer", is_foreign_key => 1, is_nullable => 1 }, + "status", + { data_type => "text", is_nullable => 1 }, + "basketno", + { data_type => "integer", is_foreign_key => 1, is_nullable => 1 }, + "raw_msg", + { data_type => "mediumtext", is_nullable => 1 }, + "filename", + { data_type => "text", is_nullable => 1 }, + "deleted", + { data_type => "tinyint", default_value => 0, is_nullable => 0 }, +); + +=head1 PRIMARY KEY + +=over 4 + +=item * L + +=back + +=cut + +__PACKAGE__->set_primary_key("id"); + +=head1 RELATIONS + +=head2 aqinvoices + +Type: has_many + +Related object: L + +=cut + +__PACKAGE__->has_many( + "aqinvoices", + "Koha::Schema::Result::Aqinvoice", + { "foreign.message_id" => "self.id" }, + { cascade_copy => 0, cascade_delete => 0 }, +); + +=head2 basketno + +Type: belongs_to + +Related object: L + +=cut + +__PACKAGE__->belongs_to( + "basketno", + "Koha::Schema::Result::Aqbasket", + { basketno => "basketno" }, + { + is_deferrable => 1, + join_type => "LEFT", + on_delete => "RESTRICT", + on_update => "RESTRICT", + }, +); + +=head2 edi_acct + +Type: belongs_to + +Related object: L + +=cut + +__PACKAGE__->belongs_to( + "edi_acct", + "Koha::Schema::Result::VendorEdiAccount", + { id => "edi_acct" }, + { + is_deferrable => 1, + join_type => "LEFT", + on_delete => "RESTRICT", + on_update => "RESTRICT", + }, +); + +=head2 vendor + +Type: belongs_to + +Related object: L + +=cut + +__PACKAGE__->belongs_to( + "vendor", + "Koha::Schema::Result::Aqbookseller", + { id => "vendor_id" }, + { + is_deferrable => 1, + join_type => "LEFT", + on_delete => "RESTRICT", + on_update => "RESTRICT", + }, +); + + +# Created by DBIx::Class::Schema::Loader v0.07033 @ 2015-02-25 10:41:36 +# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:l4h8AsG2RJupxXQcEw8yzQ + + +1; diff --git a/Koha/Schema/Result/MsgInvoice.pm b/Koha/Schema/Result/MsgInvoice.pm new file mode 100644 index 0000000000..830d6e5a29 --- /dev/null +++ b/Koha/Schema/Result/MsgInvoice.pm @@ -0,0 +1,115 @@ +use utf8; +package Koha::Schema::Result::MsgInvoice; + +# Created by DBIx::Class::Schema::Loader +# DO NOT MODIFY THE FIRST PART OF THIS FILE + +=head1 NAME + +Koha::Schema::Result::MsgInvoice + +=cut + +use strict; +use warnings; + +use base 'DBIx::Class::Core'; + +=head1 TABLE: C + +=cut + +__PACKAGE__->table("msg_invoice"); + +=head1 ACCESSORS + +=head2 mi_id + + data_type: 'integer' + is_auto_increment: 1 + is_nullable: 0 + +=head2 msg_id + + data_type: 'integer' + is_foreign_key: 1 + is_nullable: 1 + +=head2 invoiceid + + data_type: 'integer' + is_foreign_key: 1 + is_nullable: 1 + +=cut + +__PACKAGE__->add_columns( + "mi_id", + { data_type => "integer", is_auto_increment => 1, is_nullable => 0 }, + "msg_id", + { data_type => "integer", is_foreign_key => 1, is_nullable => 1 }, + "invoiceid", + { data_type => "integer", is_foreign_key => 1, is_nullable => 1 }, +); + +=head1 PRIMARY KEY + +=over 4 + +=item * L + +=back + +=cut + +__PACKAGE__->set_primary_key("mi_id"); + +=head1 RELATIONS + +=head2 invoiceid + +Type: belongs_to + +Related object: L + +=cut + +__PACKAGE__->belongs_to( + "invoiceid", + "Koha::Schema::Result::Aqinvoice", + { invoiceid => "invoiceid" }, + { + is_deferrable => 1, + join_type => "LEFT", + on_delete => "RESTRICT", + on_update => "RESTRICT", + }, +); + +=head2 msg + +Type: belongs_to + +Related object: L + +=cut + +__PACKAGE__->belongs_to( + "msg", + "Koha::Schema::Result::EdifactMessage", + { id => "msg_id" }, + { + is_deferrable => 1, + join_type => "LEFT", + on_delete => "RESTRICT", + on_update => "RESTRICT", + }, +); + + +# Created by DBIx::Class::Schema::Loader v0.07033 @ 2014-09-02 11:37:47 +# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:F1jqlEH57dpxn2Pvm/vPGA + + +# You can replace this text with custom code or comments, and it will be preserved on regeneration +1; diff --git a/Koha/Schema/Result/VendorEdiAccount.pm b/Koha/Schema/Result/VendorEdiAccount.pm new file mode 100644 index 0000000000..1a6917288a --- /dev/null +++ b/Koha/Schema/Result/VendorEdiAccount.pm @@ -0,0 +1,249 @@ +use utf8; +package Koha::Schema::Result::VendorEdiAccount; + +# Created by DBIx::Class::Schema::Loader +# DO NOT MODIFY THE FIRST PART OF THIS FILE + +=head1 NAME + +Koha::Schema::Result::VendorEdiAccount + +=cut + +use strict; +use warnings; + +use base 'DBIx::Class::Core'; + +=head1 TABLE: C + +=cut + +__PACKAGE__->table("vendor_edi_accounts"); + +=head1 ACCESSORS + +=head2 id + + data_type: 'integer' + is_auto_increment: 1 + is_nullable: 0 + +=head2 description + + data_type: 'text' + is_nullable: 0 + +=head2 host + + data_type: 'varchar' + is_nullable: 1 + size: 40 + +=head2 username + + data_type: 'varchar' + is_nullable: 1 + size: 40 + +=head2 password + + data_type: 'varchar' + is_nullable: 1 + size: 40 + +=head2 last_activity + + data_type: 'date' + datetime_undef_if_invalid: 1 + is_nullable: 1 + +=head2 vendor_id + + data_type: 'integer' + is_foreign_key: 1 + is_nullable: 1 + +=head2 download_directory + + data_type: 'text' + is_nullable: 1 + +=head2 upload_directory + + data_type: 'text' + is_nullable: 1 + +=head2 san + + data_type: 'varchar' + is_nullable: 1 + size: 20 + +=head2 id_code_qualifier + + data_type: 'varchar' + default_value: 14 + is_nullable: 1 + size: 3 + +=head2 transport + + data_type: 'varchar' + default_value: 'FTP' + is_nullable: 1 + size: 6 + +=head2 quotes_enabled + + data_type: 'tinyint' + default_value: 0 + is_nullable: 0 + +=head2 invoices_enabled + + data_type: 'tinyint' + default_value: 0 + is_nullable: 0 + +=head2 orders_enabled + + data_type: 'tinyint' + default_value: 0 + is_nullable: 0 + +=head2 responses_enabled + + data_type: 'tinyint' + default_value: 0 + is_nullable: 0 + +=head2 auto_orders + + data_type: 'tinyint' + default_value: 0 + is_nullable: 0 + +=head2 shipment_budget + + data_type: 'integer' + is_foreign_key: 1 + is_nullable: 1 + +=cut + +__PACKAGE__->add_columns( + "id", + { data_type => "integer", is_auto_increment => 1, is_nullable => 0 }, + "description", + { data_type => "text", is_nullable => 0 }, + "host", + { data_type => "varchar", is_nullable => 1, size => 40 }, + "username", + { data_type => "varchar", is_nullable => 1, size => 40 }, + "password", + { data_type => "varchar", is_nullable => 1, size => 40 }, + "last_activity", + { data_type => "date", datetime_undef_if_invalid => 1, is_nullable => 1 }, + "vendor_id", + { data_type => "integer", is_foreign_key => 1, is_nullable => 1 }, + "download_directory", + { data_type => "text", is_nullable => 1 }, + "upload_directory", + { data_type => "text", is_nullable => 1 }, + "san", + { data_type => "varchar", is_nullable => 1, size => 20 }, + "id_code_qualifier", + { data_type => "varchar", default_value => 14, is_nullable => 1, size => 3 }, + "transport", + { data_type => "varchar", default_value => "FTP", is_nullable => 1, size => 6 }, + "quotes_enabled", + { data_type => "tinyint", default_value => 0, is_nullable => 0 }, + "invoices_enabled", + { data_type => "tinyint", default_value => 0, is_nullable => 0 }, + "orders_enabled", + { data_type => "tinyint", default_value => 0, is_nullable => 0 }, + "responses_enabled", + { data_type => "tinyint", default_value => 0, is_nullable => 0 }, + "auto_orders", + { data_type => "tinyint", default_value => 0, is_nullable => 0 }, + "shipment_budget", + { data_type => "integer", is_foreign_key => 1, is_nullable => 1 }, +); + +=head1 PRIMARY KEY + +=over 4 + +=item * L + +=back + +=cut + +__PACKAGE__->set_primary_key("id"); + +=head1 RELATIONS + +=head2 edifact_messages + +Type: has_many + +Related object: L + +=cut + +__PACKAGE__->has_many( + "edifact_messages", + "Koha::Schema::Result::EdifactMessage", + { "foreign.edi_acct" => "self.id" }, + { cascade_copy => 0, cascade_delete => 0 }, +); + +=head2 shipment_budget + +Type: belongs_to + +Related object: L + +=cut + +__PACKAGE__->belongs_to( + "shipment_budget", + "Koha::Schema::Result::Aqbudget", + { budget_id => "shipment_budget" }, + { + is_deferrable => 1, + join_type => "LEFT", + on_delete => "RESTRICT", + on_update => "RESTRICT", + }, +); + +=head2 vendor + +Type: belongs_to + +Related object: L + +=cut + +__PACKAGE__->belongs_to( + "vendor", + "Koha::Schema::Result::Aqbookseller", + { id => "vendor_id" }, + { + is_deferrable => 1, + join_type => "LEFT", + on_delete => "RESTRICT", + on_update => "RESTRICT", + }, +); + + +# Created by DBIx::Class::Schema::Loader v0.07042 @ 2015-08-19 11:41:15 +# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:0CgJuFAItI71dfSG88NWhg + + +# You can replace this text with custom code or comments, and it will be preserved on regeneration +1; diff --git a/acqui/basket.pl b/acqui/basket.pl index b25426e938..0a0cbda6a3 100755 --- a/acqui/basket.pl +++ b/acqui/basket.pl @@ -36,6 +36,8 @@ use C4::Members qw/GetMember/; #needed for permissions checking for changing ba use C4::Items; use C4::Suggestions; use Date::Calc qw/Add_Delta_Days/; +use Koha::Database; +use Koha::EDI qw( create_edi_order get_edifact_ean ); =head1 NAME @@ -67,6 +69,7 @@ the supplier this script have to display the basket. my $query = new CGI; our $basketno = $query->param('basketno'); +my $ean = $query->param('ean'); my $booksellerid = $query->param('booksellerid'); my $duplinbatch = $query->param('duplinbatch'); @@ -84,6 +87,10 @@ my ( $template, $loggedinuser, $cookie, $userflags ) = get_template_and_user( my $basket = GetBasket($basketno); $booksellerid = $basket->{booksellerid} unless $booksellerid; my $bookseller = Koha::Acquisition::Bookseller->fetch({ id => $booksellerid }); +my $schema = Koha::Database->new()->schema(); +my $rs = $schema->resultset('VendorEdiAccount')->search( + { vendor_id => $booksellerid, } ); +$template->param( ediaccount => ($rs->count > 0)); unless (CanUserManageBasket($loggedinuser, $basket, $userflags)) { $template->param( @@ -196,6 +203,9 @@ if ( $op eq 'delete_confirm' ) { } elsif ($op eq 'reopen') { ReopenBasket($query->param('basketno')); print $query->redirect('/cgi-bin/koha/acqui/basket.pl?basketno='.$basket->{'basketno'}) +} +elsif ( $op eq 'ediorder' ) { + edi_close_and_order() } elsif ( $op eq 'mod_users' ) { my $basketusers_ids = $query->param('users_ids'); my @basketusers = split( /:/, $basketusers_ids ); @@ -468,3 +478,70 @@ sub get_order_infos { } output_html_with_http_headers $query, $cookie, $template->output; + + +sub edi_close_and_order { + my $confirm = $query->param('confirm') || $confirm_pref eq '2'; + if ($confirm) { + my $edi_params = { + basketno => $basketno, + ean => $ean, + }; + if ( $basket->{branch} ) { + $edi_params->{branchcode} = $basket->{branch}; + } + if ( create_edi_order($edi_params) ) { + #$template->param( edifile => 1 ); + } + CloseBasket($basketno); + + # if requested, create basket group, close it and attach the basket + if ( $query->param('createbasketgroup') ) { + my $branchcode; + if ( C4::Context->userenv + and C4::Context->userenv->{'branch'} + and C4::Context->userenv->{'branch'} ne "NO_LIBRARY_SET" ) + { + $branchcode = C4::Context->userenv->{'branch'}; + } + my $basketgroupid = NewBasketgroup( + { + name => $basket->{basketname}, + booksellerid => $booksellerid, + deliveryplace => $branchcode, + billingplace => $branchcode, + closed => 1, + } + ); + ModBasket( + { + basketno => $basketno, + basketgroupid => $basketgroupid + } + ); + print $query->redirect( +"/cgi-bin/koha/acqui/basketgroup.pl?booksellerid=$booksellerid&closed=1" + ); + } + else { + print $query->redirect( + "/cgi-bin/koha/acqui/booksellers.pl?booksellerid=$booksellerid" + ); + } + exit; + } + else { + $template->param( + edi_confirm => 1, + booksellerid => $booksellerid, + basketno => $basket->{basketno}, + basketname => $basket->{basketname}, + basketgroupname => $basket->{basketname}, + ); + if ($ean) { + $template->param( ean => $ean ); + } + + } + return; +} diff --git a/acqui/basketgroup.pl b/acqui/basketgroup.pl index dacc74eee9..6492223bd2 100755 --- a/acqui/basketgroup.pl +++ b/acqui/basketgroup.pl @@ -54,6 +54,7 @@ use CGI qw ( -utf8 ); use C4::Acquisition qw/CloseBasketgroup ReOpenBasketgroup GetOrders GetBasketsByBasketgroup GetBasketsByBookseller ModBasketgroup NewBasketgroup DelBasketgroup GetBasketgroups ModBasket GetBasketgroup GetBasket GetBasketGroupAsCSV/; use C4::Branch qw/GetBranches/; use C4::Members qw/GetMember/; +use Koha::EDI qw/create_edi_order get_edifact_ean/; use Koha::Acquisition::Bookseller; @@ -206,12 +207,24 @@ sub printbasketgrouppdf{ } +sub generate_edifact_orders { + my $basketgroupid = shift; + my $baskets = GetBasketsByBasketgroup($basketgroupid); + my $ean = get_edifact_ean(); + + for my $basket ( @{$baskets} ) { + create_edi_order( { ean => $ean, basketno => $basket->{basketno}, } ); + } + return; +} + my $op = $input->param('op') || 'display'; # possible values of $op : # - add : adds a new basketgroup, or edit an open basketgroup, or display a closed basketgroup # - mod_basket : modify an individual basket of the basketgroup # - closeandprint : close and print an closed basketgroup in pdf. called by clicking on "Close and print" button in closed basketgroups list # - print : print a closed basketgroup. called by clicking on "Print" button in closed basketgroups list +# - ediprint : generate edi order messages for the baskets in the group # - export : export in CSV a closed basketgroup. called by clicking on "Export" button in closed basketgroups list # - delete : delete an open basketgroup. called by clicking on "Delete" button in open basketgroups list # - reopen : reopen a closed basketgroup. called by clicking on "Reopen" button in closed basketgroup list @@ -370,6 +383,10 @@ if ( $op eq "add" ) { $redirectpath .= "&listclosed=1" if $closedbg ; print $input->redirect($redirectpath ); +} elsif ( $op eq 'ediprint') { + my $basketgroupid = $input->param('basketgroupid'); + generate_edifact_orders( $basketgroupid ); + exit; }else{ # no param : display the list of all basketgroups for a given vendor my $basketgroups = &GetBasketgroups($booksellerid); diff --git a/acqui/edi_ean.pl b/acqui/edi_ean.pl new file mode 100755 index 0000000000..4ceda877ba --- /dev/null +++ b/acqui/edi_ean.pl @@ -0,0 +1,64 @@ +#!/usr/bin/perl + +# Copyright 2012 Mark Gavillet & 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, write to the Free Software Foundation, Inc., +# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + +# This is an awkward construct and should probably be totally replaced +# but as all sites so far are single ordering ean its not clear what we should +# replace it with +# +use strict; +use warnings; + +use C4::Auth; +use C4::Koha; +use C4::Output; +use Koha::Database; +use CGI; +my $schema = Koha::Database->new()->schema(); + +my @eans = $schema->resultset('EdifactEan')->search( + {}, + { + join => 'branch', + } +); +my $query = CGI->new(); +my $basketno = $query->param('basketno'); + +if ( @eans == 1 ) { + my $ean = $eans[0]->ean; + print $query->redirect( + "/cgi-bin/koha/acqui/basket.pl?basketno=$basketno&op=ediorder&ean=$ean" + ); +} +else { + my ( $template, $loggedinuser, $cookie ) = get_template_and_user( + { + template_name => 'acqui/edi_ean.tt', + query => $query, + type => 'intranet', + authnotrequired => 0, + flagsrequired => { acquisition => 'order_manage' }, + debug => 1, + } + ); + $template->param( eans => \@eans ); + $template->param( basketno => $basketno ); + + output_html_with_http_headers( $query, $cookie, $template->output ); +} diff --git a/acqui/edifactmsgs.pl b/acqui/edifactmsgs.pl new file mode 100755 index 0000000000..0498b3dafd --- /dev/null +++ b/acqui/edifactmsgs.pl @@ -0,0 +1,62 @@ +#!/usr/bin/perl + +# Copyright 2014 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, write to the Free Software Foundation, Inc., +# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + +use strict; +use warnings; + +use CGI; +use Koha::Database; +use C4::Koha; +use C4::Auth; +use C4::Output; + +my $q = CGI->new; +my ( $template, $loggedinuser, $cookie, $userflags ) = get_template_and_user( + { + template_name => 'acqui/edifactmsgs.tt', + query => $q, + type => 'intranet', + authnotrequired => 0, + flagsrequired => { acquisition => 'manage_edi' }, + debug => 1, + } +); + +my $schema = Koha::Database->new()->schema(); +my $cmd = $q->param('op'); +if ( $cmd && $cmd == 'delete' ) { + my $id = $q->param->('message_id'); + my $msg = $schema->resultset('EdifactMessage')->find($id); + $msg->deleted(1); + $msg->update; +} + +my @msgs = $schema->resultset('EdifactMessage')->search( + { + deleted => 0, + }, + { + join => 'vendor', + order_by => { -desc => 'transfer_date' }, + } + +)->all; + +$template->param( messages => \@msgs ); + +output_html_with_http_headers( $q, $cookie, $template->output ); diff --git a/acqui/edimsg.pl b/acqui/edimsg.pl new file mode 100755 index 0000000000..c3547f025b --- /dev/null +++ b/acqui/edimsg.pl @@ -0,0 +1,72 @@ +#!/usr/bin/perl + +# Copyright 2014 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, write to the Free Software Foundation, Inc., +# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + +use strict; +use warnings; + +use CGI; +use Koha::Database; +use C4::Koha; +use C4::Auth; +use C4::Output; + +my $q = CGI->new; +my ( $template, $loggedinuser, $cookie, $userflags ) = get_template_and_user( + { + template_name => 'acqui/edimsg.tt', + query => $q, + type => 'intranet', + authnotrequired => 0, + flagsrequired => { acquisition => 'manage_edi' }, + debug => 1, + } +); +my $msg_id = $q->param('id'); +my $schema = Koha::Database->new()->schema(); + +my $msg = $schema->resultset('EdifactMessage')->find($msg_id); +if ($msg) { + my $transmission = $msg->raw_msg; + + my @segments = segmentize($transmission); + $template->param( segments => \@segments ); +} +else { + $template->param( no_message => 1 ); +} + +output_html_with_http_headers( $q, $cookie, $template->output ); + +sub segmentize { + my $raw = shift; + + my $re = qr{ +(?> # dont backtrack into this group + [?]. # either the escape character + # followed by any other character + | # or + [^'?] # a character that is neither escape + # nor split + )+ +}x; + my @segmented; + while ( $raw =~ /($re)/g ) { + push @segmented, "$1'"; + } + return @segmented; +} diff --git a/acqui/invoices.pl b/acqui/invoices.pl index 48adb80686..3048fb5002 100755 --- a/acqui/invoices.pl +++ b/acqui/invoices.pl @@ -62,6 +62,7 @@ my $author = $input->param('author'); my $publisher = $input->param('publisher'); my $publicationyear = $input->param('publicationyear'); my $branch = $input->param('branch'); +my $message_id = $input->param('message_id'); my $op = $input->param('op'); $shipmentdatefrom and $shipmentdatefrom = eval { dt_from_string( $shipmentdatefrom ) }; @@ -83,7 +84,8 @@ if ( $op and $op eq 'do_search' ) { author => $author, publisher => $publisher, publicationyear => $publicationyear, - branchcode => $branch + branchcode => $branch, + message_id => $message_id, ); } diff --git a/admin/edi_accounts.pl b/admin/edi_accounts.pl new file mode 100755 index 0000000000..83cc113f09 --- /dev/null +++ b/admin/edi_accounts.pl @@ -0,0 +1,155 @@ +#!/usr/bin/perl + +# Copyright 2011,2014 Mark Gavillet & 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, write to the Free Software Foundation, Inc., +# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + +use strict; +use warnings; +use CGI; +use C4::Auth; +use C4::Output; +use Koha::Database; + +my $input = CGI->new(); + +my ( $template, $loggedinuser, $cookie ) = get_template_and_user( + { + template_name => 'admin/edi_accounts.tt', + query => $input, + type => 'intranet', + authnotrequired => 0, + flagsrequired => { acquisition => 'edi_manage' }, + } +); + +my $op = $input->param('op'); +$op ||= 'display'; +my $schema = Koha::Database->new()->schema(); + +if ( $op eq 'acct_form' ) { + show_account(); + $template->param( acct_form => 1 ); + my @vendors = $schema->resultset('Aqbookseller')->search( + undef, + { + columns => [ 'name', 'id' ], + order_by => { -asc => 'name' } + } + ); + $template->param( vendors => \@vendors ); + $template->param( + code_qualifiers => [ + { + code => '14', + description => 'EAN International', + }, + { + code => '31B', + description => 'US SAN Agency', + }, + { + code => '91', + description => 'Assigned by supplier', + }, + { + code => '92', + description => 'Assigned by buyer', + }, + ] + ); + +} +elsif ( $op eq 'delete_confirm' ) { + show_account(); + $template->param( delete_confirm => 1 ); +} +else { + if ( $op eq 'save' ) { + + # validate & display + my $id = $input->param('id'); + my $fields = { + description => $input->param('description'), + host => $input->param('host'), + username => $input->param('username'), + password => $input->param('password'), + vendor_id => $input->param('vendor_id'), + upload_directory => $input->param('upload_directory'), + download_directory => $input->param('download_directory'), + san => $input->param('san'), + transport => $input->param('transport'), + quotes_enabled => defined $input->param('quotes_enabled'), + invoices_enabled => defined $input->param('invoices_enabled'), + orders_enabled => defined $input->param('orders_enabled'), + responses_enabled => defined $input->param('responses_enabled'), + auto_orders => defined $input->param('auto_orders'), + id_code_qualifier => $input->param('id_code_qualifier'), + }; + + if ($id) { + $schema->resultset('VendorEdiAccount')->search( + { + id => $id, + } + )->update_all($fields); + } + else { # new record + $schema->resultset('VendorEdiAccount')->create($fields); + } + } + elsif ( $op eq 'delete_confirmed' ) { + + $schema->resultset('VendorEdiAccount') + ->search( { id => $input->param('id'), } )->delete_all; + } + + # we do a default dispaly after deletes and saves + # as well as when thats all you want + $template->param( display => 1 ); + my @ediaccounts = $schema->resultset('VendorEdiAccount')->search( + {}, + { + join => 'vendor', + } + ); + $template->param( ediaccounts => \@ediaccounts ); +} + +output_html_with_http_headers( $input, $cookie, $template->output ); + +sub get_account { + my $id = shift; + + my $account = $schema->resultset('VendorEdiAccount')->find($id); + if ($account) { + return $account; + } + + # passing undef will default to add + return; +} + +sub show_account { + my $acct_id = $input->param('id'); + if ($acct_id) { + my $acct = $schema->resultset('VendorEdiAccount')->find($acct_id); + if ($acct) { + $template->param( account => $acct ); + } + } + return; +} diff --git a/admin/edi_ean_accounts.pl b/admin/edi_ean_accounts.pl new file mode 100755 index 0000000000..35d90c01df --- /dev/null +++ b/admin/edi_ean_accounts.pl @@ -0,0 +1,158 @@ +#!/usr/bin/perl + +# Copyright 2012, 2014 Mark Gavillet & 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, write to the Free Software Foundation, Inc., +# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + +use strict; +use warnings; +use CGI; +use C4::Auth; +use C4::Output; +use Koha::Database; + +my $input = CGI->new(); + +my ( $template, $loggedinuser, $cookie ) = get_template_and_user( + { + template_name => 'admin/edi_ean_accounts.tt', + query => $input, + type => 'intranet', + authnotrequired => 0, + flagsrequired => { acquisition => 'edi_manage' }, + } +); + +my $schema = Koha::Database->new()->schema(); +my $op = $input->param('op'); +$op ||= 'display'; + +if ( $op eq 'ean_form' ) { + show_ean(); + $template->param( ean_form => 1 ); + my @branches = $schema->resultset('Branch')->search( + undef, + { + columns => [ 'branchcode', 'branchname' ], + order_by => 'branchname', + } + ); + $template->param( branches => \@branches ); + $template->param( + code_qualifiers => [ + { + code => '14', + description => 'EAN International', + }, + { + code => '31B', + description => 'US SAN Agency', + }, + { + code => '91', + description => 'Assigned by supplier', + }, + { + code => '92', + description => 'Assigned by buyer', + }, + ] + ); + +} +elsif ( $op eq 'delete_confirm' ) { + show_ean(); + $template->param( delete_confirm => 1 ); +} +else { + if ( $op eq 'save' ) { + my $change = $input->param('oldean'); + if ($change) { + editsubmit(); + } + else { + addsubmit(); + } + } + elsif ( $op eq 'delete_confirmed' ) { + delsubmit(); + } + my @eans = $schema->resultset('EdifactEan')->search( + {}, + { + join => 'branch', + } + ); + $template->param( display => 1 ); + $template->param( eans => \@eans ); +} + +output_html_with_http_headers( $input, $cookie, $template->output ); + +sub delsubmit { + my $ean = $schema->resultset('EdifactEan')->find( + { + branchcode => $input->param('branchcode'), + ean => $input->param('ean') + } + ); + $ean->delete; + return; +} + +sub addsubmit { + + my $new_ean = $schema->resultset('EdifactEan')->new( + { + branchcode => $input->param('branchcode'), + ean => $input->param('ean'), + id_code_qualifier => $input->param('id_code_qualifier'), + } + ); + $new_ean->insert(); + return; +} + +sub editsubmit { + $schema->resultset('EdifactEan')->search( + { + branchcode => $input->param('oldbranchcode'), + ean => $input->param('oldean'), + } + )->update_all( + { + branchcode => $input->param('branchcode'), + ean => $input->param('ean'), + id_code_qualifier => $input->param('id_code_qualifier'), + } + ); + return; +} + +sub show_ean { + my $branchcode = $input->param('branchcode'); + my $ean = $input->param('ean'); + if ( $branchcode && $ean ) { + my $e = $schema->resultset('EdifactEan')->find( + { + ean => $ean, + branchcode => $branchcode, + } + ); + $template->param( ean => $e ); + } + return; +} diff --git a/installer/data/mysql/atomicupdate/edifact.sql b/installer/data/mysql/atomicupdate/edifact.sql new file mode 100644 index 0000000000..79053cdeb3 --- /dev/null +++ b/installer/data/mysql/atomicupdate/edifact.sql @@ -0,0 +1,78 @@ +-- Holds details for vendors supplying goods by EDI +CREATE TABLE IF NOT EXISTS vendor_edi_accounts ( + id int(11) NOT NULL auto_increment, + description text NOT NULL, + host varchar(40), + username varchar(40), + password varchar(40), + last_activity date, + vendor_id int(11) references aqbooksellers( id ), + download_directory text, + upload_directory text, + san varchar(20), + id_code_qualifier varchar(3) default '14', + transport varchar(6) default 'FTP', + quotes_enabled tinyint(1) not null default 0, + invoices_enabled tinyint(1) not null default 0, + orders_enabled tinyint(1) not null default 0, + responses_enabled tinyint(1) not null default 0, + auto_orders tinyint(1) not null default 0, + shipment_budget integer(11) references aqbudgets( budget_id ), + PRIMARY KEY (id), + KEY vendorid (vendor_id), + KEY shipmentbudget (shipment_budget), + CONSTRAINT vfk_vendor_id FOREIGN KEY ( vendor_id ) REFERENCES aqbooksellers ( id ), + CONSTRAINT vfk_shipment_budget FOREIGN KEY ( shipment_budget ) REFERENCES aqbudgets ( budget_id ) +) ENGINE=InnoDB DEFAULT CHARSET=utf8; + +-- Hold the actual edifact messages with links to associated baskets +CREATE TABLE IF NOT EXISTS edifact_messages ( + id int(11) NOT NULL auto_increment, + message_type varchar(10) NOT NULL, + transfer_date date, + vendor_id int(11) references aqbooksellers( id ), + edi_acct integer references vendor_edi_accounts( id ), + status text, + basketno int(11) REFERENCES aqbasket( basketno), + raw_msg mediumtext, + filename text, + deleted boolean not null default 0, + PRIMARY KEY (id), + KEY vendorid ( vendor_id), + KEY ediacct (edi_acct), + KEY basketno ( basketno), + CONSTRAINT emfk_vendor FOREIGN KEY ( vendor_id ) REFERENCES aqbooksellers ( id ), + CONSTRAINT emfk_edi_acct FOREIGN KEY ( edi_acct ) REFERENCES vendor_edi_accounts ( id ), + CONSTRAINT emfk_basketno FOREIGN KEY ( basketno ) REFERENCES aqbasket ( basketno ) +) ENGINE=InnoDB DEFAULT CHARSET=utf8; + +-- invoices link back to the edifact message it was generated from +ALTER TABLE aqinvoices ADD COLUMN message_id INT(11) REFERENCES edifact_messages( id ); + +-- clean up link on deletes +ALTER TABLE aqinvoices ADD CONSTRAINT edifact_msg_fk FOREIGN KEY ( message_id ) REFERENCES edifact_messages ( id ) ON DELETE SET NULL; + +-- Hold the supplier ids from quotes for ordering +-- although this is an EAN-13 article number the standard says 35 characters ??? +ALTER TABLE aqorders ADD COLUMN line_item_id varchar(35); + +-- The suppliers unique reference usually a quotation line number ('QLI') +-- Otherwise Suppliers unique orderline reference ('SLI') +ALTER TABLE aqorders ADD COLUMN suppliers_reference_number varchar(35); +ALTER TABLE aqorders ADD COLUMN suppliers_reference_qualifier varchar(3); +ALTER TABLE aqorders ADD COLUMN suppliers_report text; + +-- hold the EAN/SAN used in ordering +CREATE TABLE IF NOT EXISTS edifact_ean ( + ee_id integer(11) unsigned not null auto_increment primary key, + branchcode VARCHAR(10) NOT NULL REFERENCES branches (branchcode), + ean varchar(15) NOT NULL, + id_code_qualifier VARCHAR(3) NOT NULL DEFAULT '14', + CONSTRAINT efk_branchcode FOREIGN KEY ( branchcode ) REFERENCES branches ( branchcode ) +) ENGINE=InnoDB DEFAULT CHARSET=utf8; + +-- Syspref budget to hold shipping costs +INSERT INTO systempreferences (variable, explanation, type) VALUES('EDIInvoicesShippingBudget','The budget code used to allocate shipping charges to when processing EDI Invoice messages', 'free'); + +-- Add a permission for managing EDI +INSERT INTO permissions (module_bit, code, description) values (11, 'edi_manage', 'Manage EDIFACT transmissions'); diff --git a/installer/data/mysql/kohastructure.sql b/installer/data/mysql/kohastructure.sql index 14b2d02929..cd2496e6e1 100644 --- a/installer/data/mysql/kohastructure.sql +++ b/installer/data/mysql/kohastructure.sql @@ -3112,6 +3112,10 @@ CREATE TABLE `aqorders` ( -- information related to the basket line items `subscriptionid` int(11) default NULL, -- links this order line to a subscription (subscription.subscriptionid) parent_ordernumber int(11) default NULL, -- ordernumber of parent order line, or same as ordernumber if no parent `orderstatus` varchar(16) default 'new', -- the current status for this line item. Can be 'new', 'ordered', 'partial', 'complete' or 'cancelled' + line_item_id varchar(35) default NULL, -- Supplier's article id for Edifact orderline + suppliers_reference_number varchar(35) default NULL, -- Suppliers unique edifact quote ref + suppliers_reference_qualifier varchar(3) default NULL, -- Type of number above usually 'QLI' + `suppliers_report` text COLLATE utf8_unicode_ci, -- reports received from suppliers PRIMARY KEY (`ordernumber`), KEY `basketno` (`basketno`), KEY `biblionumber` (`biblionumber`), @@ -3169,6 +3173,62 @@ CREATE TABLE aqorders_transfers ( CONSTRAINT aqorders_transfers_ordernumber_to FOREIGN KEY (ordernumber_to) REFERENCES aqorders (ordernumber) ON DELETE SET NULL ON UPDATE CASCADE ) ENGINE=InnoDB DEFAULT CHARSET=utf8 COLLATE=utf8_unicode_ci; +-- +-- Table structure for table vendor_edi_accounts +-- + +DROP TABLE IF EXISTS vendor_edi_accounts; +CREATE TABLE IF NOT EXISTS vendor_edi_accounts ( + id int(11) NOT NULL auto_increment, + description text NOT NULL, + host varchar(40), + username varchar(40), + password varchar(40), + last_activity date, + vendor_id int(11) references aqbooksellers( id ), + download_directory text, + upload_directory text, + san varchar(20), + id_code_qualifier varchar(3) default '14', + transport varchar(6) default 'FTP', + quotes_enabled tinyint(1) not null default 0, + invoices_enabled tinyint(1) not null default 0, + orders_enabled tinyint(1) not null default 0, + responses_enabled tinyint(1) NOT NULL DEFAULT '0', + auto_orders tinyint(1) NOT NULL DEFAULT '0', + shipment_budget integer(11) references aqbudgets( budget_id ), + PRIMARY KEY (id), + KEY vendorid (vendor_id), + KEY shipmentbudget (shipment_budget), + CONSTRAINT vfk_vendor_id FOREIGN KEY ( vendor_id ) REFERENCES aqbooksellers ( id ), + CONSTRAINT vfk_shipment_budget FOREIGN KEY ( shipment_budget ) REFERENCES aqbudgets ( budget_id ) +) ENGINE=InnoDB DEFAULT CHARSET=utf8 COLLATE=utf8_unicode_ci; + +-- +-- Table structure for table edifact_messages +-- + +DROP TABLE IF EXISTS edifact_messages; +CREATE TABLE IF NOT EXISTS edifact_messages ( + id int(11) NOT NULL auto_increment, + message_type varchar(10) NOT NULL, + transfer_date date, + vendor_id int(11) references aqbooksellers( id ), + edi_acct integer references vendor_edi_accounts( id ), + status text, + basketno int(11) references aqbasket( basketno), + raw_msg mediumtext, + filename text, + deleted boolean not null default 0, + PRIMARY KEY (id), + KEY vendorid ( vendor_id), + KEY ediacct (edi_acct), + KEY basketno ( basketno), + CONSTRAINT emfk_vendor FOREIGN KEY ( vendor_id ) REFERENCES aqbooksellers ( id ), + CONSTRAINT emfk_edi_acct FOREIGN KEY ( edi_acct ) REFERENCES vendor_edi_accounts ( id ), + CONSTRAINT emfk_basketno FOREIGN KEY ( basketno ) REFERENCES aqbasket ( basketno ) +) ENGINE=InnoDB DEFAULT CHARSET=utf8 COLLATE=utf8_unicode_ci; + -- -- Table structure for table aqinvoices -- @@ -3183,8 +3243,10 @@ CREATE TABLE aqinvoices ( closedate date default NULL, -- invoice close date, NULL means the invoice is open shipmentcost decimal(28,6) default NULL, -- shipment cost shipmentcost_budgetid int(11) default NULL, -- foreign key to aqbudgets, link the shipment cost to a budget + message_id int(11) default NULL, -- foreign key to edifact invoice message PRIMARY KEY (invoiceid), CONSTRAINT aqinvoices_fk_aqbooksellerid FOREIGN KEY (booksellerid) REFERENCES aqbooksellers (id) ON DELETE CASCADE ON UPDATE CASCADE, + CONSTRAINT edifact_msg_fk FOREIGN KEY ( message_id ) REFERENCES edifact_messages ( id ) ON DELETE SET NULL, CONSTRAINT aqinvoices_fk_shipmentcost_budgetid FOREIGN KEY (shipmentcost_budgetid) REFERENCES aqbudgets (budget_id) ON DELETE SET NULL ON UPDATE CASCADE ) ENGINE=InnoDB DEFAULT CHARSET=utf8 COLLATE=utf8_unicode_ci; @@ -3646,6 +3708,20 @@ CREATE TABLE audio_alerts ( KEY precedence (precedence) ) ENGINE=InnoDB DEFAULT CHARSET=utf8 COLLATE=utf8_unicode_ci; +-- +-- Table structure for table 'edifact_ean' +-- + +DROP TABLE IF EXISTS edifact_ean; +CREATE TABLE IF NOT EXISTS edifact_ean ( + ee_id int(11) NOT NULL AUTO_INCREMENT, + branchcode varchar(10) not null references branches (branchcode), + ean varchar(15) NOT NULL, + id_code_qualifier varchar(3) NOT NULL default '14', + PRIMARY KEY (ee_id), + CONSTRAINT efk_branchcode FOREIGN KEY ( branchcode ) REFERENCES branches ( branchcode ) +) ENGINE=InnoDB DEFAULT CHARSET=utf8 COLLATE=utf8_unicode_ci; + /*!40103 SET TIME_ZONE=@OLD_TIME_ZONE */; /*!40101 SET SQL_MODE=@OLD_SQL_MODE */; /*!40014 SET FOREIGN_KEY_CHECKS=@OLD_FOREIGN_KEY_CHECKS */; diff --git a/installer/data/mysql/sysprefs.sql b/installer/data/mysql/sysprefs.sql index 3e6287b445..91050ae728 100644 --- a/installer/data/mysql/sysprefs.sql +++ b/installer/data/mysql/sysprefs.sql @@ -131,6 +131,7 @@ INSERT INTO systempreferences ( `variable`, `value`, `options`, `explanation`, ` ('DumpTemplateVarsIntranet', '0', NULL , 'If enabled, dump all Template Toolkit variable to a comment in the html source for the staff intranet.', 'YesNo'), ('DumpTemplateVarsOpac', '0', NULL , 'If enabled, dump all Template Toolkit variable to a comment in the html source for the opac.', 'YesNo'), ('EasyAnalyticalRecords','0','','If on, display in the catalogue screens tools to easily setup analytical record relationships','YesNo'), +('EDIInvoicesShippingBudget',NULL,NULL,'The budget code used to allocate shipping charges to when processing EDI Invoice messages','free'), ('emailLibrarianWhenHoldIsPlaced','0',NULL,'If ON, emails the librarian whenever a hold is placed','YesNo'), ('EnableAdvancedCatalogingEditor','0','','Enable the Rancor advanced cataloging editor','YesNo'), ('EnableBorrowerFiles','0',NULL,'If enabled, allows librarians to upload and attach arbitrary files to a borrower record.','YesNo'), diff --git a/installer/data/mysql/userpermissions.sql b/installer/data/mysql/userpermissions.sql index 268e9e63cc..abeeb3a05c 100644 --- a/installer/data/mysql/userpermissions.sql +++ b/installer/data/mysql/userpermissions.sql @@ -28,6 +28,7 @@ INSERT INTO permissions (module_bit, code, description) VALUES (11, 'order_receive', 'Manage orders & basket'), (11, 'budget_add_del', 'Add and delete budgets (but can''t modify budgets)'), (11, 'budget_manage_all', 'Manage all budgets'), + (11, 'edi_manage', 'Manage EDIFACT transmissions'), (13, 'edit_news', 'Write news for the OPAC and staff interfaces'), (13, 'label_creator', 'Create printable labels and barcodes from catalog and patron data'), (13, 'edit_calendar', 'Define days when the library is closed'), diff --git a/koha-tmpl/intranet-tmpl/prog/en/includes/acquisitions-menu.inc b/koha-tmpl/intranet-tmpl/prog/en/includes/acquisitions-menu.inc index 439118d3d1..c33d6d4d92 100644 --- a/koha-tmpl/intranet-tmpl/prog/en/includes/acquisitions-menu.inc +++ b/koha-tmpl/intranet-tmpl/prog/en/includes/acquisitions-menu.inc @@ -9,4 +9,7 @@ [% IF ( CAN_user_parameters ) %]
  • Currencies
    • [% END %] + [% IF CAN_user_acquisition_edi_manage %] +
  • Edifact Messages
    • + [% END %] diff --git a/koha-tmpl/intranet-tmpl/prog/en/includes/admin-menu.inc b/koha-tmpl/intranet-tmpl/prog/en/includes/admin-menu.inc index 050bfbb3d6..8a21712c93 100644 --- a/koha-tmpl/intranet-tmpl/prog/en/includes/admin-menu.inc +++ b/koha-tmpl/intranet-tmpl/prog/en/includes/admin-menu.inc @@ -55,6 +55,8 @@
  • Currencies and exchange rates
  • Budgets
  • Funds
    • +
  • EDI accounts
    • +
  • EDI eans
    • [% IF CAN_user_plugins %] diff --git a/koha-tmpl/intranet-tmpl/prog/en/modules/acqui/basket.tt b/koha-tmpl/intranet-tmpl/prog/en/modules/acqui/basket.tt index 7bcbbbe762..9ab28bed08 100644 --- a/koha-tmpl/intranet-tmpl/prog/en/modules/acqui/basket.tt +++ b/koha-tmpl/intranet-tmpl/prog/en/modules/acqui/basket.tt @@ -51,6 +51,13 @@ window.open(url, 'TransferOrder','width=600,height=400,toolbar=false,scrollbars=yes'); } + function confirm_ediorder() { + var is_confirmed = confirm(_("Are you sure you want to close this basket and generate an Edifact order?")); + if (is_confirmed) { + window.location = "[% script_name %]?op=edi_confirm&basketno=[% basketno %]"; + } + } + //]]> [% ELSE %] @@ -157,7 +164,7 @@ [% ELSE %]
    - [% UNLESS ( confirm_close ) %] + [% IF !confirm_close && !edi_confirm %] [% UNLESS ( selectbasketg ) %] [% UNLESS ( closedate ) %]
    @@ -176,6 +183,9 @@
    [% END %]
    Export this basket as CSV
    + [% IF ediaccount %] +
    Create edifact order
    + [% END %]
    [% END %] +[% IF edi_confirm %] +
    + +
    +

    Are you sure you want to generate an edifact order and close basket [% basketname|html %]?

    + [% IF CAN_user_acquisition_group_manage %] +

    + + +

    + [% END %] + + + + + + + + +
    +
    + [% END %] [% END %][%# IF (cannot_manage_basket) %] diff --git a/koha-tmpl/intranet-tmpl/prog/en/modules/acqui/basketgroup.tt b/koha-tmpl/intranet-tmpl/prog/en/modules/acqui/basketgroup.tt index 82c82ca589..e2dac37b56 100644 --- a/koha-tmpl/intranet-tmpl/prog/en/modules/acqui/basketgroup.tt +++ b/koha-tmpl/intranet-tmpl/prog/en/modules/acqui/basketgroup.tt @@ -144,6 +144,7 @@ function submitForm(form) {
    Reopen this basket group
    Export this basket group as CSV
    Print this basket group in PDF
    +
    Generate edifact order
    [% ELSE %]
    Delete basket group
    @@ -380,6 +381,7 @@ function submitForm(form) {
    +
    [% END %] diff --git a/koha-tmpl/intranet-tmpl/prog/en/modules/acqui/edi_ean.tt b/koha-tmpl/intranet-tmpl/prog/en/modules/acqui/edi_ean.tt new file mode 100644 index 0000000000..bd30e0870c --- /dev/null +++ b/koha-tmpl/intranet-tmpl/prog/en/modules/acqui/edi_ean.tt @@ -0,0 +1,38 @@ +[% INCLUDE 'doc-head-open.inc' %] +Koha › Acquisitions › Basket ([% basketno %]) +[% INCLUDE 'doc-head-close.inc' %] + + + +[% INCLUDE 'header.inc' %] +[% INCLUDE 'acquisitions-search.inc' %] + + + +
    + +
    +
    +
    + +

    Identify the branch account submitting the EDI order

    +
    +
    +

    Select ordering branch account:

    + +
    + + + +
    +
    +
    +
    +[% INCLUDE 'acquisitions-menu.inc' %] +
    +
    +[% INCLUDE 'intranet-bottom.inc' %] diff --git a/koha-tmpl/intranet-tmpl/prog/en/modules/acqui/edifactmsgs.tt b/koha-tmpl/intranet-tmpl/prog/en/modules/acqui/edifactmsgs.tt new file mode 100644 index 0000000000..168b12a814 --- /dev/null +++ b/koha-tmpl/intranet-tmpl/prog/en/modules/acqui/edifactmsgs.tt @@ -0,0 +1,90 @@ +[% INCLUDE 'doc-head-open.inc' %] +Koha › Acquisitions + +[% INCLUDE 'doc-head-close.inc' %] +[% INCLUDE 'datatables.inc' %] + + + + +[% INCLUDE 'header.inc' %] +[% INCLUDE 'acquisitions-search.inc' %] + + +
    + +
    +
    +
    + + +

    Edifact Messages

    +
    + + + + + + + + + + + + + + +[% FOREACH msg IN messages %] + + + + + + + + + + + +[% END %] + + +
    TypeTransferredStatusVendorDetailsFilename Action
    [% msg.message_type %][% msg.transfer_date %][% msg.status %] + +[% msg.vendor.name %] + +[% IF msg.message_type == 'QUOTE' || msg.message_type == 'ORDERS' %] + [% IF msg.basketno %] + + Basket: [% msg.basketno.basketno %] + + [% END %] +[% ELSE %] + + + Invoices + +[% END %] +[% msg.filename %]View Message +Delete +
    + +
    +
    +
    +
    +[% INCLUDE 'acquisitions-menu.inc' %] +
    +
    +[% INCLUDE 'intranet-bottom.inc' %] diff --git a/koha-tmpl/intranet-tmpl/prog/en/modules/acqui/edimsg.tt b/koha-tmpl/intranet-tmpl/prog/en/modules/acqui/edimsg.tt new file mode 100644 index 0000000000..508ddc2753 --- /dev/null +++ b/koha-tmpl/intranet-tmpl/prog/en/modules/acqui/edimsg.tt @@ -0,0 +1,35 @@ +[% INCLUDE 'doc-head-open.inc' %] +Koha › Acquisitions › Edifact Message Display +[% INCLUDE 'doc-head-close.inc' %] + + +[% INCLUDE 'header.inc' %] +[% INCLUDE 'acquisitions-search.inc' %] + + +
    + +[% IF no_message %] +
    The requested message cannot be displayed
    +[% ELSE %] +
    +
    +
    +
      + [% FOREACH seg IN segments %] +
    • [% seg | html %]
      • + [% END %] +
    +[% END %] + +
    +
    +
    +[% INCLUDE 'acquisitions-menu.inc' %] +
    +
    +[% INCLUDE 'intranet-bottom.inc' %] diff --git a/koha-tmpl/intranet-tmpl/prog/en/modules/admin/admin-home.tt b/koha-tmpl/intranet-tmpl/prog/en/modules/admin/admin-home.tt index eea0b0d78c..083902a79a 100644 --- a/koha-tmpl/intranet-tmpl/prog/en/modules/admin/admin-home.tt +++ b/koha-tmpl/intranet-tmpl/prog/en/modules/admin/admin-home.tt @@ -97,6 +97,11 @@
    Funds
    Define funds within your budgets
    + +
    EDI Accounts
    +
    Manage vendor EDI accounts for import/export
    +
    EDI EANs
    +
    Manage Branch EDI EANs

    Additional parameters

    diff --git a/koha-tmpl/intranet-tmpl/prog/en/modules/admin/edi_accounts.tt b/koha-tmpl/intranet-tmpl/prog/en/modules/admin/edi_accounts.tt new file mode 100644 index 0000000000..d7e46ee48d --- /dev/null +++ b/koha-tmpl/intranet-tmpl/prog/en/modules/admin/edi_accounts.tt @@ -0,0 +1,299 @@ +[% INCLUDE 'doc-head-open.inc' %] +Koha › Administration › EDI accounts +[% IF acct_form %] + [% IF account %] + ’ Modify account + [% ELSE %] + ’ Add new account + [% END %] +[% END %] +[% IF delete_confirm %] + ’ Confirm deletion of account +[% END %] + +[% INCLUDE 'doc-head-close.inc' %] + + +[% INCLUDE 'header.inc' %] +[% INCLUDE 'cat-search.inc' %] + + + +
    + +
    +
    +
    +[% IF display %] + +[% END %] + +[% IF acct_form %] +
    + + [% IF account %] + + [% END %] +
    + + [% IF account %] + Modify account + [% ELSE %] + New account + [% END %] + + +
      +
    1. + + +
      2. +
    2. + + +
      3. +
    3. + [% transport_types = [ + 'FTP', 'SFTP', 'FILE' + ] + %] + + +
      4. +
    4. + + +
      5. +
    5. + + +
      6. +
    6. + + +
      7. +
    7. + + +
      8. +
    8. + + +
      9. +
    9. + + +
      10. +
    10. + + +
      11. +
    11. + + [% IF account.quotes_enabled %] + + [% ELSE %] + + [% END %] +
      12. +
    12. + +[% IF account.orders_enabled %] + +[% ELSE %] + +[% END %] +
      13. +
    13. + +[% IF account.invoices_enabled %] + +[% ELSE %] + +[% END %] +
      14. +
    14. + +[% IF account.responses_enabled %] + +[% ELSE %] + +[% END %] +
      15. +
    15. + +[% IF account.auto_orders %] + +[% ELSE %] + +[% END %] +
      16. +
    +
    + +
    + + Cancel +
    +
    + +[% END %] +[% IF delete_confirm %] +
    +

    Delete this account?

    + + + + + + + + + + + + + +
    Vendor[% account.vendor %]
    Description[% account.description %]
    SAN[% account.san %]
    +
    + +
    + + + +
    +
    + +
    +[% END %] +[% IF display %] +

    Vendor EDI accounts

    + + + + + + + + + + + + + + + + + + + + + + [% FOREACH account IN ediaccounts %] + [% IF loop.even %] + [% ELSE %] + [% END %] + + + + + + + + + + + + [% IF account.quotes_enabled %] + + [% ELSE %] + + [% END %] + [% IF account.orders_enabled %] + + [% ELSE %] + + [% END %] + [% IF account.invoices_enabled %] + + [% ELSE %] + + [% END %] + [% IF account.responses_enabled %] + + [% ELSE %] + + [% END %] + [% IF account.auto_orders %] + + [% ELSE %] + + [% END %] + + + [% END %] +
    IDVendorDescriptionTransportRemote hostUsernamePasswordDownload DirectoryUpload Directoryid_code_typeid_codeQuotesOrdersInvoicesResponsesAuto orderingActions
    [% account.id %][% account.vendor.name %][% account.description %][% account.transport %][% account.host %][% account.username %][% IF account.password %]xxxxx[% END %][% account.download_directory %][% account.upload_directory %][% account.id_code_qualifier %][% account.san %]YNYNYNYNYN + Edit | Delete +
    +[% END %] + +
    +
    +
    + [% INCLUDE 'admin-menu.inc' %] +
    +
    +[% INCLUDE 'intranet-bottom.inc' %] diff --git a/koha-tmpl/intranet-tmpl/prog/en/modules/admin/edi_ean_accounts.tt b/koha-tmpl/intranet-tmpl/prog/en/modules/admin/edi_ean_accounts.tt new file mode 100644 index 0000000000..16219b2691 --- /dev/null +++ b/koha-tmpl/intranet-tmpl/prog/en/modules/admin/edi_ean_accounts.tt @@ -0,0 +1,153 @@ +[% INCLUDE 'doc-head-open.inc' %] +Koha › Administration › EDI EANs +[% IF ean_form %] + [% IF ean %] + ’ Modify branch EAN + [% ELSE %] + ’ Add new branch EAN + [% END %] +[% END %] +[% IF delete_confirm %] + ’ Confirm deletion of EAN +[% END %] + +[% INCLUDE 'doc-head-close.inc' %] + + +[% INCLUDE 'header.inc' %] +[% INCLUDE 'cat-search.inc' %] + + + +
    + +
    +
    +
    +[% IF display %] + +[% END %] + +[% IF ean_form %] +
    + + [% IF ean %] + + + [% END %] +
    + + [% IF ean %] + Modify EAN + [% ELSE %] + New EAN + [% END %] + + +
      +
    1. + + +
      2. +
    2. + + +
      3. +
    3. +
    +
    + +[% END %] +[% IF delete_confirm %] +
    +

    Delete EAN [% ean.ean %] for branch [% ean.branch.branchname %]?

    +
    + + + + +
    +
    + +
    +
    +[% END %] +[% IF display %] +

    Branch EANs

    + + + + + + + + [% FOREACH ean IN eans %] + [% IF loop.even %] + [% ELSE %] + [% END %] + + + + + + [% END %] +
    BranchEANCode TypeActions
    [% ean.branch.branchname %][% ean.ean %][% ean.id_code_qualifier %] + Edit | Delete
    +[% END %] + +
    +
    +
    + [% INCLUDE 'admin-menu.inc' %] +
    +
    +[% INCLUDE 'intranet-bottom.inc' %] diff --git a/koha-tmpl/intranet-tmpl/prog/en/modules/tools/tools-home.tt b/koha-tmpl/intranet-tmpl/prog/en/modules/tools/tools-home.tt index bb54f54642..514900a5cd 100644 --- a/koha-tmpl/intranet-tmpl/prog/en/modules/tools/tools-home.tt +++ b/koha-tmpl/intranet-tmpl/prog/en/modules/tools/tools-home.tt @@ -104,6 +104,11 @@
    Use tool plugins
    [% END %] + [% IF CAN_user_acquisition_edi_manage %] +
    EDIfact messages
    +
    Manage EDIfact transmissions
    + [% END %] +
    diff --git a/misc/cronjobs/edi_cron.pl b/misc/cronjobs/edi_cron.pl new file mode 100755 index 0000000000..8ba9a14c8c --- /dev/null +++ b/misc/cronjobs/edi_cron.pl @@ -0,0 +1,163 @@ +#!/usr/bin/perl +# +# Copyright 2013,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, write to the Free Software Foundation, Inc., +# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + +use warnings; +use strict; +use utf8; + +# Handles all the edi processing for a site +# loops through the vendor_edifact records and uploads and downloads +# edifact files if the appropriate type is enabled +# downloaded quotes, invoices and responses are processed here +# if orders are enabled and present they are generated and sent +# can be run as frequently as required +# log messages are appended to logdir/editrace.log + +use C4::Context; +use Log::Log4perl qw(:easy); +use Koha::Database; +use Koha::EDI qw( process_quote process_invoice process_ordrsp); +use Koha::Edifact::Transport; +use Fcntl qw( :DEFAULT :flock :seek ); + +my $logdir = C4::Context->logdir; + +# logging set to trace as this may be what you +# want on implementation +Log::Log4perl->easy_init( + { + level => $TRACE, + file => ">>$logdir/editrace.log", + } +); + +# we dont have a lock dir in context so use the logdir +my $pidfile = "$logdir/edicron.pid"; + +my $pid_handle = check_pidfile(); + +my $schema = Koha::Database->new()->schema(); + +my @edi_accts = $schema->resultset('VendorEdiAccount')->all(); + +my $logger = Log::Log4perl->get_logger(); + +for my $acct (@edi_accts) { + if ( $acct->quotes_enabled ) { + my $downloader = Koha::Edifact::Transport->new( $acct->id ); + $downloader->download_messages('QUOTE'); + + } + + if ( $acct->invoices_enabled ) { + my $downloader = Koha::Edifact::Transport->new( $acct->id ); + $downloader->download_messages('INVOICE'); + + } + if ( $acct->orders_enabled ) { + + # select pending messages + my @pending_orders = $schema->resultset('EdifactMessage')->search( + { + message_type => 'ORDERS', + vendor_id => $acct->vendor_id, + status => 'Pending', + } + ); + my $uploader = Koha::Edifact::Transport->new( $acct->id ); + $uploader->upload_messages(@pending_orders); + } + if ( $acct->responses_enabled ) { + my $downloader = Koha::Edifact::Transport->new( $acct->id ); + $downloader->download_messages('ORDRSP'); + } +} + +# process any downloaded quotes + +my @downloaded_quotes = $schema->resultset('EdifactMessage')->search( + { + message_type => 'QUOTE', + status => 'new', + } +)->all; + +foreach my $quote_file (@downloaded_quotes) { + my $filename = $quote_file->filename; + $logger->trace("Processing quote $filename"); + process_quote($quote_file); +} + +# process any downloaded invoices + +my @downloaded_invoices = $schema->resultset('EdifactMessage')->search( + { + message_type => 'INVOICE', + status => 'new', + } +)->all; + +foreach my $invoice (@downloaded_invoices) { + my $filename = $invoice->filename(); + $logger->trace("Processing invoice $filename"); + process_invoice($invoice); +} + +my @downloaded_responses = $schema->resultset('EdifactMessage')->search( + { + message_type => 'ORDRSP', + status => 'new', + } +)->all; + +foreach my $response (@downloaded_responses) { + my $filename = $response->filename(); + $logger->trace("Processing order response $filename"); + process_ordrsp($response); +} + +if ( close $pid_handle ) { + unlink $pidfile; + exit 0; +} +else { + $logger->error("Error on pidfile close: $!"); + exit 1; +} + +sub check_pidfile { + + # sysopen my $fh, $pidfile, O_EXCL | O_RDWR or log_exit "$0 already running" + sysopen my $fh, $pidfile, O_RDWR | O_CREAT + or log_exit("$0: open $pidfile: $!"); + flock $fh => LOCK_EX or log_exit("$0: flock $pidfile: $!"); + + sysseek $fh, 0, SEEK_SET or log_exit("$0: sysseek $pidfile: $!"); + truncate $fh, 0 or log_exit("$0: truncate $pidfile: $!"); + print $fh "$$\n" or log_exit("$0: print $pidfile: $!"); + + return $fh; +} + +sub log_exit { + my $error = shift; + $logger->error($error); + + exit 1; +} diff --git a/misc/cronjobs/remove_temporary_edifiles.pl b/misc/cronjobs/remove_temporary_edifiles.pl new file mode 100755 index 0000000000..e799ee5b2e --- /dev/null +++ b/misc/cronjobs/remove_temporary_edifiles.pl @@ -0,0 +1,41 @@ +#!/usr/bin/perl +use strict; +use warnings; + +use C4::Context; + +# this script will remove those older than 5 days +my $tmpdir = '/tmp'; +# +opendir( my $dh, $tmpdir) || die "Cannot open $tmpdir : $!"; + +my @files_in_tmp = grep { /\.CE[IQ]$/ && -f "$tmpdir/$_" } readdir($dh); +closedir $dh; + + +my $dbh = C4::Context->dbh; + +my $query =<<'ENDSQL'; +select filename from edifact_messages +where message_type IN ('QUOTE','INVOICE') +and datediff( CURDATE(), transfer_date ) > 5 +ENDSQL + +my $ingested; + +@{$ingested} = $dbh->selectcol_arrayref($query); + +my %ingested_hash = map { $_ => 1 } @{$ingested}; + +my @delete_list; + +foreach (@files_in_tmp) { + if ( exists $ingested_hash{$_} ) { + push @delete_list, $_; + } +} + +if ( @delete_list ) { + chdir $tmpdir; + unlink @delete_list; +} diff --git a/t/EdiInvoice.t b/t/EdiInvoice.t new file mode 100755 index 0000000000..14e7596486 --- /dev/null +++ b/t/EdiInvoice.t @@ -0,0 +1,75 @@ +#!/usr/bin/perl +use strict; +use warnings; +use FindBin qw( $Bin ); + +use Test::More tests => 19; + +BEGIN { use_ok('Koha::Edifact') } + +my $invoice_file = "$Bin/edi_testfiles/BLSINV337023.CEI"; + +my $invoice = Koha::Edifact->new( { filename => $invoice_file, } ); + +isa_ok( $invoice, 'Koha::Edifact' ); +my $x = $invoice->interchange_header('sender'); +my $control_reference = '337023'; +is( $x, '5013546025078', "sender returned" ); + +$x = $invoice->interchange_header('recipient'); +is( $x, '5013546121974', "recipient returned" ); +$x = $invoice->interchange_header('datetime'); +is( $x->[0], '140729', "datetime returned" ); +$x = $invoice->interchange_header('interchange_control_reference'); +is( $x, $control_reference, "interchange_control_reference returned" ); + +$x = $invoice->interchange_header('application_reference'); +is( $x, 'INVOIC', "application_reference returned" ); +$x = $invoice->interchange_trailer('interchange_control_count'); +is( $x, 6, "interchange_control_count returned" ); + +my $messages = $invoice->message_array(); + +# check inv number from BGM + +my $msg_count = @{$messages}; +is( $msg_count, 6, 'correct message count returned' ); + +is( $messages->[0]->message_type, 'INVOIC', 'Message shows correct type' ); + +my $expected_date = '20140729'; +is( $messages->[0]->message_date, + $expected_date, 'Message date correctly returned' ); +is( $messages->[0]->tax_point_date, + $expected_date, 'Tax point date correctly returned' ); + +my $expected_invoicenumber = '01975490'; + +my $invoicenumber = $messages->[1]->docmsg_number(); + +is( $messages->[0]->buyer_ean, '5013546121974', 'Buyer ean correct' ); +is( $messages->[0]->supplier_ean, '5013546025078', 'Supplier ean correct' ); + +is( $invoicenumber, $expected_invoicenumber, + 'correct invoicenumber extracted' ); + +my $lines = $messages->[1]->lineitems(); + +my $num_lines = @{$lines}; + +is( $num_lines, 8, "Correct number of lineitems returned" ); + +# sample invoice was from an early version where order was formatted basketno/ordernumber +my $expected_ordernumber = '2818/74593'; + +my $ordernumber = $lines->[7]->ordernumber; + +is( $ordernumber, $expected_ordernumber, 'correct ordernumber returned' ); + +my $lineprice = $lines->[7]->price_net; + +is( $lineprice, 4.55, 'correct net line price returned' ); + +my $tax = $lines->[7]->tax; + +is( $tax, 0, 'correct tax amount returned' ); diff --git a/t/Edifact.t b/t/Edifact.t new file mode 100755 index 0000000000..cc205393ae --- /dev/null +++ b/t/Edifact.t @@ -0,0 +1,121 @@ +#!/usr/bin/perl +use strict; +use warnings; +use FindBin qw( $Bin ); + +use Test::More tests => 34; + +BEGIN { use_ok('Koha::Edifact') } + +my $filename = "$Bin/edi_testfiles/prquotes_73050_20140430.CEQ"; + +my $quote = Koha::Edifact->new( { filename => $filename, } ); + +isa_ok( $quote, 'Koha::Edifact' ); + +my $x = $quote->interchange_header('sender'); +is( $x, '5013546027856', "sender returned" ); + +$x = $quote->interchange_header('recipient'); +is( $x, '5030670137480', "recipient returned" ); +$x = $quote->interchange_header('datetime'); +is( $x->[0], '140430', "datetime returned" ); +my $control_reference = 'EDIQ2857763'; +$x = $quote->interchange_header('interchange_control_reference'); +is( $x, $control_reference, "interchange_control_reference returned" ); + +$x = $quote->interchange_header('application_reference'); +is( $x, 'QUOTES', "application_reference returned" ); + +$x = $quote->interchange_trailer('interchange_control_count'); +is( $x, 1, "interchange_control_count returned" ); + +my $msgs = $quote->message_array(); +my $msg_count = @{$msgs}; +is( $msg_count, 1, "correct message count returned" ); +my $m = $msgs->[0]; + +is( $m->message_type, 'QUOTES', "Message shows correct type" ); +is( $m->message_reference_number, + 'MQ09791', "Message reference number returned" ); +is( $m->docmsg_number, 'Q741588', "Message docmsg number returned" ); +is( $m->message_date, '20140430', "Message date returned" ); + +my $lin = $m->lineitems(); + +my $num_lines = @{$lin}; +is( $num_lines, 18, 'Correct number of lines in message' ); + +my $test_line = $lin->[-1]; + +is( $test_line->line_item_number, 18, 'correct line number returned' ); +is( $test_line->item_number_id, '9780273761006', 'correct ean returned' ); +is( $test_line->quantity, 1, 'quantity returned' ); + +my $test_title = 'International business [electronic resource]'; +my $marcrec = $test_line->marc_record; +isa_ok( $marcrec, 'MARC::Record' ); + +my $title = $test_line->title(); + +# also tests components are concatenated +is( $title, $test_title, "Title returned" ); + +# problems currently with the record (needs leader ??) +#is( $marcrec->title(), $test_title, "Title returned from marc"); +my $test_author = q{Rugman, Alan M.}; +is( $test_line->author, $test_author, "Author returned" ); +is( $test_line->publisher, 'Pearson Education', "Publisher returned" ); +is( $test_line->publication_date, q{2012.}, "Pub. date returned" ); +# +# Test data encoded in GIR +# +my $stock_category = $test_line->girfield('stock_category'); +is( $stock_category, 'EBOOK', "stock_category returned" ); +my $branch = $test_line->girfield('branch'); +is( $branch, 'ELIB', "branch returned" ); +my $fund_allocation = $test_line->girfield('fund_allocation'); +is( $fund_allocation, '660BOO_2013', "fund_allocation returned" ); +my $collection_code = $test_line->girfield('collection_code'); +is( $collection_code, 'EBOO', "collection_code returned" ); + +#my $shelfmark = $test_line->girfield('shelfmark'); +#my $classification = $test_line->girfield('classification'); + +## text the free_text returned from the line +my $test_line_2 = $lin->[12]; + +my $ftx_string = 'E*610.72* - additional items'; + +is( $test_line_2->orderline_free_text, $ftx_string, "ftx note retrieved" ); + +my $filename2 = "$Bin/edi_testfiles/QUOTES_413514.CEQ"; + +my $q2 = Koha::Edifact->new( { filename => $filename2, } ); +my $messages = $q2->message_array(); + +my $orderlines = $messages->[0]->lineitems(); + +my $ol = $orderlines->[0]; + +my $y = $ol->girfield( 'copy_value', 5 ); + +is( $y, undef, 'No extra item generated' ); + +$y = $ol->girfield( 'copy_value', 1 ); +is( $y, '16.99', 'Copy Price returned' ); + +$y = $ol->girfield( 'classification', 4 ); +is( $y, '914.1061', 'Copy classification returned' ); + +$y = $ol->girfield( 'fund_allocation', 4 ); +is( $y, 'REF', 'Copy fund returned' ); + +$y = $ol->girfield( 'branch', 4 ); +is( $y, 'SOU', 'Copy Branch returned' ); + +$y = $ol->girfield( 'collection_code', 4 ); +is( $y, 'ANF', 'Collection code returned' ); + +$y = $ol->girfield( 'stock_category', 4 ); +is( $y, 'RS', 'Copy stock category returned' ); diff --git a/t/Ediorder.t b/t/Ediorder.t new file mode 100755 index 0000000000..5332f0c5ae --- /dev/null +++ b/t/Ediorder.t @@ -0,0 +1,56 @@ +#!/usr/bin/perl +use strict; +use warnings; +use FindBin qw( $Bin ); + +use Test::More tests => 6; + +BEGIN { use_ok('Koha::Edifact::Order') } + + +# The following tests are for internal methods but they could +# error spectacularly so yest +# Check that quoting is done correctly +# +my $processed_text = + Koha::Edifact::Order::encode_text(q{string containing ?,',:,+}); + +cmp_ok( + $processed_text, 'eq', + q{string containing ??,?',?:,?+}, + 'Outgoing text correctly quoted' +); + +# extend above test to test chunking in imd_segment +# +my $code = '010'; +my $data_to_encode = $processed_text; + +my @segs = Koha::Edifact::Order::imd_segment( $code, $data_to_encode ); + +my $testseg = "IMD+L+010+:::$processed_text"; +$testseg .= q{'}; # add segment terminator + +cmp_ok( $segs[0], 'eq', $testseg, 'IMD segment correctly formed' ); + +$data_to_encode = 'A' x 35; +$data_to_encode .= 'B' x 35; +$data_to_encode .= 'C' x 10; + +@segs = Koha::Edifact::Order::imd_segment( $code, $data_to_encode ); + +cmp_ok( + $segs[0], + 'eq', +q{IMD+L+010+:::AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA:BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB'}, + 'IMD segment correctly chunked' +); +cmp_ok( $segs[1], 'eq', q{IMD+L+010+:::CCCCCCCCCC'}, + 'IMD segment correctly split across segments' ); + +$data_to_encode .= '??'; + +# this used to cause an infinite loop +@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 character at end' ); diff --git a/t/Ediordrsp.t b/t/Ediordrsp.t new file mode 100755 index 0000000000..6d410dc8b8 --- /dev/null +++ b/t/Ediordrsp.t @@ -0,0 +1,59 @@ +#!/usr/bin/perl +use strict; +use warnings; +use FindBin qw( $Bin ); + +use Test::More tests => 16; + +BEGIN { use_ok('Koha::Edifact') } + +my $filedir = "$Bin/edi_testfiles"; + +my @files = map { "$filedir/$_" } + ( 'ordrsp1.CEA', 'ordrsp2.CEA', 'ordrsp3.CEA', 'ordrsp4.CEA' ); + +my @responses; +for my $filename (@files) { + + my $order_response = Koha::Edifact->new( { filename => $filename, } ); + + isa_ok( $order_response, 'Koha::Edifact' ); + push @responses, $order_response; +} + +# tests on file 1 +# Order accepted with amendments +my $order_response = $responses[0]; + +my $msg = $order_response->message_array(); +my $no_of_msg = @{$msg}; +is( $no_of_msg, 1, "Correct number of messages returned" ); + +isa_ok( $msg->[0], 'Koha::Edifact::Message' ); + +my $lines = $msg->[0]->lineitems(); + +my $no_of_lines = @{$lines}; + +is( $no_of_lines, 3, "Correct number of orderlines returned" ); + +# +is( $lines->[0]->ordernumber(), 'P28837', 'Line 1 correct ordernumber' ); +is( + $lines->[0]->coded_orderline_text(), + 'Not yet published', + 'NP returned and translated' +); + +is( $lines->[1]->ordernumber(), 'P28838', 'Line 2 correct ordernumber' ); +is( $lines->[1]->action_notification(), + 'cancelled', 'Cancelled action returned' ); +is( $lines->[1]->coded_orderline_text(), + 'Out of print', 'OP returned and translated' ); + +is( $lines->[2]->ordernumber(), 'P28846', 'Line 3 correct ordernumber' ); +is( $lines->[2]->action_notification(), + 'recorded', 'Accepted with change action returned' ); + +is( $lines->[0]->availability_date(), '19971120', + 'Availability date returned' ); diff --git a/t/edi_testfiles/BLSINV337023.CEI b/t/edi_testfiles/BLSINV337023.CEI new file mode 100644 index 0000000000..f8cdacf744 --- /dev/null +++ b/t/edi_testfiles/BLSINV337023.CEI @@ -0,0 +1 @@ +UNA:+.? 'UNB+UNOC:3+5013546025078+5013546121974+140729:1153+337023++INVOIC'UNH+01975489+INVOIC:D:96A:UN:EAN008'BGM+380+01975489+43'DTM+131:20140729:102'DTM+137:20140729:102'RFF+DQ:01975489'NAD+BY+5013546121974::9'NAD+SU+5013546025078::9'CUX+2:GBP:4'PAT+1++5:3:D:30'LIN+1++9780007464593:EN'IMD+L+009+:::Beukes, Lauren'IMD+L+050+:::Broken monsters'QTY+47:1'GIR+001+34148009564714:LAC+WID:LLO+JUN-NF:LSQ'MOA+203:7.4'MOA+52:5.59'PRI+AAA:7.4'PRI+AAB:12.99'RFF+LI:2724/71178'TAX+7+VAT+++:::0+Z'MOA+124:0'ALC+A++++DI::28'PCD+3:43'MOA+8:5.59'TAX+7+VAT+++:::0+Z'UNS+S'CNT+2:1'MOA+129:7.4'MOA+9:7.4'TAX+7+VAT+++:::0+Z'MOA+125:7.4'MOA+124:0'UNT+33+01975489'UNH+01975490+INVOIC:D:96A:UN:EAN008'BGM+380+01975490+43'DTM+131:20140729:102'DTM+137:20140729:102'RFF+DQ:01975490'NAD+BY+5013546121974::9'NAD+SU+5013546025078::9'CUX+2:GBP:4'PAT+1++5:3:D:30'LIN+1++9780755380664:EN'IMD+L+009+:::McDermott, Andy'IMD+L+050+:::The Valhalla prophecy'QTY+47:1'GIR+001+34148009564730:LAC+DIT:LLO+JUN-NF:LSQ'MOA+203:3.98'MOA+52:3.01'PRI+AAA:3.98'PRI+AAB:6.99'RFF+LI:2818/74528'TAX+7+VAT+++:::0+Z'MOA+124:0'ALC+A++++DI::28'PCD+3:43'MOA+8:3.01'TAX+7+VAT+++:::0+Z'LIN+2++9780755380664:EN'IMD+L+009+:::McDermott, Andy'IMD+L+050+:::The Valhalla prophecy'QTY+47:1'GIR+001+34148009564748:LAC+HLE:LLO+JUN-NF:LSQ'MOA+203:3.98'MOA+52:3.01'PRI+AAA:3.98'PRI+AAB:6.99'RFF+LI:2818/74529'TAX+7+VAT+++:::0+Z'MOA+124:0'ALC+A++++DI::28'PCD+3:43'MOA+8:3.01'TAX+7+VAT+++:::0+Z'LIN+3++9780857204028:EN'IMD+L+009+:::Fleming, Leah'IMD+L+050+:::The postcard'QTY+47:1'GIR+001+34148009564722:LAC+HLE:LLO+JUN-NF:LSQ'MOA+203:4.55'MOA+52:3.44'PRI+AAA:4.55'PRI+AAB:7.99'RFF+LI:2818/74544'TAX+7+VAT+++:::0+Z'MOA+124:0'ALC+A++++DI::28'PCD+3:43'MOA+8:3.44'TAX+7+VAT+++:::0+Z'LIN+4++9781471112652:EN'IMD+L+009+:::Madeley, Richard'IMD+L+050+:::The way you look tonight'QTY+47:1'GIR+001+34148009564755:LAC+DIT:LLO+JUN-NF:LSQ'MOA+203:4.55'MOA+52:3.44'PRI+AAA:4.55'PRI+AAB:7.99'RFF+LI:2818/74589'TAX+7+VAT+++:::0+Z'MOA+124:0'ALC+A++++DI::28'PCD+3:43'MOA+8:3.44'TAX+7+VAT+++:::0+Z'LIN+5++9781471112652:EN'IMD+L+009+:::Madeley, Richard'IMD+L+050+:::The way you look tonight'QTY+47:1'GIR+001+34148009564763:LAC+HLE:LLO+JUN-NF:LSQ'MOA+203:4.55'MOA+52:3.44'PRI+AAA:4.55'PRI+AAB:7.99'RFF+LI:2818/74590'TAX+7+VAT+++:::0+Z'MOA+124:0'ALC+A++++DI::28'PCD+3:43'MOA+8:3.44'TAX+7+VAT+++:::0+Z'LIN+6++9781471112652:EN'IMD+L+009+:::Madeley, Richard'IMD+L+050+:::The way you look tonight'QTY+47:1'GIR+001+34148009564771:LAC+MOB:LLO+JUN-NF:LSQ'MOA+203:4.55'MOA+52:3.44'PRI+AAA:4.55'PRI+AAB:7.99'RFF+LI:2818/74591'TAX+7+VAT+++:::0+Z'MOA+124:0'ALC+A++++DI::28'PCD+3:43'MOA+8:3.44'TAX+7+VAT+++:::0+Z'LIN+7++9781471112652:EN'IMD+L+009+:::Madeley, Richard'IMD+L+050+:::The way you look tonight'QTY+47:1'GIR+001+34148009564789:LAC+RUN:LLO+JUN-NF:LSQ'MOA+203:4.55'MOA+52:3.44'PRI+AAA:4.55'PRI+AAB:7.99'RFF+LI:2818/74592'TAX+7+VAT+++:::0+Z'MOA+124:0'ALC+A++++DI::28'PCD+3:43'MOA+8:3.44'TAX+7+VAT+++:::0+Z'LIN+8++9781471112652:EN'IMD+L+009+:::Madeley, Richard'IMD+L+050+:::The way you look tonight'QTY+47:1'GIR+001+34148009564797:LAC+WID:LLO+JUN-NF:LSQ'MOA+203:4.55'MOA+52:3.44'PRI+AAA:4.55'PRI+AAB:7.99'RFF+LI:2818/74593'TAX+7+VAT+++:::0+Z'MOA+124:0'ALC+A++++DI::28'PCD+3:43'MOA+8:3.44'TAX+7+VAT+++:::0+Z'UNS+S'CNT+2:8'MOA+129:35.260'MOA+9:35.260'TAX+7+VAT+++:::0+Z'MOA+125:35.260'MOA+124:0'UNT+145+01975490'UNH+01975491+INVOIC:D:96A:UN:EAN008'BGM+380+01975491+43'DTM+131:20140729:102'DTM+137:20140729:102'RFF+DQ:01975491'NAD+BY+5013546121974::9'NAD+SU+5013546025078::9'CUX+2:GBP:4'PAT+1++5:3:D:30'LIN+1++9781471132193:EN'IMD+L+009+:::Carter, Chris'IMD+L+050+:::An evil mind'QTY+47:1'GIR+001+34148009564821:LAC+HLE:LLO+JUN-NF:LSQ'MOA+203:7.4'MOA+52:5.59'PRI+AAA:7.4'PRI+AAB:12.99'RFF+LI:2831/74996'TAX+7+VAT+++:::0+Z'MOA+124:0'ALC+A++++DI::28'PCD+3:43'MOA+8:5.59'TAX+7+VAT+++:::0+Z'LIN+2++9781472208682:EN'IMD+L+009+:::Brown, Benita'IMD+L+050+:::Counting the days'QTY+47:1'GIR+001+34148009564805:LAC+HLE:LLO+JUN-NF:LSQ'MOA+203:11.39'MOA+52:8.6'PRI+AAA:11.39'PRI+AAB:19.99'RFF+LI:2831/75006'TAX+7+VAT+++:::0+Z'MOA+124:0'ALC+A++++DI::28'PCD+3:43'MOA+8:8.6'TAX+7+VAT+++:::0+Z'LIN+3++9781472208682:EN'IMD+L+009+:::Brown, Benita'IMD+L+050+:::Counting the days'QTY+47:1'GIR+001+34148009564813:LAC+WID:LLO+JUN-NF:LSQ'MOA+203:11.39'MOA+52:8.6'PRI+AAA:11.39'PRI+AAB:19.99'RFF+LI:2831/75007'TAX+7+VAT+++:::0+Z'MOA+124:0'ALC+A++++DI::28'PCD+3:43'MOA+8:8.6'TAX+7+VAT+++:::0+Z'UNS+S'CNT+2:3'MOA+129:30.180'MOA+9:30.180'TAX+7+VAT+++:::0+Z'MOA+125:30.180'MOA+124:0'UNT+65+01975491'UNH+01975492+INVOIC:D:96A:UN:EAN008'BGM+380+01975492+43'DTM+131:20140729:102'DTM+137:20140729:102'RFF+DQ:01975492'NAD+BY+5013546121974::9'NAD+SU+5013546025078::9'CUX+2:GBP:4'PAT+1++5:3:D:30'LIN+1++9780241957479:EN'IMD+L+009+:::Brook, Rhidian'IMD+L+050+:::The aftermath'QTY+47:1'GIR+001+34148009564839:LAC+WID:LLO+JUN-NF:LSQ'MOA+203:4.55'MOA+52:3.44'PRI+AAA:4.55'PRI+AAB:7.99'RFF+LI:2894/77394'TAX+7+VAT+++:::0+Z'MOA+124:0'ALC+A++++DI::28'PCD+3:43'MOA+8:3.44'TAX+7+VAT+++:::0+Z'UNS+S'CNT+2:1'MOA+129:4.550'MOA+9:4.550'TAX+7+VAT+++:::0+Z'MOA+125:4.550'MOA+124:0'UNT+33+01975492'UNH+01975493+INVOIC:D:96A:UN:EAN008'BGM+380+01975493+43'DTM+131:20140729:102'DTM+137:20140729:102'RFF+DQ:01975493'NAD+BY+5013546121974::9'NAD+SU+5013546025078::9'CUX+2:GBP:4'PAT+1++5:3:D:30'LIN+1++9780007513765:EN'IMD+L+009+:::Daywalt, Drew'IMD+L+050+:::The day the crayons quit'QTY+47:1'GIR+001+34148009564946:LAC+DIT:LLO+JUN-NF:LSQ'MOA+203:3.98'MOA+52:3.01'PRI+AAA:3.98'PRI+AAB:6.99'RFF+LI:2971/79232'TAX+7+VAT+++:::0+Z'MOA+124:0'ALC+A++++DI::28'PCD+3:43'MOA+8:3.01'TAX+7+VAT+++:::0+Z'LIN+2++9780007513765:EN'IMD+L+009+:::Daywalt, Drew'IMD+L+050+:::The day the crayons quit'QTY+47:1'GIR+001+34148009564953:LAC+HLE:LLO+JUN-NF:LSQ'MOA+203:3.98'MOA+52:3.01'PRI+AAA:3.98'PRI+AAB:6.99'RFF+LI:2971/79233'TAX+7+VAT+++:::0+Z'MOA+124:0'ALC+A++++DI::28'PCD+3:43'MOA+8:3.01'TAX+7+VAT+++:::0+Z'LIN+3++9780007513765:EN'IMD+L+009+:::Daywalt, Drew'IMD+L+050+:::The day the crayons quit'QTY+47:1'GIR+001+34148009564961:LAC+WID:LLO+JUN-NF:LSQ'MOA+203:3.98'MOA+52:3.01'PRI+AAA:3.98'PRI+AAB:6.99'RFF+LI:2971/79234'TAX+7+VAT+++:::0+Z'MOA+124:0'ALC+A++++DI::28'PCD+3:43'MOA+8:3.01'TAX+7+VAT+++:::0+Z'LIN+4++9780340981283:EN'IMD+L+009+:::Kelly, Mij'IMD+L+050+:::Friendly Day'QTY+47:1'GIR+001+34148009564979:LAC+DIT:LLO+JUN-NF:LSQ'MOA+203:3.98'MOA+52:3.01'PRI+AAA:3.98'PRI+AAB:6.99'RFF+LI:2971/79276'TAX+7+VAT+++:::0+Z'MOA+124:0'ALC+A++++DI::28'PCD+3:43'MOA+8:3.01'TAX+7+VAT+++:::0+Z'LIN+5++9780340981283:EN'IMD+L+009+:::Kelly, Mij'IMD+L+050+:::Friendly Day'QTY+47:1'GIR+001+34148009564987:LAC+MOB:LLO+JUN-NF:LSQ'MOA+203:3.98'MOA+52:3.01'PRI+AAA:3.98'PRI+AAB:6.99'RFF+LI:2971/79277'TAX+7+VAT+++:::0+Z'MOA+124:0'ALC+A++++DI::28'PCD+3:43'MOA+8:3.01'TAX+7+VAT+++:::0+Z'LIN+6++9780340981283:EN'IMD+L+009+:::Kelly, Mij'IMD+L+050+:::Friendly Day'QTY+47:1'GIR+001+34148009564995:LAC+WID:LLO+JUN-NF:LSQ'MOA+203:3.98'MOA+52:3.01'PRI+AAA:3.98'PRI+AAB:6.99'RFF+LI:2971/79278'TAX+7+VAT+++:::0+Z'MOA+124:0'ALC+A++++DI::28'PCD+3:43'MOA+8:3.01'TAX+7+VAT+++:::0+Z'LIN+7++9780349002071:EN'IMD+L+009+:::Cast, P. C.'IMD+L+050+:::Kalona s fall'QTY+47:1'GIR+001+34148009564920:LAC+HLE:LLO+JUN-NF:LSQ'MOA+203:3.41'MOA+52:2.58'PRI+AAA:3.41'PRI+AAB:5.99'RFF+LI:2971/78995'TAX+7+VAT+++:::0+Z'MOA+124:0'ALC+A++++DI::28'PCD+3:43'MOA+8:2.58'TAX+7+VAT+++:::0+Z'LIN+8++9780349002071:EN'IMD+L+009+:::Cast, P. C.'IMD+L+050+:::Kalona s fall'QTY+47:1'GIR+001+34148009564938:LAC+WID:LLO+JUN-NF:LSQ'MOA+203:3.41'MOA+52:2.58'PRI+AAA:3.41'PRI+AAB:5.99'RFF+LI:2971/78996'TAX+7+VAT+++:::0+Z'MOA+124:0'ALC+A++++DI::28'PCD+3:43'MOA+8:2.58'TAX+7+VAT+++:::0+Z'LIN+9++9781405267212:EN'IMD+L+009+:::McKay, Hilary'IMD+L+050+:::Tilly and the dragon'QTY+47:1'GIR+001+34148009565026:LAC+HLE:LLO+JUN-NF:LSQ'MOA+203:2.84'MOA+52:2.15'PRI+AAA:2.84'PRI+AAB:4.99'RFF+LI:2971/79301'TAX+7+VAT+++:::0+Z'MOA+124:0'ALC+A++++DI::28'PCD+3:43'MOA+8:2.15'TAX+7+VAT+++:::0+Z'LIN+10++9781405267212:EN'IMD+L+009+:::McKay, Hilary'IMD+L+050+:::Tilly and the dragon'QTY+47:1'GIR+001+34148009565034:LAC+MOB:LLO+JUN-NF:LSQ'MOA+203:2.84'MOA+52:2.15'PRI+AAA:2.84'PRI+AAB:4.99'RFF+LI:2971/79302'TAX+7+VAT+++:::0+Z'MOA+124:0'ALC+A++++DI::28'PCD+3:43'MOA+8:2.15'TAX+7+VAT+++:::0+Z'LIN+11++9781405267212:EN'IMD+L+009+:::McKay, Hilary'IMD+L+050+:::Tilly and the dragon'QTY+47:1'GIR+001+34148009565042:LAC+WID:LLO+JUN-NF:LSQ'MOA+203:2.84'MOA+52:2.15'PRI+AAA:2.84'PRI+AAB:4.99'RFF+LI:2971/79303'TAX+7+VAT+++:::0+Z'MOA+124:0'ALC+A++++DI::28'PCD+3:43'MOA+8:2.15'TAX+7+VAT+++:::0+Z'LIN+12++9781405268028:EN'IMD+L+009+:::Loser, Barry'IMD+L+050+:::Barry Loser and the holiday of doo'QTY+47:1'GIR+001+34148009565000:LAC+HLE:LLO+JUN-NF:LSQ'MOA+203:3.41'MOA+52:2.58'PRI+AAA:3.41'PRI+AAB:5.99'RFF+LI:2971/79304'TAX+7+VAT+++:::0+Z'MOA+124:0'ALC+A++++DI::28'PCD+3:43'MOA+8:2.58'TAX+7+VAT+++:::0+Z'LIN+13++9781405268028:EN'IMD+L+009+:::Loser, Barry'IMD+L+050+:::Barry Loser and the holiday of doo'QTY+47:1'GIR+001+34148009565018:LAC+WID:LLO+JUN-NF:LSQ'MOA+203:3.41'MOA+52:2.58'PRI+AAA:3.41'PRI+AAB:5.99'RFF+LI:2971/79305'TAX+7+VAT+++:::0+Z'MOA+124:0'ALC+A++++DI::28'PCD+3:43'MOA+8:2.58'TAX+7+VAT+++:::0+Z'LIN+14++9781405269094:EN'IMD+L+009+:::Monks, Lydia'IMD+L+050+:::Mungo Monkey goes to school'QTY+47:1'GIR+001+34148009565067:LAC+HLE:LLO+JUN-NF:LSQ'MOA+203:4.55'MOA+52:3.44'PRI+AAA:4.55'PRI+AAB:7.99'RFF+LI:2971/79307'TAX+7+VAT+++:::0+Z'MOA+124:0'ALC+A++++DI::28'PCD+3:43'MOA+8:3.44'TAX+7+VAT+++:::0+Z'LIN+15++9781405269094:EN'IMD+L+009+:::Monks, Lydia'IMD+L+050+:::Mungo Monkey goes to school'QTY+47:1'GIR+001+34148009565075:LAC+RUN:LLO+JUN-NF:LSQ'MOA+203:4.55'MOA+52:3.44'PRI+AAA:4.55'PRI+AAB:7.99'RFF+LI:2971/79308'TAX+7+VAT+++:::0+Z'MOA+124:0'ALC+A++++DI::28'PCD+3:43'MOA+8:3.44'TAX+7+VAT+++:::0+Z'LIN+16++9781407132846:EN'IMD+L+009+:::Simmons, Jo'IMD+L+050+:::A brotherly bother'QTY+47:1'GIR+001+34148009565117:LAC+HLE:LLO+JUN-NF:LSQ'MOA+203:2.84'MOA+52:2.15'PRI+AAA:2.84'PRI+AAB:4.99'RFF+LI:2971/79333'TAX+7+VAT+++:::0+Z'MOA+124:0'ALC+A++++DI::28'PCD+3:43'MOA+8:2.15'TAX+7+VAT+++:::0+Z'LIN+17++9781407132846:EN'IMD+L+009+:::Simmons, Jo'IMD+L+050+:::A brotherly bother'QTY+47:1'GIR+001+34148009565125:LAC+WID:LLO+JUN-NF:LSQ'MOA+203:2.84'MOA+52:2.15'PRI+AAA:2.84'PRI+AAB:4.99'RFF+LI:2971/79334'TAX+7+VAT+++:::0+Z'MOA+124:0'ALC+A++++DI::28'PCD+3:43'MOA+8:2.15'TAX+7+VAT+++:::0+Z'LIN+18++9781407142944:EN'IMD+L+009+:::Zucker, Jonny'IMD+L+050+:::The fleas who fight crime'QTY+47:1'GIR+001+34148009565158:LAC+HLE:LLO+JUN-NF:LSQ'MOA+203:2.84'MOA+52:2.15'PRI+AAA:2.84'PRI+AAB:4.99'RFF+LI:2971/79359'TAX+7+VAT+++:::0+Z'MOA+124:0'ALC+A++++DI::28'PCD+3:43'MOA+8:2.15'TAX+7+VAT+++:::0+Z'LIN+19++9781407142944:EN'IMD+L+009+:::Zucker, Jonny'IMD+L+050+:::The fleas who fight crime'QTY+47:1'GIR+001+34148009565166:LAC+WID:LLO+JUN-NF:LSQ'MOA+203:2.84'MOA+52:2.15'PRI+AAA:2.84'PRI+AAB:4.99'RFF+LI:2971/79360'TAX+7+VAT+++:::0+Z'MOA+124:0'ALC+A++++DI::28'PCD+3:43'MOA+8:2.15'TAX+7+VAT+++:::0+Z'LIN+20++9781408329085:EN'IMD+L+009+:::Banks, Rosie'IMD+L+050+:::Emerald unicorn'QTY+47:1'GIR+001+34148009564847:LAC+HLE:LLO+JUN-NF:LSQ'MOA+203:2.84'MOA+52:2.15'PRI+AAA:2.84'PRI+AAB:4.99'RFF+LI:2971/79372'TAX+7+VAT+++:::0+Z'MOA+124:0'ALC+A++++DI::28'PCD+3:43'MOA+8:2.15'TAX+7+VAT+++:::0+Z'LIN+21++9781408329085:EN'IMD+L+009+:::Banks, Rosie'IMD+L+050+:::Emerald unicorn'QTY+47:1'GIR+001+34148009564854:LAC+WID:LLO+JUN-NF:LSQ'MOA+203:2.84'MOA+52:2.15'PRI+AAA:2.84'PRI+AAB:4.99'RFF+LI:2971/79373'TAX+7+VAT+++:::0+Z'MOA+124:0'ALC+A++++DI::28'PCD+3:43'MOA+8:2.15'TAX+7+VAT+++:::0+Z'LIN+22++9781408329092:EN'IMD+L+009+:::Banks, Rosie'IMD+L+050+:::Sapphire spell'QTY+47:1'GIR+001+34148009564870:LAC+HLE:LLO+JUN-NF:LSQ'MOA+203:2.84'MOA+52:2.15'PRI+AAA:2.84'PRI+AAB:4.99'RFF+LI:2971/79374'TAX+7+VAT+++:::0+Z'MOA+124:0'ALC+A++++DI::28'PCD+3:43'MOA+8:2.15'TAX+7+VAT+++:::0+Z'LIN+23++9781408329092:EN'IMD+L+009+:::Banks, Rosie'IMD+L+050+:::Sapphire spell'QTY+47:1'GIR+001+34148009564888:LAC+WID:LLO+JUN-NF:LSQ'MOA+203:2.84'MOA+52:2.15'PRI+AAA:2.84'PRI+AAB:4.99'RFF+LI:2971/79375'TAX+7+VAT+++:::0+Z'MOA+124:0'ALC+A++++DI::28'PCD+3:43'MOA+8:2.15'TAX+7+VAT+++:::0+Z'LIN+24++9781408329115:EN'IMD+L+009+:::Banks, Rosie'IMD+L+050+:::Ruby riddle'QTY+47:1'GIR+001+34148009564862:LAC+HLE:LLO+JUN-NF:LSQ'MOA+203:2.84'MOA+52:2.15'PRI+AAA:2.84'PRI+AAB:4.99'RFF+LI:2971/79378'TAX+7+VAT+++:::0+Z'MOA+124:0'ALC+A++++DI::28'PCD+3:43'MOA+8:2.15'TAX+7+VAT+++:::0+Z'LIN+25++9781408330104:EN'IMD+L+009+:::Brownlow, Michael'IMD+L+050+:::Ten little princesses'QTY+47:1'GIR+001+34148009564912:LAC+HLE:LLO+JUN-NF:LSQ'MOA+203:6.83'MOA+52:5.16'PRI+AAA:6.83'PRI+AAB:11.99'RFF+LI:2971/79379'TAX+7+VAT+++:::0+Z'MOA+124:0'ALC+A++++DI::28'PCD+3:43'MOA+8:5.16'TAX+7+VAT+++:::0+Z'LIN+26++9781408333136:EN'IMD+L+009+:::Meadows, Daisy'IMD+L+050+:::Destiny the pop star fairy'QTY+47:1'GIR+001+34148009565059:LAC+HLE:LLO+JUN-NF:LSQ'MOA+203:2.84'MOA+52:2.15'PRI+AAA:2.84'PRI+AAB:4.99'RFF+LI:2971/79380'TAX+7+VAT+++:::0+Z'MOA+124:0'ALC+A++++DI::28'PCD+3:43'MOA+8:2.15'TAX+7+VAT+++:::0+Z'LIN+27++9781444910216:EN'IMD+L+009+:::Bently, Peter'IMD+L+050+:::The cat, the mouse and the runaway'QTY+47:1'GIR+001+34148009564896:LAC+HLE:LLO+JUN-NF:LSQ'MOA+203:3.98'MOA+52:3.01'PRI+AAA:3.98'PRI+AAB:6.99'RFF+LI:2971/79404'TAX+7+VAT+++:::0+Z'MOA+124:0'ALC+A++++DI::28'PCD+3:43'MOA+8:3.01'TAX+7+VAT+++:::0+Z'LIN+28++9781444910216:EN'IMD+L+009+:::Bently, Peter'IMD+L+050+:::The cat, the mouse and the runaway'QTY+47:1'GIR+001+34148009564904:LAC+WID:LLO+JUN-NF:LSQ'MOA+203:3.98'MOA+52:3.01'PRI+AAA:3.98'PRI+AAB:6.99'RFF+LI:2971/79405'TAX+7+VAT+++:::0+Z'MOA+124:0'ALC+A++++DI::28'PCD+3:43'MOA+8:3.01'TAX+7+VAT+++:::0+Z'LIN+29++9781444914092:EN'IMD+L+009+:::Muchamore, Robert'IMD+L+050+:::Lone wolf'QTY+47:1'GIR+001+34148009565083:LAC+DIT:LLO+JUN-NF:LSQ'MOA+203:7.4'MOA+52:5.59'PRI+AAA:7.4'PRI+AAB:12.99'RFF+LI:2971/79408'TAX+7+VAT+++:::0+Z'MOA+124:0'ALC+A++++DI::28'PCD+3:43'MOA+8:5.59'TAX+7+VAT+++:::0+Z'LIN+30++9781444914092:EN'IMD+L+009+:::Muchamore, Robert'IMD+L+050+:::Lone wolf'QTY+47:1'GIR+001+34148009565091:LAC+HLE:LLO+JUN-NF:LSQ'MOA+203:7.4'MOA+52:5.59'PRI+AAA:7.4'PRI+AAB:12.99'RFF+LI:2971/79409'TAX+7+VAT+++:::0+Z'MOA+124:0'ALC+A++++DI::28'PCD+3:43'MOA+8:5.59'TAX+7+VAT+++:::0+Z'LIN+31++9781444914092:EN'IMD+L+009+:::Muchamore, Robert'IMD+L+050+:::Lone wolf'QTY+47:1'GIR+001+34148009565109:LAC+WID:LLO+JUN-NF:LSQ'MOA+203:7.4'MOA+52:5.59'PRI+AAA:7.4'PRI+AAB:12.99'RFF+LI:2971/79410'TAX+7+VAT+++:::0+Z'MOA+124:0'ALC+A++++DI::28'PCD+3:43'MOA+8:5.59'TAX+7+VAT+++:::0+Z'LIN+32++9781781716441:EN'IMD+L+009+:::Smallman, Steve'IMD+L+050+:::Goldilocks'QTY+47:1'GIR+001+34148009565141:LAC+HLE:LLO+JUN-NF:LSQ'MOA+203:5.69'MOA+52:4.3'PRI+AAA:5.69'PRI+AAB:9.99'RFF+LI:2971/79433'TAX+7+VAT+++:::0+Z'MOA+124:0'ALC+A++++DI::28'PCD+3:43'MOA+8:4.3'TAX+7+VAT+++:::0+Z'LIN+33++9781781716465:EN'IMD+L+009+:::Smallman, Steve'IMD+L+050+:::Blow your nose, big bad wolf'QTY+47:1'GIR+001+34148009565133:LAC+HLE:LLO+JUN-NF:LSQ'MOA+203:5.69'MOA+52:4.3'PRI+AAA:5.69'PRI+AAB:9.99'RFF+LI:2971/79434'TAX+7+VAT+++:::0+Z'MOA+124:0'ALC+A++++DI::28'PCD+3:43'MOA+8:4.3'TAX+7+VAT+++:::0+Z'UNS+S'CNT+2:33'MOA+129:131.910'MOA+9:131.910'TAX+7+VAT+++:::0+Z'MOA+125:131.910'MOA+124:0'UNT+545+01975493'UNH+01975494+INVOIC:D:96A:UN:EAN008'BGM+380+01975494+43'DTM+131:20140729:102'DTM+137:20140729:102'RFF+DQ:01975494'NAD+BY+5013546121974::9'NAD+SU+5013546025078::9'CUX+2:GBP:4'PAT+1++5:3:D:30'LIN+1++9781408329085:EN'IMD+L+009+:::Banks, Rosie'IMD+L+050+:::Emerald unicorn'QTY+47:1'GIR+001+34148009565174:LAC+DIT:LLO+JUN-NF:LSQ'MOA+203:2.84'MOA+52:2.15'PRI+AAA:2.84'PRI+AAB:4.99'RFF+LI:3042/81414'TAX+7+VAT+++:::0+Z'MOA+124:0'ALC+A++++DI::28'PCD+3:43'MOA+8:2.15'TAX+7+VAT+++:::0+Z'LIN+2++9781408329085:EN'IMD+L+009+:::Banks, Rosie'IMD+L+050+:::Emerald unicorn'QTY+47:1'GIR+001+34148009565182:LAC+RUN:LLO+JUN-NF:LSQ'MOA+203:2.84'MOA+52:2.15'PRI+AAA:2.84'PRI+AAB:4.99'RFF+LI:3042/81415'TAX+7+VAT+++:::0+Z'MOA+124:0'ALC+A++++DI::28'PCD+3:43'MOA+8:2.15'TAX+7+VAT+++:::0+Z'LIN+3++9781408329092:EN'IMD+L+009+:::Banks, Rosie'IMD+L+050+:::Sapphire spell'QTY+47:1'GIR+001+34148009565240:LAC+DIT:LLO+JUN-NF:LSQ'MOA+203:2.84'MOA+52:2.15'PRI+AAA:2.84'PRI+AAB:4.99'RFF+LI:3042/81416'TAX+7+VAT+++:::0+Z'MOA+124:0'ALC+A++++DI::28'PCD+3:43'MOA+8:2.15'TAX+7+VAT+++:::0+Z'LIN+4++9781408329092:EN'IMD+L+009+:::Banks, Rosie'IMD+L+050+:::Sapphire spell'QTY+47:1'GIR+001+34148009565257:LAC+MOB:LLO+JUN-NF:LSQ'MOA+203:2.84'MOA+52:2.15'PRI+AAA:2.84'PRI+AAB:4.99'RFF+LI:3042/81417'TAX+7+VAT+++:::0+Z'MOA+124:0'ALC+A++++DI::28'PCD+3:43'MOA+8:2.15'TAX+7+VAT+++:::0+Z'LIN+5++9781408329092:EN'IMD+L+009+:::Banks, Rosie'IMD+L+050+:::Sapphire spell'QTY+47:1'GIR+001+34148009565265:LAC+RUN:LLO+JUN-NF:LSQ'MOA+203:2.84'MOA+52:2.15'PRI+AAA:2.84'PRI+AAB:4.99'RFF+LI:3042/81418'TAX+7+VAT+++:::0+Z'MOA+124:0'ALC+A++++DI::28'PCD+3:43'MOA+8:2.15'TAX+7+VAT+++:::0+Z'LIN+6++9781408329115:EN'IMD+L+009+:::Banks, Rosie'IMD+L+050+:::Ruby riddle'QTY+47:1'GIR+001+34148009565190:LAC+DIT:LLO+JUN-NF:LSQ'MOA+203:2.84'MOA+52:2.15'PRI+AAA:2.84'PRI+AAB:4.99'RFF+LI:3042/81424'TAX+7+VAT+++:::0+Z'MOA+124:0'ALC+A++++DI::28'PCD+3:43'MOA+8:2.15'TAX+7+VAT+++:::0+Z'LIN+7++9781408329115:EN'IMD+L+009+:::Banks, Rosie'IMD+L+050+:::Ruby riddle'QTY+47:1'GIR+001+34148009565208:LAC+HLE:LLO+JUN-NF:LSQ'MOA+203:2.84'MOA+52:2.15'PRI+AAA:2.84'PRI+AAB:4.99'RFF+LI:3042/81425'TAX+7+VAT+++:::0+Z'MOA+124:0'ALC+A++++DI::28'PCD+3:43'MOA+8:2.15'TAX+7+VAT+++:::0+Z'LIN+8++9781408329115:EN'IMD+L+009+:::Banks, Rosie'IMD+L+050+:::Ruby riddle'QTY+47:1'GIR+001+34148009565216:LAC+MOB:LLO+JUN-NF:LSQ'MOA+203:2.84'MOA+52:2.15'PRI+AAA:2.84'PRI+AAB:4.99'RFF+LI:3042/81426'TAX+7+VAT+++:::0+Z'MOA+124:0'ALC+A++++DI::28'PCD+3:43'MOA+8:2.15'TAX+7+VAT+++:::0+Z'LIN+9++9781408329115:EN'IMD+L+009+:::Banks, Rosie'IMD+L+050+:::Ruby riddle'QTY+47:1'GIR+001+34148009565224:LAC+RUN:LLO+JUN-NF:LSQ'MOA+203:2.84'MOA+52:2.15'PRI+AAA:2.84'PRI+AAB:4.99'RFF+LI:3042/81427'TAX+7+VAT+++:::0+Z'MOA+124:0'ALC+A++++DI::28'PCD+3:43'MOA+8:2.15'TAX+7+VAT+++:::0+Z'LIN+10++9781408329115:EN'IMD+L+009+:::Banks, Rosie'IMD+L+050+:::Ruby riddle'QTY+47:1'GIR+001+34148009565232:LAC+WID:LLO+JUN-NF:LSQ'MOA+203:2.84'MOA+52:2.15'PRI+AAA:2.84'PRI+AAB:4.99'RFF+LI:3042/81428'TAX+7+VAT+++:::0+Z'MOA+124:0'ALC+A++++DI::28'PCD+3:43'MOA+8:2.15'TAX+7+VAT+++:::0+Z'UNS+S'CNT+2:10'MOA+129:28.4'MOA+9:28.4'TAX+7+VAT+++:::0+Z'MOA+125:28.4'MOA+124:0'UNT+177+01975494'UNZ+6+337023' \ No newline at end of file diff --git a/t/edi_testfiles/QUOTES_413514.CEQ b/t/edi_testfiles/QUOTES_413514.CEQ new file mode 100644 index 0000000000..60fb9994de --- /dev/null +++ b/t/edi_testfiles/QUOTES_413514.CEQ @@ -0,0 +1 @@ +UNA:+.? 'UNB+UNOC:3+5013546027173+5013546132093+150928:1811+413514+ASKEDI:+QUOTES++++'UNH+413514001+QUOTES:D:96A:UN:EAN002'BGM+31C::28+SO314841+9'DTM+137:20150928:102'CUX+2:GBP:12'NAD+BY+5013546132093::9'NAD+SU+5013546027173::9'LIN+1++9780749577216:EN'PIA+5+0749577215:IB'IMD+L+050+:::AA hotel guide 2016'IMD+L+120+:::AA Publishing'IMD+L+170+:::2015'IMD+L+180+:::688'IMD+L+220+:::Pbk'IMD+L+250+:::AN'QTY+1:5'GIR+001+RS:LST+ANF:LSQ+BOO:LLO+REF:LFN+914.1061:LCL'GIR+001+16.99:LCV'GIR+002+RS:LST+ANF:LSQ+CRO:LLO+REF:LFN+914.1061:LCL'GIR+002+16.99:LCV'GIR+003+RS:LST+ANF:LSQ+MAG:LLO+REF:LFN+914.1061:LCL'GIR+003+16.99:LCV'GIR+004+RS:LST+ANF:LSQ+NET:LLO+REF:LFN+914.1061:LCL'GIR+004+16.99:LCV'GIR+005+RS:LST+ANF:LSQ+SOU:LLO+REF:LFN+914.1061:LCL'GIR+005+16.99:LCV'FTX+LIN++3:10B:28'PRI+AAE:16.99'RFF+QLI:SO3148410001'LIN+2++9780857111739:EN'PIA+5+0857111736:IB'IMD+L+050+:::BNF 69'IMD+L+060+:::British national formulary'IMD+L+120+:::Pharmaceutical Press'IMD+L+170+:::2015'IMD+L+180+:::1184'IMD+L+220+:::Pbk'IMD+L+250+:::AN'QTY+1:2'GIR+001+RS:LST+ANF:LSQ+CRO:LLO+REF:LFN+615.1341:LCL'GIR+001+39.99:LCV'GIR+002+RS:LST+ANF:LSQ+SOU:LLO+REF:LFN+615.1341:LCL'GIR+002+39.99:LCV'FTX+LIN++3:10B:28'PRI+AAE:39.99'RFF+QLI:SO3148410002'LIN+3++9780749474805:EN'PIA+5+0749474807:IB'IMD+L+050+:::British qualifications 2016'IMD+L+060+:::a complete guide to professional, v:ocational & academic qualifications'IMD+L+060+::: in the United Kingdom'IMD+L+120+:::KoganPage'IMD+L+170+:::2015'IMD+L+180+:::576'IMD+L+220+:::Pbk'IMD+L+250+:::AN'QTY+1:2'GIR+001+RS:LST+ANF:LSQ+CRO:LLO+REF:LFN+378.013:LCL'GIR+001+69.99:LCV'GIR+002+RS:LST+ANF:LSQ+SOU:LLO+REF:LFN+378.013:LCL'GIR+002+69.99:LCV'FTX+LIN++3:10B:28'PRI+AAE:69.99'RFF+QLI:SO3148410003'LIN+4++9781909319776:EN'PIA+5+1909319775:IB'IMD+L+050+:::Careers 2016'IMD+L+120+:::Trotman'IMD+L+170+:::2015'IMD+L+220+:::Pbk'IMD+L+250+:::AN'QTY+1:6'GIR+001+RS:LST+ANF:LSQ+BOO:LLO+REF:LFN+331.702:LCL'GIR+001+45.00:LCV'GIR+002+RS:LST+ANF:LSQ+CRO:LLO+REF:LFN+331.702:LCL'GIR+002+45.00:LCV'GIR+003+RS:LST+ANF:LSQ+FOR:LLO+REF:LFN+331.702:LCL'GIR+003+45.00:LCV'GIR+004+RS:LST+ANF:LSQ+MAG:LLO+REF:LFN+331.702:LCL'GIR+004+45.00:LCV'GIR+005+RS:LST+ANF:LSQ+NET:LLO+REF:LFN+331.702:LCL'GIR+005+45.00:LCV'GIR+006+RS:LST+ANF:LSQ+SOU:LLO+REF:LFN+331.702:LCL'GIR+006+45.00:LCV'FTX+LIN++3:10B:28'PRI+AAE:45.00'RFF+QLI:SO3148410004'LIN+5++9781910715024:EN'PIA+5+1910715026:IB'IMD+L+010+:::Child Poverty Action Group'IMD+L+050+:::Council Tax Handbook'IMD+L+120+:::CPAG'IMD+L+170+:::2015'IMD+L+180+:::305'IMD+L+220+:::Pbk'IMD+L+250+:::AN'QTY+1:1'GIR+001+RS:LST+ANF:LSQ+CRO:LLO+REF:LFN+344.4203 CHI:LCL'GIR+001+22.00:LCV'FTX+LIN++3:10B:28'PRI+AAE:22.00'RFF+QLI:SO3148410005'LIN+6++9780715110973:EN'PIA+5+0715110977:IB'IMD+L+050+:::Crockford?'s clerical directory 2016:-2017'IMD+L+060+:::a directory of the clergy of the Ch:urch of England, the Church in Wale'IMD+L+060+:::s, the Scottish Episcopal Church, t:he Church of Ireland'IMD+L+120+:::Church House Publishing'IMD+L+170+:::2015'IMD+L+180+:::1280'IMD+L+220+:::Hbk'IMD+L+250+:::AN'QTY+1:2'GIR+001+RS:LST+ANF:LSQ+CRO:LLO+REF:LFN+283.0254:LCL'GIR+001+70.00:LCV'GIR+002+RS:LST+ANF:LSQ+SOU:LLO+REF:LFN+283.0254:LCL'GIR+002+70.00:LCV'FTX+LIN++3:10B:28'PRI+AAE:70.00'RFF+QLI:SO3148410006'LIN+7++9781908232236:EN'PIA+5+1908232234:IB'IMD+L+010+:::Newton'IMD+L+011+:::Elizabeth'IMD+L+050+:::Dods Parliamentary Companion'IMD+L+120+:::Dod?'s Parliamentary Communications'IMD+L+170+:::2015'IMD+L+180+:::1488'IMD+L+220+:::Hbk'IMD+L+250+:::AN'QTY+1:2'GIR+001+RS:LST+ANF:LSQ+CRO:LLO+REF:LFN+325.00:LCV'GIR+002+RS:LST+ANF:LSQ+SOU:LLO+REF:LFN+325.00:LCV'FTX+LIN++3:10B:28'PRI+AAE:325.00'RFF+QLI:SO3148410007'LIN+8++9780851015699:EN'PIA+5+0851015697:IB'IMD+L+050+:::Hudson?'s historic houses & gardens'IMD+L+120+:::Hudson?'s Media'IMD+L+170+:::2015'IMD+L+180+:::500'IMD+L+220+:::Pbk'IMD+L+250+:::AN'QTY+1:1'GIR+001+RS:LST+ANF:LSQ+CRO:LLO+REF:LFN+914.1048:LCL'GIR+001+16.99:LCV'FTX+LIN++3:10B:28'PRI+AAE:16.99'RFF+QLI:SO3148410008'LIN+9++9781784720292:EN'PIA+5+1784720291:IB'IMD+L+010+:::Miller'IMD+L+011+:::Judith'IMD+L+050+:::Miller?'s antiques handbook & price :guide 2016/2017'IMD+L+120+:::Mitchell Beazley'IMD+L+170+:::2015'IMD+L+180+:::648'IMD+L+190+:::Miller?'s Antiques Handbook & Price :Guide'IMD+L+220+:::Hbk'IMD+L+250+:::AN'QTY+1:6'GIR+001+RS:LST+ANF:LSQ+BOO:LLO+REF:LFN+745.1075 MIL:LCL'GIR+001+30.00:LCV'GIR+002+RS:LST+ANF:LSQ+CRO:LLO+REF:LFN+745.1075 MIL:LCL'GIR+002+30.00:LCV'GIR+003+RS:LST+ANF:LSQ+FOR:LLO+REF:LFN+745.1075 MIL:LCL'GIR+003+30.00:LCV'GIR+004+RS:LST+ANF:LSQ+MAG:LLO+REF:LFN+745.1075 MIL:LCL'GIR+004+30.00:LCV'GIR+005+RS:LST+ANF:LSQ+NET:LLO+REF:LFN+745.1075 MIL:LCL'GIR+005+30.00:LCV'GIR+006+RS:LST+ANF:LSQ+SOU:LLO+REF:LFN+745.1075 MIL:LCL'GIR+006+30.00:LCV'FTX+LIN++3:10B:28'PRI+AAE:30.00'RFF+QLI:SO3148410009'LIN+10++9781440245244:EN'PIA+5+144024524X:IB'IMD+L+010+:::Cuhaj'IMD+L+011+:::George S.'IMD+L+020+:::Michael'IMD+L+021+:::Thomas'IMD+L+050+:::Standard Catalog of World Coins, 18:01-1900'IMD+L+120+:::F&W Publications Inc'IMD+L+170+:::2015'IMD+L+180+:::1296'IMD+L+220+:::Pbk'IMD+L+250+:::AN'QTY+1:5'GIR+001+RS:LST+ANF:LSQ+BOO:LLO+REF:LFN+58.99:LCV'GIR+002+RS:LST+ANF:LSQ+CRO:LLO+REF:LFN+58.99:LCV'GIR+003+RS:LST+ANF:LSQ+MAG:LLO+REF:LFN+58.99:LCV'GIR+004+RS:LST+ANF:LSQ+NET:LLO+REF:LFN+58.99:LCV'GIR+005+RS:LST+ANF:LSQ+SOU:LLO+REF:LFN+58.99:LCV'FTX+LIN++3:10B:28'PRI+AAE:58.99'RFF+QLI:SO3148410010'LIN+11++9781910715048:EN'PIA+5+1910715042:IB'IMD+L+010+:::Child Poverty Action Group'IMD+L+050+:::Student Support and Benefits Handbo:ok'IMD+L+120+:::CPAG'IMD+L+170+:::2015'IMD+L+180+:::356'IMD+L+220+:::Pbk'IMD+L+250+:::AN'QTY+1:1'GIR+001+RS:LST+ANF:LSQ+SOU:LLO+REF:LFN+20.00:LCV'FTX+LIN++3:10B:28'PRI+AAE:20.00'RFF+QLI:SO3148410011'LIN+12++9781910715055:EN'PIA+5+1910715050:IB'IMD+L+010+:::Child Poverty Action Group'IMD+L+050+:::Universal Credit'IMD+L+060+:::What You Need to Know'IMD+L+120+:::CPAG'IMD+L+170+:::2015'IMD+L+180+:::304'IMD+L+220+:::Pbk'IMD+L+250+:::AN'QTY+1:6'GIR+001+RS:LST+ANF:LSQ+BOO:LLO+REF:LFN+15.00:LCV'GIR+002+RS:LST+ANF:LSQ+CRO:LLO+REF:LFN+15.00:LCV'GIR+003+RS:LST+ANF:LSQ+FOR:LLO+REF:LFN+15.00:LCV'GIR+004+RS:LST+ANF:LSQ+MAG:LLO+REF:LFN+15.00:LCV'GIR+005+RS:LST+ANF:LSQ+NET:LLO+REF:LFN+15.00:LCV'GIR+006+RS:LST+ANF:LSQ+SOU:LLO+REF:LFN+15.00:LCV'FTX+LIN++3:10B:28'PRI+AAE:15.00'RFF+QLI:SO3148410012'LIN+13++9781472904706:EN'PIA+5+1472904702:IB'IMD+L+050+:::Who?'s who 2016'IMD+L+120+:::Bloomsbury'IMD+L+170+:::2015'IMD+L+180+:::2624'IMD+L+190+:::Who?'s Who'IMD+L+220+:::Hbk'IMD+L+250+:::AN'QTY+1:1'GIR+001+RS:LST+ANF:LSQ+CRO:LLO+REF:LFN+920.009:LCL'GIR+001+280.00:LCV'FTX+LIN++3:10B:28'PRI+AAE:280.00'RFF+QLI:SO3148410013'LIN+14++9781906035730:EN'PIA+5+1906035733:IB'IMD+L+010+:::Warrick'IMD+L+011+:::Laura'IMD+L+050+:::Willings Press Guide 2016 (set of 2: vols)'IMD+L+060+:::UK & Ireland and World News Media'IMD+L+120+:::Cision'IMD+L+170+:::2015'IMD+L+220+:::Pbk'IMD+L+250+:::AN'QTY+1:1'GIR+001+RS:LST+ANF:LSQ+CRO:LLO+REF:LFN+525.00:LCV'FTX+LIN++3:10B:28'PRI+AAE:525.00'RFF+QLI:SO3148410014'UNS+S'CNT+2:14'UNT+264+413514001'UNZ+1+413514' \ No newline at end of file diff --git a/t/edi_testfiles/ordrsp1.CEA b/t/edi_testfiles/ordrsp1.CEA new file mode 100644 index 0000000000..9ea7d958e0 --- /dev/null +++ b/t/edi_testfiles/ordrsp1.CEA @@ -0,0 +1 @@ +UNA:+.? 'UNB+UNOC:3+4012345000094+5412345000176+140430:1849+EDIQ2857776++ORDRSP'UNH+ME001234+ORDRSP:D:96A:UN:EAN005'BGM+231+R967634+4'DTM+137:19971028:102'NAD+BY+5412345000176::9'NAD+SU+4012345000094::9'CUX+2:GBP:9'LIN+1+24'PIA+5+0316907235:IB'QTY+21:2'QTY+83:2'DTM+44:19971120:102'FTX+LIN++NP:8B:28'PRI+AAE:15.99:CA:SRP'RFF+LI:P28837'LIN+2+2'PIA+5+0856674427:IB'QTY+21:1'FTX+LIN++OP:8B:28'RFF+LI:P28838'LIN+3+24'PIA+5+0870701436:IB'PIA+3+0870701428:IB'QTY+21:1'FTX+LIN++OP:8B:28'PRI+AAE:25:CA:SRP'RFF+LI:P28846'UNS+S'CNT+2:3'UNT+29+ME001234'UNZ+1+EDIQ2857776' \ No newline at end of file diff --git a/t/edi_testfiles/ordrsp2.CEA b/t/edi_testfiles/ordrsp2.CEA new file mode 100644 index 0000000000..51fe1e2020 --- /dev/null +++ b/t/edi_testfiles/ordrsp2.CEA @@ -0,0 +1 @@ +UNA:+.? 'UNB+UNOC:3+4012345000094+5412345000176+140430:1849+EDIQ2857775++ORDRSP'UNH+ME001235+ORDRSP:D:96A:UN:EAN005'BGM+231+R967635+27'DTM+137:19971028:102'FTX+GEN++ACS:9B:28'RFF+ON:H67209'NAD+BY+5412345000176::9'NAD+SU+4012345000094::9'UNS+S'CNT+2:0'UNT+10+ME001235'UNZ+1+EDIQ2857775' \ No newline at end of file diff --git a/t/edi_testfiles/ordrsp3.CEA b/t/edi_testfiles/ordrsp3.CEA new file mode 100644 index 0000000000..a42dd86361 --- /dev/null +++ b/t/edi_testfiles/ordrsp3.CEA @@ -0,0 +1 @@ +UNA:+.? 'UNB+UNOC:3+4012345000094+5412345000176+140430:1849+EDIQ2857774++ORDRSP'UNH+ME001236+ORDRSP:D:96A:UN:EAN005'BGM+23C+R967635+4'DTM+137:20010624:102'NAD+BY+5412345000176::9'NAD+SU+4012345000094::9'LIN+1+4'PIA+5+00076511236:IB'QTY+21:3’GIR+001+5346:LCO+1000431:LAC+FIC:LFN+AN:LLO'GIR+002+5347:LCO+1000432:LAC+FIC:LFN+AN:LLO'GIR+003+5348:LCO+1000433:LAC+FIC:LFN+BB:LLO'RFF+LI:0190045'LIN+2+4’PIA+5+0863183913:IB'QTY+21:1'GIR+001+6210:LCO+1000434:LAC+FIC:LFN+BB:LLO+398:LCL'GIR+001+JON:LFS+14DAY:LLN'RFF+LI:0190056'UNS+S'CNT+2:2'UNT+21:ME001236'UNZ+1+EDIQ2857774' \ No newline at end of file diff --git a/t/edi_testfiles/ordrsp4.CEA b/t/edi_testfiles/ordrsp4.CEA new file mode 100644 index 0000000000..ab431cb049 --- /dev/null +++ b/t/edi_testfiles/ordrsp4.CEA @@ -0,0 +1 @@ +UNA:+.? 'UNB+UNOC:3+4012345000094+5412345000176+140430:1849+EDIQ2857773++ORDRSP'UNH+ME001345+ORDRSP:D:96A:UN:EAN005'BGM+23C+F964312+4'DTM+137:20010430:102'NAD+BY+5412345000176::9'NAD+SU+4012345000094::9'LIN+1+4'PIA+5+0007107781:IB'QTY+21:4'GIR+L01+214365:LAC+214366:LAC+DA:LLO+920:LCL+SEC:LFS'GIR+L01+NFIC:LFS'GIR+L02+214367:LAC+214368:LAC+FG:LLO+920:LCL+SEC:LFS'GIR+L02+NFIC:LFS'RFF+LI:0184364’LOC+7+BR1::92'QTY+11:2'LOC+20+FG::92'QTY+11:2'UNS+S'CNT+2:1'UNT+20:ME001345'UNZ+1+EDIQ2857773' \ No newline at end of file diff --git a/t/edi_testfiles/prquotes_73050_20140430.CEQ b/t/edi_testfiles/prquotes_73050_20140430.CEQ new file mode 100644 index 0000000000..c5adba17ce --- /dev/null +++ b/t/edi_testfiles/prquotes_73050_20140430.CEQ @@ -0,0 +1 @@ +UNA:+.? 'UNB+UNOC:3+5013546027856+5030670137480+140430:1849+EDIQ2857763++QUOTES'UNH+MQ09791+QUOTES:D:96A:UN:EAN002'BGM+31C+Q741588+9'DTM+137:20140430:102'CUX+2:GBP:12'NAD+BY+5030670137480::9'NAD+SU+5013546027856::9'LIN+1++9780191652028:EN'IMD+L+010+:::Fisher, Miles.'IMD+L+050+:::Heart disease and diabetes [electro:nic resource]'IMD+L+100+:::2nd ed.'IMD+L+110+:::Oxford'IMD+L+120+:::Oxford University Press'IMD+L+170+:::2012.'IMD+L+180+:::xv, 156 p.'IMD+L+190+:::Oxford diabetes library'IMD+L+230+:::616.12'IMD+L+240+:::RC660'IMD+L+300+:::Previous ed.?: 2009.'QTY+1:1'GIR+001+ELIB:LLO+436BOO_2013:LFN+EBOOK:LST+EBOO:LSQ'PRI+AAE:79.42:DI'RFF+QLI:2857763'LIN+2++9781461414759:EN'IMD+L+010+:::Vlodaver, Zeev.'IMD+L+050+:::Coronary heart disease [electronic :resource]'IMD+L+110+:::New York ,London'IMD+L+120+:::Springer'IMD+L+170+:::2012.'IMD+L+180+:::xv, 540 p.'IMD+L+230+:::616.123'QTY+1:1'GIR+001+ELIB:LLO+436BOO_2013:LFN+EBOOK:LST+EBOO:LSQ'PRI+AAE:161.87:DI'RFF+QLI:2857785'LIN+3++9780199793662:EN'IMD+L+010+:::Yaffe, Kristine,'IMD+L+050+:::Chronic medical disease and cogniti:ve aging [electronic resource]'IMD+L+110+:::New York'IMD+L+120+:::Oxford University Press'IMD+L+170+:::2013'IMD+L+180+:::xv, 298 pages'IMD+L+230+:::616.044'QTY+1:1'GIR+001+ELIB:LLO+436BOO_2013:LFN+EBOOK:LST+EBOO:LSQ'PRI+AAE:165.53:DI'RFF+QLI:2857810'LIN+4++9781446258637:EN'IMD+L+010+:::Lupton, Deborah.'IMD+L+050+:::Medicine as culture [electronic res:ource]'IMD+L+100+:::3rd ed.'IMD+L+110+:::Los Angeles ,London'IMD+L+120+:::SAGE'IMD+L+170+:::2012.'IMD+L+180+:::xii, 195 p.'IMD+L+230+:::306.461'IMD+L+300+:::Previous ed.?: 2003.'QTY+1:1'GIR+001+ELIB:LLO+436BOO_2013:LFN+EBOOK:LST+EBOO:LSQ'PRI+AAE:94.8:DI'RFF+QLI:2857839'LIN+5++9780203113974:EN'IMD+L+010+:::Magdalinski, Tara,'IMD+L+050+:::Study skills for sport studies [ele:ctronic resource]'IMD+L+180+:::xv, 250 pages'IMD+L+230+:::371.30281'QTY+1:1'GIR+001+ELIB:LLO+705BOO_2013:LFN+EBOOK:LST+EBOO:LSQ'PRI+AAE:171:DI'RFF+QLI:2857913'LIN+6++9781450453080:EN'IMD+L+010+:::Hausswirth, Christophe,'IMD+L+050+:::Recovery for performance in sport [:electronic resource]'IMD+L+180+:::xiii, 281 pages'IMD+L+230+:::617.03'QTY+1:1'GIR+001+ELIB:LLO+705BOO_2013:LFN+EBOOK:LST+EBOO:LSQ'PRI+AAE:212.4:DI'RFF+QLI:2857919'LIN+7++9780203807279:EN'IMD+L+010+:::Lebed, Felix,'IMD+L+050+:::Complexity and control in team spor:ts [electronic resource]'IMD+L+180+:::xx, 223 pages'IMD+L+190+:::Routledge research in sport and exe:rcise science ;'IMD+L+191+:::6'IMD+L+230+:::306.483'QTY+1:1'GIR+001+ELIB:LLO+705BOO_2013:LFN+EBOOK:LST+EBOO:LSQ'PRI+AAE:153:DI'RFF+QLI:2858034'LIN+8++9780415691055:EN'IMD+L+010+:::Smith, Mark'IMD+L+050+:::Practical Skills in Sport and Exerc:ise Science'IMD+L+120+:::Taylor & Francis'IMD+L+170+:::2014'QTY+1:4'GIR+001+COLLRD:LLO+705BOO_2013:LFN+2WEEK:LST+CORE:LSQ'GIR+002+COLLRD:LLO+705BOO_2013:LFN+2WEEK:LST+CORE:LSQ'GIR+003+COLLRD:LLO+705BOO_2013:LFN+2WEEK:LST+CORE:LSQ'GIR+004+COLLRD:LLO+705BOO_2013:LFN+2WEEK:LST+CORE:LSQ'PRI+AAE:24.99:DI'RFF+QLI:2858105'LIN+9++9781450434324:EN'IMD+L+010+:::Hoffman, Shirl J.,'IMD+L+050+:::Introduction to kinesiology'IMD+L+100+:::Fourth edition.'IMD+L+110+:::Champaign'IMD+L+120+:::Human Kinetics Publishers'IMD+L+170+:::2013'IMD+L+180+:::xvi, 529 pages'IMD+L+230+:::612.76'IMD+L+300+:::Previous edition?: 2009.'QTY+1:3'GIR+001+NELSON:LLO+705BOO_2013:LFN+2WEEK:LST+CORE:LSQ'GIR+002+NELSON:LLO+705BOO_2013:LFN+2WEEK:LST+CORE:LSQ'GIR+003+NELSON:LLO+705BOO_2013:LFN+2WEEK:LST+CORE:LSQ'PRI+AAE:67.5:DI'RFF+QLI:2858153'LIN+10++9780702049293:EN'IMD+L+010+:::Norris, Christopher M.'IMD+L+050+:::Managing sports injuries [electroni:c resource]'IMD+L+100+:::4th ed.'IMD+L+110+:::Edinburgh'IMD+L+120+:::Churchill Livingstone'IMD+L+170+:::2011.'IMD+L+180+:::421 p.'IMD+L+230+:::617.1027'IMD+L+240+:::RD97'IMD+L+300+:::Rev. ed. of?: Sports injuries / Chr:istopher M. Norris. 3rd ed. 2004.'QTY+1:1'GIR+001+ELIB:LLO+705BOO_2013:LFN+EBOOK:LST+EBOO:LSQ'PRI+AAE:275.23:DI'RFF+QLI:2858165'LIN+11++9781292034874:EN'IMD+L+010+:::Bledsoe, Bryan E.,'IMD+L+050+:::Paramedic care [electronic resource:]'IMD+L+080+:::Volume 5,'IMD+L+100+:::Pearson new international edition.'IMD+L+180+:::ii, 422 pages'IMD+L+190+:::Pearson custom library'IMD+L+230+:::616.025'QTY+1:1'GIR+001+ELIB:LLO+436BOO_2013:LFN+EBOOK:LST+EBOO:LSQ'PRI+AAE:41.99:DI'RFF+QLI:2858217'LIN+12++9781292021645:EN'IMD+L+010+:::Bledsoe, Bryan E.,'IMD+L+050+:::Paramedic care'IMD+L+080+:::Volume 5,'IMD+L+100+:::Pearson new international edition.'IMD+L+110+:::Harlow'IMD+L+120+:::Pearson Education'IMD+L+170+:::2013'IMD+L+180+:::ii, 422 pages'IMD+L+190+:::Pearson custom library'IMD+L+230+:::616.025'QTY+1:5'GIR+001+NELSON:LLO+436BOO_2013:LFN+2WEEK:LST+MAIN:LSQ'GIR+002+NELSON:LLO+436BOO_2013:LFN+2WEEK:LST+MAIN:LSQ'GIR+003+NELSON:LLO+436BOO_2013:LFN+2WEEK:LST+MAIN:LSQ'GIR+004+NELSON:LLO+436BOO_2013:LFN+2WEEK:LST+MAIN:LSQ'GIR+005+NELSON:LLO+436BOO_2013:LFN+2WEEK:LST+MAIN:LSQ'PRI+AAE:52.99:DI'RFF+QLI:2858231'LIN+13++9781446253083:EN'IMD+L+010+:::Green, Judith'IMD+L+050+:::Qualitative Methods for Health Rese:arch'IMD+L+100+:::Third Edition'IMD+L+110+:::London'IMD+L+120+:::SAGE Publications ?: SAGE Publicati:ons Ltd'IMD+L+170+:::2013'IMD+L+180+:::376 p.'IMD+L+190+:::Introducing Qualitative Methods ser:ies'IMD+L+230+:::610.721'IMD+L+300+:::The third edition of this bestselli:ng title is packed full of real wor'QTY+1:2'GIR+001+NELSON:LLO+436BOO_2013:LFN+2WEEK:LST+610.72:LCL+MAIN:LSQ'GIR+002+NELSON:LLO+436BOO_2013:LFN+2WEEK:LST+610.72:LCL+MAIN:LSQ'FTX+LIN++2:10B:28+E*610.72* - additional items'PRI+AAE:75:DI'RFF+QLI:2858253'LIN+14++9780273757726:EN'IMD+L+010+:::Jim Blythe.'IMD+L+050+:::Essentials of marketing'IMD+L+120+:::Pearson Education'QTY+1:1'GIR+001+ELIB:LLO+660BOO_2013:LFN+EBOOK:LST+EBOO:LSQ'PRI+AAE:74.98:DI'RFF+QLI:2858398'LIN+15++9780745681726:EN'IMD+L+010+:::Selwyn, Ben,'IMD+L+050+:::The global development crisis [elec:tronic resource]'IMD+L+180+:::viii, 248 pages'IMD+L+230+:::338.9'IMD+L+240+:::HD75'IMD+L+300+:::This book challenges the assumption: that a ?'free?' global market will'QTY+1:1'GIR+001+ELIB:LLO+400BOO_2013:LFN+EBOOK:LST+EBOO:LSQ'PRI+AAE:66:DI'RFF+QLI:2858545'LIN+16++9781412992077:EN'IMD+L+010+:::McMichael, Philip.'IMD+L+050+:::Development and social change'IMD+L+100+:::5th ed.'IMD+L+110+:::Los Angeles'IMD+L+120+:::SAGE'IMD+L+170+:::c2012.'IMD+L+180+:::xxi, 383 p.'IMD+L+190+:::Sociology for a New Century Series'IMD+L+230+:::306.309'IMD+L+240+:::HC79.E44'IMD+L+300+:::Revised and updated Fifth Edition o:f this popular critical exploration'QTY+1:1'GIR+001+COLLRD:LLO+400BOO_2013:LFN+2WEEK:LST+CORE:LSQ'PRI+AAE:49.99:DI'RFF+QLI:2858547'LIN+17++9780230213111:EN'IMD+L+010+:::Brown, Chris,'IMD+L+050+:::Understanding international relatio:ns'IMD+L+100+:::4th ed.'IMD+L+110+:::Basingstoke'IMD+L+120+:::Palgrave Macmillan'IMD+L+170+:::c2009.'IMD+L+180+:::xi, 321 p.'IMD+L+230+:::327'IMD+L+240+:::JZ1242'IMD+L+300+:::Previous ed.?: 2005.'QTY+1:2'GIR+001+COLLRD:LLO+400BOO_2013:LFN+2WEEK:LST+CORE:LSQ'GIR+002+COLLRD:LLO+400BOO_2013:LFN+2WEEK:LST+CORE:LSQ'PRI+AAE:27.99:DI'RFF+QLI:2858938'LIN+18++9780273761006:EN'IMD+L+010+:::Rugman, Alan M.'IMD+L+050+:::International business [electronic :resource]'IMD+L+100+:::6th ed.'IMD+L+110+:::Harlow'IMD+L+120+:::Pearson Education'IMD+L+170+:::2012.'IMD+L+180+:::xxxii, 765 p.'IMD+L+230+:::658.049'IMD+L+300+:::First published by McGraw-Hill, 199:5.'QTY+1:1'GIR+001+ELIB:LLO+660BOO_2013:LFN+EBOOK:LST+EBOO:LSQ'PRI+AAE:114.97:DI'RFF+QLI:2858954'UNS+S'CNT+2:18'UNT+248+MQ09791'UNZ+1+EDIQ2857763' \ No newline at end of file -- 2.39.5