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'};
208 # get currencies (for change rates calcs if needed)
209 my $active_currency = GetCurrency();
210 my $default_currency;
211 if (! $data->{currency} ) { # New order no currency set
212 if ( $bookseller->{listprice} ) {
213 $default_currency = $bookseller->{listprice};
216 $default_currency = $active_currency->{currency};
220 my @rates = GetCurrencies();
224 my @loop_currency = ();
225 for my $curr ( @rates ) {
227 if ($data->{currency} ) {
228 $selected = $curr->{currency} eq $data->{currency};
231 $selected = $curr->{currency} eq $default_currency;
233 push @loop_currency, {
234 currcode => $curr->{currency},
235 rate => $curr->{rate},
236 selected => $selected,
240 # build branches list
241 my $onlymine=C4::Context->preference('IndependantBranches') &&
242 C4::Context->userenv &&
243 C4::Context->userenv->{flags}!=1 &&
244 C4::Context->userenv->{branch};
245 my $branches = GetBranches($onlymine);
247 foreach my $thisbranch ( sort {$branches->{$a}->{'branchname'} cmp $branches->{$b}->{'branchname'}} keys %$branches ) {
249 value => $thisbranch,
250 branchname => $branches->{$thisbranch}->{'branchname'},
252 $row{'selected'} = 1 if( $thisbranch && $data->{branchcode} && $thisbranch eq $data->{branchcode}) ;
253 push @branchloop, \%row;
255 $template->param( branchloop => \@branchloop );
257 # build bookfund list
258 my $borrower= GetMember('borrowernumber' => $loggedinuser);
259 my ( $flags, $homebranch )= ($borrower->{'flags'},$borrower->{'branchcode'});
261 my $budget = GetBudget($budget_id);
263 my $budget_loop = [];
264 my $budgets = GetBudgetHierarchy(q{},$borrower->{branchcode},$borrower->{borrowernumber});
265 foreach my $r (@{$budgets}) {
266 if (!defined $r->{budget_amount} || $r->{budget_amount} == 0) {
269 push @{$budget_loop}, {
270 b_id => $r->{budget_id},
271 b_txt => $r->{budget_name},
272 b_active => $r->{budget_period_active},
273 b_sel => ( $r->{budget_id} == $budget_id ) ? 1 : 0,
279 $budget_id = $data->{'budget_id'};
280 $budget_name = $budget->{'budget_name'};
285 if ($budget) { # its a mod ..
286 if ( defined $budget->{'sort1_authcat'} ) { # with custom Asort* planning values
287 $CGIsort1 = GetAuthvalueDropbox( $budget->{'sort1_authcat'}, $data->{'sort1'} );
289 } elsif(@{$budgets}){
290 $CGIsort1 = GetAuthvalueDropbox( @$budgets[0]->{'sort1_authcat'}, '' );
292 $CGIsort1 = GetAuthvalueDropbox( '', '' );
295 # if CGIsort is successfully fetched, the use it
296 # else - failback to plain input-field
298 $template->param( CGIsort1 => $CGIsort1 );
300 $template->param( sort1 => $data->{'sort1'} );
305 if ( defined $budget->{'sort2_authcat'} ) {
306 $CGIsort2 = GetAuthvalueDropbox( $budget->{'sort2_authcat'}, $data->{'sort2'} );
308 } elsif(@{$budgets}) {
309 $CGIsort2 = GetAuthvalueDropbox( @$budgets[0]->{sort2_authcat}, '' );
311 $CGIsort2 = GetAuthvalueDropbox( '', '' );
315 $template->param( CGIsort2 => $CGIsort2 );
317 $template->param( sort2 => $data->{'sort2'} );
320 if (C4::Context->preference('AcqCreateItem') eq 'ordering' && !$ordernumber) {
321 # prepare empty item form
322 my $cell = PrepareItemrecordDisplay('','','','ACQ');
323 # warn "==> ".Data::Dumper::Dumper($cell);
325 $cell = PrepareItemrecordDisplay('','','','');
326 $template->param('NoACQframework' => 1);
329 push @itemloop,$cell;
331 $template->param(items => \@itemloop);
333 # 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
335 @itemtypes = C4::ItemType->all unless C4::Context->preference('item-level_itypes');
337 # Find the items.barcode subfield for barcode validations
338 my (undef, $barcode_subfield) = GetMarcFromKohaField('items.barcode', '');
343 budget_id => $budget_id,
344 budget_name => $budget_name
348 existing => $biblionumber,
349 ordernumber => $ordernumber,
350 # basket informations
351 basketno => $basketno,
352 basketname => $basket->{'basketname'},
353 basketnote => $basket->{'note'},
354 booksellerid => $basket->{'booksellerid'},
355 basketbooksellernote => $basket->{booksellernote},
356 basketcontractno => $basket->{contractnumber},
357 basketcontractname => $contract->{contractname},
358 creationdate => C4::Dates->new($basket->{creationdate},'iso')->output,
359 authorisedby => $basket->{'authorisedby'},
360 authorisedbyname => $basket->{'authorisedbyname'},
361 closedate => C4::Dates->new($basket->{'closedate'},'iso')->output,
363 suggestionid => $suggestionid,
364 biblionumber => $biblionumber,
365 uncertainprice => $data->{'uncertainprice'},
366 authorisedbyname => $borrower->{'firstname'} . " " . $borrower->{'surname'},
367 biblioitemnumber => $data->{'biblioitemnumber'},
368 discount_2dp => sprintf( "%.2f", $bookseller->{'discount'}) , # for display
369 discount => $bookseller->{'discount'},
370 listincgst => $bookseller->{'listincgst'},
371 invoiceincgst => $bookseller->{'invoiceincgst'},
372 name => $bookseller->{'name'},
373 cur_active_sym => $active_currency->{'symbol'},
374 cur_active => $active_currency->{'currency'},
375 loop_currencies => \@loop_currency,
376 orderexists => ( $new eq 'yes' ) ? 0 : 1,
377 title => $data->{'title'},
378 author => $data->{'author'},
379 publicationyear => $data->{'publicationyear'} ? $data->{'publicationyear'} : $data->{'copyrightdate'},
380 budget_loop => $budget_loop,
381 isbn => $data->{'isbn'},
382 seriestitle => $data->{'seriestitle'},
383 itemtypeloop => \@itemtypes,
384 quantity => $data->{'quantity'},
385 quantityrec => $data->{'quantity'},
386 rrp => $data->{'rrp'},
387 listprice => sprintf("%.2f", $data->{'listprice'}||$data->{'price'}||$listprice),
388 total => sprintf("%.2f", ($data->{'ecost'}||0)*($data->{'quantity'}||0) ),
389 ecost => $data->{'ecost'},
390 unitprice => sprintf("%.2f", $data->{'unitprice'}),
391 notes => $data->{'notes'},
392 publishercode => $data->{'publishercode'},
393 barcode_subfield => $barcode_subfield,
395 import_batch_id => $import_batch_id,
397 # CHECKME: gst-stuff needs verifing, mason.
398 gstrate => $bookseller->{'gstrate'} // C4::Context->preference("gist") // 0,
399 gstreg => $bookseller->{'gstreg'},
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 (C4::Context->preference('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,
533 output_html_with_http_headers $input, $cookie, $template->output;