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 C4::Acquisition qw( NewBasket CloseBasket ModOrder);
31 use C4::Suggestions qw( ModSuggestion );
32 use C4::Items qw(AddItem);
33 use C4::Biblio qw( AddBiblio TransformKohaToMarc GetMarcBiblio );
34 use Koha::Edifact::Order;
38 use Koha::Plugins::Handler;
39 use Koha::Acquisition::Booksellers;
43 qw( process_quote process_invoice process_ordrsp create_edi_order get_edifact_ean );
45 sub create_edi_order {
46 my $parameters = shift;
47 my $basketno = $parameters->{basketno};
48 my $ean = $parameters->{ean};
49 my $branchcode = $parameters->{branchcode};
50 my $noingest = $parameters->{noingest};
51 if ( !$basketno || !$ean ) {
52 carp 'create_edi_order called with no basketno or ean';
56 my $schema = Koha::Database->new()->schema();
58 my @orderlines = $schema->resultset('Aqorder')->search(
60 basketno => $basketno,
66 carp "No orderlines for basket $basketno";
70 my $vendor = $schema->resultset('VendorEdiAccount')->search(
72 vendor_id => $orderlines[0]->basketno->booksellerid->id,
76 my $ean_search_keys = { ean => $ean, };
78 $ean_search_keys->{branchcode} = $branchcode;
81 $schema->resultset('EdifactEan')->search($ean_search_keys)->single;
83 # If no branch specific each can be found, look for a default ean
85 $ean_obj = $schema->resultset('EdifactEan')->search(
93 my $dbh = C4::Context->dbh;
94 my $arr_ref = $dbh->selectcol_arrayref(
95 'select id from edifact_messages where basketno = ? and message_type = \'QUOTE\'',
98 my $response = @{$arr_ref} ? 1 : 0;
100 my $edifact_order_params = {
101 orderlines => \@orderlines,
104 is_response => $response,
108 if ( $vendor->plugin ) {
109 $edifact = Koha::Plugins::Handler->run(
111 class => $vendor->plugin,
112 method => 'edifact_order',
114 params => $edifact_order_params,
120 $edifact = Koha::Edifact::Order->new($edifact_order_params);
123 return unless $edifact;
125 my $order_file = $edifact->encode();
129 my $m = unidecode($order_file); # remove diacritics and non-latin chars
130 if ($noingest) { # allows scripts to produce test files
134 message_type => 'ORDERS',
136 vendor_id => $vendor->vendor_id,
138 basketno => $basketno,
139 filename => $edifact->filename(),
140 transfer_date => $edifact->msg_date_string(),
141 edi_acct => $vendor->id,
144 $schema->resultset('EdifactMessage')->create($order);
152 my $response_message = shift;
153 $response_message->status('processing');
154 $response_message->update;
155 my $schema = Koha::Database->new()->schema();
156 my $logger = Log::Log4perl->get_logger();
159 Koha::Edifact->new( { transmission => $response_message->raw_msg, } );
160 my $messages = $edi->message_array();
162 if ( @{$messages} ) {
163 foreach my $msg ( @{$messages} ) {
164 my $lines = $msg->lineitems();
165 foreach my $line ( @{$lines} ) {
166 my $ordernumber = $line->ordernumber();
168 # action cancelled:change_requested:no_action:accepted:not_found:recorded
169 my $action = $line->action_notification();
170 if ( $action eq 'cancelled' ) {
171 my $reason = $line->coded_orderline_text();
174 ordernumber => $ordernumber,
175 cancellationreason => $reason,
176 orderstatus => 'cancelled',
177 datecancellationprinted => DateTime->now()->ymd(),
181 else { # record order as due with possible further info
183 my $report = $line->coded_orderline_text();
184 my $date_avail = $line->availability_date();
187 $report .= " Available: $date_avail";
191 ordernumber => $ordernumber,
192 suppliers_report => $report,
200 $response_message->status('received');
201 $response_message->update;
205 sub process_invoice {
206 my $invoice_message = shift;
207 $invoice_message->status('processing');
208 $invoice_message->update;
209 my $schema = Koha::Database->new()->schema();
210 my $logger = Log::Log4perl->get_logger();
213 my $plugin = $invoice_message->edi_acct()->plugin();
216 $edi_plugin = Koha::Plugins::Handler->run(
221 invoice_message => $invoice_message,
222 transmission => $invoice_message->raw_msg,
228 my $edi = $edi_plugin ||
229 Koha::Edifact->new( { transmission => $invoice_message->raw_msg, } );
231 my $messages = $edi->message_array();
233 if ( @{$messages} ) {
235 # BGM contains an invoice number
236 foreach my $msg ( @{$messages} ) {
237 my $invoicenumber = $msg->docmsg_number();
238 my $shipmentcharge = $msg->shipment_charge();
239 my $msg_date = $msg->message_date;
240 my $tax_date = $msg->tax_point_date;
241 if ( !defined $tax_date || $tax_date !~ m/^\d{8}/xms ) {
242 $tax_date = $msg_date;
245 my $vendor_ean = $msg->supplier_ean;
246 if ( !defined $vendor_acct || $vendor_ean ne $vendor_acct->san ) {
247 $vendor_acct = $schema->resultset('VendorEdiAccount')->search(
253 if ( !$vendor_acct ) {
255 "Cannot find vendor with ean $vendor_ean for invoice $invoicenumber in $invoice_message->filename";
258 $invoice_message->edi_acct( $vendor_acct->id );
259 $logger->trace("Adding invoice:$invoicenumber");
260 my $new_invoice = $schema->resultset('Aqinvoice')->create(
262 invoicenumber => $invoicenumber,
263 booksellerid => $invoice_message->vendor_id,
264 shipmentdate => $msg_date,
265 billingdate => $tax_date,
266 shipmentcost => $shipmentcharge,
267 shipmentcost_budgetid => $vendor_acct->shipment_budget,
268 message_id => $invoice_message->id,
271 my $invoiceid = $new_invoice->invoiceid;
272 $logger->trace("Added as invoiceno :$invoiceid");
273 my $lines = $msg->lineitems();
275 foreach my $line ( @{$lines} ) {
276 my $ordernumber = $line->ordernumber;
277 $logger->trace( "Receipting order:$ordernumber Qty: ",
280 my $order = $schema->resultset('Aqorder')->find($ordernumber);
282 # ModReceiveOrder does not validate that $ordernumber exists validate here
286 my $s = $schema->resultset('Suggestion')->search(
288 biblionumber => $order->biblionumber->biblionumber,
294 suggestionid => $s->suggestionid,
295 STATUS => 'AVAILABLE',
300 my $price = _get_invoiced_price($line);
302 if ( $order->quantity > $line->quantity ) {
303 my $ordered = $order->quantity;
306 $order->orderstatus('partial');
307 $order->quantity( $ordered - $line->quantity );
309 my $received_order = $order->copy(
311 ordernumber => undef,
312 quantity => $line->quantity,
313 quantityreceived => $line->quantity,
314 orderstatus => 'complete',
316 invoiceid => $invoiceid,
317 datereceived => $msg_date,
320 transfer_items( $schema, $line, $order,
322 receipt_items( $schema, $line,
323 $received_order->ordernumber );
325 else { # simple receipt all copies on order
326 $order->quantityreceived( $line->quantity );
327 $order->datereceived($msg_date);
328 $order->invoiceid($invoiceid);
329 $order->unitprice($price);
330 $order->orderstatus('complete');
332 receipt_items( $schema, $line, $ordernumber );
337 "No order found for $ordernumber Invoice:$invoicenumber"
347 $invoice_message->status('received');
348 $invoice_message->update; # status and basketno link
352 sub _get_invoiced_price {
354 my $price = $line->price_net;
355 if ( !defined $price ) { # no net price so generate it from lineitem amount
356 $price = $line->amt_lineitem;
357 if ( $price and $line->quantity > 1 ) {
358 $price /= $line->quantity; # div line cost by qty
365 my ( $schema, $inv_line, $ordernumber ) = @_;
366 my $logger = Log::Log4perl->get_logger();
367 my $quantity = $inv_line->quantity;
369 # itemnumber is not a foreign key ??? makes this a bit cumbersome
370 my @item_links = $schema->resultset('AqordersItem')->search(
372 ordernumber => $ordernumber,
376 foreach my $ilink (@item_links) {
377 my $item = $schema->resultset('Item')->find( $ilink->itemnumber );
379 my $i = $ilink->itemnumber;
381 "Cannot find aqorder item for $i :Order:$ordernumber");
384 my $b = $item->homebranch->branchcode;
385 if ( !exists $branch_map{$b} ) {
386 $branch_map{$b} = [];
388 push @{ $branch_map{$b} }, $item;
390 my $gir_occurrence = 0;
391 while ( $gir_occurrence < $quantity ) {
392 my $branch = $inv_line->girfield( 'branch', $gir_occurrence );
393 my $item = shift @{ $branch_map{$branch} };
395 my $barcode = $inv_line->girfield( 'barcode', $gir_occurrence );
396 if ( $barcode && !$item->barcode ) {
397 my $rs = $schema->resultset('Item')->search(
402 if ( $rs->count > 0 ) {
403 $logger->warn("Barcode $barcode is a duplicate");
407 $logger->trace("Adding barcode $barcode");
408 $item->barcode($barcode);
415 $logger->warn("Unmatched item at branch:$branch");
424 my ( $schema, $inv_line, $order_from, $order_to ) = @_;
426 # Transfer x items from the orig order to a completed partial order
427 my $quantity = $inv_line->quantity;
429 my %mapped_by_branch;
430 while ( $gocc < $quantity ) {
431 my $branch = $inv_line->girfield( 'branch', $gocc );
432 if ( !exists $mapped_by_branch{$branch} ) {
433 $mapped_by_branch{$branch} = 1;
436 $mapped_by_branch{$branch}++;
440 my $logger = Log::Log4perl->get_logger();
441 my $o1 = $order_from->ordernumber;
442 my $o2 = $order_to->ordernumber;
443 $logger->warn("transferring $quantity copies from order $o1 to order $o2");
445 my @item_links = $schema->resultset('AqordersItem')->search(
447 ordernumber => $order_from->ordernumber,
450 foreach my $ilink (@item_links) {
451 my $ino = $ilink->itemnumber;
452 my $item = $schema->resultset('Item')->find( $ilink->itemnumber );
453 my $i_branch = $item->homebranch;
454 if ( exists $mapped_by_branch{$i_branch}
455 && $mapped_by_branch{$i_branch} > 0 )
457 $ilink->ordernumber( $order_to->ordernumber );
460 --$mapped_by_branch{$i_branch};
461 $logger->warn("Transferred item $item");
464 $logger->warn("Skipped item $item");
466 if ( $quantity < 1 ) {
477 $quote->status('processing');
480 my $edi = Koha::Edifact->new( { transmission => $quote->raw_msg, } );
482 my $messages = $edi->message_array();
483 my $process_errors = 0;
484 my $logger = Log::Log4perl->get_logger();
485 my $schema = Koha::Database->new()->schema();
486 my $message_count = 0;
487 my @added_baskets; # if auto & multiple baskets need to order all
489 if ( @{$messages} && $quote->vendor_id ) {
490 foreach my $msg ( @{$messages} ) {
493 NewBasket( $quote->vendor_id, 0, $quote->filename, q{},
495 push @added_baskets, $basketno;
496 if ( $message_count > 1 ) {
497 my $m_filename = $quote->filename;
498 $m_filename .= "_$message_count";
499 $schema->resultset('EdifactMessage')->create(
501 message_type => $quote->message_type,
502 transfer_date => $quote->transfer_date,
503 vendor_id => $quote->vendor_id,
504 edi_acct => $quote->edi_acct,
506 basketno => $basketno,
508 filename => $m_filename,
513 $quote->basketno($basketno);
515 $logger->trace("Created basket :$basketno");
516 my $items = $msg->lineitems();
517 my $refnum = $msg->message_refno;
519 for my $item ( @{$items} ) {
520 if ( !quote_item( $item, $quote, $basketno ) ) {
526 my $status = 'received';
527 if ($process_errors) {
531 $quote->status($status);
532 $quote->update; # status and basketno link
533 # Do we automatically generate orders for this vendor
534 my $v = $schema->resultset('VendorEdiAccount')->search(
536 vendor_id => $quote->vendor_id,
539 if ( $v->auto_orders ) {
540 for my $b (@added_baskets) {
555 my ( $item, $quote, $basketno ) = @_;
557 my $schema = Koha::Database->new()->schema();
559 # create biblio record
560 my $logger = Log::Log4perl->get_logger();
562 $logger->error('Skipping order creation no basketno');
565 $logger->trace( 'Checking db for matches with ', $item->item_number_id() );
566 my $bib = _check_for_existing_bib( $item->item_number_id() );
567 if ( !defined $bib ) {
569 my $bib_record = _create_bib_from_quote( $item, $quote );
570 ( $bib->{biblionumber}, $bib->{biblioitemnumber} ) =
571 AddBiblio( $bib_record, q{} );
572 $logger->trace("New biblio added $bib->{biblionumber}");
575 $logger->trace("Match found: $bib->{biblionumber}");
578 # Create an orderline
579 my $order_note = $item->{orderline_free_text};
581 my $order_quantity = $item->quantity();
582 my $gir_count = $item->number_of_girs();
583 $order_quantity ||= 1; # quantity not necessarily present
584 if ( $gir_count > 1 ) {
585 if ( $gir_count != $order_quantity ) {
587 "Order for $order_quantity items, $gir_count segments present");
589 $order_quantity = 1; # attempts to create an orderline for each gir
591 my $vendor = Koha::Acquisition::Booksellers->find( $quote->vendor_id );
593 # database definitions should set some of these defaults but dont
595 biblionumber => $bib->{biblionumber},
596 entrydate => DateTime->now( time_zone => 'local' )->ymd(),
597 basketno => $basketno,
598 listprice => $item->price,
599 quantity => $order_quantity,
600 quantityreceived => 0,
601 order_vendornote => q{},
602 order_internalnote => $order_note,
604 ecost => _discounted_price( $quote->vendor->discount, $item->price ),
608 currency => $vendor->listprice(),
611 # suppliers references
612 if ( $item->reference() ) {
613 $order_hash->{suppliers_reference_number} = $item->reference;
614 $order_hash->{suppliers_reference_qualifier} = 'QLI';
616 elsif ( $item->orderline_reference_number() ) {
617 $order_hash->{suppliers_reference_number} =
618 $item->orderline_reference_number;
619 $order_hash->{suppliers_reference_qualifier} = 'SLI';
621 if ( $item->item_number_id ) { # suppliers ean
622 $order_hash->{line_item_id} = $item->item_number_id;
625 if ( $item->girfield('servicing_instruction') ) {
629 while ( $si = $item->girfield( 'servicing_instruction', $occ ) ) {
636 $order_hash->{order_vendornote} = $txt;
639 if ( $item->internal_notes() ) {
640 if ( $order_hash->{order_internalnote} ) { # more than ''
641 $order_hash->{order_internalnote} .= q{ };
643 $order_hash->{order_internalnote} .= $item->internal_notes;
646 my $budget = _get_budget( $schema, $item->girfield('fund_allocation') );
650 if ( $item->quantity > 1 ) {
651 carp 'Skipping line with no budget info';
652 $logger->trace('girfield skipped for invalid budget');
656 carp 'Skipping line with no budget info';
657 $logger->trace('orderline skipped for invalid budget');
667 $order_hash->{budget_id} = $budget->budget_id;
668 my $first_order = $schema->resultset('Aqorder')->create($order_hash);
669 my $o = $first_order->ordernumber();
670 $logger->trace("Order created :$o");
672 # should be done by database settings
673 $first_order->parent_ordernumber( $first_order->ordernumber() );
674 $first_order->update();
676 # add to $budgets to prevent duplicate orderlines
677 $budgets{ $budget->budget_id } = '1';
679 # record ordernumber against budget
680 $ordernumber{ $budget->budget_id } = $o;
682 if ( C4::Context->preference('AcqCreateItem') eq 'ordering' ) {
683 $item_hash = _create_item_from_quote( $item, $quote );
686 while ( $created < $order_quantity ) {
688 ( $bib->{biblionumber}, $bib->{biblioitemnumber}, $itemnumber )
689 = AddItem( $item_hash, $bib->{biblionumber} );
690 $logger->trace("Added item:$itemnumber");
691 $schema->resultset('AqordersItem')->create(
693 ordernumber => $first_order->ordernumber,
694 itemnumber => $itemnumber,
702 if ( $order_quantity == 1 && $item->quantity > 1 ) {
703 my $occurrence = 1; # occ zero already added
704 while ( $occurrence < $item->quantity ) {
707 $budget = _get_budget( $schema,
708 $item->girfield( 'fund_allocation', $occurrence ) );
712 $item->girfield( 'fund_allocation', $occurrence );
713 carp 'Skipping line with no budget info';
715 "girfield skipped for invalid budget:$bad_budget");
716 ++$occurrence; ## lets look at the next one not this one again
720 # add orderline for NEW budget in $budgets
721 if ( !exists $budgets{ $budget->budget_id } ) {
723 # $order_hash->{quantity} = 1; by default above
724 # we should handle both 1:1 GIR & 1:n GIR (with LQT values) here
726 $order_hash->{budget_id} = $budget->budget_id;
729 $schema->resultset('Aqorder')->create($order_hash);
730 my $o = $new_order->ordernumber();
731 $logger->trace("Order created :$o");
733 # should be done by database settings
734 $new_order->parent_ordernumber( $new_order->ordernumber() );
735 $new_order->update();
737 # add to $budgets to prevent duplicate orderlines
738 $budgets{ $budget->budget_id } = '1';
740 # record ordernumber against budget
741 $ordernumber{ $budget->budget_id } = $o;
743 if ( C4::Context->preference('AcqCreateItem') eq 'ordering' ) {
744 if ( !defined $item_hash ) {
745 $item_hash = _create_item_from_quote( $item, $quote );
749 $item->girfield( 'stock_category', $occurrence ),
751 $item->girfield( 'collection_code', $occurrence ),
753 $item->girfield( 'shelfmark', $occurrence )
754 || $item->girfield( 'classification', $occurrence )
755 || title_level_class($item),
757 $item->girfield( 'branch', $occurrence ),
758 homebranch => $item->girfield( 'branch', $occurrence ),
760 if ( $new_item->{itype} ) {
761 $item_hash->{itype} = $new_item->{itype};
763 if ( $new_item->{location} ) {
764 $item_hash->{location} = $new_item->{location};
766 if ( $new_item->{itemcallnumber} ) {
767 $item_hash->{itemcallnumber} =
768 $new_item->{itemcallnumber};
770 if ( $new_item->{holdingbranch} ) {
771 $item_hash->{holdingbranch} =
772 $new_item->{holdingbranch};
774 if ( $new_item->{homebranch} ) {
775 $item_hash->{homebranch} = $new_item->{homebranch};
779 ( undef, undef, $itemnumber ) =
780 AddItem( $item_hash, $bib->{biblionumber} );
781 $logger->trace("New item $itemnumber added");
782 $schema->resultset('AqordersItem')->create(
784 ordernumber => $new_order->ordernumber,
785 itemnumber => $itemnumber,
793 # increment quantity in orderline for EXISTING budget in $budgets
795 my $row = $schema->resultset('Aqorder')->find(
797 ordernumber => $ordernumber{ $budget->budget_id }
801 my $qty = $row->quantity;
810 if ( C4::Context->preference('AcqCreateItem') eq 'ordering' ) {
815 price => $item->price,
816 replacementprice => $item->price,
818 $item->girfield( 'stock_category', $occurrence ),
820 $item->girfield( 'collection_code', $occurrence ),
822 $item->girfield( 'shelfmark', $occurrence )
823 || $item->girfield( 'classification', $occurrence )
824 || $item_hash->{itemcallnumber},
826 $item->girfield( 'branch', $occurrence ),
827 homebranch => $item->girfield( 'branch', $occurrence ),
830 ( undef, undef, $itemnumber ) =
831 AddItem( $new_item, $bib->{biblionumber} );
832 $logger->trace("New item $itemnumber added");
833 $schema->resultset('AqordersItem')->create(
835 ordernumber => $ordernumber{ $budget->budget_id },
836 itemnumber => $itemnumber,
849 sub get_edifact_ean {
851 my $dbh = C4::Context->dbh;
853 my $eans = $dbh->selectcol_arrayref('select ean from edifact_ean');
858 # We should not need to have a routine to do this here
859 sub _discounted_price {
860 my ( $discount, $price ) = @_;
861 return $price - ( ( $discount * $price ) / 100 );
864 sub _check_for_existing_bib {
867 my $search_isbn = $isbn;
868 $search_isbn =~ s/^\s*/%/xms;
869 $search_isbn =~ s/\s*$/%/xms;
870 my $dbh = C4::Context->dbh;
871 my $sth = $dbh->prepare(
872 'select biblionumber, biblioitemnumber from biblioitems where isbn like ?',
875 $dbh->selectall_arrayref( $sth, { Slice => {} }, $search_isbn );
876 if ( @{$tuple_arr} ) {
877 return $tuple_arr->[0];
879 elsif ( length($isbn) == 13 && $isbn !~ /^97[89]/ ) {
880 my $tarr = $dbh->selectall_arrayref(
881 'select biblionumber, biblioitemnumber from biblioitems where ean = ?',
892 if ( $isbn =~ m/(\d{13})/xms ) {
893 my $b_isbn = Business::ISBN->new($1);
894 if ( $b_isbn && $b_isbn->is_valid ) {
895 $search_isbn = $b_isbn->as_isbn10->as_string( [] );
899 elsif ( $isbn =~ m/(\d{9}[xX]|\d{10})/xms ) {
900 my $b_isbn = Business::ISBN->new($1);
901 if ( $b_isbn && $b_isbn->is_valid ) {
902 $search_isbn = $b_isbn->as_isbn13->as_string( [] );
907 $search_isbn = "%$search_isbn%";
909 $dbh->selectall_arrayref( $sth, { Slice => {} }, $search_isbn );
910 if ( @{$tuple_arr} ) {
911 return $tuple_arr->[0];
918 # returns a budget obj or undef
919 # fact we need this shows what a mess Acq API is
921 my ( $schema, $budget_code ) = @_;
922 my $period_rs = $schema->resultset('Aqbudgetperiod')->search(
924 budget_period_active => 1,
928 # db does not ensure budget code is unque
929 return $schema->resultset('Aqbudget')->single(
931 budget_code => $budget_code,
933 { -in => $period_rs->get_column('budget_period_id')->as_query },
938 # try to get title level classification from incoming quote
939 sub title_level_class {
942 my $default_scheme = C4::Context->preference('DefaultClassificationSource');
943 if ( $default_scheme eq 'ddc' ) {
944 $class = $item->dewey_class();
946 elsif ( $default_scheme eq 'lcc' ) {
947 $class = $item->lc_class();
951 $item->girfield('shelfmark')
952 || $item->girfield('classification')
958 sub _create_bib_from_quote {
960 #TBD we should flag this for updating from an external source
961 #As biblio (&biblioitems) has no candidates flag in order
962 my ( $item, $quote ) = @_;
963 my $itemid = $item->item_number_id;
964 my $defalt_classification_source =
965 C4::Context->preference('DefaultClassificationSource');
967 'biblioitems.cn_source' => $defalt_classification_source,
968 'items.cn_source' => $defalt_classification_source,
969 'items.notforloan' => -1,
970 'items.cn_sort' => q{},
972 $bib_hash->{'biblio.seriestitle'} = $item->series;
974 $bib_hash->{'biblioitems.publishercode'} = $item->publisher;
975 $bib_hash->{'biblioitems.publicationyear'} =
976 $bib_hash->{'biblio.copyrightdate'} = $item->publication_date;
978 $bib_hash->{'biblio.title'} = $item->title;
979 $bib_hash->{'biblio.author'} = $item->author;
980 $bib_hash->{'biblioitems.isbn'} = $item->item_number_id;
981 $bib_hash->{'biblioitems.itemtype'} = $item->girfield('stock_category');
983 # If we have a 13 digit id we are assuming its an ean
984 # (it may also be an isbn or issn)
985 if ( $itemid =~ /^\d{13}$/ ) {
986 $bib_hash->{'biblioitems.ean'} = $itemid;
987 if ( $itemid =~ /^977/ ) {
988 $bib_hash->{'biblioitems.issn'} = $itemid;
991 for my $key ( keys %{$bib_hash} ) {
992 if ( !defined $bib_hash->{$key} ) {
993 delete $bib_hash->{$key};
996 return TransformKohaToMarc($bib_hash);
1000 sub _create_item_from_quote {
1001 my ( $item, $quote ) = @_;
1002 my $defalt_classification_source =
1003 C4::Context->preference('DefaultClassificationSource');
1005 cn_source => $defalt_classification_source,
1009 $item_hash->{booksellerid} = $quote->vendor_id;
1010 $item_hash->{price} = $item_hash->{replacementprice} = $item->price;
1011 $item_hash->{itype} = $item->girfield('stock_category');
1012 $item_hash->{location} = $item->girfield('collection_code');
1016 $item_hash->{itemcallnumber} =
1017 $item->girfield('shelfmark')
1018 || $item->girfield('classification')
1019 || title_level_class($item);
1021 my $branch = $item->girfield('branch');
1022 $item_hash->{holdingbranch} = $item_hash->{homebranch} = $branch;
1035 Module exporting subroutines used in EDI processing for Koha
1039 Subroutines called by batch processing to handle Edifact
1040 messages of various types and related utilities
1044 These routines should really be methods of some object.
1045 get_edifact_ean is a stopgap which should be replaced
1049 =head2 process_quote
1051 process_quote(quote_message);
1053 passed a message object for a quote, parses it creating an order basket
1054 and orderlines in the database
1055 updates the message's status to received in the database and adds the
1058 =head2 process_invoice
1060 process_invoice(invoice_message)
1062 passed a message object for an invoice, add the contained invoices
1063 and update the orderlines referred to in the invoice
1064 As an Edifact invoice is in effect a despatch note this receipts the
1065 appropriate quantities in the orders
1067 no meaningful return value
1069 =head2 process_ordrsp
1071 process_ordrsp(ordrsp_message)
1073 passed a message object for a supplier response, process the contents
1074 If an orderline is cancelled cancel the corresponding orderline in koha
1075 otherwise record the supplier message against it
1077 no meaningful return value
1079 =head2 create_edi_order
1081 create_edi_order( { parameter_hashref } )
1083 parameters must include basketno and ean
1085 branchcode can optionally be passed
1087 returns 1 on success undef otherwise
1089 if the parameter noingest is set the formatted order is returned
1090 and not saved in the database. This functionality is intended for debugging only
1092 =head2 receipt_items
1094 receipt_items( schema_obj, invoice_line, ordernumber)
1096 receipts the items recorded on this invoice line
1098 no meaningful return
1100 =head2 transfer_items
1102 transfer_items(schema, invoice_line, originating_order, receiving_order)
1104 Transfer the items covered by this invoice line from their original
1105 order to another order recording the partial fulfillment of the original
1108 no meaningful return
1110 =head2 get_edifact_ean
1112 $ean = get_edifact_ean();
1114 routine to return the ean.
1118 quote_item(lineitem, quote_message);
1120 Called by process_quote to handle an individual lineitem
1121 Generate the biblios and items if required and orderline linking to them
1123 Returns 1 on success undef on error
1125 Most usual cause of error is a line with no or incorrect budget codes
1126 which woild cause order creation to abort
1127 If other correct lines exist these are processed and the erroneous line os logged
1129 =head2 title_level_class
1131 classmark = title_level_class(edi_item)
1133 Trys to return a title level classmark from a quote message line
1134 Will return a dewey or lcc classmark if one exists according to the
1135 value in DefaultClassificationSource syspref
1137 If unable to returns the shelfmark or classification from the GIR segment
1139 If all else fails returns empty string
1141 =head2 _create_bib_from_quote
1143 marc_record_obj = _create_bib_from_quote(lineitem, quote)
1145 Returns a MARC::Record object based on the info in the quote's lineitem
1147 =head2 _create_item_from_quote
1149 item_hashref = _create_item_from_quote( lineitem, quote)
1151 returns a hashref representing the item fields specified in the quote
1153 =head2 _get_invoiced_price
1155 _get_invoiced_price(line_object)
1157 Returns the net price or an equivalent calculated from line cost / qty
1159 =head2 _discounted_price
1161 ecost = _discounted_price(discount, item_price)
1163 utility subroutine to return a price calculated from the
1164 vendors discount and quoted price
1166 =head2 _check_for_existing_bib
1168 (biblionumber, biblioitemnumber) = _check_for_existing_bib(isbn_or_ean)
1170 passed an isbn or ean attempts to locate a match bib
1171 On success returns biblionumber and biblioitemnumber
1172 On failure returns undefined/an empty list
1176 b = _get_budget(schema_obj, budget_code)
1178 Returns the Aqbudget object for the active budget given the passed budget_code
1179 or undefined if one does not exist
1183 Colin Campbell <colin.campbell@ptfs-europe.com>
1188 Copyright 2014,2015 PTFS-Europe Ltd
1189 This program is free software, You may redistribute it under
1190 under the terms of the GNU General Public License