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'} );
264 } elsif(scalar(@$budgets)){
265 $CGIsort1 = GetAuthvalueDropbox( 'sort1', @$budgets[0]->{'sort1_authcat'}, '' );
267 $CGIsort1 = GetAuthvalueDropbox( 'sort1','', '' );
270 # if CGIsort is successfully fetched, the use it
271 # else - failback to plain input-field
273 $template->param( CGIsort1 => $CGIsort1 );
275 $template->param( sort1 => $data->{'sort1'} );
280 if ( defined $budget->{'sort2_authcat'} ) {
281 $CGIsort2 = GetAuthvalueDropbox( 'sort2', $budget->{'sort2_authcat'}, $data->{'sort2'} );
283 } elsif(scalar(@$budgets)) {
284 $CGIsort2 = GetAuthvalueDropbox( 'sort2', @$budgets[0]->{sort2_authcat}, '' );
286 $CGIsort2 = GetAuthvalueDropbox( 'sort2','', '' );
290 $template->param( CGIsort2 => $CGIsort2 );
292 $template->param( sort2 => $data->{'sort2'} );
297 # #do a biblioitems lookup on bib
298 # my @bibitems = GetBiblioItemByBiblioNumber($biblionumber);
299 # my $bibitemscount = scalar @bibitems;
301 # if ( $bibitemscount > 0 ) {
302 # # warn "NEWBIBLIO: bibitems for $biblio exists\n";
304 # for ( my $i = 0 ; $i < $bibitemscount ; $i++ ) {
306 # $line{biblioitemnumber} = $bibitems[$i]->{'biblioitemnumber'};
307 # $line{isbn} = $bibitems[$i]->{'isbn'};
308 # $line{itemtype} = $bibitems[$i]->{'itemtype'};
309 # $line{volumeddesc} = $bibitems[$i]->{'volumeddesc'};
310 # push( @bibitemloop, \%line );
312 # $template->param( bibitemloop => \@bibitemloop );
314 # $template->param( bibitemexists => "1" );
317 if (C4::Context->preference('AcqCreateItem') eq 'ordering' && !$ordnum) {
318 # prepare empty item form
319 my $cell = PrepareItemrecordDisplay();
321 push @itemloop,$cell;
323 $template->param(items => \@itemloop);
329 budget_id => $budget_id,
330 budget_name => $budget_name
336 existing => $biblionumber,
338 basketno => $basketno,
339 booksellerid => $booksellerid,
340 suggestionid => $suggestionid,
341 biblionumber => $biblionumber,
342 uncertainprice => $data->{'uncertainprice'},
343 authorisedbyname => $borrower->{'firstname'} . " " . $borrower->{'surname'},
344 biblioitemnumber => $data->{'biblioitemnumber'},
345 itemtype => $data->{'itemtype'},
346 itemtype_desc => $itemtypes->{$data->{'itemtype'}}->{description},
347 discount_2dp => sprintf( "%.2f", $bookseller->{'discount'}) , # for display
348 discount => $bookseller->{'discount'},
349 listincgst => $bookseller->{'listincgst'},
350 invoiceincgst => $bookseller->{'invoiceincgst'},
351 invoicedisc => $bookseller->{'invoicedisc'},
352 nocalc => $bookseller->{'nocalc'},
353 name => $bookseller->{'name'},
354 cur_active_sym => $cur->{symbol},
355 cur_active => $cur->{currency},
356 currency => $bookseller->{'listprice'}, # eg: 'EUR'
357 loop_currencies => \@loop_currency,
358 orderexists => ( $new eq 'yes' ) ? 0 : 1,
359 title => $data->{'title'},
360 author => $data->{'author'},
361 copyrightdate => $data->{'copyrightdate'},
362 budget_dropbox => $budget_dropbox,
363 isbn => $data->{'isbn'},
364 seriestitle => $data->{'seriestitle'},
365 quantity => $data->{'quantity'},
366 quantityrec => $data->{'quantity'},
369 rrp => $data->{'rrp'},
370 list_price => sprintf("%.2f", $data->{'listprice'}), # watch the '-'
371 total => sprintf("%.2f", $data->{ecost}*$data->{quantity} ),
372 invoice => $data->{'booksellerinvoicenumber'},
373 ecost => $data->{'ecost'},
374 purchaseordernumber => $data->{'purchaseordernumber'},
375 notes => $data->{'notes'},
376 publishercode => $data->{'publishercode'},
379 # CHECKME: gst-stuff needs verifing, mason.
380 gstrate => $bookseller->{gstrate} || C4::Context->preference("gist"),
381 gstreg => $bookseller->{'gstreg'},
383 # donation => $donation
386 output_html_with_http_headers $input, $cookie, $template->output;
389 =item 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 (C4::Context->preference('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;