3 # Copyright 2014,2015 PTFS-Europe Ltd
5 # This file is part of Koha.
7 # Koha is free software; you can redistribute it and/or modify it
8 # under the terms of the GNU General Public License as published by
9 # the Free Software Foundation; either version 3 of the License, or
10 # (at your option) any later version.
12 # Koha is distributed in the hope that it will be useful, but
13 # WITHOUT ANY WARRANTY; without even the implied warranty of
14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 # GNU General Public License for more details.
17 # You should have received a copy of the GNU General Public License
18 # along with Koha; if not, see <http://www.gnu.org/licenses>.
22 use base qw(Exporter);
25 use English qw{ -no_match_vars };
30 use Koha::DateUtils qw( dt_from_string );
31 use C4::Acquisition qw( ModOrder NewBasket );
32 use C4::Suggestions qw( ModSuggestion );
39 use Koha::Edifact::Order;
41 use C4::Log qw( logaction );
43 use Text::Unidecode qw( unidecode );
44 use Koha::Plugins; # Adds plugin dirs to @INC
45 use Koha::Plugins::Handler;
46 use Koha::Acquisition::Baskets;
47 use Koha::Acquisition::Booksellers;
51 our (@ISA, @EXPORT_OK);
64 sub create_edi_order {
65 my $parameters = shift;
66 my $basketno = $parameters->{basketno};
67 my $ean = $parameters->{ean};
68 my $branchcode = $parameters->{branchcode};
69 my $noingest = $parameters->{noingest};
70 if ( !$basketno || !$ean ) {
71 carp 'create_edi_order called with no basketno or ean';
75 my $schema = Koha::Database->new()->schema();
77 my @orderlines = $schema->resultset('Aqorder')->search(
79 basketno => $basketno,
85 carp "No orderlines for basket $basketno";
89 my $vendor = $schema->resultset('VendorEdiAccount')->search(
91 vendor_id => $orderlines[0]->basketno->booksellerid->id,
95 my $ean_search_keys = { ean => $ean, };
97 $ean_search_keys->{branchcode} = $branchcode;
100 $schema->resultset('EdifactEan')->search($ean_search_keys)->single;
102 # If no branch specific each can be found, look for a default ean
104 $ean_obj = $schema->resultset('EdifactEan')->search(
112 my $dbh = C4::Context->dbh;
113 my $arr_ref = $dbh->selectcol_arrayref(
114 'select id from edifact_messages where basketno = ? and message_type = \'QUOTE\'',
117 my $response = @{$arr_ref} ? 1 : 0;
119 my $edifact_order_params = {
120 orderlines => \@orderlines,
123 is_response => $response,
127 if ( $vendor->plugin ) {
128 $edifact = Koha::Plugins::Handler->run(
130 class => $vendor->plugin,
131 method => 'edifact_order',
133 params => $edifact_order_params,
139 $edifact = Koha::Edifact::Order->new($edifact_order_params);
142 return unless $edifact;
144 my $order_file = $edifact->encode();
148 my $m = unidecode($order_file); # remove diacritics and non-latin chars
149 if ($noingest) { # allows scripts to produce test files
153 message_type => 'ORDERS',
155 vendor_id => $vendor->vendor_id,
157 basketno => $basketno,
158 filename => $edifact->filename(),
159 transfer_date => $edifact->msg_date_string(),
160 edi_acct => $vendor->id,
163 $schema->resultset('EdifactMessage')->create($order);
171 my $response_message = shift;
172 $response_message->status('processing');
173 $response_message->update;
174 my $schema = Koha::Database->new()->schema();
175 my $logger = Log::Log4perl->get_logger();
178 Koha::Edifact->new( { transmission => $response_message->raw_msg, } );
179 my $messages = $edi->message_array();
181 if ( @{$messages} ) {
182 foreach my $msg ( @{$messages} ) {
183 my $lines = $msg->lineitems();
184 foreach my $line ( @{$lines} ) {
185 my $ordernumber = $line->ordernumber();
187 # action cancelled:change_requested:no_action:accepted:not_found:recorded
188 my $action = $line->action_notification();
189 if ( $action eq 'cancelled' ) {
190 my $reason = $line->coded_orderline_text();
193 ordernumber => $ordernumber,
194 cancellationreason => $reason,
195 orderstatus => 'cancelled',
196 datecancellationprinted => dt_from_string()->ymd(),
200 else { # record order as due with possible further info
202 my $report = $line->coded_orderline_text();
203 my $date_avail = $line->availability_date();
206 $report .= " Available: $date_avail";
210 ordernumber => $ordernumber,
211 suppliers_report => $report,
219 $response_message->status('received');
220 $response_message->update;
224 sub process_invoice {
225 my $invoice_message = shift;
226 $invoice_message->status('processing');
227 $invoice_message->update;
228 my $schema = Koha::Database->new()->schema();
229 my $logger = Log::Log4perl->get_logger();
232 my $plugin_class = $invoice_message->edi_acct()->plugin();
234 # Plugin has its own invoice processor, only run it and not the standard invoice processor below
235 if ( $plugin_class ) {
236 eval "require $plugin_class"; # Import the class, eval is needed because requiring a string doesn't work like requiring a bareword
237 my $plugin = $plugin_class->new();
238 if ( $plugin->can('edifact_process_invoice') ) {
239 Koha::Plugins::Handler->run(
241 class => $plugin_class,
242 method => 'edifact_process_invoice',
244 invoice => $invoice_message,
253 if ( $plugin_class ) {
254 $edi_plugin = Koha::Plugins::Handler->run(
256 class => $plugin_class,
259 invoice_message => $invoice_message,
260 transmission => $invoice_message->raw_msg,
266 my $edi = $edi_plugin ||
267 Koha::Edifact->new( { transmission => $invoice_message->raw_msg, } );
269 my $messages = $edi->message_array();
271 if ( @{$messages} ) {
273 # BGM contains an invoice number
274 foreach my $msg ( @{$messages} ) {
275 my $invoicenumber = $msg->docmsg_number();
276 my $shipmentcharge = $msg->shipment_charge();
277 my $msg_date = $msg->message_date;
278 my $tax_date = $msg->tax_point_date;
279 if ( !defined $tax_date || $tax_date !~ m/^\d{8}/xms ) {
280 $tax_date = $msg_date;
283 my $vendor_ean = $msg->supplier_ean;
284 if ( !defined $vendor_acct || $vendor_ean ne $vendor_acct->san ) {
285 $vendor_acct = $schema->resultset('VendorEdiAccount')->search(
291 if ( !$vendor_acct ) {
293 "Cannot find vendor with ean $vendor_ean for invoice $invoicenumber in $invoice_message->filename";
296 $invoice_message->edi_acct( $vendor_acct->id );
297 $logger->trace("Adding invoice:$invoicenumber");
298 my $new_invoice = $schema->resultset('Aqinvoice')->create(
300 invoicenumber => $invoicenumber,
301 booksellerid => $invoice_message->vendor_id,
302 shipmentdate => $msg_date,
303 billingdate => $tax_date,
304 shipmentcost => $shipmentcharge,
305 shipmentcost_budgetid => $vendor_acct->shipment_budget,
306 message_id => $invoice_message->id,
309 my $invoiceid = $new_invoice->invoiceid;
310 $logger->trace("Added as invoiceno :$invoiceid");
311 my $lines = $msg->lineitems();
313 foreach my $line ( @{$lines} ) {
314 my $ordernumber = $line->ordernumber;
315 if (!$ordernumber ) {
316 $logger->trace( "Skipping invoice line, no associated ordernumber" );
320 $logger->trace( "Receipting order:$ordernumber Qty: ",
323 my $order = $schema->resultset('Aqorder')->find($ordernumber);
324 if (my $bib = $order->biblionumber) {
325 my $b = $bib->biblionumber;
326 my $id = $line->item_number_id;
327 $logger->trace("Updating bib:$b id:$id");
330 # ModReceiveOrder does not validate that $ordernumber exists validate here
334 my $s = $schema->resultset('Suggestion')->search(
336 biblionumber => $order->biblionumber->biblionumber,
342 suggestionid => $s->suggestionid,
343 STATUS => 'AVAILABLE',
347 # If quantity_invoiced is present use it in preference
348 my $quantity = $line->quantity_invoiced;
350 $quantity = $line->quantity;
353 my ( $price, $price_excl_tax ) = _get_invoiced_price($line, $quantity);
354 my $tax_rate = $line->tax_rate;
355 if ($tax_rate && $tax_rate->{rate} != 0) {
356 $tax_rate->{rate} /= 100;
359 if ( $order->quantity > $quantity ) {
360 my $ordered = $order->quantity;
363 $order->orderstatus('partial');
364 $order->quantity( $ordered - $quantity );
366 my $received_order = $order->copy(
368 ordernumber => undef,
369 quantity => $quantity,
370 quantityreceived => $quantity,
371 orderstatus => 'complete',
373 unitprice_tax_included => $price,
374 unitprice_tax_excluded => $price_excl_tax,
375 invoiceid => $invoiceid,
376 datereceived => $msg_date,
377 tax_rate_on_receiving => $tax_rate->{rate},
378 tax_value_on_receiving => $quantity * $price_excl_tax * $tax_rate->{rate},
381 transfer_items( $schema, $line, $order,
382 $received_order, $quantity );
383 receipt_items( $schema, $line,
384 $received_order->ordernumber, $quantity );
386 else { # simple receipt all copies on order
387 $order->quantityreceived( $quantity );
388 $order->datereceived($msg_date);
389 $order->invoiceid($invoiceid);
390 $order->unitprice($price);
391 $order->unitprice_tax_excluded($price_excl_tax);
392 $order->unitprice_tax_included($price);
393 $order->tax_rate_on_receiving($tax_rate->{rate});
394 $order->tax_value_on_receiving( $quantity * $price_excl_tax * $tax_rate->{rate});
395 $order->orderstatus('complete');
397 receipt_items( $schema, $line, $ordernumber, $quantity );
402 "No order found for $ordernumber Invoice:$invoicenumber"
412 $invoice_message->status('received');
413 $invoice_message->update; # status and basketno link
417 sub _get_invoiced_price {
420 my $line_total = $line->amt_total;
421 my $excl_tax = $line->amt_lineitem;
423 # If no tax some suppliers omit the total owed
424 # If no total given calculate from cost exclusive of tax
425 # + tax amount (if present, sometimes omitted if 0 )
426 if ( !defined $line_total ) {
427 my $x = $line->amt_taxoncharge;
431 $line_total = $excl_tax + $x;
434 # invoices give amounts per orderline, Koha requires that we store
437 return ( $line_total / $qty, $excl_tax / $qty );
439 return ( $line_total, $excl_tax ); # return as is for most common case
443 my ( $schema, $inv_line, $ordernumber, $quantity ) = @_;
444 my $logger = Log::Log4perl->get_logger();
446 # itemnumber is not a foreign key ??? makes this a bit cumbersome
447 my @item_links = $schema->resultset('AqordersItem')->search(
449 ordernumber => $ordernumber,
453 foreach my $ilink (@item_links) {
454 my $item = $schema->resultset('Item')->find( $ilink->itemnumber );
456 my $i = $ilink->itemnumber;
458 "Cannot find aqorder item for $i :Order:$ordernumber");
461 my $b = $item->get_column('homebranch');
462 if ( !exists $branch_map{$b} ) {
463 $branch_map{$b} = [];
465 push @{ $branch_map{$b} }, $item;
468 # Handling for 'AcqItemSetSubfieldsWhenReceived'
472 if ( C4::Context->preference('AcqCreateItem') eq 'ordering' ) {
473 @affects = split q{\|},
474 C4::Context->preference("AcqItemSetSubfieldsWhenReceived");
476 my $order = Koha::Acquisition::Orders->find($ordernumber);
477 $biblionumber = $order->biblionumber;
478 my $frameworkcode = GetFrameworkCode($biblionumber);
479 ($itemfield) = GetMarcFromKohaField( 'items.itemnumber',
484 my $gir_occurrence = 0;
485 while ( $gir_occurrence < $quantity ) {
486 my $branch = $inv_line->girfield( 'branch', $gir_occurrence );
487 my $item = shift @{ $branch_map{$branch} };
489 my $barcode = $inv_line->girfield( 'barcode', $gir_occurrence );
490 if ( $barcode && !$item->barcode ) {
491 my $rs = $schema->resultset('Item')->search(
496 if ( $rs->count > 0 ) {
497 $logger->warn("Barcode $barcode is a duplicate");
501 $logger->trace("Adding barcode $barcode");
502 $item->barcode($barcode);
506 # Handling for 'AcqItemSetSubfieldsWhenReceived'
508 my $item_marc = C4::Items::GetMarcItem( $biblionumber, $item->itemnumber );
509 for my $affect (@affects) {
510 my ( $sf, $v ) = split q{=}, $affect, 2;
511 foreach ( $item_marc->field($itemfield) ) {
512 $_->update( $sf => $v );
515 C4::Items::ModItemFromMarc( $item_marc, $biblionumber, $item->itemnumber );
521 $logger->warn("Unmatched item at branch:$branch");
530 my ( $schema, $inv_line, $order_from, $order_to, $quantity ) = @_;
532 # Transfer x items from the orig order to a completed partial order
534 my %mapped_by_branch;
535 while ( $gocc < $quantity ) {
536 my $branch = $inv_line->girfield( 'branch', $gocc );
537 if ( !exists $mapped_by_branch{$branch} ) {
538 $mapped_by_branch{$branch} = 1;
541 $mapped_by_branch{$branch}++;
545 my $logger = Log::Log4perl->get_logger();
546 my $o1 = $order_from->ordernumber;
547 my $o2 = $order_to->ordernumber;
548 $logger->warn("transferring $quantity copies from order $o1 to order $o2");
550 my @item_links = $schema->resultset('AqordersItem')->search(
552 ordernumber => $order_from->ordernumber,
555 foreach my $ilink (@item_links) {
556 my $ino = $ilink->itemnumber;
557 my $item = $schema->resultset('Item')->find( $ilink->itemnumber );
558 my $i_branch = $item->get_column('homebranch');
559 if ( exists $mapped_by_branch{$i_branch}
560 && $mapped_by_branch{$i_branch} > 0 )
562 $ilink->ordernumber( $order_to->ordernumber );
565 --$mapped_by_branch{$i_branch};
566 $logger->warn("Transferred item " . $item->itemnumber);
569 $logger->warn("Skipped item " . $item->itemnumber);
571 if ( $quantity < 1 ) {
582 $quote->status('processing');
585 my $edi = Koha::Edifact->new( { transmission => $quote->raw_msg, } );
587 my $messages = $edi->message_array();
588 my $process_errors = 0;
589 my $logger = Log::Log4perl->get_logger();
590 my $schema = Koha::Database->new()->schema();
591 my $message_count = 0;
592 my @added_baskets; # if auto & multiple baskets need to order all
594 if ( @{$messages} && $quote->vendor_id ) {
595 foreach my $msg ( @{$messages} ) {
598 NewBasket( $quote->vendor_id, 0, $quote->filename, q{},
600 push @added_baskets, $basketno;
601 if ( $message_count > 1 ) {
602 my $m_filename = $quote->filename;
603 $m_filename .= "_$message_count";
604 $schema->resultset('EdifactMessage')->create(
606 message_type => $quote->message_type,
607 transfer_date => $quote->transfer_date,
608 vendor_id => $quote->vendor_id,
609 edi_acct => $quote->edi_acct,
611 basketno => $basketno,
613 filename => $m_filename,
618 $quote->basketno($basketno);
620 $logger->trace("Created basket :$basketno");
621 my $items = $msg->lineitems();
622 my $refnum = $msg->message_refno;
624 for my $item ( @{$items} ) {
625 if ( !quote_item( $item, $quote, $basketno ) ) {
631 my $status = 'received';
632 if ($process_errors) {
636 $quote->status($status);
637 $quote->update; # status and basketno link
638 # Do we automatically generate orders for this vendor
639 my $v = $schema->resultset('VendorEdiAccount')->search(
641 vendor_id => $quote->vendor_id,
644 if ( $v->auto_orders ) {
645 for my $b (@added_baskets) {
648 ean => $messages->[0]->buyer_ean,
652 Koha::Acquisition::Baskets->find($b)->close;
654 if (C4::Context->preference("AcquisitionLog")) {
655 my $approved = Koha::Acquisition::Baskets->find( $b );
660 to_json($approved->unblessed)
671 my ( $item, $quote, $basketno ) = @_;
673 my $schema = Koha::Database->new()->schema();
674 my $logger = Log::Log4perl->get_logger();
676 # $basketno is the return from AddBasket in the calling routine
677 # So this call should not fail unless that has
678 my $basket = Koha::Acquisition::Baskets->find( $basketno );
680 $logger->error('Skipping order creation no valid basketno');
683 $logger->trace( 'Checking db for matches with ', $item->item_number_id() );
684 my $bib = _check_for_existing_bib( $item->item_number_id() );
685 if ( !defined $bib ) {
687 my $bib_record = _create_bib_from_quote( $item, $quote );
688 ( $bib->{biblionumber}, $bib->{biblioitemnumber} ) =
689 AddBiblio( $bib_record, q{} );
690 $logger->trace("New biblio added $bib->{biblionumber}");
693 $logger->trace("Match found: $bib->{biblionumber}");
696 # Create an orderline
697 my $order_note = $item->{orderline_free_text};
699 my $order_quantity = $item->quantity();
700 my $gir_count = $item->number_of_girs();
701 $order_quantity ||= 1; # quantity not necessarily present
702 if ( $gir_count > 1 ) {
703 if ( $gir_count != $order_quantity ) {
705 "Order for $order_quantity items, $gir_count segments present");
707 $order_quantity = 1; # attempts to create an orderline for each gir
709 my $price = $item->price_info;
710 # Howells do not send an info price but do have a gross price
712 $price = $item->price_gross;
714 my $vendor = Koha::Acquisition::Booksellers->find( $quote->vendor_id );
716 # NB quote will not include tax info it only contains the list price
717 my $ecost = _discounted_price( $vendor->discount, $price, $item->price_info_inclusive );
719 # database definitions should set some of these defaults but dont
721 biblionumber => $bib->{biblionumber},
722 entrydate => dt_from_string()->ymd(),
723 basketno => $basketno,
725 quantity => $order_quantity,
726 quantityreceived => 0,
727 order_vendornote => q{},
728 order_internalnote => q{},
729 replacementprice => $price,
730 rrp_tax_included => $price,
731 rrp_tax_excluded => $price,
734 ecost_tax_included => $ecost,
735 ecost_tax_excluded => $ecost,
739 currency => $vendor->listprice(),
742 # suppliers references
743 if ( $item->reference() ) {
744 $order_hash->{suppliers_reference_number} = $item->reference;
745 $order_hash->{suppliers_reference_qualifier} = 'QLI';
747 elsif ( $item->orderline_reference_number() ) {
748 $order_hash->{suppliers_reference_number} =
749 $item->orderline_reference_number;
750 $order_hash->{suppliers_reference_qualifier} = 'SLI';
752 if ( $item->item_number_id ) { # suppliers ean
753 $order_hash->{line_item_id} = $item->item_number_id;
756 if ( $item->girfield('servicing_instruction') ) {
760 while ( $si = $item->girfield( 'servicing_instruction', $occ ) ) {
769 $order_hash->{order_vendornote} = $order_note;
772 if ( $item->internal_notes() ) {
773 if ( $order_hash->{order_internalnote} ) { # more than ''
774 $order_hash->{order_internalnote} .= q{ };
776 $order_hash->{order_internalnote} .= $item->internal_notes;
779 my $budget = _get_budget( $schema, $item->girfield('fund_allocation') );
783 if ( $item->quantity > 1 ) {
784 carp 'Skipping line with no budget info';
785 $logger->trace('girfield skipped for invalid budget');
789 carp 'Skipping line with no budget info';
790 $logger->trace('orderline skipped for invalid budget');
800 $order_hash->{budget_id} = $budget->budget_id;
801 my $first_order = $schema->resultset('Aqorder')->create($order_hash);
802 my $o = $first_order->ordernumber();
803 $logger->trace("Order created :$o");
805 # should be done by database settings
806 $first_order->parent_ordernumber( $first_order->ordernumber() );
807 $first_order->update();
809 # add to $budgets to prevent duplicate orderlines
810 $budgets{ $budget->budget_id } = '1';
812 # record ordernumber against budget
813 $ordernumber{ $budget->budget_id } = $o;
815 if ( C4::Context->preference('AcqCreateItem') eq 'ordering' ) {
816 $item_hash = _create_item_from_quote( $item, $quote );
819 while ( $created < $order_quantity ) {
820 $item_hash->{biblionumber} = $bib->{biblionumber};
821 $item_hash->{biblioitemnumber} = $bib->{biblioitemnumber};
822 my $kitem = Koha::Item->new( $item_hash )->store;
823 my $itemnumber = $kitem->itemnumber;
824 $logger->trace("Added item:$itemnumber");
825 $schema->resultset('AqordersItem')->create(
827 ordernumber => $first_order->ordernumber,
828 itemnumber => $itemnumber,
833 my $lrp = $item->girfield('library_rotation_plan');
835 my $rota = Koha::StockRotationRotas->find(
837 { key => 'stockrotationrotas_title' }
840 $rota->add_item($itemnumber);
841 $logger->trace("Item added to rota $rota->id");
843 $logger->error("No rota found matching $lrp in orderline");
850 if ( $order_quantity == 1 && $item->quantity > 1 ) {
851 my $occurrence = 1; # occ zero already added
852 while ( $occurrence < $item->quantity ) {
855 $budget = _get_budget( $schema,
856 $item->girfield( 'fund_allocation', $occurrence ) );
860 $item->girfield( 'fund_allocation', $occurrence );
861 carp 'Skipping line with no budget info';
863 "girfield skipped for invalid budget:$bad_budget");
864 ++$occurrence; ## lets look at the next one not this one again
868 # add orderline for NEW budget in $budgets
869 if ( !exists $budgets{ $budget->budget_id } ) {
871 # $order_hash->{quantity} = 1; by default above
872 # we should handle both 1:1 GIR & 1:n GIR (with LQT values) here
874 $order_hash->{budget_id} = $budget->budget_id;
877 $schema->resultset('Aqorder')->create($order_hash);
878 my $o = $new_order->ordernumber();
879 $logger->trace("Order created :$o");
881 # should be done by database settings
882 $new_order->parent_ordernumber( $new_order->ordernumber() );
883 $new_order->update();
885 # add to $budgets to prevent duplicate orderlines
886 $budgets{ $budget->budget_id } = '1';
888 # record ordernumber against budget
889 $ordernumber{ $budget->budget_id } = $o;
891 if ( C4::Context->preference('AcqCreateItem') eq 'ordering' ) {
892 if ( !defined $item_hash ) {
893 $item_hash = _create_item_from_quote( $item, $quote );
897 $item->girfield( 'stock_category', $occurrence ),
899 $item->girfield( 'shelfmark', $occurrence )
900 || $item->girfield( 'classification', $occurrence )
901 || title_level_class($item),
903 $item->girfield( 'branch', $occurrence ),
904 homebranch => $item->girfield( 'branch', $occurrence ),
907 my $lsq_field = C4::Context->preference('EdifactLSQ');
908 $new_item->{$lsq_field} = $item->girfield( 'sequence_code', $occurrence );
910 if ( $new_item->{itype} ) {
911 $item_hash->{itype} = $new_item->{itype};
913 if ( $new_item->{$lsq_field} ) {
914 $item_hash->{$lsq_field} = $new_item->{$lsq_field};
916 if ( $new_item->{itemcallnumber} ) {
917 $item_hash->{itemcallnumber} =
918 $new_item->{itemcallnumber};
920 if ( $new_item->{holdingbranch} ) {
921 $item_hash->{holdingbranch} =
922 $new_item->{holdingbranch};
924 if ( $new_item->{homebranch} ) {
925 $item_hash->{homebranch} = $new_item->{homebranch};
928 $item_hash->{biblionumber} = $bib->{biblionumber};
929 $item_hash->{biblioitemnumber} = $bib->{biblioitemnumber};
930 my $kitem = Koha::Item->new( $item_hash )->store;
931 my $itemnumber = $kitem->itemnumber;
932 $logger->trace("New item $itemnumber added");
933 $schema->resultset('AqordersItem')->create(
935 ordernumber => $new_order->ordernumber,
936 itemnumber => $itemnumber,
941 $item->girfield( 'library_rotation_plan', $occurrence );
944 Koha::StockRotationRotas->find( { title => $lrp },
945 { key => 'stockrotationrotas_title' } );
947 $rota->add_item($itemnumber);
948 $logger->trace("Item added to rota $rota->id");
952 "No rota found matching $lrp in orderline");
960 # increment quantity in orderline for EXISTING budget in $budgets
962 my $row = $schema->resultset('Aqorder')->find(
964 ordernumber => $ordernumber{ $budget->budget_id }
968 my $qty = $row->quantity;
977 # Do not use the basket level value as it is always NULL
978 # See calling subs call to AddBasket
979 if ( C4::Context->preference('AcqCreateItem') eq 'ordering' ) {
985 replacementprice => $price,
987 $item->girfield( 'stock_category', $occurrence ),
989 $item->girfield( 'shelfmark', $occurrence )
990 || $item->girfield( 'classification', $occurrence )
991 || $item_hash->{itemcallnumber},
993 $item->girfield( 'branch', $occurrence ),
994 homebranch => $item->girfield( 'branch', $occurrence ),
996 my $lsq_field = C4::Context->preference('EdifactLSQ');
997 $new_item->{$lsq_field} = $item->girfield( 'sequence_code', $occurrence );
998 $new_item->{biblionumber} = $bib->{biblionumber};
999 $new_item->{biblioitemnumber} = $bib->{biblioitemnumber};
1000 my $kitem = Koha::Item->new( $new_item )->store;
1001 my $itemnumber = $kitem->itemnumber;
1002 $logger->trace("New item $itemnumber added");
1003 $schema->resultset('AqordersItem')->create(
1005 ordernumber => $ordernumber{ $budget->budget_id },
1006 itemnumber => $itemnumber,
1011 $item->girfield( 'library_rotation_plan', $occurrence );
1014 Koha::StockRotationRotas->find( { title => $lrp },
1015 { key => 'stockrotationrotas_title' } );
1017 $rota->add_item($itemnumber);
1018 $logger->trace("Item added to rota $rota->id");
1022 "No rota found matching $lrp in orderline");
1035 sub get_edifact_ean {
1037 my $dbh = C4::Context->dbh;
1039 my $eans = $dbh->selectcol_arrayref('select ean from edifact_ean');
1044 # We should not need to have a routine to do this here
1045 sub _discounted_price {
1046 my ( $discount, $price, $discounted_price ) = @_;
1047 if (defined $discounted_price) {
1048 return $discounted_price;
1053 return $price - ( ( $discount * $price ) / 100 );
1056 sub _check_for_existing_bib {
1059 my $search_isbn = $isbn;
1060 $search_isbn =~ s/^\s*/%/xms;
1061 $search_isbn =~ s/\s*$/%/xms;
1062 my $dbh = C4::Context->dbh;
1063 my $sth = $dbh->prepare(
1064 'select biblionumber, biblioitemnumber from biblioitems where isbn like ?',
1067 $dbh->selectall_arrayref( $sth, { Slice => {} }, $search_isbn );
1068 if ( @{$tuple_arr} ) {
1069 return $tuple_arr->[0];
1071 elsif ( length($isbn) == 13 && $isbn !~ /^97[89]/ ) {
1072 my $tarr = $dbh->selectall_arrayref(
1073 'select biblionumber, biblioitemnumber from biblioitems where ean = ?',
1083 $isbn =~ s/\-//xmsg;
1084 if ( $isbn =~ m/(\d{13})/xms ) {
1085 my $b_isbn = Business::ISBN->new($1);
1086 if ( $b_isbn && $b_isbn->is_valid && $b_isbn->as_isbn10 ) {
1087 $search_isbn = $b_isbn->as_isbn10->as_string( [] );
1091 elsif ( $isbn =~ m/(\d{9}[xX]|\d{10})/xms ) {
1092 my $b_isbn = Business::ISBN->new($1);
1093 if ( $b_isbn && $b_isbn->is_valid ) {
1094 $search_isbn = $b_isbn->as_isbn13->as_string( [] );
1099 $search_isbn = "%$search_isbn%";
1101 $dbh->selectall_arrayref( $sth, { Slice => {} }, $search_isbn );
1102 if ( @{$tuple_arr} ) {
1103 return $tuple_arr->[0];
1110 # returns a budget obj or undef
1111 # fact we need this shows what a mess Acq API is
1113 my ( $schema, $budget_code ) = @_;
1114 my $period_rs = $schema->resultset('Aqbudgetperiod')->search(
1116 budget_period_active => 1,
1120 # db does not ensure budget code is unque
1121 return $schema->resultset('Aqbudget')->single(
1123 budget_code => $budget_code,
1125 { -in => $period_rs->get_column('budget_period_id')->as_query },
1130 # try to get title level classification from incoming quote
1131 sub title_level_class {
1134 my $default_scheme = C4::Context->preference('DefaultClassificationSource');
1135 if ( $default_scheme eq 'ddc' ) {
1136 $class = $item->dewey_class();
1138 elsif ( $default_scheme eq 'lcc' ) {
1139 $class = $item->lc_class();
1143 $item->girfield('shelfmark')
1144 || $item->girfield('classification')
1150 sub _create_bib_from_quote {
1152 #TBD we should flag this for updating from an external source
1153 #As biblio (&biblioitems) has no candidates flag in order
1154 my ( $item, $quote ) = @_;
1155 my $itemid = $item->item_number_id;
1156 my $defalt_classification_source =
1157 C4::Context->preference('DefaultClassificationSource');
1159 'biblioitems.cn_source' => $defalt_classification_source,
1160 'items.cn_source' => $defalt_classification_source,
1161 'items.notforloan' => -1,
1162 'items.cn_sort' => q{},
1164 $bib_hash->{'biblio.seriestitle'} = $item->series;
1166 $bib_hash->{'biblioitems.publishercode'} = $item->publisher;
1167 $bib_hash->{'biblioitems.publicationyear'} =
1168 $bib_hash->{'biblio.copyrightdate'} = $item->publication_date;
1170 $bib_hash->{'biblio.title'} = $item->title;
1171 $bib_hash->{'biblio.author'} = $item->author;
1172 $bib_hash->{'biblioitems.isbn'} = $item->item_number_id;
1173 $bib_hash->{'biblioitems.itemtype'} = $item->girfield('stock_category');
1175 # If we have a 13 digit id we are assuming its an ean
1176 # (it may also be an isbn or issn)
1177 if ( $itemid =~ /^\d{13}$/ ) {
1178 $bib_hash->{'biblioitems.ean'} = $itemid;
1179 if ( $itemid =~ /^977/ ) {
1180 $bib_hash->{'biblioitems.issn'} = $itemid;
1183 for my $key ( keys %{$bib_hash} ) {
1184 if ( !defined $bib_hash->{$key} ) {
1185 delete $bib_hash->{$key};
1188 return TransformKohaToMarc($bib_hash);
1192 sub _create_item_from_quote {
1193 my ( $item, $quote ) = @_;
1194 my $defalt_classification_source =
1195 C4::Context->preference('DefaultClassificationSource');
1197 cn_source => $defalt_classification_source,
1201 $item_hash->{booksellerid} = $quote->vendor_id;
1202 $item_hash->{price} = $item_hash->{replacementprice} = $item->price;
1203 $item_hash->{itype} = $item->girfield('stock_category');
1204 my $lsq_field = C4::Context->preference('EdifactLSQ');
1205 $item_hash->{$lsq_field} = $item->girfield('sequence_code');
1209 $item_hash->{itemcallnumber} =
1210 $item->girfield('shelfmark')
1211 || $item->girfield('classification')
1212 || title_level_class($item);
1214 my $branch = $item->girfield('branch');
1215 $item_hash->{holdingbranch} = $item_hash->{homebranch} = $branch;
1228 Module exporting subroutines used in EDI processing for Koha
1232 Subroutines called by batch processing to handle Edifact
1233 messages of various types and related utilities
1237 These routines should really be methods of some object.
1238 get_edifact_ean is a stopgap which should be replaced
1242 =head2 process_quote
1244 process_quote(quote_message);
1246 passed a message object for a quote, parses it creating an order basket
1247 and orderlines in the database
1248 updates the message's status to received in the database and adds the
1251 =head2 process_invoice
1253 process_invoice(invoice_message)
1255 passed a message object for an invoice, add the contained invoices
1256 and update the orderlines referred to in the invoice
1257 As an Edifact invoice is in effect a despatch note this receipts the
1258 appropriate quantities in the orders
1260 no meaningful return value
1262 =head2 process_ordrsp
1264 process_ordrsp(ordrsp_message)
1266 passed a message object for a supplier response, process the contents
1267 If an orderline is cancelled cancel the corresponding orderline in koha
1268 otherwise record the supplier message against it
1270 no meaningful return value
1272 =head2 create_edi_order
1274 create_edi_order( { parameter_hashref } )
1276 parameters must include basketno and ean
1278 branchcode can optionally be passed
1280 returns 1 on success undef otherwise
1282 if the parameter noingest is set the formatted order is returned
1283 and not saved in the database. This functionality is intended for debugging only
1285 =head2 receipt_items
1287 receipt_items( schema_obj, invoice_line, ordernumber, $quantity)
1289 receipts the items recorded on this invoice line
1291 no meaningful return
1293 =head2 transfer_items
1295 transfer_items(schema, invoice_line, originating_order, receiving_order, $quantity)
1297 Transfer the items covered by this invoice line from their original
1298 order to another order recording the partial fulfillment of the original
1301 no meaningful return
1303 =head2 get_edifact_ean
1305 $ean = get_edifact_ean();
1307 routine to return the ean.
1311 quote_item(lineitem, quote_message);
1313 Called by process_quote to handle an individual lineitem
1314 Generate the biblios and items if required and orderline linking to them
1316 Returns 1 on success undef on error
1318 Most usual cause of error is a line with no or incorrect budget codes
1319 which woild cause order creation to abort
1320 If other correct lines exist these are processed and the erroneous line os logged
1322 =head2 title_level_class
1324 classmark = title_level_class(edi_item)
1326 Trys to return a title level classmark from a quote message line
1327 Will return a dewey or lcc classmark if one exists according to the
1328 value in DefaultClassificationSource syspref
1330 If unable to returns the shelfmark or classification from the GIR segment
1332 If all else fails returns empty string
1334 =head2 _create_bib_from_quote
1336 marc_record_obj = _create_bib_from_quote(lineitem, quote)
1338 Returns a MARC::Record object based on the info in the quote's lineitem
1340 =head2 _create_item_from_quote
1342 item_hashref = _create_item_from_quote( lineitem, quote)
1344 returns a hashref representing the item fields specified in the quote
1346 =head2 _get_invoiced_price
1348 (price, price_tax_excluded) = _get_invoiced_price(line_object, $quantity)
1350 Returns an array of unitprice and unitprice_tax_excluded derived from the lineitem
1353 =head2 _discounted_price
1355 ecost = _discounted_price(discount, item_price, discounted_price)
1357 utility subroutine to return a price calculated from the
1358 vendors discount and quoted price
1359 if invoice has a field containing discounted price that is returned
1360 instead of recalculating
1362 =head2 _check_for_existing_bib
1364 (biblionumber, biblioitemnumber) = _check_for_existing_bib(isbn_or_ean)
1366 passed an isbn or ean attempts to locate a match bib
1367 On success returns biblionumber and biblioitemnumber
1368 On failure returns undefined/an empty list
1372 b = _get_budget(schema_obj, budget_code)
1374 Returns the Aqbudget object for the active budget given the passed budget_code
1375 or undefined if one does not exist
1379 Colin Campbell <colin.campbell@ptfs-europe.com>
1384 Copyright 2014,2015 PTFS-Europe Ltd
1385 This program is free software, You may redistribute it under
1386 under the terms of the GNU General Public License