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 };
31 use C4::Acquisition qw( NewBasket ModOrder);
32 use C4::Suggestions qw( ModSuggestion );
33 use C4::Biblio qw( AddBiblio TransformKohaToMarc GetMarcBiblio GetFrameworkCode GetMarcFromKohaField );
34 use Koha::Edifact::Order;
36 use C4::Log qw(logaction);
39 use Koha::Plugins::Handler;
40 use Koha::Acquisition::Baskets;
41 use Koha::Acquisition::Booksellers;
45 qw( process_quote process_invoice process_ordrsp create_edi_order get_edifact_ean );
47 sub create_edi_order {
48 my $parameters = shift;
49 my $basketno = $parameters->{basketno};
50 my $ean = $parameters->{ean};
51 my $branchcode = $parameters->{branchcode};
52 my $noingest = $parameters->{noingest};
53 if ( !$basketno || !$ean ) {
54 carp 'create_edi_order called with no basketno or ean';
58 my $schema = Koha::Database->new()->schema();
60 my @orderlines = $schema->resultset('Aqorder')->search(
62 basketno => $basketno,
68 carp "No orderlines for basket $basketno";
72 my $vendor = $schema->resultset('VendorEdiAccount')->search(
74 vendor_id => $orderlines[0]->basketno->booksellerid->id,
78 my $ean_search_keys = { ean => $ean, };
80 $ean_search_keys->{branchcode} = $branchcode;
83 $schema->resultset('EdifactEan')->search($ean_search_keys)->single;
85 # If no branch specific each can be found, look for a default ean
87 $ean_obj = $schema->resultset('EdifactEan')->search(
95 my $dbh = C4::Context->dbh;
96 my $arr_ref = $dbh->selectcol_arrayref(
97 'select id from edifact_messages where basketno = ? and message_type = \'QUOTE\'',
100 my $response = @{$arr_ref} ? 1 : 0;
102 my $edifact_order_params = {
103 orderlines => \@orderlines,
106 is_response => $response,
110 if ( $vendor->plugin ) {
111 $edifact = Koha::Plugins::Handler->run(
113 class => $vendor->plugin,
114 method => 'edifact_order',
116 params => $edifact_order_params,
122 $edifact = Koha::Edifact::Order->new($edifact_order_params);
125 return unless $edifact;
127 my $order_file = $edifact->encode();
131 my $m = unidecode($order_file); # remove diacritics and non-latin chars
132 if ($noingest) { # allows scripts to produce test files
136 message_type => 'ORDERS',
138 vendor_id => $vendor->vendor_id,
140 basketno => $basketno,
141 filename => $edifact->filename(),
142 transfer_date => $edifact->msg_date_string(),
143 edi_acct => $vendor->id,
146 $schema->resultset('EdifactMessage')->create($order);
154 my $response_message = shift;
155 $response_message->status('processing');
156 $response_message->update;
157 my $schema = Koha::Database->new()->schema();
158 my $logger = Log::Log4perl->get_logger();
161 Koha::Edifact->new( { transmission => $response_message->raw_msg, } );
162 my $messages = $edi->message_array();
164 if ( @{$messages} ) {
165 foreach my $msg ( @{$messages} ) {
166 my $lines = $msg->lineitems();
167 foreach my $line ( @{$lines} ) {
168 my $ordernumber = $line->ordernumber();
170 # action cancelled:change_requested:no_action:accepted:not_found:recorded
171 my $action = $line->action_notification();
172 if ( $action eq 'cancelled' ) {
173 my $reason = $line->coded_orderline_text();
176 ordernumber => $ordernumber,
177 cancellationreason => $reason,
178 orderstatus => 'cancelled',
179 datecancellationprinted => dt_from_string()->ymd(),
183 else { # record order as due with possible further info
185 my $report = $line->coded_orderline_text();
186 my $date_avail = $line->availability_date();
189 $report .= " Available: $date_avail";
193 ordernumber => $ordernumber,
194 suppliers_report => $report,
202 $response_message->status('received');
203 $response_message->update;
207 sub process_invoice {
208 my $invoice_message = shift;
209 $invoice_message->status('processing');
210 $invoice_message->update;
211 my $schema = Koha::Database->new()->schema();
212 my $logger = Log::Log4perl->get_logger();
215 my $plugin_class = $invoice_message->edi_acct()->plugin();
217 # Plugin has its own invoice processor, only run it and not the standard invoice processor below
218 if ( $plugin_class ) {
219 my $plugin = $plugin_class->new();
220 if ( $plugin->can('edifact_process_invoice') ) {
221 Koha::Plugins::Handler->run(
223 class => $plugin_class,
224 method => 'edifact_process_invoice',
226 invoice => $invoice_message,
235 if ( $plugin_class ) {
236 $edi_plugin = Koha::Plugins::Handler->run(
238 class => $plugin_class,
241 invoice_message => $invoice_message,
242 transmission => $invoice_message->raw_msg,
248 my $edi = $edi_plugin ||
249 Koha::Edifact->new( { transmission => $invoice_message->raw_msg, } );
251 my $messages = $edi->message_array();
253 if ( @{$messages} ) {
255 # BGM contains an invoice number
256 foreach my $msg ( @{$messages} ) {
257 my $invoicenumber = $msg->docmsg_number();
258 my $shipmentcharge = $msg->shipment_charge();
259 my $msg_date = $msg->message_date;
260 my $tax_date = $msg->tax_point_date;
261 if ( !defined $tax_date || $tax_date !~ m/^\d{8}/xms ) {
262 $tax_date = $msg_date;
265 my $vendor_ean = $msg->supplier_ean;
266 if ( !defined $vendor_acct || $vendor_ean ne $vendor_acct->san ) {
267 $vendor_acct = $schema->resultset('VendorEdiAccount')->search(
273 if ( !$vendor_acct ) {
275 "Cannot find vendor with ean $vendor_ean for invoice $invoicenumber in $invoice_message->filename";
278 $invoice_message->edi_acct( $vendor_acct->id );
279 $logger->trace("Adding invoice:$invoicenumber");
280 my $new_invoice = $schema->resultset('Aqinvoice')->create(
282 invoicenumber => $invoicenumber,
283 booksellerid => $invoice_message->vendor_id,
284 shipmentdate => $msg_date,
285 billingdate => $tax_date,
286 shipmentcost => $shipmentcharge,
287 shipmentcost_budgetid => $vendor_acct->shipment_budget,
288 message_id => $invoice_message->id,
291 my $invoiceid = $new_invoice->invoiceid;
292 $logger->trace("Added as invoiceno :$invoiceid");
293 my $lines = $msg->lineitems();
295 foreach my $line ( @{$lines} ) {
296 my $ordernumber = $line->ordernumber;
297 $logger->trace( "Receipting order:$ordernumber Qty: ",
300 my $order = $schema->resultset('Aqorder')->find($ordernumber);
302 # ModReceiveOrder does not validate that $ordernumber exists validate here
306 my $s = $schema->resultset('Suggestion')->search(
308 biblionumber => $order->biblionumber->biblionumber,
314 suggestionid => $s->suggestionid,
315 STATUS => 'AVAILABLE',
319 # If quantity_invoiced is present use it in preference
320 my $quantity = $line->quantity_invoiced;
322 $quantity = $line->quantity;
325 my ( $price, $price_excl_tax ) = _get_invoiced_price($line, $quantity);
326 my $tax_rate = $line->tax_rate;
327 if ($tax_rate && $tax_rate->{rate} != 0) {
328 $tax_rate->{rate} /= 100;
331 if ( $order->quantity > $quantity ) {
332 my $ordered = $order->quantity;
335 $order->orderstatus('partial');
336 $order->quantity( $ordered - $quantity );
338 my $received_order = $order->copy(
340 ordernumber => undef,
341 quantity => $quantity,
342 quantityreceived => $quantity,
343 orderstatus => 'complete',
345 unitprice_tax_included => $price,
346 unitprice_tax_excluded => $price_excl_tax,
347 invoiceid => $invoiceid,
348 datereceived => $msg_date,
349 tax_rate_on_receiving => $tax_rate->{rate},
350 tax_value_on_receiving => $quantity * $price_excl_tax * $tax_rate->{rate},
353 transfer_items( $schema, $line, $order,
354 $received_order, $quantity );
355 receipt_items( $schema, $line,
356 $received_order->ordernumber, $quantity );
358 else { # simple receipt all copies on order
359 $order->quantityreceived( $quantity );
360 $order->datereceived($msg_date);
361 $order->invoiceid($invoiceid);
362 $order->unitprice($price);
363 $order->unitprice_tax_excluded($price_excl_tax);
364 $order->unitprice_tax_included($price);
365 $order->tax_rate_on_receiving($tax_rate->{rate});
366 $order->tax_value_on_receiving( $quantity * $price_excl_tax * $tax_rate->{rate});
367 $order->orderstatus('complete');
369 receipt_items( $schema, $line, $ordernumber, $quantity );
374 "No order found for $ordernumber Invoice:$invoicenumber"
384 $invoice_message->status('received');
385 $invoice_message->update; # status and basketno link
389 sub _get_invoiced_price {
392 my $line_total = $line->amt_total;
393 my $excl_tax = $line->amt_lineitem;
395 # If no tax some suppliers omit the total owed
396 # If no total given calculate from cost exclusive of tax
397 # + tax amount (if present, sometimes omitted if 0 )
398 if ( !defined $line_total ) {
399 my $x = $line->amt_taxoncharge;
403 $line_total = $excl_tax + $x;
406 # invoices give amounts per orderline, Koha requires that we store
409 return ( $line_total / $qty, $excl_tax / $qty );
411 return ( $line_total, $excl_tax ); # return as is for most common case
415 my ( $schema, $inv_line, $ordernumber, $quantity ) = @_;
416 my $logger = Log::Log4perl->get_logger();
418 # itemnumber is not a foreign key ??? makes this a bit cumbersome
419 my @item_links = $schema->resultset('AqordersItem')->search(
421 ordernumber => $ordernumber,
425 foreach my $ilink (@item_links) {
426 my $item = $schema->resultset('Item')->find( $ilink->itemnumber );
428 my $i = $ilink->itemnumber;
430 "Cannot find aqorder item for $i :Order:$ordernumber");
433 my $b = $item->get_column('homebranch');
434 if ( !exists $branch_map{$b} ) {
435 $branch_map{$b} = [];
437 push @{ $branch_map{$b} }, $item;
440 # Handling for 'AcqItemSetSubfieldsWhenReceived'
444 if ( C4::Context->preference('AcqCreateItem') eq 'ordering' ) {
445 @affects = split q{\|},
446 C4::Context->preference("AcqItemSetSubfieldsWhenReceived");
448 my $order = Koha::Acquisition::Orders->find($ordernumber);
449 $biblionumber = $order->biblionumber;
450 my $frameworkcode = GetFrameworkCode($biblionumber);
451 ($itemfield) = GetMarcFromKohaField( 'items.itemnumber',
456 my $gir_occurrence = 0;
457 while ( $gir_occurrence < $quantity ) {
458 my $branch = $inv_line->girfield( 'branch', $gir_occurrence );
459 my $item = shift @{ $branch_map{$branch} };
461 my $barcode = $inv_line->girfield( 'barcode', $gir_occurrence );
462 if ( $barcode && !$item->barcode ) {
463 my $rs = $schema->resultset('Item')->search(
468 if ( $rs->count > 0 ) {
469 $logger->warn("Barcode $barcode is a duplicate");
473 $logger->trace("Adding barcode $barcode");
474 $item->barcode($barcode);
478 # Handling for 'AcqItemSetSubfieldsWhenReceived'
480 my $item_marc = C4::Items::GetMarcItem( $biblionumber, $item->itemnumber );
481 for my $affect (@affects) {
482 my ( $sf, $v ) = split q{=}, $affect, 2;
483 foreach ( $item_marc->field($itemfield) ) {
484 $_->update( $sf => $v );
487 C4::Items::ModItemFromMarc( $item_marc, $biblionumber, $item->itemnumber );
493 $logger->warn("Unmatched item at branch:$branch");
502 my ( $schema, $inv_line, $order_from, $order_to, $quantity ) = @_;
504 # Transfer x items from the orig order to a completed partial order
506 my %mapped_by_branch;
507 while ( $gocc < $quantity ) {
508 my $branch = $inv_line->girfield( 'branch', $gocc );
509 if ( !exists $mapped_by_branch{$branch} ) {
510 $mapped_by_branch{$branch} = 1;
513 $mapped_by_branch{$branch}++;
517 my $logger = Log::Log4perl->get_logger();
518 my $o1 = $order_from->ordernumber;
519 my $o2 = $order_to->ordernumber;
520 $logger->warn("transferring $quantity copies from order $o1 to order $o2");
522 my @item_links = $schema->resultset('AqordersItem')->search(
524 ordernumber => $order_from->ordernumber,
527 foreach my $ilink (@item_links) {
528 my $ino = $ilink->itemnumber;
529 my $item = $schema->resultset('Item')->find( $ilink->itemnumber );
530 my $i_branch = $item->get_column('homebranch');
531 if ( exists $mapped_by_branch{$i_branch}
532 && $mapped_by_branch{$i_branch} > 0 )
534 $ilink->ordernumber( $order_to->ordernumber );
537 --$mapped_by_branch{$i_branch};
538 $logger->warn("Transferred item $item");
541 $logger->warn("Skipped item $item");
543 if ( $quantity < 1 ) {
554 $quote->status('processing');
557 my $edi = Koha::Edifact->new( { transmission => $quote->raw_msg, } );
559 my $messages = $edi->message_array();
560 my $process_errors = 0;
561 my $logger = Log::Log4perl->get_logger();
562 my $schema = Koha::Database->new()->schema();
563 my $message_count = 0;
564 my @added_baskets; # if auto & multiple baskets need to order all
566 if ( @{$messages} && $quote->vendor_id ) {
567 foreach my $msg ( @{$messages} ) {
570 NewBasket( $quote->vendor_id, 0, $quote->filename, q{},
572 push @added_baskets, $basketno;
573 if ( $message_count > 1 ) {
574 my $m_filename = $quote->filename;
575 $m_filename .= "_$message_count";
576 $schema->resultset('EdifactMessage')->create(
578 message_type => $quote->message_type,
579 transfer_date => $quote->transfer_date,
580 vendor_id => $quote->vendor_id,
581 edi_acct => $quote->edi_acct,
583 basketno => $basketno,
585 filename => $m_filename,
590 $quote->basketno($basketno);
592 $logger->trace("Created basket :$basketno");
593 my $items = $msg->lineitems();
594 my $refnum = $msg->message_refno;
596 for my $item ( @{$items} ) {
597 if ( !quote_item( $item, $quote, $basketno ) ) {
603 my $status = 'received';
604 if ($process_errors) {
608 $quote->status($status);
609 $quote->update; # status and basketno link
610 # Do we automatically generate orders for this vendor
611 my $v = $schema->resultset('VendorEdiAccount')->search(
613 vendor_id => $quote->vendor_id,
616 if ( $v->auto_orders ) {
617 for my $b (@added_baskets) {
620 ean => $messages->[0]->buyer_ean,
624 Koha::Acquisition::Baskets->find($b)->close;
626 if (C4::Context->preference("AcquisitionLog")) {
627 my $approved = Koha::Acquisition::Baskets->find( $b );
632 to_json($approved->unblessed)
643 my ( $item, $quote, $basketno ) = @_;
645 my $schema = Koha::Database->new()->schema();
646 my $logger = Log::Log4perl->get_logger();
648 # $basketno is the return from AddBasket in the calling routine
649 # So this call should not fail unless that has
650 my $basket = Koha::Acquisition::Baskets->find( $basketno );
652 $logger->error('Skipping order creation no valid basketno');
655 $logger->trace( 'Checking db for matches with ', $item->item_number_id() );
656 my $bib = _check_for_existing_bib( $item->item_number_id() );
657 if ( !defined $bib ) {
659 my $bib_record = _create_bib_from_quote( $item, $quote );
660 ( $bib->{biblionumber}, $bib->{biblioitemnumber} ) =
661 AddBiblio( $bib_record, q{} );
662 $logger->trace("New biblio added $bib->{biblionumber}");
665 $logger->trace("Match found: $bib->{biblionumber}");
668 # Create an orderline
669 my $order_note = $item->{orderline_free_text};
671 my $order_quantity = $item->quantity();
672 my $gir_count = $item->number_of_girs();
673 $order_quantity ||= 1; # quantity not necessarily present
674 if ( $gir_count > 1 ) {
675 if ( $gir_count != $order_quantity ) {
677 "Order for $order_quantity items, $gir_count segments present");
679 $order_quantity = 1; # attempts to create an orderline for each gir
681 my $price = $item->price_info;
682 # Howells do not send an info price but do have a gross price
684 $price = $item->price_gross;
686 my $vendor = Koha::Acquisition::Booksellers->find( $quote->vendor_id );
688 # NB quote will not include tax info it only contains the list price
689 my $ecost = _discounted_price( $vendor->discount, $price, $item->price_info_inclusive );
691 # database definitions should set some of these defaults but dont
693 biblionumber => $bib->{biblionumber},
694 entrydate => dt_from_string()->ymd(),
695 basketno => $basketno,
697 quantity => $order_quantity,
698 quantityreceived => 0,
699 order_vendornote => q{},
700 order_internalnote => q{},
701 replacementprice => $price,
702 rrp_tax_included => $price,
703 rrp_tax_excluded => $price,
706 ecost_tax_included => $ecost,
707 ecost_tax_excluded => $ecost,
711 currency => $vendor->listprice(),
714 # suppliers references
715 if ( $item->reference() ) {
716 $order_hash->{suppliers_reference_number} = $item->reference;
717 $order_hash->{suppliers_reference_qualifier} = 'QLI';
719 elsif ( $item->orderline_reference_number() ) {
720 $order_hash->{suppliers_reference_number} =
721 $item->orderline_reference_number;
722 $order_hash->{suppliers_reference_qualifier} = 'SLI';
724 if ( $item->item_number_id ) { # suppliers ean
725 $order_hash->{line_item_id} = $item->item_number_id;
728 if ( $item->girfield('servicing_instruction') ) {
732 while ( $si = $item->girfield( 'servicing_instruction', $occ ) ) {
741 $order_hash->{order_vendornote} = $order_note;
744 if ( $item->internal_notes() ) {
745 if ( $order_hash->{order_internalnote} ) { # more than ''
746 $order_hash->{order_internalnote} .= q{ };
748 $order_hash->{order_internalnote} .= $item->internal_notes;
751 my $budget = _get_budget( $schema, $item->girfield('fund_allocation') );
755 if ( $item->quantity > 1 ) {
756 carp 'Skipping line with no budget info';
757 $logger->trace('girfield skipped for invalid budget');
761 carp 'Skipping line with no budget info';
762 $logger->trace('orderline skipped for invalid budget');
772 $order_hash->{budget_id} = $budget->budget_id;
773 my $first_order = $schema->resultset('Aqorder')->create($order_hash);
774 my $o = $first_order->ordernumber();
775 $logger->trace("Order created :$o");
777 # should be done by database settings
778 $first_order->parent_ordernumber( $first_order->ordernumber() );
779 $first_order->update();
781 # add to $budgets to prevent duplicate orderlines
782 $budgets{ $budget->budget_id } = '1';
784 # record ordernumber against budget
785 $ordernumber{ $budget->budget_id } = $o;
787 if ( C4::Context->preference('AcqCreateItem') eq 'ordering' ) {
788 $item_hash = _create_item_from_quote( $item, $quote );
791 while ( $created < $order_quantity ) {
792 $item_hash->{biblionumber} = $bib->{biblionumber};
793 $item_hash->{biblioitemnumber} = $bib->{biblioitemnumber};
794 my $kitem = Koha::Item->new( $item_hash )->store;
795 my $itemnumber = $kitem->itemnumber;
796 $logger->trace("Added item:$itemnumber");
797 $schema->resultset('AqordersItem')->create(
799 ordernumber => $first_order->ordernumber,
800 itemnumber => $itemnumber,
808 if ( $order_quantity == 1 && $item->quantity > 1 ) {
809 my $occurrence = 1; # occ zero already added
810 while ( $occurrence < $item->quantity ) {
813 $budget = _get_budget( $schema,
814 $item->girfield( 'fund_allocation', $occurrence ) );
818 $item->girfield( 'fund_allocation', $occurrence );
819 carp 'Skipping line with no budget info';
821 "girfield skipped for invalid budget:$bad_budget");
822 ++$occurrence; ## lets look at the next one not this one again
826 # add orderline for NEW budget in $budgets
827 if ( !exists $budgets{ $budget->budget_id } ) {
829 # $order_hash->{quantity} = 1; by default above
830 # we should handle both 1:1 GIR & 1:n GIR (with LQT values) here
832 $order_hash->{budget_id} = $budget->budget_id;
835 $schema->resultset('Aqorder')->create($order_hash);
836 my $o = $new_order->ordernumber();
837 $logger->trace("Order created :$o");
839 # should be done by database settings
840 $new_order->parent_ordernumber( $new_order->ordernumber() );
841 $new_order->update();
843 # add to $budgets to prevent duplicate orderlines
844 $budgets{ $budget->budget_id } = '1';
846 # record ordernumber against budget
847 $ordernumber{ $budget->budget_id } = $o;
849 if ( C4::Context->preference('AcqCreateItem') eq 'ordering' ) {
850 if ( !defined $item_hash ) {
851 $item_hash = _create_item_from_quote( $item, $quote );
855 $item->girfield( 'stock_category', $occurrence ),
857 $item->girfield( 'collection_code', $occurrence ),
859 $item->girfield( 'shelfmark', $occurrence )
860 || $item->girfield( 'classification', $occurrence )
861 || title_level_class($item),
863 $item->girfield( 'branch', $occurrence ),
864 homebranch => $item->girfield( 'branch', $occurrence ),
866 if ( $new_item->{itype} ) {
867 $item_hash->{itype} = $new_item->{itype};
869 if ( $new_item->{location} ) {
870 $item_hash->{location} = $new_item->{location};
872 if ( $new_item->{itemcallnumber} ) {
873 $item_hash->{itemcallnumber} =
874 $new_item->{itemcallnumber};
876 if ( $new_item->{holdingbranch} ) {
877 $item_hash->{holdingbranch} =
878 $new_item->{holdingbranch};
880 if ( $new_item->{homebranch} ) {
881 $item_hash->{homebranch} = $new_item->{homebranch};
884 $item_hash->{biblionumber} = $bib->{biblionumber};
885 $item_hash->{biblioitemnumber} = $bib->{biblioitemnumber};
886 my $kitem = Koha::Item->new( $item_hash )->store;
887 my $itemnumber = $kitem->itemnumber;
888 $logger->trace("New item $itemnumber added");
889 $schema->resultset('AqordersItem')->create(
891 ordernumber => $new_order->ordernumber,
892 itemnumber => $itemnumber,
897 $item->girfield( 'library_rotation_plan', $occurrence );
900 Koha::StockRotationRotas->find( { title => $lrp },
901 { key => 'stockrotationrotas_title' } );
903 $rota->add_item($itemnumber);
904 $logger->trace("Item added to rota $rota->id");
908 "No rota found matching $lrp in orderline");
916 # increment quantity in orderline for EXISTING budget in $budgets
918 my $row = $schema->resultset('Aqorder')->find(
920 ordernumber => $ordernumber{ $budget->budget_id }
924 my $qty = $row->quantity;
933 # Do not use the basket level value as it is always NULL
934 # See calling subs call to AddBasket
935 if ( C4::Context->preference('AcqCreateItem') eq 'ordering' ) {
941 replacementprice => $price,
943 $item->girfield( 'stock_category', $occurrence ),
945 $item->girfield( 'collection_code', $occurrence ),
947 $item->girfield( 'shelfmark', $occurrence )
948 || $item->girfield( 'classification', $occurrence )
949 || $item_hash->{itemcallnumber},
951 $item->girfield( 'branch', $occurrence ),
952 homebranch => $item->girfield( 'branch', $occurrence ),
954 $new_item->{biblionumber} = $bib->{biblionumber};
955 $new_item->{biblioitemnumber} = $bib->{biblioitemnumber};
956 my $kitem = Koha::Item->new( $new_item )->store;
957 my $itemnumber = $kitem->itemnumber;
958 $logger->trace("New item $itemnumber added");
959 $schema->resultset('AqordersItem')->create(
961 ordernumber => $ordernumber{ $budget->budget_id },
962 itemnumber => $itemnumber,
967 $item->girfield( 'library_rotation_plan', $occurrence );
970 Koha::StockRotationRotas->find( { title => $lrp },
971 { key => 'stockrotationrotas_title' } );
973 $rota->add_item($itemnumber);
974 $logger->trace("Item added to rota $rota->id");
978 "No rota found matching $lrp in orderline");
991 sub get_edifact_ean {
993 my $dbh = C4::Context->dbh;
995 my $eans = $dbh->selectcol_arrayref('select ean from edifact_ean');
1000 # We should not need to have a routine to do this here
1001 sub _discounted_price {
1002 my ( $discount, $price, $discounted_price ) = @_;
1003 if (defined $discounted_price) {
1004 return $discounted_price;
1009 return $price - ( ( $discount * $price ) / 100 );
1012 sub _check_for_existing_bib {
1015 my $search_isbn = $isbn;
1016 $search_isbn =~ s/^\s*/%/xms;
1017 $search_isbn =~ s/\s*$/%/xms;
1018 my $dbh = C4::Context->dbh;
1019 my $sth = $dbh->prepare(
1020 'select biblionumber, biblioitemnumber from biblioitems where isbn like ?',
1023 $dbh->selectall_arrayref( $sth, { Slice => {} }, $search_isbn );
1024 if ( @{$tuple_arr} ) {
1025 return $tuple_arr->[0];
1027 elsif ( length($isbn) == 13 && $isbn !~ /^97[89]/ ) {
1028 my $tarr = $dbh->selectall_arrayref(
1029 'select biblionumber, biblioitemnumber from biblioitems where ean = ?',
1039 $isbn =~ s/\-//xmsg;
1040 if ( $isbn =~ m/(\d{13})/xms ) {
1041 my $b_isbn = Business::ISBN->new($1);
1042 if ( $b_isbn && $b_isbn->is_valid && $b_isbn->as_isbn10 ) {
1043 $search_isbn = $b_isbn->as_isbn10->as_string( [] );
1047 elsif ( $isbn =~ m/(\d{9}[xX]|\d{10})/xms ) {
1048 my $b_isbn = Business::ISBN->new($1);
1049 if ( $b_isbn && $b_isbn->is_valid ) {
1050 $search_isbn = $b_isbn->as_isbn13->as_string( [] );
1055 $search_isbn = "%$search_isbn%";
1057 $dbh->selectall_arrayref( $sth, { Slice => {} }, $search_isbn );
1058 if ( @{$tuple_arr} ) {
1059 return $tuple_arr->[0];
1066 # returns a budget obj or undef
1067 # fact we need this shows what a mess Acq API is
1069 my ( $schema, $budget_code ) = @_;
1070 my $period_rs = $schema->resultset('Aqbudgetperiod')->search(
1072 budget_period_active => 1,
1076 # db does not ensure budget code is unque
1077 return $schema->resultset('Aqbudget')->single(
1079 budget_code => $budget_code,
1081 { -in => $period_rs->get_column('budget_period_id')->as_query },
1086 # try to get title level classification from incoming quote
1087 sub title_level_class {
1090 my $default_scheme = C4::Context->preference('DefaultClassificationSource');
1091 if ( $default_scheme eq 'ddc' ) {
1092 $class = $item->dewey_class();
1094 elsif ( $default_scheme eq 'lcc' ) {
1095 $class = $item->lc_class();
1099 $item->girfield('shelfmark')
1100 || $item->girfield('classification')
1106 sub _create_bib_from_quote {
1108 #TBD we should flag this for updating from an external source
1109 #As biblio (&biblioitems) has no candidates flag in order
1110 my ( $item, $quote ) = @_;
1111 my $itemid = $item->item_number_id;
1112 my $defalt_classification_source =
1113 C4::Context->preference('DefaultClassificationSource');
1115 'biblioitems.cn_source' => $defalt_classification_source,
1116 'items.cn_source' => $defalt_classification_source,
1117 'items.notforloan' => -1,
1118 'items.cn_sort' => q{},
1120 $bib_hash->{'biblio.seriestitle'} = $item->series;
1122 $bib_hash->{'biblioitems.publishercode'} = $item->publisher;
1123 $bib_hash->{'biblioitems.publicationyear'} =
1124 $bib_hash->{'biblio.copyrightdate'} = $item->publication_date;
1126 $bib_hash->{'biblio.title'} = $item->title;
1127 $bib_hash->{'biblio.author'} = $item->author;
1128 $bib_hash->{'biblioitems.isbn'} = $item->item_number_id;
1129 $bib_hash->{'biblioitems.itemtype'} = $item->girfield('stock_category');
1131 # If we have a 13 digit id we are assuming its an ean
1132 # (it may also be an isbn or issn)
1133 if ( $itemid =~ /^\d{13}$/ ) {
1134 $bib_hash->{'biblioitems.ean'} = $itemid;
1135 if ( $itemid =~ /^977/ ) {
1136 $bib_hash->{'biblioitems.issn'} = $itemid;
1139 for my $key ( keys %{$bib_hash} ) {
1140 if ( !defined $bib_hash->{$key} ) {
1141 delete $bib_hash->{$key};
1144 return TransformKohaToMarc($bib_hash);
1148 sub _create_item_from_quote {
1149 my ( $item, $quote ) = @_;
1150 my $defalt_classification_source =
1151 C4::Context->preference('DefaultClassificationSource');
1153 cn_source => $defalt_classification_source,
1157 $item_hash->{booksellerid} = $quote->vendor_id;
1158 $item_hash->{price} = $item_hash->{replacementprice} = $item->price;
1159 $item_hash->{itype} = $item->girfield('stock_category');
1160 $item_hash->{location} = $item->girfield('collection_code');
1164 $item_hash->{itemcallnumber} =
1165 $item->girfield('shelfmark')
1166 || $item->girfield('classification')
1167 || title_level_class($item);
1169 my $branch = $item->girfield('branch');
1170 $item_hash->{holdingbranch} = $item_hash->{homebranch} = $branch;
1183 Module exporting subroutines used in EDI processing for Koha
1187 Subroutines called by batch processing to handle Edifact
1188 messages of various types and related utilities
1192 These routines should really be methods of some object.
1193 get_edifact_ean is a stopgap which should be replaced
1197 =head2 process_quote
1199 process_quote(quote_message);
1201 passed a message object for a quote, parses it creating an order basket
1202 and orderlines in the database
1203 updates the message's status to received in the database and adds the
1206 =head2 process_invoice
1208 process_invoice(invoice_message)
1210 passed a message object for an invoice, add the contained invoices
1211 and update the orderlines referred to in the invoice
1212 As an Edifact invoice is in effect a despatch note this receipts the
1213 appropriate quantities in the orders
1215 no meaningful return value
1217 =head2 process_ordrsp
1219 process_ordrsp(ordrsp_message)
1221 passed a message object for a supplier response, process the contents
1222 If an orderline is cancelled cancel the corresponding orderline in koha
1223 otherwise record the supplier message against it
1225 no meaningful return value
1227 =head2 create_edi_order
1229 create_edi_order( { parameter_hashref } )
1231 parameters must include basketno and ean
1233 branchcode can optionally be passed
1235 returns 1 on success undef otherwise
1237 if the parameter noingest is set the formatted order is returned
1238 and not saved in the database. This functionality is intended for debugging only
1240 =head2 receipt_items
1242 receipt_items( schema_obj, invoice_line, ordernumber, $quantity)
1244 receipts the items recorded on this invoice line
1246 no meaningful return
1248 =head2 transfer_items
1250 transfer_items(schema, invoice_line, originating_order, receiving_order, $quantity)
1252 Transfer the items covered by this invoice line from their original
1253 order to another order recording the partial fulfillment of the original
1256 no meaningful return
1258 =head2 get_edifact_ean
1260 $ean = get_edifact_ean();
1262 routine to return the ean.
1266 quote_item(lineitem, quote_message);
1268 Called by process_quote to handle an individual lineitem
1269 Generate the biblios and items if required and orderline linking to them
1271 Returns 1 on success undef on error
1273 Most usual cause of error is a line with no or incorrect budget codes
1274 which woild cause order creation to abort
1275 If other correct lines exist these are processed and the erroneous line os logged
1277 =head2 title_level_class
1279 classmark = title_level_class(edi_item)
1281 Trys to return a title level classmark from a quote message line
1282 Will return a dewey or lcc classmark if one exists according to the
1283 value in DefaultClassificationSource syspref
1285 If unable to returns the shelfmark or classification from the GIR segment
1287 If all else fails returns empty string
1289 =head2 _create_bib_from_quote
1291 marc_record_obj = _create_bib_from_quote(lineitem, quote)
1293 Returns a MARC::Record object based on the info in the quote's lineitem
1295 =head2 _create_item_from_quote
1297 item_hashref = _create_item_from_quote( lineitem, quote)
1299 returns a hashref representing the item fields specified in the quote
1301 =head2 _get_invoiced_price
1303 (price, price_tax_excluded) = _get_invoiced_price(line_object, $quantity)
1305 Returns an array of unitprice and unitprice_tax_excluded derived from the lineitem
1308 =head2 _discounted_price
1310 ecost = _discounted_price(discount, item_price, discounted_price)
1312 utility subroutine to return a price calculated from the
1313 vendors discount and quoted price
1314 if invoice has a field containing discounted price that is returned
1315 instead of recalculating
1317 =head2 _check_for_existing_bib
1319 (biblionumber, biblioitemnumber) = _check_for_existing_bib(isbn_or_ean)
1321 passed an isbn or ean attempts to locate a match bib
1322 On success returns biblionumber and biblioitemnumber
1323 On failure returns undefined/an empty list
1327 b = _get_budget(schema_obj, budget_code)
1329 Returns the Aqbudget object for the active budget given the passed budget_code
1330 or undefined if one does not exist
1334 Colin Campbell <colin.campbell@ptfs-europe.com>
1339 Copyright 2014,2015 PTFS-Europe Ltd
1340 This program is free software, You may redistribute it under
1341 under the terms of the GNU General Public License