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
80 use C4::Bookseller qw/ GetBookSellerFromId /;
82 use C4::Suggestions; # GetSuggestion
83 use C4::Biblio; # GetBiblioData GetMarcPrice
84 use C4::Items; #PrepareItemRecord
88 use C4::Branch; # GetBranches
90 use C4::Search qw/FindDuplicate/;
92 #needed for z3950 import:
93 use C4::ImportBatch qw/GetImportRecordMarc SetImportRecordStatus/;
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 $bookseller = GetBookSellerFromId($booksellerid); # FIXME: else ERROR!
102 my $ordernumber = $input->param('ordernumber') || '';
103 my $biblionumber = $input->param('biblionumber');
104 my $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 !
114 my ( $template, $loggedinuser, $cookie ) = get_template_and_user(
116 template_name => "acqui/neworderempty.tmpl",
119 authnotrequired => 0,
120 flagsrequired => { acquisition => 'order_manage' },
125 my $marcflavour = C4::Context->preference('marcflavour');
128 my $order = GetOrder($ordernumber);
129 $basketno = $order->{'basketno'};
132 my $basket = GetBasket($basketno);
133 my $contract = &GetContract($basket->{contractnumber});
135 #simple parameters reading (all in one :-)
136 my $params = $input->Vars;
137 my $listprice=0; # the price, that can be in MARC record if we have one
138 if ( $ordernumber eq '' and defined $params->{'breedingid'}){
139 #we want to import from the breeding reservoir (from a z3950 search)
140 my ($marcrecord, $encoding) = MARCfindbreeding($params->{'breedingid'});
141 die("Could not find the selected record in the reservoir, bailing") unless $marcrecord;
143 # Remove all the items (952) from the imported record
144 foreach my $item ($marcrecord->field('952')) {
145 $marcrecord->delete_field($item);
150 ($biblionumber,$duplicatetitle) = FindDuplicate($marcrecord);
151 if($biblionumber && !$input->param('use_external_source')) {
152 #if duplicate record found and user did not decide yet, first warn user
153 #and let him choose between using new record or existing record
154 Load_Duplicate($duplicatetitle);
157 #from this point: add a new record
158 if (C4::Context->preference("BiblioAddsAuthorities")){
159 my $headings_linked=BiblioAutoLink($marcrecord, $params->{'frameworkcode'});
162 $params->{'frameworkcode'} or $params->{'frameworkcode'} = "";
163 ( $biblionumber, $bibitemnum ) = AddBiblio( $marcrecord, $params->{'frameworkcode'} );
164 # get the price if there is one.
165 $listprice = GetMarcPrice($marcrecord, $marcflavour);
166 SetImportRecordStatus($params->{'breedingid'}, 'imported');
171 if ( $ordernumber eq '' ) { # create order
174 # $ordernumber=newordernum;
175 if ( $biblionumber && !$suggestionid ) {
176 $data = GetBiblioData($biblionumber);
179 # get suggestion fields if applicable. If it's a subscription renewal, then the biblio already exists
180 # otherwise, retrieve suggestion information.
182 $data = ($biblionumber) ? GetBiblioData($biblionumber) : GetSuggestion($suggestionid);
186 $data = GetOrder($ordernumber);
187 $biblionumber = $data->{'biblionumber'};
188 $budget_id = $data->{'budget_id'};
190 #get basketno and supplierno. too!
191 my $data2 = GetBasket( $data->{'basketno'} );
192 $basketno = $data2->{'basketno'};
193 $booksellerid = $data2->{'booksellerid'};
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(q{},$borrower->{branchcode},$borrower->{borrowernumber});
256 foreach my $r (@{$budgets}) {
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,
270 $budget_id = $data->{'budget_id'};
271 $budget_name = $budget->{'budget_name'};
276 if ($budget) { # its a mod ..
277 if ( defined $budget->{'sort1_authcat'} ) { # with custom Asort* planning values
278 $CGIsort1 = GetAuthvalueDropbox( $budget->{'sort1_authcat'}, $data->{'sort1'} );
280 } elsif(@{$budgets}){
281 $CGIsort1 = GetAuthvalueDropbox( @$budgets[0]->{'sort1_authcat'}, '' );
283 $CGIsort1 = GetAuthvalueDropbox( '', '' );
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}, '' );
302 $CGIsort2 = GetAuthvalueDropbox( '', '' );
306 $template->param( CGIsort2 => $CGIsort2 );
308 $template->param( sort2 => $data->{'sort2'} );
311 if (C4::Context->preference('AcqCreateItem') eq 'ordering' && !$ordernumber) {
312 # prepare empty item form
313 my $cell = PrepareItemrecordDisplay('','','','ACQ');
314 # warn "==> ".Data::Dumper::Dumper($cell);
316 $cell = PrepareItemrecordDisplay('','','','');
317 $template->param('NoACQframework' => 1);
320 push @itemloop,$cell;
322 $template->param(items => \@itemloop);
324 # 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
326 @itemtypes = C4::ItemType->all unless C4::Context->preference('item-level_itypes');
328 # Find the items.barcode subfield for barcode validations
329 my (undef, $barcode_subfield) = GetMarcFromKohaField('items.barcode', '');
334 budget_id => $budget_id,
335 budget_name => $budget_name
339 existing => $biblionumber,
340 ordernumber => $ordernumber,
341 # basket informations
342 basketno => $basketno,
343 basketname => $basket->{'basketname'},
344 basketnote => $basket->{'note'},
345 booksellerid => $basket->{'booksellerid'},
346 basketbooksellernote => $basket->{booksellernote},
347 basketcontractno => $basket->{contractnumber},
348 basketcontractname => $contract->{contractname},
349 creationdate => C4::Dates->new($basket->{creationdate},'iso')->output,
350 authorisedby => $basket->{'authorisedby'},
351 authorisedbyname => $basket->{'authorisedbyname'},
352 closedate => C4::Dates->new($basket->{'closedate'},'iso')->output,
354 suggestionid => $suggestion->{suggestionid},
355 surnamesuggestedby => $suggestion->{surnamesuggestedby},
356 firstnamesuggestedby => $suggestion->{firstnamesuggestedby},
357 biblionumber => $biblionumber,
358 uncertainprice => $data->{'uncertainprice'},
359 authorisedbyname => $borrower->{'firstname'} . " " . $borrower->{'surname'},
360 biblioitemnumber => $data->{'biblioitemnumber'},
361 discount_2dp => sprintf( "%.2f", $bookseller->{'discount'}) , # for display
362 discount => $bookseller->{'discount'},
363 listincgst => $bookseller->{'listincgst'},
364 invoiceincgst => $bookseller->{'invoiceincgst'},
365 name => $bookseller->{'name'},
366 cur_active_sym => $active_currency->{'symbol'},
367 cur_active => $active_currency->{'currency'},
368 loop_currencies => \@loop_currency,
369 orderexists => ( $new eq 'yes' ) ? 0 : 1,
370 title => $data->{'title'},
371 author => $data->{'author'},
372 publicationyear => $data->{'publicationyear'} ? $data->{'publicationyear'} : $data->{'copyrightdate'},
373 editionstatement => $data->{'editionstatement'},
374 budget_loop => $budget_loop,
375 isbn => $data->{'isbn'},
376 seriestitle => $data->{'seriestitle'},
377 itemtypeloop => \@itemtypes,
378 quantity => $data->{'quantity'},
379 quantityrec => $data->{'quantity'},
380 rrp => $data->{'rrp'},
381 listprice => sprintf("%.2f", $data->{'listprice'}||$data->{'price'}||$listprice),
382 total => sprintf("%.2f", ($data->{'ecost'}||0)*($data->{'quantity'}||0) ),
383 ecost => $data->{'ecost'},
384 unitprice => sprintf("%.2f", $data->{'unitprice'}),
385 notes => $data->{'notes'},
386 publishercode => $data->{'publishercode'},
387 barcode_subfield => $barcode_subfield,
389 import_batch_id => $import_batch_id,
391 # CHECKME: gst-stuff needs verifing, mason.
392 gstrate => $bookseller->{'gstrate'} // C4::Context->preference("gist") // 0,
393 gstreg => $bookseller->{'gstreg'},
396 output_html_with_http_headers $input, $cookie, $template->output;
399 =head2 MARCfindbreeding
401 $record = MARCfindbreeding($breedingid);
403 Look up the import record repository for the record with
404 record with id $breedingid. If found, returns the decoded
405 MARC::Record; otherwise, -1 is returned (FIXME).
406 Returns as second parameter the character encoding.
410 sub MARCfindbreeding {
412 my ($marc, $encoding) = GetImportRecordMarc($id);
413 # remove the - in isbn, koha store isbn without any -
415 my $record = MARC::Record->new_from_usmarc($marc);
416 my ($isbnfield,$isbnsubfield) = GetMarcFromKohaField('biblioitems.isbn','');
417 if ( $record->field($isbnfield) ) {
418 foreach my $field ( $record->field($isbnfield) ) {
419 foreach my $subfield ( $field->subfield($isbnsubfield) ) {
420 my $newisbn = $field->subfield($isbnsubfield);
422 $field->update( $isbnsubfield => $newisbn );
426 # fix the unimarc 100 coded field (with unicode information)
427 if ($marcflavour eq 'UNIMARC' && $record->subfield(100,'a')) {
428 my $f100a=$record->subfield(100,'a');
429 my $f100 = $record->field(100);
430 my $f100temp = $f100->as_string;
431 $record->delete_field($f100);
432 if ( length($f100temp) > 28 ) {
433 substr( $f100temp, 26, 2, "50" );
434 $f100->update( 'a' => $f100temp );
435 my $f100 = MARC::Field->new( '100', '', '', 'a' => $f100temp );
436 $record->insert_fields_ordered($f100);
440 if ( !defined(ref($record)) ) {
444 # normalize author : probably UNIMARC specific...
445 if ( C4::Context->preference("z3950NormalizeAuthor")
446 and C4::Context->preference("z3950AuthorAuthFields") )
448 my ( $tag, $subfield ) = GetMarcFromKohaField("biblio.author");
450 # my $summary = C4::Context->preference("z3950authortemplate");
452 C4::Context->preference("z3950AuthorAuthFields");
453 my @auth_fields = split /,/, $auth_fields;
456 if ( $record->field($tag) ) {
457 foreach my $tmpfield ( $record->field($tag)->subfields ) {
459 # foreach my $subfieldcode ($tmpfield->subfields){
460 my $subfieldcode = shift @$tmpfield;
461 my $subfieldvalue = shift @$tmpfield;
463 $field->add_subfields(
464 "$subfieldcode" => $subfieldvalue )
465 if ( $subfieldcode ne $subfield );
469 MARC::Field->new( $tag, "", "",
470 $subfieldcode => $subfieldvalue )
471 if ( $subfieldcode ne $subfield );
475 $record->delete_field( $record->field($tag) );
476 foreach my $fieldtag (@auth_fields) {
477 next unless ( $record->field($fieldtag) );
478 my $lastname = $record->field($fieldtag)->subfield('a');
479 my $firstname = $record->field($fieldtag)->subfield('b');
480 my $title = $record->field($fieldtag)->subfield('c');
481 my $number = $record->field($fieldtag)->subfield('d');
484 # $field->add_subfields("$subfield"=>"[ ".ucfirst($title).ucfirst($firstname)." ".$number." ]");
485 $field->add_subfields(
486 "$subfield" => ucfirst($title) . " "
487 . ucfirst($firstname) . " "
492 # $field->add_subfields("$subfield"=>"[ ".ucfirst($firstname).", ".ucfirst($lastname)." ]");
493 $field->add_subfields(
494 "$subfield" => ucfirst($firstname) . ", "
495 . ucfirst($lastname) );
498 $record->insert_fields_ordered($field);
500 return $record, $encoding;
507 my ($duplicatetitle)= @_;
508 ($template, $loggedinuser, $cookie) = get_template_and_user(
510 template_name => "acqui/neworderempty_duplicate.tmpl",
513 authnotrequired => 0,
514 flagsrequired => { acquisition => 'order_manage' },
520 biblionumber => $biblionumber,
521 basketno => $basketno,
522 booksellerid => $basket->{'booksellerid'},
523 breedingid => $params->{'breedingid'},
524 duplicatetitle => $duplicatetitle,
527 output_html_with_http_headers $input, $cookie, $template->output;