3 # Copyright 2014,2015 PTFS-Europe Ltd
5 # This file is part of Koha.
7 # Koha is free software; you can redistribute it and/or modify it
8 # under the terms of the GNU General Public License as published by
9 # the Free Software Foundation; either version 3 of the License, or
10 # (at your option) any later version.
12 # Koha is distributed in the hope that it will be useful, but
13 # WITHOUT ANY WARRANTY; without even the implied warranty of
14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 # GNU General Public License for more details.
17 # You should have received a copy of the GNU General Public License
18 # along with Koha; if not, see <http://www.gnu.org/licenses>.
22 use base
qw(Exporter);
25 use English
qw{ -no_match_vars
};
30 use C4
::Acquisition
qw( NewBasket CloseBasket ModOrder);
31 use C4
::Suggestions
qw( ModSuggestion );
32 use C4
::Items
qw(AddItem);
33 use C4
::Biblio
qw( AddBiblio TransformKohaToMarc GetMarcBiblio );
34 use Koha
::Edifact
::Order
;
38 use Koha
::Plugins
::Handler
;
42 qw( process_quote process_invoice process_ordrsp create_edi_order get_edifact_ean );
44 sub create_edi_order
{
45 my $parameters = shift;
46 my $basketno = $parameters->{basketno
};
47 my $ean = $parameters->{ean
};
48 my $branchcode = $parameters->{branchcode
};
49 my $noingest = $parameters->{noingest
};
50 $ean ||= C4
::Context
->preference('EDIfactEAN');
51 if ( !$basketno || !$ean ) {
52 carp
'create_edi_order called with no basketno or ean';
56 my $schema = Koha
::Database
->new()->schema();
58 my @orderlines = $schema->resultset('Aqorder')->search(
60 basketno
=> $basketno,
66 carp
"No orderlines for basket $basketno";
70 my $vendor = $schema->resultset('VendorEdiAccount')->search(
72 vendor_id
=> $orderlines[0]->basketno->booksellerid->id,
76 my $ean_search_keys = { ean
=> $ean, };
78 $ean_search_keys->{branchcode
} = $branchcode;
81 $schema->resultset('EdifactEan')->search($ean_search_keys)->single;
83 my $dbh = C4
::Context
->dbh;
84 my $arr_ref = $dbh->selectcol_arrayref(
85 'select id from edifact_messages where basketno = ? and message_type = \'QUOTE\'',
88 my $response = @
{$arr_ref} ?
1 : 0;
90 my $edifact_order_params = {
91 orderlines
=> \
@orderlines,
94 is_response
=> $response,
98 if ( $vendor->plugin ) {
99 $edifact = Koha
::Plugins
::Handler
->run(
101 class => $vendor->plugin,
102 method
=> 'edifact_order',
104 params
=> $edifact_order_params,
110 $edifact = Koha
::Edifact
::Order
->new($edifact_order_params);
113 return unless $edifact;
115 my $order_file = $edifact->encode();
119 my $m = unidecode
($order_file); # remove diacritics and non-latin chars
120 if ($noingest) { # allows scripts to produce test files
124 message_type
=> 'ORDERS',
126 vendor_id
=> $vendor->vendor_id,
128 basketno
=> $basketno,
129 filename
=> $edifact->filename(),
130 transfer_date
=> $edifact->msg_date_string(),
131 edi_acct
=> $vendor->id,
134 $schema->resultset('EdifactMessage')->create($order);
142 my $response_message = shift;
143 $response_message->status('processing');
144 $response_message->update;
145 my $schema = Koha
::Database
->new()->schema();
146 my $logger = Log
::Log4perl
->get_logger();
149 Koha
::Edifact
->new( { transmission
=> $response_message->raw_msg, } );
150 my $messages = $edi->message_array();
152 if ( @
{$messages} ) {
153 foreach my $msg ( @
{$messages} ) {
154 my $lines = $msg->lineitems();
155 foreach my $line ( @
{$lines} ) {
156 my $ordernumber = $line->ordernumber();
158 # action cancelled:change_requested:no_action:accepted:not_found:recorded
159 my $action = $line->action_notification();
160 if ( $action eq 'cancelled' ) {
161 my $reason = $line->coded_orderline_text();
164 ordernumber
=> $ordernumber,
165 cancellationreason
=> $reason,
166 orderstatus
=> 'cancelled',
167 datecancellationprinted
=> DateTime
->now()->ymd(),
171 else { # record order as due with possible further info
173 my $report = $line->coded_orderline_text();
174 my $date_avail = $line->availability_date();
177 $report .= " Available: $date_avail";
181 ordernumber
=> $ordernumber,
182 suppliers_report
=> $report,
190 $response_message->status('received');
191 $response_message->update;
195 sub process_invoice
{
196 my $invoice_message = shift;
197 $invoice_message->status('processing');
198 $invoice_message->update;
199 my $schema = Koha
::Database
->new()->schema();
200 my $logger = Log
::Log4perl
->get_logger();
203 my $plugin = $invoice_message->edi_acct()->plugin();
206 $edi_plugin = Koha
::Plugins
::Handler
->run(
211 invoice_message
=> $invoice_message,
212 transmission
=> $invoice_message->raw_msg,
218 my $edi = $edi_plugin ||
219 Koha
::Edifact
->new( { transmission
=> $invoice_message->raw_msg, } );
221 my $messages = $edi->message_array();
223 if ( @
{$messages} ) {
225 # BGM contains an invoice number
226 foreach my $msg ( @
{$messages} ) {
227 my $invoicenumber = $msg->docmsg_number();
228 my $shipmentcharge = $msg->shipment_charge();
229 my $msg_date = $msg->message_date;
230 my $tax_date = $msg->tax_point_date;
231 if ( !defined $tax_date || $tax_date !~ m/^\d{8}/xms ) {
232 $tax_date = $msg_date;
235 my $vendor_ean = $msg->supplier_ean;
236 if ( !defined $vendor_acct || $vendor_ean ne $vendor_acct->san ) {
237 $vendor_acct = $schema->resultset('VendorEdiAccount')->search(
243 if ( !$vendor_acct ) {
245 "Cannot find vendor with ean $vendor_ean for invoice $invoicenumber in $invoice_message->filename";
248 $invoice_message->edi_acct( $vendor_acct->id );
249 $logger->trace("Adding invoice:$invoicenumber");
250 my $new_invoice = $schema->resultset('Aqinvoice')->create(
252 invoicenumber
=> $invoicenumber,
253 booksellerid
=> $invoice_message->vendor_id,
254 shipmentdate
=> $msg_date,
255 billingdate
=> $tax_date,
256 shipmentcost
=> $shipmentcharge,
257 shipmentcost_budgetid
=> $vendor_acct->shipment_budget,
258 message_id
=> $invoice_message->id,
261 my $invoiceid = $new_invoice->invoiceid;
262 $logger->trace("Added as invoiceno :$invoiceid");
263 my $lines = $msg->lineitems();
265 foreach my $line ( @
{$lines} ) {
266 my $ordernumber = $line->ordernumber;
267 $logger->trace( "Receipting order:$ordernumber Qty: ",
270 my $order = $schema->resultset('Aqorder')->find($ordernumber);
272 # ModReceiveOrder does not validate that $ordernumber exists validate here
276 my $s = $schema->resultset('Suggestion')->search(
278 biblionumber
=> $order->biblionumber->biblionumber,
284 suggestionid
=> $s->suggestionid,
285 STATUS
=> 'AVAILABLE',
290 my $price = _get_invoiced_price
($line);
292 if ( $order->quantity > $line->quantity ) {
293 my $ordered = $order->quantity;
296 $order->orderstatus('partial');
297 $order->quantity( $ordered - $line->quantity );
299 my $received_order = $order->copy(
301 ordernumber
=> undef,
302 quantity
=> $line->quantity,
303 quantityreceived
=> $line->quantity,
304 orderstatus
=> 'complete',
306 invoiceid
=> $invoiceid,
307 datereceived
=> $msg_date,
310 transfer_items
( $schema, $line, $order,
312 receipt_items
( $schema, $line,
313 $received_order->ordernumber );
315 else { # simple receipt all copies on order
316 $order->quantityreceived( $line->quantity );
317 $order->datereceived($msg_date);
318 $order->invoiceid($invoiceid);
319 $order->unitprice($price);
320 $order->orderstatus('complete');
322 receipt_items
( $schema, $line, $ordernumber );
327 "No order found for $ordernumber Invoice:$invoicenumber"
337 $invoice_message->status('received');
338 $invoice_message->update; # status and basketno link
342 sub _get_invoiced_price
{
344 my $price = $line->price_net;
345 if ( !defined $price ) { # no net price so generate it from lineitem amount
346 $price = $line->amt_lineitem;
347 if ( $price and $line->quantity > 1 ) {
348 $price /= $line->quantity; # div line cost by qty
355 my ( $schema, $inv_line, $ordernumber ) = @_;
356 my $logger = Log
::Log4perl
->get_logger();
357 my $quantity = $inv_line->quantity;
359 # itemnumber is not a foreign key ??? makes this a bit cumbersome
360 my @item_links = $schema->resultset('AqordersItem')->search(
362 ordernumber
=> $ordernumber,
366 foreach my $ilink (@item_links) {
367 my $item = $schema->resultset('Item')->find( $ilink->itemnumber );
369 my $i = $ilink->itemnumber;
371 "Cannot find aqorder item for $i :Order:$ordernumber");
374 my $b = $item->homebranch->branchcode;
375 if ( !exists $branch_map{$b} ) {
376 $branch_map{$b} = [];
378 push @
{ $branch_map{$b} }, $item;
380 my $gir_occurrence = 0;
381 while ( $gir_occurrence < $quantity ) {
382 my $branch = $inv_line->girfield( 'branch', $gir_occurrence );
383 my $item = shift @
{ $branch_map{$branch} };
385 my $barcode = $inv_line->girfield( 'barcode', $gir_occurrence );
386 if ( $barcode && !$item->barcode ) {
387 my $rs = $schema->resultset('Item')->search(
392 if ( $rs->count > 0 ) {
393 $logger->warn("Barcode $barcode is a duplicate");
397 $logger->trace("Adding barcode $barcode");
398 $item->barcode($barcode);
405 $logger->warn("Unmatched item at branch:$branch");
414 my ( $schema, $inv_line, $order_from, $order_to ) = @_;
416 # Transfer x items from the orig order to a completed partial order
417 my $quantity = $inv_line->quantity;
419 my %mapped_by_branch;
420 while ( $gocc < $quantity ) {
421 my $branch = $inv_line->girfield( 'branch', $gocc );
422 if ( !exists $mapped_by_branch{$branch} ) {
423 $mapped_by_branch{$branch} = 1;
426 $mapped_by_branch{$branch}++;
430 my $logger = Log
::Log4perl
->get_logger();
431 my $o1 = $order_from->ordernumber;
432 my $o2 = $order_to->ordernumber;
433 $logger->warn("transferring $quantity copies from order $o1 to order $o2");
435 my @item_links = $schema->resultset('AqordersItem')->search(
437 ordernumber
=> $order_from->ordernumber,
440 foreach my $ilink (@item_links) {
441 my $ino = $ilink->itemnumber;
442 my $item = $schema->resultset('Item')->find( $ilink->itemnumber );
443 my $i_branch = $item->homebranch;
444 if ( exists $mapped_by_branch{$i_branch}
445 && $mapped_by_branch{$i_branch} > 0 )
447 $ilink->ordernumber( $order_to->ordernumber );
450 --$mapped_by_branch{$i_branch};
451 $logger->warn("Transferred item $item");
454 $logger->warn("Skipped item $item");
456 if ( $quantity < 1 ) {
467 $quote->status('processing');
470 my $edi = Koha
::Edifact
->new( { transmission
=> $quote->raw_msg, } );
472 my $messages = $edi->message_array();
473 my $process_errors = 0;
474 my $logger = Log
::Log4perl
->get_logger();
475 my $schema = Koha
::Database
->new()->schema();
476 my $message_count = 0;
477 my @added_baskets; # if auto & multiple baskets need to order all
479 if ( @
{$messages} && $quote->vendor_id ) {
480 foreach my $msg ( @
{$messages} ) {
483 NewBasket
( $quote->vendor_id, 0, $quote->filename, q{},
485 push @added_baskets, $basketno;
486 if ( $message_count > 1 ) {
487 my $m_filename = $quote->filename;
488 $m_filename .= "_$message_count";
489 $schema->resultset('EdifactMessage')->create(
491 message_type
=> $quote->message_type,
492 transfer_date
=> $quote->transfer_date,
493 vendor_id
=> $quote->vendor_id,
494 edi_acct
=> $quote->edi_acct,
496 basketno
=> $basketno,
498 filename
=> $m_filename,
503 $quote->basketno($basketno);
505 $logger->trace("Created basket :$basketno");
506 my $items = $msg->lineitems();
507 my $refnum = $msg->message_refno;
509 for my $item ( @
{$items} ) {
510 if ( !quote_item
( $item, $quote, $basketno ) ) {
516 my $status = 'received';
517 if ($process_errors) {
521 $quote->status($status);
522 $quote->update; # status and basketno link
523 # Do we automatically generate orders for this vendor
524 my $v = $schema->resultset('VendorEdiAccount')->search(
526 vendor_id
=> $quote->vendor_id,
529 if ( $v->auto_orders ) {
530 for my $b (@added_baskets) {
545 my ( $item, $quote, $basketno ) = @_;
547 my $schema = Koha
::Database
->new()->schema();
549 # create biblio record
550 my $logger = Log
::Log4perl
->get_logger();
552 $logger->error('Skipping order creation no basketno');
555 $logger->trace( 'Checking db for matches with ', $item->item_number_id() );
556 my $bib = _check_for_existing_bib
( $item->item_number_id() );
557 if ( !defined $bib ) {
559 my $bib_record = _create_bib_from_quote
( $item, $quote );
560 ( $bib->{biblionumber
}, $bib->{biblioitemnumber
} ) =
561 AddBiblio
( $bib_record, q{} );
562 $logger->trace("New biblio added $bib->{biblionumber}");
565 $logger->trace("Match found: $bib->{biblionumber}");
568 # Create an orderline
569 my $order_note = $item->{orderline_free_text
};
571 my $order_quantity = $item->quantity();
572 my $gir_count = $item->number_of_girs();
573 $order_quantity ||= 1; # quantity not necessarily present
574 if ( $gir_count > 1 ) {
575 if ( $gir_count != $order_quantity ) {
577 "Order for $order_quantity items, $gir_count segments present");
579 $order_quantity = 1; # attempts to create an orderline for each gir
582 # database definitions should set some of these defaults but dont
584 biblionumber
=> $bib->{biblionumber
},
585 entrydate
=> DateTime
->now( time_zone
=> 'local' )->ymd(),
586 basketno
=> $basketno,
587 listprice
=> $item->price,
588 quantity
=> $order_quantity,
589 quantityreceived
=> 0,
590 order_vendornote
=> q{},
591 order_internalnote
=> $order_note,
593 ecost
=> _discounted_price
( $quote->vendor->discount, $item->price ),
599 # suppliers references
600 if ( $item->reference() ) {
601 $order_hash->{suppliers_reference_number
} = $item->reference;
602 $order_hash->{suppliers_reference_qualifier
} = 'QLI';
604 elsif ( $item->orderline_reference_number() ) {
605 $order_hash->{suppliers_reference_number
} =
606 $item->orderline_reference_number;
607 $order_hash->{suppliers_reference_qualifier
} = 'SLI';
609 if ( $item->item_number_id ) { # suppliers ean
610 $order_hash->{line_item_id
} = $item->item_number_id;
613 if ( $item->girfield('servicing_instruction') ) {
617 while ( $si = $item->girfield( 'servicing_instruction', $occ ) ) {
624 $order_hash->{order_vendornote
} = $txt;
627 if ( $item->internal_notes() ) {
628 if ( $order_hash->{order_internalnote
} ) { # more than ''
629 $order_hash->{order_internalnote
} .= q{ };
631 $order_hash->{order_internalnote
} .= $item->internal_notes;
634 my $budget = _get_budget
( $schema, $item->girfield('fund_allocation') );
638 if ( $item->quantity > 1 ) {
639 carp
'Skipping line with no budget info';
640 $logger->trace('girfield skipped for invalid budget');
644 carp
'Skipping line with no budget info';
645 $logger->trace('orderline skipped for invalid budget');
655 $order_hash->{budget_id
} = $budget->budget_id;
656 my $first_order = $schema->resultset('Aqorder')->create($order_hash);
657 my $o = $first_order->ordernumber();
658 $logger->trace("Order created :$o");
660 # should be done by database settings
661 $first_order->parent_ordernumber( $first_order->ordernumber() );
662 $first_order->update();
664 # add to $budgets to prevent duplicate orderlines
665 $budgets{ $budget->budget_id } = '1';
667 # record ordernumber against budget
668 $ordernumber{ $budget->budget_id } = $o;
670 if ( C4
::Context
->preference('AcqCreateItem') eq 'ordering' ) {
671 $item_hash = _create_item_from_quote
( $item, $quote );
674 while ( $created < $order_quantity ) {
676 ( $bib->{biblionumber
}, $bib->{biblioitemnumber
}, $itemnumber )
677 = AddItem
( $item_hash, $bib->{biblionumber
} );
678 $logger->trace("Added item:$itemnumber");
679 $schema->resultset('AqordersItem')->create(
681 ordernumber
=> $first_order->ordernumber,
682 itemnumber
=> $itemnumber,
690 if ( $order_quantity == 1 && $item->quantity > 1 ) {
691 my $occurrence = 1; # occ zero already added
692 while ( $occurrence < $item->quantity ) {
695 $budget = _get_budget
( $schema,
696 $item->girfield( 'fund_allocation', $occurrence ) );
700 $item->girfield( 'fund_allocation', $occurrence );
701 carp
'Skipping line with no budget info';
703 "girfield skipped for invalid budget:$bad_budget");
704 ++$occurrence; ## lets look at the next one not this one again
708 # add orderline for NEW budget in $budgets
709 if ( !exists $budgets{ $budget->budget_id } ) {
711 # $order_hash->{quantity} = 1; by default above
712 # we should handle both 1:1 GIR & 1:n GIR (with LQT values) here
714 $order_hash->{budget_id
} = $budget->budget_id;
717 $schema->resultset('Aqorder')->create($order_hash);
718 my $o = $new_order->ordernumber();
719 $logger->trace("Order created :$o");
721 # should be done by database settings
722 $new_order->parent_ordernumber( $new_order->ordernumber() );
723 $new_order->update();
725 # add to $budgets to prevent duplicate orderlines
726 $budgets{ $budget->budget_id } = '1';
728 # record ordernumber against budget
729 $ordernumber{ $budget->budget_id } = $o;
731 if ( C4
::Context
->preference('AcqCreateItem') eq 'ordering' ) {
732 if ( !defined $item_hash ) {
733 $item_hash = _create_item_from_quote
( $item, $quote );
737 $item->girfield( 'stock_category', $occurrence ),
739 $item->girfield( 'collection_code', $occurrence ),
741 $item->girfield( 'shelfmark', $occurrence )
742 || $item->girfield( 'classification', $occurrence )
743 || title_level_class
($item),
745 $item->girfield( 'branch', $occurrence ),
746 homebranch
=> $item->girfield( 'branch', $occurrence ),
748 if ( $new_item->{itype
} ) {
749 $item_hash->{itype
} = $new_item->{itype
};
751 if ( $new_item->{location
} ) {
752 $item_hash->{location
} = $new_item->{location
};
754 if ( $new_item->{itemcallnumber
} ) {
755 $item_hash->{itemcallnumber
} =
756 $new_item->{itemcallnumber
};
758 if ( $new_item->{holdingbranch
} ) {
759 $item_hash->{holdingbranch
} =
760 $new_item->{holdingbranch
};
762 if ( $new_item->{homebranch
} ) {
763 $item_hash->{homebranch
} = $new_item->{homebranch
};
767 ( undef, undef, $itemnumber ) =
768 AddItem
( $item_hash, $bib->{biblionumber
} );
769 $logger->trace("New item $itemnumber added");
770 $schema->resultset('AqordersItem')->create(
772 ordernumber
=> $new_order->ordernumber,
773 itemnumber
=> $itemnumber,
781 # increment quantity in orderline for EXISTING budget in $budgets
783 my $row = $schema->resultset('Aqorder')->find(
785 ordernumber
=> $ordernumber{ $budget->budget_id }
789 my $qty = $row->quantity;
798 if ( C4
::Context
->preference('AcqCreateItem') eq 'ordering' ) {
803 price
=> $item->price,
804 replacementprice
=> $item->price,
806 $item->girfield( 'stock_category', $occurrence ),
808 $item->girfield( 'collection_code', $occurrence ),
810 $item->girfield( 'shelfmark', $occurrence )
811 || $item->girfield( 'classification', $occurrence )
812 || $item_hash->{itemcallnumber
},
814 $item->girfield( 'branch', $occurrence ),
815 homebranch
=> $item->girfield( 'branch', $occurrence ),
818 ( undef, undef, $itemnumber ) =
819 AddItem
( $new_item, $bib->{biblionumber
} );
820 $logger->trace("New item $itemnumber added");
821 $schema->resultset('AqordersItem')->create(
823 ordernumber
=> $ordernumber{ $budget->budget_id },
824 itemnumber
=> $itemnumber,
837 sub get_edifact_ean
{
839 my $dbh = C4
::Context
->dbh;
841 my $eans = $dbh->selectcol_arrayref('select ean from edifact_ean');
846 # We should not need to have a routine to do this here
847 sub _discounted_price
{
848 my ( $discount, $price ) = @_;
849 return $price - ( ( $discount * $price ) / 100 );
852 sub _check_for_existing_bib
{
855 my $search_isbn = $isbn;
856 $search_isbn =~ s/^\s*/%/xms;
857 $search_isbn =~ s/\s*$/%/xms;
858 my $dbh = C4
::Context
->dbh;
859 my $sth = $dbh->prepare(
860 'select biblionumber, biblioitemnumber from biblioitems where isbn like ?',
863 $dbh->selectall_arrayref( $sth, { Slice
=> {} }, $search_isbn );
864 if ( @
{$tuple_arr} ) {
865 return $tuple_arr->[0];
867 elsif ( length($isbn) == 13 && $isbn !~ /^97[89]/ ) {
868 my $tarr = $dbh->selectall_arrayref(
869 'select biblionumber, biblioitemnumber from biblioitems where ean = ?',
880 if ( $isbn =~ m/(\d{13})/xms ) {
881 my $b_isbn = Business
::ISBN
->new($1);
882 if ( $b_isbn && $b_isbn->is_valid ) {
883 $search_isbn = $b_isbn->as_isbn10->as_string( [] );
887 elsif ( $isbn =~ m/(\d{9}[xX]|\d{10})/xms ) {
888 my $b_isbn = Business
::ISBN
->new($1);
889 if ( $b_isbn && $b_isbn->is_valid ) {
890 $search_isbn = $b_isbn->as_isbn13->as_string( [] );
895 $search_isbn = "%$search_isbn%";
897 $dbh->selectall_arrayref( $sth, { Slice
=> {} }, $search_isbn );
898 if ( @
{$tuple_arr} ) {
899 return $tuple_arr->[0];
906 # returns a budget obj or undef
907 # fact we need this shows what a mess Acq API is
909 my ( $schema, $budget_code ) = @_;
910 my $period_rs = $schema->resultset('Aqbudgetperiod')->search(
912 budget_period_active
=> 1,
916 # db does not ensure budget code is unque
917 return $schema->resultset('Aqbudget')->single(
919 budget_code
=> $budget_code,
921 { -in => $period_rs->get_column('budget_period_id')->as_query },
926 # try to get title level classification from incoming quote
927 sub title_level_class
{
930 my $default_scheme = C4
::Context
->preference('DefaultClassificationSource');
931 if ( $default_scheme eq 'ddc' ) {
932 $class = $item->dewey_class();
934 elsif ( $default_scheme eq 'lcc' ) {
935 $class = $item->lc_class();
939 $item->girfield('shelfmark')
940 || $item->girfield('classification')
946 sub _create_bib_from_quote
{
948 #TBD we should flag this for updating from an external source
949 #As biblio (&biblioitems) has no candidates flag in order
950 my ( $item, $quote ) = @_;
951 my $itemid = $item->item_number_id;
952 my $defalt_classification_source =
953 C4
::Context
->preference('DefaultClassificationSource');
955 'biblioitems.cn_source' => $defalt_classification_source,
956 'items.cn_source' => $defalt_classification_source,
957 'items.notforloan' => -1,
958 'items.cn_sort' => q{},
960 $bib_hash->{'biblio.seriestitle'} = $item->series;
962 $bib_hash->{'biblioitems.publishercode'} = $item->publisher;
963 $bib_hash->{'biblioitems.publicationyear'} =
964 $bib_hash->{'biblio.copyrightdate'} = $item->publication_date;
966 $bib_hash->{'biblio.title'} = $item->title;
967 $bib_hash->{'biblio.author'} = $item->author;
968 $bib_hash->{'biblioitems.isbn'} = $item->item_number_id;
969 $bib_hash->{'biblioitems.itemtype'} = $item->girfield('stock_category');
971 # If we have a 13 digit id we are assuming its an ean
972 # (it may also be an isbn or issn)
973 if ( $itemid =~ /^\d{13}$/ ) {
974 $bib_hash->{'biblioitems.ean'} = $itemid;
975 if ( $itemid =~ /^977/ ) {
976 $bib_hash->{'biblioitems.issn'} = $itemid;
979 for my $key ( keys %{$bib_hash} ) {
980 if ( !defined $bib_hash->{$key} ) {
981 delete $bib_hash->{$key};
984 return TransformKohaToMarc
($bib_hash);
988 sub _create_item_from_quote
{
989 my ( $item, $quote ) = @_;
990 my $defalt_classification_source =
991 C4
::Context
->preference('DefaultClassificationSource');
993 cn_source
=> $defalt_classification_source,
997 $item_hash->{booksellerid
} = $quote->vendor_id;
998 $item_hash->{price
} = $item_hash->{replacementprice
} = $item->price;
999 $item_hash->{itype
} = $item->girfield('stock_category');
1000 $item_hash->{location
} = $item->girfield('collection_code');
1004 $item_hash->{itemcallnumber
} =
1005 $item->girfield('shelfmark')
1006 || $item->girfield('classification')
1007 || title_level_class
($item);
1009 my $branch = $item->girfield('branch');
1010 $item_hash->{holdingbranch
} = $item_hash->{homebranch
} = $branch;
1023 Module exporting subroutines used in EDI processing for Koha
1027 Subroutines called by batch processing to handle Edifact
1028 messages of various types and related utilities
1032 These routines should really be methods of some object.
1033 get_edifact_ean is a stopgap which should be replaced
1037 =head2 process_quote
1039 process_quote(quote_message);
1041 passed a message object for a quote, parses it creating an order basket
1042 and orderlines in the database
1043 updates the message's status to received in the database and adds the
1046 =head2 process_invoice
1048 process_invoice(invoice_message)
1050 passed a message object for an invoice, add the contained invoices
1051 and update the orderlines referred to in the invoice
1052 As an Edifact invoice is in effect a despatch note this receipts the
1053 appropriate quantities in the orders
1055 no meaningful return value
1057 =head2 process_ordrsp
1059 process_ordrsp(ordrsp_message)
1061 passed a message object for a supplier response, process the contents
1062 If an orderline is cancelled cancel the corresponding orderline in koha
1063 otherwise record the supplier message against it
1065 no meaningful return value
1067 =head2 create_edi_order
1069 create_edi_order( { parameter_hashref } )
1071 parameters must include basketno and ean
1073 branchcode can optionally be passed
1075 returns 1 on success undef otherwise
1077 if the parameter noingest is set the formatted order is returned
1078 and not saved in the database. This functionality is intended for debugging only
1080 =head2 receipt_items
1082 receipt_items( schema_obj, invoice_line, ordernumber)
1084 receipts the items recorded on this invoice line
1086 no meaningful return
1088 =head2 transfer_items
1090 transfer_items(schema, invoice_line, originating_order, receiving_order)
1092 Transfer the items covered by this invoice line from their original
1093 order to another order recording the partial fulfillment of the original
1096 no meaningful return
1098 =head2 get_edifact_ean
1100 $ean = get_edifact_ean();
1102 routine to return the ean.
1106 quote_item(lineitem, quote_message);
1108 Called by process_quote to handle an individual lineitem
1109 Generate the biblios and items if required and orderline linking to them
1111 Returns 1 on success undef on error
1113 Most usual cause of error is a line with no or incorrect budget codes
1114 which woild cause order creation to abort
1115 If other correct lines exist these are processed and the erroneous line os logged
1117 =head2 title_level_class
1119 classmark = title_level_class(edi_item)
1121 Trys to return a title level classmark from a quote message line
1122 Will return a dewey or lcc classmark if one exists according to the
1123 value in DefaultClassificationSource syspref
1125 If unable to returns the shelfmark or classification from the GIR segment
1127 If all else fails returns empty string
1129 =head2 _create_bib_from_quote
1131 marc_record_obj = _create_bib_from_quote(lineitem, quote)
1133 Returns a MARC::Record object based on the info in the quote's lineitem
1135 =head2 _create_item_from_quote
1137 item_hashref = _create_item_from_quote( lineitem, quote)
1139 returns a hashref representing the item fields specified in the quote
1141 =head2 _get_invoiced_price
1143 _get_invoiced_price(line_object)
1145 Returns the net price or an equivalent calculated from line cost / qty
1147 =head2 _discounted_price
1149 ecost = _discounted_price(discount, item_price)
1151 utility subroutine to return a price calculated from the
1152 vendors discount and quoted price
1154 =head2 _check_for_existing_bib
1156 (biblionumber, biblioitemnumber) = _check_for_existing_bib(isbn_or_ean)
1158 passed an isbn or ean attempts to locate a match bib
1159 On success returns biblionumber and biblioitemnumber
1160 On failure returns undefined/an empty list
1164 b = _get_budget(schema_obj, budget_code)
1166 Returns the Aqbudget object for the active budget given the passed budget_code
1167 or undefined if one does not exist
1171 Colin Campbell <colin.campbell@ptfs-europe.com>
1176 Copyright 2014,2015 PTFS-Europe Ltd
1177 This program is free software, You may redistribute it under
1178 under the terms of the GNU General Public License