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 with
20 # Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
21 # Suite 330, Boston, MA 02111-1307 USA
29 this script allows to create a new record to order it. This record shouldn't exist
37 the bookseller the librarian has to buy a new book.
40 the title of this new record.
43 the author of this new record.
45 =item publication year
46 the publication year of this new record.
49 the number of this order.
54 the basket number for this new order.
57 if this order comes from a suggestion.
60 the item's id in the breeding reservoir
79 use C4::Bookseller; # GetBookSellerFromId
81 use C4::Suggestions; # GetSuggestion
82 use C4::Biblio; # GetBiblioData
86 use C4::Branch; # GetBranches
88 use C4::Search qw/FindDuplicate BiblioAddAuthorities/;
90 #needed for z3950 import:
91 use C4::ImportBatch qw/GetImportRecordMarc SetImportRecordStatus/;
94 my $booksellerid = $input->param('booksellerid'); # FIXME: else ERROR!
95 my $budget_id = $input->param('budget_id'); # FIXME: else ERROR!
96 my $title = $input->param('title');
97 my $author = $input->param('author');
98 my $publicationyear = $input->param('publicationyear');
99 my $bookseller = GetBookSellerFromId($booksellerid); # FIXME: else ERROR!
100 my $ordnum = $input->param('ordnum') || '';
101 my $biblionumber = $input->param('biblionumber');
102 my $basketno = $input->param('basketno');
103 my $suggestionid = $input->param('suggestionid');
104 my $close = $input->param('close');
105 my $uncertainprice = $input->param('uncertainprice');
106 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 !
112 my ( $template, $loggedinuser, $cookie ) = get_template_and_user(
114 template_name => "acqui/neworderempty.tmpl",
117 authnotrequired => 0,
118 flagsrequired => { acquisition => 'order_manage' },
123 my $basket = GetBasket($basketno);
124 my $contract = &GetContract($basket->{contractnumber});
126 #simple parameters reading (all in one :-)
127 my $params = $input->Vars;
128 my $listprice; # the price, that can be in MARC record if we have one
129 if ( $ordnum eq '' and defined $params->{'breedingid'}){
130 #we want to import from the breeding reservoir (from a z3950 search)
131 my ($marcrecord, $encoding) = MARCfindbreeding($params->{'breedingid'});
132 die("Could not find the selected record in the reservoir, bailing") unless $marcrecord;
136 if (! (($biblionumber,$duplicatetitle) = FindDuplicate($marcrecord))){
137 if (C4::Context->preference("BiblioAddsAuthorities")){
138 my ($countlinked,$countcreated)=BiblioAddAuthorities($marcrecord, $params->{'frameworkcode'});
141 $params->{'frameworkcode'} or $params->{'frameworkcode'} = "";
142 ( $biblionumber, $bibitemnum ) = AddBiblio( $marcrecord, $params->{'frameworkcode'} );
143 # get the price if there is one.
144 # filter by storing only the 1st number
145 # we suppose the currency is correct, as we have no possibilities to get it.
146 if ($marcrecord->subfield("345","d")) {
147 $listprice = $marcrecord->subfield("345","d");
148 if ($listprice =~ /^([\d\.,]*)/) {
150 $listprice =~ s/,/\./;
155 elsif ($marcrecord->subfield("010","d")) {
156 $listprice = $marcrecord->subfield("010","d");
157 if ($listprice =~ /^([\d\.,]*)/) {
159 $listprice =~ s/,/\./;
165 SetImportRecordStatus($params->{'breedingid'}, 'imported');
170 my $cur = GetCurrency();
172 if ( $ordnum eq '' ) { # create order
175 # $ordnum=newordernum;
176 if ( $biblionumber && !$suggestionid ) {
177 $data = GetBiblioData($biblionumber);
180 # get suggestion fields if applicable. If it's a subscription renewal, then the biblio already exists
181 # otherwise, retrieve suggestion information.
183 $data = ($biblionumber) ? GetBiblioData($biblionumber) : GetSuggestion($suggestionid);
187 $data = GetOrder($ordnum);
188 $biblionumber = $data->{'biblionumber'};
189 $budget_id = $data->{'budget_id'};
191 #get basketno and supplierno. too!
192 my $data2 = GetBasket( $data->{'basketno'} );
193 $basketno = $data2->{'basketno'};
194 $booksellerid = $data2->{'booksellerid'};
197 # get currencies (for change rates calcs if needed)
198 my @rates = GetCurrencies();
199 my $count = scalar @rates;
203 my @loop_currency = ();
204 for ( my $i = 0 ; $i < $count ; $i++ ) {
206 $line{currency} = $rates[$i]->{'currency'};
207 $line{rate} = $rates[$i]->{'rate'};
208 push @loop_currency, \%line;
211 # build branches list
212 my $onlymine=C4::Context->preference('IndependantBranches') &&
213 C4::Context->userenv &&
214 C4::Context->userenv->{flags}!=1 &&
215 C4::Context->userenv->{branch};
216 my $branches = GetBranches($onlymine);
218 foreach my $thisbranch ( sort {$branches->{$a}->{'branchname'} cmp $branches->{$b}->{'branchname'}} keys %$branches ) {
220 value => $thisbranch,
221 branchname => $branches->{$thisbranch}->{'branchname'},
223 $row{'selected'} = 1 if( $thisbranch eq $data->{branchcode}) ;
224 push @branchloop, \%row;
226 $template->param( branchloop => \@branchloop );
228 # build bookfund list
229 my $borrower= GetMember('borrowernumber' => $loggedinuser);
230 my ( $flags, $homebranch )= ($borrower->{'flags'},$borrower->{'branchcode'});
232 my $budget = GetBudget($budget_id);
236 my $budgets = GetBudgetHierarchy('','',$borrower->{'borrowernumber'});
237 foreach my $r (@$budgets) {
238 $labels{"$r->{budget_id}"} = $r->{budget_name};
239 next if sprintf ("%00d", $r->{budget_amount}) == 0;
240 push @values, $r->{budget_id};
242 # if no budget_id is passed then its an add
243 my $budget_dropbox = CGI::scrolling_list(
244 -name => 'budget_id',
249 -onChange => "fetchSortDropbox(this.form)",
253 $budget_id = $data->{'budget_id'};
254 $budget_name = $budget->{'budget_name'};
259 if ($budget) { # its a mod ..
260 if ( defined $budget->{'sort1_authcat'} ) { # with custom Asort* planning values
261 $CGIsort1 = GetAuthvalueDropbox( 'sort1', $budget->{'sort1_authcat'}, $data->{'sort1'} );
263 } elsif(scalar(@$budgets)){
264 $CGIsort1 = GetAuthvalueDropbox( 'sort1', @$budgets[0]->{'sort1_authcat'}, '' );
266 $CGIsort1 = GetAuthvalueDropbox( 'sort1','', '' );
269 # if CGIsort is successfully fetched, the use it
270 # else - failback to plain input-field
272 $template->param( CGIsort1 => $CGIsort1 );
274 $template->param( sort1 => $data->{'sort1'} );
279 if ( defined $budget->{'sort2_authcat'} ) {
280 $CGIsort2 = GetAuthvalueDropbox( 'sort2', $budget->{'sort2_authcat'}, $data->{'sort2'} );
282 } elsif(scalar(@$budgets)) {
283 $CGIsort2 = GetAuthvalueDropbox( 'sort2', @$budgets[0]->{sort2_authcat}, '' );
285 $CGIsort2 = GetAuthvalueDropbox( 'sort2','', '' );
289 $template->param( CGIsort2 => $CGIsort2 );
291 $template->param( sort2 => $data->{'sort2'} );
294 if (C4::Context->preference('AcqCreateItem') eq 'ordering' && !$ordnum) {
295 # prepare empty item form
296 my $cell = PrepareItemrecordDisplay('','','','ACQ');
297 # warn "==> ".Data::Dumper::Dumper($cell);
299 $cell = PrepareItemrecordDisplay('','','','');
300 $template->param('NoACQframework' => 1);
303 push @itemloop,$cell;
305 $template->param(items => \@itemloop);
311 budget_id => $budget_id,
312 budget_name => $budget_name
316 existing => $biblionumber,
318 # basket informations
319 basketno => $basketno,
320 basketname => $basket->{'basketname'},
321 basketnote => $basket->{'note'},
322 booksellerid => $basket->{'booksellerid'},
323 basketbooksellernote => $basket->{booksellernote},
324 basketcontractno => $basket->{contractnumber},
325 basketcontractname => $contract->{contractname},
326 creationdate => C4::Dates->new($basket->{creationdate},'iso')->output,
327 authorisedby => $basket->{'authorisedby'},
328 authorisedbyname => $basket->{'authorisedbyname'},
329 closedate => C4::Dates->new($basket->{'closedate'},'iso')->output,
331 suggestionid => $suggestionid,
332 biblionumber => $biblionumber,
333 uncertainprice => $data->{'uncertainprice'},
334 authorisedbyname => $borrower->{'firstname'} . " " . $borrower->{'surname'},
335 biblioitemnumber => $data->{'biblioitemnumber'},
336 discount_2dp => sprintf( "%.2f", $bookseller->{'discount'}) , # for display
337 discount => $bookseller->{'discount'},
338 listincgst => $bookseller->{'listincgst'},
339 invoiceincgst => $bookseller->{'invoiceincgst'},
340 name => $bookseller->{'name'},
341 cur_active_sym => $cur->{'symbol'},
342 cur_active => $cur->{'currency'},
343 currency => $bookseller->{'listprice'}, # eg: 'EUR'
344 loop_currencies => \@loop_currency,
345 orderexists => ( $new eq 'yes' ) ? 0 : 1,
346 title => $data->{'title'},
347 author => $data->{'author'},
348 publicationyear => $data->{'publicationyear'},
349 budget_dropbox => $budget_dropbox,
350 isbn => $data->{'isbn'},
351 seriestitle => $data->{'seriestitle'},
352 quantity => $data->{'quantity'},
353 quantityrec => $data->{'quantity'},
354 rrp => $data->{'rrp'},
355 list_price => sprintf("%.2f", $data->{'listprice'}||$listprice),
356 total => sprintf("%.2f", $data->{'ecost'}*$data->{'quantity'} ),
357 ecost => $data->{'ecost'},
358 notes => $data->{'notes'},
359 publishercode => $data->{'publishercode'},
361 import_batch_id => $import_batch_id,
363 # CHECKME: gst-stuff needs verifing, mason.
364 gstrate => $bookseller->{'gstrate'} || C4::Context->preference("gist"),
365 gstreg => $bookseller->{'gstreg'},
368 output_html_with_http_headers $input, $cookie, $template->output;
371 =item MARCfindbreeding
373 $record = MARCfindbreeding($breedingid);
375 Look up the import record repository for the record with
376 record with id $breedingid. If found, returns the decoded
377 MARC::Record; otherwise, -1 is returned (FIXME).
378 Returns as second parameter the character encoding.
382 sub MARCfindbreeding {
384 my ($marc, $encoding) = GetImportRecordMarc($id);
385 # remove the - in isbn, koha store isbn without any -
387 my $record = MARC::Record->new_from_usmarc($marc);
388 my ($isbnfield,$isbnsubfield) = GetMarcFromKohaField('biblioitems.isbn','');
389 if ( $record->field($isbnfield) ) {
390 foreach my $field ( $record->field($isbnfield) ) {
391 foreach my $subfield ( $field->subfield($isbnsubfield) ) {
392 my $newisbn = $field->subfield($isbnsubfield);
394 $field->update( $isbnsubfield => $newisbn );
398 # fix the unimarc 100 coded field (with unicode information)
399 if (C4::Context->preference('marcflavour') eq 'UNIMARC' && $record->subfield(100,'a')) {
400 my $f100a=$record->subfield(100,'a');
401 my $f100 = $record->field(100);
402 my $f100temp = $f100->as_string;
403 $record->delete_field($f100);
404 if ( length($f100temp) > 28 ) {
405 substr( $f100temp, 26, 2, "50" );
406 $f100->update( 'a' => $f100temp );
407 my $f100 = MARC::Field->new( '100', '', '', 'a' => $f100temp );
408 $record->insert_fields_ordered($f100);
412 if ( !defined(ref($record)) ) {
416 # normalize author : probably UNIMARC specific...
417 if ( C4::Context->preference("z3950NormalizeAuthor")
418 and C4::Context->preference("z3950AuthorAuthFields") )
420 my ( $tag, $subfield ) = GetMarcFromKohaField("biblio.author");
422 # my $summary = C4::Context->preference("z3950authortemplate");
424 C4::Context->preference("z3950AuthorAuthFields");
425 my @auth_fields = split /,/, $auth_fields;
428 if ( $record->field($tag) ) {
429 foreach my $tmpfield ( $record->field($tag)->subfields ) {
431 # foreach my $subfieldcode ($tmpfield->subfields){
432 my $subfieldcode = shift @$tmpfield;
433 my $subfieldvalue = shift @$tmpfield;
435 $field->add_subfields(
436 "$subfieldcode" => $subfieldvalue )
437 if ( $subfieldcode ne $subfield );
441 MARC::Field->new( $tag, "", "",
442 $subfieldcode => $subfieldvalue )
443 if ( $subfieldcode ne $subfield );
447 $record->delete_field( $record->field($tag) );
448 foreach my $fieldtag (@auth_fields) {
449 next unless ( $record->field($fieldtag) );
450 my $lastname = $record->field($fieldtag)->subfield('a');
451 my $firstname = $record->field($fieldtag)->subfield('b');
452 my $title = $record->field($fieldtag)->subfield('c');
453 my $number = $record->field($fieldtag)->subfield('d');
456 # $field->add_subfields("$subfield"=>"[ ".ucfirst($title).ucfirst($firstname)." ".$number." ]");
457 $field->add_subfields(
458 "$subfield" => ucfirst($title) . " "
459 . ucfirst($firstname) . " "
464 # $field->add_subfields("$subfield"=>"[ ".ucfirst($firstname).", ".ucfirst($lastname)." ]");
465 $field->add_subfields(
466 "$subfield" => ucfirst($firstname) . ", "
467 . ucfirst($lastname) );
470 $record->insert_fields_ordered($field);
472 return $record, $encoding;