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.
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') || 0; # 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=0; # 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);
233 my $budget_loop = [];
234 my $budgets = GetBudgetHierarchy
(q{},$borrower->{branchcode
},$borrower->{borrowernumber
});
235 foreach my $r (@
{$budgets}) {
236 if (!defined $r->{budget_amount
} || $r->{budget_amount
} == 0) {
239 push @
{$budget_loop}, {
240 b_id
=> $r->{budget_id
},
241 b_txt
=> $r->{budget_name
},
242 b_sel
=> ( $r->{budget_id
} == $budget_id ) ?
1 : 0,
248 $budget_id = $data->{'budget_id'};
249 $budget_name = $budget->{'budget_name'};
254 if ($budget) { # its a mod ..
255 if ( defined $budget->{'sort1_authcat'} ) { # with custom Asort* planning values
256 $CGIsort1 = GetAuthvalueDropbox
( 'sort1', $budget->{'sort1_authcat'}, $data->{'sort1'} );
258 } elsif(scalar(@
$budgets)){
259 $CGIsort1 = GetAuthvalueDropbox
( 'sort1', @
$budgets[0]->{'sort1_authcat'}, '' );
261 $CGIsort1 = GetAuthvalueDropbox
( 'sort1','', '' );
264 # if CGIsort is successfully fetched, the use it
265 # else - failback to plain input-field
267 $template->param( CGIsort1
=> $CGIsort1 );
269 $template->param( sort1
=> $data->{'sort1'} );
274 if ( defined $budget->{'sort2_authcat'} ) {
275 $CGIsort2 = GetAuthvalueDropbox
( 'sort2', $budget->{'sort2_authcat'}, $data->{'sort2'} );
277 } elsif(scalar(@
$budgets)) {
278 $CGIsort2 = GetAuthvalueDropbox
( 'sort2', @
$budgets[0]->{sort2_authcat
}, '' );
280 $CGIsort2 = GetAuthvalueDropbox
( 'sort2','', '' );
284 $template->param( CGIsort2
=> $CGIsort2 );
286 $template->param( sort2
=> $data->{'sort2'} );
289 if (C4
::Context
->preference('AcqCreateItem') eq 'ordering' && !$ordernumber) {
290 # prepare empty item form
291 my $cell = PrepareItemrecordDisplay
('','','','ACQ');
292 # warn "==> ".Data::Dumper::Dumper($cell);
294 $cell = PrepareItemrecordDisplay
('','','','');
295 $template->param('NoACQframework' => 1);
298 push @itemloop,$cell;
300 $template->param(items
=> \
@itemloop);
306 budget_id
=> $budget_id,
307 budget_name
=> $budget_name
311 existing
=> $biblionumber,
312 ordernumber
=> $ordernumber,
313 # basket informations
314 basketno
=> $basketno,
315 basketname
=> $basket->{'basketname'},
316 basketnote
=> $basket->{'note'},
317 booksellerid
=> $basket->{'booksellerid'},
318 basketbooksellernote
=> $basket->{booksellernote
},
319 basketcontractno
=> $basket->{contractnumber
},
320 basketcontractname
=> $contract->{contractname
},
321 creationdate
=> C4
::Dates
->new($basket->{creationdate
},'iso')->output,
322 authorisedby
=> $basket->{'authorisedby'},
323 authorisedbyname
=> $basket->{'authorisedbyname'},
324 closedate
=> C4
::Dates
->new($basket->{'closedate'},'iso')->output,
326 suggestionid
=> $suggestionid,
327 biblionumber
=> $biblionumber,
328 uncertainprice
=> $data->{'uncertainprice'},
329 authorisedbyname
=> $borrower->{'firstname'} . " " . $borrower->{'surname'},
330 biblioitemnumber
=> $data->{'biblioitemnumber'},
331 discount_2dp
=> sprintf( "%.2f", $bookseller->{'discount'}) , # for display
332 discount
=> $bookseller->{'discount'},
333 listincgst
=> $bookseller->{'listincgst'},
334 invoiceincgst
=> $bookseller->{'invoiceincgst'},
335 name
=> $bookseller->{'name'},
336 cur_active_sym
=> $cur->{'symbol'},
337 cur_active
=> $cur->{'currency'},
338 currency
=> $bookseller->{'listprice'} || $cur->{'currency'}, # eg: 'EUR'
339 loop_currencies
=> \
@loop_currency,
340 orderexists
=> ( $new eq 'yes' ) ?
0 : 1,
341 title
=> $data->{'title'},
342 author
=> $data->{'author'},
343 publicationyear
=> $data->{'publicationyear'},
344 budget_loop
=> $budget_loop,
345 isbn
=> $data->{'isbn'},
346 seriestitle
=> $data->{'seriestitle'},
347 quantity
=> $data->{'quantity'},
348 quantityrec
=> $data->{'quantity'},
349 rrp
=> $data->{'rrp'},
350 listprice
=> sprintf("%.2f", $data->{'listprice'}||$listprice),
351 total
=> sprintf("%.2f", ($data->{'ecost'}||0)*($data->{'quantity'}||0) ),
352 ecost
=> $data->{'ecost'},
353 notes
=> $data->{'notes'},
354 publishercode
=> $data->{'publishercode'},
356 import_batch_id
=> $import_batch_id,
358 # CHECKME: gst-stuff needs verifing, mason.
359 gstrate
=> $bookseller->{'gstrate'} || C4
::Context
->preference("gist"),
360 gstreg
=> $bookseller->{'gstreg'},
363 output_html_with_http_headers
$input, $cookie, $template->output;
366 =item MARCfindbreeding
368 $record = MARCfindbreeding($breedingid);
370 Look up the import record repository for the record with
371 record with id $breedingid. If found, returns the decoded
372 MARC::Record; otherwise, -1 is returned (FIXME).
373 Returns as second parameter the character encoding.
377 sub MARCfindbreeding
{
379 my ($marc, $encoding) = GetImportRecordMarc
($id);
380 # remove the - in isbn, koha store isbn without any -
382 my $record = MARC
::Record
->new_from_usmarc($marc);
383 my ($isbnfield,$isbnsubfield) = GetMarcFromKohaField
('biblioitems.isbn','');
384 if ( $record->field($isbnfield) ) {
385 foreach my $field ( $record->field($isbnfield) ) {
386 foreach my $subfield ( $field->subfield($isbnsubfield) ) {
387 my $newisbn = $field->subfield($isbnsubfield);
389 $field->update( $isbnsubfield => $newisbn );
393 # fix the unimarc 100 coded field (with unicode information)
394 if (C4
::Context
->preference('marcflavour') eq 'UNIMARC' && $record->subfield(100,'a')) {
395 my $f100a=$record->subfield(100,'a');
396 my $f100 = $record->field(100);
397 my $f100temp = $f100->as_string;
398 $record->delete_field($f100);
399 if ( length($f100temp) > 28 ) {
400 substr( $f100temp, 26, 2, "50" );
401 $f100->update( 'a' => $f100temp );
402 my $f100 = MARC
::Field
->new( '100', '', '', 'a' => $f100temp );
403 $record->insert_fields_ordered($f100);
407 if ( !defined(ref($record)) ) {
411 # normalize author : probably UNIMARC specific...
412 if ( C4
::Context
->preference("z3950NormalizeAuthor")
413 and C4
::Context
->preference("z3950AuthorAuthFields") )
415 my ( $tag, $subfield ) = GetMarcFromKohaField
("biblio.author");
417 # my $summary = C4::Context->preference("z3950authortemplate");
419 C4
::Context
->preference("z3950AuthorAuthFields");
420 my @auth_fields = split /,/, $auth_fields;
423 if ( $record->field($tag) ) {
424 foreach my $tmpfield ( $record->field($tag)->subfields ) {
426 # foreach my $subfieldcode ($tmpfield->subfields){
427 my $subfieldcode = shift @
$tmpfield;
428 my $subfieldvalue = shift @
$tmpfield;
430 $field->add_subfields(
431 "$subfieldcode" => $subfieldvalue )
432 if ( $subfieldcode ne $subfield );
436 MARC
::Field
->new( $tag, "", "",
437 $subfieldcode => $subfieldvalue )
438 if ( $subfieldcode ne $subfield );
442 $record->delete_field( $record->field($tag) );
443 foreach my $fieldtag (@auth_fields) {
444 next unless ( $record->field($fieldtag) );
445 my $lastname = $record->field($fieldtag)->subfield('a');
446 my $firstname = $record->field($fieldtag)->subfield('b');
447 my $title = $record->field($fieldtag)->subfield('c');
448 my $number = $record->field($fieldtag)->subfield('d');
451 # $field->add_subfields("$subfield"=>"[ ".ucfirst($title).ucfirst($firstname)." ".$number." ]");
452 $field->add_subfields(
453 "$subfield" => ucfirst($title) . " "
454 . ucfirst($firstname) . " "
459 # $field->add_subfields("$subfield"=>"[ ".ucfirst($firstname).", ".ucfirst($lastname)." ]");
460 $field->add_subfields(
461 "$subfield" => ucfirst($firstname) . ", "
462 . ucfirst($lastname) );
465 $record->insert_fields_ordered($field);
467 return $record, $encoding;