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::Baskets;
40 use Koha::Acquisition::Booksellers;
44 qw( process_quote process_invoice process_ordrsp create_edi_order get_edifact_ean );
46 sub create_edi_order {
47 my $parameters = shift;
48 my $basketno = $parameters->{basketno};
49 my $ean = $parameters->{ean};
50 my $branchcode = $parameters->{branchcode};
51 my $noingest = $parameters->{noingest};
52 if ( !$basketno || !$ean ) {
53 carp 'create_edi_order called with no basketno or ean';
57 my $schema = Koha::Database->new()->schema();
59 my @orderlines = $schema->resultset('Aqorder')->search(
61 basketno => $basketno,
67 carp "No orderlines for basket $basketno";
71 my $vendor = $schema->resultset('VendorEdiAccount')->search(
73 vendor_id => $orderlines[0]->basketno->booksellerid->id,
77 my $ean_search_keys = { ean => $ean, };
79 $ean_search_keys->{branchcode} = $branchcode;
82 $schema->resultset('EdifactEan')->search($ean_search_keys)->single;
84 # If no branch specific each can be found, look for a default ean
86 $ean_obj = $schema->resultset('EdifactEan')->search(
94 my $dbh = C4::Context->dbh;
95 my $arr_ref = $dbh->selectcol_arrayref(
96 'select id from edifact_messages where basketno = ? and message_type = \'QUOTE\'',
99 my $response = @{$arr_ref} ? 1 : 0;
101 my $edifact_order_params = {
102 orderlines => \@orderlines,
105 is_response => $response,
109 if ( $vendor->plugin ) {
110 $edifact = Koha::Plugins::Handler->run(
112 class => $vendor->plugin,
113 method => 'edifact_order',
115 params => $edifact_order_params,
121 $edifact = Koha::Edifact::Order->new($edifact_order_params);
124 return unless $edifact;
126 my $order_file = $edifact->encode();
130 my $m = unidecode($order_file); # remove diacritics and non-latin chars
131 if ($noingest) { # allows scripts to produce test files
135 message_type => 'ORDERS',
137 vendor_id => $vendor->vendor_id,
139 basketno => $basketno,
140 filename => $edifact->filename(),
141 transfer_date => $edifact->msg_date_string(),
142 edi_acct => $vendor->id,
145 $schema->resultset('EdifactMessage')->create($order);
153 my $response_message = shift;
154 $response_message->status('processing');
155 $response_message->update;
156 my $schema = Koha::Database->new()->schema();
157 my $logger = Log::Log4perl->get_logger();
160 Koha::Edifact->new( { transmission => $response_message->raw_msg, } );
161 my $messages = $edi->message_array();
163 if ( @{$messages} ) {
164 foreach my $msg ( @{$messages} ) {
165 my $lines = $msg->lineitems();
166 foreach my $line ( @{$lines} ) {
167 my $ordernumber = $line->ordernumber();
169 # action cancelled:change_requested:no_action:accepted:not_found:recorded
170 my $action = $line->action_notification();
171 if ( $action eq 'cancelled' ) {
172 my $reason = $line->coded_orderline_text();
175 ordernumber => $ordernumber,
176 cancellationreason => $reason,
177 orderstatus => 'cancelled',
178 datecancellationprinted => DateTime->now()->ymd(),
182 else { # record order as due with possible further info
184 my $report = $line->coded_orderline_text();
185 my $date_avail = $line->availability_date();
188 $report .= " Available: $date_avail";
192 ordernumber => $ordernumber,
193 suppliers_report => $report,
201 $response_message->status('received');
202 $response_message->update;
206 sub process_invoice {
207 my $invoice_message = shift;
208 $invoice_message->status('processing');
209 $invoice_message->update;
210 my $schema = Koha::Database->new()->schema();
211 my $logger = Log::Log4perl->get_logger();
214 my $plugin = $invoice_message->edi_acct()->plugin();
217 $edi_plugin = Koha::Plugins::Handler->run(
222 invoice_message => $invoice_message,
223 transmission => $invoice_message->raw_msg,
229 my $edi = $edi_plugin ||
230 Koha::Edifact->new( { transmission => $invoice_message->raw_msg, } );
232 my $messages = $edi->message_array();
234 if ( @{$messages} ) {
236 # BGM contains an invoice number
237 foreach my $msg ( @{$messages} ) {
238 my $invoicenumber = $msg->docmsg_number();
239 my $shipmentcharge = $msg->shipment_charge();
240 my $msg_date = $msg->message_date;
241 my $tax_date = $msg->tax_point_date;
242 if ( !defined $tax_date || $tax_date !~ m/^\d{8}/xms ) {
243 $tax_date = $msg_date;
246 my $vendor_ean = $msg->supplier_ean;
247 if ( !defined $vendor_acct || $vendor_ean ne $vendor_acct->san ) {
248 $vendor_acct = $schema->resultset('VendorEdiAccount')->search(
254 if ( !$vendor_acct ) {
256 "Cannot find vendor with ean $vendor_ean for invoice $invoicenumber in $invoice_message->filename";
259 $invoice_message->edi_acct( $vendor_acct->id );
260 $logger->trace("Adding invoice:$invoicenumber");
261 my $new_invoice = $schema->resultset('Aqinvoice')->create(
263 invoicenumber => $invoicenumber,
264 booksellerid => $invoice_message->vendor_id,
265 shipmentdate => $msg_date,
266 billingdate => $tax_date,
267 shipmentcost => $shipmentcharge,
268 shipmentcost_budgetid => $vendor_acct->shipment_budget,
269 message_id => $invoice_message->id,
272 my $invoiceid = $new_invoice->invoiceid;
273 $logger->trace("Added as invoiceno :$invoiceid");
274 my $lines = $msg->lineitems();
276 foreach my $line ( @{$lines} ) {
277 my $ordernumber = $line->ordernumber;
278 $logger->trace( "Receipting order:$ordernumber Qty: ",
281 my $order = $schema->resultset('Aqorder')->find($ordernumber);
283 # ModReceiveOrder does not validate that $ordernumber exists validate here
287 my $s = $schema->resultset('Suggestion')->search(
289 biblionumber => $order->biblionumber->biblionumber,
295 suggestionid => $s->suggestionid,
296 STATUS => 'AVAILABLE',
301 my $price = _get_invoiced_price($line);
303 if ( $order->quantity > $line->quantity ) {
304 my $ordered = $order->quantity;
307 $order->orderstatus('partial');
308 $order->quantity( $ordered - $line->quantity );
310 my $received_order = $order->copy(
312 ordernumber => undef,
313 quantity => $line->quantity,
314 quantityreceived => $line->quantity,
315 orderstatus => 'complete',
317 invoiceid => $invoiceid,
318 datereceived => $msg_date,
321 transfer_items( $schema, $line, $order,
323 receipt_items( $schema, $line,
324 $received_order->ordernumber );
326 else { # simple receipt all copies on order
327 $order->quantityreceived( $line->quantity );
328 $order->datereceived($msg_date);
329 $order->invoiceid($invoiceid);
330 $order->unitprice($price);
331 $order->orderstatus('complete');
333 receipt_items( $schema, $line, $ordernumber );
338 "No order found for $ordernumber Invoice:$invoicenumber"
348 $invoice_message->status('received');
349 $invoice_message->update; # status and basketno link
353 sub _get_invoiced_price {
355 my $price = $line->price_net;
356 if ( !defined $price ) { # no net price so generate it from lineitem amount
357 $price = $line->amt_lineitem;
358 if ( $price and $line->quantity > 1 ) {
359 $price /= $line->quantity; # div line cost by qty
366 my ( $schema, $inv_line, $ordernumber ) = @_;
367 my $logger = Log::Log4perl->get_logger();
368 my $quantity = $inv_line->quantity;
370 # itemnumber is not a foreign key ??? makes this a bit cumbersome
371 my @item_links = $schema->resultset('AqordersItem')->search(
373 ordernumber => $ordernumber,
377 foreach my $ilink (@item_links) {
378 my $item = $schema->resultset('Item')->find( $ilink->itemnumber );
380 my $i = $ilink->itemnumber;
382 "Cannot find aqorder item for $i :Order:$ordernumber");
385 my $b = $item->homebranch->branchcode;
386 if ( !exists $branch_map{$b} ) {
387 $branch_map{$b} = [];
389 push @{ $branch_map{$b} }, $item;
391 my $gir_occurrence = 0;
392 while ( $gir_occurrence < $quantity ) {
393 my $branch = $inv_line->girfield( 'branch', $gir_occurrence );
394 my $item = shift @{ $branch_map{$branch} };
396 my $barcode = $inv_line->girfield( 'barcode', $gir_occurrence );
397 if ( $barcode && !$item->barcode ) {
398 my $rs = $schema->resultset('Item')->search(
403 if ( $rs->count > 0 ) {
404 $logger->warn("Barcode $barcode is a duplicate");
408 $logger->trace("Adding barcode $barcode");
409 $item->barcode($barcode);
416 $logger->warn("Unmatched item at branch:$branch");
425 my ( $schema, $inv_line, $order_from, $order_to ) = @_;
427 # Transfer x items from the orig order to a completed partial order
428 my $quantity = $inv_line->quantity;
430 my %mapped_by_branch;
431 while ( $gocc < $quantity ) {
432 my $branch = $inv_line->girfield( 'branch', $gocc );
433 if ( !exists $mapped_by_branch{$branch} ) {
434 $mapped_by_branch{$branch} = 1;
437 $mapped_by_branch{$branch}++;
441 my $logger = Log::Log4perl->get_logger();
442 my $o1 = $order_from->ordernumber;
443 my $o2 = $order_to->ordernumber;
444 $logger->warn("transferring $quantity copies from order $o1 to order $o2");
446 my @item_links = $schema->resultset('AqordersItem')->search(
448 ordernumber => $order_from->ordernumber,
451 foreach my $ilink (@item_links) {
452 my $ino = $ilink->itemnumber;
453 my $item = $schema->resultset('Item')->find( $ilink->itemnumber );
454 my $i_branch = $item->homebranch;
455 if ( exists $mapped_by_branch{$i_branch}
456 && $mapped_by_branch{$i_branch} > 0 )
458 $ilink->ordernumber( $order_to->ordernumber );
461 --$mapped_by_branch{$i_branch};
462 $logger->warn("Transferred item $item");
465 $logger->warn("Skipped item $item");
467 if ( $quantity < 1 ) {
478 $quote->status('processing');
481 my $edi = Koha::Edifact->new( { transmission => $quote->raw_msg, } );
483 my $messages = $edi->message_array();
484 my $process_errors = 0;
485 my $logger = Log::Log4perl->get_logger();
486 my $schema = Koha::Database->new()->schema();
487 my $message_count = 0;
488 my @added_baskets; # if auto & multiple baskets need to order all
490 if ( @{$messages} && $quote->vendor_id ) {
491 foreach my $msg ( @{$messages} ) {
494 NewBasket( $quote->vendor_id, 0, $quote->filename, q{},
496 push @added_baskets, $basketno;
497 if ( $message_count > 1 ) {
498 my $m_filename = $quote->filename;
499 $m_filename .= "_$message_count";
500 $schema->resultset('EdifactMessage')->create(
502 message_type => $quote->message_type,
503 transfer_date => $quote->transfer_date,
504 vendor_id => $quote->vendor_id,
505 edi_acct => $quote->edi_acct,
507 basketno => $basketno,
509 filename => $m_filename,
514 $quote->basketno($basketno);
516 $logger->trace("Created basket :$basketno");
517 my $items = $msg->lineitems();
518 my $refnum = $msg->message_refno;
520 for my $item ( @{$items} ) {
521 if ( !quote_item( $item, $quote, $basketno ) ) {
527 my $status = 'received';
528 if ($process_errors) {
532 $quote->status($status);
533 $quote->update; # status and basketno link
534 # Do we automatically generate orders for this vendor
535 my $v = $schema->resultset('VendorEdiAccount')->search(
537 vendor_id => $quote->vendor_id,
540 if ( $v->auto_orders ) {
541 for my $b (@added_baskets) {
556 my ( $item, $quote, $basketno ) = @_;
558 my $schema = Koha::Database->new()->schema();
559 my $logger = Log::Log4perl->get_logger();
561 my $basket = Koha::Acquisition::Baskets->find( $basketno );
563 $logger->error('Skipping order creation no valid basketno');
566 $logger->trace( 'Checking db for matches with ', $item->item_number_id() );
567 my $bib = _check_for_existing_bib( $item->item_number_id() );
568 if ( !defined $bib ) {
570 my $bib_record = _create_bib_from_quote( $item, $quote );
571 ( $bib->{biblionumber}, $bib->{biblioitemnumber} ) =
572 AddBiblio( $bib_record, q{} );
573 $logger->trace("New biblio added $bib->{biblionumber}");
576 $logger->trace("Match found: $bib->{biblionumber}");
579 # Create an orderline
580 my $order_note = $item->{orderline_free_text};
582 my $order_quantity = $item->quantity();
583 my $gir_count = $item->number_of_girs();
584 $order_quantity ||= 1; # quantity not necessarily present
585 if ( $gir_count > 1 ) {
586 if ( $gir_count != $order_quantity ) {
588 "Order for $order_quantity items, $gir_count segments present");
590 $order_quantity = 1; # attempts to create an orderline for each gir
592 my $vendor = Koha::Acquisition::Booksellers->find( $quote->vendor_id );
594 # database definitions should set some of these defaults but dont
596 biblionumber => $bib->{biblionumber},
597 entrydate => DateTime->now( time_zone => 'local' )->ymd(),
598 basketno => $basketno,
599 listprice => $item->price,
600 quantity => $order_quantity,
601 quantityreceived => 0,
602 order_vendornote => q{},
603 order_internalnote => $order_note,
605 ecost => _discounted_price( $quote->vendor->discount, $item->price ),
609 currency => $vendor->listprice(),
612 # suppliers references
613 if ( $item->reference() ) {
614 $order_hash->{suppliers_reference_number} = $item->reference;
615 $order_hash->{suppliers_reference_qualifier} = 'QLI';
617 elsif ( $item->orderline_reference_number() ) {
618 $order_hash->{suppliers_reference_number} =
619 $item->orderline_reference_number;
620 $order_hash->{suppliers_reference_qualifier} = 'SLI';
622 if ( $item->item_number_id ) { # suppliers ean
623 $order_hash->{line_item_id} = $item->item_number_id;
626 if ( $item->girfield('servicing_instruction') ) {
630 while ( $si = $item->girfield( 'servicing_instruction', $occ ) ) {
637 $order_hash->{order_vendornote} = $txt;
640 if ( $item->internal_notes() ) {
641 if ( $order_hash->{order_internalnote} ) { # more than ''
642 $order_hash->{order_internalnote} .= q{ };
644 $order_hash->{order_internalnote} .= $item->internal_notes;
647 my $budget = _get_budget( $schema, $item->girfield('fund_allocation') );
651 if ( $item->quantity > 1 ) {
652 carp 'Skipping line with no budget info';
653 $logger->trace('girfield skipped for invalid budget');
657 carp 'Skipping line with no budget info';
658 $logger->trace('orderline skipped for invalid budget');
668 $order_hash->{budget_id} = $budget->budget_id;
669 my $first_order = $schema->resultset('Aqorder')->create($order_hash);
670 my $o = $first_order->ordernumber();
671 $logger->trace("Order created :$o");
673 # should be done by database settings
674 $first_order->parent_ordernumber( $first_order->ordernumber() );
675 $first_order->update();
677 # add to $budgets to prevent duplicate orderlines
678 $budgets{ $budget->budget_id } = '1';
680 # record ordernumber against budget
681 $ordernumber{ $budget->budget_id } = $o;
683 if ( C4::Context->preference('AcqCreateItem') eq 'ordering' ) {
684 $item_hash = _create_item_from_quote( $item, $quote );
687 while ( $created < $order_quantity ) {
689 ( $bib->{biblionumber}, $bib->{biblioitemnumber}, $itemnumber )
690 = AddItem( $item_hash, $bib->{biblionumber} );
691 $logger->trace("Added item:$itemnumber");
692 $schema->resultset('AqordersItem')->create(
694 ordernumber => $first_order->ordernumber,
695 itemnumber => $itemnumber,
703 if ( $order_quantity == 1 && $item->quantity > 1 ) {
704 my $occurrence = 1; # occ zero already added
705 while ( $occurrence < $item->quantity ) {
708 $budget = _get_budget( $schema,
709 $item->girfield( 'fund_allocation', $occurrence ) );
713 $item->girfield( 'fund_allocation', $occurrence );
714 carp 'Skipping line with no budget info';
716 "girfield skipped for invalid budget:$bad_budget");
717 ++$occurrence; ## lets look at the next one not this one again
721 # add orderline for NEW budget in $budgets
722 if ( !exists $budgets{ $budget->budget_id } ) {
724 # $order_hash->{quantity} = 1; by default above
725 # we should handle both 1:1 GIR & 1:n GIR (with LQT values) here
727 $order_hash->{budget_id} = $budget->budget_id;
730 $schema->resultset('Aqorder')->create($order_hash);
731 my $o = $new_order->ordernumber();
732 $logger->trace("Order created :$o");
734 # should be done by database settings
735 $new_order->parent_ordernumber( $new_order->ordernumber() );
736 $new_order->update();
738 # add to $budgets to prevent duplicate orderlines
739 $budgets{ $budget->budget_id } = '1';
741 # record ordernumber against budget
742 $ordernumber{ $budget->budget_id } = $o;
744 if ( C4::Context->preference('AcqCreateItem') eq 'ordering' ) {
745 if ( !defined $item_hash ) {
746 $item_hash = _create_item_from_quote( $item, $quote );
750 $item->girfield( 'stock_category', $occurrence ),
752 $item->girfield( 'collection_code', $occurrence ),
754 $item->girfield( 'shelfmark', $occurrence )
755 || $item->girfield( 'classification', $occurrence )
756 || title_level_class($item),
758 $item->girfield( 'branch', $occurrence ),
759 homebranch => $item->girfield( 'branch', $occurrence ),
761 if ( $new_item->{itype} ) {
762 $item_hash->{itype} = $new_item->{itype};
764 if ( $new_item->{location} ) {
765 $item_hash->{location} = $new_item->{location};
767 if ( $new_item->{itemcallnumber} ) {
768 $item_hash->{itemcallnumber} =
769 $new_item->{itemcallnumber};
771 if ( $new_item->{holdingbranch} ) {
772 $item_hash->{holdingbranch} =
773 $new_item->{holdingbranch};
775 if ( $new_item->{homebranch} ) {
776 $item_hash->{homebranch} = $new_item->{homebranch};
780 ( undef, undef, $itemnumber ) =
781 AddItem( $item_hash, $bib->{biblionumber} );
782 $logger->trace("New item $itemnumber added");
783 $schema->resultset('AqordersItem')->create(
785 ordernumber => $new_order->ordernumber,
786 itemnumber => $itemnumber,
794 # increment quantity in orderline for EXISTING budget in $budgets
796 my $row = $schema->resultset('Aqorder')->find(
798 ordernumber => $ordernumber{ $budget->budget_id }
802 my $qty = $row->quantity;
811 if ( $basket->effective_create_item eq 'ordering' ) {
816 price => $item->price,
817 replacementprice => $item->price,
819 $item->girfield( 'stock_category', $occurrence ),
821 $item->girfield( 'collection_code', $occurrence ),
823 $item->girfield( 'shelfmark', $occurrence )
824 || $item->girfield( 'classification', $occurrence )
825 || $item_hash->{itemcallnumber},
827 $item->girfield( 'branch', $occurrence ),
828 homebranch => $item->girfield( 'branch', $occurrence ),
831 ( undef, undef, $itemnumber ) =
832 AddItem( $new_item, $bib->{biblionumber} );
833 $logger->trace("New item $itemnumber added");
834 $schema->resultset('AqordersItem')->create(
836 ordernumber => $ordernumber{ $budget->budget_id },
837 itemnumber => $itemnumber,
850 sub get_edifact_ean {
852 my $dbh = C4::Context->dbh;
854 my $eans = $dbh->selectcol_arrayref('select ean from edifact_ean');
859 # We should not need to have a routine to do this here
860 sub _discounted_price {
861 my ( $discount, $price ) = @_;
862 return $price - ( ( $discount * $price ) / 100 );
865 sub _check_for_existing_bib {
868 my $search_isbn = $isbn;
869 $search_isbn =~ s/^\s*/%/xms;
870 $search_isbn =~ s/\s*$/%/xms;
871 my $dbh = C4::Context->dbh;
872 my $sth = $dbh->prepare(
873 'select biblionumber, biblioitemnumber from biblioitems where isbn like ?',
876 $dbh->selectall_arrayref( $sth, { Slice => {} }, $search_isbn );
877 if ( @{$tuple_arr} ) {
878 return $tuple_arr->[0];
880 elsif ( length($isbn) == 13 && $isbn !~ /^97[89]/ ) {
881 my $tarr = $dbh->selectall_arrayref(
882 'select biblionumber, biblioitemnumber from biblioitems where ean = ?',
893 if ( $isbn =~ m/(\d{13})/xms ) {
894 my $b_isbn = Business::ISBN->new($1);
895 if ( $b_isbn && $b_isbn->is_valid ) {
896 $search_isbn = $b_isbn->as_isbn10->as_string( [] );
900 elsif ( $isbn =~ m/(\d{9}[xX]|\d{10})/xms ) {
901 my $b_isbn = Business::ISBN->new($1);
902 if ( $b_isbn && $b_isbn->is_valid ) {
903 $search_isbn = $b_isbn->as_isbn13->as_string( [] );
908 $search_isbn = "%$search_isbn%";
910 $dbh->selectall_arrayref( $sth, { Slice => {} }, $search_isbn );
911 if ( @{$tuple_arr} ) {
912 return $tuple_arr->[0];
919 # returns a budget obj or undef
920 # fact we need this shows what a mess Acq API is
922 my ( $schema, $budget_code ) = @_;
923 my $period_rs = $schema->resultset('Aqbudgetperiod')->search(
925 budget_period_active => 1,
929 # db does not ensure budget code is unque
930 return $schema->resultset('Aqbudget')->single(
932 budget_code => $budget_code,
934 { -in => $period_rs->get_column('budget_period_id')->as_query },
939 # try to get title level classification from incoming quote
940 sub title_level_class {
943 my $default_scheme = C4::Context->preference('DefaultClassificationSource');
944 if ( $default_scheme eq 'ddc' ) {
945 $class = $item->dewey_class();
947 elsif ( $default_scheme eq 'lcc' ) {
948 $class = $item->lc_class();
952 $item->girfield('shelfmark')
953 || $item->girfield('classification')
959 sub _create_bib_from_quote {
961 #TBD we should flag this for updating from an external source
962 #As biblio (&biblioitems) has no candidates flag in order
963 my ( $item, $quote ) = @_;
964 my $itemid = $item->item_number_id;
965 my $defalt_classification_source =
966 C4::Context->preference('DefaultClassificationSource');
968 'biblioitems.cn_source' => $defalt_classification_source,
969 'items.cn_source' => $defalt_classification_source,
970 'items.notforloan' => -1,
971 'items.cn_sort' => q{},
973 $bib_hash->{'biblio.seriestitle'} = $item->series;
975 $bib_hash->{'biblioitems.publishercode'} = $item->publisher;
976 $bib_hash->{'biblioitems.publicationyear'} =
977 $bib_hash->{'biblio.copyrightdate'} = $item->publication_date;
979 $bib_hash->{'biblio.title'} = $item->title;
980 $bib_hash->{'biblio.author'} = $item->author;
981 $bib_hash->{'biblioitems.isbn'} = $item->item_number_id;
982 $bib_hash->{'biblioitems.itemtype'} = $item->girfield('stock_category');
984 # If we have a 13 digit id we are assuming its an ean
985 # (it may also be an isbn or issn)
986 if ( $itemid =~ /^\d{13}$/ ) {
987 $bib_hash->{'biblioitems.ean'} = $itemid;
988 if ( $itemid =~ /^977/ ) {
989 $bib_hash->{'biblioitems.issn'} = $itemid;
992 for my $key ( keys %{$bib_hash} ) {
993 if ( !defined $bib_hash->{$key} ) {
994 delete $bib_hash->{$key};
997 return TransformKohaToMarc($bib_hash);
1001 sub _create_item_from_quote {
1002 my ( $item, $quote ) = @_;
1003 my $defalt_classification_source =
1004 C4::Context->preference('DefaultClassificationSource');
1006 cn_source => $defalt_classification_source,
1010 $item_hash->{booksellerid} = $quote->vendor_id;
1011 $item_hash->{price} = $item_hash->{replacementprice} = $item->price;
1012 $item_hash->{itype} = $item->girfield('stock_category');
1013 $item_hash->{location} = $item->girfield('collection_code');
1017 $item_hash->{itemcallnumber} =
1018 $item->girfield('shelfmark')
1019 || $item->girfield('classification')
1020 || title_level_class($item);
1022 my $branch = $item->girfield('branch');
1023 $item_hash->{holdingbranch} = $item_hash->{homebranch} = $branch;
1036 Module exporting subroutines used in EDI processing for Koha
1040 Subroutines called by batch processing to handle Edifact
1041 messages of various types and related utilities
1045 These routines should really be methods of some object.
1046 get_edifact_ean is a stopgap which should be replaced
1050 =head2 process_quote
1052 process_quote(quote_message);
1054 passed a message object for a quote, parses it creating an order basket
1055 and orderlines in the database
1056 updates the message's status to received in the database and adds the
1059 =head2 process_invoice
1061 process_invoice(invoice_message)
1063 passed a message object for an invoice, add the contained invoices
1064 and update the orderlines referred to in the invoice
1065 As an Edifact invoice is in effect a despatch note this receipts the
1066 appropriate quantities in the orders
1068 no meaningful return value
1070 =head2 process_ordrsp
1072 process_ordrsp(ordrsp_message)
1074 passed a message object for a supplier response, process the contents
1075 If an orderline is cancelled cancel the corresponding orderline in koha
1076 otherwise record the supplier message against it
1078 no meaningful return value
1080 =head2 create_edi_order
1082 create_edi_order( { parameter_hashref } )
1084 parameters must include basketno and ean
1086 branchcode can optionally be passed
1088 returns 1 on success undef otherwise
1090 if the parameter noingest is set the formatted order is returned
1091 and not saved in the database. This functionality is intended for debugging only
1093 =head2 receipt_items
1095 receipt_items( schema_obj, invoice_line, ordernumber)
1097 receipts the items recorded on this invoice line
1099 no meaningful return
1101 =head2 transfer_items
1103 transfer_items(schema, invoice_line, originating_order, receiving_order)
1105 Transfer the items covered by this invoice line from their original
1106 order to another order recording the partial fulfillment of the original
1109 no meaningful return
1111 =head2 get_edifact_ean
1113 $ean = get_edifact_ean();
1115 routine to return the ean.
1119 quote_item(lineitem, quote_message);
1121 Called by process_quote to handle an individual lineitem
1122 Generate the biblios and items if required and orderline linking to them
1124 Returns 1 on success undef on error
1126 Most usual cause of error is a line with no or incorrect budget codes
1127 which woild cause order creation to abort
1128 If other correct lines exist these are processed and the erroneous line os logged
1130 =head2 title_level_class
1132 classmark = title_level_class(edi_item)
1134 Trys to return a title level classmark from a quote message line
1135 Will return a dewey or lcc classmark if one exists according to the
1136 value in DefaultClassificationSource syspref
1138 If unable to returns the shelfmark or classification from the GIR segment
1140 If all else fails returns empty string
1142 =head2 _create_bib_from_quote
1144 marc_record_obj = _create_bib_from_quote(lineitem, quote)
1146 Returns a MARC::Record object based on the info in the quote's lineitem
1148 =head2 _create_item_from_quote
1150 item_hashref = _create_item_from_quote( lineitem, quote)
1152 returns a hashref representing the item fields specified in the quote
1154 =head2 _get_invoiced_price
1156 _get_invoiced_price(line_object)
1158 Returns the net price or an equivalent calculated from line cost / qty
1160 =head2 _discounted_price
1162 ecost = _discounted_price(discount, item_price)
1164 utility subroutine to return a price calculated from the
1165 vendors discount and quoted price
1167 =head2 _check_for_existing_bib
1169 (biblionumber, biblioitemnumber) = _check_for_existing_bib(isbn_or_ean)
1171 passed an isbn or ean attempts to locate a match bib
1172 On success returns biblionumber and biblioitemnumber
1173 On failure returns undefined/an empty list
1177 b = _get_budget(schema_obj, budget_code)
1179 Returns the Aqbudget object for the active budget given the passed budget_code
1180 or undefined if one does not exist
1184 Colin Campbell <colin.campbell@ptfs-europe.com>
1189 Copyright 2014,2015 PTFS-Europe Ltd
1190 This program is free software, You may redistribute it under
1191 under the terms of the GNU General Public License