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
87 use C4::Branch; # GetBranches
89 use C4::Search qw/FindDuplicate BiblioAddAuthorities/;
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; # FIXME: else ERROR!
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 ) = get_template_and_user(
115 template_name => "acqui/neworderempty.tmpl",
118 authnotrequired => 0,
119 flagsrequired => { acquisition => 'order_manage' },
124 my $basket = GetBasket($basketno);
125 my $contract = &GetContract($basket->{contractnumber});
127 #simple parameters reading (all in one :-)
128 my $params = $input->Vars;
129 my $listprice=0; # the price, that can be in MARC record if we have one
130 if ( $ordernumber eq '' and defined $params->{'breedingid'}){
131 #we want to import from the breeding reservoir (from a z3950 search)
132 my ($marcrecord, $encoding) = MARCfindbreeding($params->{'breedingid'});
133 die("Could not find the selected record in the reservoir, bailing") unless $marcrecord;
137 ($biblionumber,$duplicatetitle) = FindDuplicate($marcrecord);
138 if($biblionumber && !$input->param('use_external_source')) {
139 #if duplicate record found and user did not decide yet, first warn user
140 #and let him choose between using new record or existing record
141 Load_Duplicate($duplicatetitle);
144 #from this point: add a new record
145 if (C4::Context->preference("BiblioAddsAuthorities")){
146 my ($countlinked,$countcreated)=BiblioAddAuthorities($marcrecord, $params->{'frameworkcode'});
149 $params->{'frameworkcode'} or $params->{'frameworkcode'} = "";
150 ( $biblionumber, $bibitemnum ) = AddBiblio( $marcrecord, $params->{'frameworkcode'} );
151 # get the price if there is one.
152 # filter by storing only the 1st number
153 # we suppose the currency is correct, as we have no possibilities to get it.
154 if ($marcrecord->subfield("345","d")) {
155 $listprice = $marcrecord->subfield("345","d");
156 if ($listprice =~ /^([\d\.,]*)/) {
158 $listprice =~ s/,/\./;
163 elsif ($marcrecord->subfield("010","d")) {
164 $listprice = $marcrecord->subfield("010","d");
165 if ($listprice =~ /^([\d\.,]*)/) {
167 $listprice =~ s/,/\./;
172 SetImportRecordStatus($params->{'breedingid'}, 'imported');
177 if ( $ordernumber eq '' ) { # create order
180 # $ordernumber=newordernum;
181 if ( $biblionumber && !$suggestionid ) {
182 $data = GetBiblioData($biblionumber);
185 # get suggestion fields if applicable. If it's a subscription renewal, then the biblio already exists
186 # otherwise, retrieve suggestion information.
188 $data = ($biblionumber) ? GetBiblioData($biblionumber) : GetSuggestion($suggestionid);
192 $data = GetOrder($ordernumber);
193 $biblionumber = $data->{'biblionumber'};
194 $budget_id = $data->{'budget_id'};
196 #get basketno and supplierno. too!
197 my $data2 = GetBasket( $data->{'basketno'} );
198 $basketno = $data2->{'basketno'};
199 $booksellerid = $data2->{'booksellerid'};
202 # get currencies (for change rates calcs if needed)
203 my $active_currency = GetCurrency();
204 my $default_currency;
205 if (! $data->{currency} ) { # New order no currency set
206 if ( $bookseller->{listprice} ) {
207 $default_currency = $bookseller->{listprice};
210 $default_currency = $active_currency->{currency};
214 my @rates = GetCurrencies();
218 my @loop_currency = ();
219 for my $curr ( @rates ) {
221 if ($data->{currency} ) {
222 $selected = $curr->{currency} eq $data->{currency};
225 $selected = $curr->{currency} eq $default_currency;
227 push @loop_currency, {
228 currcode => $curr->{currency},
229 rate => $curr->{rate},
230 selected => $selected,
234 # build branches list
235 my $onlymine=C4::Context->preference('IndependantBranches') &&
236 C4::Context->userenv &&
237 C4::Context->userenv->{flags}!=1 &&
238 C4::Context->userenv->{branch};
239 my $branches = GetBranches($onlymine);
241 foreach my $thisbranch ( sort {$branches->{$a}->{'branchname'} cmp $branches->{$b}->{'branchname'}} keys %$branches ) {
243 value => $thisbranch,
244 branchname => $branches->{$thisbranch}->{'branchname'},
246 $row{'selected'} = 1 if( $thisbranch eq $data->{branchcode}) ;
247 push @branchloop, \%row;
249 $template->param( branchloop => \@branchloop );
251 # build bookfund list
252 my $borrower= GetMember('borrowernumber' => $loggedinuser);
253 my ( $flags, $homebranch )= ($borrower->{'flags'},$borrower->{'branchcode'});
255 my $budget = GetBudget($budget_id);
257 my $budget_loop = [];
258 my $budgets = GetBudgetHierarchy(q{},$borrower->{branchcode},$borrower->{borrowernumber});
259 foreach my $r (@{$budgets}) {
260 if (!defined $r->{budget_amount} || $r->{budget_amount} == 0) {
263 push @{$budget_loop}, {
264 b_id => $r->{budget_id},
265 b_txt => $r->{budget_name},
266 b_active => $r->{budget_period_active},
267 b_sel => ( $r->{budget_id} == $budget_id ) ? 1 : 0,
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( 'sort1', $budget->{'sort1_authcat'}, $data->{'sort1'} );
283 } elsif(scalar(@$budgets)){
284 $CGIsort1 = GetAuthvalueDropbox( 'sort1', @$budgets[0]->{'sort1_authcat'}, '' );
286 $CGIsort1 = GetAuthvalueDropbox( 'sort1','', '' );
289 # if CGIsort is successfully fetched, the use it
290 # else - failback to plain input-field
292 $template->param( CGIsort1 => $CGIsort1 );
294 $template->param( sort1 => $data->{'sort1'} );
299 if ( defined $budget->{'sort2_authcat'} ) {
300 $CGIsort2 = GetAuthvalueDropbox( 'sort2', $budget->{'sort2_authcat'}, $data->{'sort2'} );
302 } elsif(scalar(@$budgets)) {
303 $CGIsort2 = GetAuthvalueDropbox( 'sort2', @$budgets[0]->{sort2_authcat}, '' );
305 $CGIsort2 = GetAuthvalueDropbox( 'sort2','', '' );
309 $template->param( CGIsort2 => $CGIsort2 );
311 $template->param( sort2 => $data->{'sort2'} );
314 if (C4::Context->preference('AcqCreateItem') eq 'ordering' && !$ordernumber) {
315 # prepare empty item form
316 my $cell = PrepareItemrecordDisplay('','','','ACQ');
317 # warn "==> ".Data::Dumper::Dumper($cell);
319 $cell = PrepareItemrecordDisplay('','','','');
320 $template->param('NoACQframework' => 1);
323 push @itemloop,$cell;
325 $template->param(items => \@itemloop);
331 budget_id => $budget_id,
332 budget_name => $budget_name
336 existing => $biblionumber,
337 ordernumber => $ordernumber,
338 # basket informations
339 basketno => $basketno,
340 basketname => $basket->{'basketname'},
341 basketnote => $basket->{'note'},
342 booksellerid => $basket->{'booksellerid'},
343 basketbooksellernote => $basket->{booksellernote},
344 basketcontractno => $basket->{contractnumber},
345 basketcontractname => $contract->{contractname},
346 creationdate => C4::Dates->new($basket->{creationdate},'iso')->output,
347 authorisedby => $basket->{'authorisedby'},
348 authorisedbyname => $basket->{'authorisedbyname'},
349 closedate => C4::Dates->new($basket->{'closedate'},'iso')->output,
351 suggestionid => $suggestionid,
352 biblionumber => $biblionumber,
353 uncertainprice => $data->{'uncertainprice'},
354 authorisedbyname => $borrower->{'firstname'} . " " . $borrower->{'surname'},
355 biblioitemnumber => $data->{'biblioitemnumber'},
356 discount_2dp => sprintf( "%.2f", $bookseller->{'discount'}) , # for display
357 discount => $bookseller->{'discount'},
358 listincgst => $bookseller->{'listincgst'},
359 invoiceincgst => $bookseller->{'invoiceincgst'},
360 name => $bookseller->{'name'},
361 cur_active_sym => $active_currency->{'symbol'},
362 cur_active => $active_currency->{'currency'},
363 loop_currencies => \@loop_currency,
364 orderexists => ( $new eq 'yes' ) ? 0 : 1,
365 title => $data->{'title'},
366 author => $data->{'author'},
367 publicationyear => $data->{'publicationyear'} ? $data->{'publicationyear'} : $data->{'copyrightdate'},
368 budget_loop => $budget_loop,
369 isbn => $data->{'isbn'},
370 seriestitle => $data->{'seriestitle'},
371 quantity => $data->{'quantity'},
372 quantityrec => $data->{'quantity'},
373 rrp => $data->{'rrp'},
374 listprice => sprintf("%.2f", $data->{'listprice'}||$data->{'price'}||$listprice),
375 total => sprintf("%.2f", ($data->{'ecost'}||0)*($data->{'quantity'}||0) ),
376 ecost => $data->{'ecost'},
377 notes => $data->{'notes'},
378 publishercode => $data->{'publishercode'},
380 import_batch_id => $import_batch_id,
382 # CHECKME: gst-stuff needs verifing, mason.
383 gstrate => $bookseller->{'gstrate'} // C4::Context->preference("gist") // 0,
384 gstreg => $bookseller->{'gstreg'},
387 output_html_with_http_headers $input, $cookie, $template->output;
390 =head2 MARCfindbreeding
392 $record = MARCfindbreeding($breedingid);
394 Look up the import record repository for the record with
395 record with id $breedingid. If found, returns the decoded
396 MARC::Record; otherwise, -1 is returned (FIXME).
397 Returns as second parameter the character encoding.
401 sub MARCfindbreeding {
403 my ($marc, $encoding) = GetImportRecordMarc($id);
404 # remove the - in isbn, koha store isbn without any -
406 my $record = MARC::Record->new_from_usmarc($marc);
407 my ($isbnfield,$isbnsubfield) = GetMarcFromKohaField('biblioitems.isbn','');
408 if ( $record->field($isbnfield) ) {
409 foreach my $field ( $record->field($isbnfield) ) {
410 foreach my $subfield ( $field->subfield($isbnsubfield) ) {
411 my $newisbn = $field->subfield($isbnsubfield);
413 $field->update( $isbnsubfield => $newisbn );
417 # fix the unimarc 100 coded field (with unicode information)
418 if (C4::Context->preference('marcflavour') eq 'UNIMARC' && $record->subfield(100,'a')) {
419 my $f100a=$record->subfield(100,'a');
420 my $f100 = $record->field(100);
421 my $f100temp = $f100->as_string;
422 $record->delete_field($f100);
423 if ( length($f100temp) > 28 ) {
424 substr( $f100temp, 26, 2, "50" );
425 $f100->update( 'a' => $f100temp );
426 my $f100 = MARC::Field->new( '100', '', '', 'a' => $f100temp );
427 $record->insert_fields_ordered($f100);
431 if ( !defined(ref($record)) ) {
435 # normalize author : probably UNIMARC specific...
436 if ( C4::Context->preference("z3950NormalizeAuthor")
437 and C4::Context->preference("z3950AuthorAuthFields") )
439 my ( $tag, $subfield ) = GetMarcFromKohaField("biblio.author");
441 # my $summary = C4::Context->preference("z3950authortemplate");
443 C4::Context->preference("z3950AuthorAuthFields");
444 my @auth_fields = split /,/, $auth_fields;
447 if ( $record->field($tag) ) {
448 foreach my $tmpfield ( $record->field($tag)->subfields ) {
450 # foreach my $subfieldcode ($tmpfield->subfields){
451 my $subfieldcode = shift @$tmpfield;
452 my $subfieldvalue = shift @$tmpfield;
454 $field->add_subfields(
455 "$subfieldcode" => $subfieldvalue )
456 if ( $subfieldcode ne $subfield );
460 MARC::Field->new( $tag, "", "",
461 $subfieldcode => $subfieldvalue )
462 if ( $subfieldcode ne $subfield );
466 $record->delete_field( $record->field($tag) );
467 foreach my $fieldtag (@auth_fields) {
468 next unless ( $record->field($fieldtag) );
469 my $lastname = $record->field($fieldtag)->subfield('a');
470 my $firstname = $record->field($fieldtag)->subfield('b');
471 my $title = $record->field($fieldtag)->subfield('c');
472 my $number = $record->field($fieldtag)->subfield('d');
475 # $field->add_subfields("$subfield"=>"[ ".ucfirst($title).ucfirst($firstname)." ".$number." ]");
476 $field->add_subfields(
477 "$subfield" => ucfirst($title) . " "
478 . ucfirst($firstname) . " "
483 # $field->add_subfields("$subfield"=>"[ ".ucfirst($firstname).", ".ucfirst($lastname)." ]");
484 $field->add_subfields(
485 "$subfield" => ucfirst($firstname) . ", "
486 . ucfirst($lastname) );
489 $record->insert_fields_ordered($field);
491 return $record, $encoding;
498 my ($duplicatetitle)= @_;
499 ($template, $loggedinuser, $cookie) = get_template_and_user(
501 template_name => "acqui/neworderempty_duplicate.tmpl",
504 authnotrequired => 0,
505 flagsrequired => { acquisition => 'order_manage' },
511 biblionumber => $biblionumber,
512 basketno => $basketno,
513 booksellerid => $basket->{'booksellerid'},
514 breedingid => $params->{'breedingid'},
515 duplicatetitle => $duplicatetitle,
518 output_html_with_http_headers $input, $cookie, $template->output;