Revert "Bug 7143 - Bug for tracking changes to the about page"
[koha.git] / acqui / addorderiso2709.pl
1 #!/usr/bin/perl
2
3 #A script that lets the user populate a basket from an iso2709 file
4 #the script first displays a list of import batches, then when a batch is selected displays all the biblios in it.
5 #The user can then pick which biblios he wants to order
6
7 # Copyright 2008 - 2011 BibLibre SARL
8 #
9 # This file is part of Koha.
10 #
11 # Koha is free software; you can redistribute it and/or modify it
12 # under the terms of the GNU General Public License as published by
13 # the Free Software Foundation; either version 3 of the License, or
14 # (at your option) any later version.
15 #
16 # Koha is distributed in the hope that it will be useful, but
17 # WITHOUT ANY WARRANTY; without even the implied warranty of
18 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19 # GNU General Public License for more details.
20 #
21 # You should have received a copy of the GNU General Public License
22 # along with Koha; if not, see <http://www.gnu.org/licenses>.
23
24 use Modern::Perl;
25 use CGI qw ( -utf8 );
26 use Carp;
27 use YAML qw/Load/;
28
29 use C4::Context;
30 use C4::Auth;
31 use C4::Output;
32 use C4::ImportBatch;
33 use C4::Matcher;
34 use C4::Search qw/FindDuplicate/;
35 use C4::Acquisition;
36 use C4::Biblio;
37 use C4::Items;
38 use C4::Koha;
39 use C4::Budgets;
40 use C4::Acquisition;
41 use C4::Suggestions;    # GetSuggestion
42 use C4::Branch;         # GetBranches
43 use C4::Members;
44
45 use Koha::Number::Price;
46 use Koha::Acquisition::Currencies;
47 use Koha::Acquisition::Order;
48 use Koha::Acquisition::Bookseller;
49
50 my $input = new CGI;
51 my ($template, $loggedinuser, $cookie, $userflags) = get_template_and_user({
52     template_name => "acqui/addorderiso2709.tt",
53     query => $input,
54     type => "intranet",
55     authnotrequired => 0,
56     flagsrequired   => { acquisition => 'order_manage' },
57     debug => 1,
58 });
59
60 my $cgiparams = $input->Vars;
61 my $op = $cgiparams->{'op'} || '';
62 my $booksellerid  = $input->param('booksellerid');
63 my $allmatch = $input->param('allmatch');
64 my $bookseller = Koha::Acquisition::Bookseller->fetch({ id => $booksellerid });
65
66 $template->param(scriptname => "/cgi-bin/koha/acqui/addorderiso2709.pl",
67                 booksellerid => $booksellerid,
68                 booksellername => $bookseller->{name},
69                 );
70
71 if ($cgiparams->{'import_batch_id'} && $op eq ""){
72     $op = "batch_details";
73 }
74
75 #Needed parameters:
76 if (! $cgiparams->{'basketno'}){
77     die "Basketnumber required to order from iso2709 file import";
78 }
79
80 #
81 # 1st step = choose the file to import into acquisition
82 #
83 if ($op eq ""){
84     $template->param("basketno" => $cgiparams->{'basketno'});
85 #display batches
86     import_batches_list($template);
87 #
88 # 2nd step = display the content of the chosen file
89 #
90 } elsif ($op eq "batch_details"){
91 #display lines inside the selected batch
92     # get currencies (for change rates calcs if needed)
93     my @currencies = Koha::Acquisition::Currencies->search;
94
95     $template->param("batch_details" => 1,
96                      "basketno"      => $cgiparams->{'basketno'},
97                      currencies => \@currencies,
98                      bookseller => $bookseller,
99                      "allmatch" => $allmatch,
100                      );
101     import_biblios_list($template, $cgiparams->{'import_batch_id'});
102     my $basket = GetBasket($cgiparams->{basketno});
103     if ( C4::Context->preference('AcqCreateItem') eq 'ordering' && !$basket->{is_standing} ) {
104         # prepare empty item form
105         my $cell = PrepareItemrecordDisplay( '', '', '', 'ACQ' );
106
107         #     warn "==> ".Data::Dumper::Dumper($cell);
108         unless ($cell) {
109             $cell = PrepareItemrecordDisplay( '', '', '', '' );
110             $template->param( 'NoACQframework' => 1 );
111         }
112         my @itemloop;
113         push @itemloop, $cell;
114
115         $template->param( items => \@itemloop );
116     }
117 #
118 # 3rd step = import the records
119 #
120 } elsif ( $op eq 'import_records' ) {
121 #import selected lines
122     $template->param('basketno' => $cgiparams->{'basketno'});
123 # Budget_id is mandatory for adding an order, we just add a default, the user needs to modify this aftewards
124     my $budgets = GetBudgets();
125     if (scalar @$budgets == 0){
126         die "No budgets defined, can't continue";
127     }
128     my $budget_id = @$budgets[0]->{'budget_id'};
129 #get all records from a batch, and check their import status to see if they are checked.
130 #(default values: quantity 1, uncertainprice yes, first budget)
131
132     # retrieve the file you want to import
133     my $import_batch_id = $cgiparams->{'import_batch_id'};
134     my $biblios = GetImportRecordsRange($import_batch_id);
135     my $duplinbatch;
136     my $imported = 0;
137     my @import_record_id_selected = $input->multi_param("import_record_id");
138     my @quantities = $input->multi_param('quantity');
139     my @prices = $input->multi_param('price');
140     my @budgets_id = $input->multi_param('budget_id');
141     my @discount = $input->multi_param('discount');
142     my @sort1 = $input->multi_param('sort1');
143     my @sort2 = $input->multi_param('sort2');
144     my $active_currency = Koha::Acquisition::Currencies->get_active;
145     for my $biblio (@$biblios){
146         # Check if this import_record_id was selected
147         next if not grep { $_ eq $$biblio{import_record_id} } @import_record_id_selected;
148         my ( $marcblob, $encoding ) = GetImportRecordMarc( $biblio->{'import_record_id'} );
149         my $marcrecord = MARC::Record->new_from_usmarc($marcblob) || die "couldn't translate marc information";
150         my $match = GetImportRecordMatches( $biblio->{'import_record_id'}, 1 );
151         my $biblionumber=$#$match > -1?$match->[0]->{'biblionumber'}:0;
152         my $c_quantity = shift( @quantities ) || GetMarcQuantity($marcrecord, C4::Context->preference('marcflavour') ) || 1;
153         my $c_budget_id = shift( @budgets_id ) || $input->param('all_budget_id') || $budget_id;
154         my $c_discount = shift ( @discount);
155         $c_discount = $c_discount / 100 if $c_discount > 1;
156         my $c_sort1 = shift( @sort1 ) || $input->param('all_sort1') || '';
157         my $c_sort2 = shift( @sort2 ) || $input->param('all_sort2') || '';
158
159         # 1st insert the biblio, or find it through matcher
160         unless ( $biblionumber ) {
161             $duplinbatch=$import_batch_id and next if FindDuplicate($marcrecord);
162             # add the biblio
163             my $bibitemnum;
164
165             # remove ISBN -
166             my ( $isbnfield, $isbnsubfield ) = GetMarcFromKohaField( 'biblioitems.isbn', '' );
167             if ( $marcrecord->field($isbnfield) ) {
168                 foreach my $field ( $marcrecord->field($isbnfield) ) {
169                     foreach my $subfield ( $field->subfield($isbnsubfield) ) {
170                         my $newisbn = $field->subfield($isbnsubfield);
171                         $newisbn =~ s/-//g;
172                         $field->update( $isbnsubfield => $newisbn );
173                     }
174                 }
175             }
176             ( $biblionumber, $bibitemnum ) = AddBiblio( $marcrecord, $cgiparams->{'frameworkcode'} || '' );
177             SetImportRecordStatus( $biblio->{'import_record_id'}, 'imported' );
178             # 2nd add authorities if applicable
179             if (C4::Context->preference("BiblioAddsAuthorities")){
180                 my $headings_linked =BiblioAutoLink($marcrecord, $cgiparams->{'frameworkcode'});
181             }
182         } else {
183             SetImportRecordStatus( $biblio->{'import_record_id'}, 'imported' );
184         }
185         # 3rd add order
186         my $patron = C4::Members::GetMember( borrowernumber => $loggedinuser );
187         # get quantity in the MARC record (1 if none)
188         my $quantity = GetMarcQuantity($marcrecord, C4::Context->preference('marcflavour')) || 1;
189         my %orderinfo = (
190             biblionumber       => $biblionumber,
191             basketno           => $cgiparams->{'basketno'},
192             quantity           => $c_quantity,
193             branchcode         => $patron->{branchcode},
194             budget_id          => $c_budget_id,
195             uncertainprice     => 1,
196             sort1              => $c_sort1,
197             sort2              => $c_sort2,
198             order_internalnote => $cgiparams->{'all_order_internalnote'},
199             order_vendornote   => $cgiparams->{'all_order_vendornote'},
200             currency           => $cgiparams->{'all_currency'},
201         );
202         # get the price if there is one.
203         my $price= shift( @prices ) || GetMarcPrice($marcrecord, C4::Context->preference('marcflavour'));
204         if ($price){
205             # in France, the cents separator is the , but sometimes, ppl use a .
206             # in this case, the price will be x100 when unformatted ! Replace the . by a , to get a proper price calculation
207             $price =~ s/\./,/ if C4::Context->preference("CurrencyFormat") eq "FR";
208             $price = Koha::Number::Price->new($price)->unformat;
209             $orderinfo{gstrate} = $bookseller->{gstrate};
210             my $c = $c_discount ? $c_discount : $bookseller->{discount} / 100;
211             if ( $bookseller->{listincgst} ) {
212                 if ( $c_discount ) {
213                     $orderinfo{ecost} = $price;
214                     $orderinfo{rrp}   = $orderinfo{ecost} / ( 1 - $c );
215                 } else {
216                     $orderinfo{ecost} = $price * ( 1 - $c );
217                     $orderinfo{rrp}   = $price;
218                 }
219             } else {
220                 if ( $c_discount ) {
221                     $orderinfo{ecost} = $price / ( 1 + $orderinfo{gstrate} );
222                     $orderinfo{rrp}   = $orderinfo{ecost} / ( 1 - $c );
223                 } else {
224                     $orderinfo{rrp}   = $price / ( 1 + $orderinfo{gstrate} );
225                     $orderinfo{ecost} = $orderinfo{rrp} * ( 1 - $c );
226                 }
227             }
228             $orderinfo{listprice} = $orderinfo{rrp} / $active_currency->rate;
229             $orderinfo{unitprice} = $orderinfo{ecost};
230             $orderinfo{total} = $orderinfo{ecost} * $c_quantity;
231         } else {
232             $orderinfo{listprice} = 0;
233         }
234
235         # remove uncertainprice flag if we have found a price in the MARC record
236         $orderinfo{uncertainprice} = 0 if $orderinfo{listprice};
237         my $order = Koha::Acquisition::Order->new( \%orderinfo )->insert;
238
239         # 4th, add items if applicable
240         # parse the item sent by the form, and create an item just for the import_record_id we are dealing with
241         # this is not optimised, but it's working !
242         my $basket = GetBasket($cgiparams->{basketno});
243         if ( C4::Context->preference('AcqCreateItem') eq 'ordering' && !$basket->{is_standing} ) {
244             my @tags         = $input->multi_param('tag');
245             my @subfields    = $input->multi_param('subfield');
246             my @field_values = $input->multi_param('field_value');
247             my @serials      = $input->multi_param('serial');
248             my @ind_tag   = $input->multi_param('ind_tag');
249             my @indicator = $input->multi_param('indicator');
250             my $item;
251             push @{ $item->{tags} },         $tags[0];
252             push @{ $item->{subfields} },    $subfields[0];
253             push @{ $item->{field_values} }, $field_values[0];
254             push @{ $item->{ind_tag} },      $ind_tag[0];
255             push @{ $item->{indicator} },    $indicator[0];
256             my $xml = TransformHtmlToXml( \@tags, \@subfields, \@field_values, \@indicator, \@ind_tag );
257             my $record = MARC::Record::new_from_xml( $xml, 'UTF-8' );
258             for (my $qtyloop=1;$qtyloop <= $c_quantity;$qtyloop++) {
259                 my ( $biblionumber, $bibitemnum, $itemnumber ) = AddItemFromMarc( $record, $biblionumber );
260                 $order->add_item( $itemnumber );
261             }
262         } else {
263             SetImportRecordStatus( $biblio->{'import_record_id'}, 'imported' );
264         }
265         $imported++;
266     }
267     # go to basket page
268     if ( $imported ) {
269         print $input->redirect("/cgi-bin/koha/acqui/basket.pl?basketno=".$cgiparams->{'basketno'}."&amp;duplinbatch=$duplinbatch");
270     } else {
271         print $input->redirect("/cgi-bin/koha/acqui/addorderiso2709.pl?import_batch_id=$import_batch_id&amp;basketno=".$cgiparams->{'basketno'}."&amp;booksellerid=$booksellerid&amp;allmatch=1");
272     }
273     exit;
274 }
275
276 my $budgets = GetBudgets();
277 my $budget_id = @$budgets[0]->{'budget_id'};
278 # build bookfund list
279 my $borrower = GetMember( 'borrowernumber' => $loggedinuser );
280 my ( $flags, $homebranch ) = ( $borrower->{'flags'}, $borrower->{'branchcode'} );
281 my $budget = GetBudget($budget_id);
282
283 # build budget list
284 my $budget_loop = [];
285 my $budgets_hierarchy = GetBudgetHierarchy;
286 foreach my $r ( @{$budgets_hierarchy} ) {
287     next unless (CanUserUseBudget($borrower, $r, $userflags));
288     if ( !defined $r->{budget_amount} || $r->{budget_amount} == 0 ) {
289         next;
290     }
291     push @{$budget_loop},
292       { b_id  => $r->{budget_id},
293         b_txt => $r->{budget_name},
294         b_sort1_authcat => $r->{'sort1_authcat'},
295         b_sort2_authcat => $r->{'sort2_authcat'},
296         b_active => $r->{budget_period_active},
297         b_sel => ( $r->{budget_id} == $budget_id ) ? 1 : 0,
298       };
299 }
300
301 @{$budget_loop} =
302   sort { uc( $a->{b_txt}) cmp uc( $b->{b_txt}) } @{$budget_loop};
303
304 $template->param( budget_loop    => $budget_loop,);
305
306 output_html_with_http_headers $input, $cookie, $template->output;
307
308
309 sub import_batches_list {
310     my ($template) = @_;
311     my $batches = GetImportBatchRangeDesc();
312
313     my @list = ();
314     foreach my $batch (@$batches) {
315         if ( $batch->{'import_status'} =~ /^staged$|^reverted$/ && $batch->{'record_type'} eq 'biblio') {
316             # check if there is at least 1 line still staged
317             my $stagedList=GetImportRecordsRange($batch->{'import_batch_id'}, undef, 1, $batch->{import_status}, { order_by_direction => 'ASC' });
318             if (scalar @$stagedList) {
319                 push @list, {
320                         import_batch_id => $batch->{'import_batch_id'},
321                         num_records => $batch->{'num_records'},
322                         num_items => $batch->{'num_items'},
323                         staged_date => $batch->{'upload_timestamp'},
324                         import_status => $batch->{'import_status'},
325                         file_name => $batch->{'file_name'},
326                         comments => $batch->{'comments'},
327                 };
328             } else {
329                 # if there are no more line to includes, set the status to imported
330                 SetImportBatchStatus( $batch->{'import_batch_id'}, 'imported' );
331             }
332         }
333     }
334     $template->param(batch_list => \@list); 
335     my $num_batches = GetNumberOfNonZ3950ImportBatches();
336     $template->param(num_results => $num_batches);
337 }
338
339 sub import_biblios_list {
340     my ($template, $import_batch_id) = @_;
341     my $batch = GetImportBatch($import_batch_id,'staged');
342     return () unless $batch and $batch->{import_status} =~ /^staged$|^reverted$/;
343     my $biblios = GetImportRecordsRange($import_batch_id,'','',$batch->{import_status});
344     my @list = ();
345
346     foreach my $biblio (@$biblios) {
347         my $citation = $biblio->{'title'};
348         $citation .= " $biblio->{'author'}" if $biblio->{'author'};
349         $citation .= " (" if $biblio->{'issn'} or $biblio->{'isbn'};
350         $citation .= $biblio->{'isbn'} if $biblio->{'isbn'};
351         $citation .= ", " if $biblio->{'issn'} and $biblio->{'isbn'};
352         $citation .= $biblio->{'issn'} if $biblio->{'issn'};
353         $citation .= ")" if $biblio->{'issn'} or $biblio->{'isbn'};
354         my $match = GetImportRecordMatches($biblio->{'import_record_id'}, 1);
355         my %cellrecord = (
356             import_record_id => $biblio->{'import_record_id'},
357             citation => $citation,
358             import  => 1,
359             status => $biblio->{'status'},
360             record_sequence => $biblio->{'record_sequence'},
361             overlay_status => $biblio->{'overlay_status'},
362             match_biblionumber => $#$match > -1 ? $match->[0]->{'biblionumber'} : 0,
363             match_citation     => $#$match > -1 ? $match->[0]->{'title'} || '' . ' ' . $match->[0]->{'author'} || '': '',
364             match_score => $#$match > -1 ? $match->[0]->{'score'} : 0,
365         );
366         my ( $marcblob, $encoding ) = GetImportRecordMarc( $biblio->{'import_record_id'} );
367         my $marcrecord = MARC::Record->new_from_usmarc($marcblob) || die "couldn't translate marc information";
368         my $infos = get_infos_syspref($marcrecord, ['price', 'quantity', 'budget_code', 'discount', 'sort1', 'sort2']);
369         my $price = $infos->{price};
370         my $quantity = $infos->{quantity};
371         my $budget_code = $infos->{budget_code};
372         my $discount = $infos->{discount};
373         my $sort1 = $infos->{sort1};
374         my $sort2 = $infos->{sort2};
375         my $budget_id;
376         if($budget_code) {
377             my $biblio_budget = GetBudgetByCode($budget_code);
378             if($biblio_budget) {
379                 $budget_id = $biblio_budget->{budget_id};
380             }
381         }
382         $cellrecord{price} = $price || '';
383         $cellrecord{quantity} = $quantity || '';
384         $cellrecord{budget_id} = $budget_id || '';
385         $cellrecord{discount} = $discount || '';
386         $cellrecord{sort1} = $sort1 || '';
387         $cellrecord{sort2} = $sort2 || '';
388
389         push @list, \%cellrecord;
390     }
391     my $num_records = $batch->{'num_records'};
392     my $overlay_action = GetImportBatchOverlayAction($import_batch_id);
393     my $nomatch_action = GetImportBatchNoMatchAction($import_batch_id);
394     my $item_action = GetImportBatchItemAction($import_batch_id);
395     $template->param(biblio_list => \@list,
396                         num_results => $num_records,
397                         import_batch_id => $import_batch_id,
398                         "overlay_action_${overlay_action}" => 1,
399                         overlay_action => $overlay_action,
400                         "nomatch_action_${nomatch_action}" => 1,
401                         nomatch_action => $nomatch_action,
402                         "item_action_${item_action}" => 1,
403                         item_action => $item_action
404                     );
405     batch_info($template, $batch);
406 }
407
408 sub batch_info {
409     my ($template, $batch) = @_;
410     $template->param(batch_info => 1,
411                                       file_name => $batch->{'file_name'},
412                                           comments => $batch->{'comments'},
413                                           import_status => $batch->{'import_status'},
414                                           upload_timestamp => $batch->{'upload_timestamp'},
415                                           num_records => $batch->{'num_records'},
416                                           num_items => $batch->{'num_items'});
417     if ($batch->{'num_records'} > 0) {
418         if ($batch->{'import_status'} eq 'staged' or $batch->{'import_status'} eq 'reverted') {
419             $template->param(can_commit => 1);
420         }
421         if ($batch->{'import_status'} eq 'imported') {
422             $template->param(can_revert => 1);
423         }
424     }
425     if (defined $batch->{'matcher_id'}) {
426         my $matcher = C4::Matcher->fetch($batch->{'matcher_id'});
427         if (defined $matcher) {
428             $template->param('current_matcher_id' => $batch->{'matcher_id'},
429                                               'current_matcher_code' => $matcher->code(),
430                                               'current_matcher_description' => $matcher->description());
431         }
432     }
433     add_matcher_list($batch->{'matcher_id'}, $template);
434 }
435
436 sub add_matcher_list {
437     my ($current_matcher_id, $template) = @_;
438     my @matchers = C4::Matcher::GetMatcherList();
439     if (defined $current_matcher_id) {
440         for (my $i = 0; $i <= $#matchers; $i++) {
441             if ($matchers[$i]->{'matcher_id'} == $current_matcher_id) {
442                 $matchers[$i]->{'selected'} = 1;
443             }
444         }
445     }
446     $template->param(available_matchers => \@matchers);
447 }
448
449 sub get_infos_syspref {
450     my ($record, $field_list) = @_;
451     my $syspref = C4::Context->preference('MarcFieldsToOrder');
452     $syspref = "$syspref\n\n"; # YAML is anal on ending \n. Surplus does not hurt
453     my $yaml = eval {
454         YAML::Load($syspref);
455     };
456     if ( $@ ) {
457         warn "Unable to parse MarcFieldsToOrder syspref : $@";
458         return ();
459     }
460     my $r;
461     for my $field_name ( @$field_list ) {
462         next unless exists $yaml->{$field_name};
463         my @fields = split /\|/, $yaml->{$field_name};
464         for my $field ( @fields ) {
465             my ( $f, $sf ) = split /\$/, $field;
466             next unless $f and $sf;
467             if ( my $v = $record->subfield( $f, $sf ) ) {
468                 $r->{$field_name} = $v;
469             }
470             last if $yaml->{$field};
471         }
472     }
473     return $r;
474 }