3 #script to show display basket of orders
4 #written by chris@katipo.co.nz 24/2/2000
6 # Copyright 2000-2002 Katipo Communications
8 # This file is part of Koha.
10 # Koha is free software; you can redistribute it and/or modify it
11 # under the terms of the GNU General Public License as published by
12 # the Free Software Foundation; either version 3 of the License, or
13 # (at your option) any later version.
15 # Koha is distributed in the hope that it will be useful, but
16 # WITHOUT ANY WARRANTY; without even the implied warranty of
17 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 # GNU General Public License for more details.
20 # You should have received a copy of the GNU General Public License
21 # along with Koha; if not, see <http://www.gnu.org/licenses>.
30 this script allows to create a new record to order it. This record shouldn't exist
38 the bookseller the librarian has to buy a new book.
41 the title of this new record.
44 the author of this new record.
46 =item publication year
47 the publication year of this new record.
50 the number of this order.
55 the basket number for this new order.
58 if this order comes from a suggestion.
61 the item's id in the breeding reservoir
79 use C4::Suggestions; # GetSuggestion
80 use C4::Biblio; # GetBiblioData GetMarcPrice
81 use C4::Items; #PrepareItemRecord
85 use C4::Search qw/FindDuplicate/;
87 #needed for z3950 import:
88 use C4::ImportBatch qw/GetImportRecordMarc SetImportRecordStatus/;
90 use Koha::Acquisition::Booksellers;
91 use Koha::Acquisition::Currencies;
96 my $booksellerid = $input->param('booksellerid'); # FIXME: else ERROR!
97 my $budget_id = $input->param('budget_id') || 0;
98 my $title = $input->param('title');
99 my $author = $input->param('author');
100 my $publicationyear = $input->param('publicationyear');
101 my $ordernumber = $input->param('ordernumber') || '';
102 our $biblionumber = $input->param('biblionumber');
103 our $basketno = $input->param('basketno');
104 my $suggestionid = $input->param('suggestionid');
105 my $close = $input->param('close');
106 my $uncertainprice = $input->param('uncertainprice');
107 my $import_batch_id = $input->param('import_batch_id'); # if this is filled, we come from a staged file, and we will return here after saving the order !
108 my $from_subscriptionid = $input->param('from_subscriptionid');
114 our ( $template, $loggedinuser, $cookie, $userflags ) = get_template_and_user(
116 template_name => "acqui/neworderempty.tt",
119 authnotrequired => 0,
120 flagsrequired => { acquisition => 'order_manage' },
125 our $marcflavour = C4::Context->preference('marcflavour');
128 my $order = GetOrder($ordernumber);
129 $basketno = $order->{'basketno'};
132 our $basket = GetBasket($basketno);
133 my $basketobj = Koha::Acquisition::Baskets->find( $basketno );
134 $booksellerid = $basket->{booksellerid} unless $booksellerid;
135 my $bookseller = Koha::Acquisition::Booksellers->find( $booksellerid );
137 my $contract = GetContract({
138 contractnumber => $basket->{contractnumber}
141 #simple parameters reading (all in one :-)
142 our $params = $input->Vars;
143 my $listprice=0; # the price, that can be in MARC record if we have one
144 if ( $ordernumber eq '' and defined $params->{'breedingid'}){
145 #we want to import from the breeding reservoir (from a z3950 search)
146 my ($marcrecord, $encoding) = MARCfindbreeding($params->{'breedingid'});
147 die("Could not find the selected record in the reservoir, bailing") unless $marcrecord;
149 # Remove all the items (952) from the imported record
150 foreach my $item ($marcrecord->field('952')) {
151 $marcrecord->delete_field($item);
156 ($biblionumber,$duplicatetitle) = FindDuplicate($marcrecord);
157 if($biblionumber && !$input->param('use_external_source')) {
158 #if duplicate record found and user did not decide yet, first warn user
159 #and let them choose between using a new record or an existing record
160 Load_Duplicate($duplicatetitle);
163 #from this point: add a new record
164 if (C4::Context->preference("BiblioAddsAuthorities")){
165 my $headings_linked=BiblioAutoLink($marcrecord, $params->{'frameworkcode'});
168 $params->{'frameworkcode'} or $params->{'frameworkcode'} = "";
169 ( $biblionumber, $bibitemnum ) = AddBiblio( $marcrecord, $params->{'frameworkcode'} );
170 # get the price if there is one.
171 $listprice = GetMarcPrice($marcrecord, $marcflavour);
172 SetImportRecordStatus($params->{'breedingid'}, 'imported');
177 my ( @order_user_ids, @order_users );
178 if ( $ordernumber eq '' ) { # create order
181 # $ordernumber=newordernum;
182 if ( $biblionumber && !$suggestionid ) {
183 $data = GetBiblioData($biblionumber);
186 # get suggestion fields if applicable. If it's a subscription renewal, then the biblio already exists
187 # otherwise, retrieve suggestion information.
189 $data = ($biblionumber) ? GetBiblioData($biblionumber) : GetSuggestion($suggestionid);
190 $budget_id ||= $data->{'budgetid'} // 0;
194 $data = GetOrder($ordernumber);
195 $biblionumber = $data->{'biblionumber'};
196 $budget_id = $data->{'budget_id'};
199 subscriptionid => $data->{subscriptionid},
202 $basket = GetBasket( $data->{'basketno'} );
203 $basketno = $basket->{'basketno'};
205 @order_user_ids = GetOrderUsers($ordernumber);
206 foreach my $order_user_id (@order_user_ids) {
207 # FIXME Could be improved with search -in
208 my $order_patron = Koha::Patrons->find( $order_user_id );
209 push @order_users, $order_patron if $order_patron;
214 $suggestion = GetSuggestionInfo($suggestionid) if $suggestionid;
216 my @currencies = Koha::Acquisition::Currencies->search;
217 my $active_currency = Koha::Acquisition::Currencies->get_active;
219 # build bookfund list
220 my $patron = Koha::Patrons->find( $loggedinuser )->unblessed;
222 my $budget = GetBudget($budget_id);
224 my $budget_loop = [];
225 my $budgets = GetBudgetHierarchy;
226 foreach my $r (@{$budgets}) {
227 next unless (CanUserUseBudget($patron, $r, $userflags));
228 if (!defined $r->{budget_amount} || $r->{budget_amount} <0) {
231 push @{$budget_loop}, {
232 b_id => $r->{budget_id},
233 b_txt => $r->{budget_name},
234 b_sort1_authcat => $r->{'sort1_authcat'},
235 b_sort2_authcat => $r->{'sort2_authcat'},
236 b_active => $r->{budget_period_active},
237 b_sel => ( $r->{budget_id} == $budget_id ) ? 1 : 0,
238 b_level => $r->{budget_level},
243 $budget_id = $data->{'budget_id'};
244 $budget_name = $budget->{'budget_name'};
248 $template->param( sort1 => $data->{'sort1'} );
249 $template->param( sort2 => $data->{'sort2'} );
251 if ($basketobj->effective_create_items eq 'ordering' && !$ordernumber) {
252 # Check if ACQ framework exists
253 my $marc = GetMarcStructure(1, 'ACQ', { unsafe => 1 } );
255 $template->param('NoACQframework' => 1);
258 AcqCreateItemOrdering => 1,
259 UniqueItemFields => C4::Context->preference('UniqueItemFields'),
262 # Get the item types list, but only if item_level_itype is YES. Otherwise, it will be in the item, no need to display it in the biblio
264 @itemtypes = Koha::ItemTypes->search unless C4::Context->preference('item-level_itypes');
266 if ( defined $from_subscriptionid ) {
267 my $lastOrderReceived = GetLastOrderReceivedFromSubscriptionid $from_subscriptionid;
268 if ( defined $lastOrderReceived ) {
269 $budget_id = $lastOrderReceived->{budgetid};
270 $data->{listprice} = $lastOrderReceived->{listprice};
271 $data->{uncertainprice} = $lastOrderReceived->{uncertainprice};
272 $data->{tax_rate} = $lastOrderReceived->{tax_rate_on_ordering};
273 $data->{discount} = $lastOrderReceived->{discount};
274 $data->{rrp} = $lastOrderReceived->{rrp};
275 $data->{ecost} = $lastOrderReceived->{ecost};
276 $data->{quantity} = $lastOrderReceived->{quantity};
277 $data->{unitprice} = $lastOrderReceived->{unitprice};
278 $data->{order_internalnote} = $lastOrderReceived->{order_internalnote};
279 $data->{order_vendornote} = $lastOrderReceived->{order_vendornote};
280 $data->{sort1} = $lastOrderReceived->{sort1};
281 $data->{sort2} = $lastOrderReceived->{sort2};
283 $basket = GetBasket( $input->param('basketno') );
286 $template->param( subscriptionid => $from_subscriptionid );
289 # Find the items.barcode subfield for barcode validations
290 my (undef, $barcode_subfield) = GetMarcFromKohaField('items.barcode', '');
295 budget_id => $budget_id,
296 budget_name => $budget_name
299 # get option values for gist syspref
300 my @gst_values = map {
302 }, split( '\|', C4::Context->preference("gist") );
304 my $quantity = $input->param('rr_quantity_to_order') ?
305 $input->param('rr_quantity_to_order') :
310 existing => $biblionumber,
311 ordernumber => $ordernumber,
312 # basket informations
313 basketno => $basketno,
315 basketname => $basket->{'basketname'},
316 basketnote => $basket->{'note'},
317 booksellerid => $basket->{'booksellerid'},
318 basketbooksellernote => $basket->{booksellernote},
319 basketcontractno => $basket->{contractnumber},
320 basketcontractname => $contract->{contractname},
321 creationdate => $basket->{creationdate},
322 authorisedby => $basket->{'authorisedby'},
323 authorisedbyname => $basket->{'authorisedbyname'},
324 closedate => $basket->{'closedate'},
326 suggestionid => $suggestion->{suggestionid},
327 surnamesuggestedby => $suggestion->{surnamesuggestedby},
328 firstnamesuggestedby => $suggestion->{firstnamesuggestedby},
329 biblionumber => $biblionumber,
330 uncertainprice => $data->{'uncertainprice'},
331 discount_2dp => sprintf( "%.2f", $bookseller->discount ) , # for display
332 discount => $bookseller->discount,
333 orderdiscount_2dp => sprintf( "%.2f", $data->{'discount'} || 0 ),
334 orderdiscount => $data->{'discount'},
335 order_internalnote => $data->{'order_internalnote'},
336 order_vendornote => $data->{'order_vendornote'},
337 listincgst => $bookseller->listincgst,
338 invoiceincgst => $bookseller->invoiceincgst,
339 name => $bookseller->name,
340 cur_active_sym => $active_currency->symbol,
341 cur_active => $active_currency->currency,
342 currencies => \@currencies,
343 currency => $data->{currency},
344 vendor_currency => $bookseller->listprice,
345 orderexists => ( $new eq 'yes' ) ? 0 : 1,
346 title => $data->{'title'},
347 author => $data->{'author'},
348 publicationyear => $data->{'publicationyear'} ? $data->{'publicationyear'} : $data->{'copyrightdate'},
349 editionstatement => $data->{'editionstatement'},
350 budget_loop => $budget_loop,
351 isbn => $data->{'isbn'},
352 ean => $data->{'ean'},
353 seriestitle => $data->{'seriestitle'},
354 itemtypeloop => \@itemtypes,
355 quantity => $quantity,
356 quantityrec => $quantity,
357 rrp => $data->{'rrp'},
358 gst_values => \@gst_values,
359 tax_rate => $data->{tax_rate_on_ordering} ? $data->{tax_rate_on_ordering}+0.0 : $bookseller->tax_rate ? $bookseller->tax_rate+0.0 : 0,
360 listprice => sprintf( "%.2f", $data->{listprice} || $data->{price} || $listprice),
361 total => sprintf( "%.2f", ($data->{ecost} || 0) * ($data->{'quantity'} || 0) ),
362 ecost => sprintf( "%.2f", $data->{ecost} || 0),
363 unitprice => sprintf( "%.2f", $data->{unitprice} || 0),
364 publishercode => $data->{'publishercode'},
365 barcode_subfield => $barcode_subfield,
366 import_batch_id => $import_batch_id,
367 acqcreate => $basketobj->effective_create_items eq "ordering" ? 1 : "",
368 users_ids => join(':', @order_user_ids),
369 users => \@order_users,
370 (uc(C4::Context->preference("marcflavour"))) => 1
373 output_html_with_http_headers $input, $cookie, $template->output;
376 =head2 MARCfindbreeding
378 $record = MARCfindbreeding($breedingid);
380 Look up the import record repository for the record with
381 record with id $breedingid. If found, returns the decoded
382 MARC::Record; otherwise, -1 is returned (FIXME).
383 Returns as second parameter the character encoding.
387 sub MARCfindbreeding {
389 my ($marc, $encoding) = GetImportRecordMarc($id);
390 # remove the - in isbn, koha store isbn without any -
392 my $record = MARC::Record->new_from_usmarc($marc);
393 my ($isbnfield,$isbnsubfield) = GetMarcFromKohaField('biblioitems.isbn','');
394 if ( $record->field($isbnfield) ) {
395 foreach my $field ( $record->field($isbnfield) ) {
396 foreach my $subfield ( $field->subfield($isbnsubfield) ) {
397 my $newisbn = $field->subfield($isbnsubfield);
399 $field->update( $isbnsubfield => $newisbn );
403 # fix the unimarc 100 coded field (with unicode information)
404 if ($marcflavour eq 'UNIMARC' && $record->subfield(100,'a')) {
405 my $f100a=$record->subfield(100,'a');
406 my $f100 = $record->field(100);
407 my $f100temp = $f100->as_string;
408 $record->delete_field($f100);
409 if ( length($f100temp) > 28 ) {
410 substr( $f100temp, 26, 2, "50" );
411 $f100->update( 'a' => $f100temp );
412 my $f100 = MARC::Field->new( '100', '', '', 'a' => $f100temp );
413 $record->insert_fields_ordered($f100);
417 if ( !defined(ref($record)) ) {
421 # normalize author : probably UNIMARC specific...
422 if ( C4::Context->preference("z3950NormalizeAuthor")
423 and C4::Context->preference("z3950AuthorAuthFields") )
425 my ( $tag, $subfield ) = GetMarcFromKohaField("biblio.author", '');
427 # my $summary = C4::Context->preference("z3950authortemplate");
429 C4::Context->preference("z3950AuthorAuthFields");
430 my @auth_fields = split /,/, $auth_fields;
433 if ( $record->field($tag) ) {
434 foreach my $tmpfield ( $record->field($tag)->subfields ) {
436 # foreach my $subfieldcode ($tmpfield->subfields){
437 my $subfieldcode = shift @$tmpfield;
438 my $subfieldvalue = shift @$tmpfield;
440 $field->add_subfields(
441 "$subfieldcode" => $subfieldvalue )
442 if ( $subfieldcode ne $subfield );
446 MARC::Field->new( $tag, "", "",
447 $subfieldcode => $subfieldvalue )
448 if ( $subfieldcode ne $subfield );
452 $record->delete_field( $record->field($tag) );
453 foreach my $fieldtag (@auth_fields) {
454 next unless ( $record->field($fieldtag) );
455 my $lastname = $record->field($fieldtag)->subfield('a');
456 my $firstname = $record->field($fieldtag)->subfield('b');
457 my $title = $record->field($fieldtag)->subfield('c');
458 my $number = $record->field($fieldtag)->subfield('d');
461 # $field->add_subfields("$subfield"=>"[ ".ucfirst($title).ucfirst($firstname)." ".$number." ]");
462 $field->add_subfields(
463 "$subfield" => ucfirst($title) . " "
464 . ucfirst($firstname) . " "
469 # $field->add_subfields("$subfield"=>"[ ".ucfirst($firstname).", ".ucfirst($lastname)." ]");
470 $field->add_subfields(
471 "$subfield" => ucfirst($firstname) . ", "
472 . ucfirst($lastname) );
475 $record->insert_fields_ordered($field);
477 return $record, $encoding;
484 my ($duplicatetitle)= @_;
485 ($template, $loggedinuser, $cookie) = get_template_and_user(
487 template_name => "acqui/neworderempty_duplicate.tt",
490 authnotrequired => 0,
491 flagsrequired => { acquisition => 'order_manage' },
497 biblionumber => $biblionumber,
498 basketno => $basketno,
499 booksellerid => $basket->{'booksellerid'},
500 breedingid => $params->{'breedingid'},
501 duplicatetitle => $duplicatetitle,
502 (uc(C4::Context->preference("marcflavour"))) => 1
505 output_html_with_http_headers $input, $cookie, $template->output;