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
11 # under the terms of the GNU General Public License as published by
12 # the Free Software Foundation; either version 3 of the License, or
13 # (at your option) any later version.
15 # Koha is distributed in the hope that it will be useful, but
16 # WITHOUT ANY WARRANTY; without even the implied warranty of
17 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 # GNU General Public License for more details.
20 # You should have received a copy of the GNU General Public License
21 # along with Koha; if not, see <http://www.gnu.org/licenses>.
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
79 use C4
::Suggestions
; # GetSuggestion
80 use C4
::Biblio
; # GetBiblioData GetMarcPrice
81 use C4
::Items
; #PrepareItemRecord
84 use C4
::Branch
; # GetBranches
86 use C4
::Search qw
/FindDuplicate/;
88 #needed for z3950 import:
89 use C4
::ImportBatch qw
/GetImportRecordMarc SetImportRecordStatus/;
91 use Koha
::Acquisition
::Bookseller
;
92 use Koha
::Acquisition
::Currencies
;
96 my $booksellerid = $input->param('booksellerid'); # FIXME: else ERROR!
97 my $budget_id = $input->param('budget_id') || 0;
98 my $title = $input->param('title');
99 my $author = $input->param('author');
100 my $publicationyear = $input->param('publicationyear');
101 my $ordernumber = $input->param('ordernumber') || '';
102 our $biblionumber = $input->param('biblionumber');
103 our $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 !
108 my $subscriptionid = $input->param('subscriptionid');
114 our ( $template, $loggedinuser, $cookie, $userflags ) = get_template_and_user
(
116 template_name
=> "acqui/neworderempty.tt",
119 authnotrequired
=> 0,
120 flagsrequired
=> { acquisition
=> 'order_manage' },
125 our $marcflavour = C4
::Context
->preference('marcflavour');
128 my $order = GetOrder
($ordernumber);
129 $basketno = $order->{'basketno'};
132 our $basket = GetBasket
($basketno);
133 $booksellerid = $basket->{booksellerid
} unless $booksellerid;
134 my $bookseller = Koha
::Acquisition
::Bookseller
->fetch({ id
=> $booksellerid });
136 my $contract = GetContract
({
137 contractnumber
=> $basket->{contractnumber
}
140 #simple parameters reading (all in one :-)
141 our $params = $input->Vars;
142 my $listprice=0; # the price, that can be in MARC record if we have one
143 if ( $ordernumber eq '' and defined $params->{'breedingid'}){
144 #we want to import from the breeding reservoir (from a z3950 search)
145 my ($marcrecord, $encoding) = MARCfindbreeding
($params->{'breedingid'});
146 die("Could not find the selected record in the reservoir, bailing") unless $marcrecord;
148 # Remove all the items (952) from the imported record
149 foreach my $item ($marcrecord->field('952')) {
150 $marcrecord->delete_field($item);
155 ($biblionumber,$duplicatetitle) = FindDuplicate
($marcrecord);
156 if($biblionumber && !$input->param('use_external_source')) {
157 #if duplicate record found and user did not decide yet, first warn user
158 #and let him choose between using new record or existing record
159 Load_Duplicate
($duplicatetitle);
162 #from this point: add a new record
163 if (C4
::Context
->preference("BiblioAddsAuthorities")){
164 my $headings_linked=BiblioAutoLink
($marcrecord, $params->{'frameworkcode'});
167 $params->{'frameworkcode'} or $params->{'frameworkcode'} = "";
168 ( $biblionumber, $bibitemnum ) = AddBiblio
( $marcrecord, $params->{'frameworkcode'} );
169 # get the price if there is one.
170 $listprice = GetMarcPrice
($marcrecord, $marcflavour);
171 SetImportRecordStatus
($params->{'breedingid'}, 'imported');
176 my ( @order_user_ids, @order_users );
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);
189 $budget_id ||= $data->{'budgetid'} // 0;
193 $data = GetOrder
($ordernumber);
194 $biblionumber = $data->{'biblionumber'};
195 $budget_id = $data->{'budget_id'};
197 $basket = GetBasket
( $data->{'basketno'} );
198 $basketno = $basket->{'basketno'};
200 @order_user_ids = GetOrderUsers
($ordernumber);
201 foreach my $order_user_id (@order_user_ids) {
202 my $order_user = GetMember
(borrowernumber
=> $order_user_id);
203 push @order_users, $order_user if $order_user;
208 $suggestion = GetSuggestionInfo
($suggestionid) if $suggestionid;
210 my @currencies = Koha
::Acquisition
::Currencies
->search;
211 my $active_currency = Koha
::Acquisition
::Currencies
->get_active;
213 # build branches list
215 C4
::Context
->preference('IndependentBranches')
216 && C4
::Context
->userenv
217 && !C4
::Context
->IsSuperLibrarian()
218 && C4
::Context
->userenv->{branch
};
219 my $branches = GetBranches
($onlymine);
221 foreach my $thisbranch ( sort {$branches->{$a}->{'branchname'} cmp $branches->{$b}->{'branchname'}} keys %$branches ) {
223 value
=> $thisbranch,
224 branchname
=> $branches->{$thisbranch}->{'branchname'},
226 $row{'selected'} = 1 if( $thisbranch && $data->{branchcode
} && $thisbranch eq $data->{branchcode
}) ;
227 push @branchloop, \
%row;
229 $template->param( branchloop
=> \
@branchloop );
231 # build bookfund list
232 my $borrower= GetMember
('borrowernumber' => $loggedinuser);
233 my ( $flags, $homebranch )= ($borrower->{'flags'},$borrower->{'branchcode'});
235 my $budget = GetBudget
($budget_id);
237 my $budget_loop = [];
238 my $budgets = GetBudgetHierarchy
;
239 foreach my $r (@
{$budgets}) {
240 next unless (CanUserUseBudget
($borrower, $r, $userflags));
241 if (!defined $r->{budget_amount
} || $r->{budget_amount
} == 0) {
244 push @
{$budget_loop}, {
245 b_id
=> $r->{budget_id
},
246 b_txt
=> $r->{budget_name
},
247 b_sort1_authcat
=> $r->{'sort1_authcat'},
248 b_sort2_authcat
=> $r->{'sort2_authcat'},
249 b_active
=> $r->{budget_period_active
},
250 b_sel
=> ( $r->{budget_id
} == $budget_id ) ?
1 : 0,
255 sort { uc( $a->{b_txt
}) cmp uc( $b->{b_txt
}) } @
{$budget_loop};
258 $budget_id = $data->{'budget_id'};
259 $budget_name = $budget->{'budget_name'};
263 $template->param( sort1
=> $data->{'sort1'} );
264 $template->param( sort2
=> $data->{'sort2'} );
266 if (C4
::Context
->preference('AcqCreateItem') eq 'ordering' && !$ordernumber) {
267 # Check if ACQ framework exists
268 my $marc = GetMarcStructure
(1, 'ACQ');
270 $template->param('NoACQframework' => 1);
273 AcqCreateItemOrdering
=> 1,
274 UniqueItemFields
=> C4
::Context
->preference('UniqueItemFields'),
277 # Get the item types list, but only if item_level_itype is YES. Otherwise, it will be in the item, no need to display it in the biblio
279 @itemtypes = Koha
::ItemTypes
->search unless C4
::Context
->preference('item-level_itypes');
281 if ( defined $subscriptionid ) {
282 my $lastOrderReceived = GetLastOrderReceivedFromSubscriptionid
$subscriptionid;
283 if ( defined $lastOrderReceived ) {
284 $budget_id = $lastOrderReceived->{budgetid
};
285 $data->{listprice
} = $lastOrderReceived->{listprice
};
286 $data->{uncertainprice
} = $lastOrderReceived->{uncertainprice
};
287 $data->{gstrate
} = $lastOrderReceived->{gstrate
};
288 $data->{discount
} = $lastOrderReceived->{discount
};
289 $data->{rrp
} = $lastOrderReceived->{rrp
};
290 $data->{ecost
} = $lastOrderReceived->{ecost
};
291 $data->{quantity
} = $lastOrderReceived->{quantity
};
292 $data->{unitprice
} = $lastOrderReceived->{unitprice
};
293 $data->{order_internalnote
} = $lastOrderReceived->{order_internalnote
};
294 $data->{order_vendornote
} = $lastOrderReceived->{order_vendornote
};
295 $data->{sort1
} = $lastOrderReceived->{sort1
};
296 $data->{sort2
} = $lastOrderReceived->{sort2
};
298 $basket = GetBasket
( $input->param('basketno') );
302 # Find the items.barcode subfield for barcode validations
303 my (undef, $barcode_subfield) = GetMarcFromKohaField
('items.barcode', '');
308 budget_id
=> $budget_id,
309 budget_name
=> $budget_name
312 # get option values for gist syspref
313 my @gst_values = map {
315 }, split( '\|', C4
::Context
->preference("gist") );
317 my $quantity = $input->param('rr_quantity_to_order') ?
318 $input->param('rr_quantity_to_order') :
323 existing
=> $biblionumber,
324 ordernumber
=> $ordernumber,
325 # basket informations
326 basketno
=> $basketno,
327 basketname
=> $basket->{'basketname'},
328 basketnote
=> $basket->{'note'},
329 booksellerid
=> $basket->{'booksellerid'},
330 basketbooksellernote
=> $basket->{booksellernote
},
331 basketcontractno
=> $basket->{contractnumber
},
332 basketcontractname
=> $contract->{contractname
},
333 creationdate
=> $basket->{creationdate
},
334 authorisedby
=> $basket->{'authorisedby'},
335 authorisedbyname
=> $basket->{'authorisedbyname'},
336 closedate
=> $basket->{'closedate'},
338 suggestionid
=> $suggestion->{suggestionid
},
339 surnamesuggestedby
=> $suggestion->{surnamesuggestedby
},
340 firstnamesuggestedby
=> $suggestion->{firstnamesuggestedby
},
341 biblionumber
=> $biblionumber,
342 uncertainprice
=> $data->{'uncertainprice'},
343 discount_2dp
=> sprintf( "%.2f", $bookseller->{'discount'} ) , # for display
344 discount
=> $bookseller->{'discount'},
345 orderdiscount_2dp
=> sprintf( "%.2f", $data->{'discount'} || 0 ),
346 orderdiscount
=> $data->{'discount'},
347 order_internalnote
=> $data->{'order_internalnote'},
348 order_vendornote
=> $data->{'order_vendornote'},
349 listincgst
=> $bookseller->{'listincgst'},
350 invoiceincgst
=> $bookseller->{'invoiceincgst'},
351 name
=> $bookseller->{'name'},
352 cur_active_sym
=> $active_currency->symbol,
353 cur_active
=> $active_currency->currency,
354 currencies
=> \
@currencies,
355 currency
=> $data->{currency
},
356 vendor_currency
=> $bookseller->{listprice
},
357 orderexists
=> ( $new eq 'yes' ) ?
0 : 1,
358 title
=> $data->{'title'},
359 author
=> $data->{'author'},
360 publicationyear
=> $data->{'publicationyear'} ?
$data->{'publicationyear'} : $data->{'copyrightdate'},
361 editionstatement
=> $data->{'editionstatement'},
362 budget_loop
=> $budget_loop,
363 isbn
=> $data->{'isbn'},
364 ean
=> $data->{'ean'},
365 seriestitle
=> $data->{'seriestitle'},
366 itemtypeloop
=> \
@itemtypes,
367 quantity
=> $quantity,
368 quantityrec
=> $quantity,
369 rrp
=> $data->{'rrp'},
370 gst_values
=> \
@gst_values,
371 gstrate
=> $data->{gstrate
} ?
$data->{gstrate
}+0.0 : $bookseller->{gstrate
} ?
$bookseller->{gstrate
}+0.0 : 0,
372 listprice
=> sprintf( "%.2f", $data->{listprice
} || $data->{price
} || $listprice),
373 total
=> sprintf( "%.2f", ($data->{ecost
} || 0) * ($data->{'quantity'} || 0) ),
374 ecost
=> sprintf( "%.2f", $data->{ecost
} || 0),
375 unitprice
=> sprintf( "%.2f", $data->{unitprice
} || 0),
376 publishercode
=> $data->{'publishercode'},
377 barcode_subfield
=> $barcode_subfield,
378 import_batch_id
=> $import_batch_id,
379 subscriptionid
=> $subscriptionid,
380 acqcreate
=> C4
::Context
->preference("AcqCreateItem") eq "ordering" ?
1 : "",
381 users_ids
=> join(':', @order_user_ids),
382 users
=> \
@order_users,
383 (uc(C4
::Context
->preference("marcflavour"))) => 1
386 output_html_with_http_headers
$input, $cookie, $template->output;
389 =head2 MARCfindbreeding
391 $record = MARCfindbreeding($breedingid);
393 Look up the import record repository for the record with
394 record with id $breedingid. If found, returns the decoded
395 MARC::Record; otherwise, -1 is returned (FIXME).
396 Returns as second parameter the character encoding.
400 sub MARCfindbreeding
{
402 my ($marc, $encoding) = GetImportRecordMarc
($id);
403 # remove the - in isbn, koha store isbn without any -
405 my $record = MARC
::Record
->new_from_usmarc($marc);
406 my ($isbnfield,$isbnsubfield) = GetMarcFromKohaField
('biblioitems.isbn','');
407 if ( $record->field($isbnfield) ) {
408 foreach my $field ( $record->field($isbnfield) ) {
409 foreach my $subfield ( $field->subfield($isbnsubfield) ) {
410 my $newisbn = $field->subfield($isbnsubfield);
412 $field->update( $isbnsubfield => $newisbn );
416 # fix the unimarc 100 coded field (with unicode information)
417 if ($marcflavour eq 'UNIMARC' && $record->subfield(100,'a')) {
418 my $f100a=$record->subfield(100,'a');
419 my $f100 = $record->field(100);
420 my $f100temp = $f100->as_string;
421 $record->delete_field($f100);
422 if ( length($f100temp) > 28 ) {
423 substr( $f100temp, 26, 2, "50" );
424 $f100->update( 'a' => $f100temp );
425 my $f100 = MARC
::Field
->new( '100', '', '', 'a' => $f100temp );
426 $record->insert_fields_ordered($f100);
430 if ( !defined(ref($record)) ) {
434 # normalize author : probably UNIMARC specific...
435 if ( C4
::Context
->preference("z3950NormalizeAuthor")
436 and C4
::Context
->preference("z3950AuthorAuthFields") )
438 my ( $tag, $subfield ) = GetMarcFromKohaField
("biblio.author", '');
440 # my $summary = C4::Context->preference("z3950authortemplate");
442 C4
::Context
->preference("z3950AuthorAuthFields");
443 my @auth_fields = split /,/, $auth_fields;
446 if ( $record->field($tag) ) {
447 foreach my $tmpfield ( $record->field($tag)->subfields ) {
449 # foreach my $subfieldcode ($tmpfield->subfields){
450 my $subfieldcode = shift @
$tmpfield;
451 my $subfieldvalue = shift @
$tmpfield;
453 $field->add_subfields(
454 "$subfieldcode" => $subfieldvalue )
455 if ( $subfieldcode ne $subfield );
459 MARC
::Field
->new( $tag, "", "",
460 $subfieldcode => $subfieldvalue )
461 if ( $subfieldcode ne $subfield );
465 $record->delete_field( $record->field($tag) );
466 foreach my $fieldtag (@auth_fields) {
467 next unless ( $record->field($fieldtag) );
468 my $lastname = $record->field($fieldtag)->subfield('a');
469 my $firstname = $record->field($fieldtag)->subfield('b');
470 my $title = $record->field($fieldtag)->subfield('c');
471 my $number = $record->field($fieldtag)->subfield('d');
474 # $field->add_subfields("$subfield"=>"[ ".ucfirst($title).ucfirst($firstname)." ".$number." ]");
475 $field->add_subfields(
476 "$subfield" => ucfirst($title) . " "
477 . ucfirst($firstname) . " "
482 # $field->add_subfields("$subfield"=>"[ ".ucfirst($firstname).", ".ucfirst($lastname)." ]");
483 $field->add_subfields(
484 "$subfield" => ucfirst($firstname) . ", "
485 . ucfirst($lastname) );
488 $record->insert_fields_ordered($field);
490 return $record, $encoding;
497 my ($duplicatetitle)= @_;
498 ($template, $loggedinuser, $cookie) = get_template_and_user
(
500 template_name
=> "acqui/neworderempty_duplicate.tt",
503 authnotrequired
=> 0,
504 flagsrequired
=> { acquisition
=> 'order_manage' },
510 biblionumber
=> $biblionumber,
511 basketno
=> $basketno,
512 booksellerid
=> $basket->{'booksellerid'},
513 breedingid
=> $params->{'breedingid'},
514 duplicatetitle
=> $duplicatetitle,
515 (uc(C4
::Context
->preference("marcflavour"))) => 1
518 output_html_with_http_headers
$input, $cookie, $template->output;