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 $ordernumber = $input->param('ordernumber') || '';
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 ( $ordernumber 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/,/\./;
164 SetImportRecordStatus
($params->{'breedingid'}, 'imported');
169 my $cur = GetCurrency
();
171 if ( $ordernumber eq '' ) { # create order
174 # $ordernumber=newordernum;
175 if ( $biblionumber && !$suggestionid ) {
176 $data = GetBiblioData
($biblionumber);
179 # get suggestion fields if applicable. If it's a subscription renewal, then the biblio already exists
180 # otherwise, retrieve suggestion information.
182 $data = ($biblionumber) ? GetBiblioData
($biblionumber) : GetSuggestion
($suggestionid);
186 $data = GetOrder
($ordernumber);
187 $biblionumber = $data->{'biblionumber'};
188 $budget_id = $data->{'budget_id'};
190 #get basketno and supplierno. too!
191 my $data2 = GetBasket
( $data->{'basketno'} );
192 $basketno = $data2->{'basketno'};
193 $booksellerid = $data2->{'booksellerid'};
196 # get currencies (for change rates calcs if needed)
197 my @rates = GetCurrencies
();
198 my $count = scalar @rates;
202 my @loop_currency = ();
203 for ( my $i = 0 ; $i < $count ; $i++ ) {
205 $line{currency
} = $rates[$i]->{'currency'};
206 $line{rate
} = $rates[$i]->{'rate'};
207 push @loop_currency, \
%line;
210 # build branches list
211 my $onlymine=C4
::Context
->preference('IndependantBranches') &&
212 C4
::Context
->userenv &&
213 C4
::Context
->userenv->{flags
}!=1 &&
214 C4
::Context
->userenv->{branch
};
215 my $branches = GetBranches
($onlymine);
217 foreach my $thisbranch ( sort {$branches->{$a}->{'branchname'} cmp $branches->{$b}->{'branchname'}} keys %$branches ) {
219 value
=> $thisbranch,
220 branchname
=> $branches->{$thisbranch}->{'branchname'},
222 $row{'selected'} = 1 if( $thisbranch eq $data->{branchcode
}) ;
223 push @branchloop, \
%row;
225 $template->param( branchloop
=> \
@branchloop );
227 # build bookfund list
228 my $borrower= GetMember
('borrowernumber' => $loggedinuser);
229 my ( $flags, $homebranch )= ($borrower->{'flags'},$borrower->{'branchcode'});
231 my $budget = GetBudget
($budget_id);
235 my $budgets = GetBudgetHierarchy
('','',$borrower->{'borrowernumber'});
236 foreach my $r (@
$budgets) {
237 $labels{"$r->{budget_id}"} = $r->{budget_name
};
238 next if sprintf ("%00d", $r->{budget_amount
}) == 0;
239 push @values, $r->{budget_id
};
241 # if no budget_id is passed then its an add
242 my $budget_dropbox = CGI
::scrolling_list
(
243 -name
=> 'budget_id',
248 -onChange
=> "fetchSortDropbox(this.form)",
252 $budget_id = $data->{'budget_id'};
253 $budget_name = $budget->{'budget_name'};
258 if ($budget) { # its a mod ..
259 if ( defined $budget->{'sort1_authcat'} ) { # with custom Asort* planning values
260 $CGIsort1 = GetAuthvalueDropbox
( 'sort1', $budget->{'sort1_authcat'}, $data->{'sort1'} );
262 } elsif(scalar(@
$budgets)){
263 $CGIsort1 = GetAuthvalueDropbox
( 'sort1', @
$budgets[0]->{'sort1_authcat'}, '' );
265 $CGIsort1 = GetAuthvalueDropbox
( 'sort1','', '' );
268 # if CGIsort is successfully fetched, the use it
269 # else - failback to plain input-field
271 $template->param( CGIsort1
=> $CGIsort1 );
273 $template->param( sort1
=> $data->{'sort1'} );
278 if ( defined $budget->{'sort2_authcat'} ) {
279 $CGIsort2 = GetAuthvalueDropbox
( 'sort2', $budget->{'sort2_authcat'}, $data->{'sort2'} );
281 } elsif(scalar(@
$budgets)) {
282 $CGIsort2 = GetAuthvalueDropbox
( 'sort2', @
$budgets[0]->{sort2_authcat
}, '' );
284 $CGIsort2 = GetAuthvalueDropbox
( 'sort2','', '' );
288 $template->param( CGIsort2
=> $CGIsort2 );
290 $template->param( sort2
=> $data->{'sort2'} );
293 if (C4
::Context
->preference('AcqCreateItem') eq 'ordering' && !$ordernumber) {
294 # prepare empty item form
295 my $cell = PrepareItemrecordDisplay
('','','','ACQ');
296 # warn "==> ".Data::Dumper::Dumper($cell);
298 $cell = PrepareItemrecordDisplay
('','','','');
299 $template->param('NoACQframework' => 1);
302 push @itemloop,$cell;
304 $template->param(items
=> \
@itemloop);
310 budget_id
=> $budget_id,
311 budget_name
=> $budget_name
315 existing
=> $biblionumber,
316 ordernumber
=> $ordernumber,
317 # basket informations
318 basketno
=> $basketno,
319 basketname
=> $basket->{'basketname'},
320 basketnote
=> $basket->{'note'},
321 booksellerid
=> $basket->{'booksellerid'},
322 basketbooksellernote
=> $basket->{booksellernote
},
323 basketcontractno
=> $basket->{contractnumber
},
324 basketcontractname
=> $contract->{contractname
},
325 creationdate
=> C4
::Dates
->new($basket->{creationdate
},'iso')->output,
326 authorisedby
=> $basket->{'authorisedby'},
327 authorisedbyname
=> $basket->{'authorisedbyname'},
328 closedate
=> C4
::Dates
->new($basket->{'closedate'},'iso')->output,
330 suggestionid
=> $suggestionid,
331 biblionumber
=> $biblionumber,
332 uncertainprice
=> $data->{'uncertainprice'},
333 authorisedbyname
=> $borrower->{'firstname'} . " " . $borrower->{'surname'},
334 biblioitemnumber
=> $data->{'biblioitemnumber'},
335 discount_2dp
=> sprintf( "%.2f", $bookseller->{'discount'}) , # for display
336 discount
=> $bookseller->{'discount'},
337 listincgst
=> $bookseller->{'listincgst'},
338 invoiceincgst
=> $bookseller->{'invoiceincgst'},
339 name
=> $bookseller->{'name'},
340 cur_active_sym
=> $cur->{'symbol'},
341 cur_active
=> $cur->{'currency'},
342 currency
=> $bookseller->{'listprice'}, # eg: 'EUR'
343 loop_currencies
=> \
@loop_currency,
344 orderexists
=> ( $new eq 'yes' ) ?
0 : 1,
345 title
=> $data->{'title'},
346 author
=> $data->{'author'},
347 publicationyear
=> $data->{'publicationyear'},
348 budget_dropbox
=> $budget_dropbox,
349 isbn
=> $data->{'isbn'},
350 seriestitle
=> $data->{'seriestitle'},
351 quantity
=> $data->{'quantity'},
352 quantityrec
=> $data->{'quantity'},
353 rrp
=> $data->{'rrp'},
354 listprice
=> sprintf("%.2f", $data->{'listprice'}||$listprice),
355 total
=> sprintf("%.2f", $data->{'ecost'}*$data->{'quantity'} ),
356 ecost
=> $data->{'ecost'},
357 notes
=> $data->{'notes'},
358 publishercode
=> $data->{'publishercode'},
360 import_batch_id
=> $import_batch_id,
362 # CHECKME: gst-stuff needs verifing, mason.
363 gstrate
=> $bookseller->{'gstrate'} || C4
::Context
->preference("gist"),
364 gstreg
=> $bookseller->{'gstreg'},
367 output_html_with_http_headers
$input, $cookie, $template->output;
370 =item MARCfindbreeding
372 $record = MARCfindbreeding($breedingid);
374 Look up the import record repository for the record with
375 record with id $breedingid. If found, returns the decoded
376 MARC::Record; otherwise, -1 is returned (FIXME).
377 Returns as second parameter the character encoding.
381 sub MARCfindbreeding
{
383 my ($marc, $encoding) = GetImportRecordMarc
($id);
384 # remove the - in isbn, koha store isbn without any -
386 my $record = MARC
::Record
->new_from_usmarc($marc);
387 my ($isbnfield,$isbnsubfield) = GetMarcFromKohaField
('biblioitems.isbn','');
388 if ( $record->field($isbnfield) ) {
389 foreach my $field ( $record->field($isbnfield) ) {
390 foreach my $subfield ( $field->subfield($isbnsubfield) ) {
391 my $newisbn = $field->subfield($isbnsubfield);
393 $field->update( $isbnsubfield => $newisbn );
397 # fix the unimarc 100 coded field (with unicode information)
398 if (C4
::Context
->preference('marcflavour') eq 'UNIMARC' && $record->subfield(100,'a')) {
399 my $f100a=$record->subfield(100,'a');
400 my $f100 = $record->field(100);
401 my $f100temp = $f100->as_string;
402 $record->delete_field($f100);
403 if ( length($f100temp) > 28 ) {
404 substr( $f100temp, 26, 2, "50" );
405 $f100->update( 'a' => $f100temp );
406 my $f100 = MARC
::Field
->new( '100', '', '', 'a' => $f100temp );
407 $record->insert_fields_ordered($f100);
411 if ( !defined(ref($record)) ) {
415 # normalize author : probably UNIMARC specific...
416 if ( C4
::Context
->preference("z3950NormalizeAuthor")
417 and C4
::Context
->preference("z3950AuthorAuthFields") )
419 my ( $tag, $subfield ) = GetMarcFromKohaField
("biblio.author");
421 # my $summary = C4::Context->preference("z3950authortemplate");
423 C4
::Context
->preference("z3950AuthorAuthFields");
424 my @auth_fields = split /,/, $auth_fields;
427 if ( $record->field($tag) ) {
428 foreach my $tmpfield ( $record->field($tag)->subfields ) {
430 # foreach my $subfieldcode ($tmpfield->subfields){
431 my $subfieldcode = shift @
$tmpfield;
432 my $subfieldvalue = shift @
$tmpfield;
434 $field->add_subfields(
435 "$subfieldcode" => $subfieldvalue )
436 if ( $subfieldcode ne $subfield );
440 MARC
::Field
->new( $tag, "", "",
441 $subfieldcode => $subfieldvalue )
442 if ( $subfieldcode ne $subfield );
446 $record->delete_field( $record->field($tag) );
447 foreach my $fieldtag (@auth_fields) {
448 next unless ( $record->field($fieldtag) );
449 my $lastname = $record->field($fieldtag)->subfield('a');
450 my $firstname = $record->field($fieldtag)->subfield('b');
451 my $title = $record->field($fieldtag)->subfield('c');
452 my $number = $record->field($fieldtag)->subfield('d');
455 # $field->add_subfields("$subfield"=>"[ ".ucfirst($title).ucfirst($firstname)." ".$number." ]");
456 $field->add_subfields(
457 "$subfield" => ucfirst($title) . " "
458 . ucfirst($firstname) . " "
463 # $field->add_subfields("$subfield"=>"[ ".ucfirst($firstname).", ".ucfirst($lastname)." ]");
464 $field->add_subfields(
465 "$subfield" => ucfirst($firstname) . ", "
466 . ucfirst($lastname) );
469 $record->insert_fields_ordered($field);
471 return $record, $encoding;