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
76 use C4
::Suggestions
; # GetSuggestion
77 use C4
::Biblio
; # GetBiblioData GetMarcPrice
78 use C4
::Items
; #PrepareItemRecord
82 use C4
::Search qw
/FindDuplicate/;
84 #needed for z3950 import:
85 use C4
::ImportBatch qw
/GetImportRecordMarc SetImportRecordStatus/;
87 use Koha
::Acquisition
::Booksellers
;
88 use Koha
::Acquisition
::Currencies
;
89 use Koha
::BiblioFrameworks
;
90 use Koha
::DateUtils
qw( dt_from_string );
91 use Koha
::MarcSubfieldStructures
;
94 use Koha
::RecordProcessor
;
95 use Koha
::Subscriptions
;
98 my $booksellerid = $input->param('booksellerid'); # FIXME: else ERROR!
99 my $budget_id = $input->param('budget_id') || 0;
100 my $title = $input->param('title');
101 my $author = $input->param('author');
102 my $publicationyear = $input->param('publicationyear');
103 my $ordernumber = $input->param('ordernumber') || '';
104 our $biblionumber = $input->param('biblionumber');
105 our $basketno = $input->param('basketno');
106 my $suggestionid = $input->param('suggestionid');
107 my $uncertainprice = $input->param('uncertainprice');
108 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 !
109 my $from_subscriptionid = $input->param('from_subscriptionid');
113 our ( $template, $loggedinuser, $cookie, $userflags ) = get_template_and_user
(
115 template_name
=> "acqui/neworderempty.tt",
118 authnotrequired
=> 0,
119 flagsrequired
=> { acquisition
=> 'order_manage' },
124 our $marcflavour = C4
::Context
->preference('marcflavour');
127 my $order = GetOrder
($ordernumber);
128 $basketno = $order->{'basketno'};
131 our $basket = GetBasket
($basketno);
132 my $basketobj = Koha
::Acquisition
::Baskets
->find( $basketno );
133 $booksellerid = $basket->{booksellerid
} unless $booksellerid;
134 my $bookseller = Koha
::Acquisition
::Booksellers
->find( $booksellerid );
136 output_and_exit
( $input, $cookie, $template, 'unknown_basket') unless $basketobj;
137 output_and_exit
( $input, $cookie, $template, 'unknown_vendor') unless $bookseller;
139 my $contract = GetContract
({
140 contractnumber
=> $basket->{contractnumber
}
143 #simple parameters reading (all in one :-)
144 our $params = $input->Vars;
145 my $listprice=0; # the price, that can be in MARC record if we have one
146 if ( $ordernumber eq '' and defined $params->{'breedingid'}){
147 #we want to import from the breeding reservoir (from a z3950 search)
148 my ($marcrecord, $encoding) = MARCfindbreeding
($params->{'breedingid'});
149 die("Could not find the selected record in the reservoir, bailing") unless $marcrecord;
151 # Remove all the items (952) from the imported record
152 foreach my $item ($marcrecord->field('952')) {
153 $marcrecord->delete_field($item);
158 ($biblionumber,$duplicatetitle) = FindDuplicate
($marcrecord);
159 if($biblionumber && !$input->param('use_external_source')) {
160 #if duplicate record found and user did not decide yet, first warn user
161 #and let them choose between using a new record or an existing record
162 Load_Duplicate
($duplicatetitle);
165 #from this point: add a new record
166 C4
::Acquisition
::FillWithDefaultValues
($marcrecord, {only_mandatory
=> 1});
168 $params->{'frameworkcode'} or $params->{'frameworkcode'} = "";
169 ( $biblionumber, $bibitemnum ) = AddBiblio
( $marcrecord, $params->{'frameworkcode'} );
170 # get the price if there is one.
171 $listprice = GetMarcPrice
($marcrecord, $marcflavour);
172 SetImportRecordStatus
($params->{'breedingid'}, 'imported');
177 my ( @order_user_ids, @order_users, @catalog_details );
178 our $tagslib = GetMarcStructure
(1, 'ACQ', { unsafe
=> 1 } );
179 my ( $itemnumber_tag, $itemnumber_subtag ) = GetMarcFromKohaField
( 'items.itemnumber' );
180 if ( not $ordernumber ) { # create order
183 if ( $biblionumber ) {
184 $data = GetBiblioData
($biblionumber);
186 # get suggestion fields if applicable. If it's a subscription renewal, then the biblio already exists
187 # otherwise, retrieve suggestion information.
188 elsif ($suggestionid) {
189 $data = GetSuggestion
($suggestionid);
190 $budget_id ||= $data->{'budgetid'} // 0;
193 if ( not $biblionumber and Koha
::BiblioFrameworks
->find('ACQ') ) {
194 #my $acq_mss = Koha::MarcSubfieldStructures->search({ frameworkcode => 'ACQ', tagfield => { '!=' => $itemnumber_tag } });
195 foreach my $tag ( sort keys %{$tagslib} ) {
197 next if $tag eq $itemnumber_tag; # skip items fields
198 foreach my $subfield ( sort keys %{ $tagslib->{$tag} } ) {
199 my $mss = $tagslib->{$tag}{$subfield};
200 next if IsMarcStructureInternal
($mss);
201 next if $mss->{tab
} == -1;
202 my $value = $mss->{defaultvalue
};
204 if ($suggestionid and $mss->{kohafield
}) {
205 # Reading suggestion info if ordering from a suggestion
206 if ( $mss->{kohafield
} eq 'biblio.title' ) {
207 $value = $data->{title
};
209 elsif ( $mss->{kohafield
} eq 'biblio.author' ) {
210 $value = $data->{author
};
212 elsif ( $mss->{kohafield
} eq 'biblioitems.publishercode' ) {
213 $value = $data->{publishercode
};
215 elsif ( $mss->{kohafield
} eq 'biblioitems.editionstatement' ) {
216 $value = $data->{editionstatement
};
218 elsif ( $mss->{kohafield
} eq 'biblioitems.publicationyear' ) {
219 $value = $data->{publicationyear
};
221 elsif ( $mss->{kohafield
} eq 'biblioitems.isbn' ) {
222 $value = $data->{isbn
};
224 elsif ( $mss->{kohafield
} eq 'biblio.seriestitle' ) {
225 $value = $data->{seriestitle
};
229 if ( $value eq '' ) {
231 # get today date & replace <<YYYY>>, <<MM>>, <<DD>> if provided in the default value
232 my $today_dt = dt_from_string
;
233 my $year = $today_dt->strftime('%Y');
234 my $month = $today_dt->strftime('%m');
235 my $day = $today_dt->strftime('%d');
236 $value =~ s/<<YYYY>>/$year/g;
237 $value =~ s/<<MM>>/$month/g;
238 $value =~ s/<<DD>>/$day/g;
240 # And <<USER>> with surname (?)
242 ( C4
::Context
->userenv
243 ? C4
::Context
->userenv->{'surname'}
244 : "superlibrarian" );
245 $value =~ s/<<USER>>/$username/g;
247 push @catalog_details, {
249 subfield
=> $subfield,
250 %$mss, # Do we need plugins support (?)
258 $data = GetOrder
($ordernumber);
259 $budget_id = $data->{'budget_id'};
262 subscriptionid
=> $data->{subscriptionid
},
265 $basket = GetBasket
( $data->{'basketno'} );
266 $basketno = $basket->{'basketno'};
268 @order_user_ids = GetOrderUsers
($ordernumber);
269 foreach my $order_user_id (@order_user_ids) {
270 # FIXME Could be improved with search -in
271 my $order_patron = Koha
::Patrons
->find( $order_user_id );
272 push @order_users, $order_patron if $order_patron;
275 $biblionumber = $data->{biblionumber
};
278 # - no ordernumber but a biblionumber: from a subscription, from an existing record
279 # - no ordernumber, no biblionumber: from a suggestion, from a new order
280 if ( not $ordernumber or $biblionumber ) {
281 if ( C4
::Context
->preference('UseACQFrameworkForBiblioRecords') ) {
282 my $record = $biblionumber ? GetMarcBiblio
({ biblionumber
=> $biblionumber }) : undef;
283 foreach my $tag ( sort keys %{$tagslib} ) {
285 next if $tag eq $itemnumber_tag; # skip items fields
286 my @fields = $biblionumber ?
$record->field($tag) : ();
287 foreach my $subfield ( sort keys %{ $tagslib->{$tag} } ) {
288 my $mss = $tagslib->{$tag}{$subfield};
289 next if IsMarcStructureInternal
($mss);
290 next if $mss->{tab
} == -1;
291 # We only need to display the values
292 my $value = join '; ', map { $tag < 10 ?
$_->data : $_->subfield( $subfield ) } @fields;
294 push @catalog_details, {
296 subfield
=> $subfield,
306 $template->param( catalog_details
=> \
@catalog_details, );
309 $suggestion = GetSuggestionInfo
($suggestionid) if $suggestionid;
311 my @currencies = Koha
::Acquisition
::Currencies
->search;
312 my $active_currency = Koha
::Acquisition
::Currencies
->get_active;
314 # build bookfund list
315 my $patron = Koha
::Patrons
->find( $loggedinuser )->unblessed;
317 my $budget = GetBudget
($budget_id);
319 my $budget_loop = [];
320 my $budgets = GetBudgetHierarchy
;
321 foreach my $r (@
{$budgets}) {
322 next unless (CanUserUseBudget
($patron, $r, $userflags));
323 if (!defined $r->{budget_amount
} || $r->{budget_amount
} <0) {
326 push @
{$budget_loop}, {
327 b_id
=> $r->{budget_id
},
328 b_txt
=> $r->{budget_name
},
329 b_sort1_authcat
=> $r->{'sort1_authcat'},
330 b_sort2_authcat
=> $r->{'sort2_authcat'},
331 b_active
=> $r->{budget_period_active
},
332 b_sel
=> ( $r->{budget_id
} == $budget_id ) ?
1 : 0,
333 b_level
=> $r->{budget_level
},
338 $template->param( sort1
=> $data->{'sort1'} );
339 $template->param( sort2
=> $data->{'sort2'} );
341 if ($basketobj->effective_create_items eq 'ordering' && !$ordernumber) {
342 # Check if ACQ framework exists
343 my $marc = GetMarcStructure
(1, 'ACQ', { unsafe
=> 1 } );
345 $template->param('NoACQframework' => 1);
348 AcqCreateItemOrdering
=> 1,
349 UniqueItemFields
=> C4
::Context
->preference('UniqueItemFields'),
353 # 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
355 @itemtypes = Koha
::ItemTypes
->search unless C4
::Context
->preference('item-level_itypes');
357 if ( defined $from_subscriptionid ) {
358 # Get the last received order for this subscription
359 my $lastOrderReceived = Koha
::Acquisition
::Orders
->search(
361 subscriptionid
=> $from_subscriptionid,
362 datereceived
=> { '!=' => undef }
366 [ { -desc
=> 'datereceived' }, { -desc
=> 'ordernumber' } ]
369 if ( $lastOrderReceived->count ) {
370 $lastOrderReceived = $lastOrderReceived->next->unblessed; # FIXME We should send the object to the template
371 $budget_id = $lastOrderReceived->{budgetid
};
372 $data->{listprice
} = $lastOrderReceived->{listprice
};
373 $data->{uncertainprice
} = $lastOrderReceived->{uncertainprice
};
374 $data->{tax_rate
} = $lastOrderReceived->{tax_rate_on_ordering
};
375 $data->{discount
} = $lastOrderReceived->{discount
};
376 $data->{rrp
} = $lastOrderReceived->{rrp
};
377 $data->{replacementprice
} = $lastOrderReceived->{replacementprice
};
378 $data->{ecost
} = $lastOrderReceived->{ecost
};
379 $data->{quantity
} = $lastOrderReceived->{quantity
};
380 $data->{unitprice
} = $lastOrderReceived->{unitprice
};
381 $data->{order_internalnote
} = $lastOrderReceived->{order_internalnote
};
382 $data->{order_vendornote
} = $lastOrderReceived->{order_vendornote
};
383 $data->{sort1
} = $lastOrderReceived->{sort1
};
384 $data->{sort2
} = $lastOrderReceived->{sort2
};
386 $basket = GetBasket
( $input->param('basketno') );
389 my $subscription = Koha
::Subscriptions
->find($from_subscriptionid);
391 subscriptionid
=> $from_subscriptionid,
392 subscription
=> $subscription,
396 # Find the items.barcode subfield for barcode validations
397 my (undef, $barcode_subfield) = GetMarcFromKohaField
( 'items.barcode' );
400 # get option values for gist syspref
401 my @gst_values = map {
403 }, split( '\|', C4
::Context
->preference("gist") );
405 my $quantity = $input->param('rr_quantity_to_order') ?
406 $input->param('rr_quantity_to_order') :
412 existing
=> $biblionumber,
413 ordernumber
=> $ordernumber,
414 # basket informations
415 basketno
=> $basketno,
417 basketname
=> $basket->{'basketname'},
418 basketnote
=> $basket->{'note'},
419 booksellerid
=> $basket->{'booksellerid'},
420 basketbooksellernote
=> $basket->{booksellernote
},
421 basketcontractno
=> $basket->{contractnumber
},
422 basketcontractname
=> $contract->{contractname
},
423 creationdate
=> $basket->{creationdate
},
424 authorisedby
=> $basket->{'authorisedby'},
425 authorisedbyname
=> $basket->{'authorisedbyname'},
426 closedate
=> $basket->{'closedate'},
428 suggestionid
=> $suggestion->{suggestionid
},
429 surnamesuggestedby
=> $suggestion->{surnamesuggestedby
},
430 firstnamesuggestedby
=> $suggestion->{firstnamesuggestedby
},
431 biblionumber
=> $biblionumber,
432 uncertainprice
=> $data->{'uncertainprice'},
433 discount_2dp
=> sprintf( "%.2f", $bookseller->discount ) , # for display
434 discount
=> $bookseller->discount,
435 orderdiscount_2dp
=> sprintf( "%.2f", $data->{'discount'} || 0 ),
436 orderdiscount
=> $data->{'discount'},
437 order_internalnote
=> $data->{'order_internalnote'},
438 order_vendornote
=> $data->{'order_vendornote'},
439 listincgst
=> $bookseller->listincgst,
440 invoiceincgst
=> $bookseller->invoiceincgst,
441 name
=> $bookseller->name,
442 cur_active_sym
=> $active_currency->symbol,
443 cur_active
=> $active_currency->currency,
444 currencies
=> \
@currencies,
445 currency
=> $data->{currency
},
446 vendor_currency
=> $bookseller->listprice,
447 orderexists
=> ( $new eq 'yes' ) ?
0 : 1,
448 title
=> $data->{'title'},
449 author
=> $data->{'author'},
450 publicationyear
=> $data->{'publicationyear'} ?
$data->{'publicationyear'} : $data->{'copyrightdate'},
451 editionstatement
=> $data->{'editionstatement'},
452 budget_loop
=> $budget_loop,
453 isbn
=> $data->{'isbn'},
454 ean
=> $data->{'ean'},
455 seriestitle
=> $data->{'seriestitle'},
456 itemtypeloop
=> \
@itemtypes,
457 quantity
=> $quantity,
458 quantityrec
=> $quantity,
459 rrp
=> $data->{'rrp'},
460 replacementprice
=> $data->{'replacementprice'},
461 gst_values
=> \
@gst_values,
462 tax_rate
=> $data->{tax_rate_on_ordering
} ?
$data->{tax_rate_on_ordering
}+0.0 : $bookseller->tax_rate ?
$bookseller->tax_rate+0.0 : 0,
463 listprice
=> sprintf( "%.2f", $data->{listprice
} || $data->{price
} || $listprice),
464 total
=> sprintf( "%.2f", ($data->{ecost
} || 0) * ($data->{'quantity'} || 0) ),
465 ecost
=> sprintf( "%.2f", $data->{ecost
} || 0),
466 unitprice
=> sprintf( "%.2f", $data->{unitprice
} || 0),
467 publishercode
=> $data->{'publishercode'},
468 barcode_subfield
=> $barcode_subfield,
469 import_batch_id
=> $import_batch_id,
470 acqcreate
=> $basketobj->effective_create_items eq "ordering" ?
1 : "",
471 users_ids
=> join(':', @order_user_ids),
472 users
=> \
@order_users,
473 (uc(C4
::Context
->preference("marcflavour"))) => 1
476 output_html_with_http_headers
$input, $cookie, $template->output;
479 =head2 MARCfindbreeding
481 $record = MARCfindbreeding($breedingid);
483 Look up the import record repository for the record with
484 record with id $breedingid. If found, returns the decoded
485 MARC::Record; otherwise, -1 is returned (FIXME).
486 Returns as second parameter the character encoding.
490 sub MARCfindbreeding
{
492 my ($marc, $encoding) = GetImportRecordMarc
($id);
493 # remove the - in isbn, koha store isbn without any -
495 my $record = MARC
::Record
->new_from_usmarc($marc);
496 my ($isbnfield,$isbnsubfield) = GetMarcFromKohaField
( 'biblioitems.isbn' );
497 if ( $record->field($isbnfield) ) {
498 foreach my $field ( $record->field($isbnfield) ) {
499 foreach my $subfield ( $field->subfield($isbnsubfield) ) {
500 my $newisbn = $field->subfield($isbnsubfield);
502 $field->update( $isbnsubfield => $newisbn );
506 # fix the unimarc 100 coded field (with unicode information)
507 if ($marcflavour eq 'UNIMARC' && $record->subfield(100,'a')) {
508 my $f100a=$record->subfield(100,'a');
509 my $f100 = $record->field(100);
510 my $f100temp = $f100->as_string;
511 $record->delete_field($f100);
512 if ( length($f100temp) > 28 ) {
513 substr( $f100temp, 26, 2, "50" );
514 $f100->update( 'a' => $f100temp );
515 my $f100 = MARC
::Field
->new( '100', '', '', 'a' => $f100temp );
516 $record->insert_fields_ordered($f100);
520 if ( !defined(ref($record)) ) {
524 # normalize author : probably UNIMARC specific...
525 if ( C4
::Context
->preference("z3950NormalizeAuthor")
526 and C4
::Context
->preference("z3950AuthorAuthFields") )
528 my ( $tag, $subfield ) = GetMarcFromKohaField
( "biblio.author" );
531 C4
::Context
->preference("z3950AuthorAuthFields");
532 my @auth_fields = split /,/, $auth_fields;
535 if ( $record->field($tag) ) {
536 foreach my $tmpfield ( $record->field($tag)->subfields ) {
538 my $subfieldcode = shift @
$tmpfield;
539 my $subfieldvalue = shift @
$tmpfield;
541 $field->add_subfields(
542 "$subfieldcode" => $subfieldvalue )
543 if ( $subfieldcode ne $subfield );
547 MARC
::Field
->new( $tag, "", "",
548 $subfieldcode => $subfieldvalue )
549 if ( $subfieldcode ne $subfield );
553 $record->delete_field( $record->field($tag) );
554 foreach my $fieldtag (@auth_fields) {
555 next unless ( $record->field($fieldtag) );
556 my $lastname = $record->field($fieldtag)->subfield('a');
557 my $firstname = $record->field($fieldtag)->subfield('b');
558 my $title = $record->field($fieldtag)->subfield('c');
559 my $number = $record->field($fieldtag)->subfield('d');
561 $field->add_subfields(
562 "$subfield" => ucfirst($title) . " "
563 . ucfirst($firstname) . " "
567 $field->add_subfields(
568 "$subfield" => ucfirst($firstname) . ", "
569 . ucfirst($lastname) );
572 $record->insert_fields_ordered($field);
574 return $record, $encoding;
581 my ($duplicatetitle)= @_;
582 ($template, $loggedinuser, $cookie) = get_template_and_user
(
584 template_name
=> "acqui/neworderempty_duplicate.tt",
587 authnotrequired
=> 0,
588 flagsrequired
=> { acquisition
=> 'order_manage' },
594 biblionumber
=> $biblionumber,
595 basketno
=> $basketno,
596 booksellerid
=> $basket->{'booksellerid'},
597 breedingid
=> $params->{'breedingid'},
598 duplicatetitle
=> $duplicatetitle,
599 (uc(C4
::Context
->preference("marcflavour"))) => 1
602 output_html_with_http_headers
$input, $cookie, $template->output;