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;
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;
135 # Remove all the items (952) from the imported record
136 foreach my $item ($marcrecord->field('952')) {
137 $marcrecord->delete_field($item);
142 ($biblionumber,$duplicatetitle) = FindDuplicate($marcrecord);
143 if($biblionumber && !$input->param('use_external_source')) {
144 #if duplicate record found and user did not decide yet, first warn user
145 #and let him choose between using new record or existing record
146 Load_Duplicate($duplicatetitle);
149 #from this point: add a new record
150 if (C4::Context->preference("BiblioAddsAuthorities")){
151 my ($countlinked,$countcreated)=BiblioAddAuthorities($marcrecord, $params->{'frameworkcode'});
154 $params->{'frameworkcode'} or $params->{'frameworkcode'} = "";
155 ( $biblionumber, $bibitemnum ) = AddBiblio( $marcrecord, $params->{'frameworkcode'} );
156 # get the price if there is one.
157 # filter by storing only the 1st number
158 # we suppose the currency is correct, as we have no possibilities to get it.
159 if ($marcrecord->subfield("345","d")) {
160 $listprice = $marcrecord->subfield("345","d");
161 if ($listprice =~ /^([\d\.,]*)/) {
163 $listprice =~ s/,/\./;
168 elsif ($marcrecord->subfield("010","d")) {
169 $listprice = $marcrecord->subfield("010","d");
170 if ($listprice =~ /^([\d\.,]*)/) {
172 $listprice =~ s/,/\./;
177 SetImportRecordStatus($params->{'breedingid'}, 'imported');
182 if ( $ordernumber eq '' ) { # create order
185 # $ordernumber=newordernum;
186 if ( $biblionumber && !$suggestionid ) {
187 $data = GetBiblioData($biblionumber);
190 # get suggestion fields if applicable. If it's a subscription renewal, then the biblio already exists
191 # otherwise, retrieve suggestion information.
193 $data = ($biblionumber) ? GetBiblioData($biblionumber) : GetSuggestion($suggestionid);
197 $data = GetOrder($ordernumber);
198 $biblionumber = $data->{'biblionumber'};
199 $budget_id = $data->{'budget_id'};
201 #get basketno and supplierno. too!
202 my $data2 = GetBasket( $data->{'basketno'} );
203 $basketno = $data2->{'basketno'};
204 $booksellerid = $data2->{'booksellerid'};
208 $suggestion = GetSuggestionInfo($suggestionid) if $suggestionid;
210 # get currencies (for change rates calcs if needed)
211 my $active_currency = GetCurrency();
212 my $default_currency;
213 if (! $data->{currency} ) { # New order no currency set
214 if ( $bookseller->{listprice} ) {
215 $default_currency = $bookseller->{listprice};
218 $default_currency = $active_currency->{currency};
222 my @rates = GetCurrencies();
226 my @loop_currency = ();
227 for my $curr ( @rates ) {
229 if ($data->{currency} ) {
230 $selected = $curr->{currency} eq $data->{currency};
233 $selected = $curr->{currency} eq $default_currency;
235 push @loop_currency, {
236 currcode => $curr->{currency},
237 rate => $curr->{rate},
238 selected => $selected,
242 # build branches list
243 my $onlymine=C4::Context->preference('IndependantBranches') &&
244 C4::Context->userenv &&
245 C4::Context->userenv->{flags}!=1 &&
246 C4::Context->userenv->{branch};
247 my $branches = GetBranches($onlymine);
249 foreach my $thisbranch ( sort {$branches->{$a}->{'branchname'} cmp $branches->{$b}->{'branchname'}} keys %$branches ) {
251 value => $thisbranch,
252 branchname => $branches->{$thisbranch}->{'branchname'},
254 $row{'selected'} = 1 if( $thisbranch && $data->{branchcode} && $thisbranch eq $data->{branchcode}) ;
255 push @branchloop, \%row;
257 $template->param( branchloop => \@branchloop );
259 # build bookfund list
260 my $borrower= GetMember('borrowernumber' => $loggedinuser);
261 my ( $flags, $homebranch )= ($borrower->{'flags'},$borrower->{'branchcode'});
263 my $budget = GetBudget($budget_id);
265 my $budget_loop = [];
266 my $budgets = GetBudgetHierarchy(q{},$borrower->{branchcode},$borrower->{borrowernumber});
267 foreach my $r (@{$budgets}) {
268 if (!defined $r->{budget_amount} || $r->{budget_amount} == 0) {
271 push @{$budget_loop}, {
272 b_id => $r->{budget_id},
273 b_txt => $r->{budget_name},
274 b_active => $r->{budget_period_active},
275 b_sel => ( $r->{budget_id} == $budget_id ) ? 1 : 0,
281 $budget_id = $data->{'budget_id'};
282 $budget_name = $budget->{'budget_name'};
287 if ($budget) { # its a mod ..
288 if ( defined $budget->{'sort1_authcat'} ) { # with custom Asort* planning values
289 $CGIsort1 = GetAuthvalueDropbox( $budget->{'sort1_authcat'}, $data->{'sort1'} );
291 } elsif(@{$budgets}){
292 $CGIsort1 = GetAuthvalueDropbox( @$budgets[0]->{'sort1_authcat'}, '' );
294 $CGIsort1 = GetAuthvalueDropbox( '', '' );
297 # if CGIsort is successfully fetched, the use it
298 # else - failback to plain input-field
300 $template->param( CGIsort1 => $CGIsort1 );
302 $template->param( sort1 => $data->{'sort1'} );
307 if ( defined $budget->{'sort2_authcat'} ) {
308 $CGIsort2 = GetAuthvalueDropbox( $budget->{'sort2_authcat'}, $data->{'sort2'} );
310 } elsif(@{$budgets}) {
311 $CGIsort2 = GetAuthvalueDropbox( @$budgets[0]->{sort2_authcat}, '' );
313 $CGIsort2 = GetAuthvalueDropbox( '', '' );
317 $template->param( CGIsort2 => $CGIsort2 );
319 $template->param( sort2 => $data->{'sort2'} );
322 if (C4::Context->preference('AcqCreateItem') eq 'ordering' && !$ordernumber) {
323 # prepare empty item form
324 my $cell = PrepareItemrecordDisplay('','','','ACQ');
325 # warn "==> ".Data::Dumper::Dumper($cell);
327 $cell = PrepareItemrecordDisplay('','','','');
328 $template->param('NoACQframework' => 1);
331 push @itemloop,$cell;
333 $template->param(items => \@itemloop);
335 # 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
337 @itemtypes = C4::ItemType->all unless C4::Context->preference('item-level_itypes');
339 # Find the items.barcode subfield for barcode validations
340 my (undef, $barcode_subfield) = GetMarcFromKohaField('items.barcode', '');
345 budget_id => $budget_id,
346 budget_name => $budget_name
350 existing => $biblionumber,
351 ordernumber => $ordernumber,
352 # basket informations
353 basketno => $basketno,
354 basketname => $basket->{'basketname'},
355 basketnote => $basket->{'note'},
356 booksellerid => $basket->{'booksellerid'},
357 basketbooksellernote => $basket->{booksellernote},
358 basketcontractno => $basket->{contractnumber},
359 basketcontractname => $contract->{contractname},
360 creationdate => C4::Dates->new($basket->{creationdate},'iso')->output,
361 authorisedby => $basket->{'authorisedby'},
362 authorisedbyname => $basket->{'authorisedbyname'},
363 closedate => C4::Dates->new($basket->{'closedate'},'iso')->output,
365 suggestionid => $suggestion->{suggestionid},
366 surnamesuggestedby => $suggestion->{surnamesuggestedby},
367 firstnamesuggestedby => $suggestion->{firstnamesuggestedby},
368 biblionumber => $biblionumber,
369 uncertainprice => $data->{'uncertainprice'},
370 authorisedbyname => $borrower->{'firstname'} . " " . $borrower->{'surname'},
371 biblioitemnumber => $data->{'biblioitemnumber'},
372 discount_2dp => sprintf( "%.2f", $bookseller->{'discount'}) , # for display
373 discount => $bookseller->{'discount'},
374 listincgst => $bookseller->{'listincgst'},
375 invoiceincgst => $bookseller->{'invoiceincgst'},
376 name => $bookseller->{'name'},
377 cur_active_sym => $active_currency->{'symbol'},
378 cur_active => $active_currency->{'currency'},
379 loop_currencies => \@loop_currency,
380 orderexists => ( $new eq 'yes' ) ? 0 : 1,
381 title => $data->{'title'},
382 author => $data->{'author'},
383 publicationyear => $data->{'publicationyear'} ? $data->{'publicationyear'} : $data->{'copyrightdate'},
384 editionstatement => $data->{'editionstatement'},
385 budget_loop => $budget_loop,
386 isbn => $data->{'isbn'},
387 seriestitle => $data->{'seriestitle'},
388 itemtypeloop => \@itemtypes,
389 quantity => $data->{'quantity'},
390 quantityrec => $data->{'quantity'},
391 rrp => $data->{'rrp'},
392 listprice => sprintf("%.2f", $data->{'listprice'}||$data->{'price'}||$listprice),
393 total => sprintf("%.2f", ($data->{'ecost'}||0)*($data->{'quantity'}||0) ),
394 ecost => $data->{'ecost'},
395 unitprice => sprintf("%.2f", $data->{'unitprice'}),
396 notes => $data->{'notes'},
397 publishercode => $data->{'publishercode'},
398 barcode_subfield => $barcode_subfield,
400 import_batch_id => $import_batch_id,
402 # CHECKME: gst-stuff needs verifing, mason.
403 gstrate => $bookseller->{'gstrate'} // C4::Context->preference("gist") // 0,
404 gstreg => $bookseller->{'gstreg'},
407 output_html_with_http_headers $input, $cookie, $template->output;
410 =head2 MARCfindbreeding
412 $record = MARCfindbreeding($breedingid);
414 Look up the import record repository for the record with
415 record with id $breedingid. If found, returns the decoded
416 MARC::Record; otherwise, -1 is returned (FIXME).
417 Returns as second parameter the character encoding.
421 sub MARCfindbreeding {
423 my ($marc, $encoding) = GetImportRecordMarc($id);
424 # remove the - in isbn, koha store isbn without any -
426 my $record = MARC::Record->new_from_usmarc($marc);
427 my ($isbnfield,$isbnsubfield) = GetMarcFromKohaField('biblioitems.isbn','');
428 if ( $record->field($isbnfield) ) {
429 foreach my $field ( $record->field($isbnfield) ) {
430 foreach my $subfield ( $field->subfield($isbnsubfield) ) {
431 my $newisbn = $field->subfield($isbnsubfield);
433 $field->update( $isbnsubfield => $newisbn );
437 # fix the unimarc 100 coded field (with unicode information)
438 if (C4::Context->preference('marcflavour') eq 'UNIMARC' && $record->subfield(100,'a')) {
439 my $f100a=$record->subfield(100,'a');
440 my $f100 = $record->field(100);
441 my $f100temp = $f100->as_string;
442 $record->delete_field($f100);
443 if ( length($f100temp) > 28 ) {
444 substr( $f100temp, 26, 2, "50" );
445 $f100->update( 'a' => $f100temp );
446 my $f100 = MARC::Field->new( '100', '', '', 'a' => $f100temp );
447 $record->insert_fields_ordered($f100);
451 if ( !defined(ref($record)) ) {
455 # normalize author : probably UNIMARC specific...
456 if ( C4::Context->preference("z3950NormalizeAuthor")
457 and C4::Context->preference("z3950AuthorAuthFields") )
459 my ( $tag, $subfield ) = GetMarcFromKohaField("biblio.author");
461 # my $summary = C4::Context->preference("z3950authortemplate");
463 C4::Context->preference("z3950AuthorAuthFields");
464 my @auth_fields = split /,/, $auth_fields;
467 if ( $record->field($tag) ) {
468 foreach my $tmpfield ( $record->field($tag)->subfields ) {
470 # foreach my $subfieldcode ($tmpfield->subfields){
471 my $subfieldcode = shift @$tmpfield;
472 my $subfieldvalue = shift @$tmpfield;
474 $field->add_subfields(
475 "$subfieldcode" => $subfieldvalue )
476 if ( $subfieldcode ne $subfield );
480 MARC::Field->new( $tag, "", "",
481 $subfieldcode => $subfieldvalue )
482 if ( $subfieldcode ne $subfield );
486 $record->delete_field( $record->field($tag) );
487 foreach my $fieldtag (@auth_fields) {
488 next unless ( $record->field($fieldtag) );
489 my $lastname = $record->field($fieldtag)->subfield('a');
490 my $firstname = $record->field($fieldtag)->subfield('b');
491 my $title = $record->field($fieldtag)->subfield('c');
492 my $number = $record->field($fieldtag)->subfield('d');
495 # $field->add_subfields("$subfield"=>"[ ".ucfirst($title).ucfirst($firstname)." ".$number." ]");
496 $field->add_subfields(
497 "$subfield" => ucfirst($title) . " "
498 . ucfirst($firstname) . " "
503 # $field->add_subfields("$subfield"=>"[ ".ucfirst($firstname).", ".ucfirst($lastname)." ]");
504 $field->add_subfields(
505 "$subfield" => ucfirst($firstname) . ", "
506 . ucfirst($lastname) );
509 $record->insert_fields_ordered($field);
511 return $record, $encoding;
518 my ($duplicatetitle)= @_;
519 ($template, $loggedinuser, $cookie) = get_template_and_user(
521 template_name => "acqui/neworderempty_duplicate.tmpl",
524 authnotrequired => 0,
525 flagsrequired => { acquisition => 'order_manage' },
531 biblionumber => $biblionumber,
532 basketno => $basketno,
533 booksellerid => $basket->{'booksellerid'},
534 breedingid => $params->{'breedingid'},
535 duplicatetitle => $duplicatetitle,
538 output_html_with_http_headers $input, $cookie, $template->output;