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 GetMarcPrice
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 $marcflavour = C4::Context->preference('marcflavour');
126 my $basket = GetBasket($basketno);
127 my $contract = &GetContract($basket->{contractnumber});
129 #simple parameters reading (all in one :-)
130 my $params = $input->Vars;
131 my $listprice=0; # the price, that can be in MARC record if we have one
132 if ( $ordernumber eq '' and defined $params->{'breedingid'}){
133 #we want to import from the breeding reservoir (from a z3950 search)
134 my ($marcrecord, $encoding) = MARCfindbreeding($params->{'breedingid'});
135 die("Could not find the selected record in the reservoir, bailing") unless $marcrecord;
137 # Remove all the items (952) from the imported record
138 foreach my $item ($marcrecord->field('952')) {
139 $marcrecord->delete_field($item);
144 ($biblionumber,$duplicatetitle) = FindDuplicate($marcrecord);
145 if($biblionumber && !$input->param('use_external_source')) {
146 #if duplicate record found and user did not decide yet, first warn user
147 #and let him choose between using new record or existing record
148 Load_Duplicate($duplicatetitle);
151 #from this point: add a new record
152 if (C4::Context->preference("BiblioAddsAuthorities")){
153 my ($countlinked,$countcreated)=BiblioAddAuthorities($marcrecord, $params->{'frameworkcode'});
156 $params->{'frameworkcode'} or $params->{'frameworkcode'} = "";
157 ( $biblionumber, $bibitemnum ) = AddBiblio( $marcrecord, $params->{'frameworkcode'} );
158 # get the price if there is one.
159 $listprice = GetMarcPrice($marcrecord, $marcflavour);
160 SetImportRecordStatus($params->{'breedingid'}, 'imported');
165 if ( $ordernumber eq '' ) { # create order
168 # $ordernumber=newordernum;
169 if ( $biblionumber && !$suggestionid ) {
170 $data = GetBiblioData($biblionumber);
173 # get suggestion fields if applicable. If it's a subscription renewal, then the biblio already exists
174 # otherwise, retrieve suggestion information.
176 $data = ($biblionumber) ? GetBiblioData($biblionumber) : GetSuggestion($suggestionid);
180 $data = GetOrder($ordernumber);
181 $biblionumber = $data->{'biblionumber'};
182 $budget_id = $data->{'budget_id'};
184 #get basketno and supplierno. too!
185 my $data2 = GetBasket( $data->{'basketno'} );
186 $basketno = $data2->{'basketno'};
187 $booksellerid = $data2->{'booksellerid'};
191 $suggestion = GetSuggestionInfo($suggestionid) if $suggestionid;
193 # get currencies (for change rates calcs if needed)
194 my $active_currency = GetCurrency();
195 my $default_currency;
196 if (! $data->{currency} ) { # New order no currency set
197 if ( $bookseller->{listprice} ) {
198 $default_currency = $bookseller->{listprice};
201 $default_currency = $active_currency->{currency};
205 my @rates = GetCurrencies();
209 my @loop_currency = ();
210 for my $curr ( @rates ) {
212 if ($data->{currency} ) {
213 $selected = $curr->{currency} eq $data->{currency};
216 $selected = $curr->{currency} eq $default_currency;
218 push @loop_currency, {
219 currcode => $curr->{currency},
220 rate => $curr->{rate},
221 selected => $selected,
225 # build branches list
226 my $onlymine=C4::Context->preference('IndependantBranches') &&
227 C4::Context->userenv &&
228 C4::Context->userenv->{flags}!=1 &&
229 C4::Context->userenv->{branch};
230 my $branches = GetBranches($onlymine);
232 foreach my $thisbranch ( sort {$branches->{$a}->{'branchname'} cmp $branches->{$b}->{'branchname'}} keys %$branches ) {
234 value => $thisbranch,
235 branchname => $branches->{$thisbranch}->{'branchname'},
237 $row{'selected'} = 1 if( $thisbranch && $data->{branchcode} && $thisbranch eq $data->{branchcode}) ;
238 push @branchloop, \%row;
240 $template->param( branchloop => \@branchloop );
242 # build bookfund list
243 my $borrower= GetMember('borrowernumber' => $loggedinuser);
244 my ( $flags, $homebranch )= ($borrower->{'flags'},$borrower->{'branchcode'});
246 my $budget = GetBudget($budget_id);
248 my $budget_loop = [];
249 my $budgets = GetBudgetHierarchy(q{},$borrower->{branchcode},$borrower->{borrowernumber});
250 foreach my $r (@{$budgets}) {
251 if (!defined $r->{budget_amount} || $r->{budget_amount} == 0) {
254 push @{$budget_loop}, {
255 b_id => $r->{budget_id},
256 b_txt => $r->{budget_name},
257 b_active => $r->{budget_period_active},
258 b_sel => ( $r->{budget_id} == $budget_id ) ? 1 : 0,
264 $budget_id = $data->{'budget_id'};
265 $budget_name = $budget->{'budget_name'};
270 if ($budget) { # its a mod ..
271 if ( defined $budget->{'sort1_authcat'} ) { # with custom Asort* planning values
272 $CGIsort1 = GetAuthvalueDropbox( $budget->{'sort1_authcat'}, $data->{'sort1'} );
274 } elsif(@{$budgets}){
275 $CGIsort1 = GetAuthvalueDropbox( @$budgets[0]->{'sort1_authcat'}, '' );
277 $CGIsort1 = GetAuthvalueDropbox( '', '' );
280 # if CGIsort is successfully fetched, the use it
281 # else - failback to plain input-field
283 $template->param( CGIsort1 => $CGIsort1 );
285 $template->param( sort1 => $data->{'sort1'} );
290 if ( defined $budget->{'sort2_authcat'} ) {
291 $CGIsort2 = GetAuthvalueDropbox( $budget->{'sort2_authcat'}, $data->{'sort2'} );
293 } elsif(@{$budgets}) {
294 $CGIsort2 = GetAuthvalueDropbox( @$budgets[0]->{sort2_authcat}, '' );
296 $CGIsort2 = GetAuthvalueDropbox( '', '' );
300 $template->param( CGIsort2 => $CGIsort2 );
302 $template->param( sort2 => $data->{'sort2'} );
305 if (C4::Context->preference('AcqCreateItem') eq 'ordering' && !$ordernumber) {
306 # prepare empty item form
307 my $cell = PrepareItemrecordDisplay('','','','ACQ');
308 # warn "==> ".Data::Dumper::Dumper($cell);
310 $cell = PrepareItemrecordDisplay('','','','');
311 $template->param('NoACQframework' => 1);
314 push @itemloop,$cell;
316 $template->param(items => \@itemloop);
318 # 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
320 @itemtypes = C4::ItemType->all unless C4::Context->preference('item-level_itypes');
322 # Find the items.barcode subfield for barcode validations
323 my (undef, $barcode_subfield) = GetMarcFromKohaField('items.barcode', '');
328 budget_id => $budget_id,
329 budget_name => $budget_name
333 existing => $biblionumber,
334 ordernumber => $ordernumber,
335 # basket informations
336 basketno => $basketno,
337 basketname => $basket->{'basketname'},
338 basketnote => $basket->{'note'},
339 booksellerid => $basket->{'booksellerid'},
340 basketbooksellernote => $basket->{booksellernote},
341 basketcontractno => $basket->{contractnumber},
342 basketcontractname => $contract->{contractname},
343 creationdate => C4::Dates->new($basket->{creationdate},'iso')->output,
344 authorisedby => $basket->{'authorisedby'},
345 authorisedbyname => $basket->{'authorisedbyname'},
346 closedate => C4::Dates->new($basket->{'closedate'},'iso')->output,
348 suggestionid => $suggestion->{suggestionid},
349 surnamesuggestedby => $suggestion->{surnamesuggestedby},
350 firstnamesuggestedby => $suggestion->{firstnamesuggestedby},
351 biblionumber => $biblionumber,
352 uncertainprice => $data->{'uncertainprice'},
353 authorisedbyname => $borrower->{'firstname'} . " " . $borrower->{'surname'},
354 biblioitemnumber => $data->{'biblioitemnumber'},
355 discount_2dp => sprintf( "%.2f", $bookseller->{'discount'}) , # for display
356 discount => $bookseller->{'discount'},
357 listincgst => $bookseller->{'listincgst'},
358 invoiceincgst => $bookseller->{'invoiceincgst'},
359 name => $bookseller->{'name'},
360 cur_active_sym => $active_currency->{'symbol'},
361 cur_active => $active_currency->{'currency'},
362 loop_currencies => \@loop_currency,
363 orderexists => ( $new eq 'yes' ) ? 0 : 1,
364 title => $data->{'title'},
365 author => $data->{'author'},
366 publicationyear => $data->{'publicationyear'} ? $data->{'publicationyear'} : $data->{'copyrightdate'},
367 editionstatement => $data->{'editionstatement'},
368 budget_loop => $budget_loop,
369 isbn => $data->{'isbn'},
370 seriestitle => $data->{'seriestitle'},
371 itemtypeloop => \@itemtypes,
372 quantity => $data->{'quantity'},
373 quantityrec => $data->{'quantity'},
374 rrp => $data->{'rrp'},
375 listprice => sprintf("%.2f", $data->{'listprice'}||$data->{'price'}||$listprice),
376 total => sprintf("%.2f", ($data->{'ecost'}||0)*($data->{'quantity'}||0) ),
377 ecost => $data->{'ecost'},
378 unitprice => sprintf("%.2f", $data->{'unitprice'}),
379 notes => $data->{'notes'},
380 publishercode => $data->{'publishercode'},
381 barcode_subfield => $barcode_subfield,
383 import_batch_id => $import_batch_id,
385 # CHECKME: gst-stuff needs verifing, mason.
386 gstrate => $bookseller->{'gstrate'} // C4::Context->preference("gist") // 0,
387 gstreg => $bookseller->{'gstreg'},
390 output_html_with_http_headers $input, $cookie, $template->output;
393 =head2 MARCfindbreeding
395 $record = MARCfindbreeding($breedingid);
397 Look up the import record repository for the record with
398 record with id $breedingid. If found, returns the decoded
399 MARC::Record; otherwise, -1 is returned (FIXME).
400 Returns as second parameter the character encoding.
404 sub MARCfindbreeding {
406 my ($marc, $encoding) = GetImportRecordMarc($id);
407 # remove the - in isbn, koha store isbn without any -
409 my $record = MARC::Record->new_from_usmarc($marc);
410 my ($isbnfield,$isbnsubfield) = GetMarcFromKohaField('biblioitems.isbn','');
411 if ( $record->field($isbnfield) ) {
412 foreach my $field ( $record->field($isbnfield) ) {
413 foreach my $subfield ( $field->subfield($isbnsubfield) ) {
414 my $newisbn = $field->subfield($isbnsubfield);
416 $field->update( $isbnsubfield => $newisbn );
420 # fix the unimarc 100 coded field (with unicode information)
421 if ($marcflavour eq 'UNIMARC' && $record->subfield(100,'a')) {
422 my $f100a=$record->subfield(100,'a');
423 my $f100 = $record->field(100);
424 my $f100temp = $f100->as_string;
425 $record->delete_field($f100);
426 if ( length($f100temp) > 28 ) {
427 substr( $f100temp, 26, 2, "50" );
428 $f100->update( 'a' => $f100temp );
429 my $f100 = MARC::Field->new( '100', '', '', 'a' => $f100temp );
430 $record->insert_fields_ordered($f100);
434 if ( !defined(ref($record)) ) {
438 # normalize author : probably UNIMARC specific...
439 if ( C4::Context->preference("z3950NormalizeAuthor")
440 and C4::Context->preference("z3950AuthorAuthFields") )
442 my ( $tag, $subfield ) = GetMarcFromKohaField("biblio.author");
444 # my $summary = C4::Context->preference("z3950authortemplate");
446 C4::Context->preference("z3950AuthorAuthFields");
447 my @auth_fields = split /,/, $auth_fields;
450 if ( $record->field($tag) ) {
451 foreach my $tmpfield ( $record->field($tag)->subfields ) {
453 # foreach my $subfieldcode ($tmpfield->subfields){
454 my $subfieldcode = shift @$tmpfield;
455 my $subfieldvalue = shift @$tmpfield;
457 $field->add_subfields(
458 "$subfieldcode" => $subfieldvalue )
459 if ( $subfieldcode ne $subfield );
463 MARC::Field->new( $tag, "", "",
464 $subfieldcode => $subfieldvalue )
465 if ( $subfieldcode ne $subfield );
469 $record->delete_field( $record->field($tag) );
470 foreach my $fieldtag (@auth_fields) {
471 next unless ( $record->field($fieldtag) );
472 my $lastname = $record->field($fieldtag)->subfield('a');
473 my $firstname = $record->field($fieldtag)->subfield('b');
474 my $title = $record->field($fieldtag)->subfield('c');
475 my $number = $record->field($fieldtag)->subfield('d');
478 # $field->add_subfields("$subfield"=>"[ ".ucfirst($title).ucfirst($firstname)." ".$number." ]");
479 $field->add_subfields(
480 "$subfield" => ucfirst($title) . " "
481 . ucfirst($firstname) . " "
486 # $field->add_subfields("$subfield"=>"[ ".ucfirst($firstname).", ".ucfirst($lastname)." ]");
487 $field->add_subfields(
488 "$subfield" => ucfirst($firstname) . ", "
489 . ucfirst($lastname) );
492 $record->insert_fields_ordered($field);
494 return $record, $encoding;
501 my ($duplicatetitle)= @_;
502 ($template, $loggedinuser, $cookie) = get_template_and_user(
504 template_name => "acqui/neworderempty_duplicate.tmpl",
507 authnotrequired => 0,
508 flagsrequired => { acquisition => 'order_manage' },
514 biblionumber => $biblionumber,
515 basketno => $basketno,
516 booksellerid => $basket->{'booksellerid'},
517 breedingid => $params->{'breedingid'},
518 duplicatetitle => $duplicatetitle,
521 output_html_with_http_headers $input, $cookie, $template->output;