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 flagsrequired
=> { acquisition
=> 'order_manage' },
123 our $marcflavour = C4
::Context
->preference('marcflavour');
126 my $order = GetOrder
($ordernumber);
127 $basketno = $order->{'basketno'};
130 our $basket = GetBasket
($basketno);
131 my $basketobj = Koha
::Acquisition
::Baskets
->find( $basketno );
132 $booksellerid = $basket->{booksellerid
} unless $booksellerid;
133 my $bookseller = Koha
::Acquisition
::Booksellers
->find( $booksellerid );
135 output_and_exit
( $input, $cookie, $template, 'unknown_basket') unless $basketobj;
136 output_and_exit
( $input, $cookie, $template, 'unknown_vendor') unless $bookseller;
139 ordernumber
=> $ordernumber,
140 basketno
=> $basketno,
142 booksellerid
=> $basket->{'booksellerid'},
143 name
=> $bookseller->name,
145 output_and_exit
( $input, $cookie, $template, 'order_cannot_be_edited' )
146 if $ordernumber and $basketobj->closedate;
148 my $contract = GetContract
({
149 contractnumber
=> $basket->{contractnumber
}
152 #simple parameters reading (all in one :-)
153 our $params = $input->Vars;
154 my $listprice=0; # the price, that can be in MARC record if we have one
155 if ( $ordernumber eq '' and defined $params->{'breedingid'}){
156 #we want to import from the breeding reservoir (from a z3950 search)
157 my ($marcrecord, $encoding) = MARCfindbreeding
($params->{'breedingid'});
158 die("Could not find the selected record in the reservoir, bailing") unless $marcrecord;
160 # Remove all the items (952) from the imported record
161 foreach my $item ($marcrecord->field('952')) {
162 $marcrecord->delete_field($item);
167 ($biblionumber,$duplicatetitle) = FindDuplicate
($marcrecord);
168 if($biblionumber && !$input->param('use_external_source')) {
169 #if duplicate record found and user did not decide yet, first warn user
170 #and let them choose between using a new record or an existing record
171 Load_Duplicate
($duplicatetitle);
174 #from this point: add a new record
175 C4
::Acquisition
::FillWithDefaultValues
($marcrecord, {only_mandatory
=> 1});
177 $params->{'frameworkcode'} or $params->{'frameworkcode'} = "";
178 ( $biblionumber, $bibitemnum ) = AddBiblio
( $marcrecord, $params->{'frameworkcode'} );
179 # get the price if there is one.
180 $listprice = GetMarcPrice
($marcrecord, $marcflavour);
181 SetImportRecordStatus
($params->{'breedingid'}, 'imported');
186 my ( @order_user_ids, @order_users, @catalog_details );
187 our $tagslib = GetMarcStructure
(1, 'ACQ', { unsafe
=> 1 } );
188 my ( $itemnumber_tag, $itemnumber_subtag ) = GetMarcFromKohaField
( 'items.itemnumber' );
189 if ( not $ordernumber ) { # create order
192 if ( $biblionumber ) {
193 $data = GetBiblioData
($biblionumber);
195 # get suggestion fields if applicable. If it's a subscription renewal, then the biblio already exists
196 # otherwise, retrieve suggestion information.
197 elsif ($suggestionid) {
198 $data = GetSuggestion
($suggestionid);
199 $budget_id ||= $data->{'budgetid'} // 0;
202 if ( not $biblionumber and Koha
::BiblioFrameworks
->find('ACQ') ) {
203 #my $acq_mss = Koha::MarcSubfieldStructures->search({ frameworkcode => 'ACQ', tagfield => { '!=' => $itemnumber_tag } });
204 foreach my $tag ( sort keys %{$tagslib} ) {
206 next if $tag eq $itemnumber_tag; # skip items fields
207 foreach my $subfield ( sort keys %{ $tagslib->{$tag} } ) {
208 my $mss = $tagslib->{$tag}{$subfield};
209 next if IsMarcStructureInternal
($mss);
210 next if $mss->{tab
} == -1;
211 my $value = $mss->{defaultvalue
};
213 if ($suggestionid and $mss->{kohafield
}) {
214 # Reading suggestion info if ordering from a suggestion
215 if ( $mss->{kohafield
} eq 'biblio.title' ) {
216 $value = $data->{title
};
218 elsif ( $mss->{kohafield
} eq 'biblio.author' ) {
219 $value = $data->{author
};
221 elsif ( $mss->{kohafield
} eq 'biblioitems.publishercode' ) {
222 $value = $data->{publishercode
};
224 elsif ( $mss->{kohafield
} eq 'biblioitems.editionstatement' ) {
225 $value = $data->{editionstatement
};
227 elsif ( $mss->{kohafield
} eq 'biblioitems.publicationyear' ) {
228 $value = $data->{publicationyear
};
230 elsif ( $mss->{kohafield
} eq 'biblioitems.isbn' ) {
231 $value = $data->{isbn
};
233 elsif ( $mss->{kohafield
} eq 'biblio.seriestitle' ) {
234 $value = $data->{seriestitle
};
240 # get today date & replace <<YYYY>>, <<YY>>, <<MM>>, <<DD>> if provided in the default value
241 my $today_dt = dt_from_string
;
242 my $year = $today_dt->strftime('%Y');
243 my $shortyear = $today_dt->strftime('%y');
244 my $month = $today_dt->strftime('%m');
245 my $day = $today_dt->strftime('%d');
246 $value =~ s/<<YYYY>>/$year/g;
247 $value =~ s/<<YY>>/$shortyear/g;
248 $value =~ s/<<MM>>/$month/g;
249 $value =~ s/<<DD>>/$day/g;
251 # And <<USER>> with surname (?)
253 ( C4
::Context
->userenv
254 ? C4
::Context
->userenv->{'surname'}
255 : "superlibrarian" );
256 $value =~ s/<<USER>>/$username/g;
258 push @catalog_details, {
260 subfield
=> $subfield,
261 %$mss, # Do we need plugins support (?)
269 $data = GetOrder
($ordernumber);
270 $budget_id = $data->{'budget_id'};
273 subscriptionid
=> $data->{subscriptionid
},
276 $basket = GetBasket
( $data->{'basketno'} );
277 $basketno = $basket->{'basketno'};
279 @order_user_ids = GetOrderUsers
($ordernumber);
280 foreach my $order_user_id (@order_user_ids) {
281 # FIXME Could be improved with search -in
282 my $order_patron = Koha
::Patrons
->find( $order_user_id );
283 push @order_users, $order_patron if $order_patron;
286 $biblionumber = $data->{biblionumber
};
289 # - no ordernumber but a biblionumber: from a subscription, from an existing record
290 # - no ordernumber, no biblionumber: from a suggestion, from a new order
291 if ( not $ordernumber or $biblionumber ) {
292 if ( C4
::Context
->preference('UseACQFrameworkForBiblioRecords') ) {
293 my $record = $biblionumber ? GetMarcBiblio
({ biblionumber
=> $biblionumber }) : undef;
294 foreach my $tag ( sort keys %{$tagslib} ) {
296 next if $tag eq $itemnumber_tag; # skip items fields
297 my @fields = $biblionumber ?
$record->field($tag) : ();
298 foreach my $subfield ( sort keys %{ $tagslib->{$tag} } ) {
299 my $mss = $tagslib->{$tag}{$subfield};
300 next if IsMarcStructureInternal
($mss);
301 next if $mss->{tab
} == -1;
302 # We only need to display the values
303 my $value = join '; ', map { $tag < 10 ?
$_->data : $_->subfield( $subfield ) } @fields;
305 push @catalog_details, {
307 subfield
=> $subfield,
317 $template->param( catalog_details
=> \
@catalog_details, );
320 $suggestion = GetSuggestionInfo
($suggestionid) if $suggestionid;
322 my @currencies = Koha
::Acquisition
::Currencies
->search;
323 my $active_currency = Koha
::Acquisition
::Currencies
->get_active;
325 # build bookfund list
326 my $patron = Koha
::Patrons
->find( $loggedinuser )->unblessed;
328 my $budget = GetBudget
($budget_id);
330 my $budget_loop = [];
331 my $budgets = GetBudgetHierarchy
;
332 foreach my $r (@
{$budgets}) {
333 next unless (CanUserUseBudget
($patron, $r, $userflags));
334 push @
{$budget_loop}, {
335 b_id
=> $r->{budget_id
},
336 b_txt
=> $r->{budget_name
},
337 b_sort1_authcat
=> $r->{'sort1_authcat'},
338 b_sort2_authcat
=> $r->{'sort2_authcat'},
339 b_active
=> $r->{budget_period_active
},
340 b_sel
=> ( $r->{budget_id
} == $budget_id ) ?
1 : 0,
341 b_level
=> $r->{budget_level
},
346 $template->param( sort1
=> $data->{'sort1'} );
347 $template->param( sort2
=> $data->{'sort2'} );
349 if ($basketobj->effective_create_items eq 'ordering' && !$ordernumber) {
350 # Check if ACQ framework exists
351 my $marc = GetMarcStructure
(1, 'ACQ', { unsafe
=> 1 } );
353 $template->param('NoACQframework' => 1);
356 AcqCreateItemOrdering
=> 1,
357 UniqueItemFields
=> C4
::Context
->preference('UniqueItemFields'),
361 # 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
363 @itemtypes = Koha
::ItemTypes
->search unless C4
::Context
->preference('item-level_itypes');
365 if ( defined $from_subscriptionid ) {
366 # Get the last received order for this subscription
367 my $lastOrderReceived = Koha
::Acquisition
::Orders
->search(
369 subscriptionid
=> $from_subscriptionid,
370 datereceived
=> { '!=' => undef }
374 [ { -desc
=> 'datereceived' }, { -desc
=> 'ordernumber' } ]
377 if ( $lastOrderReceived->count ) {
378 $lastOrderReceived = $lastOrderReceived->next->unblessed; # FIXME We should send the object to the template
379 $budget_id = $lastOrderReceived->{budgetid
};
380 $data->{listprice
} = $lastOrderReceived->{listprice
};
381 $data->{uncertainprice
} = $lastOrderReceived->{uncertainprice
};
382 $data->{tax_rate
} = $lastOrderReceived->{tax_rate_on_ordering
};
383 $data->{discount
} = $lastOrderReceived->{discount
};
384 $data->{rrp
} = $lastOrderReceived->{rrp
};
385 $data->{replacementprice
} = $lastOrderReceived->{replacementprice
};
386 $data->{ecost
} = $lastOrderReceived->{ecost
};
387 $data->{quantity
} = $lastOrderReceived->{quantity
};
388 $data->{unitprice
} = $lastOrderReceived->{unitprice
};
389 $data->{order_internalnote
} = $lastOrderReceived->{order_internalnote
};
390 $data->{order_vendornote
} = $lastOrderReceived->{order_vendornote
};
391 $data->{sort1
} = $lastOrderReceived->{sort1
};
392 $data->{sort2
} = $lastOrderReceived->{sort2
};
394 $basket = GetBasket
( $input->param('basketno') );
397 my $subscription = Koha
::Subscriptions
->find($from_subscriptionid);
399 subscriptionid
=> $from_subscriptionid,
400 subscription
=> $subscription,
404 # Find the items.barcode subfield for barcode validations
405 my (undef, $barcode_subfield) = GetMarcFromKohaField
( 'items.barcode' );
408 # get option values for gist syspref
409 my @gst_values = map {
411 }, split( '\|', C4
::Context
->preference("gist") );
413 my $quantity = $input->param('rr_quantity_to_order') ?
414 $input->param('rr_quantity_to_order') :
420 existing
=> $biblionumber,
421 # basket informations
422 basketname
=> $basket->{'basketname'},
423 basketnote
=> $basket->{'note'},
424 booksellerid
=> $basket->{'booksellerid'},
425 basketbooksellernote
=> $basket->{booksellernote
},
426 basketcontractno
=> $basket->{contractnumber
},
427 basketcontractname
=> $contract->{contractname
},
428 creationdate
=> $basket->{creationdate
},
429 authorisedby
=> $basket->{'authorisedby'},
430 authorisedbyname
=> $basket->{'authorisedbyname'},
431 closedate
=> $basket->{'closedate'},
433 suggestionid
=> $suggestion->{suggestionid
},
434 surnamesuggestedby
=> $suggestion->{surnamesuggestedby
},
435 firstnamesuggestedby
=> $suggestion->{firstnamesuggestedby
},
436 biblionumber
=> $biblionumber,
437 uncertainprice
=> $data->{'uncertainprice'},
438 discount_2dp
=> sprintf( "%.2f", $bookseller->discount ) , # for display
439 discount
=> $bookseller->discount,
440 orderdiscount_2dp
=> sprintf( "%.2f", $data->{'discount'} || 0 ),
441 orderdiscount
=> $data->{'discount'},
442 order_internalnote
=> $data->{'order_internalnote'},
443 order_vendornote
=> $data->{'order_vendornote'},
444 listincgst
=> $bookseller->listincgst,
445 invoiceincgst
=> $bookseller->invoiceincgst,
446 cur_active_sym
=> $active_currency->symbol,
447 cur_active
=> $active_currency->currency,
448 currencies
=> \
@currencies,
449 currency
=> $data->{currency
},
450 vendor_currency
=> $bookseller->listprice,
451 orderexists
=> ( $new eq 'yes' ) ?
0 : 1,
452 title
=> $data->{'title'},
453 author
=> $data->{'author'},
454 publicationyear
=> $data->{'publicationyear'} ?
$data->{'publicationyear'} : $data->{'copyrightdate'},
455 editionstatement
=> $data->{'editionstatement'},
456 budget_loop
=> $budget_loop,
457 isbn
=> $data->{'isbn'},
458 ean
=> $data->{'ean'},
459 seriestitle
=> $data->{'seriestitle'},
460 itemtypeloop
=> \
@itemtypes,
461 quantity
=> $quantity,
462 quantityrec
=> $quantity,
463 rrp
=> $data->{'rrp'},
464 replacementprice
=> $data->{'replacementprice'},
465 gst_values
=> \
@gst_values,
466 tax_rate
=> $data->{tax_rate_on_ordering
} ?
$data->{tax_rate_on_ordering
}+0.0 : $bookseller->tax_rate ?
$bookseller->tax_rate+0.0 : 0,
467 listprice
=> sprintf( "%.2f", $data->{listprice
} || $data->{price
} || $listprice),
468 total
=> sprintf( "%.2f", ($data->{ecost
} || 0) * ($data->{'quantity'} || 0) ),
469 ecost
=> sprintf( "%.2f", $data->{ecost
} || 0),
470 unitprice
=> sprintf( "%.2f", $data->{unitprice
} || 0),
471 publishercode
=> $data->{'publishercode'},
472 barcode_subfield
=> $barcode_subfield,
473 import_batch_id
=> $import_batch_id,
474 acqcreate
=> $basketobj->effective_create_items eq "ordering" ?
1 : "",
475 users_ids
=> join(':', @order_user_ids),
476 users
=> \
@order_users,
477 (uc(C4
::Context
->preference("marcflavour"))) => 1
480 output_html_with_http_headers
$input, $cookie, $template->output;
483 =head2 MARCfindbreeding
485 $record = MARCfindbreeding($breedingid);
487 Look up the import record repository for the record with
488 record with id $breedingid. If found, returns the decoded
489 MARC::Record; otherwise, -1 is returned (FIXME).
490 Returns as second parameter the character encoding.
494 sub MARCfindbreeding
{
496 my ($marc, $encoding) = GetImportRecordMarc
($id);
497 # remove the - in isbn, koha store isbn without any -
499 my $record = MARC
::Record
->new_from_usmarc($marc);
500 my ($isbnfield,$isbnsubfield) = GetMarcFromKohaField
( 'biblioitems.isbn' );
501 if ( $record->field($isbnfield) ) {
502 foreach my $field ( $record->field($isbnfield) ) {
503 foreach my $subfield ( $field->subfield($isbnsubfield) ) {
504 my $newisbn = $field->subfield($isbnsubfield);
506 $field->update( $isbnsubfield => $newisbn );
510 # fix the unimarc 100 coded field (with unicode information)
511 if ($marcflavour eq 'UNIMARC' && $record->subfield(100,'a')) {
512 my $f100a=$record->subfield(100,'a');
513 my $f100 = $record->field(100);
514 my $f100temp = $f100->as_string;
515 $record->delete_field($f100);
516 if ( length($f100temp) > 28 ) {
517 substr( $f100temp, 26, 2, "50" );
518 $f100->update( 'a' => $f100temp );
519 my $f100 = MARC
::Field
->new( '100', '', '', 'a' => $f100temp );
520 $record->insert_fields_ordered($f100);
524 if ( !defined(ref($record)) ) {
528 # normalize author : probably UNIMARC specific...
529 if ( C4
::Context
->preference("z3950NormalizeAuthor")
530 and C4
::Context
->preference("z3950AuthorAuthFields") )
532 my ( $tag, $subfield ) = GetMarcFromKohaField
( "biblio.author" );
535 C4
::Context
->preference("z3950AuthorAuthFields");
536 my @auth_fields = split /,/, $auth_fields;
539 if ( $record->field($tag) ) {
540 foreach my $tmpfield ( $record->field($tag)->subfields ) {
542 my $subfieldcode = shift @
$tmpfield;
543 my $subfieldvalue = shift @
$tmpfield;
545 $field->add_subfields(
546 "$subfieldcode" => $subfieldvalue )
547 if ( $subfieldcode ne $subfield );
551 MARC
::Field
->new( $tag, "", "",
552 $subfieldcode => $subfieldvalue )
553 if ( $subfieldcode ne $subfield );
557 $record->delete_field( $record->field($tag) );
558 foreach my $fieldtag (@auth_fields) {
559 next unless ( $record->field($fieldtag) );
560 my $lastname = $record->field($fieldtag)->subfield('a');
561 my $firstname = $record->field($fieldtag)->subfield('b');
562 my $title = $record->field($fieldtag)->subfield('c');
563 my $number = $record->field($fieldtag)->subfield('d');
565 $field->add_subfields(
566 "$subfield" => ucfirst($title) . " "
567 . ucfirst($firstname) . " "
571 $field->add_subfields(
572 "$subfield" => ucfirst($firstname) . ", "
573 . ucfirst($lastname) );
576 $record->insert_fields_ordered($field);
578 return $record, $encoding;
585 my ($duplicatetitle)= @_;
586 ($template, $loggedinuser, $cookie) = get_template_and_user
(
588 template_name
=> "acqui/neworderempty_duplicate.tt",
591 flagsrequired
=> { acquisition
=> 'order_manage' },
597 biblionumber
=> $biblionumber,
598 basketno
=> $basketno,
599 booksellerid
=> $basket->{'booksellerid'},
600 breedingid
=> $params->{'breedingid'},
601 duplicatetitle
=> $duplicatetitle,
602 (uc(C4
::Context
->preference("marcflavour"))) => 1
605 output_html_with_http_headers
$input, $cookie, $template->output;