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
79 use C4::Bookseller qw/ GetBookSellerFromId /;
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/;
95 my $booksellerid = $input->param('booksellerid'); # FIXME: else ERROR!
96 my $budget_id = $input->param('budget_id') || 0;
97 my $title = $input->param('title');
98 my $author = $input->param('author');
99 my $publicationyear = $input->param('publicationyear');
100 my $ordernumber = $input->param('ordernumber') || '';
101 our $biblionumber = $input->param('biblionumber');
102 our $basketno = $input->param('basketno');
103 my $suggestionid = $input->param('suggestionid');
104 my $close = $input->param('close');
105 my $uncertainprice = $input->param('uncertainprice');
106 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 !
107 my $subscriptionid = $input->param('subscriptionid');
113 our ( $template, $loggedinuser, $cookie, $userflags ) = get_template_and_user(
115 template_name => "acqui/neworderempty.tmpl",
118 authnotrequired => 0,
119 flagsrequired => { acquisition => 'order_manage' },
124 our $marcflavour = C4::Context->preference('marcflavour');
127 my $order = GetOrder($ordernumber);
128 $basketno = $order->{'basketno'};
131 our $basket = GetBasket($basketno);
132 $booksellerid = $basket->{booksellerid} unless $booksellerid;
133 my $bookseller = GetBookSellerFromId($booksellerid);
135 my $contract = &GetContract($basket->{contractnumber});
137 #simple parameters reading (all in one :-)
138 our $params = $input->Vars;
139 my $listprice=0; # the price, that can be in MARC record if we have one
140 if ( $ordernumber eq '' and defined $params->{'breedingid'}){
141 #we want to import from the breeding reservoir (from a z3950 search)
142 my ($marcrecord, $encoding) = MARCfindbreeding($params->{'breedingid'});
143 die("Could not find the selected record in the reservoir, bailing") unless $marcrecord;
145 # Remove all the items (952) from the imported record
146 foreach my $item ($marcrecord->field('952')) {
147 $marcrecord->delete_field($item);
152 ($biblionumber,$duplicatetitle) = FindDuplicate($marcrecord);
153 if($biblionumber && !$input->param('use_external_source')) {
154 #if duplicate record found and user did not decide yet, first warn user
155 #and let him choose between using new record or existing record
156 Load_Duplicate($duplicatetitle);
159 #from this point: add a new record
160 if (C4::Context->preference("BiblioAddsAuthorities")){
161 my $headings_linked=BiblioAutoLink($marcrecord, $params->{'frameworkcode'});
164 $params->{'frameworkcode'} or $params->{'frameworkcode'} = "";
165 ( $biblionumber, $bibitemnum ) = AddBiblio( $marcrecord, $params->{'frameworkcode'} );
166 # get the price if there is one.
167 $listprice = GetMarcPrice($marcrecord, $marcflavour);
168 SetImportRecordStatus($params->{'breedingid'}, 'imported');
173 if ( $ordernumber eq '' ) { # create order
176 # $ordernumber=newordernum;
177 if ( $biblionumber && !$suggestionid ) {
178 $data = GetBiblioData($biblionumber);
181 # get suggestion fields if applicable. If it's a subscription renewal, then the biblio already exists
182 # otherwise, retrieve suggestion information.
184 $data = ($biblionumber) ? GetBiblioData($biblionumber) : GetSuggestion($suggestionid);
188 $data = GetOrder($ordernumber);
189 $biblionumber = $data->{'biblionumber'};
190 $budget_id = $data->{'budget_id'};
192 $basket = GetBasket( $data->{'basketno'} );
193 $basketno = $basket->{'basketno'};
197 $suggestion = GetSuggestionInfo($suggestionid) if $suggestionid;
199 # get currencies (for change rates calcs if needed)
200 my $active_currency = GetCurrency();
201 my $default_currency;
202 if (! $data->{currency} ) { # New order no currency set
203 if ( $bookseller->{listprice} ) {
204 $default_currency = $bookseller->{listprice};
207 $default_currency = $active_currency->{currency};
211 my @rates = GetCurrencies();
215 my @loop_currency = ();
216 for my $curr ( @rates ) {
218 if ($data->{currency} ) {
219 $selected = $curr->{currency} eq $data->{currency};
222 $selected = $curr->{currency} eq $default_currency;
224 push @loop_currency, {
225 currcode => $curr->{currency},
226 rate => $curr->{rate},
227 selected => $selected,
231 # build branches list
232 my $onlymine=C4::Context->preference('IndependantBranches') &&
233 C4::Context->userenv &&
234 C4::Context->userenv->{flags}!=1 &&
235 C4::Context->userenv->{branch};
236 my $branches = GetBranches($onlymine);
238 foreach my $thisbranch ( sort {$branches->{$a}->{'branchname'} cmp $branches->{$b}->{'branchname'}} keys %$branches ) {
240 value => $thisbranch,
241 branchname => $branches->{$thisbranch}->{'branchname'},
243 $row{'selected'} = 1 if( $thisbranch && $data->{branchcode} && $thisbranch eq $data->{branchcode}) ;
244 push @branchloop, \%row;
246 $template->param( branchloop => \@branchloop );
248 # build bookfund list
249 my $borrower= GetMember('borrowernumber' => $loggedinuser);
250 my ( $flags, $homebranch )= ($borrower->{'flags'},$borrower->{'branchcode'});
252 my $budget = GetBudget($budget_id);
254 my $budget_loop = [];
255 my $budgets = GetBudgetHierarchy;
256 foreach my $r (@{$budgets}) {
257 next unless (CanUserUseBudget($borrower, $r, $userflags));
258 if (!defined $r->{budget_amount} || $r->{budget_amount} == 0) {
261 push @{$budget_loop}, {
262 b_id => $r->{budget_id},
263 b_txt => $r->{budget_name},
264 b_active => $r->{budget_period_active},
265 b_sel => ( $r->{budget_id} == $budget_id ) ? 1 : 0,
270 sort { uc( $a->{b_txt}) cmp uc( $b->{b_txt}) } @{$budget_loop};
273 $budget_id = $data->{'budget_id'};
274 $budget_name = $budget->{'budget_name'};
279 if ($budget) { # its a mod ..
280 if ( defined $budget->{'sort1_authcat'} ) { # with custom Asort* planning values
281 $CGIsort1 = GetAuthvalueDropbox( $budget->{'sort1_authcat'}, $data->{'sort1'} );
283 } elsif(@{$budgets}){
284 $CGIsort1 = GetAuthvalueDropbox( @$budgets[0]->{'sort1_authcat'}, '' );
287 # if CGIsort is successfully fetched, the use it
288 # else - failback to plain input-field
290 $template->param( CGIsort1 => $CGIsort1 );
292 $template->param( sort1 => $data->{'sort1'} );
297 if ( defined $budget->{'sort2_authcat'} ) {
298 $CGIsort2 = GetAuthvalueDropbox( $budget->{'sort2_authcat'}, $data->{'sort2'} );
300 } elsif(@{$budgets}) {
301 $CGIsort2 = GetAuthvalueDropbox( @$budgets[0]->{sort2_authcat}, '' );
305 $template->param( CGIsort2 => $CGIsort2 );
307 $template->param( sort2 => $data->{'sort2'} );
310 if (C4::Context->preference('AcqCreateItem') eq 'ordering' && !$ordernumber) {
311 # Check if ACQ framework exists
312 my $marc = GetMarcStructure(1, 'ACQ');
314 $template->param('NoACQframework' => 1);
317 AcqCreateItemOrdering => 1,
318 UniqueItemFields => C4::Context->preference('UniqueItemFields'),
321 # 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
323 @itemtypes = C4::ItemType->all unless C4::Context->preference('item-level_itypes');
325 if ( defined $subscriptionid ) {
326 my $lastOrderReceived = GetLastOrderReceivedFromSubscriptionid $subscriptionid;
327 if ( defined $lastOrderReceived ) {
328 $budget_id = $lastOrderReceived->{budgetid};
329 $data->{listprice} = $lastOrderReceived->{listprice};
330 $data->{uncertainprice} = $lastOrderReceived->{uncertainprice};
331 $data->{gstrate} = $lastOrderReceived->{gstrate};
332 $data->{discount} = $lastOrderReceived->{discount};
333 $data->{rrp} = $lastOrderReceived->{rrp};
334 $data->{ecost} = $lastOrderReceived->{ecost};
335 $data->{quantity} = $lastOrderReceived->{quantity};
336 $data->{unitprice} = $lastOrderReceived->{unitprice};
337 $data->{notes} = $lastOrderReceived->{notes};
338 $data->{sort1} = $lastOrderReceived->{sort1};
339 $data->{sort2} = $lastOrderReceived->{sort2};
341 $basket = GetBasket( $input->param('basketno') );
345 # Find the items.barcode subfield for barcode validations
346 my (undef, $barcode_subfield) = GetMarcFromKohaField('items.barcode', '');
351 budget_id => $budget_id,
352 budget_name => $budget_name
355 # get option values for gist syspref
356 my @gst_values = map {
358 }, split( '\|', C4::Context->preference("gist") );
361 existing => $biblionumber,
362 ordernumber => $ordernumber,
363 # basket informations
364 basketno => $basketno,
365 basketname => $basket->{'basketname'},
366 basketnote => $basket->{'note'},
367 booksellerid => $basket->{'booksellerid'},
368 basketbooksellernote => $basket->{booksellernote},
369 basketcontractno => $basket->{contractnumber},
370 basketcontractname => $contract->{contractname},
371 creationdate => $basket->{creationdate},
372 authorisedby => $basket->{'authorisedby'},
373 authorisedbyname => $basket->{'authorisedbyname'},
374 closedate => $basket->{'closedate'},
376 suggestionid => $suggestion->{suggestionid},
377 surnamesuggestedby => $suggestion->{surnamesuggestedby},
378 firstnamesuggestedby => $suggestion->{firstnamesuggestedby},
379 biblionumber => $biblionumber,
380 uncertainprice => $data->{'uncertainprice'},
381 authorisedbyname => $borrower->{'firstname'} . " " . $borrower->{'surname'},
382 biblioitemnumber => $data->{'biblioitemnumber'},
383 discount_2dp => sprintf( "%.2f", $bookseller->{'discount'} ) , # for display
384 discount => $bookseller->{'discount'},
385 orderdiscount_2dp => sprintf( "%.2f", $data->{'discount'} || 0 ),
386 orderdiscount => $data->{'discount'},
387 listincgst => $bookseller->{'listincgst'},
388 invoiceincgst => $bookseller->{'invoiceincgst'},
389 name => $bookseller->{'name'},
390 cur_active_sym => $active_currency->{'symbol'},
391 cur_active => $active_currency->{'currency'},
392 loop_currencies => \@loop_currency,
393 orderexists => ( $new eq 'yes' ) ? 0 : 1,
394 title => $data->{'title'},
395 author => $data->{'author'},
396 publicationyear => $data->{'publicationyear'} ? $data->{'publicationyear'} : $data->{'copyrightdate'},
397 editionstatement => $data->{'editionstatement'},
398 budget_loop => $budget_loop,
399 isbn => $data->{'isbn'},
400 ean => $data->{'ean'},
401 seriestitle => $data->{'seriestitle'},
402 itemtypeloop => \@itemtypes,
403 quantity => $data->{'quantity'},
404 quantityrec => $data->{'quantity'},
405 rrp => $data->{'rrp'},
406 gst_values => \@gst_values,
407 gstrate => $data->{gstrate} ? $data->{gstrate}+0.0 : $bookseller->{gstrate} ? $bookseller->{gstrate}+0.0 : 0,
408 gstreg => $bookseller->{'gstreg'},
409 listprice => sprintf( "%.2f", $data->{listprice} || $data->{price} || $listprice),
410 total => sprintf( "%.2f", ($data->{ecost} || 0) * ($data->{'quantity'} || 0) ),
411 ecost => sprintf( "%.2f", $data->{ecost} || 0),
412 unitprice => sprintf( "%.2f", $data->{unitprice} || 0),
413 publishercode => $data->{'publishercode'},
414 barcode_subfield => $barcode_subfield,
415 import_batch_id => $import_batch_id,
416 subscriptionid => $subscriptionid,
417 (uc(C4::Context->preference("marcflavour"))) => 1
420 $template->param ( notes => $data->{'notes'} ) if ( $ordernumber );
422 output_html_with_http_headers $input, $cookie, $template->output;
425 =head2 MARCfindbreeding
427 $record = MARCfindbreeding($breedingid);
429 Look up the import record repository for the record with
430 record with id $breedingid. If found, returns the decoded
431 MARC::Record; otherwise, -1 is returned (FIXME).
432 Returns as second parameter the character encoding.
436 sub MARCfindbreeding {
438 my ($marc, $encoding) = GetImportRecordMarc($id);
439 # remove the - in isbn, koha store isbn without any -
441 my $record = MARC::Record->new_from_usmarc($marc);
442 my ($isbnfield,$isbnsubfield) = GetMarcFromKohaField('biblioitems.isbn','');
443 if ( $record->field($isbnfield) ) {
444 foreach my $field ( $record->field($isbnfield) ) {
445 foreach my $subfield ( $field->subfield($isbnsubfield) ) {
446 my $newisbn = $field->subfield($isbnsubfield);
448 $field->update( $isbnsubfield => $newisbn );
452 # fix the unimarc 100 coded field (with unicode information)
453 if ($marcflavour eq 'UNIMARC' && $record->subfield(100,'a')) {
454 my $f100a=$record->subfield(100,'a');
455 my $f100 = $record->field(100);
456 my $f100temp = $f100->as_string;
457 $record->delete_field($f100);
458 if ( length($f100temp) > 28 ) {
459 substr( $f100temp, 26, 2, "50" );
460 $f100->update( 'a' => $f100temp );
461 my $f100 = MARC::Field->new( '100', '', '', 'a' => $f100temp );
462 $record->insert_fields_ordered($f100);
466 if ( !defined(ref($record)) ) {
470 # normalize author : probably UNIMARC specific...
471 if ( C4::Context->preference("z3950NormalizeAuthor")
472 and C4::Context->preference("z3950AuthorAuthFields") )
474 my ( $tag, $subfield ) = GetMarcFromKohaField("biblio.author", '');
476 # my $summary = C4::Context->preference("z3950authortemplate");
478 C4::Context->preference("z3950AuthorAuthFields");
479 my @auth_fields = split /,/, $auth_fields;
482 if ( $record->field($tag) ) {
483 foreach my $tmpfield ( $record->field($tag)->subfields ) {
485 # foreach my $subfieldcode ($tmpfield->subfields){
486 my $subfieldcode = shift @$tmpfield;
487 my $subfieldvalue = shift @$tmpfield;
489 $field->add_subfields(
490 "$subfieldcode" => $subfieldvalue )
491 if ( $subfieldcode ne $subfield );
495 MARC::Field->new( $tag, "", "",
496 $subfieldcode => $subfieldvalue )
497 if ( $subfieldcode ne $subfield );
501 $record->delete_field( $record->field($tag) );
502 foreach my $fieldtag (@auth_fields) {
503 next unless ( $record->field($fieldtag) );
504 my $lastname = $record->field($fieldtag)->subfield('a');
505 my $firstname = $record->field($fieldtag)->subfield('b');
506 my $title = $record->field($fieldtag)->subfield('c');
507 my $number = $record->field($fieldtag)->subfield('d');
510 # $field->add_subfields("$subfield"=>"[ ".ucfirst($title).ucfirst($firstname)." ".$number." ]");
511 $field->add_subfields(
512 "$subfield" => ucfirst($title) . " "
513 . ucfirst($firstname) . " "
518 # $field->add_subfields("$subfield"=>"[ ".ucfirst($firstname).", ".ucfirst($lastname)." ]");
519 $field->add_subfields(
520 "$subfield" => ucfirst($firstname) . ", "
521 . ucfirst($lastname) );
524 $record->insert_fields_ordered($field);
526 return $record, $encoding;
533 my ($duplicatetitle)= @_;
534 ($template, $loggedinuser, $cookie) = get_template_and_user(
536 template_name => "acqui/neworderempty_duplicate.tmpl",
539 authnotrequired => 0,
540 flagsrequired => { acquisition => 'order_manage' },
546 biblionumber => $biblionumber,
547 basketno => $basketno,
548 booksellerid => $basket->{'booksellerid'},
549 breedingid => $params->{'breedingid'},
550 duplicatetitle => $duplicatetitle,
551 (uc(C4::Context->preference("marcflavour"))) => 1
554 output_html_with_http_headers $input, $cookie, $template->output;