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;
137 if (! (($biblionumber,$duplicatetitle) = FindDuplicate($marcrecord))){
138 if (C4::Context->preference("BiblioAddsAuthorities")){
139 my ($countlinked,$countcreated)=BiblioAddAuthorities($marcrecord, $params->{'frameworkcode'});
142 $params->{'frameworkcode'} or $params->{'frameworkcode'} = "";
143 ( $biblionumber, $bibitemnum ) = AddBiblio( $marcrecord, $params->{'frameworkcode'} );
144 # get the price if there is one.
145 # filter by storing only the 1st number
146 # we suppose the currency is correct, as we have no possibilities to get it.
147 if ($marcrecord->subfield("345","d")) {
148 $listprice = $marcrecord->subfield("345","d");
149 if ($listprice =~ /^([\d\.,]*)/) {
151 $listprice =~ s/,/\./;
156 elsif ($marcrecord->subfield("010","d")) {
157 $listprice = $marcrecord->subfield("010","d");
158 if ($listprice =~ /^([\d\.,]*)/) {
160 $listprice =~ s/,/\./;
165 SetImportRecordStatus($params->{'breedingid'}, 'imported');
170 my $cur = GetCurrency();
172 if ( $ordernumber eq '' ) { # create order
175 # $ordernumber=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($ordernumber);
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);
234 my $budget_loop = [];
235 my $budgets = GetBudgetHierarchy(q{},$borrower->{branchcode},$borrower->{borrowernumber});
236 foreach my $r (@{$budgets}) {
237 if (!defined $r->{budget_amount} || $r->{budget_amount} == 0) {
240 push @{$budget_loop}, {
241 b_id => $r->{budget_id},
242 b_txt => $r->{budget_name},
243 b_sel => ( $r->{budget_id} == $budget_id ) ? 1 : 0,
249 $budget_id = $data->{'budget_id'};
250 $budget_name = $budget->{'budget_name'};
255 if ($budget) { # its a mod ..
256 if ( defined $budget->{'sort1_authcat'} ) { # with custom Asort* planning values
257 $CGIsort1 = GetAuthvalueDropbox( 'sort1', $budget->{'sort1_authcat'}, $data->{'sort1'} );
259 } elsif(scalar(@$budgets)){
260 $CGIsort1 = GetAuthvalueDropbox( 'sort1', @$budgets[0]->{'sort1_authcat'}, '' );
262 $CGIsort1 = GetAuthvalueDropbox( 'sort1','', '' );
265 # if CGIsort is successfully fetched, the use it
266 # else - failback to plain input-field
268 $template->param( CGIsort1 => $CGIsort1 );
270 $template->param( sort1 => $data->{'sort1'} );
275 if ( defined $budget->{'sort2_authcat'} ) {
276 $CGIsort2 = GetAuthvalueDropbox( 'sort2', $budget->{'sort2_authcat'}, $data->{'sort2'} );
278 } elsif(scalar(@$budgets)) {
279 $CGIsort2 = GetAuthvalueDropbox( 'sort2', @$budgets[0]->{sort2_authcat}, '' );
281 $CGIsort2 = GetAuthvalueDropbox( 'sort2','', '' );
285 $template->param( CGIsort2 => $CGIsort2 );
287 $template->param( sort2 => $data->{'sort2'} );
290 if (C4::Context->preference('AcqCreateItem') eq 'ordering' && !$ordernumber) {
291 # prepare empty item form
292 my $cell = PrepareItemrecordDisplay('','','','ACQ');
293 # warn "==> ".Data::Dumper::Dumper($cell);
295 $cell = PrepareItemrecordDisplay('','','','');
296 $template->param('NoACQframework' => 1);
299 push @itemloop,$cell;
301 $template->param(items => \@itemloop);
307 budget_id => $budget_id,
308 budget_name => $budget_name
312 existing => $biblionumber,
313 ordernumber => $ordernumber,
314 # basket informations
315 basketno => $basketno,
316 basketname => $basket->{'basketname'},
317 basketnote => $basket->{'note'},
318 booksellerid => $basket->{'booksellerid'},
319 basketbooksellernote => $basket->{booksellernote},
320 basketcontractno => $basket->{contractnumber},
321 basketcontractname => $contract->{contractname},
322 creationdate => C4::Dates->new($basket->{creationdate},'iso')->output,
323 authorisedby => $basket->{'authorisedby'},
324 authorisedbyname => $basket->{'authorisedbyname'},
325 closedate => C4::Dates->new($basket->{'closedate'},'iso')->output,
327 suggestionid => $suggestionid,
328 biblionumber => $biblionumber,
329 uncertainprice => $data->{'uncertainprice'},
330 authorisedbyname => $borrower->{'firstname'} . " " . $borrower->{'surname'},
331 biblioitemnumber => $data->{'biblioitemnumber'},
332 discount_2dp => sprintf( "%.2f", $bookseller->{'discount'}) , # for display
333 discount => $bookseller->{'discount'},
334 listincgst => $bookseller->{'listincgst'},
335 invoiceincgst => $bookseller->{'invoiceincgst'},
336 name => $bookseller->{'name'},
337 cur_active_sym => $cur->{'symbol'},
338 cur_active => $cur->{'currency'},
339 currency => $bookseller->{'listprice'} || $cur->{'currency'}, # eg: 'EUR'
340 loop_currencies => \@loop_currency,
341 orderexists => ( $new eq 'yes' ) ? 0 : 1,
342 title => $data->{'title'},
343 author => $data->{'author'},
344 publicationyear => $data->{'publicationyear'} ? $data->{'publicationyear'} : $data->{'copyrightdate'},
345 budget_loop => $budget_loop,
346 isbn => $data->{'isbn'},
347 seriestitle => $data->{'seriestitle'},
348 quantity => $data->{'quantity'},
349 quantityrec => $data->{'quantity'},
350 rrp => $data->{'rrp'},
351 listprice => sprintf("%.2f", $data->{'listprice'}||$listprice),
352 total => sprintf("%.2f", ($data->{'ecost'}||0)*($data->{'quantity'}||0) ),
353 ecost => $data->{'ecost'},
354 notes => $data->{'notes'},
355 publishercode => $data->{'publishercode'},
357 import_batch_id => $import_batch_id,
359 # CHECKME: gst-stuff needs verifing, mason.
360 gstrate => $bookseller->{'gstrate'} || C4::Context->preference("gist"),
361 gstreg => $bookseller->{'gstreg'},
364 output_html_with_http_headers $input, $cookie, $template->output;
367 =head2 MARCfindbreeding
369 $record = MARCfindbreeding($breedingid);
371 Look up the import record repository for the record with
372 record with id $breedingid. If found, returns the decoded
373 MARC::Record; otherwise, -1 is returned (FIXME).
374 Returns as second parameter the character encoding.
378 sub MARCfindbreeding {
380 my ($marc, $encoding) = GetImportRecordMarc($id);
381 # remove the - in isbn, koha store isbn without any -
383 my $record = MARC::Record->new_from_usmarc($marc);
384 my ($isbnfield,$isbnsubfield) = GetMarcFromKohaField('biblioitems.isbn','');
385 if ( $record->field($isbnfield) ) {
386 foreach my $field ( $record->field($isbnfield) ) {
387 foreach my $subfield ( $field->subfield($isbnsubfield) ) {
388 my $newisbn = $field->subfield($isbnsubfield);
390 $field->update( $isbnsubfield => $newisbn );
394 # fix the unimarc 100 coded field (with unicode information)
395 if (C4::Context->preference('marcflavour') eq 'UNIMARC' && $record->subfield(100,'a')) {
396 my $f100a=$record->subfield(100,'a');
397 my $f100 = $record->field(100);
398 my $f100temp = $f100->as_string;
399 $record->delete_field($f100);
400 if ( length($f100temp) > 28 ) {
401 substr( $f100temp, 26, 2, "50" );
402 $f100->update( 'a' => $f100temp );
403 my $f100 = MARC::Field->new( '100', '', '', 'a' => $f100temp );
404 $record->insert_fields_ordered($f100);
408 if ( !defined(ref($record)) ) {
412 # normalize author : probably UNIMARC specific...
413 if ( C4::Context->preference("z3950NormalizeAuthor")
414 and C4::Context->preference("z3950AuthorAuthFields") )
416 my ( $tag, $subfield ) = GetMarcFromKohaField("biblio.author");
418 # my $summary = C4::Context->preference("z3950authortemplate");
420 C4::Context->preference("z3950AuthorAuthFields");
421 my @auth_fields = split /,/, $auth_fields;
424 if ( $record->field($tag) ) {
425 foreach my $tmpfield ( $record->field($tag)->subfields ) {
427 # foreach my $subfieldcode ($tmpfield->subfields){
428 my $subfieldcode = shift @$tmpfield;
429 my $subfieldvalue = shift @$tmpfield;
431 $field->add_subfields(
432 "$subfieldcode" => $subfieldvalue )
433 if ( $subfieldcode ne $subfield );
437 MARC::Field->new( $tag, "", "",
438 $subfieldcode => $subfieldvalue )
439 if ( $subfieldcode ne $subfield );
443 $record->delete_field( $record->field($tag) );
444 foreach my $fieldtag (@auth_fields) {
445 next unless ( $record->field($fieldtag) );
446 my $lastname = $record->field($fieldtag)->subfield('a');
447 my $firstname = $record->field($fieldtag)->subfield('b');
448 my $title = $record->field($fieldtag)->subfield('c');
449 my $number = $record->field($fieldtag)->subfield('d');
452 # $field->add_subfields("$subfield"=>"[ ".ucfirst($title).ucfirst($firstname)." ".$number." ]");
453 $field->add_subfields(
454 "$subfield" => ucfirst($title) . " "
455 . ucfirst($firstname) . " "
460 # $field->add_subfields("$subfield"=>"[ ".ucfirst($firstname).", ".ucfirst($lastname)." ]");
461 $field->add_subfields(
462 "$subfield" => ucfirst($firstname) . ", "
463 . ucfirst($lastname) );
466 $record->insert_fields_ordered($field);
468 return $record, $encoding;