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
84 use C4::Items; #PrepareItemRecord
88 use C4::Branch; # GetBranches
90 use C4::Search qw/FindDuplicate BiblioAddAuthorities/;
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 $basket = GetBasket($basketno);
126 my $contract = &GetContract($basket->{contractnumber});
128 #simple parameters reading (all in one :-)
129 my $params = $input->Vars;
130 my $listprice=0; # the price, that can be in MARC record if we have one
131 if ( $ordernumber eq '' and defined $params->{'breedingid'}){
132 #we want to import from the breeding reservoir (from a z3950 search)
133 my ($marcrecord, $encoding) = MARCfindbreeding($params->{'breedingid'});
134 die("Could not find the selected record in the reservoir, bailing") unless $marcrecord;
136 # Remove all the items (952) from the imported record
137 foreach my $item ($marcrecord->field('952')) {
138 $marcrecord->delete_field($item);
143 ($biblionumber,$duplicatetitle) = FindDuplicate($marcrecord);
144 if($biblionumber && !$input->param('use_external_source')) {
145 #if duplicate record found and user did not decide yet, first warn user
146 #and let him choose between using new record or existing record
147 Load_Duplicate($duplicatetitle);
150 #from this point: add a new record
151 if (C4::Context->preference("BiblioAddsAuthorities")){
152 my ($countlinked,$countcreated)=BiblioAddAuthorities($marcrecord, $params->{'frameworkcode'});
155 $params->{'frameworkcode'} or $params->{'frameworkcode'} = "";
156 ( $biblionumber, $bibitemnum ) = AddBiblio( $marcrecord, $params->{'frameworkcode'} );
157 # get the price if there is one.
158 # filter by storing only the 1st number
159 # we suppose the currency is correct, as we have no possibilities to get it.
160 if ($marcrecord->subfield("345","d")) {
161 $listprice = $marcrecord->subfield("345","d");
162 if ($listprice =~ /^([\d\.,]*)/) {
164 $listprice =~ s/,/\./;
169 elsif ($marcrecord->subfield("010","d")) {
170 $listprice = $marcrecord->subfield("010","d");
171 if ($listprice =~ /^([\d\.,]*)/) {
173 $listprice =~ s/,/\./;
178 SetImportRecordStatus($params->{'breedingid'}, 'imported');
183 if ( $ordernumber eq '' ) { # create order
186 # $ordernumber=newordernum;
187 if ( $biblionumber && !$suggestionid ) {
188 $data = GetBiblioData($biblionumber);
191 # get suggestion fields if applicable. If it's a subscription renewal, then the biblio already exists
192 # otherwise, retrieve suggestion information.
194 $data = ($biblionumber) ? GetBiblioData($biblionumber) : GetSuggestion($suggestionid);
198 $data = GetOrder($ordernumber);
199 $biblionumber = $data->{'biblionumber'};
200 $budget_id = $data->{'budget_id'};
202 #get basketno and supplierno. too!
203 my $data2 = GetBasket( $data->{'basketno'} );
204 $basketno = $data2->{'basketno'};
205 $booksellerid = $data2->{'booksellerid'};
209 $suggestion = GetSuggestionInfo($suggestionid) if $suggestionid;
211 # get currencies (for change rates calcs if needed)
212 my $active_currency = GetCurrency();
213 my $default_currency;
214 if (! $data->{currency} ) { # New order no currency set
215 if ( $bookseller->{listprice} ) {
216 $default_currency = $bookseller->{listprice};
219 $default_currency = $active_currency->{currency};
223 my @rates = GetCurrencies();
227 my @loop_currency = ();
228 for my $curr ( @rates ) {
230 if ($data->{currency} ) {
231 $selected = $curr->{currency} eq $data->{currency};
234 $selected = $curr->{currency} eq $default_currency;
236 push @loop_currency, {
237 currcode => $curr->{currency},
238 rate => $curr->{rate},
239 selected => $selected,
243 # build branches list
244 my $onlymine=C4::Context->preference('IndependantBranches') &&
245 C4::Context->userenv &&
246 C4::Context->userenv->{flags}!=1 &&
247 C4::Context->userenv->{branch};
248 my $branches = GetBranches($onlymine);
250 foreach my $thisbranch ( sort {$branches->{$a}->{'branchname'} cmp $branches->{$b}->{'branchname'}} keys %$branches ) {
252 value => $thisbranch,
253 branchname => $branches->{$thisbranch}->{'branchname'},
255 $row{'selected'} = 1 if( $thisbranch && $data->{branchcode} && $thisbranch eq $data->{branchcode}) ;
256 push @branchloop, \%row;
258 $template->param( branchloop => \@branchloop );
260 # build bookfund list
261 my $borrower= GetMember('borrowernumber' => $loggedinuser);
262 my ( $flags, $homebranch )= ($borrower->{'flags'},$borrower->{'branchcode'});
264 my $budget = GetBudget($budget_id);
266 my $budget_loop = [];
267 my $budgets = GetBudgetHierarchy(q{},$borrower->{branchcode},$borrower->{borrowernumber});
268 foreach my $r (@{$budgets}) {
269 if (!defined $r->{budget_amount} || $r->{budget_amount} == 0) {
272 push @{$budget_loop}, {
273 b_id => $r->{budget_id},
274 b_txt => $r->{budget_name},
275 b_active => $r->{budget_period_active},
276 b_sel => ( $r->{budget_id} == $budget_id ) ? 1 : 0,
282 $budget_id = $data->{'budget_id'};
283 $budget_name = $budget->{'budget_name'};
288 if ($budget) { # its a mod ..
289 if ( defined $budget->{'sort1_authcat'} ) { # with custom Asort* planning values
290 $CGIsort1 = GetAuthvalueDropbox( $budget->{'sort1_authcat'}, $data->{'sort1'} );
292 } elsif(@{$budgets}){
293 $CGIsort1 = GetAuthvalueDropbox( @$budgets[0]->{'sort1_authcat'}, '' );
295 $CGIsort1 = GetAuthvalueDropbox( '', '' );
298 # if CGIsort is successfully fetched, the use it
299 # else - failback to plain input-field
301 $template->param( CGIsort1 => $CGIsort1 );
303 $template->param( sort1 => $data->{'sort1'} );
308 if ( defined $budget->{'sort2_authcat'} ) {
309 $CGIsort2 = GetAuthvalueDropbox( $budget->{'sort2_authcat'}, $data->{'sort2'} );
311 } elsif(@{$budgets}) {
312 $CGIsort2 = GetAuthvalueDropbox( @$budgets[0]->{sort2_authcat}, '' );
314 $CGIsort2 = GetAuthvalueDropbox( '', '' );
318 $template->param( CGIsort2 => $CGIsort2 );
320 $template->param( sort2 => $data->{'sort2'} );
323 if (C4::Context->preference('AcqCreateItem') eq 'ordering' && !$ordernumber) {
324 # prepare empty item form
325 my $cell = PrepareItemrecordDisplay('','','','ACQ');
326 # warn "==> ".Data::Dumper::Dumper($cell);
328 $cell = PrepareItemrecordDisplay('','','','');
329 $template->param('NoACQframework' => 1);
332 push @itemloop,$cell;
334 $template->param(items => \@itemloop);
336 # 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
338 @itemtypes = C4::ItemType->all unless C4::Context->preference('item-level_itypes');
340 # Find the items.barcode subfield for barcode validations
341 my (undef, $barcode_subfield) = GetMarcFromKohaField('items.barcode', '');
346 budget_id => $budget_id,
347 budget_name => $budget_name
351 existing => $biblionumber,
352 ordernumber => $ordernumber,
353 # basket informations
354 basketno => $basketno,
355 basketname => $basket->{'basketname'},
356 basketnote => $basket->{'note'},
357 booksellerid => $basket->{'booksellerid'},
358 basketbooksellernote => $basket->{booksellernote},
359 basketcontractno => $basket->{contractnumber},
360 basketcontractname => $contract->{contractname},
361 creationdate => C4::Dates->new($basket->{creationdate},'iso')->output,
362 authorisedby => $basket->{'authorisedby'},
363 authorisedbyname => $basket->{'authorisedbyname'},
364 closedate => C4::Dates->new($basket->{'closedate'},'iso')->output,
366 suggestionid => $suggestion->{suggestionid},
367 surnamesuggestedby => $suggestion->{surnamesuggestedby},
368 firstnamesuggestedby => $suggestion->{firstnamesuggestedby},
369 biblionumber => $biblionumber,
370 uncertainprice => $data->{'uncertainprice'},
371 authorisedbyname => $borrower->{'firstname'} . " " . $borrower->{'surname'},
372 biblioitemnumber => $data->{'biblioitemnumber'},
373 discount_2dp => sprintf( "%.2f", $bookseller->{'discount'}) , # for display
374 discount => $bookseller->{'discount'},
375 listincgst => $bookseller->{'listincgst'},
376 invoiceincgst => $bookseller->{'invoiceincgst'},
377 name => $bookseller->{'name'},
378 cur_active_sym => $active_currency->{'symbol'},
379 cur_active => $active_currency->{'currency'},
380 loop_currencies => \@loop_currency,
381 orderexists => ( $new eq 'yes' ) ? 0 : 1,
382 title => $data->{'title'},
383 author => $data->{'author'},
384 publicationyear => $data->{'publicationyear'} ? $data->{'publicationyear'} : $data->{'copyrightdate'},
385 editionstatement => $data->{'editionstatement'},
386 budget_loop => $budget_loop,
387 isbn => $data->{'isbn'},
388 seriestitle => $data->{'seriestitle'},
389 itemtypeloop => \@itemtypes,
390 quantity => $data->{'quantity'},
391 quantityrec => $data->{'quantity'},
392 rrp => $data->{'rrp'},
393 listprice => sprintf("%.2f", $data->{'listprice'}||$data->{'price'}||$listprice),
394 total => sprintf("%.2f", ($data->{'ecost'}||0)*($data->{'quantity'}||0) ),
395 ecost => $data->{'ecost'},
396 unitprice => sprintf("%.2f", $data->{'unitprice'}),
397 notes => $data->{'notes'},
398 publishercode => $data->{'publishercode'},
399 barcode_subfield => $barcode_subfield,
401 import_batch_id => $import_batch_id,
403 # CHECKME: gst-stuff needs verifing, mason.
404 gstrate => $bookseller->{'gstrate'} // C4::Context->preference("gist") // 0,
405 gstreg => $bookseller->{'gstreg'},
408 output_html_with_http_headers $input, $cookie, $template->output;
411 =head2 MARCfindbreeding
413 $record = MARCfindbreeding($breedingid);
415 Look up the import record repository for the record with
416 record with id $breedingid. If found, returns the decoded
417 MARC::Record; otherwise, -1 is returned (FIXME).
418 Returns as second parameter the character encoding.
422 sub MARCfindbreeding {
424 my ($marc, $encoding) = GetImportRecordMarc($id);
425 # remove the - in isbn, koha store isbn without any -
427 my $record = MARC::Record->new_from_usmarc($marc);
428 my ($isbnfield,$isbnsubfield) = GetMarcFromKohaField('biblioitems.isbn','');
429 if ( $record->field($isbnfield) ) {
430 foreach my $field ( $record->field($isbnfield) ) {
431 foreach my $subfield ( $field->subfield($isbnsubfield) ) {
432 my $newisbn = $field->subfield($isbnsubfield);
434 $field->update( $isbnsubfield => $newisbn );
438 # fix the unimarc 100 coded field (with unicode information)
439 if (C4::Context->preference('marcflavour') eq 'UNIMARC' && $record->subfield(100,'a')) {
440 my $f100a=$record->subfield(100,'a');
441 my $f100 = $record->field(100);
442 my $f100temp = $f100->as_string;
443 $record->delete_field($f100);
444 if ( length($f100temp) > 28 ) {
445 substr( $f100temp, 26, 2, "50" );
446 $f100->update( 'a' => $f100temp );
447 my $f100 = MARC::Field->new( '100', '', '', 'a' => $f100temp );
448 $record->insert_fields_ordered($f100);
452 if ( !defined(ref($record)) ) {
456 # normalize author : probably UNIMARC specific...
457 if ( C4::Context->preference("z3950NormalizeAuthor")
458 and C4::Context->preference("z3950AuthorAuthFields") )
460 my ( $tag, $subfield ) = GetMarcFromKohaField("biblio.author");
462 # my $summary = C4::Context->preference("z3950authortemplate");
464 C4::Context->preference("z3950AuthorAuthFields");
465 my @auth_fields = split /,/, $auth_fields;
468 if ( $record->field($tag) ) {
469 foreach my $tmpfield ( $record->field($tag)->subfields ) {
471 # foreach my $subfieldcode ($tmpfield->subfields){
472 my $subfieldcode = shift @$tmpfield;
473 my $subfieldvalue = shift @$tmpfield;
475 $field->add_subfields(
476 "$subfieldcode" => $subfieldvalue )
477 if ( $subfieldcode ne $subfield );
481 MARC::Field->new( $tag, "", "",
482 $subfieldcode => $subfieldvalue )
483 if ( $subfieldcode ne $subfield );
487 $record->delete_field( $record->field($tag) );
488 foreach my $fieldtag (@auth_fields) {
489 next unless ( $record->field($fieldtag) );
490 my $lastname = $record->field($fieldtag)->subfield('a');
491 my $firstname = $record->field($fieldtag)->subfield('b');
492 my $title = $record->field($fieldtag)->subfield('c');
493 my $number = $record->field($fieldtag)->subfield('d');
496 # $field->add_subfields("$subfield"=>"[ ".ucfirst($title).ucfirst($firstname)." ".$number." ]");
497 $field->add_subfields(
498 "$subfield" => ucfirst($title) . " "
499 . ucfirst($firstname) . " "
504 # $field->add_subfields("$subfield"=>"[ ".ucfirst($firstname).", ".ucfirst($lastname)." ]");
505 $field->add_subfields(
506 "$subfield" => ucfirst($firstname) . ", "
507 . ucfirst($lastname) );
510 $record->insert_fields_ordered($field);
512 return $record, $encoding;
519 my ($duplicatetitle)= @_;
520 ($template, $loggedinuser, $cookie) = get_template_and_user(
522 template_name => "acqui/neworderempty_duplicate.tmpl",
525 authnotrequired => 0,
526 flagsrequired => { acquisition => 'order_manage' },
532 biblionumber => $biblionumber,
533 basketno => $basketno,
534 booksellerid => $basket->{'booksellerid'},
535 breedingid => $params->{'breedingid'},
536 duplicatetitle => $duplicatetitle,
539 output_html_with_http_headers $input, $cookie, $template->output;