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
};
231 # get today date & replace <<YYYY>>, <<YY>>, <<MM>>, <<DD>> if provided in the default value
232 my $today_dt = dt_from_string
;
233 my $year = $today_dt->strftime('%Y');
234 my $shortyear = $today_dt->strftime('%y');
235 my $month = $today_dt->strftime('%m');
236 my $day = $today_dt->strftime('%d');
237 $value =~ s/<<YYYY>>/$year/g;
238 $value =~ s/<<YY>>/$shortyear/g;
239 $value =~ s/<<MM>>/$month/g;
240 $value =~ s/<<DD>>/$day/g;
242 # And <<USER>> with surname (?)
244 ( C4
::Context
->userenv
245 ? C4
::Context
->userenv->{'surname'}
246 : "superlibrarian" );
247 $value =~ s/<<USER>>/$username/g;
249 push @catalog_details, {
251 subfield
=> $subfield,
252 %$mss, # Do we need plugins support (?)
260 $data = GetOrder
($ordernumber);
261 $budget_id = $data->{'budget_id'};
264 subscriptionid
=> $data->{subscriptionid
},
267 $basket = GetBasket
( $data->{'basketno'} );
268 $basketno = $basket->{'basketno'};
270 @order_user_ids = GetOrderUsers
($ordernumber);
271 foreach my $order_user_id (@order_user_ids) {
272 # FIXME Could be improved with search -in
273 my $order_patron = Koha
::Patrons
->find( $order_user_id );
274 push @order_users, $order_patron if $order_patron;
277 $biblionumber = $data->{biblionumber
};
280 # - no ordernumber but a biblionumber: from a subscription, from an existing record
281 # - no ordernumber, no biblionumber: from a suggestion, from a new order
282 if ( not $ordernumber or $biblionumber ) {
283 if ( C4
::Context
->preference('UseACQFrameworkForBiblioRecords') ) {
284 my $record = $biblionumber ? GetMarcBiblio
({ biblionumber
=> $biblionumber }) : undef;
285 foreach my $tag ( sort keys %{$tagslib} ) {
287 next if $tag eq $itemnumber_tag; # skip items fields
288 my @fields = $biblionumber ?
$record->field($tag) : ();
289 foreach my $subfield ( sort keys %{ $tagslib->{$tag} } ) {
290 my $mss = $tagslib->{$tag}{$subfield};
291 next if IsMarcStructureInternal
($mss);
292 next if $mss->{tab
} == -1;
293 # We only need to display the values
294 my $value = join '; ', map { $tag < 10 ?
$_->data : $_->subfield( $subfield ) } @fields;
296 push @catalog_details, {
298 subfield
=> $subfield,
308 $template->param( catalog_details
=> \
@catalog_details, );
311 $suggestion = GetSuggestionInfo
($suggestionid) if $suggestionid;
313 my @currencies = Koha
::Acquisition
::Currencies
->search;
314 my $active_currency = Koha
::Acquisition
::Currencies
->get_active;
316 # build bookfund list
317 my $patron = Koha
::Patrons
->find( $loggedinuser )->unblessed;
319 my $budget = GetBudget
($budget_id);
321 my $budget_loop = [];
322 my $budgets = GetBudgetHierarchy
;
323 foreach my $r (@
{$budgets}) {
324 next unless (CanUserUseBudget
($patron, $r, $userflags));
325 push @
{$budget_loop}, {
326 b_id
=> $r->{budget_id
},
327 b_txt
=> $r->{budget_name
},
328 b_sort1_authcat
=> $r->{'sort1_authcat'},
329 b_sort2_authcat
=> $r->{'sort2_authcat'},
330 b_active
=> $r->{budget_period_active
},
331 b_sel
=> ( $r->{budget_id
} == $budget_id ) ?
1 : 0,
332 b_level
=> $r->{budget_level
},
337 $template->param( sort1
=> $data->{'sort1'} );
338 $template->param( sort2
=> $data->{'sort2'} );
340 if ($basketobj->effective_create_items eq 'ordering' && !$ordernumber) {
341 # Check if ACQ framework exists
342 my $marc = GetMarcStructure
(1, 'ACQ', { unsafe
=> 1 } );
344 $template->param('NoACQframework' => 1);
347 AcqCreateItemOrdering
=> 1,
348 UniqueItemFields
=> C4
::Context
->preference('UniqueItemFields'),
352 # 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
354 @itemtypes = Koha
::ItemTypes
->search unless C4
::Context
->preference('item-level_itypes');
356 if ( defined $from_subscriptionid ) {
357 # Get the last received order for this subscription
358 my $lastOrderReceived = Koha
::Acquisition
::Orders
->search(
360 subscriptionid
=> $from_subscriptionid,
361 datereceived
=> { '!=' => undef }
365 [ { -desc
=> 'datereceived' }, { -desc
=> 'ordernumber' } ]
368 if ( $lastOrderReceived->count ) {
369 $lastOrderReceived = $lastOrderReceived->next->unblessed; # FIXME We should send the object to the template
370 $budget_id = $lastOrderReceived->{budgetid
};
371 $data->{listprice
} = $lastOrderReceived->{listprice
};
372 $data->{uncertainprice
} = $lastOrderReceived->{uncertainprice
};
373 $data->{tax_rate
} = $lastOrderReceived->{tax_rate_on_ordering
};
374 $data->{discount
} = $lastOrderReceived->{discount
};
375 $data->{rrp
} = $lastOrderReceived->{rrp
};
376 $data->{replacementprice
} = $lastOrderReceived->{replacementprice
};
377 $data->{ecost
} = $lastOrderReceived->{ecost
};
378 $data->{quantity
} = $lastOrderReceived->{quantity
};
379 $data->{unitprice
} = $lastOrderReceived->{unitprice
};
380 $data->{order_internalnote
} = $lastOrderReceived->{order_internalnote
};
381 $data->{order_vendornote
} = $lastOrderReceived->{order_vendornote
};
382 $data->{sort1
} = $lastOrderReceived->{sort1
};
383 $data->{sort2
} = $lastOrderReceived->{sort2
};
385 $basket = GetBasket
( $input->param('basketno') );
388 my $subscription = Koha
::Subscriptions
->find($from_subscriptionid);
390 subscriptionid
=> $from_subscriptionid,
391 subscription
=> $subscription,
395 # Find the items.barcode subfield for barcode validations
396 my (undef, $barcode_subfield) = GetMarcFromKohaField
( 'items.barcode' );
399 # get option values for gist syspref
400 my @gst_values = map {
402 }, split( '\|', C4
::Context
->preference("gist") );
404 my $quantity = $input->param('rr_quantity_to_order') ?
405 $input->param('rr_quantity_to_order') :
411 existing
=> $biblionumber,
412 ordernumber
=> $ordernumber,
413 # basket informations
414 basketno
=> $basketno,
416 basketname
=> $basket->{'basketname'},
417 basketnote
=> $basket->{'note'},
418 booksellerid
=> $basket->{'booksellerid'},
419 basketbooksellernote
=> $basket->{booksellernote
},
420 basketcontractno
=> $basket->{contractnumber
},
421 basketcontractname
=> $contract->{contractname
},
422 creationdate
=> $basket->{creationdate
},
423 authorisedby
=> $basket->{'authorisedby'},
424 authorisedbyname
=> $basket->{'authorisedbyname'},
425 closedate
=> $basket->{'closedate'},
427 suggestionid
=> $suggestion->{suggestionid
},
428 surnamesuggestedby
=> $suggestion->{surnamesuggestedby
},
429 firstnamesuggestedby
=> $suggestion->{firstnamesuggestedby
},
430 biblionumber
=> $biblionumber,
431 uncertainprice
=> $data->{'uncertainprice'},
432 discount_2dp
=> sprintf( "%.2f", $bookseller->discount ) , # for display
433 discount
=> $bookseller->discount,
434 orderdiscount_2dp
=> sprintf( "%.2f", $data->{'discount'} || 0 ),
435 orderdiscount
=> $data->{'discount'},
436 order_internalnote
=> $data->{'order_internalnote'},
437 order_vendornote
=> $data->{'order_vendornote'},
438 listincgst
=> $bookseller->listincgst,
439 invoiceincgst
=> $bookseller->invoiceincgst,
440 name
=> $bookseller->name,
441 cur_active_sym
=> $active_currency->symbol,
442 cur_active
=> $active_currency->currency,
443 currencies
=> \
@currencies,
444 currency
=> $data->{currency
},
445 vendor_currency
=> $bookseller->listprice,
446 orderexists
=> ( $new eq 'yes' ) ?
0 : 1,
447 title
=> $data->{'title'},
448 author
=> $data->{'author'},
449 publicationyear
=> $data->{'publicationyear'} ?
$data->{'publicationyear'} : $data->{'copyrightdate'},
450 editionstatement
=> $data->{'editionstatement'},
451 budget_loop
=> $budget_loop,
452 isbn
=> $data->{'isbn'},
453 ean
=> $data->{'ean'},
454 seriestitle
=> $data->{'seriestitle'},
455 itemtypeloop
=> \
@itemtypes,
456 quantity
=> $quantity,
457 quantityrec
=> $quantity,
458 rrp
=> $data->{'rrp'},
459 replacementprice
=> $data->{'replacementprice'},
460 gst_values
=> \
@gst_values,
461 tax_rate
=> $data->{tax_rate_on_ordering
} ?
$data->{tax_rate_on_ordering
}+0.0 : $bookseller->tax_rate ?
$bookseller->tax_rate+0.0 : 0,
462 listprice
=> sprintf( "%.2f", $data->{listprice
} || $data->{price
} || $listprice),
463 total
=> sprintf( "%.2f", ($data->{ecost
} || 0) * ($data->{'quantity'} || 0) ),
464 ecost
=> sprintf( "%.2f", $data->{ecost
} || 0),
465 unitprice
=> sprintf( "%.2f", $data->{unitprice
} || 0),
466 publishercode
=> $data->{'publishercode'},
467 barcode_subfield
=> $barcode_subfield,
468 import_batch_id
=> $import_batch_id,
469 acqcreate
=> $basketobj->effective_create_items eq "ordering" ?
1 : "",
470 users_ids
=> join(':', @order_user_ids),
471 users
=> \
@order_users,
472 (uc(C4
::Context
->preference("marcflavour"))) => 1
475 output_html_with_http_headers
$input, $cookie, $template->output;
478 =head2 MARCfindbreeding
480 $record = MARCfindbreeding($breedingid);
482 Look up the import record repository for the record with
483 record with id $breedingid. If found, returns the decoded
484 MARC::Record; otherwise, -1 is returned (FIXME).
485 Returns as second parameter the character encoding.
489 sub MARCfindbreeding
{
491 my ($marc, $encoding) = GetImportRecordMarc
($id);
492 # remove the - in isbn, koha store isbn without any -
494 my $record = MARC
::Record
->new_from_usmarc($marc);
495 my ($isbnfield,$isbnsubfield) = GetMarcFromKohaField
( 'biblioitems.isbn' );
496 if ( $record->field($isbnfield) ) {
497 foreach my $field ( $record->field($isbnfield) ) {
498 foreach my $subfield ( $field->subfield($isbnsubfield) ) {
499 my $newisbn = $field->subfield($isbnsubfield);
501 $field->update( $isbnsubfield => $newisbn );
505 # fix the unimarc 100 coded field (with unicode information)
506 if ($marcflavour eq 'UNIMARC' && $record->subfield(100,'a')) {
507 my $f100a=$record->subfield(100,'a');
508 my $f100 = $record->field(100);
509 my $f100temp = $f100->as_string;
510 $record->delete_field($f100);
511 if ( length($f100temp) > 28 ) {
512 substr( $f100temp, 26, 2, "50" );
513 $f100->update( 'a' => $f100temp );
514 my $f100 = MARC
::Field
->new( '100', '', '', 'a' => $f100temp );
515 $record->insert_fields_ordered($f100);
519 if ( !defined(ref($record)) ) {
523 # normalize author : probably UNIMARC specific...
524 if ( C4
::Context
->preference("z3950NormalizeAuthor")
525 and C4
::Context
->preference("z3950AuthorAuthFields") )
527 my ( $tag, $subfield ) = GetMarcFromKohaField
( "biblio.author" );
530 C4
::Context
->preference("z3950AuthorAuthFields");
531 my @auth_fields = split /,/, $auth_fields;
534 if ( $record->field($tag) ) {
535 foreach my $tmpfield ( $record->field($tag)->subfields ) {
537 my $subfieldcode = shift @
$tmpfield;
538 my $subfieldvalue = shift @
$tmpfield;
540 $field->add_subfields(
541 "$subfieldcode" => $subfieldvalue )
542 if ( $subfieldcode ne $subfield );
546 MARC
::Field
->new( $tag, "", "",
547 $subfieldcode => $subfieldvalue )
548 if ( $subfieldcode ne $subfield );
552 $record->delete_field( $record->field($tag) );
553 foreach my $fieldtag (@auth_fields) {
554 next unless ( $record->field($fieldtag) );
555 my $lastname = $record->field($fieldtag)->subfield('a');
556 my $firstname = $record->field($fieldtag)->subfield('b');
557 my $title = $record->field($fieldtag)->subfield('c');
558 my $number = $record->field($fieldtag)->subfield('d');
560 $field->add_subfields(
561 "$subfield" => ucfirst($title) . " "
562 . ucfirst($firstname) . " "
566 $field->add_subfields(
567 "$subfield" => ucfirst($firstname) . ", "
568 . ucfirst($lastname) );
571 $record->insert_fields_ordered($field);
573 return $record, $encoding;
580 my ($duplicatetitle)= @_;
581 ($template, $loggedinuser, $cookie) = get_template_and_user
(
583 template_name
=> "acqui/neworderempty_duplicate.tt",
586 authnotrequired
=> 0,
587 flagsrequired
=> { acquisition
=> 'order_manage' },
593 biblionumber
=> $biblionumber,
594 basketno
=> $basketno,
595 booksellerid
=> $basket->{'booksellerid'},
596 breedingid
=> $params->{'breedingid'},
597 duplicatetitle
=> $duplicatetitle,
598 (uc(C4
::Context
->preference("marcflavour"))) => 1
601 output_html_with_http_headers
$input, $cookie, $template->output;