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 budget_loop => $budget_loop,
385 isbn => $data->{'isbn'},
386 seriestitle => $data->{'seriestitle'},
387 itemtypeloop => \@itemtypes,
388 quantity => $data->{'quantity'},
389 quantityrec => $data->{'quantity'},
390 rrp => $data->{'rrp'},
391 listprice => sprintf("%.2f", $data->{'listprice'}||$data->{'price'}||$listprice),
392 total => sprintf("%.2f", ($data->{'ecost'}||0)*($data->{'quantity'}||0) ),
393 ecost => $data->{'ecost'},
394 unitprice => sprintf("%.2f", $data->{'unitprice'}),
395 notes => $data->{'notes'},
396 publishercode => $data->{'publishercode'},
397 barcode_subfield => $barcode_subfield,
399 import_batch_id => $import_batch_id,
401 # CHECKME: gst-stuff needs verifing, mason.
402 gstrate => $bookseller->{'gstrate'} // C4::Context->preference("gist") // 0,
403 gstreg => $bookseller->{'gstreg'},
406 output_html_with_http_headers $input, $cookie, $template->output;
409 =head2 MARCfindbreeding
411 $record = MARCfindbreeding($breedingid);
413 Look up the import record repository for the record with
414 record with id $breedingid. If found, returns the decoded
415 MARC::Record; otherwise, -1 is returned (FIXME).
416 Returns as second parameter the character encoding.
420 sub MARCfindbreeding {
422 my ($marc, $encoding) = GetImportRecordMarc($id);
423 # remove the - in isbn, koha store isbn without any -
425 my $record = MARC::Record->new_from_usmarc($marc);
426 my ($isbnfield,$isbnsubfield) = GetMarcFromKohaField('biblioitems.isbn','');
427 if ( $record->field($isbnfield) ) {
428 foreach my $field ( $record->field($isbnfield) ) {
429 foreach my $subfield ( $field->subfield($isbnsubfield) ) {
430 my $newisbn = $field->subfield($isbnsubfield);
432 $field->update( $isbnsubfield => $newisbn );
436 # fix the unimarc 100 coded field (with unicode information)
437 if (C4::Context->preference('marcflavour') eq 'UNIMARC' && $record->subfield(100,'a')) {
438 my $f100a=$record->subfield(100,'a');
439 my $f100 = $record->field(100);
440 my $f100temp = $f100->as_string;
441 $record->delete_field($f100);
442 if ( length($f100temp) > 28 ) {
443 substr( $f100temp, 26, 2, "50" );
444 $f100->update( 'a' => $f100temp );
445 my $f100 = MARC::Field->new( '100', '', '', 'a' => $f100temp );
446 $record->insert_fields_ordered($f100);
450 if ( !defined(ref($record)) ) {
454 # normalize author : probably UNIMARC specific...
455 if ( C4::Context->preference("z3950NormalizeAuthor")
456 and C4::Context->preference("z3950AuthorAuthFields") )
458 my ( $tag, $subfield ) = GetMarcFromKohaField("biblio.author");
460 # my $summary = C4::Context->preference("z3950authortemplate");
462 C4::Context->preference("z3950AuthorAuthFields");
463 my @auth_fields = split /,/, $auth_fields;
466 if ( $record->field($tag) ) {
467 foreach my $tmpfield ( $record->field($tag)->subfields ) {
469 # foreach my $subfieldcode ($tmpfield->subfields){
470 my $subfieldcode = shift @$tmpfield;
471 my $subfieldvalue = shift @$tmpfield;
473 $field->add_subfields(
474 "$subfieldcode" => $subfieldvalue )
475 if ( $subfieldcode ne $subfield );
479 MARC::Field->new( $tag, "", "",
480 $subfieldcode => $subfieldvalue )
481 if ( $subfieldcode ne $subfield );
485 $record->delete_field( $record->field($tag) );
486 foreach my $fieldtag (@auth_fields) {
487 next unless ( $record->field($fieldtag) );
488 my $lastname = $record->field($fieldtag)->subfield('a');
489 my $firstname = $record->field($fieldtag)->subfield('b');
490 my $title = $record->field($fieldtag)->subfield('c');
491 my $number = $record->field($fieldtag)->subfield('d');
494 # $field->add_subfields("$subfield"=>"[ ".ucfirst($title).ucfirst($firstname)." ".$number." ]");
495 $field->add_subfields(
496 "$subfield" => ucfirst($title) . " "
497 . ucfirst($firstname) . " "
502 # $field->add_subfields("$subfield"=>"[ ".ucfirst($firstname).", ".ucfirst($lastname)." ]");
503 $field->add_subfields(
504 "$subfield" => ucfirst($firstname) . ", "
505 . ucfirst($lastname) );
508 $record->insert_fields_ordered($field);
510 return $record, $encoding;
517 my ($duplicatetitle)= @_;
518 ($template, $loggedinuser, $cookie) = get_template_and_user(
520 template_name => "acqui/neworderempty_duplicate.tmpl",
523 authnotrequired => 0,
524 flagsrequired => { acquisition => 'order_manage' },
530 biblionumber => $biblionumber,
531 basketno => $basketno,
532 booksellerid => $basket->{'booksellerid'},
533 breedingid => $params->{'breedingid'},
534 duplicatetitle => $duplicatetitle,
537 output_html_with_http_headers $input, $cookie, $template->output;