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( 'shelfmark', $occurrence )
874 || $item->girfield( 'classification', $occurrence )
875 || title_level_class($item),
877 $item->girfield( 'branch', $occurrence ),
878 homebranch => $item->girfield( 'branch', $occurrence ),
881 my $lsq_field = C4::Context->preference('EdifactLSQ');
882 $new_item->{$lsq_field} = $item->girfield( 'sequence_code', $occurrence );
884 if ( $new_item->{itype} ) {
885 $item_hash->{itype} = $new_item->{itype};
887 if ( $new_item->{$lsq_field} ) {
888 $item_hash->{$lsq_field} = $new_item->{$lsq_field};
890 if ( $new_item->{itemcallnumber} ) {
891 $item_hash->{itemcallnumber} =
892 $new_item->{itemcallnumber};
894 if ( $new_item->{holdingbranch} ) {
895 $item_hash->{holdingbranch} =
896 $new_item->{holdingbranch};
898 if ( $new_item->{homebranch} ) {
899 $item_hash->{homebranch} = $new_item->{homebranch};
902 $item_hash->{biblionumber} = $bib->{biblionumber};
903 $item_hash->{biblioitemnumber} = $bib->{biblioitemnumber};
904 my $kitem = Koha::Item->new( $item_hash )->store;
905 my $itemnumber = $kitem->itemnumber;
906 $logger->trace("New item $itemnumber added");
907 $schema->resultset('AqordersItem')->create(
909 ordernumber => $new_order->ordernumber,
910 itemnumber => $itemnumber,
915 $item->girfield( 'library_rotation_plan', $occurrence );
918 Koha::StockRotationRotas->find( { title => $lrp },
919 { key => 'stockrotationrotas_title' } );
921 $rota->add_item($itemnumber);
922 $logger->trace("Item added to rota $rota->id");
926 "No rota found matching $lrp in orderline");
934 # increment quantity in orderline for EXISTING budget in $budgets
936 my $row = $schema->resultset('Aqorder')->find(
938 ordernumber => $ordernumber{ $budget->budget_id }
942 my $qty = $row->quantity;
951 # Do not use the basket level value as it is always NULL
952 # See calling subs call to AddBasket
953 if ( C4::Context->preference('AcqCreateItem') eq 'ordering' ) {
959 replacementprice => $price,
961 $item->girfield( 'stock_category', $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 my $lsq_field = C4::Context->preference('EdifactLSQ');
971 $new_item->{$lsq_field} = $item->girfield( 'sequence_code', $occurrence );
972 $new_item->{biblionumber} = $bib->{biblionumber};
973 $new_item->{biblioitemnumber} = $bib->{biblioitemnumber};
974 my $kitem = Koha::Item->new( $new_item )->store;
975 my $itemnumber = $kitem->itemnumber;
976 $logger->trace("New item $itemnumber added");
977 $schema->resultset('AqordersItem')->create(
979 ordernumber => $ordernumber{ $budget->budget_id },
980 itemnumber => $itemnumber,
985 $item->girfield( 'library_rotation_plan', $occurrence );
988 Koha::StockRotationRotas->find( { title => $lrp },
989 { key => 'stockrotationrotas_title' } );
991 $rota->add_item($itemnumber);
992 $logger->trace("Item added to rota $rota->id");
996 "No rota found matching $lrp in orderline");
1009 sub get_edifact_ean {
1011 my $dbh = C4::Context->dbh;
1013 my $eans = $dbh->selectcol_arrayref('select ean from edifact_ean');
1018 # We should not need to have a routine to do this here
1019 sub _discounted_price {
1020 my ( $discount, $price, $discounted_price ) = @_;
1021 if (defined $discounted_price) {
1022 return $discounted_price;
1027 return $price - ( ( $discount * $price ) / 100 );
1030 sub _check_for_existing_bib {
1033 my $search_isbn = $isbn;
1034 $search_isbn =~ s/^\s*/%/xms;
1035 $search_isbn =~ s/\s*$/%/xms;
1036 my $dbh = C4::Context->dbh;
1037 my $sth = $dbh->prepare(
1038 'select biblionumber, biblioitemnumber from biblioitems where isbn like ?',
1041 $dbh->selectall_arrayref( $sth, { Slice => {} }, $search_isbn );
1042 if ( @{$tuple_arr} ) {
1043 return $tuple_arr->[0];
1045 elsif ( length($isbn) == 13 && $isbn !~ /^97[89]/ ) {
1046 my $tarr = $dbh->selectall_arrayref(
1047 'select biblionumber, biblioitemnumber from biblioitems where ean = ?',
1057 $isbn =~ s/\-//xmsg;
1058 if ( $isbn =~ m/(\d{13})/xms ) {
1059 my $b_isbn = Business::ISBN->new($1);
1060 if ( $b_isbn && $b_isbn->is_valid && $b_isbn->as_isbn10 ) {
1061 $search_isbn = $b_isbn->as_isbn10->as_string( [] );
1065 elsif ( $isbn =~ m/(\d{9}[xX]|\d{10})/xms ) {
1066 my $b_isbn = Business::ISBN->new($1);
1067 if ( $b_isbn && $b_isbn->is_valid ) {
1068 $search_isbn = $b_isbn->as_isbn13->as_string( [] );
1073 $search_isbn = "%$search_isbn%";
1075 $dbh->selectall_arrayref( $sth, { Slice => {} }, $search_isbn );
1076 if ( @{$tuple_arr} ) {
1077 return $tuple_arr->[0];
1084 # returns a budget obj or undef
1085 # fact we need this shows what a mess Acq API is
1087 my ( $schema, $budget_code ) = @_;
1088 my $period_rs = $schema->resultset('Aqbudgetperiod')->search(
1090 budget_period_active => 1,
1094 # db does not ensure budget code is unque
1095 return $schema->resultset('Aqbudget')->single(
1097 budget_code => $budget_code,
1099 { -in => $period_rs->get_column('budget_period_id')->as_query },
1104 # try to get title level classification from incoming quote
1105 sub title_level_class {
1108 my $default_scheme = C4::Context->preference('DefaultClassificationSource');
1109 if ( $default_scheme eq 'ddc' ) {
1110 $class = $item->dewey_class();
1112 elsif ( $default_scheme eq 'lcc' ) {
1113 $class = $item->lc_class();
1117 $item->girfield('shelfmark')
1118 || $item->girfield('classification')
1124 sub _create_bib_from_quote {
1126 #TBD we should flag this for updating from an external source
1127 #As biblio (&biblioitems) has no candidates flag in order
1128 my ( $item, $quote ) = @_;
1129 my $itemid = $item->item_number_id;
1130 my $defalt_classification_source =
1131 C4::Context->preference('DefaultClassificationSource');
1133 'biblioitems.cn_source' => $defalt_classification_source,
1134 'items.cn_source' => $defalt_classification_source,
1135 'items.notforloan' => -1,
1136 'items.cn_sort' => q{},
1138 $bib_hash->{'biblio.seriestitle'} = $item->series;
1140 $bib_hash->{'biblioitems.publishercode'} = $item->publisher;
1141 $bib_hash->{'biblioitems.publicationyear'} =
1142 $bib_hash->{'biblio.copyrightdate'} = $item->publication_date;
1144 $bib_hash->{'biblio.title'} = $item->title;
1145 $bib_hash->{'biblio.author'} = $item->author;
1146 $bib_hash->{'biblioitems.isbn'} = $item->item_number_id;
1147 $bib_hash->{'biblioitems.itemtype'} = $item->girfield('stock_category');
1149 # If we have a 13 digit id we are assuming its an ean
1150 # (it may also be an isbn or issn)
1151 if ( $itemid =~ /^\d{13}$/ ) {
1152 $bib_hash->{'biblioitems.ean'} = $itemid;
1153 if ( $itemid =~ /^977/ ) {
1154 $bib_hash->{'biblioitems.issn'} = $itemid;
1157 for my $key ( keys %{$bib_hash} ) {
1158 if ( !defined $bib_hash->{$key} ) {
1159 delete $bib_hash->{$key};
1162 return TransformKohaToMarc($bib_hash);
1166 sub _create_item_from_quote {
1167 my ( $item, $quote ) = @_;
1168 my $defalt_classification_source =
1169 C4::Context->preference('DefaultClassificationSource');
1171 cn_source => $defalt_classification_source,
1175 $item_hash->{booksellerid} = $quote->vendor_id;
1176 $item_hash->{price} = $item_hash->{replacementprice} = $item->price;
1177 $item_hash->{itype} = $item->girfield('stock_category');
1178 my $lsq_field = C4::Context->preference('EdifactLSQ');
1179 $item_hash->{$lsq_field} = $item->girfield('sequence_code');
1183 $item_hash->{itemcallnumber} =
1184 $item->girfield('shelfmark')
1185 || $item->girfield('classification')
1186 || title_level_class($item);
1188 my $branch = $item->girfield('branch');
1189 $item_hash->{holdingbranch} = $item_hash->{homebranch} = $branch;
1202 Module exporting subroutines used in EDI processing for Koha
1206 Subroutines called by batch processing to handle Edifact
1207 messages of various types and related utilities
1211 These routines should really be methods of some object.
1212 get_edifact_ean is a stopgap which should be replaced
1216 =head2 process_quote
1218 process_quote(quote_message);
1220 passed a message object for a quote, parses it creating an order basket
1221 and orderlines in the database
1222 updates the message's status to received in the database and adds the
1225 =head2 process_invoice
1227 process_invoice(invoice_message)
1229 passed a message object for an invoice, add the contained invoices
1230 and update the orderlines referred to in the invoice
1231 As an Edifact invoice is in effect a despatch note this receipts the
1232 appropriate quantities in the orders
1234 no meaningful return value
1236 =head2 process_ordrsp
1238 process_ordrsp(ordrsp_message)
1240 passed a message object for a supplier response, process the contents
1241 If an orderline is cancelled cancel the corresponding orderline in koha
1242 otherwise record the supplier message against it
1244 no meaningful return value
1246 =head2 create_edi_order
1248 create_edi_order( { parameter_hashref } )
1250 parameters must include basketno and ean
1252 branchcode can optionally be passed
1254 returns 1 on success undef otherwise
1256 if the parameter noingest is set the formatted order is returned
1257 and not saved in the database. This functionality is intended for debugging only
1259 =head2 receipt_items
1261 receipt_items( schema_obj, invoice_line, ordernumber, $quantity)
1263 receipts the items recorded on this invoice line
1265 no meaningful return
1267 =head2 transfer_items
1269 transfer_items(schema, invoice_line, originating_order, receiving_order, $quantity)
1271 Transfer the items covered by this invoice line from their original
1272 order to another order recording the partial fulfillment of the original
1275 no meaningful return
1277 =head2 get_edifact_ean
1279 $ean = get_edifact_ean();
1281 routine to return the ean.
1285 quote_item(lineitem, quote_message);
1287 Called by process_quote to handle an individual lineitem
1288 Generate the biblios and items if required and orderline linking to them
1290 Returns 1 on success undef on error
1292 Most usual cause of error is a line with no or incorrect budget codes
1293 which woild cause order creation to abort
1294 If other correct lines exist these are processed and the erroneous line os logged
1296 =head2 title_level_class
1298 classmark = title_level_class(edi_item)
1300 Trys to return a title level classmark from a quote message line
1301 Will return a dewey or lcc classmark if one exists according to the
1302 value in DefaultClassificationSource syspref
1304 If unable to returns the shelfmark or classification from the GIR segment
1306 If all else fails returns empty string
1308 =head2 _create_bib_from_quote
1310 marc_record_obj = _create_bib_from_quote(lineitem, quote)
1312 Returns a MARC::Record object based on the info in the quote's lineitem
1314 =head2 _create_item_from_quote
1316 item_hashref = _create_item_from_quote( lineitem, quote)
1318 returns a hashref representing the item fields specified in the quote
1320 =head2 _get_invoiced_price
1322 (price, price_tax_excluded) = _get_invoiced_price(line_object, $quantity)
1324 Returns an array of unitprice and unitprice_tax_excluded derived from the lineitem
1327 =head2 _discounted_price
1329 ecost = _discounted_price(discount, item_price, discounted_price)
1331 utility subroutine to return a price calculated from the
1332 vendors discount and quoted price
1333 if invoice has a field containing discounted price that is returned
1334 instead of recalculating
1336 =head2 _check_for_existing_bib
1338 (biblionumber, biblioitemnumber) = _check_for_existing_bib(isbn_or_ean)
1340 passed an isbn or ean attempts to locate a match bib
1341 On success returns biblionumber and biblioitemnumber
1342 On failure returns undefined/an empty list
1346 b = _get_budget(schema_obj, budget_code)
1348 Returns the Aqbudget object for the active budget given the passed budget_code
1349 or undefined if one does not exist
1353 Colin Campbell <colin.campbell@ptfs-europe.com>
1358 Copyright 2014,2015 PTFS-Europe Ltd
1359 This program is free software, You may redistribute it under
1360 under the terms of the GNU General Public License