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 under the
11 # terms of the GNU General Public License as published by the Free Software
12 # Foundation; either version 2 of the License, or (at your option) any later
15 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
16 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
17 # A PARTICULAR PURPOSE. See the GNU General Public License for more details.
19 # You should have received a copy of the GNU General Public License along
20 # with Koha; if not, write to the Free Software Foundation, Inc.,
21 # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
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
81 use C4::Suggestions; # GetSuggestion
82 use C4::Biblio; # GetBiblioData GetMarcPrice
83 use C4::Items; #PrepareItemRecord
87 use C4::Branch; # GetBranches
89 use C4::Search qw/FindDuplicate/;
91 #needed for z3950 import:
92 use C4::ImportBatch qw/GetImportRecordMarc SetImportRecordStatus/;
94 use Koha::Acquisition::Bookseller;
97 my $booksellerid = $input->param('booksellerid'); # FIXME: else ERROR!
98 my $budget_id = $input->param('budget_id') || 0;
99 my $title = $input->param('title');
100 my $author = $input->param('author');
101 my $publicationyear = $input->param('publicationyear');
102 my $ordernumber = $input->param('ordernumber') || '';
103 our $biblionumber = $input->param('biblionumber');
104 our $basketno = $input->param('basketno');
105 my $suggestionid = $input->param('suggestionid');
106 my $close = $input->param('close');
107 my $uncertainprice = $input->param('uncertainprice');
108 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 !
109 my $subscriptionid = $input->param('subscriptionid');
115 our ( $template, $loggedinuser, $cookie, $userflags ) = get_template_and_user(
117 template_name => "acqui/neworderempty.tt",
120 authnotrequired => 0,
121 flagsrequired => { acquisition => 'order_manage' },
126 our $marcflavour = C4::Context->preference('marcflavour');
129 my $order = GetOrder($ordernumber);
130 $basketno = $order->{'basketno'};
133 our $basket = GetBasket($basketno);
134 $booksellerid = $basket->{booksellerid} unless $booksellerid;
135 my $bookseller = Koha::Acquisition::Bookseller->fetch({ id => $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 him choose between using new record or 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 if ( $ordernumber eq '' ) { # create order
180 # $ordernumber=newordernum;
181 if ( $biblionumber && !$suggestionid ) {
182 $data = GetBiblioData($biblionumber);
185 # get suggestion fields if applicable. If it's a subscription renewal, then the biblio already exists
186 # otherwise, retrieve suggestion information.
188 $data = ($biblionumber) ? GetBiblioData($biblionumber) : GetSuggestion($suggestionid);
189 $budget_id ||= $data->{'budgetid'} // 0;
193 $data = GetOrder($ordernumber);
194 $biblionumber = $data->{'biblionumber'};
195 $budget_id = $data->{'budget_id'};
197 $basket = GetBasket( $data->{'basketno'} );
198 $basketno = $basket->{'basketno'};
202 $suggestion = GetSuggestionInfo($suggestionid) if $suggestionid;
204 # get currencies (for change rates calcs if needed)
205 my $active_currency = GetCurrency();
206 my $default_currency;
207 if (! $data->{currency} ) { # New order no currency set
208 if ( $bookseller->{listprice} ) {
209 $default_currency = $bookseller->{listprice};
212 $default_currency = $active_currency->{currency};
216 my @rates = GetCurrencies();
220 my @loop_currency = ();
221 for my $curr ( @rates ) {
223 if ($data->{currency} ) {
224 $selected = $curr->{currency} eq $data->{currency};
227 $selected = $curr->{currency} eq $default_currency;
229 push @loop_currency, {
230 currcode => $curr->{currency},
231 rate => $curr->{rate},
232 selected => $selected,
236 # build branches list
238 C4::Context->preference('IndependentBranches')
239 && C4::Context->userenv
240 && !C4::Context->IsSuperLibrarian()
241 && C4::Context->userenv->{branch};
242 my $branches = GetBranches($onlymine);
244 foreach my $thisbranch ( sort {$branches->{$a}->{'branchname'} cmp $branches->{$b}->{'branchname'}} keys %$branches ) {
246 value => $thisbranch,
247 branchname => $branches->{$thisbranch}->{'branchname'},
249 $row{'selected'} = 1 if( $thisbranch && $data->{branchcode} && $thisbranch eq $data->{branchcode}) ;
250 push @branchloop, \%row;
252 $template->param( branchloop => \@branchloop );
254 # build bookfund list
255 my $borrower= GetMember('borrowernumber' => $loggedinuser);
256 my ( $flags, $homebranch )= ($borrower->{'flags'},$borrower->{'branchcode'});
258 my $budget = GetBudget($budget_id);
260 my $budget_loop = [];
261 my $budgets = GetBudgetHierarchy;
262 foreach my $r (@{$budgets}) {
263 next unless (CanUserUseBudget($borrower, $r, $userflags));
264 if (!defined $r->{budget_amount} || $r->{budget_amount} == 0) {
267 push @{$budget_loop}, {
268 b_id => $r->{budget_id},
269 b_txt => $r->{budget_name},
270 b_sort1_authcat => $r->{'sort1_authcat'},
271 b_sort2_authcat => $r->{'sort2_authcat'},
272 b_active => $r->{budget_period_active},
273 b_sel => ( $r->{budget_id} == $budget_id ) ? 1 : 0,
278 sort { uc( $a->{b_txt}) cmp uc( $b->{b_txt}) } @{$budget_loop};
281 $budget_id = $data->{'budget_id'};
282 $budget_name = $budget->{'budget_name'};
286 $template->param( sort1 => $data->{'sort1'} );
287 $template->param( sort2 => $data->{'sort2'} );
289 if (C4::Context->preference('AcqCreateItem') eq 'ordering' && !$ordernumber) {
290 # Check if ACQ framework exists
291 my $marc = GetMarcStructure(1, 'ACQ');
293 $template->param('NoACQframework' => 1);
296 AcqCreateItemOrdering => 1,
297 UniqueItemFields => C4::Context->preference('UniqueItemFields'),
300 # 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
302 @itemtypes = C4::ItemType->all unless C4::Context->preference('item-level_itypes');
304 if ( defined $subscriptionid ) {
305 my $lastOrderReceived = GetLastOrderReceivedFromSubscriptionid $subscriptionid;
306 if ( defined $lastOrderReceived ) {
307 $budget_id = $lastOrderReceived->{budgetid};
308 $data->{listprice} = $lastOrderReceived->{listprice};
309 $data->{uncertainprice} = $lastOrderReceived->{uncertainprice};
310 $data->{gstrate} = $lastOrderReceived->{gstrate};
311 $data->{discount} = $lastOrderReceived->{discount};
312 $data->{rrp} = $lastOrderReceived->{rrp};
313 $data->{ecost} = $lastOrderReceived->{ecost};
314 $data->{quantity} = $lastOrderReceived->{quantity};
315 $data->{unitprice} = $lastOrderReceived->{unitprice};
316 $data->{order_internalnote} = $lastOrderReceived->{order_internalnote};
317 $data->{order_vendornote} = $lastOrderReceived->{order_vendornote};
318 $data->{sort1} = $lastOrderReceived->{sort1};
319 $data->{sort2} = $lastOrderReceived->{sort2};
321 $basket = GetBasket( $input->param('basketno') );
325 # Find the items.barcode subfield for barcode validations
326 my (undef, $barcode_subfield) = GetMarcFromKohaField('items.barcode', '');
331 budget_id => $budget_id,
332 budget_name => $budget_name
335 # get option values for gist syspref
336 my @gst_values = map {
338 }, split( '\|', C4::Context->preference("gist") );
340 my $quantity = $input->param('rr_quantity_to_order') ?
341 $input->param('rr_quantity_to_order') :
346 existing => $biblionumber,
347 ordernumber => $ordernumber,
348 # basket informations
349 basketno => $basketno,
350 basketname => $basket->{'basketname'},
351 basketnote => $basket->{'note'},
352 booksellerid => $basket->{'booksellerid'},
353 basketbooksellernote => $basket->{booksellernote},
354 basketcontractno => $basket->{contractnumber},
355 basketcontractname => $contract->{contractname},
356 creationdate => $basket->{creationdate},
357 authorisedby => $basket->{'authorisedby'},
358 authorisedbyname => $basket->{'authorisedbyname'},
359 closedate => $basket->{'closedate'},
361 suggestionid => $suggestion->{suggestionid},
362 surnamesuggestedby => $suggestion->{surnamesuggestedby},
363 firstnamesuggestedby => $suggestion->{firstnamesuggestedby},
364 biblionumber => $biblionumber,
365 uncertainprice => $data->{'uncertainprice'},
366 authorisedbyname => $borrower->{'firstname'} . " " . $borrower->{'surname'},
367 discount_2dp => sprintf( "%.2f", $bookseller->{'discount'} ) , # for display
368 discount => $bookseller->{'discount'},
369 orderdiscount_2dp => sprintf( "%.2f", $data->{'discount'} || 0 ),
370 orderdiscount => $data->{'discount'},
371 order_internalnote => $data->{'order_internalnote'},
372 order_vendornote => $data->{'order_vendornote'},
373 listincgst => $bookseller->{'listincgst'},
374 invoiceincgst => $bookseller->{'invoiceincgst'},
375 name => $bookseller->{'name'},
376 cur_active_sym => $active_currency->{'symbol'},
377 cur_active => $active_currency->{'currency'},
378 loop_currencies => \@loop_currency,
379 orderexists => ( $new eq 'yes' ) ? 0 : 1,
380 title => $data->{'title'},
381 author => $data->{'author'},
382 publicationyear => $data->{'publicationyear'} ? $data->{'publicationyear'} : $data->{'copyrightdate'},
383 editionstatement => $data->{'editionstatement'},
384 budget_loop => $budget_loop,
385 isbn => $data->{'isbn'},
386 ean => $data->{'ean'},
387 seriestitle => $data->{'seriestitle'},
388 itemtypeloop => \@itemtypes,
389 quantity => $quantity,
390 quantityrec => $quantity,
391 rrp => $data->{'rrp'},
392 gst_values => \@gst_values,
393 gstrate => $data->{gstrate} ? $data->{gstrate}+0.0 : $bookseller->{gstrate} ? $bookseller->{gstrate}+0.0 : 0,
394 listprice => sprintf( "%.2f", $data->{listprice} || $data->{price} || $listprice),
395 total => sprintf( "%.2f", ($data->{ecost} || 0) * ($data->{'quantity'} || 0) ),
396 ecost => sprintf( "%.2f", $data->{ecost} || 0),
397 unitprice => sprintf( "%.2f", $data->{unitprice} || 0),
398 publishercode => $data->{'publishercode'},
399 barcode_subfield => $barcode_subfield,
400 import_batch_id => $import_batch_id,
401 subscriptionid => $subscriptionid,
402 acqcreate => C4::Context->preference("AcqCreateItem") eq "ordering" ? 1 : "",
403 (uc(C4::Context->preference("marcflavour"))) => 1
406 output_html_with_http_headers $input, $cookie, $template->output;
409 =head2 MARCfindbreeding
411 $record = MARCfindbreeding($breedingid);
413 Look up the import record repository for the record with
414 record with id $breedingid. If found, returns the decoded
415 MARC::Record; otherwise, -1 is returned (FIXME).
416 Returns as second parameter the character encoding.
420 sub MARCfindbreeding {
422 my ($marc, $encoding) = GetImportRecordMarc($id);
423 # remove the - in isbn, koha store isbn without any -
425 my $record = MARC::Record->new_from_usmarc($marc);
426 my ($isbnfield,$isbnsubfield) = GetMarcFromKohaField('biblioitems.isbn','');
427 if ( $record->field($isbnfield) ) {
428 foreach my $field ( $record->field($isbnfield) ) {
429 foreach my $subfield ( $field->subfield($isbnsubfield) ) {
430 my $newisbn = $field->subfield($isbnsubfield);
432 $field->update( $isbnsubfield => $newisbn );
436 # fix the unimarc 100 coded field (with unicode information)
437 if ($marcflavour eq 'UNIMARC' && $record->subfield(100,'a')) {
438 my $f100a=$record->subfield(100,'a');
439 my $f100 = $record->field(100);
440 my $f100temp = $f100->as_string;
441 $record->delete_field($f100);
442 if ( length($f100temp) > 28 ) {
443 substr( $f100temp, 26, 2, "50" );
444 $f100->update( 'a' => $f100temp );
445 my $f100 = MARC::Field->new( '100', '', '', 'a' => $f100temp );
446 $record->insert_fields_ordered($f100);
450 if ( !defined(ref($record)) ) {
454 # normalize author : probably UNIMARC specific...
455 if ( C4::Context->preference("z3950NormalizeAuthor")
456 and C4::Context->preference("z3950AuthorAuthFields") )
458 my ( $tag, $subfield ) = GetMarcFromKohaField("biblio.author", '');
460 # my $summary = C4::Context->preference("z3950authortemplate");
462 C4::Context->preference("z3950AuthorAuthFields");
463 my @auth_fields = split /,/, $auth_fields;
466 if ( $record->field($tag) ) {
467 foreach my $tmpfield ( $record->field($tag)->subfields ) {
469 # foreach my $subfieldcode ($tmpfield->subfields){
470 my $subfieldcode = shift @$tmpfield;
471 my $subfieldvalue = shift @$tmpfield;
473 $field->add_subfields(
474 "$subfieldcode" => $subfieldvalue )
475 if ( $subfieldcode ne $subfield );
479 MARC::Field->new( $tag, "", "",
480 $subfieldcode => $subfieldvalue )
481 if ( $subfieldcode ne $subfield );
485 $record->delete_field( $record->field($tag) );
486 foreach my $fieldtag (@auth_fields) {
487 next unless ( $record->field($fieldtag) );
488 my $lastname = $record->field($fieldtag)->subfield('a');
489 my $firstname = $record->field($fieldtag)->subfield('b');
490 my $title = $record->field($fieldtag)->subfield('c');
491 my $number = $record->field($fieldtag)->subfield('d');
494 # $field->add_subfields("$subfield"=>"[ ".ucfirst($title).ucfirst($firstname)." ".$number." ]");
495 $field->add_subfields(
496 "$subfield" => ucfirst($title) . " "
497 . ucfirst($firstname) . " "
502 # $field->add_subfields("$subfield"=>"[ ".ucfirst($firstname).", ".ucfirst($lastname)." ]");
503 $field->add_subfields(
504 "$subfield" => ucfirst($firstname) . ", "
505 . ucfirst($lastname) );
508 $record->insert_fields_ordered($field);
510 return $record, $encoding;
517 my ($duplicatetitle)= @_;
518 ($template, $loggedinuser, $cookie) = get_template_and_user(
520 template_name => "acqui/neworderempty_duplicate.tt",
523 authnotrequired => 0,
524 flagsrequired => { acquisition => 'order_manage' },
530 biblionumber => $biblionumber,
531 basketno => $basketno,
532 booksellerid => $basket->{'booksellerid'},
533 breedingid => $params->{'breedingid'},
534 duplicatetitle => $duplicatetitle,
535 (uc(C4::Context->preference("marcflavour"))) => 1
538 output_html_with_http_headers $input, $cookie, $template->output;