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 $logger->trace( "Receipting order:$ordernumber Qty: ",
318 my $order = $schema->resultset('Aqorder')->find($ordernumber);
320 # ModReceiveOrder does not validate that $ordernumber exists validate here
324 my $s = $schema->resultset('Suggestion')->search(
326 biblionumber => $order->biblionumber->biblionumber,
332 suggestionid => $s->suggestionid,
333 STATUS => 'AVAILABLE',
337 # If quantity_invoiced is present use it in preference
338 my $quantity = $line->quantity_invoiced;
340 $quantity = $line->quantity;
343 my ( $price, $price_excl_tax ) = _get_invoiced_price($line, $quantity);
344 my $tax_rate = $line->tax_rate;
345 if ($tax_rate && $tax_rate->{rate} != 0) {
346 $tax_rate->{rate} /= 100;
349 if ( $order->quantity > $quantity ) {
350 my $ordered = $order->quantity;
353 $order->orderstatus('partial');
354 $order->quantity( $ordered - $quantity );
356 my $received_order = $order->copy(
358 ordernumber => undef,
359 quantity => $quantity,
360 quantityreceived => $quantity,
361 orderstatus => 'complete',
363 unitprice_tax_included => $price,
364 unitprice_tax_excluded => $price_excl_tax,
365 invoiceid => $invoiceid,
366 datereceived => $msg_date,
367 tax_rate_on_receiving => $tax_rate->{rate},
368 tax_value_on_receiving => $quantity * $price_excl_tax * $tax_rate->{rate},
371 transfer_items( $schema, $line, $order,
372 $received_order, $quantity );
373 receipt_items( $schema, $line,
374 $received_order->ordernumber, $quantity );
376 else { # simple receipt all copies on order
377 $order->quantityreceived( $quantity );
378 $order->datereceived($msg_date);
379 $order->invoiceid($invoiceid);
380 $order->unitprice($price);
381 $order->unitprice_tax_excluded($price_excl_tax);
382 $order->unitprice_tax_included($price);
383 $order->tax_rate_on_receiving($tax_rate->{rate});
384 $order->tax_value_on_receiving( $quantity * $price_excl_tax * $tax_rate->{rate});
385 $order->orderstatus('complete');
387 receipt_items( $schema, $line, $ordernumber, $quantity );
392 "No order found for $ordernumber Invoice:$invoicenumber"
402 $invoice_message->status('received');
403 $invoice_message->update; # status and basketno link
407 sub _get_invoiced_price {
410 my $line_total = $line->amt_total;
411 my $excl_tax = $line->amt_lineitem;
413 # If no tax some suppliers omit the total owed
414 # If no total given calculate from cost exclusive of tax
415 # + tax amount (if present, sometimes omitted if 0 )
416 if ( !defined $line_total ) {
417 my $x = $line->amt_taxoncharge;
421 $line_total = $excl_tax + $x;
424 # invoices give amounts per orderline, Koha requires that we store
427 return ( $line_total / $qty, $excl_tax / $qty );
429 return ( $line_total, $excl_tax ); # return as is for most common case
433 my ( $schema, $inv_line, $ordernumber, $quantity ) = @_;
434 my $logger = Log::Log4perl->get_logger();
436 # itemnumber is not a foreign key ??? makes this a bit cumbersome
437 my @item_links = $schema->resultset('AqordersItem')->search(
439 ordernumber => $ordernumber,
443 foreach my $ilink (@item_links) {
444 my $item = $schema->resultset('Item')->find( $ilink->itemnumber );
446 my $i = $ilink->itemnumber;
448 "Cannot find aqorder item for $i :Order:$ordernumber");
451 my $b = $item->get_column('homebranch');
452 if ( !exists $branch_map{$b} ) {
453 $branch_map{$b} = [];
455 push @{ $branch_map{$b} }, $item;
458 # Handling for 'AcqItemSetSubfieldsWhenReceived'
462 if ( C4::Context->preference('AcqCreateItem') eq 'ordering' ) {
463 @affects = split q{\|},
464 C4::Context->preference("AcqItemSetSubfieldsWhenReceived");
466 my $order = Koha::Acquisition::Orders->find($ordernumber);
467 $biblionumber = $order->biblionumber;
468 my $frameworkcode = GetFrameworkCode($biblionumber);
469 ($itemfield) = GetMarcFromKohaField( 'items.itemnumber',
474 my $gir_occurrence = 0;
475 while ( $gir_occurrence < $quantity ) {
476 my $branch = $inv_line->girfield( 'branch', $gir_occurrence );
477 my $item = shift @{ $branch_map{$branch} };
479 my $barcode = $inv_line->girfield( 'barcode', $gir_occurrence );
480 if ( $barcode && !$item->barcode ) {
481 my $rs = $schema->resultset('Item')->search(
486 if ( $rs->count > 0 ) {
487 $logger->warn("Barcode $barcode is a duplicate");
491 $logger->trace("Adding barcode $barcode");
492 $item->barcode($barcode);
496 # Handling for 'AcqItemSetSubfieldsWhenReceived'
498 my $item_marc = C4::Items::GetMarcItem( $biblionumber, $item->itemnumber );
499 for my $affect (@affects) {
500 my ( $sf, $v ) = split q{=}, $affect, 2;
501 foreach ( $item_marc->field($itemfield) ) {
502 $_->update( $sf => $v );
505 C4::Items::ModItemFromMarc( $item_marc, $biblionumber, $item->itemnumber );
511 $logger->warn("Unmatched item at branch:$branch");
520 my ( $schema, $inv_line, $order_from, $order_to, $quantity ) = @_;
522 # Transfer x items from the orig order to a completed partial order
524 my %mapped_by_branch;
525 while ( $gocc < $quantity ) {
526 my $branch = $inv_line->girfield( 'branch', $gocc );
527 if ( !exists $mapped_by_branch{$branch} ) {
528 $mapped_by_branch{$branch} = 1;
531 $mapped_by_branch{$branch}++;
535 my $logger = Log::Log4perl->get_logger();
536 my $o1 = $order_from->ordernumber;
537 my $o2 = $order_to->ordernumber;
538 $logger->warn("transferring $quantity copies from order $o1 to order $o2");
540 my @item_links = $schema->resultset('AqordersItem')->search(
542 ordernumber => $order_from->ordernumber,
545 foreach my $ilink (@item_links) {
546 my $ino = $ilink->itemnumber;
547 my $item = $schema->resultset('Item')->find( $ilink->itemnumber );
548 my $i_branch = $item->get_column('homebranch');
549 if ( exists $mapped_by_branch{$i_branch}
550 && $mapped_by_branch{$i_branch} > 0 )
552 $ilink->ordernumber( $order_to->ordernumber );
555 --$mapped_by_branch{$i_branch};
556 $logger->warn("Transferred item $item");
559 $logger->warn("Skipped item $item");
561 if ( $quantity < 1 ) {
572 $quote->status('processing');
575 my $edi = Koha::Edifact->new( { transmission => $quote->raw_msg, } );
577 my $messages = $edi->message_array();
578 my $process_errors = 0;
579 my $logger = Log::Log4perl->get_logger();
580 my $schema = Koha::Database->new()->schema();
581 my $message_count = 0;
582 my @added_baskets; # if auto & multiple baskets need to order all
584 if ( @{$messages} && $quote->vendor_id ) {
585 foreach my $msg ( @{$messages} ) {
588 NewBasket( $quote->vendor_id, 0, $quote->filename, q{},
590 push @added_baskets, $basketno;
591 if ( $message_count > 1 ) {
592 my $m_filename = $quote->filename;
593 $m_filename .= "_$message_count";
594 $schema->resultset('EdifactMessage')->create(
596 message_type => $quote->message_type,
597 transfer_date => $quote->transfer_date,
598 vendor_id => $quote->vendor_id,
599 edi_acct => $quote->edi_acct,
601 basketno => $basketno,
603 filename => $m_filename,
608 $quote->basketno($basketno);
610 $logger->trace("Created basket :$basketno");
611 my $items = $msg->lineitems();
612 my $refnum = $msg->message_refno;
614 for my $item ( @{$items} ) {
615 if ( !quote_item( $item, $quote, $basketno ) ) {
621 my $status = 'received';
622 if ($process_errors) {
626 $quote->status($status);
627 $quote->update; # status and basketno link
628 # Do we automatically generate orders for this vendor
629 my $v = $schema->resultset('VendorEdiAccount')->search(
631 vendor_id => $quote->vendor_id,
634 if ( $v->auto_orders ) {
635 for my $b (@added_baskets) {
638 ean => $messages->[0]->buyer_ean,
642 Koha::Acquisition::Baskets->find($b)->close;
644 if (C4::Context->preference("AcquisitionLog")) {
645 my $approved = Koha::Acquisition::Baskets->find( $b );
650 to_json($approved->unblessed)
661 my ( $item, $quote, $basketno ) = @_;
663 my $schema = Koha::Database->new()->schema();
664 my $logger = Log::Log4perl->get_logger();
666 # $basketno is the return from AddBasket in the calling routine
667 # So this call should not fail unless that has
668 my $basket = Koha::Acquisition::Baskets->find( $basketno );
670 $logger->error('Skipping order creation no valid basketno');
673 $logger->trace( 'Checking db for matches with ', $item->item_number_id() );
674 my $bib = _check_for_existing_bib( $item->item_number_id() );
675 if ( !defined $bib ) {
677 my $bib_record = _create_bib_from_quote( $item, $quote );
678 ( $bib->{biblionumber}, $bib->{biblioitemnumber} ) =
679 AddBiblio( $bib_record, q{} );
680 $logger->trace("New biblio added $bib->{biblionumber}");
683 $logger->trace("Match found: $bib->{biblionumber}");
686 # Create an orderline
687 my $order_note = $item->{orderline_free_text};
689 my $order_quantity = $item->quantity();
690 my $gir_count = $item->number_of_girs();
691 $order_quantity ||= 1; # quantity not necessarily present
692 if ( $gir_count > 1 ) {
693 if ( $gir_count != $order_quantity ) {
695 "Order for $order_quantity items, $gir_count segments present");
697 $order_quantity = 1; # attempts to create an orderline for each gir
699 my $price = $item->price_info;
700 # Howells do not send an info price but do have a gross price
702 $price = $item->price_gross;
704 my $vendor = Koha::Acquisition::Booksellers->find( $quote->vendor_id );
706 # NB quote will not include tax info it only contains the list price
707 my $ecost = _discounted_price( $vendor->discount, $price, $item->price_info_inclusive );
709 # database definitions should set some of these defaults but dont
711 biblionumber => $bib->{biblionumber},
712 entrydate => dt_from_string()->ymd(),
713 basketno => $basketno,
715 quantity => $order_quantity,
716 quantityreceived => 0,
717 order_vendornote => q{},
718 order_internalnote => q{},
719 replacementprice => $price,
720 rrp_tax_included => $price,
721 rrp_tax_excluded => $price,
724 ecost_tax_included => $ecost,
725 ecost_tax_excluded => $ecost,
729 currency => $vendor->listprice(),
732 # suppliers references
733 if ( $item->reference() ) {
734 $order_hash->{suppliers_reference_number} = $item->reference;
735 $order_hash->{suppliers_reference_qualifier} = 'QLI';
737 elsif ( $item->orderline_reference_number() ) {
738 $order_hash->{suppliers_reference_number} =
739 $item->orderline_reference_number;
740 $order_hash->{suppliers_reference_qualifier} = 'SLI';
742 if ( $item->item_number_id ) { # suppliers ean
743 $order_hash->{line_item_id} = $item->item_number_id;
746 if ( $item->girfield('servicing_instruction') ) {
750 while ( $si = $item->girfield( 'servicing_instruction', $occ ) ) {
759 $order_hash->{order_vendornote} = $order_note;
762 if ( $item->internal_notes() ) {
763 if ( $order_hash->{order_internalnote} ) { # more than ''
764 $order_hash->{order_internalnote} .= q{ };
766 $order_hash->{order_internalnote} .= $item->internal_notes;
769 my $budget = _get_budget( $schema, $item->girfield('fund_allocation') );
773 if ( $item->quantity > 1 ) {
774 carp 'Skipping line with no budget info';
775 $logger->trace('girfield skipped for invalid budget');
779 carp 'Skipping line with no budget info';
780 $logger->trace('orderline skipped for invalid budget');
790 $order_hash->{budget_id} = $budget->budget_id;
791 my $first_order = $schema->resultset('Aqorder')->create($order_hash);
792 my $o = $first_order->ordernumber();
793 $logger->trace("Order created :$o");
795 # should be done by database settings
796 $first_order->parent_ordernumber( $first_order->ordernumber() );
797 $first_order->update();
799 # add to $budgets to prevent duplicate orderlines
800 $budgets{ $budget->budget_id } = '1';
802 # record ordernumber against budget
803 $ordernumber{ $budget->budget_id } = $o;
805 if ( C4::Context->preference('AcqCreateItem') eq 'ordering' ) {
806 $item_hash = _create_item_from_quote( $item, $quote );
809 while ( $created < $order_quantity ) {
810 $item_hash->{biblionumber} = $bib->{biblionumber};
811 $item_hash->{biblioitemnumber} = $bib->{biblioitemnumber};
812 my $kitem = Koha::Item->new( $item_hash )->store;
813 my $itemnumber = $kitem->itemnumber;
814 $logger->trace("Added item:$itemnumber");
815 $schema->resultset('AqordersItem')->create(
817 ordernumber => $first_order->ordernumber,
818 itemnumber => $itemnumber,
826 if ( $order_quantity == 1 && $item->quantity > 1 ) {
827 my $occurrence = 1; # occ zero already added
828 while ( $occurrence < $item->quantity ) {
831 $budget = _get_budget( $schema,
832 $item->girfield( 'fund_allocation', $occurrence ) );
836 $item->girfield( 'fund_allocation', $occurrence );
837 carp 'Skipping line with no budget info';
839 "girfield skipped for invalid budget:$bad_budget");
840 ++$occurrence; ## lets look at the next one not this one again
844 # add orderline for NEW budget in $budgets
845 if ( !exists $budgets{ $budget->budget_id } ) {
847 # $order_hash->{quantity} = 1; by default above
848 # we should handle both 1:1 GIR & 1:n GIR (with LQT values) here
850 $order_hash->{budget_id} = $budget->budget_id;
853 $schema->resultset('Aqorder')->create($order_hash);
854 my $o = $new_order->ordernumber();
855 $logger->trace("Order created :$o");
857 # should be done by database settings
858 $new_order->parent_ordernumber( $new_order->ordernumber() );
859 $new_order->update();
861 # add to $budgets to prevent duplicate orderlines
862 $budgets{ $budget->budget_id } = '1';
864 # record ordernumber against budget
865 $ordernumber{ $budget->budget_id } = $o;
867 if ( C4::Context->preference('AcqCreateItem') eq 'ordering' ) {
868 if ( !defined $item_hash ) {
869 $item_hash = _create_item_from_quote( $item, $quote );
873 $item->girfield( 'stock_category', $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 ),
883 my $lsq_field = C4::Context->preference('EdifactLSQ');
884 $new_item->{$lsq_field} = $item->girfield( 'sequence_code', $occurrence );
886 if ( $new_item->{itype} ) {
887 $item_hash->{itype} = $new_item->{itype};
889 if ( $new_item->{$lsq_field} ) {
890 $item_hash->{$lsq_field} = $new_item->{$lsq_field};
892 if ( $new_item->{itemcallnumber} ) {
893 $item_hash->{itemcallnumber} =
894 $new_item->{itemcallnumber};
896 if ( $new_item->{holdingbranch} ) {
897 $item_hash->{holdingbranch} =
898 $new_item->{holdingbranch};
900 if ( $new_item->{homebranch} ) {
901 $item_hash->{homebranch} = $new_item->{homebranch};
904 $item_hash->{biblionumber} = $bib->{biblionumber};
905 $item_hash->{biblioitemnumber} = $bib->{biblioitemnumber};
906 my $kitem = Koha::Item->new( $item_hash )->store;
907 my $itemnumber = $kitem->itemnumber;
908 $logger->trace("New item $itemnumber added");
909 $schema->resultset('AqordersItem')->create(
911 ordernumber => $new_order->ordernumber,
912 itemnumber => $itemnumber,
917 $item->girfield( 'library_rotation_plan', $occurrence );
920 Koha::StockRotationRotas->find( { title => $lrp },
921 { key => 'stockrotationrotas_title' } );
923 $rota->add_item($itemnumber);
924 $logger->trace("Item added to rota $rota->id");
928 "No rota found matching $lrp in orderline");
936 # increment quantity in orderline for EXISTING budget in $budgets
938 my $row = $schema->resultset('Aqorder')->find(
940 ordernumber => $ordernumber{ $budget->budget_id }
944 my $qty = $row->quantity;
953 # Do not use the basket level value as it is always NULL
954 # See calling subs call to AddBasket
955 if ( C4::Context->preference('AcqCreateItem') eq 'ordering' ) {
961 replacementprice => $price,
963 $item->girfield( 'stock_category', $occurrence ),
965 $item->girfield( 'shelfmark', $occurrence )
966 || $item->girfield( 'classification', $occurrence )
967 || $item_hash->{itemcallnumber},
969 $item->girfield( 'branch', $occurrence ),
970 homebranch => $item->girfield( 'branch', $occurrence ),
972 my $lsq_field = C4::Context->preference('EdifactLSQ');
973 $new_item->{$lsq_field} = $item->girfield( 'sequence_code', $occurrence );
974 $new_item->{biblionumber} = $bib->{biblionumber};
975 $new_item->{biblioitemnumber} = $bib->{biblioitemnumber};
976 my $kitem = Koha::Item->new( $new_item )->store;
977 my $itemnumber = $kitem->itemnumber;
978 $logger->trace("New item $itemnumber added");
979 $schema->resultset('AqordersItem')->create(
981 ordernumber => $ordernumber{ $budget->budget_id },
982 itemnumber => $itemnumber,
987 $item->girfield( 'library_rotation_plan', $occurrence );
990 Koha::StockRotationRotas->find( { title => $lrp },
991 { key => 'stockrotationrotas_title' } );
993 $rota->add_item($itemnumber);
994 $logger->trace("Item added to rota $rota->id");
998 "No rota found matching $lrp in orderline");
1011 sub get_edifact_ean {
1013 my $dbh = C4::Context->dbh;
1015 my $eans = $dbh->selectcol_arrayref('select ean from edifact_ean');
1020 # We should not need to have a routine to do this here
1021 sub _discounted_price {
1022 my ( $discount, $price, $discounted_price ) = @_;
1023 if (defined $discounted_price) {
1024 return $discounted_price;
1029 return $price - ( ( $discount * $price ) / 100 );
1032 sub _check_for_existing_bib {
1035 my $search_isbn = $isbn;
1036 $search_isbn =~ s/^\s*/%/xms;
1037 $search_isbn =~ s/\s*$/%/xms;
1038 my $dbh = C4::Context->dbh;
1039 my $sth = $dbh->prepare(
1040 'select biblionumber, biblioitemnumber from biblioitems where isbn like ?',
1043 $dbh->selectall_arrayref( $sth, { Slice => {} }, $search_isbn );
1044 if ( @{$tuple_arr} ) {
1045 return $tuple_arr->[0];
1047 elsif ( length($isbn) == 13 && $isbn !~ /^97[89]/ ) {
1048 my $tarr = $dbh->selectall_arrayref(
1049 'select biblionumber, biblioitemnumber from biblioitems where ean = ?',
1059 $isbn =~ s/\-//xmsg;
1060 if ( $isbn =~ m/(\d{13})/xms ) {
1061 my $b_isbn = Business::ISBN->new($1);
1062 if ( $b_isbn && $b_isbn->is_valid && $b_isbn->as_isbn10 ) {
1063 $search_isbn = $b_isbn->as_isbn10->as_string( [] );
1067 elsif ( $isbn =~ m/(\d{9}[xX]|\d{10})/xms ) {
1068 my $b_isbn = Business::ISBN->new($1);
1069 if ( $b_isbn && $b_isbn->is_valid ) {
1070 $search_isbn = $b_isbn->as_isbn13->as_string( [] );
1075 $search_isbn = "%$search_isbn%";
1077 $dbh->selectall_arrayref( $sth, { Slice => {} }, $search_isbn );
1078 if ( @{$tuple_arr} ) {
1079 return $tuple_arr->[0];
1086 # returns a budget obj or undef
1087 # fact we need this shows what a mess Acq API is
1089 my ( $schema, $budget_code ) = @_;
1090 my $period_rs = $schema->resultset('Aqbudgetperiod')->search(
1092 budget_period_active => 1,
1096 # db does not ensure budget code is unque
1097 return $schema->resultset('Aqbudget')->single(
1099 budget_code => $budget_code,
1101 { -in => $period_rs->get_column('budget_period_id')->as_query },
1106 # try to get title level classification from incoming quote
1107 sub title_level_class {
1110 my $default_scheme = C4::Context->preference('DefaultClassificationSource');
1111 if ( $default_scheme eq 'ddc' ) {
1112 $class = $item->dewey_class();
1114 elsif ( $default_scheme eq 'lcc' ) {
1115 $class = $item->lc_class();
1119 $item->girfield('shelfmark')
1120 || $item->girfield('classification')
1126 sub _create_bib_from_quote {
1128 #TBD we should flag this for updating from an external source
1129 #As biblio (&biblioitems) has no candidates flag in order
1130 my ( $item, $quote ) = @_;
1131 my $itemid = $item->item_number_id;
1132 my $defalt_classification_source =
1133 C4::Context->preference('DefaultClassificationSource');
1135 'biblioitems.cn_source' => $defalt_classification_source,
1136 'items.cn_source' => $defalt_classification_source,
1137 'items.notforloan' => -1,
1138 'items.cn_sort' => q{},
1140 $bib_hash->{'biblio.seriestitle'} = $item->series;
1142 $bib_hash->{'biblioitems.publishercode'} = $item->publisher;
1143 $bib_hash->{'biblioitems.publicationyear'} =
1144 $bib_hash->{'biblio.copyrightdate'} = $item->publication_date;
1146 $bib_hash->{'biblio.title'} = $item->title;
1147 $bib_hash->{'biblio.author'} = $item->author;
1148 $bib_hash->{'biblioitems.isbn'} = $item->item_number_id;
1149 $bib_hash->{'biblioitems.itemtype'} = $item->girfield('stock_category');
1151 # If we have a 13 digit id we are assuming its an ean
1152 # (it may also be an isbn or issn)
1153 if ( $itemid =~ /^\d{13}$/ ) {
1154 $bib_hash->{'biblioitems.ean'} = $itemid;
1155 if ( $itemid =~ /^977/ ) {
1156 $bib_hash->{'biblioitems.issn'} = $itemid;
1159 for my $key ( keys %{$bib_hash} ) {
1160 if ( !defined $bib_hash->{$key} ) {
1161 delete $bib_hash->{$key};
1164 return TransformKohaToMarc($bib_hash);
1168 sub _create_item_from_quote {
1169 my ( $item, $quote ) = @_;
1170 my $defalt_classification_source =
1171 C4::Context->preference('DefaultClassificationSource');
1173 cn_source => $defalt_classification_source,
1177 $item_hash->{booksellerid} = $quote->vendor_id;
1178 $item_hash->{price} = $item_hash->{replacementprice} = $item->price;
1179 $item_hash->{itype} = $item->girfield('stock_category');
1180 my $lsq_field = C4::Context->preference('EdifactLSQ');
1181 $item_hash->{$lsq_field} = $item->girfield('sequence_code');
1185 $item_hash->{itemcallnumber} =
1186 $item->girfield('shelfmark')
1187 || $item->girfield('classification')
1188 || title_level_class($item);
1190 my $branch = $item->girfield('branch');
1191 $item_hash->{holdingbranch} = $item_hash->{homebranch} = $branch;
1204 Module exporting subroutines used in EDI processing for Koha
1208 Subroutines called by batch processing to handle Edifact
1209 messages of various types and related utilities
1213 These routines should really be methods of some object.
1214 get_edifact_ean is a stopgap which should be replaced
1218 =head2 process_quote
1220 process_quote(quote_message);
1222 passed a message object for a quote, parses it creating an order basket
1223 and orderlines in the database
1224 updates the message's status to received in the database and adds the
1227 =head2 process_invoice
1229 process_invoice(invoice_message)
1231 passed a message object for an invoice, add the contained invoices
1232 and update the orderlines referred to in the invoice
1233 As an Edifact invoice is in effect a despatch note this receipts the
1234 appropriate quantities in the orders
1236 no meaningful return value
1238 =head2 process_ordrsp
1240 process_ordrsp(ordrsp_message)
1242 passed a message object for a supplier response, process the contents
1243 If an orderline is cancelled cancel the corresponding orderline in koha
1244 otherwise record the supplier message against it
1246 no meaningful return value
1248 =head2 create_edi_order
1250 create_edi_order( { parameter_hashref } )
1252 parameters must include basketno and ean
1254 branchcode can optionally be passed
1256 returns 1 on success undef otherwise
1258 if the parameter noingest is set the formatted order is returned
1259 and not saved in the database. This functionality is intended for debugging only
1261 =head2 receipt_items
1263 receipt_items( schema_obj, invoice_line, ordernumber, $quantity)
1265 receipts the items recorded on this invoice line
1267 no meaningful return
1269 =head2 transfer_items
1271 transfer_items(schema, invoice_line, originating_order, receiving_order, $quantity)
1273 Transfer the items covered by this invoice line from their original
1274 order to another order recording the partial fulfillment of the original
1277 no meaningful return
1279 =head2 get_edifact_ean
1281 $ean = get_edifact_ean();
1283 routine to return the ean.
1287 quote_item(lineitem, quote_message);
1289 Called by process_quote to handle an individual lineitem
1290 Generate the biblios and items if required and orderline linking to them
1292 Returns 1 on success undef on error
1294 Most usual cause of error is a line with no or incorrect budget codes
1295 which woild cause order creation to abort
1296 If other correct lines exist these are processed and the erroneous line os logged
1298 =head2 title_level_class
1300 classmark = title_level_class(edi_item)
1302 Trys to return a title level classmark from a quote message line
1303 Will return a dewey or lcc classmark if one exists according to the
1304 value in DefaultClassificationSource syspref
1306 If unable to returns the shelfmark or classification from the GIR segment
1308 If all else fails returns empty string
1310 =head2 _create_bib_from_quote
1312 marc_record_obj = _create_bib_from_quote(lineitem, quote)
1314 Returns a MARC::Record object based on the info in the quote's lineitem
1316 =head2 _create_item_from_quote
1318 item_hashref = _create_item_from_quote( lineitem, quote)
1320 returns a hashref representing the item fields specified in the quote
1322 =head2 _get_invoiced_price
1324 (price, price_tax_excluded) = _get_invoiced_price(line_object, $quantity)
1326 Returns an array of unitprice and unitprice_tax_excluded derived from the lineitem
1329 =head2 _discounted_price
1331 ecost = _discounted_price(discount, item_price, discounted_price)
1333 utility subroutine to return a price calculated from the
1334 vendors discount and quoted price
1335 if invoice has a field containing discounted price that is returned
1336 instead of recalculating
1338 =head2 _check_for_existing_bib
1340 (biblionumber, biblioitemnumber) = _check_for_existing_bib(isbn_or_ean)
1342 passed an isbn or ean attempts to locate a match bib
1343 On success returns biblionumber and biblioitemnumber
1344 On failure returns undefined/an empty list
1348 b = _get_budget(schema_obj, budget_code)
1350 Returns the Aqbudget object for the active budget given the passed budget_code
1351 or undefined if one does not exist
1355 Colin Campbell <colin.campbell@ptfs-europe.com>
1360 Copyright 2014,2015 PTFS-Europe Ltd
1361 This program is free software, You may redistribute it under
1362 under the terms of the GNU General Public License