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::Handler;
45 use Koha::Acquisition::Baskets;
46 use Koha::Acquisition::Booksellers;
50 our (@ISA, @EXPORT_OK);
63 sub create_edi_order {
64 my $parameters = shift;
65 my $basketno = $parameters->{basketno};
66 my $ean = $parameters->{ean};
67 my $branchcode = $parameters->{branchcode};
68 my $noingest = $parameters->{noingest};
69 if ( !$basketno || !$ean ) {
70 carp 'create_edi_order called with no basketno or ean';
74 my $schema = Koha::Database->new()->schema();
76 my @orderlines = $schema->resultset('Aqorder')->search(
78 basketno => $basketno,
84 carp "No orderlines for basket $basketno";
88 my $vendor = $schema->resultset('VendorEdiAccount')->search(
90 vendor_id => $orderlines[0]->basketno->booksellerid->id,
94 my $ean_search_keys = { ean => $ean, };
96 $ean_search_keys->{branchcode} = $branchcode;
99 $schema->resultset('EdifactEan')->search($ean_search_keys)->single;
101 # If no branch specific each can be found, look for a default ean
103 $ean_obj = $schema->resultset('EdifactEan')->search(
111 my $dbh = C4::Context->dbh;
112 my $arr_ref = $dbh->selectcol_arrayref(
113 'select id from edifact_messages where basketno = ? and message_type = \'QUOTE\'',
116 my $response = @{$arr_ref} ? 1 : 0;
118 my $edifact_order_params = {
119 orderlines => \@orderlines,
122 is_response => $response,
126 if ( $vendor->plugin ) {
127 $edifact = Koha::Plugins::Handler->run(
129 class => $vendor->plugin,
130 method => 'edifact_order',
132 params => $edifact_order_params,
138 $edifact = Koha::Edifact::Order->new($edifact_order_params);
141 return unless $edifact;
143 my $order_file = $edifact->encode();
147 my $m = unidecode($order_file); # remove diacritics and non-latin chars
148 if ($noingest) { # allows scripts to produce test files
152 message_type => 'ORDERS',
154 vendor_id => $vendor->vendor_id,
156 basketno => $basketno,
157 filename => $edifact->filename(),
158 transfer_date => $edifact->msg_date_string(),
159 edi_acct => $vendor->id,
162 $schema->resultset('EdifactMessage')->create($order);
170 my $response_message = shift;
171 $response_message->status('processing');
172 $response_message->update;
173 my $schema = Koha::Database->new()->schema();
174 my $logger = Log::Log4perl->get_logger();
177 Koha::Edifact->new( { transmission => $response_message->raw_msg, } );
178 my $messages = $edi->message_array();
180 if ( @{$messages} ) {
181 foreach my $msg ( @{$messages} ) {
182 my $lines = $msg->lineitems();
183 foreach my $line ( @{$lines} ) {
184 my $ordernumber = $line->ordernumber();
186 # action cancelled:change_requested:no_action:accepted:not_found:recorded
187 my $action = $line->action_notification();
188 if ( $action eq 'cancelled' ) {
189 my $reason = $line->coded_orderline_text();
192 ordernumber => $ordernumber,
193 cancellationreason => $reason,
194 orderstatus => 'cancelled',
195 datecancellationprinted => dt_from_string()->ymd(),
199 else { # record order as due with possible further info
201 my $report = $line->coded_orderline_text();
202 my $date_avail = $line->availability_date();
205 $report .= " Available: $date_avail";
209 ordernumber => $ordernumber,
210 suppliers_report => $report,
218 $response_message->status('received');
219 $response_message->update;
223 sub process_invoice {
224 my $invoice_message = shift;
225 $invoice_message->status('processing');
226 $invoice_message->update;
227 my $schema = Koha::Database->new()->schema();
228 my $logger = Log::Log4perl->get_logger();
231 my $plugin_class = $invoice_message->edi_acct()->plugin();
233 # Plugin has its own invoice processor, only run it and not the standard invoice processor below
234 if ( $plugin_class ) {
235 my $plugin = $plugin_class->new();
236 if ( $plugin->can('edifact_process_invoice') ) {
237 Koha::Plugins::Handler->run(
239 class => $plugin_class,
240 method => 'edifact_process_invoice',
242 invoice => $invoice_message,
251 if ( $plugin_class ) {
252 $edi_plugin = Koha::Plugins::Handler->run(
254 class => $plugin_class,
257 invoice_message => $invoice_message,
258 transmission => $invoice_message->raw_msg,
264 my $edi = $edi_plugin ||
265 Koha::Edifact->new( { transmission => $invoice_message->raw_msg, } );
267 my $messages = $edi->message_array();
269 if ( @{$messages} ) {
271 # BGM contains an invoice number
272 foreach my $msg ( @{$messages} ) {
273 my $invoicenumber = $msg->docmsg_number();
274 my $shipmentcharge = $msg->shipment_charge();
275 my $msg_date = $msg->message_date;
276 my $tax_date = $msg->tax_point_date;
277 if ( !defined $tax_date || $tax_date !~ m/^\d{8}/xms ) {
278 $tax_date = $msg_date;
281 my $vendor_ean = $msg->supplier_ean;
282 if ( !defined $vendor_acct || $vendor_ean ne $vendor_acct->san ) {
283 $vendor_acct = $schema->resultset('VendorEdiAccount')->search(
289 if ( !$vendor_acct ) {
291 "Cannot find vendor with ean $vendor_ean for invoice $invoicenumber in $invoice_message->filename";
294 $invoice_message->edi_acct( $vendor_acct->id );
295 $logger->trace("Adding invoice:$invoicenumber");
296 my $new_invoice = $schema->resultset('Aqinvoice')->create(
298 invoicenumber => $invoicenumber,
299 booksellerid => $invoice_message->vendor_id,
300 shipmentdate => $msg_date,
301 billingdate => $tax_date,
302 shipmentcost => $shipmentcharge,
303 shipmentcost_budgetid => $vendor_acct->shipment_budget,
304 message_id => $invoice_message->id,
307 my $invoiceid = $new_invoice->invoiceid;
308 $logger->trace("Added as invoiceno :$invoiceid");
309 my $lines = $msg->lineitems();
311 foreach my $line ( @{$lines} ) {
312 my $ordernumber = $line->ordernumber;
313 $logger->trace( "Receipting order:$ordernumber Qty: ",
316 my $order = $schema->resultset('Aqorder')->find($ordernumber);
318 # ModReceiveOrder does not validate that $ordernumber exists validate here
322 my $s = $schema->resultset('Suggestion')->search(
324 biblionumber => $order->biblionumber->biblionumber,
330 suggestionid => $s->suggestionid,
331 STATUS => 'AVAILABLE',
335 # If quantity_invoiced is present use it in preference
336 my $quantity = $line->quantity_invoiced;
338 $quantity = $line->quantity;
341 my ( $price, $price_excl_tax ) = _get_invoiced_price($line, $quantity);
342 my $tax_rate = $line->tax_rate;
343 if ($tax_rate && $tax_rate->{rate} != 0) {
344 $tax_rate->{rate} /= 100;
347 if ( $order->quantity > $quantity ) {
348 my $ordered = $order->quantity;
351 $order->orderstatus('partial');
352 $order->quantity( $ordered - $quantity );
354 my $received_order = $order->copy(
356 ordernumber => undef,
357 quantity => $quantity,
358 quantityreceived => $quantity,
359 orderstatus => 'complete',
361 unitprice_tax_included => $price,
362 unitprice_tax_excluded => $price_excl_tax,
363 invoiceid => $invoiceid,
364 datereceived => $msg_date,
365 tax_rate_on_receiving => $tax_rate->{rate},
366 tax_value_on_receiving => $quantity * $price_excl_tax * $tax_rate->{rate},
369 transfer_items( $schema, $line, $order,
370 $received_order, $quantity );
371 receipt_items( $schema, $line,
372 $received_order->ordernumber, $quantity );
374 else { # simple receipt all copies on order
375 $order->quantityreceived( $quantity );
376 $order->datereceived($msg_date);
377 $order->invoiceid($invoiceid);
378 $order->unitprice($price);
379 $order->unitprice_tax_excluded($price_excl_tax);
380 $order->unitprice_tax_included($price);
381 $order->tax_rate_on_receiving($tax_rate->{rate});
382 $order->tax_value_on_receiving( $quantity * $price_excl_tax * $tax_rate->{rate});
383 $order->orderstatus('complete');
385 receipt_items( $schema, $line, $ordernumber, $quantity );
390 "No order found for $ordernumber Invoice:$invoicenumber"
400 $invoice_message->status('received');
401 $invoice_message->update; # status and basketno link
405 sub _get_invoiced_price {
408 my $line_total = $line->amt_total;
409 my $excl_tax = $line->amt_lineitem;
411 # If no tax some suppliers omit the total owed
412 # If no total given calculate from cost exclusive of tax
413 # + tax amount (if present, sometimes omitted if 0 )
414 if ( !defined $line_total ) {
415 my $x = $line->amt_taxoncharge;
419 $line_total = $excl_tax + $x;
422 # invoices give amounts per orderline, Koha requires that we store
425 return ( $line_total / $qty, $excl_tax / $qty );
427 return ( $line_total, $excl_tax ); # return as is for most common case
431 my ( $schema, $inv_line, $ordernumber, $quantity ) = @_;
432 my $logger = Log::Log4perl->get_logger();
434 # itemnumber is not a foreign key ??? makes this a bit cumbersome
435 my @item_links = $schema->resultset('AqordersItem')->search(
437 ordernumber => $ordernumber,
441 foreach my $ilink (@item_links) {
442 my $item = $schema->resultset('Item')->find( $ilink->itemnumber );
444 my $i = $ilink->itemnumber;
446 "Cannot find aqorder item for $i :Order:$ordernumber");
449 my $b = $item->get_column('homebranch');
450 if ( !exists $branch_map{$b} ) {
451 $branch_map{$b} = [];
453 push @{ $branch_map{$b} }, $item;
456 # Handling for 'AcqItemSetSubfieldsWhenReceived'
460 if ( C4::Context->preference('AcqCreateItem') eq 'ordering' ) {
461 @affects = split q{\|},
462 C4::Context->preference("AcqItemSetSubfieldsWhenReceived");
464 my $order = Koha::Acquisition::Orders->find($ordernumber);
465 $biblionumber = $order->biblionumber;
466 my $frameworkcode = GetFrameworkCode($biblionumber);
467 ($itemfield) = GetMarcFromKohaField( 'items.itemnumber',
472 my $gir_occurrence = 0;
473 while ( $gir_occurrence < $quantity ) {
474 my $branch = $inv_line->girfield( 'branch', $gir_occurrence );
475 my $item = shift @{ $branch_map{$branch} };
477 my $barcode = $inv_line->girfield( 'barcode', $gir_occurrence );
478 if ( $barcode && !$item->barcode ) {
479 my $rs = $schema->resultset('Item')->search(
484 if ( $rs->count > 0 ) {
485 $logger->warn("Barcode $barcode is a duplicate");
489 $logger->trace("Adding barcode $barcode");
490 $item->barcode($barcode);
494 # Handling for 'AcqItemSetSubfieldsWhenReceived'
496 my $item_marc = C4::Items::GetMarcItem( $biblionumber, $item->itemnumber );
497 for my $affect (@affects) {
498 my ( $sf, $v ) = split q{=}, $affect, 2;
499 foreach ( $item_marc->field($itemfield) ) {
500 $_->update( $sf => $v );
503 C4::Items::ModItemFromMarc( $item_marc, $biblionumber, $item->itemnumber );
509 $logger->warn("Unmatched item at branch:$branch");
518 my ( $schema, $inv_line, $order_from, $order_to, $quantity ) = @_;
520 # Transfer x items from the orig order to a completed partial order
522 my %mapped_by_branch;
523 while ( $gocc < $quantity ) {
524 my $branch = $inv_line->girfield( 'branch', $gocc );
525 if ( !exists $mapped_by_branch{$branch} ) {
526 $mapped_by_branch{$branch} = 1;
529 $mapped_by_branch{$branch}++;
533 my $logger = Log::Log4perl->get_logger();
534 my $o1 = $order_from->ordernumber;
535 my $o2 = $order_to->ordernumber;
536 $logger->warn("transferring $quantity copies from order $o1 to order $o2");
538 my @item_links = $schema->resultset('AqordersItem')->search(
540 ordernumber => $order_from->ordernumber,
543 foreach my $ilink (@item_links) {
544 my $ino = $ilink->itemnumber;
545 my $item = $schema->resultset('Item')->find( $ilink->itemnumber );
546 my $i_branch = $item->get_column('homebranch');
547 if ( exists $mapped_by_branch{$i_branch}
548 && $mapped_by_branch{$i_branch} > 0 )
550 $ilink->ordernumber( $order_to->ordernumber );
553 --$mapped_by_branch{$i_branch};
554 $logger->warn("Transferred item $item");
557 $logger->warn("Skipped item $item");
559 if ( $quantity < 1 ) {
570 $quote->status('processing');
573 my $edi = Koha::Edifact->new( { transmission => $quote->raw_msg, } );
575 my $messages = $edi->message_array();
576 my $process_errors = 0;
577 my $logger = Log::Log4perl->get_logger();
578 my $schema = Koha::Database->new()->schema();
579 my $message_count = 0;
580 my @added_baskets; # if auto & multiple baskets need to order all
582 if ( @{$messages} && $quote->vendor_id ) {
583 foreach my $msg ( @{$messages} ) {
586 NewBasket( $quote->vendor_id, 0, $quote->filename, q{},
588 push @added_baskets, $basketno;
589 if ( $message_count > 1 ) {
590 my $m_filename = $quote->filename;
591 $m_filename .= "_$message_count";
592 $schema->resultset('EdifactMessage')->create(
594 message_type => $quote->message_type,
595 transfer_date => $quote->transfer_date,
596 vendor_id => $quote->vendor_id,
597 edi_acct => $quote->edi_acct,
599 basketno => $basketno,
601 filename => $m_filename,
606 $quote->basketno($basketno);
608 $logger->trace("Created basket :$basketno");
609 my $items = $msg->lineitems();
610 my $refnum = $msg->message_refno;
612 for my $item ( @{$items} ) {
613 if ( !quote_item( $item, $quote, $basketno ) ) {
619 my $status = 'received';
620 if ($process_errors) {
624 $quote->status($status);
625 $quote->update; # status and basketno link
626 # Do we automatically generate orders for this vendor
627 my $v = $schema->resultset('VendorEdiAccount')->search(
629 vendor_id => $quote->vendor_id,
632 if ( $v->auto_orders ) {
633 for my $b (@added_baskets) {
636 ean => $messages->[0]->buyer_ean,
640 Koha::Acquisition::Baskets->find($b)->close;
642 if (C4::Context->preference("AcquisitionLog")) {
643 my $approved = Koha::Acquisition::Baskets->find( $b );
648 to_json($approved->unblessed)
659 my ( $item, $quote, $basketno ) = @_;
661 my $schema = Koha::Database->new()->schema();
662 my $logger = Log::Log4perl->get_logger();
664 # $basketno is the return from AddBasket in the calling routine
665 # So this call should not fail unless that has
666 my $basket = Koha::Acquisition::Baskets->find( $basketno );
668 $logger->error('Skipping order creation no valid basketno');
671 $logger->trace( 'Checking db for matches with ', $item->item_number_id() );
672 my $bib = _check_for_existing_bib( $item->item_number_id() );
673 if ( !defined $bib ) {
675 my $bib_record = _create_bib_from_quote( $item, $quote );
676 ( $bib->{biblionumber}, $bib->{biblioitemnumber} ) =
677 AddBiblio( $bib_record, q{} );
678 $logger->trace("New biblio added $bib->{biblionumber}");
681 $logger->trace("Match found: $bib->{biblionumber}");
684 # Create an orderline
685 my $order_note = $item->{orderline_free_text};
687 my $order_quantity = $item->quantity();
688 my $gir_count = $item->number_of_girs();
689 $order_quantity ||= 1; # quantity not necessarily present
690 if ( $gir_count > 1 ) {
691 if ( $gir_count != $order_quantity ) {
693 "Order for $order_quantity items, $gir_count segments present");
695 $order_quantity = 1; # attempts to create an orderline for each gir
697 my $price = $item->price_info;
698 # Howells do not send an info price but do have a gross price
700 $price = $item->price_gross;
702 my $vendor = Koha::Acquisition::Booksellers->find( $quote->vendor_id );
704 # NB quote will not include tax info it only contains the list price
705 my $ecost = _discounted_price( $vendor->discount, $price, $item->price_info_inclusive );
707 # database definitions should set some of these defaults but dont
709 biblionumber => $bib->{biblionumber},
710 entrydate => dt_from_string()->ymd(),
711 basketno => $basketno,
713 quantity => $order_quantity,
714 quantityreceived => 0,
715 order_vendornote => q{},
716 order_internalnote => q{},
717 replacementprice => $price,
718 rrp_tax_included => $price,
719 rrp_tax_excluded => $price,
722 ecost_tax_included => $ecost,
723 ecost_tax_excluded => $ecost,
727 currency => $vendor->listprice(),
730 # suppliers references
731 if ( $item->reference() ) {
732 $order_hash->{suppliers_reference_number} = $item->reference;
733 $order_hash->{suppliers_reference_qualifier} = 'QLI';
735 elsif ( $item->orderline_reference_number() ) {
736 $order_hash->{suppliers_reference_number} =
737 $item->orderline_reference_number;
738 $order_hash->{suppliers_reference_qualifier} = 'SLI';
740 if ( $item->item_number_id ) { # suppliers ean
741 $order_hash->{line_item_id} = $item->item_number_id;
744 if ( $item->girfield('servicing_instruction') ) {
748 while ( $si = $item->girfield( 'servicing_instruction', $occ ) ) {
757 $order_hash->{order_vendornote} = $order_note;
760 if ( $item->internal_notes() ) {
761 if ( $order_hash->{order_internalnote} ) { # more than ''
762 $order_hash->{order_internalnote} .= q{ };
764 $order_hash->{order_internalnote} .= $item->internal_notes;
767 my $budget = _get_budget( $schema, $item->girfield('fund_allocation') );
771 if ( $item->quantity > 1 ) {
772 carp 'Skipping line with no budget info';
773 $logger->trace('girfield skipped for invalid budget');
777 carp 'Skipping line with no budget info';
778 $logger->trace('orderline skipped for invalid budget');
788 $order_hash->{budget_id} = $budget->budget_id;
789 my $first_order = $schema->resultset('Aqorder')->create($order_hash);
790 my $o = $first_order->ordernumber();
791 $logger->trace("Order created :$o");
793 # should be done by database settings
794 $first_order->parent_ordernumber( $first_order->ordernumber() );
795 $first_order->update();
797 # add to $budgets to prevent duplicate orderlines
798 $budgets{ $budget->budget_id } = '1';
800 # record ordernumber against budget
801 $ordernumber{ $budget->budget_id } = $o;
803 if ( C4::Context->preference('AcqCreateItem') eq 'ordering' ) {
804 $item_hash = _create_item_from_quote( $item, $quote );
807 while ( $created < $order_quantity ) {
808 $item_hash->{biblionumber} = $bib->{biblionumber};
809 $item_hash->{biblioitemnumber} = $bib->{biblioitemnumber};
810 my $kitem = Koha::Item->new( $item_hash )->store;
811 my $itemnumber = $kitem->itemnumber;
812 $logger->trace("Added item:$itemnumber");
813 $schema->resultset('AqordersItem')->create(
815 ordernumber => $first_order->ordernumber,
816 itemnumber => $itemnumber,
824 if ( $order_quantity == 1 && $item->quantity > 1 ) {
825 my $occurrence = 1; # occ zero already added
826 while ( $occurrence < $item->quantity ) {
829 $budget = _get_budget( $schema,
830 $item->girfield( 'fund_allocation', $occurrence ) );
834 $item->girfield( 'fund_allocation', $occurrence );
835 carp 'Skipping line with no budget info';
837 "girfield skipped for invalid budget:$bad_budget");
838 ++$occurrence; ## lets look at the next one not this one again
842 # add orderline for NEW budget in $budgets
843 if ( !exists $budgets{ $budget->budget_id } ) {
845 # $order_hash->{quantity} = 1; by default above
846 # we should handle both 1:1 GIR & 1:n GIR (with LQT values) here
848 $order_hash->{budget_id} = $budget->budget_id;
851 $schema->resultset('Aqorder')->create($order_hash);
852 my $o = $new_order->ordernumber();
853 $logger->trace("Order created :$o");
855 # should be done by database settings
856 $new_order->parent_ordernumber( $new_order->ordernumber() );
857 $new_order->update();
859 # add to $budgets to prevent duplicate orderlines
860 $budgets{ $budget->budget_id } = '1';
862 # record ordernumber against budget
863 $ordernumber{ $budget->budget_id } = $o;
865 if ( C4::Context->preference('AcqCreateItem') eq 'ordering' ) {
866 if ( !defined $item_hash ) {
867 $item_hash = _create_item_from_quote( $item, $quote );
871 $item->girfield( 'stock_category', $occurrence ),
873 $item->girfield( 'collection_code', $occurrence ),
875 $item->girfield( 'shelfmark', $occurrence )
876 || $item->girfield( 'classification', $occurrence )
877 || title_level_class($item),
879 $item->girfield( 'branch', $occurrence ),
880 homebranch => $item->girfield( 'branch', $occurrence ),
882 if ( $new_item->{itype} ) {
883 $item_hash->{itype} = $new_item->{itype};
885 if ( $new_item->{location} ) {
886 $item_hash->{location} = $new_item->{location};
888 if ( $new_item->{itemcallnumber} ) {
889 $item_hash->{itemcallnumber} =
890 $new_item->{itemcallnumber};
892 if ( $new_item->{holdingbranch} ) {
893 $item_hash->{holdingbranch} =
894 $new_item->{holdingbranch};
896 if ( $new_item->{homebranch} ) {
897 $item_hash->{homebranch} = $new_item->{homebranch};
900 $item_hash->{biblionumber} = $bib->{biblionumber};
901 $item_hash->{biblioitemnumber} = $bib->{biblioitemnumber};
902 my $kitem = Koha::Item->new( $item_hash )->store;
903 my $itemnumber = $kitem->itemnumber;
904 $logger->trace("New item $itemnumber added");
905 $schema->resultset('AqordersItem')->create(
907 ordernumber => $new_order->ordernumber,
908 itemnumber => $itemnumber,
913 $item->girfield( 'library_rotation_plan', $occurrence );
916 Koha::StockRotationRotas->find( { title => $lrp },
917 { key => 'stockrotationrotas_title' } );
919 $rota->add_item($itemnumber);
920 $logger->trace("Item added to rota $rota->id");
924 "No rota found matching $lrp in orderline");
932 # increment quantity in orderline for EXISTING budget in $budgets
934 my $row = $schema->resultset('Aqorder')->find(
936 ordernumber => $ordernumber{ $budget->budget_id }
940 my $qty = $row->quantity;
949 # Do not use the basket level value as it is always NULL
950 # See calling subs call to AddBasket
951 if ( C4::Context->preference('AcqCreateItem') eq 'ordering' ) {
957 replacementprice => $price,
959 $item->girfield( 'stock_category', $occurrence ),
961 $item->girfield( 'collection_code', $occurrence ),
963 $item->girfield( 'shelfmark', $occurrence )
964 || $item->girfield( 'classification', $occurrence )
965 || $item_hash->{itemcallnumber},
967 $item->girfield( 'branch', $occurrence ),
968 homebranch => $item->girfield( 'branch', $occurrence ),
970 $new_item->{biblionumber} = $bib->{biblionumber};
971 $new_item->{biblioitemnumber} = $bib->{biblioitemnumber};
972 my $kitem = Koha::Item->new( $new_item )->store;
973 my $itemnumber = $kitem->itemnumber;
974 $logger->trace("New item $itemnumber added");
975 $schema->resultset('AqordersItem')->create(
977 ordernumber => $ordernumber{ $budget->budget_id },
978 itemnumber => $itemnumber,
983 $item->girfield( 'library_rotation_plan', $occurrence );
986 Koha::StockRotationRotas->find( { title => $lrp },
987 { key => 'stockrotationrotas_title' } );
989 $rota->add_item($itemnumber);
990 $logger->trace("Item added to rota $rota->id");
994 "No rota found matching $lrp in orderline");
1007 sub get_edifact_ean {
1009 my $dbh = C4::Context->dbh;
1011 my $eans = $dbh->selectcol_arrayref('select ean from edifact_ean');
1016 # We should not need to have a routine to do this here
1017 sub _discounted_price {
1018 my ( $discount, $price, $discounted_price ) = @_;
1019 if (defined $discounted_price) {
1020 return $discounted_price;
1025 return $price - ( ( $discount * $price ) / 100 );
1028 sub _check_for_existing_bib {
1031 my $search_isbn = $isbn;
1032 $search_isbn =~ s/^\s*/%/xms;
1033 $search_isbn =~ s/\s*$/%/xms;
1034 my $dbh = C4::Context->dbh;
1035 my $sth = $dbh->prepare(
1036 'select biblionumber, biblioitemnumber from biblioitems where isbn like ?',
1039 $dbh->selectall_arrayref( $sth, { Slice => {} }, $search_isbn );
1040 if ( @{$tuple_arr} ) {
1041 return $tuple_arr->[0];
1043 elsif ( length($isbn) == 13 && $isbn !~ /^97[89]/ ) {
1044 my $tarr = $dbh->selectall_arrayref(
1045 'select biblionumber, biblioitemnumber from biblioitems where ean = ?',
1055 $isbn =~ s/\-//xmsg;
1056 if ( $isbn =~ m/(\d{13})/xms ) {
1057 my $b_isbn = Business::ISBN->new($1);
1058 if ( $b_isbn && $b_isbn->is_valid && $b_isbn->as_isbn10 ) {
1059 $search_isbn = $b_isbn->as_isbn10->as_string( [] );
1063 elsif ( $isbn =~ m/(\d{9}[xX]|\d{10})/xms ) {
1064 my $b_isbn = Business::ISBN->new($1);
1065 if ( $b_isbn && $b_isbn->is_valid ) {
1066 $search_isbn = $b_isbn->as_isbn13->as_string( [] );
1071 $search_isbn = "%$search_isbn%";
1073 $dbh->selectall_arrayref( $sth, { Slice => {} }, $search_isbn );
1074 if ( @{$tuple_arr} ) {
1075 return $tuple_arr->[0];
1082 # returns a budget obj or undef
1083 # fact we need this shows what a mess Acq API is
1085 my ( $schema, $budget_code ) = @_;
1086 my $period_rs = $schema->resultset('Aqbudgetperiod')->search(
1088 budget_period_active => 1,
1092 # db does not ensure budget code is unque
1093 return $schema->resultset('Aqbudget')->single(
1095 budget_code => $budget_code,
1097 { -in => $period_rs->get_column('budget_period_id')->as_query },
1102 # try to get title level classification from incoming quote
1103 sub title_level_class {
1106 my $default_scheme = C4::Context->preference('DefaultClassificationSource');
1107 if ( $default_scheme eq 'ddc' ) {
1108 $class = $item->dewey_class();
1110 elsif ( $default_scheme eq 'lcc' ) {
1111 $class = $item->lc_class();
1115 $item->girfield('shelfmark')
1116 || $item->girfield('classification')
1122 sub _create_bib_from_quote {
1124 #TBD we should flag this for updating from an external source
1125 #As biblio (&biblioitems) has no candidates flag in order
1126 my ( $item, $quote ) = @_;
1127 my $itemid = $item->item_number_id;
1128 my $defalt_classification_source =
1129 C4::Context->preference('DefaultClassificationSource');
1131 'biblioitems.cn_source' => $defalt_classification_source,
1132 'items.cn_source' => $defalt_classification_source,
1133 'items.notforloan' => -1,
1134 'items.cn_sort' => q{},
1136 $bib_hash->{'biblio.seriestitle'} = $item->series;
1138 $bib_hash->{'biblioitems.publishercode'} = $item->publisher;
1139 $bib_hash->{'biblioitems.publicationyear'} =
1140 $bib_hash->{'biblio.copyrightdate'} = $item->publication_date;
1142 $bib_hash->{'biblio.title'} = $item->title;
1143 $bib_hash->{'biblio.author'} = $item->author;
1144 $bib_hash->{'biblioitems.isbn'} = $item->item_number_id;
1145 $bib_hash->{'biblioitems.itemtype'} = $item->girfield('stock_category');
1147 # If we have a 13 digit id we are assuming its an ean
1148 # (it may also be an isbn or issn)
1149 if ( $itemid =~ /^\d{13}$/ ) {
1150 $bib_hash->{'biblioitems.ean'} = $itemid;
1151 if ( $itemid =~ /^977/ ) {
1152 $bib_hash->{'biblioitems.issn'} = $itemid;
1155 for my $key ( keys %{$bib_hash} ) {
1156 if ( !defined $bib_hash->{$key} ) {
1157 delete $bib_hash->{$key};
1160 return TransformKohaToMarc($bib_hash);
1164 sub _create_item_from_quote {
1165 my ( $item, $quote ) = @_;
1166 my $defalt_classification_source =
1167 C4::Context->preference('DefaultClassificationSource');
1169 cn_source => $defalt_classification_source,
1173 $item_hash->{booksellerid} = $quote->vendor_id;
1174 $item_hash->{price} = $item_hash->{replacementprice} = $item->price;
1175 $item_hash->{itype} = $item->girfield('stock_category');
1176 $item_hash->{location} = $item->girfield('collection_code');
1180 $item_hash->{itemcallnumber} =
1181 $item->girfield('shelfmark')
1182 || $item->girfield('classification')
1183 || title_level_class($item);
1185 my $branch = $item->girfield('branch');
1186 $item_hash->{holdingbranch} = $item_hash->{homebranch} = $branch;
1199 Module exporting subroutines used in EDI processing for Koha
1203 Subroutines called by batch processing to handle Edifact
1204 messages of various types and related utilities
1208 These routines should really be methods of some object.
1209 get_edifact_ean is a stopgap which should be replaced
1213 =head2 process_quote
1215 process_quote(quote_message);
1217 passed a message object for a quote, parses it creating an order basket
1218 and orderlines in the database
1219 updates the message's status to received in the database and adds the
1222 =head2 process_invoice
1224 process_invoice(invoice_message)
1226 passed a message object for an invoice, add the contained invoices
1227 and update the orderlines referred to in the invoice
1228 As an Edifact invoice is in effect a despatch note this receipts the
1229 appropriate quantities in the orders
1231 no meaningful return value
1233 =head2 process_ordrsp
1235 process_ordrsp(ordrsp_message)
1237 passed a message object for a supplier response, process the contents
1238 If an orderline is cancelled cancel the corresponding orderline in koha
1239 otherwise record the supplier message against it
1241 no meaningful return value
1243 =head2 create_edi_order
1245 create_edi_order( { parameter_hashref } )
1247 parameters must include basketno and ean
1249 branchcode can optionally be passed
1251 returns 1 on success undef otherwise
1253 if the parameter noingest is set the formatted order is returned
1254 and not saved in the database. This functionality is intended for debugging only
1256 =head2 receipt_items
1258 receipt_items( schema_obj, invoice_line, ordernumber, $quantity)
1260 receipts the items recorded on this invoice line
1262 no meaningful return
1264 =head2 transfer_items
1266 transfer_items(schema, invoice_line, originating_order, receiving_order, $quantity)
1268 Transfer the items covered by this invoice line from their original
1269 order to another order recording the partial fulfillment of the original
1272 no meaningful return
1274 =head2 get_edifact_ean
1276 $ean = get_edifact_ean();
1278 routine to return the ean.
1282 quote_item(lineitem, quote_message);
1284 Called by process_quote to handle an individual lineitem
1285 Generate the biblios and items if required and orderline linking to them
1287 Returns 1 on success undef on error
1289 Most usual cause of error is a line with no or incorrect budget codes
1290 which woild cause order creation to abort
1291 If other correct lines exist these are processed and the erroneous line os logged
1293 =head2 title_level_class
1295 classmark = title_level_class(edi_item)
1297 Trys to return a title level classmark from a quote message line
1298 Will return a dewey or lcc classmark if one exists according to the
1299 value in DefaultClassificationSource syspref
1301 If unable to returns the shelfmark or classification from the GIR segment
1303 If all else fails returns empty string
1305 =head2 _create_bib_from_quote
1307 marc_record_obj = _create_bib_from_quote(lineitem, quote)
1309 Returns a MARC::Record object based on the info in the quote's lineitem
1311 =head2 _create_item_from_quote
1313 item_hashref = _create_item_from_quote( lineitem, quote)
1315 returns a hashref representing the item fields specified in the quote
1317 =head2 _get_invoiced_price
1319 (price, price_tax_excluded) = _get_invoiced_price(line_object, $quantity)
1321 Returns an array of unitprice and unitprice_tax_excluded derived from the lineitem
1324 =head2 _discounted_price
1326 ecost = _discounted_price(discount, item_price, discounted_price)
1328 utility subroutine to return a price calculated from the
1329 vendors discount and quoted price
1330 if invoice has a field containing discounted price that is returned
1331 instead of recalculating
1333 =head2 _check_for_existing_bib
1335 (biblionumber, biblioitemnumber) = _check_for_existing_bib(isbn_or_ean)
1337 passed an isbn or ean attempts to locate a match bib
1338 On success returns biblionumber and biblioitemnumber
1339 On failure returns undefined/an empty list
1343 b = _get_budget(schema_obj, budget_code)
1345 Returns the Aqbudget object for the active budget given the passed budget_code
1346 or undefined if one does not exist
1350 Colin Campbell <colin.campbell@ptfs-europe.com>
1355 Copyright 2014,2015 PTFS-Europe Ltd
1356 This program is free software, You may redistribute it under
1357 under the terms of the GNU General Public License