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 CloseBasket ModOrder);
32 use C4
::Suggestions
qw( ModSuggestion );
33 use C4
::Biblio
qw( AddBiblio TransformKohaToMarc GetMarcBiblio GetFrameworkCode GetMarcFromKohaField );
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
=> dt_from_string
()->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;
392 # Handling for 'AcqItemSetSubfieldsWhenReceived'
396 if ( C4
::Context
->preference('AcqCreateItem') eq 'ordering' ) {
397 @affects = split q{\|},
398 C4
::Context
->preference("AcqItemSetSubfieldsWhenReceived");
400 my $order = Koha
::Acquisition
::Orders
->find($ordernumber);
401 $biblionumber = $order->biblionumber;
402 my $frameworkcode = GetFrameworkCode
($biblionumber);
403 ($itemfield) = GetMarcFromKohaField
( 'items.itemnumber',
408 my $gir_occurrence = 0;
409 while ( $gir_occurrence < $quantity ) {
410 my $branch = $inv_line->girfield( 'branch', $gir_occurrence );
411 my $item = shift @
{ $branch_map{$branch} };
413 my $barcode = $inv_line->girfield( 'barcode', $gir_occurrence );
414 if ( $barcode && !$item->barcode ) {
415 my $rs = $schema->resultset('Item')->search(
420 if ( $rs->count > 0 ) {
421 $logger->warn("Barcode $barcode is a duplicate");
425 $logger->trace("Adding barcode $barcode");
426 $item->barcode($barcode);
430 # Handling for 'AcqItemSetSubfieldsWhenReceived'
432 my $item_marc = C4
::Items
::GetMarcItem
( $biblionumber, $item->itemnumber );
433 for my $affect (@affects) {
434 my ( $sf, $v ) = split q{=}, $affect, 2;
435 foreach ( $item_marc->field($itemfield) ) {
436 $_->update( $sf => $v );
439 C4
::Items
::ModItemFromMarc
( $item_marc, $biblionumber, $item->itemnumber );
445 $logger->warn("Unmatched item at branch:$branch");
454 my ( $schema, $inv_line, $order_from, $order_to ) = @_;
456 # Transfer x items from the orig order to a completed partial order
457 my $quantity = $inv_line->quantity;
459 my %mapped_by_branch;
460 while ( $gocc < $quantity ) {
461 my $branch = $inv_line->girfield( 'branch', $gocc );
462 if ( !exists $mapped_by_branch{$branch} ) {
463 $mapped_by_branch{$branch} = 1;
466 $mapped_by_branch{$branch}++;
470 my $logger = Log
::Log4perl
->get_logger();
471 my $o1 = $order_from->ordernumber;
472 my $o2 = $order_to->ordernumber;
473 $logger->warn("transferring $quantity copies from order $o1 to order $o2");
475 my @item_links = $schema->resultset('AqordersItem')->search(
477 ordernumber
=> $order_from->ordernumber,
480 foreach my $ilink (@item_links) {
481 my $ino = $ilink->itemnumber;
482 my $item = $schema->resultset('Item')->find( $ilink->itemnumber );
483 my $i_branch = $item->homebranch;
484 if ( exists $mapped_by_branch{$i_branch}
485 && $mapped_by_branch{$i_branch} > 0 )
487 $ilink->ordernumber( $order_to->ordernumber );
490 --$mapped_by_branch{$i_branch};
491 $logger->warn("Transferred item $item");
494 $logger->warn("Skipped item $item");
496 if ( $quantity < 1 ) {
507 $quote->status('processing');
510 my $edi = Koha
::Edifact
->new( { transmission
=> $quote->raw_msg, } );
512 my $messages = $edi->message_array();
513 my $process_errors = 0;
514 my $logger = Log
::Log4perl
->get_logger();
515 my $schema = Koha
::Database
->new()->schema();
516 my $message_count = 0;
517 my @added_baskets; # if auto & multiple baskets need to order all
519 if ( @
{$messages} && $quote->vendor_id ) {
520 foreach my $msg ( @
{$messages} ) {
523 NewBasket
( $quote->vendor_id, 0, $quote->filename, q{},
525 push @added_baskets, $basketno;
526 if ( $message_count > 1 ) {
527 my $m_filename = $quote->filename;
528 $m_filename .= "_$message_count";
529 $schema->resultset('EdifactMessage')->create(
531 message_type
=> $quote->message_type,
532 transfer_date
=> $quote->transfer_date,
533 vendor_id
=> $quote->vendor_id,
534 edi_acct
=> $quote->edi_acct,
536 basketno
=> $basketno,
538 filename
=> $m_filename,
543 $quote->basketno($basketno);
545 $logger->trace("Created basket :$basketno");
546 my $items = $msg->lineitems();
547 my $refnum = $msg->message_refno;
549 for my $item ( @
{$items} ) {
550 if ( !quote_item
( $item, $quote, $basketno ) ) {
556 my $status = 'received';
557 if ($process_errors) {
561 $quote->status($status);
562 $quote->update; # status and basketno link
563 # Do we automatically generate orders for this vendor
564 my $v = $schema->resultset('VendorEdiAccount')->search(
566 vendor_id
=> $quote->vendor_id,
569 if ( $v->auto_orders ) {
570 for my $b (@added_baskets) {
573 ean
=> $messages->[0]->buyer_ean,
585 my ( $item, $quote, $basketno ) = @_;
587 my $schema = Koha
::Database
->new()->schema();
588 my $logger = Log
::Log4perl
->get_logger();
590 # $basketno is the return from AddBasket in the calling routine
591 # So this call should not fail unless that has
592 my $basket = Koha
::Acquisition
::Baskets
->find( $basketno );
594 $logger->error('Skipping order creation no valid basketno');
597 $logger->trace( 'Checking db for matches with ', $item->item_number_id() );
598 my $bib = _check_for_existing_bib
( $item->item_number_id() );
599 if ( !defined $bib ) {
601 my $bib_record = _create_bib_from_quote
( $item, $quote );
602 ( $bib->{biblionumber
}, $bib->{biblioitemnumber
} ) =
603 AddBiblio
( $bib_record, q{} );
604 $logger->trace("New biblio added $bib->{biblionumber}");
607 $logger->trace("Match found: $bib->{biblionumber}");
610 # Create an orderline
611 my $order_note = $item->{orderline_free_text
};
613 my $order_quantity = $item->quantity();
614 my $gir_count = $item->number_of_girs();
615 $order_quantity ||= 1; # quantity not necessarily present
616 if ( $gir_count > 1 ) {
617 if ( $gir_count != $order_quantity ) {
619 "Order for $order_quantity items, $gir_count segments present");
621 $order_quantity = 1; # attempts to create an orderline for each gir
623 my $vendor = Koha
::Acquisition
::Booksellers
->find( $quote->vendor_id );
625 # database definitions should set some of these defaults but dont
627 biblionumber
=> $bib->{biblionumber
},
628 entrydate
=> dt_from_string
()->ymd(),
629 basketno
=> $basketno,
630 listprice
=> $item->price,
631 quantity
=> $order_quantity,
632 quantityreceived
=> 0,
633 order_vendornote
=> q{},
634 order_internalnote
=> $order_note,
635 replacementprice
=> $item->price,
636 rrp_tax_included
=> $item->price,
637 rrp_tax_excluded
=> $item->price,
638 ecost
=> _discounted_price
( $quote->vendor->discount, $item->price ),
642 currency
=> $vendor->listprice(),
645 # suppliers references
646 if ( $item->reference() ) {
647 $order_hash->{suppliers_reference_number
} = $item->reference;
648 $order_hash->{suppliers_reference_qualifier
} = 'QLI';
650 elsif ( $item->orderline_reference_number() ) {
651 $order_hash->{suppliers_reference_number
} =
652 $item->orderline_reference_number;
653 $order_hash->{suppliers_reference_qualifier
} = 'SLI';
655 if ( $item->item_number_id ) { # suppliers ean
656 $order_hash->{line_item_id
} = $item->item_number_id;
659 if ( $item->girfield('servicing_instruction') ) {
663 while ( $si = $item->girfield( 'servicing_instruction', $occ ) ) {
670 $order_hash->{order_vendornote
} = $txt;
673 if ( $item->internal_notes() ) {
674 if ( $order_hash->{order_internalnote
} ) { # more than ''
675 $order_hash->{order_internalnote
} .= q{ };
677 $order_hash->{order_internalnote
} .= $item->internal_notes;
680 my $budget = _get_budget
( $schema, $item->girfield('fund_allocation') );
684 if ( $item->quantity > 1 ) {
685 carp
'Skipping line with no budget info';
686 $logger->trace('girfield skipped for invalid budget');
690 carp
'Skipping line with no budget info';
691 $logger->trace('orderline skipped for invalid budget');
701 $order_hash->{budget_id
} = $budget->budget_id;
702 my $first_order = $schema->resultset('Aqorder')->create($order_hash);
703 my $o = $first_order->ordernumber();
704 $logger->trace("Order created :$o");
706 # should be done by database settings
707 $first_order->parent_ordernumber( $first_order->ordernumber() );
708 $first_order->update();
710 # add to $budgets to prevent duplicate orderlines
711 $budgets{ $budget->budget_id } = '1';
713 # record ordernumber against budget
714 $ordernumber{ $budget->budget_id } = $o;
716 if ( C4
::Context
->preference('AcqCreateItem') eq 'ordering' ) {
717 $item_hash = _create_item_from_quote
( $item, $quote );
720 while ( $created < $order_quantity ) {
721 $item_hash->{biblionumber
} = $bib->{biblionumber
};
722 $item_hash->{biblioitemnumber
} = $bib->{biblioitemnumber
};
723 my $item = Koha
::Item
->new( $item_hash )->store;
724 my $itemnumber = $item->itemnumber;
725 $logger->trace("Added item:$itemnumber");
726 $schema->resultset('AqordersItem')->create(
728 ordernumber
=> $first_order->ordernumber,
729 itemnumber
=> $itemnumber,
737 if ( $order_quantity == 1 && $item->quantity > 1 ) {
738 my $occurrence = 1; # occ zero already added
739 while ( $occurrence < $item->quantity ) {
742 $budget = _get_budget
( $schema,
743 $item->girfield( 'fund_allocation', $occurrence ) );
747 $item->girfield( 'fund_allocation', $occurrence );
748 carp
'Skipping line with no budget info';
750 "girfield skipped for invalid budget:$bad_budget");
751 ++$occurrence; ## lets look at the next one not this one again
755 # add orderline for NEW budget in $budgets
756 if ( !exists $budgets{ $budget->budget_id } ) {
758 # $order_hash->{quantity} = 1; by default above
759 # we should handle both 1:1 GIR & 1:n GIR (with LQT values) here
761 $order_hash->{budget_id
} = $budget->budget_id;
764 $schema->resultset('Aqorder')->create($order_hash);
765 my $o = $new_order->ordernumber();
766 $logger->trace("Order created :$o");
768 # should be done by database settings
769 $new_order->parent_ordernumber( $new_order->ordernumber() );
770 $new_order->update();
772 # add to $budgets to prevent duplicate orderlines
773 $budgets{ $budget->budget_id } = '1';
775 # record ordernumber against budget
776 $ordernumber{ $budget->budget_id } = $o;
778 if ( C4
::Context
->preference('AcqCreateItem') eq 'ordering' ) {
779 if ( !defined $item_hash ) {
780 $item_hash = _create_item_from_quote
( $item, $quote );
784 $item->girfield( 'stock_category', $occurrence ),
786 $item->girfield( 'collection_code', $occurrence ),
788 $item->girfield( 'shelfmark', $occurrence )
789 || $item->girfield( 'classification', $occurrence )
790 || title_level_class
($item),
792 $item->girfield( 'branch', $occurrence ),
793 homebranch
=> $item->girfield( 'branch', $occurrence ),
795 if ( $new_item->{itype
} ) {
796 $item_hash->{itype
} = $new_item->{itype
};
798 if ( $new_item->{location
} ) {
799 $item_hash->{location
} = $new_item->{location
};
801 if ( $new_item->{itemcallnumber
} ) {
802 $item_hash->{itemcallnumber
} =
803 $new_item->{itemcallnumber
};
805 if ( $new_item->{holdingbranch
} ) {
806 $item_hash->{holdingbranch
} =
807 $new_item->{holdingbranch
};
809 if ( $new_item->{homebranch
} ) {
810 $item_hash->{homebranch
} = $new_item->{homebranch
};
813 $item_hash->{biblionumber
} = $bib->{biblionumber
};
814 $item_hash->{biblioitemnumber
} = $bib->{biblioitemnumber
};
815 my $item = Koha
::Item
->new( $item_hash )->store;
816 my $itemnumber = $item->itemnumber;
817 $logger->trace("New item $itemnumber added");
818 $schema->resultset('AqordersItem')->create(
820 ordernumber
=> $new_order->ordernumber,
821 itemnumber
=> $itemnumber,
826 $item->girfield( 'library_rotation_plan', $occurrence );
829 Koha
::StockRotationRotas
->find( { title
=> $lrp },
830 { key
=> 'stockrotationrotas_title' } );
832 $rota->add_item($itemnumber);
833 $logger->trace("Item added to rota $rota->id");
837 "No rota found matching $lrp in orderline");
845 # increment quantity in orderline for EXISTING budget in $budgets
847 my $row = $schema->resultset('Aqorder')->find(
849 ordernumber
=> $ordernumber{ $budget->budget_id }
853 my $qty = $row->quantity;
862 # Do not use the basket level value as it is always NULL
863 # See calling subs call to AddBasket
864 if ( C4
::Context
->preference('AcqCreateItem') eq 'ordering' ) {
869 price
=> $item->price,
870 replacementprice
=> $item->price,
872 $item->girfield( 'stock_category', $occurrence ),
874 $item->girfield( 'collection_code', $occurrence ),
876 $item->girfield( 'shelfmark', $occurrence )
877 || $item->girfield( 'classification', $occurrence )
878 || $item_hash->{itemcallnumber
},
880 $item->girfield( 'branch', $occurrence ),
881 homebranch
=> $item->girfield( 'branch', $occurrence ),
883 $new_item->{biblionumber
} = $bib->{biblionumber
};
884 $new_item->{biblioitemnumber
} = $bib->{biblioitemnumber
};
885 my $item = Koha
::Item
->new( $new_item )->store;
886 my $itemnumber = $item->itemnumber;
887 $logger->trace("New item $itemnumber added");
888 $schema->resultset('AqordersItem')->create(
890 ordernumber
=> $ordernumber{ $budget->budget_id },
891 itemnumber
=> $itemnumber,
896 $item->girfield( 'library_rotation_plan', $occurrence );
899 Koha
::StockRotationRotas
->find( { title
=> $lrp },
900 { key
=> 'stockrotationrotas_title' } );
902 $rota->add_item($itemnumber);
903 $logger->trace("Item added to rota $rota->id");
907 "No rota found matching $lrp in orderline");
920 sub get_edifact_ean
{
922 my $dbh = C4
::Context
->dbh;
924 my $eans = $dbh->selectcol_arrayref('select ean from edifact_ean');
929 # We should not need to have a routine to do this here
930 sub _discounted_price
{
931 my ( $discount, $price ) = @_;
932 return $price - ( ( $discount * $price ) / 100 );
935 sub _check_for_existing_bib
{
938 my $search_isbn = $isbn;
939 $search_isbn =~ s/^\s*/%/xms;
940 $search_isbn =~ s/\s*$/%/xms;
941 my $dbh = C4
::Context
->dbh;
942 my $sth = $dbh->prepare(
943 'select biblionumber, biblioitemnumber from biblioitems where isbn like ?',
946 $dbh->selectall_arrayref( $sth, { Slice
=> {} }, $search_isbn );
947 if ( @
{$tuple_arr} ) {
948 return $tuple_arr->[0];
950 elsif ( length($isbn) == 13 && $isbn !~ /^97[89]/ ) {
951 my $tarr = $dbh->selectall_arrayref(
952 'select biblionumber, biblioitemnumber from biblioitems where ean = ?',
963 if ( $isbn =~ m/(\d{13})/xms ) {
964 my $b_isbn = Business
::ISBN
->new($1);
965 if ( $b_isbn && $b_isbn->is_valid && $b_isbn->as_isbn10 ) {
966 $search_isbn = $b_isbn->as_isbn10->as_string( [] );
970 elsif ( $isbn =~ m/(\d{9}[xX]|\d{10})/xms ) {
971 my $b_isbn = Business
::ISBN
->new($1);
972 if ( $b_isbn && $b_isbn->is_valid ) {
973 $search_isbn = $b_isbn->as_isbn13->as_string( [] );
978 $search_isbn = "%$search_isbn%";
980 $dbh->selectall_arrayref( $sth, { Slice
=> {} }, $search_isbn );
981 if ( @
{$tuple_arr} ) {
982 return $tuple_arr->[0];
989 # returns a budget obj or undef
990 # fact we need this shows what a mess Acq API is
992 my ( $schema, $budget_code ) = @_;
993 my $period_rs = $schema->resultset('Aqbudgetperiod')->search(
995 budget_period_active
=> 1,
999 # db does not ensure budget code is unque
1000 return $schema->resultset('Aqbudget')->single(
1002 budget_code
=> $budget_code,
1004 { -in => $period_rs->get_column('budget_period_id')->as_query },
1009 # try to get title level classification from incoming quote
1010 sub title_level_class
{
1013 my $default_scheme = C4
::Context
->preference('DefaultClassificationSource');
1014 if ( $default_scheme eq 'ddc' ) {
1015 $class = $item->dewey_class();
1017 elsif ( $default_scheme eq 'lcc' ) {
1018 $class = $item->lc_class();
1022 $item->girfield('shelfmark')
1023 || $item->girfield('classification')
1029 sub _create_bib_from_quote
{
1031 #TBD we should flag this for updating from an external source
1032 #As biblio (&biblioitems) has no candidates flag in order
1033 my ( $item, $quote ) = @_;
1034 my $itemid = $item->item_number_id;
1035 my $defalt_classification_source =
1036 C4
::Context
->preference('DefaultClassificationSource');
1038 'biblioitems.cn_source' => $defalt_classification_source,
1039 'items.cn_source' => $defalt_classification_source,
1040 'items.notforloan' => -1,
1041 'items.cn_sort' => q{},
1043 $bib_hash->{'biblio.seriestitle'} = $item->series;
1045 $bib_hash->{'biblioitems.publishercode'} = $item->publisher;
1046 $bib_hash->{'biblioitems.publicationyear'} =
1047 $bib_hash->{'biblio.copyrightdate'} = $item->publication_date;
1049 $bib_hash->{'biblio.title'} = $item->title;
1050 $bib_hash->{'biblio.author'} = $item->author;
1051 $bib_hash->{'biblioitems.isbn'} = $item->item_number_id;
1052 $bib_hash->{'biblioitems.itemtype'} = $item->girfield('stock_category');
1054 # If we have a 13 digit id we are assuming its an ean
1055 # (it may also be an isbn or issn)
1056 if ( $itemid =~ /^\d{13}$/ ) {
1057 $bib_hash->{'biblioitems.ean'} = $itemid;
1058 if ( $itemid =~ /^977/ ) {
1059 $bib_hash->{'biblioitems.issn'} = $itemid;
1062 for my $key ( keys %{$bib_hash} ) {
1063 if ( !defined $bib_hash->{$key} ) {
1064 delete $bib_hash->{$key};
1067 return TransformKohaToMarc
($bib_hash);
1071 sub _create_item_from_quote
{
1072 my ( $item, $quote ) = @_;
1073 my $defalt_classification_source =
1074 C4
::Context
->preference('DefaultClassificationSource');
1076 cn_source
=> $defalt_classification_source,
1080 $item_hash->{booksellerid
} = $quote->vendor_id;
1081 $item_hash->{price
} = $item_hash->{replacementprice
} = $item->price;
1082 $item_hash->{itype
} = $item->girfield('stock_category');
1083 $item_hash->{location
} = $item->girfield('collection_code');
1087 $item_hash->{itemcallnumber
} =
1088 $item->girfield('shelfmark')
1089 || $item->girfield('classification')
1090 || title_level_class
($item);
1092 my $branch = $item->girfield('branch');
1093 $item_hash->{holdingbranch
} = $item_hash->{homebranch
} = $branch;
1106 Module exporting subroutines used in EDI processing for Koha
1110 Subroutines called by batch processing to handle Edifact
1111 messages of various types and related utilities
1115 These routines should really be methods of some object.
1116 get_edifact_ean is a stopgap which should be replaced
1120 =head2 process_quote
1122 process_quote(quote_message);
1124 passed a message object for a quote, parses it creating an order basket
1125 and orderlines in the database
1126 updates the message's status to received in the database and adds the
1129 =head2 process_invoice
1131 process_invoice(invoice_message)
1133 passed a message object for an invoice, add the contained invoices
1134 and update the orderlines referred to in the invoice
1135 As an Edifact invoice is in effect a despatch note this receipts the
1136 appropriate quantities in the orders
1138 no meaningful return value
1140 =head2 process_ordrsp
1142 process_ordrsp(ordrsp_message)
1144 passed a message object for a supplier response, process the contents
1145 If an orderline is cancelled cancel the corresponding orderline in koha
1146 otherwise record the supplier message against it
1148 no meaningful return value
1150 =head2 create_edi_order
1152 create_edi_order( { parameter_hashref } )
1154 parameters must include basketno and ean
1156 branchcode can optionally be passed
1158 returns 1 on success undef otherwise
1160 if the parameter noingest is set the formatted order is returned
1161 and not saved in the database. This functionality is intended for debugging only
1163 =head2 receipt_items
1165 receipt_items( schema_obj, invoice_line, ordernumber)
1167 receipts the items recorded on this invoice line
1169 no meaningful return
1171 =head2 transfer_items
1173 transfer_items(schema, invoice_line, originating_order, receiving_order)
1175 Transfer the items covered by this invoice line from their original
1176 order to another order recording the partial fulfillment of the original
1179 no meaningful return
1181 =head2 get_edifact_ean
1183 $ean = get_edifact_ean();
1185 routine to return the ean.
1189 quote_item(lineitem, quote_message);
1191 Called by process_quote to handle an individual lineitem
1192 Generate the biblios and items if required and orderline linking to them
1194 Returns 1 on success undef on error
1196 Most usual cause of error is a line with no or incorrect budget codes
1197 which woild cause order creation to abort
1198 If other correct lines exist these are processed and the erroneous line os logged
1200 =head2 title_level_class
1202 classmark = title_level_class(edi_item)
1204 Trys to return a title level classmark from a quote message line
1205 Will return a dewey or lcc classmark if one exists according to the
1206 value in DefaultClassificationSource syspref
1208 If unable to returns the shelfmark or classification from the GIR segment
1210 If all else fails returns empty string
1212 =head2 _create_bib_from_quote
1214 marc_record_obj = _create_bib_from_quote(lineitem, quote)
1216 Returns a MARC::Record object based on the info in the quote's lineitem
1218 =head2 _create_item_from_quote
1220 item_hashref = _create_item_from_quote( lineitem, quote)
1222 returns a hashref representing the item fields specified in the quote
1224 =head2 _get_invoiced_price
1226 _get_invoiced_price(line_object)
1228 Returns the net price or an equivalent calculated from line cost / qty
1230 =head2 _discounted_price
1232 ecost = _discounted_price(discount, item_price)
1234 utility subroutine to return a price calculated from the
1235 vendors discount and quoted price
1237 =head2 _check_for_existing_bib
1239 (biblionumber, biblioitemnumber) = _check_for_existing_bib(isbn_or_ean)
1241 passed an isbn or ean attempts to locate a match bib
1242 On success returns biblionumber and biblioitemnumber
1243 On failure returns undefined/an empty list
1247 b = _get_budget(schema_obj, budget_code)
1249 Returns the Aqbudget object for the active budget given the passed budget_code
1250 or undefined if one does not exist
1254 Colin Campbell <colin.campbell@ptfs-europe.com>
1259 Copyright 2014,2015 PTFS-Europe Ltd
1260 This program is free software, You may redistribute it under
1261 under the terms of the GNU General Public License