]> git.koha-community.org Git - koha.git/blob - acqui/addorderiso2709.pl
Bug 11247: Fix calls of TransformHtmlToXml
[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::Order;
47 use Koha::Acquisition::Bookseller;
48
49 my $input = new CGI;
50 my ($template, $loggedinuser, $cookie, $userflags) = get_template_and_user({
51     template_name => "acqui/addorderiso2709.tt",
52     query => $input,
53     type => "intranet",
54     authnotrequired => 0,
55     flagsrequired   => { acquisition => 'order_manage' },
56     debug => 1,
57 });
58
59 my $cgiparams = $input->Vars;
60 my $op = $cgiparams->{'op'} || '';
61 my $booksellerid  = $input->param('booksellerid');
62 my $allmatch = $input->param('allmatch');
63 my $bookseller = Koha::Acquisition::Bookseller->fetch({ id => $booksellerid });
64 my $data;
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 $active_currency = GetCurrency();
94     my $default_currency;
95     if (! $data->{currency} ) { # New order no currency set
96         if ( $bookseller->{listprice} ) {
97             $default_currency = $bookseller->{listprice};
98         }
99         else {
100             $default_currency = $active_currency->{currency};
101         }
102     }
103     my @rates = GetCurrencies();
104
105     # ## @rates
106
107     my @loop_currency = ();
108     for my $curr ( @rates ) {
109         my $selected;
110         if ($data->{currency} ) {
111             $selected = $curr->{currency} eq $data->{currency};
112         }
113         else {
114             $selected = $curr->{currency} eq $default_currency;
115         }
116         push @loop_currency, {
117             currcode => $curr->{currency},
118             rate     => $curr->{rate},
119             selected => $selected,
120         }
121     }
122
123     $template->param("batch_details" => 1,
124                      "basketno"      => $cgiparams->{'basketno'},
125                      loop_currencies  => \@loop_currency,
126                      "allmatch" => $allmatch,
127                      );
128     import_biblios_list($template, $cgiparams->{'import_batch_id'});
129     if ( C4::Context->preference('AcqCreateItem') eq 'ordering' ) {
130         # prepare empty item form
131         my $cell = PrepareItemrecordDisplay( '', '', '', 'ACQ' );
132
133         #     warn "==> ".Data::Dumper::Dumper($cell);
134         unless ($cell) {
135             $cell = PrepareItemrecordDisplay( '', '', '', '' );
136             $template->param( 'NoACQframework' => 1 );
137         }
138         my @itemloop;
139         push @itemloop, $cell;
140
141         $template->param( items => \@itemloop );
142     }
143 #
144 # 3rd step = import the records
145 #
146 } elsif ( $op eq 'import_records' ) {
147 #import selected lines
148     $template->param('basketno' => $cgiparams->{'basketno'});
149 # Budget_id is mandatory for adding an order, we just add a default, the user needs to modify this aftewards
150     my $budgets = GetBudgets();
151     if (scalar @$budgets == 0){
152         die "No budgets defined, can't continue";
153     }
154     my $budget_id = @$budgets[0]->{'budget_id'};
155 #get all records from a batch, and check their import status to see if they are checked.
156 #(default values: quantity 1, uncertainprice yes, first budget)
157
158     # retrieve the file you want to import
159     my $import_batch_id = $cgiparams->{'import_batch_id'};
160     my $biblios = GetImportRecordsRange($import_batch_id);
161     my $duplinbatch;
162     my $imported = 0;
163     my @import_record_id_selected = $input->param("import_record_id");
164     my @quantities = $input->param('quantity');
165     my @prices = $input->param('price');
166     my @budgets_id = $input->param('budget_id');
167     my @discount = $input->param('discount');
168     my @sort1 = $input->param('sort1');
169     my @sort2 = $input->param('sort2');
170     my $cur = GetCurrency();
171     for my $biblio (@$biblios){
172         # Check if this import_record_id was selected
173         next if not grep { $_ eq $$biblio{import_record_id} } @import_record_id_selected;
174         my ( $marcblob, $encoding ) = GetImportRecordMarc( $biblio->{'import_record_id'} );
175         my $marcrecord = MARC::Record->new_from_usmarc($marcblob) || die "couldn't translate marc information";
176         my $match = GetImportRecordMatches( $biblio->{'import_record_id'}, 1 );
177         my $biblionumber=$#$match > -1?$match->[0]->{'biblionumber'}:0;
178         my $c_quantity = shift( @quantities ) || GetMarcQuantity($marcrecord, C4::Context->preference('marcflavour') ) || 1;
179         my $c_budget_id = shift( @budgets_id ) || $input->param('all_budget_id') || $budget_id;
180         my $c_discount = shift ( @discount);
181         $c_discount = $c_discount / 100 if $c_discount > 1;
182         my $c_sort1 = shift( @sort1 ) || $input->param('all_sort1') || '';
183         my $c_sort2 = shift( @sort2 ) || $input->param('all_sort2') || '';
184
185         # 1st insert the biblio, or find it through matcher
186         unless ( $biblionumber ) {
187             $duplinbatch=$import_batch_id and next if FindDuplicate($marcrecord);
188             # add the biblio
189             my $bibitemnum;
190
191             # remove ISBN -
192             my ( $isbnfield, $isbnsubfield ) = GetMarcFromKohaField( 'biblioitems.isbn', '' );
193             if ( $marcrecord->field($isbnfield) ) {
194                 foreach my $field ( $marcrecord->field($isbnfield) ) {
195                     foreach my $subfield ( $field->subfield($isbnsubfield) ) {
196                         my $newisbn = $field->subfield($isbnsubfield);
197                         $newisbn =~ s/-//g;
198                         $field->update( $isbnsubfield => $newisbn );
199                     }
200                 }
201             }
202             ( $biblionumber, $bibitemnum ) = AddBiblio( $marcrecord, $cgiparams->{'frameworkcode'} || '' );
203             SetImportRecordStatus( $biblio->{'import_record_id'}, 'imported' );
204             # 2nd add authorities if applicable
205             if (C4::Context->preference("BiblioAddsAuthorities")){
206                 my $headings_linked =BiblioAutoLink($marcrecord, $cgiparams->{'frameworkcode'});
207             }
208         } else {
209             SetImportRecordStatus( $biblio->{'import_record_id'}, 'imported' );
210         }
211         # 3rd add order
212         my $patron = C4::Members::GetMember( borrowernumber => $loggedinuser );
213         my $branch = C4::Branch->GetBranchDetail( $patron->{branchcode} );
214         # get quantity in the MARC record (1 if none)
215         my $quantity = GetMarcQuantity($marcrecord, C4::Context->preference('marcflavour')) || 1;
216         my %orderinfo = (
217             biblionumber       => $biblionumber,
218             basketno           => $cgiparams->{'basketno'},
219             quantity           => $c_quantity,
220             branchcode         => $patron->{branchcode},
221             budget_id          => $c_budget_id,
222             uncertainprice     => 1,
223             sort1              => $c_sort1,
224             sort2              => $c_sort2,
225             order_internalnote => $cgiparams->{'all_order_internalnote'},
226             order_vendornote   => $cgiparams->{'all_order_vendornote'},
227             currency           => $cgiparams->{'all_currency'},
228         );
229         # get the price if there is one.
230         my $price= shift( @prices ) || GetMarcPrice($marcrecord, C4::Context->preference('marcflavour'));
231         if ($price){
232             # in France, the cents separator is the , but sometimes, ppl use a .
233             # in this case, the price will be x100 when unformatted ! Replace the . by a , to get a proper price calculation
234             $price =~ s/\./,/ if C4::Context->preference("CurrencyFormat") eq "FR";
235             $price = Koha::Number::Price->new($price)->unformat;
236             $orderinfo{gstrate} = $bookseller->{gstrate};
237             my $c = $c_discount ? $c_discount : $bookseller->{discount} / 100;
238             if ( $bookseller->{listincgst} ) {
239                 if ( $c_discount ) {
240                     $orderinfo{ecost} = $price;
241                     $orderinfo{rrp}   = $orderinfo{ecost} / ( 1 - $c );
242                 } else {
243                     $orderinfo{ecost} = $price * ( 1 - $c );
244                     $orderinfo{rrp}   = $price;
245                 }
246             } else {
247                 if ( $c_discount ) {
248                     $orderinfo{ecost} = $price / ( 1 + $orderinfo{gstrate} );
249                     $orderinfo{rrp}   = $orderinfo{ecost} / ( 1 - $c );
250                 } else {
251                     $orderinfo{rrp}   = $price / ( 1 + $orderinfo{gstrate} );
252                     $orderinfo{ecost} = $orderinfo{rrp} * ( 1 - $c );
253                 }
254             }
255             $orderinfo{listprice} = $orderinfo{rrp} / $cur->{rate};
256             $orderinfo{unitprice} = $orderinfo{ecost};
257             $orderinfo{total} = $orderinfo{ecost} * $c_quantity;
258         } else {
259             $orderinfo{listprice} = 0;
260         }
261
262         # remove uncertainprice flag if we have found a price in the MARC record
263         $orderinfo{uncertainprice} = 0 if $orderinfo{listprice};
264         my $order = Koha::Acquisition::Order->new( \%orderinfo )->insert;
265
266         # 4th, add items if applicable
267         # parse the item sent by the form, and create an item just for the import_record_id we are dealing with
268         # this is not optimised, but it's working !
269         if ( C4::Context->preference('AcqCreateItem') eq 'ordering' ) {
270             my @tags         = $input->param('tag');
271             my @subfields    = $input->param('subfield');
272             my @field_values = $input->param('field_value');
273             my @serials      = $input->param('serial');
274             my @ind_tag   = $input->param('ind_tag');
275             my @indicator = $input->param('indicator');
276             my $item;
277             push @{ $item->{tags} },         $tags[0];
278             push @{ $item->{subfields} },    $subfields[0];
279             push @{ $item->{field_values} }, $field_values[0];
280             push @{ $item->{ind_tag} },      $ind_tag[0];
281             push @{ $item->{indicator} },    $indicator[0];
282             my $xml = TransformHtmlToXml( \@tags, \@subfields, \@field_values, \@indicator, \@ind_tag );
283             my $record = MARC::Record::new_from_xml( $xml, 'UTF-8' );
284             for (my $qtyloop=1;$qtyloop <= $c_quantity;$qtyloop++) {
285                 my ( $biblionumber, $bibitemnum, $itemnumber ) = AddItemFromMarc( $record, $biblionumber );
286                 $order->add_item( $itemnumber );
287             }
288         } else {
289             SetImportRecordStatus( $biblio->{'import_record_id'}, 'imported' );
290         }
291         $imported++;
292     }
293     # go to basket page
294     if ( $imported ) {
295         print $input->redirect("/cgi-bin/koha/acqui/basket.pl?basketno=".$cgiparams->{'basketno'}."&amp;duplinbatch=$duplinbatch");
296     } else {
297         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");
298     }
299     exit;
300 }
301
302 my $budgets = GetBudgets();
303 my $budget_id = @$budgets[0]->{'budget_id'};
304 # build bookfund list
305 my $borrower = GetMember( 'borrowernumber' => $loggedinuser );
306 my ( $flags, $homebranch ) = ( $borrower->{'flags'}, $borrower->{'branchcode'} );
307 my $budget = GetBudget($budget_id);
308
309 # build budget list
310 my $budget_loop = [];
311 my $budgets_hierarchy = GetBudgetHierarchy;
312 foreach my $r ( @{$budgets_hierarchy} ) {
313     next unless (CanUserUseBudget($borrower, $r, $userflags));
314     if ( !defined $r->{budget_amount} || $r->{budget_amount} == 0 ) {
315         next;
316     }
317     push @{$budget_loop},
318       { b_id  => $r->{budget_id},
319         b_txt => $r->{budget_name},
320         b_sort1_authcat => $r->{'sort1_authcat'},
321         b_sort2_authcat => $r->{'sort2_authcat'},
322         b_active => $r->{budget_period_active},
323         b_sel => ( $r->{budget_id} == $budget_id ) ? 1 : 0,
324       };
325 }
326
327 @{$budget_loop} =
328   sort { uc( $a->{b_txt}) cmp uc( $b->{b_txt}) } @{$budget_loop};
329
330 $template->param( budget_loop    => $budget_loop,);
331
332 output_html_with_http_headers $input, $cookie, $template->output;
333
334
335 sub import_batches_list {
336     my ($template) = @_;
337     my $batches = GetImportBatchRangeDesc();
338
339     my @list = ();
340     foreach my $batch (@$batches) {
341         if ( $batch->{'import_status'} =~ /^staged$|^reverted$/ ) {
342             # check if there is at least 1 line still staged
343             my $stagedList=GetImportRecordsRange($batch->{'import_batch_id'}, undef, 1, $batch->{import_status}, { order_by_direction => 'ASC' });
344             if (scalar @$stagedList) {
345                 push @list, {
346                         import_batch_id => $batch->{'import_batch_id'},
347                         num_records => $batch->{'num_records'},
348                         num_items => $batch->{'num_items'},
349                         staged_date => $batch->{'upload_timestamp'},
350                         import_status => $batch->{'import_status'},
351                         file_name => $batch->{'file_name'},
352                         comments => $batch->{'comments'},
353                 };
354             } else {
355                 # if there are no more line to includes, set the status to imported
356                 SetImportBatchStatus( $batch->{'import_batch_id'}, 'imported' );
357             }
358         }
359     }
360     $template->param(batch_list => \@list); 
361     my $num_batches = GetNumberOfNonZ3950ImportBatches();
362     $template->param(num_results => $num_batches);
363 }
364
365 sub import_biblios_list {
366     my ($template, $import_batch_id) = @_;
367     my $batch = GetImportBatch($import_batch_id,'staged');
368     return () unless $batch and $batch->{import_status} =~ /^staged$|^reverted$/;
369     my $biblios = GetImportRecordsRange($import_batch_id,'','',$batch->{import_status});
370     my @list = ();
371
372     foreach my $biblio (@$biblios) {
373         my $citation = $biblio->{'title'};
374         $citation .= " $biblio->{'author'}" if $biblio->{'author'};
375         $citation .= " (" if $biblio->{'issn'} or $biblio->{'isbn'};
376         $citation .= $biblio->{'isbn'} if $biblio->{'isbn'};
377         $citation .= ", " if $biblio->{'issn'} and $biblio->{'isbn'};
378         $citation .= $biblio->{'issn'} if $biblio->{'issn'};
379         $citation .= ")" if $biblio->{'issn'} or $biblio->{'isbn'};
380         my $match = GetImportRecordMatches($biblio->{'import_record_id'}, 1);
381         my %cellrecord = (
382             import_record_id => $biblio->{'import_record_id'},
383             citation => $citation,
384             import  => 1,
385             status => $biblio->{'status'},
386             record_sequence => $biblio->{'record_sequence'},
387             overlay_status => $biblio->{'overlay_status'},
388             match_biblionumber => $#$match > -1 ? $match->[0]->{'biblionumber'} : 0,
389             match_citation     => $#$match > -1 ? $match->[0]->{'title'} || '' . ' ' . $match->[0]->{'author'} || '': '',
390             match_score => $#$match > -1 ? $match->[0]->{'score'} : 0,
391         );
392         my ( $marcblob, $encoding ) = GetImportRecordMarc( $biblio->{'import_record_id'} );
393         my $marcrecord = MARC::Record->new_from_usmarc($marcblob) || die "couldn't translate marc information";
394         my $infos = get_infos_syspref($marcrecord, ['price', 'quantity', 'budget_code', 'discount', 'sort1', 'sort2']);
395         my $price = $infos->{price};
396         my $quantity = $infos->{quantity};
397         my $budget_code = $infos->{budget_code};
398         my $discount = $infos->{discount};
399         my $sort1 = $infos->{sort1};
400         my $sort2 = $infos->{sort2};
401         my $budget_id;
402         if($budget_code) {
403             my $biblio_budget = GetBudgetByCode($budget_code);
404             if($biblio_budget) {
405                 $budget_id = $biblio_budget->{budget_id};
406             }
407         }
408         $cellrecord{price} = $price || '';
409         $cellrecord{quantity} = $quantity || '';
410         $cellrecord{budget_id} = $budget_id || '';
411         $cellrecord{discount} = $discount || '';
412         $cellrecord{sort1} = $sort1 || '';
413         $cellrecord{sort2} = $sort2 || '';
414
415         push @list, \%cellrecord;
416     }
417     my $num_records = $batch->{'num_records'};
418     my $overlay_action = GetImportBatchOverlayAction($import_batch_id);
419     my $nomatch_action = GetImportBatchNoMatchAction($import_batch_id);
420     my $item_action = GetImportBatchItemAction($import_batch_id);
421     $template->param(biblio_list => \@list,
422                         num_results => $num_records,
423                         import_batch_id => $import_batch_id,
424                         "overlay_action_${overlay_action}" => 1,
425                         overlay_action => $overlay_action,
426                         "nomatch_action_${nomatch_action}" => 1,
427                         nomatch_action => $nomatch_action,
428                         "item_action_${item_action}" => 1,
429                         item_action => $item_action
430                     );
431     batch_info($template, $batch);
432 }
433
434 sub batch_info {
435     my ($template, $batch) = @_;
436     $template->param(batch_info => 1,
437                                       file_name => $batch->{'file_name'},
438                                           comments => $batch->{'comments'},
439                                           import_status => $batch->{'import_status'},
440                                           upload_timestamp => $batch->{'upload_timestamp'},
441                                           num_records => $batch->{'num_records'},
442                                           num_items => $batch->{'num_items'});
443     if ($batch->{'num_records'} > 0) {
444         if ($batch->{'import_status'} eq 'staged' or $batch->{'import_status'} eq 'reverted') {
445             $template->param(can_commit => 1);
446         }
447         if ($batch->{'import_status'} eq 'imported') {
448             $template->param(can_revert => 1);
449         }
450     }
451     if (defined $batch->{'matcher_id'}) {
452         my $matcher = C4::Matcher->fetch($batch->{'matcher_id'});
453         if (defined $matcher) {
454             $template->param('current_matcher_id' => $batch->{'matcher_id'},
455                                               'current_matcher_code' => $matcher->code(),
456                                               'current_matcher_description' => $matcher->description());
457         }
458     }
459     add_matcher_list($batch->{'matcher_id'}, $template);
460 }
461
462 sub add_matcher_list {
463     my ($current_matcher_id, $template) = @_;
464     my @matchers = C4::Matcher::GetMatcherList();
465     if (defined $current_matcher_id) {
466         for (my $i = 0; $i <= $#matchers; $i++) {
467             if ($matchers[$i]->{'matcher_id'} == $current_matcher_id) {
468                 $matchers[$i]->{'selected'} = 1;
469             }
470         }
471     }
472     $template->param(available_matchers => \@matchers);
473 }
474
475 sub get_infos_syspref {
476     my ($record, $field_list) = @_;
477     my $syspref = C4::Context->preference('MarcFieldsToOrder');
478     $syspref = "$syspref\n\n"; # YAML is anal on ending \n. Surplus does not hurt
479     my $yaml = eval {
480         YAML::Load($syspref);
481     };
482     if ( $@ ) {
483         warn "Unable to parse MarcFieldsToOrder syspref : $@";
484         return ();
485     }
486     my $r;
487     for my $field_name ( @$field_list ) {
488         next unless exists $yaml->{$field_name};
489         my @fields = split /\|/, $yaml->{$field_name};
490         for my $field ( @fields ) {
491             my ( $f, $sf ) = split /\$/, $field;
492             next unless $f and $sf;
493             if ( my $v = $record->subfield( $f, $sf ) ) {
494                 $r->{$field_name} = $v;
495             }
496             last if $yaml->{$field};
497         }
498     }
499     return $r;
500 }