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 $bookseller = GetBookSellerFromId($booksellerid); # FIXME: else ERROR!
101 my $ordernumber = $input->param('ordernumber') || '';
102 my $biblionumber = $input->param('biblionumber');
103 my $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 !
113 my ( $template, $loggedinuser, $cookie, $userflags ) = get_template_and_user(
115 template_name => "acqui/neworderempty.tmpl",
118 authnotrequired => 0,
119 flagsrequired => { acquisition => 'order_manage' },
124 my $marcflavour = C4::Context->preference('marcflavour');
127 my $order = GetOrder($ordernumber);
128 $basketno = $order->{'basketno'};
131 my $basket = GetBasket($basketno);
132 my $contract = &GetContract($basket->{contractnumber});
134 #simple parameters reading (all in one :-)
135 my $params = $input->Vars;
136 my $listprice=0; # the price, that can be in MARC record if we have one
137 if ( $ordernumber eq '' and defined $params->{'breedingid'}){
138 #we want to import from the breeding reservoir (from a z3950 search)
139 my ($marcrecord, $encoding) = MARCfindbreeding($params->{'breedingid'});
140 die("Could not find the selected record in the reservoir, bailing") unless $marcrecord;
142 # Remove all the items (952) from the imported record
143 foreach my $item ($marcrecord->field('952')) {
144 $marcrecord->delete_field($item);
149 ($biblionumber,$duplicatetitle) = FindDuplicate($marcrecord);
150 if($biblionumber && !$input->param('use_external_source')) {
151 #if duplicate record found and user did not decide yet, first warn user
152 #and let him choose between using new record or existing record
153 Load_Duplicate($duplicatetitle);
156 #from this point: add a new record
157 if (C4::Context->preference("BiblioAddsAuthorities")){
158 my $headings_linked=BiblioAutoLink($marcrecord, $params->{'frameworkcode'});
161 $params->{'frameworkcode'} or $params->{'frameworkcode'} = "";
162 ( $biblionumber, $bibitemnum ) = AddBiblio( $marcrecord, $params->{'frameworkcode'} );
163 # get the price if there is one.
164 $listprice = GetMarcPrice($marcrecord, $marcflavour);
165 SetImportRecordStatus($params->{'breedingid'}, 'imported');
170 if ( $ordernumber eq '' ) { # create order
173 # $ordernumber=newordernum;
174 if ( $biblionumber && !$suggestionid ) {
175 $data = GetBiblioData($biblionumber);
178 # get suggestion fields if applicable. If it's a subscription renewal, then the biblio already exists
179 # otherwise, retrieve suggestion information.
181 $data = ($biblionumber) ? GetBiblioData($biblionumber) : GetSuggestion($suggestionid);
185 $data = GetOrder($ordernumber);
186 $biblionumber = $data->{'biblionumber'};
187 $budget_id = $data->{'budget_id'};
189 #get basketno and supplierno. too!
190 my $data2 = GetBasket( $data->{'basketno'} );
191 $basketno = $data2->{'basketno'};
192 $booksellerid = $data2->{'booksellerid'};
196 $suggestion = GetSuggestionInfo($suggestionid) if $suggestionid;
198 # get currencies (for change rates calcs if needed)
199 my $active_currency = GetCurrency();
200 my $default_currency;
201 if (! $data->{currency} ) { # New order no currency set
202 if ( $bookseller->{listprice} ) {
203 $default_currency = $bookseller->{listprice};
206 $default_currency = $active_currency->{currency};
210 my @rates = GetCurrencies();
214 my @loop_currency = ();
215 for my $curr ( @rates ) {
217 if ($data->{currency} ) {
218 $selected = $curr->{currency} eq $data->{currency};
221 $selected = $curr->{currency} eq $default_currency;
223 push @loop_currency, {
224 currcode => $curr->{currency},
225 rate => $curr->{rate},
226 selected => $selected,
230 # build branches list
231 my $onlymine=C4::Context->preference('IndependantBranches') &&
232 C4::Context->userenv &&
233 C4::Context->userenv->{flags}!=1 &&
234 C4::Context->userenv->{branch};
235 my $branches = GetBranches($onlymine);
237 foreach my $thisbranch ( sort {$branches->{$a}->{'branchname'} cmp $branches->{$b}->{'branchname'}} keys %$branches ) {
239 value => $thisbranch,
240 branchname => $branches->{$thisbranch}->{'branchname'},
242 $row{'selected'} = 1 if( $thisbranch && $data->{branchcode} && $thisbranch eq $data->{branchcode}) ;
243 push @branchloop, \%row;
245 $template->param( branchloop => \@branchloop );
247 # build bookfund list
248 my $borrower= GetMember('borrowernumber' => $loggedinuser);
249 my ( $flags, $homebranch )= ($borrower->{'flags'},$borrower->{'branchcode'});
251 my $budget = GetBudget($budget_id);
253 my $budget_loop = [];
254 my $budgets = GetBudgetHierarchy;
255 foreach my $r (@{$budgets}) {
256 next unless (CanUserUseBudget($borrower, $r, $userflags));
257 if (!defined $r->{budget_amount} || $r->{budget_amount} == 0) {
260 push @{$budget_loop}, {
261 b_id => $r->{budget_id},
262 b_txt => $r->{budget_name},
263 b_active => $r->{budget_period_active},
264 b_sel => ( $r->{budget_id} == $budget_id ) ? 1 : 0,
269 sort { uc( $a->{b_txt}) cmp uc( $b->{b_txt}) } @{$budget_loop};
272 $budget_id = $data->{'budget_id'};
273 $budget_name = $budget->{'budget_name'};
278 if ($budget) { # its a mod ..
279 if ( defined $budget->{'sort1_authcat'} ) { # with custom Asort* planning values
280 $CGIsort1 = GetAuthvalueDropbox( $budget->{'sort1_authcat'}, $data->{'sort1'} );
282 } elsif(@{$budgets}){
283 $CGIsort1 = GetAuthvalueDropbox( @$budgets[0]->{'sort1_authcat'}, '' );
286 # if CGIsort is successfully fetched, the use it
287 # else - failback to plain input-field
289 $template->param( CGIsort1 => $CGIsort1 );
291 $template->param( sort1 => $data->{'sort1'} );
296 if ( defined $budget->{'sort2_authcat'} ) {
297 $CGIsort2 = GetAuthvalueDropbox( $budget->{'sort2_authcat'}, $data->{'sort2'} );
299 } elsif(@{$budgets}) {
300 $CGIsort2 = GetAuthvalueDropbox( @$budgets[0]->{sort2_authcat}, '' );
304 $template->param( CGIsort2 => $CGIsort2 );
306 $template->param( sort2 => $data->{'sort2'} );
309 if (C4::Context->preference('AcqCreateItem') eq 'ordering' && !$ordernumber) {
310 # Check if ACQ framework exists
311 my $marc = GetMarcStructure(1, 'ACQ');
313 $template->param('NoACQframework' => 1);
316 AcqCreateItemOrdering => 1,
317 UniqueItemFields => C4::Context->preference('UniqueItemFields'),
320 # 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
322 @itemtypes = C4::ItemType->all unless C4::Context->preference('item-level_itypes');
324 # Find the items.barcode subfield for barcode validations
325 my (undef, $barcode_subfield) = GetMarcFromKohaField('items.barcode', '');
330 budget_id => $budget_id,
331 budget_name => $budget_name
334 # get option values for gist syspref
335 my @gst_values = map {
337 }, split( '\|', C4::Context->preference("gist") );
339 my $cur = GetCurrency();
342 existing => $biblionumber,
343 ordernumber => $ordernumber,
344 # basket informations
345 basketno => $basketno,
346 basketname => $basket->{'basketname'},
347 basketnote => $basket->{'note'},
348 booksellerid => $basket->{'booksellerid'},
349 basketbooksellernote => $basket->{booksellernote},
350 basketcontractno => $basket->{contractnumber},
351 basketcontractname => $contract->{contractname},
352 creationdate => $basket->{creationdate},
353 authorisedby => $basket->{'authorisedby'},
354 authorisedbyname => $basket->{'authorisedbyname'},
355 closedate => $basket->{'closedate'},
357 suggestionid => $suggestion->{suggestionid},
358 surnamesuggestedby => $suggestion->{surnamesuggestedby},
359 firstnamesuggestedby => $suggestion->{firstnamesuggestedby},
360 biblionumber => $biblionumber,
361 uncertainprice => $data->{'uncertainprice'},
362 authorisedbyname => $borrower->{'firstname'} . " " . $borrower->{'surname'},
363 biblioitemnumber => $data->{'biblioitemnumber'},
364 discount_2dp => sprintf( "%.2f", $bookseller->{'discount'} ) , # for display
365 discount => $bookseller->{'discount'},
366 orderdiscount_2dp => sprintf( "%.2f", $data->{'discount'} || 0 ),
367 orderdiscount => $data->{'discount'},
368 listincgst => $bookseller->{'listincgst'},
369 invoiceincgst => $bookseller->{'invoiceincgst'},
370 name => $bookseller->{'name'},
371 cur_active_sym => $active_currency->{'symbol'},
372 cur_active => $active_currency->{'currency'},
373 loop_currencies => \@loop_currency,
374 currency_rate => $cur->{rate},
375 orderexists => ( $new eq 'yes' ) ? 0 : 1,
376 title => $data->{'title'},
377 author => $data->{'author'},
378 publicationyear => $data->{'publicationyear'} ? $data->{'publicationyear'} : $data->{'copyrightdate'},
379 editionstatement => $data->{'editionstatement'},
380 budget_loop => $budget_loop,
381 isbn => $data->{'isbn'},
382 ean => $data->{'ean'},
383 seriestitle => $data->{'seriestitle'},
384 itemtypeloop => \@itemtypes,
385 quantity => $data->{'quantity'},
386 quantityrec => $data->{'quantity'},
387 rrp => $data->{'rrp'},
388 gst_values => \@gst_values,
389 gstrate => $data->{gstrate} ? $data->{gstrate}+0.0 : $bookseller->{gstrate} ? $bookseller->{gstrate}+0.0 : 0,
390 gstreg => $bookseller->{'gstreg'},
391 listprice => sprintf( "%.2f", $data->{listprice} || $data->{price} || $listprice),
392 total => sprintf( "%.2f", ($data->{ecost} || 0) * ($data->{'quantity'} || 0) ),
393 ecost => sprintf( "%.2f", $data->{ecost} || 0),
394 unitprice => sprintf( "%.2f", $data->{unitprice} || 0),
395 notes => $data->{'notes'},
396 publishercode => $data->{'publishercode'},
397 barcode_subfield => $barcode_subfield,
398 import_batch_id => $import_batch_id,
399 (uc(C4::Context->preference("marcflavour"))) => 1
402 output_html_with_http_headers $input, $cookie, $template->output;
405 =head2 MARCfindbreeding
407 $record = MARCfindbreeding($breedingid);
409 Look up the import record repository for the record with
410 record with id $breedingid. If found, returns the decoded
411 MARC::Record; otherwise, -1 is returned (FIXME).
412 Returns as second parameter the character encoding.
416 sub MARCfindbreeding {
418 my ($marc, $encoding) = GetImportRecordMarc($id);
419 # remove the - in isbn, koha store isbn without any -
421 my $record = MARC::Record->new_from_usmarc($marc);
422 my ($isbnfield,$isbnsubfield) = GetMarcFromKohaField('biblioitems.isbn','');
423 if ( $record->field($isbnfield) ) {
424 foreach my $field ( $record->field($isbnfield) ) {
425 foreach my $subfield ( $field->subfield($isbnsubfield) ) {
426 my $newisbn = $field->subfield($isbnsubfield);
428 $field->update( $isbnsubfield => $newisbn );
432 # fix the unimarc 100 coded field (with unicode information)
433 if ($marcflavour eq 'UNIMARC' && $record->subfield(100,'a')) {
434 my $f100a=$record->subfield(100,'a');
435 my $f100 = $record->field(100);
436 my $f100temp = $f100->as_string;
437 $record->delete_field($f100);
438 if ( length($f100temp) > 28 ) {
439 substr( $f100temp, 26, 2, "50" );
440 $f100->update( 'a' => $f100temp );
441 my $f100 = MARC::Field->new( '100', '', '', 'a' => $f100temp );
442 $record->insert_fields_ordered($f100);
446 if ( !defined(ref($record)) ) {
450 # normalize author : probably UNIMARC specific...
451 if ( C4::Context->preference("z3950NormalizeAuthor")
452 and C4::Context->preference("z3950AuthorAuthFields") )
454 my ( $tag, $subfield ) = GetMarcFromKohaField("biblio.author");
456 # my $summary = C4::Context->preference("z3950authortemplate");
458 C4::Context->preference("z3950AuthorAuthFields");
459 my @auth_fields = split /,/, $auth_fields;
462 if ( $record->field($tag) ) {
463 foreach my $tmpfield ( $record->field($tag)->subfields ) {
465 # foreach my $subfieldcode ($tmpfield->subfields){
466 my $subfieldcode = shift @$tmpfield;
467 my $subfieldvalue = shift @$tmpfield;
469 $field->add_subfields(
470 "$subfieldcode" => $subfieldvalue )
471 if ( $subfieldcode ne $subfield );
475 MARC::Field->new( $tag, "", "",
476 $subfieldcode => $subfieldvalue )
477 if ( $subfieldcode ne $subfield );
481 $record->delete_field( $record->field($tag) );
482 foreach my $fieldtag (@auth_fields) {
483 next unless ( $record->field($fieldtag) );
484 my $lastname = $record->field($fieldtag)->subfield('a');
485 my $firstname = $record->field($fieldtag)->subfield('b');
486 my $title = $record->field($fieldtag)->subfield('c');
487 my $number = $record->field($fieldtag)->subfield('d');
490 # $field->add_subfields("$subfield"=>"[ ".ucfirst($title).ucfirst($firstname)." ".$number." ]");
491 $field->add_subfields(
492 "$subfield" => ucfirst($title) . " "
493 . ucfirst($firstname) . " "
498 # $field->add_subfields("$subfield"=>"[ ".ucfirst($firstname).", ".ucfirst($lastname)." ]");
499 $field->add_subfields(
500 "$subfield" => ucfirst($firstname) . ", "
501 . ucfirst($lastname) );
504 $record->insert_fields_ordered($field);
506 return $record, $encoding;
513 my ($duplicatetitle)= @_;
514 ($template, $loggedinuser, $cookie) = get_template_and_user(
516 template_name => "acqui/neworderempty_duplicate.tmpl",
519 authnotrequired => 0,
520 flagsrequired => { acquisition => 'order_manage' },
526 biblionumber => $biblionumber,
527 basketno => $basketno,
528 booksellerid => $basket->{'booksellerid'},
529 breedingid => $params->{'breedingid'},
530 duplicatetitle => $duplicatetitle,
531 (uc(C4::Context->preference("marcflavour"))) => 1
534 output_html_with_http_headers $input, $cookie, $template->output;