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; # 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;
135 # Remove all the items (952) from the imported record
136 foreach my $item ($marcrecord->field('952')) {
137 $marcrecord->delete_field($item);
142 if (! (($biblionumber,$duplicatetitle) = FindDuplicate($marcrecord))){
143 if (C4::Context->preference("BiblioAddsAuthorities")){
144 my ($countlinked,$countcreated)=BiblioAddAuthorities($marcrecord, $params->{'frameworkcode'});
147 $params->{'frameworkcode'} or $params->{'frameworkcode'} = "";
148 ( $biblionumber, $bibitemnum ) = AddBiblio( $marcrecord, $params->{'frameworkcode'} );
149 # get the price if there is one.
150 # filter by storing only the 1st number
151 # we suppose the currency is correct, as we have no possibilities to get it.
152 if ($marcrecord->subfield("345","d")) {
153 $listprice = $marcrecord->subfield("345","d");
154 if ($listprice =~ /^([\d\.,]*)/) {
156 $listprice =~ s/,/\./;
161 elsif ($marcrecord->subfield("010","d")) {
162 $listprice = $marcrecord->subfield("010","d");
163 if ($listprice =~ /^([\d\.,]*)/) {
165 $listprice =~ s/,/\./;
170 SetImportRecordStatus($params->{'breedingid'}, 'imported');
175 my $cur = GetCurrency();
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 @rates = GetCurrencies();
204 my $count = scalar @rates;
208 my @loop_currency = ();
209 for ( my $i = 0 ; $i < $count ; $i++ ) {
211 $line{currency} = $rates[$i]->{'currency'};
212 $line{rate} = $rates[$i]->{'rate'};
213 push @loop_currency, \%line;
216 # build branches list
217 my $onlymine=C4::Context->preference('IndependantBranches') &&
218 C4::Context->userenv &&
219 C4::Context->userenv->{flags}!=1 &&
220 C4::Context->userenv->{branch};
221 my $branches = GetBranches($onlymine);
223 foreach my $thisbranch ( sort {$branches->{$a}->{'branchname'} cmp $branches->{$b}->{'branchname'}} keys %$branches ) {
225 value => $thisbranch,
226 branchname => $branches->{$thisbranch}->{'branchname'},
228 $row{'selected'} = 1 if( $thisbranch && $data->{branchcode} && $thisbranch eq $data->{branchcode}) ;
229 push @branchloop, \%row;
231 $template->param( branchloop => \@branchloop );
233 # build bookfund list
234 my $borrower= GetMember('borrowernumber' => $loggedinuser);
235 my ( $flags, $homebranch )= ($borrower->{'flags'},$borrower->{'branchcode'});
237 my $budget = GetBudget($budget_id);
239 my $budget_loop = [];
240 my $budgets = GetBudgetHierarchy(q{},$borrower->{branchcode},$borrower->{borrowernumber});
241 foreach my $r (@{$budgets}) {
242 if (!defined $r->{budget_amount} || $r->{budget_amount} == 0) {
245 push @{$budget_loop}, {
246 b_id => $r->{budget_id},
247 b_txt => $r->{budget_name},
248 b_sel => ( $r->{budget_id} == $budget_id ) ? 1 : 0,
254 $budget_id = $data->{'budget_id'};
255 $budget_name = $budget->{'budget_name'};
260 if ($budget) { # its a mod ..
261 if ( defined $budget->{'sort1_authcat'} ) { # with custom Asort* planning values
262 $CGIsort1 = GetAuthvalueDropbox( 'sort1', $budget->{'sort1_authcat'}, $data->{'sort1'} );
264 } elsif(scalar(@$budgets)){
265 $CGIsort1 = GetAuthvalueDropbox( 'sort1', @$budgets[0]->{'sort1_authcat'}, '' );
267 $CGIsort1 = GetAuthvalueDropbox( 'sort1','', '' );
270 # if CGIsort is successfully fetched, the use it
271 # else - failback to plain input-field
273 $template->param( CGIsort1 => $CGIsort1 );
275 $template->param( sort1 => $data->{'sort1'} );
280 if ( defined $budget->{'sort2_authcat'} ) {
281 $CGIsort2 = GetAuthvalueDropbox( 'sort2', $budget->{'sort2_authcat'}, $data->{'sort2'} );
283 } elsif(scalar(@$budgets)) {
284 $CGIsort2 = GetAuthvalueDropbox( 'sort2', @$budgets[0]->{sort2_authcat}, '' );
286 $CGIsort2 = GetAuthvalueDropbox( 'sort2','', '' );
290 $template->param( CGIsort2 => $CGIsort2 );
292 $template->param( sort2 => $data->{'sort2'} );
295 if (C4::Context->preference('AcqCreateItem') eq 'ordering' && !$ordernumber) {
296 # prepare empty item form
297 my $cell = PrepareItemrecordDisplay('','','','ACQ');
298 # warn "==> ".Data::Dumper::Dumper($cell);
300 $cell = PrepareItemrecordDisplay('','','','');
301 $template->param('NoACQframework' => 1);
304 push @itemloop,$cell;
306 $template->param(items => \@itemloop);
312 budget_id => $budget_id,
313 budget_name => $budget_name
317 existing => $biblionumber,
318 ordernumber => $ordernumber,
319 # basket informations
320 basketno => $basketno,
321 basketname => $basket->{'basketname'},
322 basketnote => $basket->{'note'},
323 booksellerid => $basket->{'booksellerid'},
324 basketbooksellernote => $basket->{booksellernote},
325 basketcontractno => $basket->{contractnumber},
326 basketcontractname => $contract->{contractname},
327 creationdate => C4::Dates->new($basket->{creationdate},'iso')->output,
328 authorisedby => $basket->{'authorisedby'},
329 authorisedbyname => $basket->{'authorisedbyname'},
330 closedate => C4::Dates->new($basket->{'closedate'},'iso')->output,
332 suggestionid => $suggestionid,
333 biblionumber => $biblionumber,
334 uncertainprice => $data->{'uncertainprice'},
335 authorisedbyname => $borrower->{'firstname'} . " " . $borrower->{'surname'},
336 biblioitemnumber => $data->{'biblioitemnumber'},
337 discount_2dp => sprintf( "%.2f", $bookseller->{'discount'}) , # for display
338 discount => $bookseller->{'discount'},
339 listincgst => $bookseller->{'listincgst'},
340 invoiceincgst => $bookseller->{'invoiceincgst'},
341 name => $bookseller->{'name'},
342 cur_active_sym => $cur->{'symbol'},
343 cur_active => $cur->{'currency'},
344 currency => $bookseller->{'listprice'} || $cur->{'currency'}, # eg: 'EUR'
345 loop_currencies => \@loop_currency,
346 orderexists => ( $new eq 'yes' ) ? 0 : 1,
347 title => $data->{'title'},
348 author => $data->{'author'},
349 publicationyear => $data->{'publicationyear'} ? $data->{'publicationyear'} : $data->{'copyrightdate'},
350 budget_loop => $budget_loop,
351 isbn => $data->{'isbn'},
352 seriestitle => $data->{'seriestitle'},
353 quantity => $data->{'quantity'},
354 quantityrec => $data->{'quantity'},
355 rrp => $data->{'rrp'},
356 listprice => sprintf("%.2f", $data->{'listprice'}||$listprice),
357 total => sprintf("%.2f", ($data->{'ecost'}||0)*($data->{'quantity'}||0) ),
358 ecost => $data->{'ecost'},
359 notes => $data->{'notes'},
360 publishercode => $data->{'publishercode'},
362 import_batch_id => $import_batch_id,
364 # CHECKME: gst-stuff needs verifing, mason.
365 gstrate => $bookseller->{'gstrate'} || C4::Context->preference("gist"),
366 gstreg => $bookseller->{'gstreg'},
369 output_html_with_http_headers $input, $cookie, $template->output;
372 =head2 MARCfindbreeding
374 $record = MARCfindbreeding($breedingid);
376 Look up the import record repository for the record with
377 record with id $breedingid. If found, returns the decoded
378 MARC::Record; otherwise, -1 is returned (FIXME).
379 Returns as second parameter the character encoding.
383 sub MARCfindbreeding {
385 my ($marc, $encoding) = GetImportRecordMarc($id);
386 # remove the - in isbn, koha store isbn without any -
388 my $record = MARC::Record->new_from_usmarc($marc);
389 my ($isbnfield,$isbnsubfield) = GetMarcFromKohaField('biblioitems.isbn','');
390 if ( $record->field($isbnfield) ) {
391 foreach my $field ( $record->field($isbnfield) ) {
392 foreach my $subfield ( $field->subfield($isbnsubfield) ) {
393 my $newisbn = $field->subfield($isbnsubfield);
395 $field->update( $isbnsubfield => $newisbn );
399 # fix the unimarc 100 coded field (with unicode information)
400 if (C4::Context->preference('marcflavour') eq 'UNIMARC' && $record->subfield(100,'a')) {
401 my $f100a=$record->subfield(100,'a');
402 my $f100 = $record->field(100);
403 my $f100temp = $f100->as_string;
404 $record->delete_field($f100);
405 if ( length($f100temp) > 28 ) {
406 substr( $f100temp, 26, 2, "50" );
407 $f100->update( 'a' => $f100temp );
408 my $f100 = MARC::Field->new( '100', '', '', 'a' => $f100temp );
409 $record->insert_fields_ordered($f100);
413 if ( !defined(ref($record)) ) {
417 # normalize author : probably UNIMARC specific...
418 if ( C4::Context->preference("z3950NormalizeAuthor")
419 and C4::Context->preference("z3950AuthorAuthFields") )
421 my ( $tag, $subfield ) = GetMarcFromKohaField("biblio.author");
423 # my $summary = C4::Context->preference("z3950authortemplate");
425 C4::Context->preference("z3950AuthorAuthFields");
426 my @auth_fields = split /,/, $auth_fields;
429 if ( $record->field($tag) ) {
430 foreach my $tmpfield ( $record->field($tag)->subfields ) {
432 # foreach my $subfieldcode ($tmpfield->subfields){
433 my $subfieldcode = shift @$tmpfield;
434 my $subfieldvalue = shift @$tmpfield;
436 $field->add_subfields(
437 "$subfieldcode" => $subfieldvalue )
438 if ( $subfieldcode ne $subfield );
442 MARC::Field->new( $tag, "", "",
443 $subfieldcode => $subfieldvalue )
444 if ( $subfieldcode ne $subfield );
448 $record->delete_field( $record->field($tag) );
449 foreach my $fieldtag (@auth_fields) {
450 next unless ( $record->field($fieldtag) );
451 my $lastname = $record->field($fieldtag)->subfield('a');
452 my $firstname = $record->field($fieldtag)->subfield('b');
453 my $title = $record->field($fieldtag)->subfield('c');
454 my $number = $record->field($fieldtag)->subfield('d');
457 # $field->add_subfields("$subfield"=>"[ ".ucfirst($title).ucfirst($firstname)." ".$number." ]");
458 $field->add_subfields(
459 "$subfield" => ucfirst($title) . " "
460 . ucfirst($firstname) . " "
465 # $field->add_subfields("$subfield"=>"[ ".ucfirst($firstname).", ".ucfirst($lastname)." ]");
466 $field->add_subfields(
467 "$subfield" => ucfirst($firstname) . ", "
468 . ucfirst($lastname) );
471 $record->insert_fields_ordered($field);
473 return $record, $encoding;