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');
176 my $cur = GetCurrency();
178 if ( $ordernumber eq '' ) { # create order
181 # $ordernumber=newordernum;
182 if ( $biblionumber && !$suggestionid ) {
183 $data = GetBiblioData($biblionumber);
186 # get suggestion fields if applicable. If it's a subscription renewal, then the biblio already exists
187 # otherwise, retrieve suggestion information.
189 $data = ($biblionumber) ? GetBiblioData($biblionumber) : GetSuggestion($suggestionid);
193 $data = GetOrder($ordernumber);
194 $biblionumber = $data->{'biblionumber'};
195 $budget_id = $data->{'budget_id'};
197 #get basketno and supplierno. too!
198 my $data2 = GetBasket( $data->{'basketno'} );
199 $basketno = $data2->{'basketno'};
200 $booksellerid = $data2->{'booksellerid'};
203 # get currencies (for change rates calcs if needed)
204 my @rates = GetCurrencies();
205 my $count = scalar @rates;
209 my @loop_currency = ();
210 for ( my $i = 0 ; $i < $count ; $i++ ) {
212 $line{currcode} = $rates[$i]->{'currency'};
213 $line{rate} = $rates[$i]->{'rate'};
214 $line{selected} = 1 if ($line{currcode} eq $data->{currency});
215 push @loop_currency, \%line;
218 # build branches list
219 my $onlymine=C4::Context->preference('IndependantBranches') &&
220 C4::Context->userenv &&
221 C4::Context->userenv->{flags}!=1 &&
222 C4::Context->userenv->{branch};
223 my $branches = GetBranches($onlymine);
225 foreach my $thisbranch ( sort {$branches->{$a}->{'branchname'} cmp $branches->{$b}->{'branchname'}} keys %$branches ) {
227 value => $thisbranch,
228 branchname => $branches->{$thisbranch}->{'branchname'},
230 $row{'selected'} = 1 if( $thisbranch eq $data->{branchcode}) ;
231 push @branchloop, \%row;
233 $template->param( branchloop => \@branchloop );
235 # build bookfund list
236 my $borrower= GetMember('borrowernumber' => $loggedinuser);
237 my ( $flags, $homebranch )= ($borrower->{'flags'},$borrower->{'branchcode'});
239 my $budget = GetBudget($budget_id);
241 my $budget_loop = [];
242 my $budgets = GetBudgetHierarchy(q{},$borrower->{branchcode},$borrower->{borrowernumber});
243 foreach my $r (@{$budgets}) {
244 if (!defined $r->{budget_amount} || $r->{budget_amount} == 0) {
247 push @{$budget_loop}, {
248 b_id => $r->{budget_id},
249 b_txt => $r->{budget_name},
250 b_sel => ( $r->{budget_id} == $budget_id ) ? 1 : 0,
256 $budget_id = $data->{'budget_id'};
257 $budget_name = $budget->{'budget_name'};
262 if ($budget) { # its a mod ..
263 if ( defined $budget->{'sort1_authcat'} ) { # with custom Asort* planning values
264 $CGIsort1 = GetAuthvalueDropbox( 'sort1', $budget->{'sort1_authcat'}, $data->{'sort1'} );
266 } elsif(scalar(@$budgets)){
267 $CGIsort1 = GetAuthvalueDropbox( 'sort1', @$budgets[0]->{'sort1_authcat'}, '' );
269 $CGIsort1 = GetAuthvalueDropbox( 'sort1','', '' );
272 # if CGIsort is successfully fetched, the use it
273 # else - failback to plain input-field
275 $template->param( CGIsort1 => $CGIsort1 );
277 $template->param( sort1 => $data->{'sort1'} );
282 if ( defined $budget->{'sort2_authcat'} ) {
283 $CGIsort2 = GetAuthvalueDropbox( 'sort2', $budget->{'sort2_authcat'}, $data->{'sort2'} );
285 } elsif(scalar(@$budgets)) {
286 $CGIsort2 = GetAuthvalueDropbox( 'sort2', @$budgets[0]->{sort2_authcat}, '' );
288 $CGIsort2 = GetAuthvalueDropbox( 'sort2','', '' );
292 $template->param( CGIsort2 => $CGIsort2 );
294 $template->param( sort2 => $data->{'sort2'} );
297 if (C4::Context->preference('AcqCreateItem') eq 'ordering' && !$ordernumber) {
298 # prepare empty item form
299 my $cell = PrepareItemrecordDisplay('','','','ACQ');
300 # warn "==> ".Data::Dumper::Dumper($cell);
302 $cell = PrepareItemrecordDisplay('','','','');
303 $template->param('NoACQframework' => 1);
306 push @itemloop,$cell;
308 $template->param(items => \@itemloop);
314 budget_id => $budget_id,
315 budget_name => $budget_name
319 existing => $biblionumber,
320 ordernumber => $ordernumber,
321 # basket informations
322 basketno => $basketno,
323 basketname => $basket->{'basketname'},
324 basketnote => $basket->{'note'},
325 booksellerid => $basket->{'booksellerid'},
326 basketbooksellernote => $basket->{booksellernote},
327 basketcontractno => $basket->{contractnumber},
328 basketcontractname => $contract->{contractname},
329 creationdate => C4::Dates->new($basket->{creationdate},'iso')->output,
330 authorisedby => $basket->{'authorisedby'},
331 authorisedbyname => $basket->{'authorisedbyname'},
332 closedate => C4::Dates->new($basket->{'closedate'},'iso')->output,
334 suggestionid => $suggestionid,
335 biblionumber => $biblionumber,
336 uncertainprice => $data->{'uncertainprice'},
337 authorisedbyname => $borrower->{'firstname'} . " " . $borrower->{'surname'},
338 biblioitemnumber => $data->{'biblioitemnumber'},
339 discount_2dp => sprintf( "%.2f", $bookseller->{'discount'}) , # for display
340 discount => $bookseller->{'discount'},
341 listincgst => $bookseller->{'listincgst'},
342 invoiceincgst => $bookseller->{'invoiceincgst'},
343 name => $bookseller->{'name'},
344 cur_active_sym => $cur->{'symbol'},
345 cur_active => $cur->{'currency'},
346 # currency => $bookseller->{'listprice'} || $cur->{'currency'}, # eg: 'EUR'
347 loop_currencies => \@loop_currency,
348 orderexists => ( $new eq 'yes' ) ? 0 : 1,
349 title => $data->{'title'},
350 author => $data->{'author'},
351 publicationyear => $data->{'publicationyear'} ? $data->{'publicationyear'} : $data->{'copyrightdate'},
352 budget_loop => $budget_loop,
353 isbn => $data->{'isbn'},
354 seriestitle => $data->{'seriestitle'},
355 quantity => $data->{'quantity'},
356 quantityrec => $data->{'quantity'},
357 rrp => $data->{'rrp'},
358 listprice => sprintf("%.2f", $data->{'listprice'}||$data->{'price'}||$listprice),
359 total => sprintf("%.2f", ($data->{'ecost'}||0)*($data->{'quantity'}||0) ),
360 ecost => $data->{'ecost'},
361 notes => $data->{'notes'},
362 publishercode => $data->{'publishercode'},
364 import_batch_id => $import_batch_id,
366 # CHECKME: gst-stuff needs verifing, mason.
367 gstrate => $bookseller->{'gstrate'} // C4::Context->preference("gist") // 0,
368 gstreg => $bookseller->{'gstreg'},
371 output_html_with_http_headers $input, $cookie, $template->output;
374 =head2 MARCfindbreeding
376 $record = MARCfindbreeding($breedingid);
378 Look up the import record repository for the record with
379 record with id $breedingid. If found, returns the decoded
380 MARC::Record; otherwise, -1 is returned (FIXME).
381 Returns as second parameter the character encoding.
385 sub MARCfindbreeding {
387 my ($marc, $encoding) = GetImportRecordMarc($id);
388 # remove the - in isbn, koha store isbn without any -
390 my $record = MARC::Record->new_from_usmarc($marc);
391 my ($isbnfield,$isbnsubfield) = GetMarcFromKohaField('biblioitems.isbn','');
392 if ( $record->field($isbnfield) ) {
393 foreach my $field ( $record->field($isbnfield) ) {
394 foreach my $subfield ( $field->subfield($isbnsubfield) ) {
395 my $newisbn = $field->subfield($isbnsubfield);
397 $field->update( $isbnsubfield => $newisbn );
401 # fix the unimarc 100 coded field (with unicode information)
402 if (C4::Context->preference('marcflavour') eq 'UNIMARC' && $record->subfield(100,'a')) {
403 my $f100a=$record->subfield(100,'a');
404 my $f100 = $record->field(100);
405 my $f100temp = $f100->as_string;
406 $record->delete_field($f100);
407 if ( length($f100temp) > 28 ) {
408 substr( $f100temp, 26, 2, "50" );
409 $f100->update( 'a' => $f100temp );
410 my $f100 = MARC::Field->new( '100', '', '', 'a' => $f100temp );
411 $record->insert_fields_ordered($f100);
415 if ( !defined(ref($record)) ) {
419 # normalize author : probably UNIMARC specific...
420 if ( C4::Context->preference("z3950NormalizeAuthor")
421 and C4::Context->preference("z3950AuthorAuthFields") )
423 my ( $tag, $subfield ) = GetMarcFromKohaField("biblio.author");
425 # my $summary = C4::Context->preference("z3950authortemplate");
427 C4::Context->preference("z3950AuthorAuthFields");
428 my @auth_fields = split /,/, $auth_fields;
431 if ( $record->field($tag) ) {
432 foreach my $tmpfield ( $record->field($tag)->subfields ) {
434 # foreach my $subfieldcode ($tmpfield->subfields){
435 my $subfieldcode = shift @$tmpfield;
436 my $subfieldvalue = shift @$tmpfield;
438 $field->add_subfields(
439 "$subfieldcode" => $subfieldvalue )
440 if ( $subfieldcode ne $subfield );
444 MARC::Field->new( $tag, "", "",
445 $subfieldcode => $subfieldvalue )
446 if ( $subfieldcode ne $subfield );
450 $record->delete_field( $record->field($tag) );
451 foreach my $fieldtag (@auth_fields) {
452 next unless ( $record->field($fieldtag) );
453 my $lastname = $record->field($fieldtag)->subfield('a');
454 my $firstname = $record->field($fieldtag)->subfield('b');
455 my $title = $record->field($fieldtag)->subfield('c');
456 my $number = $record->field($fieldtag)->subfield('d');
459 # $field->add_subfields("$subfield"=>"[ ".ucfirst($title).ucfirst($firstname)." ".$number." ]");
460 $field->add_subfields(
461 "$subfield" => ucfirst($title) . " "
462 . ucfirst($firstname) . " "
467 # $field->add_subfields("$subfield"=>"[ ".ucfirst($firstname).", ".ucfirst($lastname)." ]");
468 $field->add_subfields(
469 "$subfield" => ucfirst($firstname) . ", "
470 . ucfirst($lastname) );
473 $record->insert_fields_ordered($field);
475 return $record, $encoding;
482 my ($duplicatetitle)= @_;
483 ($template, $loggedinuser, $cookie) = get_template_and_user(
485 template_name => "acqui/neworderempty_duplicate.tmpl",
488 authnotrequired => 0,
489 flagsrequired => { acquisition => 'order_manage' },
495 biblionumber => $biblionumber,
496 basketno => $basketno,
497 booksellerid => $basket->{'booksellerid'},
498 breedingid => $params->{'breedingid'},
499 duplicatetitle => $duplicatetitle,
502 output_html_with_http_headers $input, $cookie, $template->output;