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