Line 0
Link Here
|
|
|
1 |
package Koha::EDI; |
2 |
|
3 |
# Copyright 2014 PTFS-Europe Ltd |
4 |
# |
5 |
# This file is part of Koha. |
6 |
# |
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. |
11 |
# |
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. |
16 |
# |
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>. |
19 |
|
20 |
use strict; |
21 |
use warnings; |
22 |
use base qw(Exporter); |
23 |
use utf8; |
24 |
use Carp; |
25 |
use English qw{ -no_match_vars }; |
26 |
use Business::ISBN; |
27 |
use DateTime; |
28 |
use C4::Context; |
29 |
use Koha::Database; |
30 |
use C4::Acquisition qw( NewBasket CloseBasket ); |
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; |
35 |
use Koha::Edifact; |
36 |
use Log::Log4perl; |
37 |
use Text::Unidecode; |
38 |
|
39 |
our $VERSION = 1.1; |
40 |
our @EXPORT_OK = |
41 |
qw( process_quote process_invoice process_ordrsp create_edi_order get_edifact_ean ); |
42 |
|
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'; |
52 |
return; |
53 |
} |
54 |
|
55 |
my $schema = Koha::Database->new()->schema(); |
56 |
|
57 |
my @orderlines = $schema->resultset('Aqorder')->search( |
58 |
{ |
59 |
basketno => $basketno, |
60 |
orderstatus => 'new', |
61 |
} |
62 |
)->all; |
63 |
|
64 |
if ( !@orderlines ) { |
65 |
carp "No orderlines for basket $basketno"; |
66 |
return; |
67 |
} |
68 |
|
69 |
my $vendor = $schema->resultset('VendorEdiAccount')->search( |
70 |
{ |
71 |
vendor_id => $orderlines[0]->basketno->booksellerid->id, |
72 |
} |
73 |
)->single; |
74 |
|
75 |
my $ean_search_keys = { ean => $ean, }; |
76 |
if ($branchcode) { |
77 |
$ean_search_keys->{branchcode} = $branchcode; |
78 |
} |
79 |
my $ean_obj = |
80 |
$schema->resultset('EdifactEan')->search($ean_search_keys)->single; |
81 |
|
82 |
my $edifact = Koha::Edifact::Order->new( |
83 |
{ orderlines => \@orderlines, vendor => $vendor, ean => $ean_obj } ); |
84 |
if ( !$edifact ) { |
85 |
return; |
86 |
} |
87 |
|
88 |
my $order_file = $edifact->encode(); |
89 |
|
90 |
# ingest result |
91 |
if ($order_file) { |
92 |
my $m = unidecode($order_file); # remove diacritics and non-latin chars |
93 |
if ($noingest) { # allows scripts to produce test files |
94 |
return $m; |
95 |
} |
96 |
my $order = { |
97 |
message_type => 'ORDERS', |
98 |
raw_msg => $m, |
99 |
vendor_id => $vendor->vendor_id, |
100 |
status => 'Pending', |
101 |
basketno => $basketno, |
102 |
filename => $edifact->filename(), |
103 |
transfer_date => $edifact->msg_date_string(), |
104 |
edi_acct => $vendor->id, |
105 |
|
106 |
}; |
107 |
$schema->resultset('EdifactMessage')->create($order); |
108 |
return 1; |
109 |
} |
110 |
|
111 |
return; |
112 |
} |
113 |
|
114 |
sub process_ordrsp { |
115 |
my $response_message = shift; |
116 |
$response_message->status('processing'); |
117 |
$response_message->update; |
118 |
my $schema = Koha::Database->new()->schema(); |
119 |
my $logger = Log::Log4perl->get_logger(); |
120 |
my $vendor_acct; |
121 |
my $edi = |
122 |
Koha::Edifact->new( { transmission => $response_message->raw_msg, } ); |
123 |
my $messages = $edi->message_array(); |
124 |
|
125 |
if ( @{$messages} ) { |
126 |
foreach my $msg ( @{$messages} ) { |
127 |
|
128 |
# currently a no-op |
129 |
} |
130 |
} |
131 |
|
132 |
$response_message->status('received'); |
133 |
$response_message->update; |
134 |
return; |
135 |
} |
136 |
|
137 |
sub process_invoice { |
138 |
my $invoice_message = shift; |
139 |
$invoice_message->status('processing'); |
140 |
$invoice_message->update; |
141 |
my $schema = Koha::Database->new()->schema(); |
142 |
my $logger = Log::Log4perl->get_logger(); |
143 |
my $vendor_acct; |
144 |
my $edi = |
145 |
Koha::Edifact->new( { transmission => $invoice_message->raw_msg, } ); |
146 |
my $messages = $edi->message_array(); |
147 |
|
148 |
if ( @{$messages} ) { |
149 |
|
150 |
# BGM contains an invoice number |
151 |
foreach my $msg ( @{$messages} ) { |
152 |
my $invoicenumber = $msg->docmsg_number(); |
153 |
my $shipmentcharge = $msg->shipment_charge(); |
154 |
my $msg_date = $msg->message_date; |
155 |
my $tax_date = $msg->tax_point_date; |
156 |
if ( !defined $tax_date || $tax_date !~ m/^\d{8}/xms ) { |
157 |
$tax_date = $msg_date; |
158 |
} |
159 |
|
160 |
my $vendor_ean = $msg->supplier_ean; |
161 |
if ( !defined $vendor_acct || $vendor_ean ne $vendor_acct->san ) { |
162 |
$vendor_acct = $schema->resultset('VendorEdiAccount')->search( |
163 |
{ |
164 |
san => $vendor_ean, |
165 |
} |
166 |
)->single; |
167 |
} |
168 |
if ( !$vendor_acct ) { |
169 |
carp |
170 |
"Cannot find vendor with ean $vendor_ean for invoice $invoicenumber in $invoice_message->filename"; |
171 |
next; |
172 |
} |
173 |
$invoice_message->edi_acct( $vendor_acct->id ); |
174 |
$logger->trace("Adding invoice:$invoicenumber"); |
175 |
my $new_invoice = $schema->resultset('Aqinvoice')->create( |
176 |
{ |
177 |
invoicenumber => $invoicenumber, |
178 |
booksellerid => $invoice_message->vendor_id, |
179 |
shipmentdate => $msg_date, |
180 |
billingdate => $tax_date, |
181 |
shipmentcost => $shipmentcharge, |
182 |
shipmentcost_budgetid => $vendor_acct->shipment_budget, |
183 |
message_id => $invoice_message->id, |
184 |
} |
185 |
); |
186 |
my $invoiceid = $new_invoice->invoiceid; |
187 |
$logger->trace("Added as invoiceno :$invoiceid"); |
188 |
my $lines = $msg->lineitems(); |
189 |
|
190 |
foreach my $line ( @{$lines} ) { |
191 |
my $ordernumber = $line->ordernumber; |
192 |
$logger->trace( "Receipting order:$ordernumber Qty: ", |
193 |
$line->quantity ); |
194 |
|
195 |
my $order = $schema->resultset('Aqorder')->find($ordernumber); |
196 |
|
197 |
# ModReceiveOrder does not validate that $ordernumber exists validate here |
198 |
if ($order) { |
199 |
|
200 |
# check suggestions |
201 |
my $s = $schema->resultset('Suggestion')->search( |
202 |
{ |
203 |
biblionumber => $order->biblionumber->biblionumber, |
204 |
} |
205 |
)->single; |
206 |
if ($s) { |
207 |
ModSuggestion( |
208 |
{ |
209 |
suggestionid => $s->suggestionid, |
210 |
STATUS => 'AVAILABLE', |
211 |
} |
212 |
); |
213 |
} |
214 |
|
215 |
my $price = _get_invoiced_price($line); |
216 |
|
217 |
if ( $order->quantity > $line->quantity ) { |
218 |
my $ordered = $order->quantity; |
219 |
|
220 |
# part receipt |
221 |
$order->orderstatus('partial'); |
222 |
$order->quantity( $ordered - $line->quantity ); |
223 |
$order->update; |
224 |
my $received_order = $order->copy( |
225 |
{ |
226 |
ordernumber => undef, |
227 |
quantity => $line->quantity, |
228 |
quantityreceived => $line->quantity, |
229 |
orderstatus => 'complete', |
230 |
unitprice => $price, |
231 |
invoiceid => $invoiceid, |
232 |
datereceived => $msg_date, |
233 |
} |
234 |
); |
235 |
transfer_items( $schema, $line, $order, |
236 |
$received_order ); |
237 |
receipt_items( $schema, $line, |
238 |
$received_order->ordernumber ); |
239 |
} |
240 |
else { # simple receipt all copies on order |
241 |
$order->quantityreceived( $line->quantity ); |
242 |
$order->datereceived($msg_date); |
243 |
$order->invoiceid($invoiceid); |
244 |
$order->unitprice($price); |
245 |
$order->orderstatus('complete'); |
246 |
$order->update; |
247 |
receipt_items( $schema, $line, $ordernumber ); |
248 |
} |
249 |
} |
250 |
else { |
251 |
$logger->error( |
252 |
"No order found for $ordernumber Invoice:$invoicenumber" |
253 |
); |
254 |
next; |
255 |
} |
256 |
|
257 |
} |
258 |
|
259 |
} |
260 |
} |
261 |
|
262 |
$invoice_message->status('received'); |
263 |
$invoice_message->update; # status and basketno link |
264 |
return; |
265 |
} |
266 |
|
267 |
sub _get_invoiced_price { |
268 |
my $line = shift; |
269 |
my $price = $line->price_net; |
270 |
if ( !defined $price ) { # no net price so generate it from lineitem amount |
271 |
$price = $line->amt_lineitem; |
272 |
if ( $price and $line->quantity > 1 ) { |
273 |
$price /= $line->quantity; # div line cost by qty |
274 |
} |
275 |
} |
276 |
return $price; |
277 |
} |
278 |
|
279 |
sub receipt_items { |
280 |
my ( $schema, $inv_line, $ordernumber ) = @_; |
281 |
my $logger = Log::Log4perl->get_logger(); |
282 |
my $quantity = $inv_line->quantity; |
283 |
|
284 |
# itemnumber is not a foreign key ??? makes this a bit cumbersome |
285 |
my @item_links = $schema->resultset('AqordersItem')->search( |
286 |
{ |
287 |
ordernumber => $ordernumber, |
288 |
} |
289 |
); |
290 |
my %branch_map; |
291 |
foreach my $ilink (@item_links) { |
292 |
my $item = $schema->resultset('Item')->find( $ilink->itemnumber ); |
293 |
if ( !$item ) { |
294 |
my $i = $ilink->itemnumber; |
295 |
$logger->warn( |
296 |
"Cannot find aqorder item for $i :Order:$ordernumber"); |
297 |
next; |
298 |
} |
299 |
my $b = $item->homebranch->branchcode; |
300 |
if ( !exists $branch_map{$b} ) { |
301 |
$branch_map{$b} = []; |
302 |
} |
303 |
push @{ $branch_map{$b} }, $item; |
304 |
} |
305 |
my $gir_occurence = 0; |
306 |
while ( $gir_occurence < $quantity ) { |
307 |
my $branch = $inv_line->girfield( 'branch', $gir_occurence ); |
308 |
my $item = shift @{ $branch_map{$branch} }; |
309 |
if ($item) { |
310 |
my $barcode = $inv_line->girfield( 'barcode', $gir_occurence ); |
311 |
if ( $barcode && !$item->barcode ) { |
312 |
my $rs = $schema->resultset('Item')->search( |
313 |
{ |
314 |
barcode => $barcode, |
315 |
} |
316 |
); |
317 |
if ( $rs->count > 0 ) { |
318 |
$logger->warn("Barcode $barcode is a duplicate"); |
319 |
} |
320 |
else { |
321 |
|
322 |
$logger->trace("Adding barcode $barcode"); |
323 |
$item->barcode($barcode); |
324 |
} |
325 |
} |
326 |
|
327 |
# clear not for loan flag |
328 |
# if ( $item->notforloan == -1 ) { |
329 |
# $item->notforloan(0); |
330 |
# } |
331 |
$item->update; |
332 |
} |
333 |
else { |
334 |
$logger->warn("Unmatched item at branch:$branch"); |
335 |
} |
336 |
++$gir_occurence; |
337 |
} |
338 |
return; |
339 |
|
340 |
} |
341 |
|
342 |
sub transfer_items { |
343 |
my ( $schema, $inv_line, $order_from, $order_to ) = @_; |
344 |
|
345 |
# Transfer x items from the orig order to a completed partial order |
346 |
my $quantity = $inv_line->quantity; |
347 |
my $gocc = 0; |
348 |
my %mapped_by_branch; |
349 |
while ( $gocc < $quantity ) { |
350 |
my $branch = $inv_line->girfield( 'branch', $gocc ); |
351 |
if ( !exists $mapped_by_branch{$branch} ) { |
352 |
$mapped_by_branch{$branch} = 1; |
353 |
} |
354 |
else { |
355 |
$mapped_by_branch{$branch}++; |
356 |
} |
357 |
++$gocc; |
358 |
} |
359 |
my $logger = Log::Log4perl->get_logger(); |
360 |
my $o1 = $order_from->ordernumber; |
361 |
my $o2 = $order_to->ordernumber; |
362 |
$logger->warn("transferring $quantity copies from order $o1 to order $o2"); |
363 |
|
364 |
my @item_links = $schema->resultset('AqordersItem')->search( |
365 |
{ |
366 |
ordernumber => $order_from->ordernumber, |
367 |
} |
368 |
); |
369 |
foreach my $ilink (@item_links) { |
370 |
my $ino = $ilink->itemnumber; |
371 |
my $item = $schema->resultset('Item')->find( $ilink->itemnumber ); |
372 |
my $i_branch = $item->homebranch; |
373 |
if ( exists $mapped_by_branch{$i_branch} |
374 |
&& $mapped_by_branch{$i_branch} > 0 ) |
375 |
{ |
376 |
$ilink->ordernumber( $order_to->ordernumber ); |
377 |
$ilink->update; |
378 |
--$quantity; |
379 |
--$mapped_by_branch{$i_branch}; |
380 |
$logger->warn("Transferred item $item"); |
381 |
} |
382 |
else { |
383 |
$logger->warn("Skipped item $item"); |
384 |
} |
385 |
if ( $quantity < 1 ) { |
386 |
last; |
387 |
} |
388 |
} |
389 |
|
390 |
return; |
391 |
} |
392 |
|
393 |
# called on messages with status 'new' |
394 |
sub process_quote { |
395 |
my $quote = shift; |
396 |
|
397 |
$quote->status('processing'); |
398 |
$quote->update; |
399 |
|
400 |
my $edi = Koha::Edifact->new( { transmission => $quote->raw_msg, } ); |
401 |
|
402 |
my $messages = $edi->message_array(); |
403 |
my $process_errors = 0; |
404 |
my $logger = Log::Log4perl->get_logger(); |
405 |
my $schema = Koha::Database->new()->schema(); |
406 |
my $message_count = 0; |
407 |
my @added_baskets; # if auto & multiple baskets need to order all |
408 |
|
409 |
if ( @{$messages} && $quote->vendor_id ) { |
410 |
foreach my $msg ( @{$messages} ) { |
411 |
++$message_count; |
412 |
my $basketno = |
413 |
NewBasket( $quote->vendor_id, 0, $quote->filename, q{}, |
414 |
q{} . q{} ); |
415 |
push @added_baskets, $basketno; |
416 |
if ( $message_count > 1 ) { |
417 |
my $m_filename = $quote->filename; |
418 |
$m_filename .= "_$message_count"; |
419 |
$schema->resultset('EdifactMessage')->create( |
420 |
{ |
421 |
message_type => $quote->message_type, |
422 |
transfer_date => $quote->transfer_date, |
423 |
vendor_id => $quote->vendor_id, |
424 |
edi_acct => $quote->edi_acct, |
425 |
status => 'recmsg', |
426 |
basketno => $basketno, |
427 |
raw_msg => q{}, |
428 |
filename => $m_filename, |
429 |
} |
430 |
); |
431 |
} |
432 |
else { |
433 |
$quote->basketno($basketno); |
434 |
} |
435 |
$logger->trace("Created basket :$basketno"); |
436 |
my $items = $msg->lineitems(); |
437 |
my $refnum = $msg->message_refno; |
438 |
|
439 |
for my $item ( @{$items} ) { |
440 |
if ( !quote_item( $item, $quote, $basketno ) ) { |
441 |
++$process_errors; |
442 |
} |
443 |
} |
444 |
} |
445 |
} |
446 |
my $status = 'received'; |
447 |
if ($process_errors) { |
448 |
$status = 'error'; |
449 |
} |
450 |
|
451 |
$quote->status($status); |
452 |
$quote->update; # status and basketno link |
453 |
# Do we automatically generate orders for this vendor |
454 |
my $v = $schema->resultset('VendorEdiAccount')->search( |
455 |
{ |
456 |
vendor_id => $quote->vendor_id, |
457 |
} |
458 |
)->single; |
459 |
if ( $v->auto_orders ) { |
460 |
for my $b (@added_baskets) { |
461 |
create_edi_order( |
462 |
{ |
463 |
|
464 |
basketno => $b, |
465 |
} |
466 |
); |
467 |
CloseBasket($b); |
468 |
} |
469 |
} |
470 |
|
471 |
return; |
472 |
} |
473 |
|
474 |
sub quote_item { |
475 |
my ( $item, $quote, $basketno ) = @_; |
476 |
|
477 |
my $schema = Koha::Database->new()->schema(); |
478 |
|
479 |
# create biblio record |
480 |
my $logger = Log::Log4perl->get_logger(); |
481 |
if ( !$basketno ) { |
482 |
$logger->error('Skipping order creation no basketno'); |
483 |
return; |
484 |
} |
485 |
$logger->trace( 'Checking db for matches with ', $item->item_number_id() ); |
486 |
my $bib = _check_for_existing_bib( $item->item_number_id() ); |
487 |
if ( !defined $bib ) { |
488 |
$bib = {}; |
489 |
my $bib_record = _create_bib_from_quote( $item, $quote ); |
490 |
( $bib->{biblionumber}, $bib->{biblioitemnumber} ) = |
491 |
AddBiblio( $bib_record, q{} ); |
492 |
$logger->trace("New biblio added $bib->{biblionumber}"); |
493 |
} |
494 |
else { |
495 |
$logger->trace("Match found: $bib->{biblionumber}"); |
496 |
} |
497 |
|
498 |
# Create an orderline |
499 |
my $order_note = $item->{orderline_free_text}; |
500 |
$order_note ||= q{}; |
501 |
my $order_quantity = $item->quantity(); |
502 |
my $gir_count = $item->number_of_girs(); |
503 |
$order_quantity ||= 1; # quantity not necessarily present |
504 |
if ( $gir_count > 1 ) { |
505 |
if ( $gir_count != $order_quantity ) { |
506 |
$logger->error( |
507 |
"Order for $order_quantity items, $gir_count segments present"); |
508 |
} |
509 |
$order_quantity = 1; # attempts to create an orderline for each gir |
510 |
} |
511 |
|
512 |
# database definitions should set some of these defaults but dont |
513 |
my $order_hash = { |
514 |
biblionumber => $bib->{biblionumber}, |
515 |
entrydate => DateTime->now( time_zone => 'local' )->ymd(), |
516 |
basketno => $basketno, |
517 |
listprice => $item->price, |
518 |
quantity => $order_quantity, |
519 |
quantityreceived => 0, |
520 |
order_internalnote => $order_note, |
521 |
rrp => $item->price, |
522 |
ecost => _discounted_price( $quote->vendor->discount, $item->price ), |
523 |
uncertainprice => 0, |
524 |
sort1 => q{}, |
525 |
sort2 => q{}, |
526 |
|
527 |
# supplierreference => $item->reference, |
528 |
}; |
529 |
|
530 |
# suppliers references |
531 |
if ( $item->reference() ) { |
532 |
$order_hash->{suppliers_reference_number} = $item->reference; |
533 |
$order_hash->{suppliers_reference_qualifier} = 'QLI'; |
534 |
} |
535 |
elsif ( $item->orderline_reference_number() ) { |
536 |
$order_hash->{suppliers_reference_number} = |
537 |
$item->orderline_reference_number; |
538 |
$order_hash->{suppliers_reference_qualifier} = 'SLI'; |
539 |
} |
540 |
if ( $item->item_number_id ) { # suppliers ean |
541 |
$order_hash->{line_item_id} = $item->item_number_id; |
542 |
} |
543 |
|
544 |
if ( $item->girfield('servicing_instruction') ) { |
545 |
my $occ = 0; |
546 |
my $txt = q{}; |
547 |
my $si; |
548 |
while ( $si = $item->girfield( 'servicing_instruction', $occ ) ) { |
549 |
if ($occ) { |
550 |
$txt .= q{: }; |
551 |
} |
552 |
$txt .= $si; |
553 |
++$occ; |
554 |
} |
555 |
$order_hash->{order_vendornote} = $txt; |
556 |
} |
557 |
|
558 |
if ( $item->internal_notes() ) { |
559 |
if ( $order_hash->{order_internalnote} ) { # more than '' |
560 |
$order_hash->{order_internalnote} .= q{ }; |
561 |
} |
562 |
$order_hash->{order_internalnote} .= $item->internal_notes; |
563 |
} |
564 |
|
565 |
my $budget = _get_budget( $schema, $item->girfield('fund_allocation') ); |
566 |
|
567 |
my $skip = '0'; |
568 |
if ( !$budget ) { |
569 |
if ( $item->quantity > 1 ) { |
570 |
carp 'Skipping line with no budget info'; |
571 |
$logger->trace('girfield skipped for invalid budget'); |
572 |
$skip++; |
573 |
} |
574 |
else { |
575 |
carp 'Skipping line with no budget info'; |
576 |
$logger->trace('orderline skipped for invalid budget'); |
577 |
return; |
578 |
} |
579 |
} |
580 |
|
581 |
my %ordernumber; |
582 |
my %budgets; |
583 |
my $item_hash; |
584 |
|
585 |
if ( !$skip ) { |
586 |
$order_hash->{budget_id} = $budget->budget_id; |
587 |
my $first_order = $schema->resultset('Aqorder')->create($order_hash); |
588 |
my $o = $first_order->ordernumber(); |
589 |
$logger->trace("Order created :$o"); |
590 |
|
591 |
# should be done by database settings |
592 |
$first_order->parent_ordernumber( $first_order->ordernumber() ); |
593 |
$first_order->update(); |
594 |
|
595 |
# add to $budgets to prevent duplicate orderlines |
596 |
$budgets{ $budget->budget_id } = '1'; |
597 |
|
598 |
# record ordernumber against budget |
599 |
$ordernumber{ $budget->budget_id } = $o; |
600 |
|
601 |
if ( C4::Context->preference('AcqCreateItem') eq 'ordering' ) { |
602 |
$item_hash = _create_item_from_quote( $item, $quote ); |
603 |
|
604 |
my $created = 0; |
605 |
while ( $created < $order_quantity ) { |
606 |
my $itemnumber; |
607 |
( $bib->{biblionumber}, $bib->{biblioitemnumber}, $itemnumber ) |
608 |
= AddItem( $item_hash, $bib->{biblionumber} ); |
609 |
$logger->trace("Added item:$itemnumber"); |
610 |
$schema->resultset('AqordersItem')->create( |
611 |
{ |
612 |
ordernumber => $first_order->ordernumber, |
613 |
itemnumber => $itemnumber, |
614 |
} |
615 |
); |
616 |
++$created; |
617 |
} |
618 |
} |
619 |
} |
620 |
|
621 |
if ( $order_quantity == 1 && $item->quantity > 1 ) { |
622 |
my $occurence = 1; # occ zero already added |
623 |
while ( $occurence < $item->quantity ) { |
624 |
|
625 |
# check budget code |
626 |
$budget = _get_budget( $schema, |
627 |
$item->girfield( 'fund_allocation', $occurence ) ); |
628 |
|
629 |
if ( !$budget ) { |
630 |
my $bad_budget = |
631 |
$item->girfield( 'fund_allocation', $occurence ); |
632 |
carp 'Skipping line with no budget info'; |
633 |
$logger->trace( |
634 |
"girfield skipped for invalid budget:$bad_budget"); |
635 |
++$occurence; ## lets look at the next one not this one again |
636 |
next; |
637 |
} |
638 |
|
639 |
# add orderline for NEW budget in $budgets |
640 |
if ( !exists $budgets{ $budget->budget_id } ) { |
641 |
|
642 |
# $order_hash->{quantity} = 1; by default above |
643 |
# we should handle both 1:1 GIR & 1:n GIR (with LQT values) here |
644 |
|
645 |
$order_hash->{budget_id} = $budget->budget_id; |
646 |
|
647 |
my $new_order = |
648 |
$schema->resultset('Aqorder')->create($order_hash); |
649 |
my $o = $new_order->ordernumber(); |
650 |
$logger->trace("Order created :$o"); |
651 |
|
652 |
# should be done by database settings |
653 |
$new_order->parent_ordernumber( $new_order->ordernumber() ); |
654 |
$new_order->update(); |
655 |
|
656 |
# add to $budgets to prevent duplicate orderlines |
657 |
$budgets{ $budget->budget_id } = '1'; |
658 |
|
659 |
# record ordernumber against budget |
660 |
$ordernumber{ $budget->budget_id } = $o; |
661 |
|
662 |
if ( C4::Context->preference('AcqCreateItem') eq 'ordering' ) { |
663 |
if ( !defined $item_hash ) { |
664 |
$item_hash = _create_item_from_quote( $item, $quote ); |
665 |
} |
666 |
my $new_item = { |
667 |
itype => |
668 |
$item->girfield( 'stock_category', $occurence ), |
669 |
location => |
670 |
$item->girfield( 'collection_code', $occurence ), |
671 |
itemcallnumber => |
672 |
$item->girfield( 'shelfmark', $occurence ) |
673 |
|| $item->girfield( 'classification', $occurence ) |
674 |
|| title_level_class($item), |
675 |
holdingbranch => |
676 |
$item->girfield( 'branch', $occurence ), |
677 |
homebranch => $item->girfield( 'branch', $occurence ), |
678 |
}; |
679 |
if ( $new_item->{itype} ) { |
680 |
$item_hash->{itype} = $new_item->{itype}; |
681 |
} |
682 |
if ( $new_item->{location} ) { |
683 |
$item_hash->{location} = $new_item->{location}; |
684 |
} |
685 |
if ( $new_item->{itemcallnumber} ) { |
686 |
$item_hash->{itemcallnumber} = |
687 |
$new_item->{itemcallnumber}; |
688 |
} |
689 |
if ( $new_item->{holdingbranch} ) { |
690 |
$item_hash->{holdingbranch} = |
691 |
$new_item->{holdingbranch}; |
692 |
} |
693 |
if ( $new_item->{homebranch} ) { |
694 |
$item_hash->{homebranch} = $new_item->{homebranch}; |
695 |
} |
696 |
|
697 |
my $itemnumber; |
698 |
( undef, undef, $itemnumber ) = |
699 |
AddItem( $item_hash, $bib->{biblionumber} ); |
700 |
$logger->trace("New item $itemnumber added"); |
701 |
$schema->resultset('AqordersItem')->create( |
702 |
{ |
703 |
ordernumber => $new_order->ordernumber, |
704 |
itemnumber => $itemnumber, |
705 |
} |
706 |
); |
707 |
} |
708 |
|
709 |
++$occurence; |
710 |
} |
711 |
|
712 |
# increment quantity in orderline for EXISTING budget in $budgets |
713 |
else { |
714 |
my $row = $schema->resultset('Aqorder')->find( |
715 |
{ |
716 |
ordernumber => $ordernumber{ $budget->budget_id } |
717 |
} |
718 |
); |
719 |
if ($row) { |
720 |
my $qty = $row->quantity; |
721 |
$qty++; |
722 |
$row->update( |
723 |
{ |
724 |
quantity => $qty, |
725 |
} |
726 |
); |
727 |
} |
728 |
|
729 |
if ( C4::Context->preference('AcqCreateItem') eq 'ordering' ) { |
730 |
my $new_item = { |
731 |
notforloan => -1, |
732 |
cn_sort => q{}, |
733 |
cn_source => 'ddc', |
734 |
price => $item->price, |
735 |
replacementprice => $item->price, |
736 |
itype => |
737 |
$item->girfield( 'stock_category', $occurence ), |
738 |
location => |
739 |
$item->girfield( 'collection_code', $occurence ), |
740 |
itemcallnumber => |
741 |
$item->girfield( 'shelfmark', $occurence ) |
742 |
|| $item->girfield( 'classification', $occurence ) |
743 |
|| $item_hash->{itemcallnumber}, |
744 |
holdingbranch => |
745 |
$item->girfield( 'branch', $occurence ), |
746 |
homebranch => $item->girfield( 'branch', $occurence ), |
747 |
}; |
748 |
my $itemnumber; |
749 |
( undef, undef, $itemnumber ) = |
750 |
AddItem( $new_item, $bib->{biblionumber} ); |
751 |
$logger->trace("New item $itemnumber added"); |
752 |
$schema->resultset('AqordersItem')->create( |
753 |
{ |
754 |
ordernumber => $ordernumber{ $budget->budget_id }, |
755 |
itemnumber => $itemnumber, |
756 |
} |
757 |
); |
758 |
} |
759 |
|
760 |
++$occurence; |
761 |
} |
762 |
} |
763 |
} |
764 |
return 1; |
765 |
|
766 |
} |
767 |
|
768 |
sub get_edifact_ean { |
769 |
|
770 |
my $dbh = C4::Context->dbh; |
771 |
|
772 |
my $eans = $dbh->selectcol_arrayref('select ean from edifact_ean'); |
773 |
|
774 |
return $eans->[0]; |
775 |
} |
776 |
|
777 |
# We should not need to have a routine to do this here |
778 |
sub _discounted_price { |
779 |
my ( $discount, $price ) = @_; |
780 |
return $price - ( ( $discount * $price ) / 100 ); |
781 |
} |
782 |
|
783 |
sub _check_for_existing_bib { |
784 |
my $isbn = shift; |
785 |
|
786 |
my $search_isbn = $isbn; |
787 |
$search_isbn =~ s/^\s*/%/xms; |
788 |
$search_isbn =~ s/\s*$/%/xms; |
789 |
my $dbh = C4::Context->dbh; |
790 |
my $sth = $dbh->prepare( |
791 |
'select biblionumber, biblioitemnumber from biblioitems where isbn like ?', |
792 |
); |
793 |
my $tuple_arr = |
794 |
$dbh->selectall_arrayref( $sth, { Slice => {} }, $search_isbn ); |
795 |
if ( @{$tuple_arr} ) { |
796 |
return $tuple_arr->[0]; |
797 |
} |
798 |
elsif ( length($isbn) == 13 && $isbn !~ /^97[89]/ ) { |
799 |
my $tarr = $dbh->selectall_arrayref( |
800 |
'select biblionumber, biblioitemnumber from biblioitems where ean = ?', |
801 |
{ Slice => {} }, |
802 |
$isbn |
803 |
); |
804 |
if ( @{$tarr} ) { |
805 |
return $tarr->[0]; |
806 |
} |
807 |
} |
808 |
else { |
809 |
undef $search_isbn; |
810 |
$isbn =~ s/\-//xmsg; |
811 |
if ( $isbn =~ m/(\d{13})/xms ) { |
812 |
my $b_isbn = Business::ISBN->new($1); |
813 |
if ( $b_isbn && $b_isbn->is_valid ) { |
814 |
$search_isbn = $b_isbn->as_isbn10->as_string( [] ); |
815 |
} |
816 |
|
817 |
} |
818 |
elsif ( $isbn =~ m/(\d{9}[xX]|\d{10})/xms ) { |
819 |
my $b_isbn = Business::ISBN->new($1); |
820 |
if ( $b_isbn && $b_isbn->is_valid ) { |
821 |
$search_isbn = $b_isbn->as_isbn13->as_string( [] ); |
822 |
} |
823 |
|
824 |
} |
825 |
if ($search_isbn) { |
826 |
$search_isbn = "%$search_isbn%"; |
827 |
$tuple_arr = |
828 |
$dbh->selectall_arrayref( $sth, { Slice => {} }, $search_isbn ); |
829 |
if ( @{$tuple_arr} ) { |
830 |
return $tuple_arr->[0]; |
831 |
} |
832 |
} |
833 |
} |
834 |
return; |
835 |
} |
836 |
|
837 |
# returns a budget obj or undef |
838 |
# fact we need this shows what a mess Acq API is |
839 |
sub _get_budget { |
840 |
my ( $schema, $budget_code ) = @_; |
841 |
my $period_rs = $schema->resultset('Aqbudgetperiod')->search( |
842 |
{ |
843 |
budget_period_active => 1, |
844 |
} |
845 |
); |
846 |
|
847 |
# db does not ensure budget code is unque |
848 |
return $schema->resultset('Aqbudget')->single( |
849 |
{ |
850 |
budget_code => $budget_code, |
851 |
budget_period_id => |
852 |
{ -in => $period_rs->get_column('budget_period_id')->as_query }, |
853 |
} |
854 |
); |
855 |
} |
856 |
|
857 |
# try to get title level classification from incoming quote |
858 |
sub title_level_class { |
859 |
my ($item) = @_; |
860 |
my $class = q{}; |
861 |
my $default_scheme = C4::Context->preference('DefaultClassificationSource'); |
862 |
if ( $default_scheme eq 'ddc' ) { |
863 |
$class = $item->dewey_class(); |
864 |
} |
865 |
elsif ( $default_scheme eq 'lcc' ) { |
866 |
$class = $item->lc_class(); |
867 |
} |
868 |
if ( !$class ) { |
869 |
$class = |
870 |
$item->girfield('shelfmark') |
871 |
|| $item->girfield('classification') |
872 |
|| q{}; |
873 |
} |
874 |
return $class; |
875 |
} |
876 |
|
877 |
sub _create_bib_from_quote { |
878 |
|
879 |
#TBD we should flag this for updating from an external source |
880 |
#As biblio (&biblioitems) has no candidates flag in order |
881 |
my ( $item, $quote ) = @_; |
882 |
my $itemid = $item->item_number_id; |
883 |
my $defalt_classification_source = |
884 |
C4::Context->preference('DefaultClassificationSource'); |
885 |
my $bib_hash = { |
886 |
'biblioitems.cn_source' => $defalt_classification_source, |
887 |
'items.cn_source' => $defalt_classification_source, |
888 |
'items.notforloan' => -1, |
889 |
'items.cn_sort' => q{}, |
890 |
}; |
891 |
$bib_hash->{'biblio.seriestitle'} = $item->series; |
892 |
|
893 |
$bib_hash->{'biblioitems.publishercode'} = $item->publisher; |
894 |
$bib_hash->{'biblioitems.publicationyear'} = |
895 |
$bib_hash->{'biblio.copyrightdate'} = $item->publication_date; |
896 |
|
897 |
$bib_hash->{'biblio.title'} = $item->title; |
898 |
$bib_hash->{'biblio.author'} = $item->author; |
899 |
$bib_hash->{'biblioitems.isbn'} = $item->item_number_id; |
900 |
$bib_hash->{'biblioitems.itemtype'} = $item->girfield('stock_category'); |
901 |
|
902 |
# If we have a 13 digit id we are assuming its an ean |
903 |
# (it may also be an isbn or issn) |
904 |
if ( $itemid =~ /^\d{13}$/ ) { |
905 |
$bib_hash->{'biblioitems.ean'} = $itemid; |
906 |
if ( $itemid =~ /^977/ ) { |
907 |
$bib_hash->{'biblioitems.issn'} = $itemid; |
908 |
} |
909 |
} |
910 |
for my $key ( keys %{$bib_hash} ) { |
911 |
if ( !defined $bib_hash->{$key} ) { |
912 |
delete $bib_hash->{$key}; |
913 |
} |
914 |
} |
915 |
return TransformKohaToMarc($bib_hash); |
916 |
|
917 |
} |
918 |
|
919 |
sub _create_item_from_quote { |
920 |
my ( $item, $quote ) = @_; |
921 |
my $defalt_classification_source = |
922 |
C4::Context->preference('DefaultClassificationSource'); |
923 |
my $item_hash = { |
924 |
cn_source => $defalt_classification_source, |
925 |
notforloan => -1, |
926 |
cn_sort => q{}, |
927 |
}; |
928 |
$item_hash->{booksellerid} = $quote->vendor_id; |
929 |
$item_hash->{price} = $item_hash->{replacementprice} = $item->price; |
930 |
$item_hash->{itype} = $item->girfield('stock_category'); |
931 |
$item_hash->{location} = $item->girfield('collection_code'); |
932 |
|
933 |
my $note = {}; |
934 |
|
935 |
$item_hash->{itemcallnumber} = |
936 |
$item->girfield('shelfmark') |
937 |
|| $item->girfield('classification') |
938 |
|| title_level_class($item); |
939 |
|
940 |
my $branch = $item->girfield('branch'); |
941 |
$item_hash->{holdingbranch} = $item_hash->{homebranch} = $branch; |
942 |
return $item_hash; |
943 |
} |
944 |
|
945 |
1; |
946 |
__END__ |
947 |
|
948 |
=head1 NAME |
949 |
|
950 |
Koha::EDI |
951 |
|
952 |
=head1 SYNOPSIS |
953 |
|
954 |
Module exporting subroutines used in EDI processing for Koha |
955 |
|
956 |
=head1 DESCRIPTION |
957 |
|
958 |
Subroutines called by batch processing to handle Edifact |
959 |
messages of various types and related utilities |
960 |
|
961 |
=head1 BUGS |
962 |
|
963 |
These routines should really be methods of some object. |
964 |
get_edifact_ean is a stopgap which should be replaced |
965 |
|
966 |
=head1 SUBROUTINES |
967 |
|
968 |
=head2 process_quote |
969 |
|
970 |
process_quote(quote_message); |
971 |
|
972 |
passed a message object for a quote, parses it creating an order basket |
973 |
and orderlines in the database |
974 |
updates the message's status to received in the database and adds the |
975 |
link to basket |
976 |
|
977 |
=head2 process_invoice |
978 |
|
979 |
process_invoice(invoice_message) |
980 |
|
981 |
passed a message object for an invoice, add the contained invoices |
982 |
and update the orderlines referred to in the invoice |
983 |
As an Edifact invoice is in effect a despatch note this receipts the |
984 |
appropriate quantities in the orders |
985 |
|
986 |
|
987 |
=head2 create_edi_order |
988 |
|
989 |
create_edi_order( { parameter_hashref } ) |
990 |
|
991 |
parameters must include basketno and ean |
992 |
|
993 |
branchcode can optionally be passed |
994 |
|
995 |
returns 1 on success undef otherwise |
996 |
|
997 |
if the parameter noingest is set the formatted order is returned |
998 |
and not saved in the database. This functionality is intended for debugging only |
999 |
e |
1000 |
my $database = Koha::Database->new(); |
1001 |
|
1002 |
=head2 get_edifact_ean |
1003 |
|
1004 |
$ean = get_edifact_ean(); |
1005 |
|
1006 |
routine to return the ean. |
1007 |
|
1008 |
=head2 quote_item |
1009 |
|
1010 |
quote_item(lineitem, quote_message); |
1011 |
|
1012 |
Called by process_quote to handle an individual lineitem |
1013 |
Generate the biblios and items if required and orderline linking to them |
1014 |
|
1015 |
=head1 AUTHOR |
1016 |
|
1017 |
Colin Campbell <colin.campbell@ptfs-europe.com> |
1018 |
|
1019 |
|
1020 |
=head1 COPYRIGHT |
1021 |
|
1022 |
Copyright 2014, PTFS-Europe Ltd |
1023 |
This program is free software, You may redistribute it under |
1024 |
under the terms of the GNU General Public License |
1025 |
|
1026 |
|
1027 |
=cut |