[biblibre-newacq] (bug #3616) fix neworderempty
[koha.git] / acqui / neworderempty.pl
1 #!/usr/bin/perl
2
3 #script to show display basket of orders
4 #written by chris@katipo.co.nz 24/2/2000
5
6 # Copyright 2000-2002 Katipo Communications
7 #
8 # This file is part of Koha.
9 #
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
13 # version.
14 #
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.
18 #
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
22
23
24 =head1 NAME
25
26 neworderempty.pl
27
28 =head1 DESCRIPTION
29 this script allows to create a new record to order it. This record shouldn't exist
30 on database.
31
32 =head1 CGI PARAMETERS
33
34 =over 4
35
36 =item booksellerid
37 the bookseller the librarian has to buy a new book.
38
39 =item title
40 the title of this new record.
41
42 =item author
43 the author of this new record.
44
45 =item copyright
46 the copyright of this new record.
47
48 =item ordnum
49 the number of this order.
50
51 =item biblio
52
53 =item basketno
54 the basket number for this new order.
55
56 =item suggestionid
57 if this order comes from a suggestion.
58
59 =item breedingid
60 the item's id in the breeding reservoir
61
62 =item close
63
64 =back
65
66 =cut
67
68 use warnings;
69 use strict;
70 use CGI;
71 use C4::Context;
72 use C4::Input;
73
74 use C4::Auth;
75 use C4::Budgets;
76 use C4::Input;
77 #use C4::Bookfund;
78
79 use C4::Bookseller;             # GetBookSellerFromId
80 use C4::Acquisition;
81 use C4::Suggestions;    # GetSuggestion
82 use C4::Biblio;                 # GetBiblioData
83 use C4::Output;
84 use C4::Input;
85 use C4::Koha;
86 use C4::Branch;                 # GetBranches
87 use C4::Members;
88 use C4::Search qw/FindDuplicate BiblioAddAuthorities/;
89
90 #needed for z3950 import:
91 use C4::ImportBatch qw/GetImportRecordMarc/;
92
93 my $input        = new CGI;
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');
108 my $data;
109 my $new = 'no';
110
111 my $budget_name;
112
113 my ( $template, $loggedinuser, $cookie ) = get_template_and_user(
114     {
115         template_name   => "acqui/neworderempty.tmpl",
116         query           => $input,
117         type            => "intranet",
118         authnotrequired => 0,
119         flagsrequired   => { acquisition => 'order_manage' },
120         debug           => 1,
121     }
122 );
123
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;
130
131     my $duplicatetitle;
132 #look for duplicates
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);
147             }
148         }
149         if (C4::Context->preference("BiblioAddsAuthorities")){
150               my ($countlinked,$countcreated)=BiblioAddAuthorities($marcrecord, $params->{'frameworkcode'});
151         }
152         my $bibitemnum;
153         $params->{'frameworkcode'} or $params->{'frameworkcode'} = "";
154         ( $biblionumber, $bibitemnum ) = AddBiblio( $marcrecord, $params->{'frameworkcode'} );
155     }
156 }
157
158
159 my $cur = GetCurrency();
160
161 if ( $ordnum eq '' ) {    # create order
162     $new = 'yes';
163
164     #   $ordnum=newordernum;
165     if ( $biblionumber && !$suggestionid ) {
166         $data = GetBiblioData($biblionumber);
167     }
168
169 # get suggestion fields if applicable. If it's a subscription renewal, then the biblio already exists
170 # otherwise, retrieve suggestion information.
171     if ($suggestionid) {
172                 $data = ($biblionumber) ? GetBiblioData($biblionumber) : GetSuggestion($suggestionid);
173     }
174 }
175 else {    #modify order
176     $data   = GetOrder($ordnum);
177     $biblionumber = $data->{'biblionumber'};
178     $budget_id = $data->{'budget_id'};
179
180     #get basketno and supplierno. too!
181     my $data2 = GetBasket( $data->{'basketno'} );
182     $basketno     = $data2->{'basketno'};
183     $booksellerid = $data2->{'booksellerid'};
184 }
185
186 # get currencies (for change rates calcs if needed)
187 my @rates = GetCurrencies();
188 my $count = scalar @rates;
189
190 # ## @rates
191
192 my @loop_currency = ();
193 for ( my $i = 0 ; $i < $count ; $i++ ) {
194     my %line;
195     $line{currency} = $rates[$i]->{'currency'};
196     $line{rate}     = $rates[$i]->{'rate'};
197     push @loop_currency, \%line;
198 }
199
200     # ##  @loop_currency
201
202
203 # build itemtype list
204 my $itemtypes = GetItemTypes;
205
206 my @itemtypesloop;
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'} } ;
209 }
210
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);
217 my @branchloop;
218 foreach my $thisbranch ( sort {$branches->{$a}->{'branchname'} cmp $branches->{$b}->{'branchname'}} keys %$branches ) {
219      my %row = (
220         value      => $thisbranch,
221         branchname => $branches->{$thisbranch}->{'branchname'},
222     );
223         $row{'selected'} = 1 if( $thisbranch eq $data->{branchcode}) ;
224     push @branchloop, \%row;
225 }
226 $template->param( branchloop => \@branchloop , itypeloop => \@itemtypesloop );
227
228 # build bookfund list
229 my $borrower= GetMember('borrowernumber' => $loggedinuser);
230 my ( $flags, $homebranch )= ($borrower->{'flags'},$borrower->{'branchcode'});
231
232 my $budget =  GetBudget($budget_id);
233 # build budget list
234 my %labels;
235 my @values;
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};
241 }
242 # if no budget_id is passed then its an add
243 my $budget_dropbox = CGI::scrolling_list(
244     -name    => 'budget_id',
245     -id      => 'budget_id',
246     -values  => \@values,
247     -size    => 1,
248     -labels  => \%labels,
249     -onChange   => "fetchSortDropbox(this.form)",
250 );
251
252 if ($close) {
253     $budget_id      =  $data->{'budget_id'};
254     $budget_name    =   $budget->{'budget_name'};      
255
256 }
257
258
259 my $CGIsort1;
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'} );
263     }
264 } elsif(scalar(@$budgets)){
265     $CGIsort1 = GetAuthvalueDropbox( 'sort1', @$budgets[0]->{'sort1_authcat'}, '' );
266 }else{
267     $CGIsort1 = GetAuthvalueDropbox( 'sort1','', '' );
268 }
269
270 # if CGIsort is successfully fetched, the use it
271 # else - failback to plain input-field
272 if ($CGIsort1) {
273     $template->param( CGIsort1 => $CGIsort1 );
274 } else {
275     $template->param( sort1 => $data->{'sort1'} );
276 }
277
278 my $CGIsort2;
279 if ($budget) {
280     if ( defined $budget->{'sort2_authcat'} ) {
281         $CGIsort2 = GetAuthvalueDropbox( 'sort2', $budget->{'sort2_authcat'}, $data->{'sort2'} );
282     }
283 } elsif(scalar(@$budgets)) {
284     $CGIsort2 = GetAuthvalueDropbox( 'sort2', @$budgets[0]->{sort2_authcat}, '' );
285 }else{
286     $CGIsort2 = GetAuthvalueDropbox( 'sort2','', '' );
287 }
288
289 if ($CGIsort2) {
290     $template->param( CGIsort2 => $CGIsort2 );
291 } else {
292     $template->param( sort2 => $data->{'sort2'} );
293 }
294
295
296
297 # #do a biblioitems lookup on bib
298 # my @bibitems = GetBiblioItemByBiblioNumber($biblionumber);
299 # my $bibitemscount = scalar @bibitems;
300
301 # if ( $bibitemscount > 0 ) {
302 #     # warn "NEWBIBLIO: bibitems for $biblio exists\n";
303 #     my @bibitemloop;
304 #     for ( my $i = 0 ; $i < $bibitemscount ; $i++ ) {
305 #         my %line;
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 );
311
312 #         $template->param( bibitemloop => \@bibitemloop );
313 #     }
314 #     $template->param( bibitemexists => "1" );
315 # }
316
317 if (C4::Context->preference('AcqCreateItem') eq 'ordering' && !$ordnum) {
318     # prepare empty item form
319     my $cell = PrepareItemrecordDisplay();
320     my @itemloop;
321     push @itemloop,$cell;
322     
323     $template->param(items => \@itemloop);
324 }
325
326 # fill template
327 $template->param(
328     close        => $close,
329     budget_id    => $budget_id,
330     budget_name  => $budget_name
331   )
332   if ($close);
333
334     # ## @loop_currency,
335 $template->param(
336     existing         => $biblionumber,
337     ordnum           => $ordnum,
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'},
367
368
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'},
377
378
379 # CHECKME: gst-stuff needs verifing, mason.
380     gstrate          => $bookseller->{gstrate} || C4::Context->preference("gist"),
381     gstreg           => $bookseller->{'gstreg'},
382
383 #     donation         => $donation
384 );
385
386 output_html_with_http_headers $input, $cookie, $template->output;
387
388
389 =item MARCfindbreeding
390
391     $record = MARCfindbreeding($breedingid);
392
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.
397
398 =cut
399
400 sub MARCfindbreeding {
401     my ( $id ) = @_;
402     my ($marc, $encoding) = GetImportRecordMarc($id);
403     # remove the - in isbn, koha store isbn without any -
404     if ($marc) {
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);
411                     $newisbn =~ s/-//g;
412                     $field->update( $isbnsubfield => $newisbn );
413                 }
414             }
415         }
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);
427             }
428         }
429                 
430         if ( !defined(ref($record)) ) {
431             return -1;
432         }
433         else {
434             # normalize author : probably UNIMARC specific...
435             if (    C4::Context->preference("z3950NormalizeAuthor")
436                 and C4::Context->preference("z3950AuthorAuthFields") )
437             {
438                 my ( $tag, $subfield ) = GetMarcFromKohaField("biblio.author");
439
440  #                 my $summary = C4::Context->preference("z3950authortemplate");
441                 my $auth_fields =
442                   C4::Context->preference("z3950AuthorAuthFields");
443                 my @auth_fields = split /,/, $auth_fields;
444                 my $field;
445
446                 if ( $record->field($tag) ) {
447                     foreach my $tmpfield ( $record->field($tag)->subfields ) {
448
449        #                        foreach my $subfieldcode ($tmpfield->subfields){
450                         my $subfieldcode  = shift @$tmpfield;
451                         my $subfieldvalue = shift @$tmpfield;
452                         if ($field) {
453                             $field->add_subfields(
454                                 "$subfieldcode" => $subfieldvalue )
455                               if ( $subfieldcode ne $subfield );
456                         }
457                         else {
458                             $field =
459                               MARC::Field->new( $tag, "", "",
460                                 $subfieldcode => $subfieldvalue )
461                               if ( $subfieldcode ne $subfield );
462                         }
463                     }
464                 }
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');
472                     if ($title) {
473
474 #                         $field->add_subfields("$subfield"=>"[ ".ucfirst($title).ucfirst($firstname)." ".$number." ]");
475                         $field->add_subfields(
476                                 "$subfield" => ucfirst($title) . " "
477                               . ucfirst($firstname) . " "
478                               . $number );
479                     }
480                     else {
481
482 #                       $field->add_subfields("$subfield"=>"[ ".ucfirst($firstname).", ".ucfirst($lastname)." ]");
483                         $field->add_subfields(
484                             "$subfield" => ucfirst($firstname) . ", "
485                               . ucfirst($lastname) );
486                     }
487                 }
488                 $record->insert_fields_ordered($field);
489             }
490             return $record, $encoding;
491         }
492     }
493     return -1;
494 }
495