|
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 |