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
;
41 qw( process_quote process_invoice process_ordrsp create_edi_order get_edifact_ean );
43 sub create_edi_order
{
44 my $parameters = shift;
45 my $basketno = $parameters->{basketno
};
46 my $ean = $parameters->{ean
};
47 my $branchcode = $parameters->{branchcode
};
48 my $noingest = $parameters->{noingest
};
49 $ean ||= C4
::Context
->preference('EDIfactEAN');
50 if ( !$basketno || !$ean ) {
51 carp
'create_edi_order called with no basketno or ean';
55 my $schema = Koha
::Database
->new()->schema();
57 my @orderlines = $schema->resultset('Aqorder')->search(
59 basketno
=> $basketno,
65 carp
"No orderlines for basket $basketno";
69 my $vendor = $schema->resultset('VendorEdiAccount')->search(
71 vendor_id
=> $orderlines[0]->basketno->booksellerid->id,
75 my $ean_search_keys = { ean
=> $ean, };
77 $ean_search_keys->{branchcode
} = $branchcode;
80 $schema->resultset('EdifactEan')->search($ean_search_keys)->single;
82 my $dbh = C4
::Context
->dbh;
83 my $arr_ref = $dbh->selectcol_arrayref(
84 'select id from edifact_messages where basketno = ? and message_type = \'QUOTE\'',
87 my $response = @
{$arr_ref} ?
1 : 0;
89 my $edifact = Koha
::Edifact
::Order
->new(
91 orderlines
=> \
@orderlines,
94 is_response
=> $response,
101 my $order_file = $edifact->encode();
105 my $m = unidecode
($order_file); # remove diacritics and non-latin chars
106 if ($noingest) { # allows scripts to produce test files
110 message_type
=> 'ORDERS',
112 vendor_id
=> $vendor->vendor_id,
114 basketno
=> $basketno,
115 filename
=> $edifact->filename(),
116 transfer_date
=> $edifact->msg_date_string(),
117 edi_acct
=> $vendor->id,
120 $schema->resultset('EdifactMessage')->create($order);
128 my $response_message = shift;
129 $response_message->status('processing');
130 $response_message->update;
131 my $schema = Koha
::Database
->new()->schema();
132 my $logger = Log
::Log4perl
->get_logger();
135 Koha
::Edifact
->new( { transmission
=> $response_message->raw_msg, } );
136 my $messages = $edi->message_array();
138 if ( @
{$messages} ) {
139 foreach my $msg ( @
{$messages} ) {
140 my $lines = $msg->lineitems();
141 foreach my $line ( @
{$lines} ) {
142 my $ordernumber = $line->ordernumber();
144 # action cancelled:change_requested:no_action:accepted:not_found:recorded
145 my $action = $line->action_notification();
146 if ( $action eq 'cancelled' ) {
147 my $reason = $line->coded_orderline_text();
150 ordernumber
=> $ordernumber,
151 cancellationreason
=> $reason,
152 orderstatus
=> 'cancelled',
153 datecancellationprinted
=> DateTime
->now()->ymd(),
157 else { # record order as due with possible further info
159 my $report = $line->coded_orderline_text();
160 my $date_avail = $line->availability_date();
163 $report .= " Available: $date_avail";
167 ordernumber
=> $ordernumber,
168 suppliers_report
=> $report,
176 $response_message->status('received');
177 $response_message->update;
181 sub process_invoice
{
182 my $invoice_message = shift;
183 $invoice_message->status('processing');
184 $invoice_message->update;
185 my $schema = Koha
::Database
->new()->schema();
186 my $logger = Log
::Log4perl
->get_logger();
189 Koha
::Edifact
->new( { transmission
=> $invoice_message->raw_msg, } );
190 my $messages = $edi->message_array();
192 if ( @
{$messages} ) {
194 # BGM contains an invoice number
195 foreach my $msg ( @
{$messages} ) {
196 my $invoicenumber = $msg->docmsg_number();
197 my $shipmentcharge = $msg->shipment_charge();
198 my $msg_date = $msg->message_date;
199 my $tax_date = $msg->tax_point_date;
200 if ( !defined $tax_date || $tax_date !~ m/^\d{8}/xms ) {
201 $tax_date = $msg_date;
204 my $vendor_ean = $msg->supplier_ean;
205 if ( !defined $vendor_acct || $vendor_ean ne $vendor_acct->san ) {
206 $vendor_acct = $schema->resultset('VendorEdiAccount')->search(
212 if ( !$vendor_acct ) {
214 "Cannot find vendor with ean $vendor_ean for invoice $invoicenumber in $invoice_message->filename";
217 $invoice_message->edi_acct( $vendor_acct->id );
218 $logger->trace("Adding invoice:$invoicenumber");
219 my $new_invoice = $schema->resultset('Aqinvoice')->create(
221 invoicenumber
=> $invoicenumber,
222 booksellerid
=> $invoice_message->vendor_id,
223 shipmentdate
=> $msg_date,
224 billingdate
=> $tax_date,
225 shipmentcost
=> $shipmentcharge,
226 shipmentcost_budgetid
=> $vendor_acct->shipment_budget,
227 message_id
=> $invoice_message->id,
230 my $invoiceid = $new_invoice->invoiceid;
231 $logger->trace("Added as invoiceno :$invoiceid");
232 my $lines = $msg->lineitems();
234 foreach my $line ( @
{$lines} ) {
235 my $ordernumber = $line->ordernumber;
236 $logger->trace( "Receipting order:$ordernumber Qty: ",
239 my $order = $schema->resultset('Aqorder')->find($ordernumber);
241 # ModReceiveOrder does not validate that $ordernumber exists validate here
245 my $s = $schema->resultset('Suggestion')->search(
247 biblionumber
=> $order->biblionumber->biblionumber,
253 suggestionid
=> $s->suggestionid,
254 STATUS
=> 'AVAILABLE',
259 my $price = _get_invoiced_price
($line);
261 if ( $order->quantity > $line->quantity ) {
262 my $ordered = $order->quantity;
265 $order->orderstatus('partial');
266 $order->quantity( $ordered - $line->quantity );
268 my $received_order = $order->copy(
270 ordernumber
=> undef,
271 quantity
=> $line->quantity,
272 quantityreceived
=> $line->quantity,
273 orderstatus
=> 'complete',
275 invoiceid
=> $invoiceid,
276 datereceived
=> $msg_date,
279 transfer_items
( $schema, $line, $order,
281 receipt_items
( $schema, $line,
282 $received_order->ordernumber );
284 else { # simple receipt all copies on order
285 $order->quantityreceived( $line->quantity );
286 $order->datereceived($msg_date);
287 $order->invoiceid($invoiceid);
288 $order->unitprice($price);
289 $order->orderstatus('complete');
291 receipt_items
( $schema, $line, $ordernumber );
296 "No order found for $ordernumber Invoice:$invoicenumber"
306 $invoice_message->status('received');
307 $invoice_message->update; # status and basketno link
311 sub _get_invoiced_price
{
313 my $price = $line->price_net;
314 if ( !defined $price ) { # no net price so generate it from lineitem amount
315 $price = $line->amt_lineitem;
316 if ( $price and $line->quantity > 1 ) {
317 $price /= $line->quantity; # div line cost by qty
324 my ( $schema, $inv_line, $ordernumber ) = @_;
325 my $logger = Log
::Log4perl
->get_logger();
326 my $quantity = $inv_line->quantity;
328 # itemnumber is not a foreign key ??? makes this a bit cumbersome
329 my @item_links = $schema->resultset('AqordersItem')->search(
331 ordernumber
=> $ordernumber,
335 foreach my $ilink (@item_links) {
336 my $item = $schema->resultset('Item')->find( $ilink->itemnumber );
338 my $i = $ilink->itemnumber;
340 "Cannot find aqorder item for $i :Order:$ordernumber");
343 my $b = $item->homebranch->branchcode;
344 if ( !exists $branch_map{$b} ) {
345 $branch_map{$b} = [];
347 push @
{ $branch_map{$b} }, $item;
349 my $gir_occurrence = 0;
350 while ( $gir_occurrence < $quantity ) {
351 my $branch = $inv_line->girfield( 'branch', $gir_occurrence );
352 my $item = shift @
{ $branch_map{$branch} };
354 my $barcode = $inv_line->girfield( 'barcode', $gir_occurrence );
355 if ( $barcode && !$item->barcode ) {
356 my $rs = $schema->resultset('Item')->search(
361 if ( $rs->count > 0 ) {
362 $logger->warn("Barcode $barcode is a duplicate");
366 $logger->trace("Adding barcode $barcode");
367 $item->barcode($barcode);
374 $logger->warn("Unmatched item at branch:$branch");
383 my ( $schema, $inv_line, $order_from, $order_to ) = @_;
385 # Transfer x items from the orig order to a completed partial order
386 my $quantity = $inv_line->quantity;
388 my %mapped_by_branch;
389 while ( $gocc < $quantity ) {
390 my $branch = $inv_line->girfield( 'branch', $gocc );
391 if ( !exists $mapped_by_branch{$branch} ) {
392 $mapped_by_branch{$branch} = 1;
395 $mapped_by_branch{$branch}++;
399 my $logger = Log
::Log4perl
->get_logger();
400 my $o1 = $order_from->ordernumber;
401 my $o2 = $order_to->ordernumber;
402 $logger->warn("transferring $quantity copies from order $o1 to order $o2");
404 my @item_links = $schema->resultset('AqordersItem')->search(
406 ordernumber
=> $order_from->ordernumber,
409 foreach my $ilink (@item_links) {
410 my $ino = $ilink->itemnumber;
411 my $item = $schema->resultset('Item')->find( $ilink->itemnumber );
412 my $i_branch = $item->homebranch;
413 if ( exists $mapped_by_branch{$i_branch}
414 && $mapped_by_branch{$i_branch} > 0 )
416 $ilink->ordernumber( $order_to->ordernumber );
419 --$mapped_by_branch{$i_branch};
420 $logger->warn("Transferred item $item");
423 $logger->warn("Skipped item $item");
425 if ( $quantity < 1 ) {
436 $quote->status('processing');
439 my $edi = Koha
::Edifact
->new( { transmission
=> $quote->raw_msg, } );
441 my $messages = $edi->message_array();
442 my $process_errors = 0;
443 my $logger = Log
::Log4perl
->get_logger();
444 my $schema = Koha
::Database
->new()->schema();
445 my $message_count = 0;
446 my @added_baskets; # if auto & multiple baskets need to order all
448 if ( @
{$messages} && $quote->vendor_id ) {
449 foreach my $msg ( @
{$messages} ) {
452 NewBasket
( $quote->vendor_id, 0, $quote->filename, q{},
454 push @added_baskets, $basketno;
455 if ( $message_count > 1 ) {
456 my $m_filename = $quote->filename;
457 $m_filename .= "_$message_count";
458 $schema->resultset('EdifactMessage')->create(
460 message_type
=> $quote->message_type,
461 transfer_date
=> $quote->transfer_date,
462 vendor_id
=> $quote->vendor_id,
463 edi_acct
=> $quote->edi_acct,
465 basketno
=> $basketno,
467 filename
=> $m_filename,
472 $quote->basketno($basketno);
474 $logger->trace("Created basket :$basketno");
475 my $items = $msg->lineitems();
476 my $refnum = $msg->message_refno;
478 for my $item ( @
{$items} ) {
479 if ( !quote_item
( $item, $quote, $basketno ) ) {
485 my $status = 'received';
486 if ($process_errors) {
490 $quote->status($status);
491 $quote->update; # status and basketno link
492 # Do we automatically generate orders for this vendor
493 my $v = $schema->resultset('VendorEdiAccount')->search(
495 vendor_id
=> $quote->vendor_id,
498 if ( $v->auto_orders ) {
499 for my $b (@added_baskets) {
514 my ( $item, $quote, $basketno ) = @_;
516 my $schema = Koha
::Database
->new()->schema();
518 # create biblio record
519 my $logger = Log
::Log4perl
->get_logger();
521 $logger->error('Skipping order creation no basketno');
524 $logger->trace( 'Checking db for matches with ', $item->item_number_id() );
525 my $bib = _check_for_existing_bib
( $item->item_number_id() );
526 if ( !defined $bib ) {
528 my $bib_record = _create_bib_from_quote
( $item, $quote );
529 ( $bib->{biblionumber
}, $bib->{biblioitemnumber
} ) =
530 AddBiblio
( $bib_record, q{} );
531 $logger->trace("New biblio added $bib->{biblionumber}");
534 $logger->trace("Match found: $bib->{biblionumber}");
537 # Create an orderline
538 my $order_note = $item->{orderline_free_text
};
540 my $order_quantity = $item->quantity();
541 my $gir_count = $item->number_of_girs();
542 $order_quantity ||= 1; # quantity not necessarily present
543 if ( $gir_count > 1 ) {
544 if ( $gir_count != $order_quantity ) {
546 "Order for $order_quantity items, $gir_count segments present");
548 $order_quantity = 1; # attempts to create an orderline for each gir
551 # database definitions should set some of these defaults but dont
553 biblionumber
=> $bib->{biblionumber
},
554 entrydate
=> DateTime
->now( time_zone
=> 'local' )->ymd(),
555 basketno
=> $basketno,
556 listprice
=> $item->price,
557 quantity
=> $order_quantity,
558 quantityreceived
=> 0,
559 order_vendornote
=> q{},
560 order_internalnote
=> $order_note,
562 ecost
=> _discounted_price
( $quote->vendor->discount, $item->price ),
568 # suppliers references
569 if ( $item->reference() ) {
570 $order_hash->{suppliers_reference_number
} = $item->reference;
571 $order_hash->{suppliers_reference_qualifier
} = 'QLI';
573 elsif ( $item->orderline_reference_number() ) {
574 $order_hash->{suppliers_reference_number
} =
575 $item->orderline_reference_number;
576 $order_hash->{suppliers_reference_qualifier
} = 'SLI';
578 if ( $item->item_number_id ) { # suppliers ean
579 $order_hash->{line_item_id
} = $item->item_number_id;
582 if ( $item->girfield('servicing_instruction') ) {
586 while ( $si = $item->girfield( 'servicing_instruction', $occ ) ) {
593 $order_hash->{order_vendornote
} = $txt;
596 if ( $item->internal_notes() ) {
597 if ( $order_hash->{order_internalnote
} ) { # more than ''
598 $order_hash->{order_internalnote
} .= q{ };
600 $order_hash->{order_internalnote
} .= $item->internal_notes;
603 my $budget = _get_budget
( $schema, $item->girfield('fund_allocation') );
607 if ( $item->quantity > 1 ) {
608 carp
'Skipping line with no budget info';
609 $logger->trace('girfield skipped for invalid budget');
613 carp
'Skipping line with no budget info';
614 $logger->trace('orderline skipped for invalid budget');
624 $order_hash->{budget_id
} = $budget->budget_id;
625 my $first_order = $schema->resultset('Aqorder')->create($order_hash);
626 my $o = $first_order->ordernumber();
627 $logger->trace("Order created :$o");
629 # should be done by database settings
630 $first_order->parent_ordernumber( $first_order->ordernumber() );
631 $first_order->update();
633 # add to $budgets to prevent duplicate orderlines
634 $budgets{ $budget->budget_id } = '1';
636 # record ordernumber against budget
637 $ordernumber{ $budget->budget_id } = $o;
639 if ( C4
::Context
->preference('AcqCreateItem') eq 'ordering' ) {
640 $item_hash = _create_item_from_quote
( $item, $quote );
643 while ( $created < $order_quantity ) {
645 ( $bib->{biblionumber
}, $bib->{biblioitemnumber
}, $itemnumber )
646 = AddItem
( $item_hash, $bib->{biblionumber
} );
647 $logger->trace("Added item:$itemnumber");
648 $schema->resultset('AqordersItem')->create(
650 ordernumber
=> $first_order->ordernumber,
651 itemnumber
=> $itemnumber,
659 if ( $order_quantity == 1 && $item->quantity > 1 ) {
660 my $occurrence = 1; # occ zero already added
661 while ( $occurrence < $item->quantity ) {
664 $budget = _get_budget
( $schema,
665 $item->girfield( 'fund_allocation', $occurrence ) );
669 $item->girfield( 'fund_allocation', $occurrence );
670 carp
'Skipping line with no budget info';
672 "girfield skipped for invalid budget:$bad_budget");
673 ++$occurrence; ## lets look at the next one not this one again
677 # add orderline for NEW budget in $budgets
678 if ( !exists $budgets{ $budget->budget_id } ) {
680 # $order_hash->{quantity} = 1; by default above
681 # we should handle both 1:1 GIR & 1:n GIR (with LQT values) here
683 $order_hash->{budget_id
} = $budget->budget_id;
686 $schema->resultset('Aqorder')->create($order_hash);
687 my $o = $new_order->ordernumber();
688 $logger->trace("Order created :$o");
690 # should be done by database settings
691 $new_order->parent_ordernumber( $new_order->ordernumber() );
692 $new_order->update();
694 # add to $budgets to prevent duplicate orderlines
695 $budgets{ $budget->budget_id } = '1';
697 # record ordernumber against budget
698 $ordernumber{ $budget->budget_id } = $o;
700 if ( C4
::Context
->preference('AcqCreateItem') eq 'ordering' ) {
701 if ( !defined $item_hash ) {
702 $item_hash = _create_item_from_quote
( $item, $quote );
706 $item->girfield( 'stock_category', $occurrence ),
708 $item->girfield( 'collection_code', $occurrence ),
710 $item->girfield( 'shelfmark', $occurrence )
711 || $item->girfield( 'classification', $occurrence )
712 || title_level_class
($item),
714 $item->girfield( 'branch', $occurrence ),
715 homebranch
=> $item->girfield( 'branch', $occurrence ),
717 if ( $new_item->{itype
} ) {
718 $item_hash->{itype
} = $new_item->{itype
};
720 if ( $new_item->{location
} ) {
721 $item_hash->{location
} = $new_item->{location
};
723 if ( $new_item->{itemcallnumber
} ) {
724 $item_hash->{itemcallnumber
} =
725 $new_item->{itemcallnumber
};
727 if ( $new_item->{holdingbranch
} ) {
728 $item_hash->{holdingbranch
} =
729 $new_item->{holdingbranch
};
731 if ( $new_item->{homebranch
} ) {
732 $item_hash->{homebranch
} = $new_item->{homebranch
};
736 ( undef, undef, $itemnumber ) =
737 AddItem
( $item_hash, $bib->{biblionumber
} );
738 $logger->trace("New item $itemnumber added");
739 $schema->resultset('AqordersItem')->create(
741 ordernumber
=> $new_order->ordernumber,
742 itemnumber
=> $itemnumber,
750 # increment quantity in orderline for EXISTING budget in $budgets
752 my $row = $schema->resultset('Aqorder')->find(
754 ordernumber
=> $ordernumber{ $budget->budget_id }
758 my $qty = $row->quantity;
767 if ( C4
::Context
->preference('AcqCreateItem') eq 'ordering' ) {
772 price
=> $item->price,
773 replacementprice
=> $item->price,
775 $item->girfield( 'stock_category', $occurrence ),
777 $item->girfield( 'collection_code', $occurrence ),
779 $item->girfield( 'shelfmark', $occurrence )
780 || $item->girfield( 'classification', $occurrence )
781 || $item_hash->{itemcallnumber
},
783 $item->girfield( 'branch', $occurrence ),
784 homebranch
=> $item->girfield( 'branch', $occurrence ),
787 ( undef, undef, $itemnumber ) =
788 AddItem
( $new_item, $bib->{biblionumber
} );
789 $logger->trace("New item $itemnumber added");
790 $schema->resultset('AqordersItem')->create(
792 ordernumber
=> $ordernumber{ $budget->budget_id },
793 itemnumber
=> $itemnumber,
806 sub get_edifact_ean
{
808 my $dbh = C4
::Context
->dbh;
810 my $eans = $dbh->selectcol_arrayref('select ean from edifact_ean');
815 # We should not need to have a routine to do this here
816 sub _discounted_price
{
817 my ( $discount, $price ) = @_;
818 return $price - ( ( $discount * $price ) / 100 );
821 sub _check_for_existing_bib
{
824 my $search_isbn = $isbn;
825 $search_isbn =~ s/^\s*/%/xms;
826 $search_isbn =~ s/\s*$/%/xms;
827 my $dbh = C4
::Context
->dbh;
828 my $sth = $dbh->prepare(
829 'select biblionumber, biblioitemnumber from biblioitems where isbn like ?',
832 $dbh->selectall_arrayref( $sth, { Slice
=> {} }, $search_isbn );
833 if ( @
{$tuple_arr} ) {
834 return $tuple_arr->[0];
836 elsif ( length($isbn) == 13 && $isbn !~ /^97[89]/ ) {
837 my $tarr = $dbh->selectall_arrayref(
838 'select biblionumber, biblioitemnumber from biblioitems where ean = ?',
849 if ( $isbn =~ m/(\d{13})/xms ) {
850 my $b_isbn = Business
::ISBN
->new($1);
851 if ( $b_isbn && $b_isbn->is_valid ) {
852 $search_isbn = $b_isbn->as_isbn10->as_string( [] );
856 elsif ( $isbn =~ m/(\d{9}[xX]|\d{10})/xms ) {
857 my $b_isbn = Business
::ISBN
->new($1);
858 if ( $b_isbn && $b_isbn->is_valid ) {
859 $search_isbn = $b_isbn->as_isbn13->as_string( [] );
864 $search_isbn = "%$search_isbn%";
866 $dbh->selectall_arrayref( $sth, { Slice
=> {} }, $search_isbn );
867 if ( @
{$tuple_arr} ) {
868 return $tuple_arr->[0];
875 # returns a budget obj or undef
876 # fact we need this shows what a mess Acq API is
878 my ( $schema, $budget_code ) = @_;
879 my $period_rs = $schema->resultset('Aqbudgetperiod')->search(
881 budget_period_active
=> 1,
885 # db does not ensure budget code is unque
886 return $schema->resultset('Aqbudget')->single(
888 budget_code
=> $budget_code,
890 { -in => $period_rs->get_column('budget_period_id')->as_query },
895 # try to get title level classification from incoming quote
896 sub title_level_class
{
899 my $default_scheme = C4
::Context
->preference('DefaultClassificationSource');
900 if ( $default_scheme eq 'ddc' ) {
901 $class = $item->dewey_class();
903 elsif ( $default_scheme eq 'lcc' ) {
904 $class = $item->lc_class();
908 $item->girfield('shelfmark')
909 || $item->girfield('classification')
915 sub _create_bib_from_quote
{
917 #TBD we should flag this for updating from an external source
918 #As biblio (&biblioitems) has no candidates flag in order
919 my ( $item, $quote ) = @_;
920 my $itemid = $item->item_number_id;
921 my $defalt_classification_source =
922 C4
::Context
->preference('DefaultClassificationSource');
924 'biblioitems.cn_source' => $defalt_classification_source,
925 'items.cn_source' => $defalt_classification_source,
926 'items.notforloan' => -1,
927 'items.cn_sort' => q{},
929 $bib_hash->{'biblio.seriestitle'} = $item->series;
931 $bib_hash->{'biblioitems.publishercode'} = $item->publisher;
932 $bib_hash->{'biblioitems.publicationyear'} =
933 $bib_hash->{'biblio.copyrightdate'} = $item->publication_date;
935 $bib_hash->{'biblio.title'} = $item->title;
936 $bib_hash->{'biblio.author'} = $item->author;
937 $bib_hash->{'biblioitems.isbn'} = $item->item_number_id;
938 $bib_hash->{'biblioitems.itemtype'} = $item->girfield('stock_category');
940 # If we have a 13 digit id we are assuming its an ean
941 # (it may also be an isbn or issn)
942 if ( $itemid =~ /^\d{13}$/ ) {
943 $bib_hash->{'biblioitems.ean'} = $itemid;
944 if ( $itemid =~ /^977/ ) {
945 $bib_hash->{'biblioitems.issn'} = $itemid;
948 for my $key ( keys %{$bib_hash} ) {
949 if ( !defined $bib_hash->{$key} ) {
950 delete $bib_hash->{$key};
953 return TransformKohaToMarc
($bib_hash);
957 sub _create_item_from_quote
{
958 my ( $item, $quote ) = @_;
959 my $defalt_classification_source =
960 C4
::Context
->preference('DefaultClassificationSource');
962 cn_source
=> $defalt_classification_source,
966 $item_hash->{booksellerid
} = $quote->vendor_id;
967 $item_hash->{price
} = $item_hash->{replacementprice
} = $item->price;
968 $item_hash->{itype
} = $item->girfield('stock_category');
969 $item_hash->{location
} = $item->girfield('collection_code');
973 $item_hash->{itemcallnumber
} =
974 $item->girfield('shelfmark')
975 || $item->girfield('classification')
976 || title_level_class
($item);
978 my $branch = $item->girfield('branch');
979 $item_hash->{holdingbranch
} = $item_hash->{homebranch
} = $branch;
992 Module exporting subroutines used in EDI processing for Koha
996 Subroutines called by batch processing to handle Edifact
997 messages of various types and related utilities
1001 These routines should really be methods of some object.
1002 get_edifact_ean is a stopgap which should be replaced
1006 =head2 process_quote
1008 process_quote(quote_message);
1010 passed a message object for a quote, parses it creating an order basket
1011 and orderlines in the database
1012 updates the message's status to received in the database and adds the
1015 =head2 process_invoice
1017 process_invoice(invoice_message)
1019 passed a message object for an invoice, add the contained invoices
1020 and update the orderlines referred to in the invoice
1021 As an Edifact invoice is in effect a despatch note this receipts the
1022 appropriate quantities in the orders
1024 no meaningful return value
1026 =head2 process_ordrsp
1028 process_ordrsp(ordrsp_message)
1030 passed a message object for a supplier response, process the contents
1031 If an orderline is cancelled cancel the corresponding orderline in koha
1032 otherwise record the supplier message against it
1034 no meaningful return value
1036 =head2 create_edi_order
1038 create_edi_order( { parameter_hashref } )
1040 parameters must include basketno and ean
1042 branchcode can optionally be passed
1044 returns 1 on success undef otherwise
1046 if the parameter noingest is set the formatted order is returned
1047 and not saved in the database. This functionality is intended for debugging only
1049 =head2 receipt_items
1051 receipt_items( schema_obj, invoice_line, ordernumber)
1053 receipts the items recorded on this invoice line
1055 no meaningful return
1057 =head2 transfer_items
1059 transfer_items(schema, invoice_line, originating_order, receiving_order)
1061 Transfer the items covered by this invoice line from their original
1062 order to another order recording the partial fulfillment of the original
1065 no meaningful return
1067 =head2 get_edifact_ean
1069 $ean = get_edifact_ean();
1071 routine to return the ean.
1075 quote_item(lineitem, quote_message);
1077 Called by process_quote to handle an individual lineitem
1078 Generate the biblios and items if required and orderline linking to them
1080 Returns 1 on success undef on error
1082 Most usual cause of error is a line with no or incorrect budget codes
1083 which woild cause order creation to abort
1084 If other correct lines exist these are processed and the erroneous line os logged
1086 =head2 title_level_class
1088 classmark = title_level_class(edi_item)
1090 Trys to return a title level classmark from a quote message line
1091 Will return a dewey or lcc classmark if one exists according to the
1092 value in DefaultClassificationSource syspref
1094 If unable to returns the shelfmark or classification from the GIR segment
1096 If all else fails returns empty string
1098 =head2 _create_bib_from_quote
1100 marc_record_obj = _create_bib_from_quote(lineitem, quote)
1102 Returns a MARC::Record object based on the info in the quote's lineitem
1104 =head2 _create_item_from_quote
1106 item_hashref = _create_item_from_quote( lineitem, quote)
1108 returns a hashref representing the item fields specified in the quote
1110 =head2 _get_invoiced_price
1112 _get_invoiced_price(line_object)
1114 Returns the net price or an equivalent calculated from line cost / qty
1116 =head2 _discounted_price
1118 ecost = _discounted_price(discount, item_price)
1120 utility subroutine to return a price calculated from the
1121 vendors discount and quoted price
1123 =head2 _check_for_existing_bib
1125 (biblionumber, biblioitemnumber) = _check_for_existing_bib(isbn_or_ean)
1127 passed an isbn or ean attempts to locate a match bib
1128 On success returns biblionumber and biblioitemnumber
1129 On failure returns undefined/an empty list
1133 b = _get_budget(schema_obj, budget_code)
1135 Returns the Aqbudget object for the active budget given the passed budget_code
1136 or undefined if one does not exist
1140 Colin Campbell <colin.campbell@ptfs-europe.com>
1145 Copyright 2014,2015 PTFS-Europe Ltd
1146 This program is free software, You may redistribute it under
1147 under the terms of the GNU General Public License