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 with
20 # Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
21 # Suite 330, Boston, MA 02111-1307 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.
46 the copyright 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/;
94 my $booksellerid = $input->param('booksellerid'); # FIXME: else ERROR!
95 my $budget_id = $input->param('budget_id'); # FIXME: else ERROR!
96 my $title = $input->param('title');
97 my $author = $input->param('author');
98 my $copyright = $input->param('copyright');
99 my $bookseller = GetBookSellerFromId($booksellerid); # FIXME: else ERROR!
100 my $ordnum = $input->param('ordnum') || '';
101 my $biblionumber = $input->param('biblionumber');
102 my $basketno = $input->param('basketno');
103 my $purchaseorder= $input->param('purchaseordernumber');
104 my $suggestionid = $input->param('suggestionid');
105 # my $donation = $input->param('donation');
106 my $close = $input->param('close');
107 my $uncertainprice = $input->param('uncertainprice');
113 my ( $template, $loggedinuser, $cookie ) = get_template_and_user(
115 template_name => "acqui/neworderempty.tmpl",
118 authnotrequired => 0,
119 flagsrequired => { acquisition => 'order_manage' },
124 #simple parameters reading (all in one :-)
125 my $params = $input->Vars;
126 if ( $ordnum eq '' and defined $params->{'breedingid'}){
127 #we want to import from the breeding reservoir (from a z3950 search)
128 my ($marcrecord, $encoding) = MARCfindbreeding($params->{'breedingid'});
129 die("Could not find the selected record in the reservoir, bailing") unless $marcrecord;
133 if (! (($biblionumber,$duplicatetitle) = FindDuplicate($marcrecord))){
134 my $itemtypes = GetItemTypes();
135 my $marcflavour = C4::Context->preference("marcflavour");
136 # warn("$marcflavour----itemtype"."-------------marcflavour".$marcflavour."---------subfield".$marcrecord->subfield('200', 'b'));
137 #use the itemtype field of the UNIMARC standard.
138 if ( $marcflavour eq 'UNIMARC' ) {
139 my $itemtype = $marcrecord->subfield('200', 'b');
140 #Check wether the itemtype is known
141 warn(grep { $itemtypes->{$_}->{itemtype} =~ /$itemtype/ } keys %$itemtypes);
142 if (scalar(grep { $itemtypes->{$_}->{itemtype} =~ /$itemtype/ } keys %$itemtypes) == 0) {
143 my @itemtypes = sort {lc($itemtypes->{$a}->{'description'}) cmp lc($itemtypes->{$b}->{'description'})} keys %$itemtypes;
144 $itemtype = $itemtypes[0];
145 # warn(YAML->Dump(@itemtypes));
146 $marcrecord->field('200')->update('b' => $itemtype);
149 if (C4::Context->preference("BiblioAddsAuthorities")){
150 my ($countlinked,$countcreated)=BiblioAddAuthorities($marcrecord, $params->{'frameworkcode'});
153 $params->{'frameworkcode'} or $params->{'frameworkcode'} = "";
154 ( $biblionumber, $bibitemnum ) = AddBiblio( $marcrecord, $params->{'frameworkcode'} );
159 my $cur = GetCurrency();
161 if ( $ordnum eq '' ) { # create order
164 # $ordnum=newordernum;
165 if ( $biblionumber && !$suggestionid ) {
166 $data = GetBiblioData($biblionumber);
169 # get suggestion fields if applicable. If it's a subscription renewal, then the biblio already exists
170 # otherwise, retrieve suggestion information.
172 $data = ($biblionumber) ? GetBiblioData($biblionumber) : GetSuggestion($suggestionid);
176 $data = GetOrder($ordnum);
177 $biblionumber = $data->{'biblionumber'};
178 $budget_id = $data->{'budget_id'};
180 #get basketno and supplierno. too!
181 my $data2 = GetBasket( $data->{'basketno'} );
182 $basketno = $data2->{'basketno'};
183 $booksellerid = $data2->{'booksellerid'};
186 # get currencies (for change rates calcs if needed)
187 my @rates = GetCurrencies();
188 my $count = scalar @rates;
192 my @loop_currency = ();
193 for ( my $i = 0 ; $i < $count ; $i++ ) {
195 $line{currency} = $rates[$i]->{'currency'};
196 $line{rate} = $rates[$i]->{'rate'};
197 push @loop_currency, \%line;
203 # build itemtype list
204 my $itemtypes = GetItemTypes;
207 foreach my $thisitemtype (sort {$itemtypes->{$a}->{'description'} cmp $itemtypes->{$b}->{'description'}} keys %$itemtypes) {
208 push @itemtypesloop, { itemtype => $itemtypes->{$thisitemtype}->{'itemtype'} , desc => $itemtypes->{$thisitemtype}->{'description'} } ;
211 # build branches list
212 my $onlymine=C4::Context->preference('IndependantBranches') &&
213 C4::Context->userenv &&
214 C4::Context->userenv->{flags}!=1 &&
215 C4::Context->userenv->{branch};
216 my $branches = GetBranches($onlymine);
218 foreach my $thisbranch ( sort {$branches->{$a}->{'branchname'} cmp $branches->{$b}->{'branchname'}} keys %$branches ) {
220 value => $thisbranch,
221 branchname => $branches->{$thisbranch}->{'branchname'},
223 $row{'selected'} = 1 if( $thisbranch eq $data->{branchcode}) ;
224 push @branchloop, \%row;
226 $template->param( branchloop => \@branchloop , itypeloop => \@itemtypesloop );
228 # build bookfund list
229 my $borrower= GetMember('borrowernumber' => $loggedinuser);
230 my ( $flags, $homebranch )= ($borrower->{'flags'},$borrower->{'branchcode'});
232 my $budget = GetBudget($budget_id);
236 my $budgets = GetBudgetHierarchy('','',$borrower->{'borrowernumber'});
237 foreach my $r (@$budgets) {
238 $labels{"$r->{budget_id}"} = $r->{budget_name};
239 next if sprintf ("%00d", $r->{budget_amount}) == 0;
240 push @values, $r->{budget_id};
242 # if no budget_id is passed then its an add
243 my $budget_dropbox = CGI::scrolling_list(
244 -name => 'budget_id',
249 -onChange => "fetchSortDropbox(this.form)",
253 $budget_id = $data->{'budget_id'};
254 $budget_name = $budget->{'budget_name'};
260 if ($budget) { # its a mod ..
261 if ( defined $budget->{'sort1_authcat'} ) { # with custom Asort* planning values
262 $CGIsort1 = GetAuthvalueDropbox( 'sort1', $budget->{'sort1_authcat'}, $data->{'sort1'} );
265 $CGIsort1 = GetAuthvalueDropbox( 'sort1', @$budgets[0]->{'sort1_authcat'}, '' );
268 # if CGIsort is successfully fetched, the use it
269 # else - failback to plain input-field
271 $template->param( CGIsort1 => $CGIsort1 );
273 $template->param( sort1 => $data->{'sort1'} );
278 if ( defined $budget->{'sort2_authcat'} ) {
279 $CGIsort2 = GetAuthvalueDropbox( 'sort2', $budget->{'sort2_authcat'}, $data->{'sort2'} );
282 $CGIsort2 = GetAuthvalueDropbox( 'sort2', @$budgets[0]->{sort2_authcat}, '' );
285 $template->param( CGIsort2 => $CGIsort2 );
287 $template->param( sort2 => $data->{'sort2'} );
292 # #do a biblioitems lookup on bib
293 # my @bibitems = GetBiblioItemByBiblioNumber($biblionumber);
294 # my $bibitemscount = scalar @bibitems;
296 # if ( $bibitemscount > 0 ) {
297 # # warn "NEWBIBLIO: bibitems for $biblio exists\n";
299 # for ( my $i = 0 ; $i < $bibitemscount ; $i++ ) {
301 # $line{biblioitemnumber} = $bibitems[$i]->{'biblioitemnumber'};
302 # $line{isbn} = $bibitems[$i]->{'isbn'};
303 # $line{itemtype} = $bibitems[$i]->{'itemtype'};
304 # $line{volumeddesc} = $bibitems[$i]->{'volumeddesc'};
305 # push( @bibitemloop, \%line );
307 # $template->param( bibitemloop => \@bibitemloop );
309 # $template->param( bibitemexists => "1" );
312 if (C4::Context->preference('AcqCreateItem') eq 'ordering' && !$ordnum) {
313 # prepare empty item form
314 my $cell = PrepareItemrecordDisplay();
316 push @itemloop,$cell;
318 $template->param(items => \@itemloop);
324 budget_id => $budget_id,
325 budget_name => $budget_name
331 existing => $biblionumber,
333 basketno => $basketno,
334 booksellerid => $booksellerid,
335 suggestionid => $suggestionid,
336 biblionumber => $biblionumber,
337 uncertainprice => $data->{'uncertainprice'},
338 authorisedbyname => $borrower->{'firstname'} . " " . $borrower->{'surname'},
339 biblioitemnumber => $data->{'biblioitemnumber'},
340 itemtype => $data->{'itemtype'},
341 itemtype_desc => $itemtypes->{$data->{'itemtype'}}->{description},
342 discount_2dp => sprintf( "%.2f", $bookseller->{'discount'}) , # for display
343 discount => $bookseller->{'discount'},
344 listincgst => $bookseller->{'listincgst'},
345 invoiceincgst => $bookseller->{'invoiceincgst'},
346 invoicedisc => $bookseller->{'invoicedisc'},
347 nocalc => $bookseller->{'nocalc'},
348 name => $bookseller->{'name'},
349 cur_active_sym => $cur->{symbol},
350 cur_active => $cur->{currency},
351 currency => $bookseller->{'listprice'}, # eg: 'EUR'
352 loop_currencies => \@loop_currency,
353 orderexists => ( $new eq 'yes' ) ? 0 : 1,
354 title => $data->{'title'},
355 author => $data->{'author'},
356 copyrightdate => $data->{'copyrightdate'},
357 budget_dropbox => $budget_dropbox,
358 isbn => $data->{'isbn'},
359 seriestitle => $data->{'seriestitle'},
360 quantity => $data->{'quantity'},
361 quantityrec => $data->{'quantity'},
364 rrp => $data->{'rrp'},
365 list_price => sprintf("%.2f", $data->{'listprice'}), # watch the '-'
366 total => sprintf("%.2f", $data->{ecost}*$data->{quantity} ),
367 invoice => $data->{'booksellerinvoicenumber'},
368 ecost => $data->{'ecost'},
369 purchaseordernumber => $data->{'purchaseordernumber'},
370 notes => $data->{'notes'},
371 publishercode => $data->{'publishercode'},
374 # CHECKME: gst-stuff needs verifing, mason.
375 gstrate => $bookseller->{gstrate} || C4::Context->preference("gist"),
376 gstreg => $bookseller->{'gstreg'},
378 # donation => $donation
381 output_html_with_http_headers $input, $cookie, $template->output;
384 =item MARCfindbreeding
386 $record = MARCfindbreeding($breedingid);
388 Look up the import record repository for the record with
389 record with id $breedingid. If found, returns the decoded
390 MARC::Record; otherwise, -1 is returned (FIXME).
391 Returns as second parameter the character encoding.
395 sub MARCfindbreeding {
397 my ($marc, $encoding) = GetImportRecordMarc($id);
398 # remove the - in isbn, koha store isbn without any -
400 my $record = MARC::Record->new_from_usmarc($marc);
401 my ($isbnfield,$isbnsubfield) = GetMarcFromKohaField('biblioitems.isbn','');
402 if ( $record->field($isbnfield) ) {
403 foreach my $field ( $record->field($isbnfield) ) {
404 foreach my $subfield ( $field->subfield($isbnsubfield) ) {
405 my $newisbn = $field->subfield($isbnsubfield);
407 $field->update( $isbnsubfield => $newisbn );
411 # fix the unimarc 100 coded field (with unicode information)
412 if (C4::Context->preference('marcflavour') eq 'UNIMARC' && $record->subfield(100,'a')) {
413 my $f100a=$record->subfield(100,'a');
414 my $f100 = $record->field(100);
415 my $f100temp = $f100->as_string;
416 $record->delete_field($f100);
417 if ( length($f100temp) > 28 ) {
418 substr( $f100temp, 26, 2, "50" );
419 $f100->update( 'a' => $f100temp );
420 my $f100 = MARC::Field->new( '100', '', '', 'a' => $f100temp );
421 $record->insert_fields_ordered($f100);
425 if ( !defined(ref($record)) ) {
429 # normalize author : probably UNIMARC specific...
430 if ( C4::Context->preference("z3950NormalizeAuthor")
431 and C4::Context->preference("z3950AuthorAuthFields") )
433 my ( $tag, $subfield ) = GetMarcFromKohaField("biblio.author");
435 # my $summary = C4::Context->preference("z3950authortemplate");
437 C4::Context->preference("z3950AuthorAuthFields");
438 my @auth_fields = split /,/, $auth_fields;
441 if ( $record->field($tag) ) {
442 foreach my $tmpfield ( $record->field($tag)->subfields ) {
444 # foreach my $subfieldcode ($tmpfield->subfields){
445 my $subfieldcode = shift @$tmpfield;
446 my $subfieldvalue = shift @$tmpfield;
448 $field->add_subfields(
449 "$subfieldcode" => $subfieldvalue )
450 if ( $subfieldcode ne $subfield );
454 MARC::Field->new( $tag, "", "",
455 $subfieldcode => $subfieldvalue )
456 if ( $subfieldcode ne $subfield );
460 $record->delete_field( $record->field($tag) );
461 foreach my $fieldtag (@auth_fields) {
462 next unless ( $record->field($fieldtag) );
463 my $lastname = $record->field($fieldtag)->subfield('a');
464 my $firstname = $record->field($fieldtag)->subfield('b');
465 my $title = $record->field($fieldtag)->subfield('c');
466 my $number = $record->field($fieldtag)->subfield('d');
469 # $field->add_subfields("$subfield"=>"[ ".ucfirst($title).ucfirst($firstname)." ".$number." ]");
470 $field->add_subfields(
471 "$subfield" => ucfirst($title) . " "
472 . ucfirst($firstname) . " "
477 # $field->add_subfields("$subfield"=>"[ ".ucfirst($firstname).", ".ucfirst($lastname)." ]");
478 $field->add_subfields(
479 "$subfield" => ucfirst($firstname) . ", "
480 . ucfirst($lastname) );
483 $record->insert_fields_ordered($field);
485 return $record, $encoding;