?  search:
summary | log | graphiclog1 | graphiclog2 | commit | commitdiff | tree | refs | edit | fork
blame | history | raw | HEAD
Bug 16718 - Translatability: Fix problems with sentence splitting by <strong> in...
[koha.git] / C4 / Search.pm
blob36c4cfa7de59026256ba4d153176aacd64ef197e
1 package C4::Search;
2
3 # This file is part of Koha.
4 #
5 # Koha is free software; you can redistribute it and/or modify it
6 # under the terms of the GNU General Public License as published by
7 # the Free Software Foundation; either version 3 of the License, or
8 # (at your option) any later version.
9 #
10 # Koha is distributed in the hope that it will be useful, but
11 # WITHOUT ANY WARRANTY; without even the implied warranty of
12 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13 # GNU General Public License for more details.
14 #
15 # You should have received a copy of the GNU General Public License
16 # along with Koha; if not, see <http://www.gnu.org/licenses>.
17
18 use strict;
19 #use warnings; FIXME - Bug 2505
20 require Exporter;
21 use C4::Context;
22 use C4::Biblio; # GetMarcFromKohaField, GetBiblioData
23 use C4::Koha; # getFacets
24 use Koha::DateUtils;
25 use Lingua::Stem;
26 use C4::Search::PazPar2;
27 use XML::Simple;
28 use C4::Members qw(GetHideLostItemsPreference);
29 use C4::XSLT;
30 use C4::Branch;
31 use C4::Reserves; # GetReserveStatus
32 use C4::Debug;
33 use C4::Charset;
34 use Koha::Libraries;
35 use YAML;
36 use URI::Escape;
37 use Business::ISBN;
38 use MARC::Record;
39 use MARC::Field;
40 use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $DEBUG);
41
42 BEGIN {
43 $DEBUG = ($ENV{DEBUG}) ? 1 : 0;
44 }
45
46 =head1 NAME
47
48 C4::Search - Functions for searching the Koha catalog.
49
50 =head1 SYNOPSIS
51
52 See opac/opac-search.pl or catalogue/search.pl for example of usage
53
54 =head1 DESCRIPTION
55
56 This module provides searching functions for Koha's bibliographic databases
57
58 =head1 FUNCTIONS
59
60 =cut
61
62 @ISA = qw(Exporter);
63 @EXPORT = qw(
64 &FindDuplicate
65 &SimpleSearch
66 &searchResults
67 &getRecords
68 &buildQuery
69 &GetDistinctValues
70 &enabled_staff_search_views
71 );
72
73 # make all your functions, whether exported or not;
74
75 =head2 FindDuplicate
76
77 ($biblionumber,$biblionumber,$title) = FindDuplicate($record);
78
79 This function attempts to find duplicate records using a hard-coded, fairly simplistic algorithm
80
81 =cut
82
83 sub FindDuplicate {
84 my ($record) = @_;
85 my $dbh = C4::Context->dbh;
86 my $result = TransformMarcToKoha( $record, '' );
87 my $sth;
88 my $query;
89 my $search;
90 my $type;
91 my ( $biblionumber, $title );
92
93 # search duplicate on ISBN, easy and fast..
94 # ... normalize first
95 if ( $result->{isbn} ) {
96 $result->{isbn} =~ s/\(.*$//;
97 $result->{isbn} =~ s/\s+$//;
98 $query = "isbn:$result->{isbn}";
99 }
100 else {
101 my $QParser;
102 $QParser = C4::Context->queryparser if (C4::Context->preference('UseQueryParser'));
103 my $titleindex;
104 my $authorindex;
105 my $op;
106
107 if ($QParser) {
108 $titleindex = 'title|exact';
109 $authorindex = 'author|exact';
110 $op = '&&';
111 $QParser->custom_data->{'QueryAutoTruncate'} = C4::Context->preference('QueryAutoTruncate');
112 } else {
113 $titleindex = 'ti,ext';
114 $authorindex = 'au,ext';
115 $op = 'and';
116 }
117
118 $result->{title} =~ s /\\//g;
119 $result->{title} =~ s /\"//g;
120 $result->{title} =~ s /\(//g;
121 $result->{title} =~ s /\)//g;
122
123 # FIXME: instead of removing operators, could just do
124 # quotes around the value
125 $result->{title} =~ s/(and|or|not)//g;
126 $query = "$titleindex:\"$result->{title}\"";
127 if ( $result->{author} ) {
128 $result->{author} =~ s /\\//g;
129 $result->{author} =~ s /\"//g;
130 $result->{author} =~ s /\(//g;
131 $result->{author} =~ s /\)//g;
132
133 # remove valid operators
134 $result->{author} =~ s/(and|or|not)//g;
135 $query .= " $op $authorindex:\"$result->{author}\"";
136 }
137 }
138
139 my ( $error, $searchresults, undef ) = SimpleSearch($query); # FIXME :: hardcoded !
140 my @results;
141 if (!defined $error) {
142 foreach my $possible_duplicate_record (@{$searchresults}) {
143 my $marcrecord = new_record_from_zebra(
144 'biblioserver',
145 $possible_duplicate_record
146 );
147
148 my $result = TransformMarcToKoha( $marcrecord, '' );
149
150 # FIXME :: why 2 $biblionumber ?
151 if ($result) {
152 push @results, $result->{'biblionumber'};
153 push @results, $result->{'title'};
154 }
155 }
156 }
157 return @results;
158 }
159
160 =head2 SimpleSearch
161
162 ( $error, $results, $total_hits ) = SimpleSearch( $query, $offset, $max_results, [@servers] );
163
164 This function provides a simple search API on the bibliographic catalog
165
166 =over 2
167
168 =item C<input arg:>
169
170 * $query can be a simple keyword or a complete CCL query
171 * @servers is optional. Defaults to biblioserver as found in koha-conf.xml
172 * $offset - If present, represents the number of records at the beginning to omit. Defaults to 0
173 * $max_results - if present, determines the maximum number of records to fetch. undef is All. defaults to undef.
174
175
176 =item C<Return:>
177
178 Returns an array consisting of three elements
179 * $error is undefined unless an error is detected
180 * $results is a reference to an array of records.
181 * $total_hits is the number of hits that would have been returned with no limit
182
183 If an error is returned the two other return elements are undefined. If error itself is undefined
184 the other two elements are always defined
185
186 =item C<usage in the script:>
187
188 =back
189
190 my ( $error, $marcresults, $total_hits ) = SimpleSearch($query);
191
192 if (defined $error) {
193 $template->param(query_error => $error);
194 warn "error: ".$error;
195 output_html_with_http_headers $input, $cookie, $template->output;
196 exit;
197 }
198
199 my $hits = @{$marcresults};
200 my @results;
201
202 for my $r ( @{$marcresults} ) {
203 my $marcrecord = MARC::File::USMARC::decode($r);
204 my $biblio = TransformMarcToKoha($marcrecord,q{});
205
206 #build the iarray of hashs for the template.
207 push @results, {
208 title => $biblio->{'title'},
209 subtitle => $biblio->{'subtitle'},
210 biblionumber => $biblio->{'biblionumber'},
211 author => $biblio->{'author'},
212 publishercode => $biblio->{'publishercode'},
213 publicationyear => $biblio->{'publicationyear'},
214 };
215
216 }
217
218 $template->param(result=>\@results);
219
220 =cut
221
222 sub SimpleSearch {
223 my ( $query, $offset, $max_results, $servers ) = @_;
224
225 return ( 'No query entered', undef, undef ) unless $query;
226 # FIXME hardcoded value. See catalog/search.pl & opac-search.pl too.
227 my @servers = defined ( $servers ) ? @$servers : ( 'biblioserver' );
228 my @zoom_queries;
229 my @tmpresults;
230 my @zconns;
231 my $results = [];
232 my $total_hits = 0;
233
234 my $QParser;
235 $QParser = C4::Context->queryparser if (C4::Context->preference('UseQueryParser') && ! ($query =~ m/\w,\w|\w=\w/));
236 if ($QParser) {
237 $QParser->custom_data->{'QueryAutoTruncate'} = C4::Context->preference('QueryAutoTruncate');
238 }
239
240 # Initialize & Search Zebra
241 for ( my $i = 0 ; $i < @servers ; $i++ ) {
242 eval {
243 $zconns[$i] = C4::Context->Zconn( $servers[$i], 1 );
244 if ($QParser) {
245 $query =~ s/=/:/g;
246 $QParser->parse( $query );
247 $query = $QParser->target_syntax($servers[$i]);
248 $zoom_queries[$i] = new ZOOM::Query::PQF( $query, $zconns[$i]);
249 } else {
250 $query =~ s/:/=/g;
251 $zoom_queries[$i] = new ZOOM::Query::CCL2RPN( $query, $zconns[$i]);
252 }
253 $tmpresults[$i] = $zconns[$i]->search( $zoom_queries[$i] );
254
255 # error handling
256 my $error =
257 $zconns[$i]->errmsg() . " ("
258 . $zconns[$i]->errcode() . ") "
259 . $zconns[$i]->addinfo() . " "
260 . $zconns[$i]->diagset();
261
262 return ( $error, undef, undef ) if $zconns[$i]->errcode();
263 };
264 if ($@) {
265
266 # caught a ZOOM::Exception
267 my $error =
268 $@->message() . " ("
269 . $@->code() . ") "
270 . $@->addinfo() . " "
271 . $@->diagset();
272 warn $error." for query: $query";
273 return ( $error, undef, undef );
274 }
275 }
276
277 _ZOOM_event_loop(
278 \@zconns,
279 \@tmpresults,
280 sub {
281 my ($i, $size) = @_;
282 my $first_record = defined($offset) ? $offset + 1 : 1;
283 my $hits = $tmpresults[ $i - 1 ]->size();
284 $total_hits += $hits;
285 my $last_record = $hits;
286 if ( defined $max_results && $offset + $max_results < $hits ) {
287 $last_record = $offset + $max_results;
288 }
289
290 for my $j ( $first_record .. $last_record ) {
291 my $record = eval {
292 $tmpresults[ $i - 1 ]->record( $j - 1 )->raw()
293 ; # 0 indexed
294 };
295 push @{$results}, $record if defined $record;
296 }
297 }
298 );
299
300 foreach my $zoom_query (@zoom_queries) {
301 $zoom_query->destroy();
302 }
303
304 return ( undef, $results, $total_hits );
305 }
306
307 =head2 getRecords
308
309 ( undef, $results_hashref, \@facets_loop ) = getRecords (
310
311 $koha_query, $simple_query, $sort_by_ref, $servers_ref,
312 $results_per_page, $offset, $expanded_facet, $branches,$itemtypes,
313 $query_type, $scan
314 );
315
316 The all singing, all dancing, multi-server, asynchronous, scanning,
317 searching, record nabbing, facet-building
318
319 See verbse embedded documentation.
320
321 =cut
322
323 sub getRecords {
324 my (
325 $koha_query, $simple_query, $sort_by_ref, $servers_ref,
326 $results_per_page, $offset, $expanded_facet, $branches,
327 $itemtypes, $query_type, $scan, $opac
328 ) = @_;
329
330 my @servers = @$servers_ref;
331 my @sort_by = @$sort_by_ref;
332
333 # Initialize variables for the ZOOM connection and results object
334 my $zconn;
335 my @zconns;
336 my @results;
337 my $results_hashref = ();
338
339 # Initialize variables for the faceted results objects
340 my $facets_counter = {};
341 my $facets_info = {};
342 my $facets = getFacets();
343
344 my @facets_loop; # stores the ref to array of hashes for template facets loop
345
346 ### LOOP THROUGH THE SERVERS
347 for ( my $i = 0 ; $i < @servers ; $i++ ) {
348 $zconns[$i] = C4::Context->Zconn( $servers[$i], 1 );
349
350 # perform the search, create the results objects
351 # if this is a local search, use the $koha-query, if it's a federated one, use the federated-query
352 my $query_to_use = ($servers[$i] =~ /biblioserver/) ? $koha_query : $simple_query;
353
354 #$query_to_use = $simple_query if $scan;
355 warn $simple_query if ( $scan and $DEBUG );
356
357 # Check if we've got a query_type defined, if so, use it
358 eval {
359 if ($query_type) {
360 if ($query_type =~ /^ccl/) {
361 $query_to_use =~ s/\:/\=/g; # change : to = last minute (FIXME)
362 $results[$i] = $zconns[$i]->search(new ZOOM::Query::CCL2RPN($query_to_use, $zconns[$i]));
363 } elsif ($query_type =~ /^cql/) {
364 $results[$i] = $zconns[$i]->search(new ZOOM::Query::CQL($query_to_use, $zconns[$i]));
365 } elsif ($query_type =~ /^pqf/) {
366 $results[$i] = $zconns[$i]->search(new ZOOM::Query::PQF($query_to_use, $zconns[$i]));
367 } else {
368 warn "Unknown query_type '$query_type'. Results undetermined.";
369 }
370 } elsif ($scan) {
371 $results[$i] = $zconns[$i]->scan( new ZOOM::Query::CCL2RPN($query_to_use, $zconns[$i]));
372 } else {
373 $results[$i] = $zconns[$i]->search(new ZOOM::Query::CCL2RPN($query_to_use, $zconns[$i]));
374 }
375 };
376 if ($@) {
377 warn "WARNING: query problem with $query_to_use " . $@;
378 }
379
380 # Concatenate the sort_by limits and pass them to the results object
381 # Note: sort will override rank
382 my $sort_by;
383 foreach my $sort (@sort_by) {
384 if ( $sort eq "author_az" || $sort eq "author_asc" ) {
385 $sort_by .= "1=1003 <i ";
386 }
387 elsif ( $sort eq "author_za" || $sort eq "author_dsc" ) {
388 $sort_by .= "1=1003 >i ";
389 }
390 elsif ( $sort eq "popularity_asc" ) {
391 $sort_by .= "1=9003 <i ";
392 }
393 elsif ( $sort eq "popularity_dsc" ) {
394 $sort_by .= "1=9003 >i ";
395 }
396 elsif ( $sort eq "call_number_asc" ) {
397 $sort_by .= "1=8007 <i ";
398 }
399 elsif ( $sort eq "call_number_dsc" ) {
400 $sort_by .= "1=8007 >i ";
401 }
402 elsif ( $sort eq "pubdate_asc" ) {
403 $sort_by .= "1=31 <i ";
404 }
405 elsif ( $sort eq "pubdate_dsc" ) {
406 $sort_by .= "1=31 >i ";
407 }
408 elsif ( $sort eq "acqdate_asc" ) {
409 $sort_by .= "1=32 <i ";
410 }
411 elsif ( $sort eq "acqdate_dsc" ) {
412 $sort_by .= "1=32 >i ";
413 }
414 elsif ( $sort eq "title_az" || $sort eq "title_asc" ) {
415 $sort_by .= "1=4 <i ";
416 }
417 elsif ( $sort eq "title_za" || $sort eq "title_dsc" ) {
418 $sort_by .= "1=4 >i ";
419 }
420 else {
421 warn "Ignoring unrecognized sort '$sort' requested" if $sort_by;
422 }
423 }
424 if ( $sort_by && !$scan && $results[$i] ) {
425 if ( $results[$i]->sort( "yaz", $sort_by ) < 0 ) {
426 warn "WARNING sort $sort_by failed";
427 }
428 }
429 } # finished looping through servers
430
431 # The big moment: asynchronously retrieve results from all servers
432 _ZOOM_event_loop(
433 \@zconns,
434 \@results,
435 sub {
436 my ( $i, $size ) = @_;
437 my $results_hash;
438
439 # loop through the results
440 $results_hash->{'hits'} = $size;
441 my $times;
442 if ( $offset + $results_per_page <= $size ) {
443 $times = $offset + $results_per_page;
444 }
445 else {
446 $times = $size;
447 }
448
449 for ( my $j = $offset ; $j < $times ; $j++ ) {
450 my $records_hash;
451 my $record;
452
453 ## Check if it's an index scan
454 if ($scan) {
455 my ( $term, $occ ) = $results[ $i - 1 ]->display_term($j);
456
457 # here we create a minimal MARC record and hand it off to the
458 # template just like a normal result ... perhaps not ideal, but
459 # it works for now
460 my $tmprecord = MARC::Record->new();
461 $tmprecord->encoding('UTF-8');
462 my $tmptitle;
463 my $tmpauthor;
464
465 # the minimal record in author/title (depending on MARC flavour)
466 if ( C4::Context->preference("marcflavour") eq
467 "UNIMARC" )
468 {
469 $tmptitle = MARC::Field->new(
470 '200', ' ', ' ',
471 a => $term,
472 f => $occ
473 );
474 $tmprecord->append_fields($tmptitle);
475 }
476 else {
477 $tmptitle =
478 MARC::Field->new( '245', ' ', ' ', a => $term, );
479 $tmpauthor =
480 MARC::Field->new( '100', ' ', ' ', a => $occ, );
481 $tmprecord->append_fields($tmptitle);
482 $tmprecord->append_fields($tmpauthor);
483 }
484 $results_hash->{'RECORDS'}[$j] =
485 $tmprecord->as_usmarc();
486 }
487
488 # not an index scan
489 else {
490 $record = $results[ $i - 1 ]->record($j)->raw();
491 # warn "RECORD $j:".$record;
492 $results_hash->{'RECORDS'}[$j] = $record;
493 }
494
495 }
496 $results_hashref->{ $servers[ $i - 1 ] } = $results_hash;
497
498 # Fill the facets while we're looping, but only for the
499 # biblioserver and not for a scan
500 if ( !$scan && $servers[ $i - 1 ] =~ /biblioserver/ ) {
501 $facets_counter = GetFacets( $results[ $i - 1 ] );
502 $facets_info = _get_facets_info( $facets );
503 }
504
505 # BUILD FACETS
506 if ( $servers[ $i - 1 ] =~ /biblioserver/ ) {
507 for my $link_value (
508 sort { $facets_counter->{$b} <=> $facets_counter->{$a} }
509 keys %$facets_counter
510 )
511 {
512 my $expandable;
513 my $number_of_facets;
514 my @this_facets_array;
515 for my $one_facet (
516 sort {
517 $facets_counter->{$link_value}
518 ->{$b} <=> $facets_counter->{$link_value}
519 ->{$a}
520 } keys %{ $facets_counter->{$link_value} }
521 )
522 {
523 $number_of_facets++;
524 if ( ( $number_of_facets <= 5 )
525 || ( $expanded_facet eq $link_value )
526 || ( $facets_info->{$link_value}->{'expanded'} )
527 )
528 {
529
530 # Sanitize the link value : parenthesis, question and exclamation mark will cause errors with CCL
531 my $facet_link_value = $one_facet;
532 $facet_link_value =~ s/[()!?¡¿؟]/ /g;
533
534 # fix the length that will display in the label,
535 my $facet_label_value = $one_facet;
536 my $facet_max_length = C4::Context->preference(
537 'FacetLabelTruncationLength')
538 || 20;
539 $facet_label_value =
540 substr( $one_facet, 0, $facet_max_length )
541 . "..."
542 if length($facet_label_value) >
543 $facet_max_length;
544
545 # if it's a branch, label by the name, not the code,
546 if ( $link_value =~ /branch/ ) {
547 if ( defined $branches
548 && ref($branches) eq "HASH"
549 && defined $branches->{$one_facet}
550 && ref( $branches->{$one_facet} ) eq
551 "HASH" )
552 {
553 $facet_label_value =
554 $branches->{$one_facet}
555 ->{'branchname'};
556 }
557 else {
558 $facet_label_value = "*";
559 }
560 }
561
562 # if it's a itemtype, label by the name, not the code,
563 if ( $link_value =~ /itype/ ) {
564 if ( defined $itemtypes
565 && ref($itemtypes) eq "HASH"
566 && defined $itemtypes->{$one_facet}
567 && ref( $itemtypes->{$one_facet} ) eq
568 "HASH" )
569 {
570 $facet_label_value =
571 $itemtypes->{$one_facet}
572 ->{translated_description};
573 }
574 }
575
576 # also, if it's a location code, use the name instead of the code
577 if ( $link_value =~ /location/ ) {
578 $facet_label_value =
579 GetKohaAuthorisedValueLib( 'LOC',
580 $one_facet, $opac );
581 }
582
583 # but we're down with the whole label being in the link's title.
584 push @this_facets_array,
585 {
586 facet_count =>
587 $facets_counter->{$link_value}
588 ->{$one_facet},
589 facet_label_value => $facet_label_value,
590 facet_title_value => $one_facet,
591 facet_link_value => $facet_link_value,
592 type_link_value => $link_value,
593 }
594 if ($facet_label_value);
595 }
596 }
597
598 # handle expanded option
599 unless ( $facets_info->{$link_value}->{'expanded'} ) {
600 $expandable = 1
601 if ( ( $number_of_facets > 5 )
602 && ( $expanded_facet ne $link_value ) );
603 }
604 push @facets_loop,
605 {
606 type_link_value => $link_value,
607 type_id => $link_value . "_id",
608 "type_label_"
609 . $facets_info->{$link_value}->{'label_value'} =>
610 1,
611 facets => \@this_facets_array,
612 expandable => $expandable,
613 expand => $link_value,
614 }
615 unless (
616 (
617 $facets_info->{$link_value}->{'label_value'} =~
618 /Libraries/
619 )
620 and ( Koha::Libraries->search->count == 1 )
621 );
622 }
623 }
624 }
625 );
626
627 # This sorts the facets into alphabetical order
628 if (@facets_loop) {
629 foreach my $f (@facets_loop) {
630 $f->{facets} = [ sort { uc($a->{facet_label_value}) cmp uc($b->{facet_label_value}) } @{ $f->{facets} } ];
631 }
632 @facets_loop = sort {$a->{expand} cmp $b->{expand}} @facets_loop;
633 }
634
635 return ( undef, $results_hashref, \@facets_loop );
636 }
637
638 sub GetFacets {
639
640 my $rs = shift;
641 my $facets;
642
643 my $indexing_mode = C4::Context->config('zebra_bib_index_mode') // 'dom';
644 my $use_zebra_facets = C4::Context->config('use_zebra_facets') // 0;
645
646 if ( $indexing_mode eq 'dom' &&
647 $use_zebra_facets ) {
648 $facets = _get_facets_from_zebra( $rs );
649 } else {
650 $facets = _get_facets_from_records( $rs );
651 }
652
653 return $facets;
654 }
655
656 sub _get_facets_from_records {
657
658 my $rs = shift;
659
660 my $facets_maxrecs = C4::Context->preference('maxRecordsForFacets') // 20;
661 my $facets_config = getFacets();
662 my $facets = {};
663 my $size = $rs->size();
664 my $jmax = $size > $facets_maxrecs
665 ? $facets_maxrecs
666 : $size;
667
668 for ( my $j = 0 ; $j < $jmax ; $j++ ) {
669
670 my $marc_record = new_record_from_zebra (
671 'biblioserver',
672 $rs->record( $j )->raw()
673 );
674
675 if ( ! defined $marc_record ) {
676 warn "ERROR DECODING RECORD - $@: " .
677 $rs->record( $j )->raw();
678 next;
679 }
680
681 _get_facets_data_from_record( $marc_record, $facets_config, $facets );
682 }
683
684 return $facets;
685 }
686
687 =head2 _get_facets_data_from_record
688
689 C4::Search::_get_facets_data_from_record( $marc_record, $facets, $facets_counter );
690
691 Internal function that extracts facets information from a MARC::Record object
692 and populates $facets_counter for using in getRecords.
693
694 $facets is expected to be filled with C4::Koha::getFacets output (i.e. the configured
695 facets for Zebra).
696
697 =cut
698
699 sub _get_facets_data_from_record {
700
701 my ( $marc_record, $facets, $facets_counter ) = @_;
702
703 for my $facet (@$facets) {
704
705 my @used_datas = ();
706
707 foreach my $tag ( @{ $facet->{ tags } } ) {
708
709 # tag number is the first three digits
710 my $tag_num = substr( $tag, 0, 3 );
711 # subfields are the remainder
712 my $subfield_letters = substr( $tag, 3 );
713
714 my @fields = $marc_record->field( $tag_num );
715 foreach my $field (@fields) {
716 # If $field->indicator(1) eq 'z', it means it is a 'see from'
717 # field introduced because of IncludeSeeFromInSearches, so skip it
718 next if $field->indicator(1) eq 'z';
719
720 my $data = $field->as_string( $subfield_letters, $facet->{ sep } );
721
722 unless ( grep { /^\Q$data\E$/ } @used_datas ) {
723 push @used_datas, $data;
724 $facets_counter->{ $facet->{ idx } }->{ $data }++;
725 }
726 }
727 }
728 }
729 }
730
731 =head2 _get_facets_from_zebra
732
733 my $facets = _get_facets_from_zebra( $result_set )
734
735 Retrieves facets for a specified result set. It loops through the facets defined
736 in C4::Koha::getFacets and returns a hash with the following structure:
737
738 { facet_idx => {
739 facet_value => count
740 },
741 ...
742 }
743
744 =cut
745
746 sub _get_facets_from_zebra {
747
748 my $rs = shift;
749
750 # save current elementSetName
751 my $elementSetName = $rs->option( 'elementSetName' );
752
753 my $facets_loop = getFacets();
754 my $facets_data = {};
755 # loop through defined facets and fill the facets hashref
756 foreach my $facet ( @$facets_loop ) {
757
758 my $idx = $facet->{ idx };
759 my $sep = $facet->{ sep };
760 my $facet_values = _get_facet_from_result_set( $idx, $rs, $sep );
761 if ( $facet_values ) {
762 # we've actually got a result
763 $facets_data->{ $idx } = $facet_values;
764 }
765 }
766 # set elementSetName to its previous value to avoid side effects
767 $rs->option( elementSetName => $elementSetName );
768
769 return $facets_data;
770 }
771
772 =head2 _get_facet_from_result_set
773
774 my $facet_values =
775 C4::Search::_get_facet_from_result_set( $facet_idx, $result_set, $sep )
776
777 Internal function that extracts facet information for a specific index ($facet_idx) and
778 returns a hash containing facet values and count:
779
780 {
781 $facet_value => $count ,
782 ...
783 }
784
785 Warning: this function has the side effect of changing the elementSetName for the result
786 set. It is a helper function for the main loop, which takes care of backing it up for
787 restoring.
788
789 =cut
790
791 sub _get_facet_from_result_set {
792
793 my $facet_idx = shift;
794 my $rs = shift;
795 my $sep = shift;
796
797 my $internal_sep = '<*>';
798 my $facetMaxCount = C4::Context->preference('FacetMaxCount') // 20;
799
800 return if ( ! defined $facet_idx || ! defined $rs );
801 # zebra's facet element, untokenized index
802 my $facet_element = 'zebra::facet::' . $facet_idx . ':0:' . $facetMaxCount;
803 # configure zebra results for retrieving the desired facet
804 $rs->option( elementSetName => $facet_element );
805 # get the facet record from result set
806 my $facet = $rs->record( 0 )->raw;
807 # if the facet has no restuls...
808 return if !defined $facet;
809 # TODO: benchmark DOM vs. SAX performance
810 my $facet_dom = XML::LibXML->load_xml(
811 string => ($facet)
812 );
813 my @terms = $facet_dom->getElementsByTagName('term');
814 return if ! @terms;
815
816 my $facets = {};
817 foreach my $term ( @terms ) {
818 my $facet_value = $term->textContent;
819 $facet_value =~ s/\Q$internal_sep\E/$sep/ if defined $sep;
820 $facets->{ $facet_value } = $term->getAttribute( 'occur' );
821 }
822
823 return $facets;
824 }
825
826 =head2 _get_facets_info
827
828 my $facets_info = C4::Search::_get_facets_info( $facets )
829
830 Internal function that extracts facets information and properly builds
831 the data structure needed to render facet labels.
832
833 =cut
834
835 sub _get_facets_info {
836
837 my $facets = shift;
838
839 my $facets_info = {};
840
841 for my $facet ( @$facets ) {
842 $facets_info->{ $facet->{ idx } }->{ label_value } = $facet->{ label };
843 $facets_info->{ $facet->{ idx } }->{ expanded } = $facet->{ expanded };
844 }
845
846 return $facets_info;
847 }
848
849 sub pazGetRecords {
850 my (
851 $koha_query, $simple_query, $sort_by_ref, $servers_ref,
852 $results_per_page, $offset, $expanded_facet, $branches,
853 $query_type, $scan
854 ) = @_;
855
856 my $paz = C4::Search::PazPar2->new(C4::Context->config('pazpar2url'));
857 $paz->init();
858 $paz->search($simple_query);
859 sleep 1; # FIXME: WHY?
860
861 # do results
862 my $results_hashref = {};
863 my $stats = XMLin($paz->stat);
864 my $results = XMLin($paz->show($offset, $results_per_page, 'work-title:1'), forcearray => 1);
865
866 # for a grouped search result, the number of hits
867 # is the number of groups returned; 'bib_hits' will have
868 # the total number of bibs.
869 $results_hashref->{'biblioserver'}->{'hits'} = $results->{'merged'}->[0];
870 $results_hashref->{'biblioserver'}->{'bib_hits'} = $stats->{'hits'};
871
872 HIT: foreach my $hit (@{ $results->{'hit'} }) {
873 my $recid = $hit->{recid}->[0];
874
875 my $work_title = $hit->{'md-work-title'}->[0];
876 my $work_author;
877 if (exists $hit->{'md-work-author'}) {
878 $work_author = $hit->{'md-work-author'}->[0];
879 }
880 my $group_label = (defined $work_author) ? "$work_title / $work_author" : $work_title;
881
882 my $result_group = {};
883 $result_group->{'group_label'} = $group_label;
884 $result_group->{'group_merge_key'} = $recid;
885
886 my $count = 1;
887 if (exists $hit->{count}) {
888 $count = $hit->{count}->[0];
889 }
890 $result_group->{'group_count'} = $count;
891
892 for (my $i = 0; $i < $count; $i++) {
893 # FIXME -- may need to worry about diacritics here
894 my $rec = $paz->record($recid, $i);
895 push @{ $result_group->{'RECORDS'} }, $rec;
896 }
897
898 push @{ $results_hashref->{'biblioserver'}->{'GROUPS'} }, $result_group;
899 }
900
901 # pass through facets
902 my $termlist_xml = $paz->termlist('author,subject');
903 my $terms = XMLin($termlist_xml, forcearray => 1);
904 my @facets_loop = ();
905 #die Dumper($results);
906 # foreach my $list (sort keys %{ $terms->{'list'} }) {
907 # my @facets = ();
908 # foreach my $facet (sort @{ $terms->{'list'}->{$list}->{'term'} } ) {
909 # push @facets, {
910 # facet_label_value => $facet->{'name'}->[0],
911 # };
912 # }
913 # push @facets_loop, ( {
914 # type_label => $list,
915 # facets => \@facets,
916 # } );
917 # }
918
919 return ( undef, $results_hashref, \@facets_loop );
920 }
921
922 # TRUNCATION
923 sub _detect_truncation {
924 my ( $operand, $index ) = @_;
925 my ( @nontruncated, @righttruncated, @lefttruncated, @rightlefttruncated,
926 @regexpr );
927 $operand =~ s/^ //g;
928 my @wordlist = split( /\s/, $operand );
929 foreach my $word (@wordlist) {
930 if ( $word =~ s/^\*([^\*]+)\*$/$1/ ) {
931 push @rightlefttruncated, $word;
932 }
933 elsif ( $word =~ s/^\*([^\*]+)$/$1/ ) {
934 push @lefttruncated, $word;
935 }
936 elsif ( $word =~ s/^([^\*]+)\*$/$1/ ) {
937 push @righttruncated, $word;
938 }
939 elsif ( index( $word, "*" ) < 0 ) {
940 push @nontruncated, $word;
941 }
942 else {
943 push @regexpr, $word;
944 }
945 }
946 return (
947 \@nontruncated, \@righttruncated, \@lefttruncated,
948 \@rightlefttruncated, \@regexpr
949 );
950 }
951
952 # STEMMING
953 sub _build_stemmed_operand {
954 my ($operand,$lang) = @_;
955 require Lingua::Stem::Snowball ;
956 my $stemmed_operand=q{};
957
958 # If operand contains a digit, it is almost certainly an identifier, and should
959 # not be stemmed. This is particularly relevant for ISBNs and ISSNs, which
960 # can contain the letter "X" - for example, _build_stemmend_operand would reduce
961 # "014100018X" to "x ", which for a MARC21 database would bring up irrelevant
962 # results (e.g., "23 x 29 cm." from the 300$c). Bug 2098.
963 return $operand if $operand =~ /\d/;
964
965 # FIXME: the locale should be set based on the user's language and/or search choice
966 #warn "$lang";
967 # Make sure we only use the first two letters from the language code
968 $lang = lc(substr($lang, 0, 2));
969 # The language codes for the two variants of Norwegian will now be "nb" and "nn",
970 # none of which Lingua::Stem::Snowball can use, so we need to "translate" them
971 if ($lang eq 'nb' || $lang eq 'nn') {
972 $lang = 'no';
973 }
974 my $stemmer = Lingua::Stem::Snowball->new( lang => $lang,
975 encoding => "UTF-8" );
976
977 my @words = split( / /, $operand );
978 my @stems = $stemmer->stem(\@words);
979 for my $stem (@stems) {
980 $stemmed_operand .= "$stem";
981 $stemmed_operand .= "?"
982 unless ( $stem =~ /(and$|or$|not$)/ ) || ( length($stem) < 3 );
983 $stemmed_operand .= " ";
984 }
985 warn "STEMMED OPERAND: $stemmed_operand" if $DEBUG;
986 return $stemmed_operand;
987 }
988
989 # FIELD WEIGHTING
990 sub _build_weighted_query {
991
992 # FIELD WEIGHTING - This is largely experimental stuff. What I'm committing works
993 # pretty well but could work much better if we had a smarter query parser
994 my ( $operand, $stemmed_operand, $index ) = @_;
995 my $stemming = C4::Context->preference("QueryStemming") || 0;
996 my $weight_fields = C4::Context->preference("QueryWeightFields") || 0;
997 my $fuzzy_enabled = C4::Context->preference("QueryFuzzy") || 0;
998 $operand =~ s/"/ /g; # Bug 7518: searches with quotation marks don't work
999
1000 my $weighted_query .= "(rk=("; # Specifies that we're applying rank
1001
1002 # Keyword, or, no index specified
1003 if ( ( $index eq 'kw' ) || ( !$index ) ) {
1004 $weighted_query .=
1005 "Title-cover,ext,r1=\"$operand\""; # exact title-cover
1006 $weighted_query .= " or ti,ext,r2=\"$operand\""; # exact title
1007 $weighted_query .= " or Title-cover,phr,r3=\"$operand\""; # phrase title
1008 $weighted_query .= " or ti,wrdl,r4=\"$operand\""; # words in title
1009 #$weighted_query .= " or any,ext,r4=$operand"; # exact any
1010 #$weighted_query .=" or kw,wrdl,r5=\"$operand\""; # word list any
1011 $weighted_query .= " or wrdl,fuzzy,r8=\"$operand\""
1012 if $fuzzy_enabled; # add fuzzy, word list
1013 $weighted_query .= " or wrdl,right-Truncation,r9=\"$stemmed_operand\""
1014 if ( $stemming and $stemmed_operand )
1015 ; # add stemming, right truncation
1016 $weighted_query .= " or wrdl,r9=\"$operand\"";
1017
1018 # embedded sorting: 0 a-z; 1 z-a
1019 # $weighted_query .= ") or (sort1,aut=1";
1020 }
1021
1022 # Barcode searches should skip this process
1023 elsif ( $index eq 'bc' ) {
1024 $weighted_query .= "bc=\"$operand\"";
1025 }
1026
1027 # Authority-number searches should skip this process
1028 elsif ( $index eq 'an' ) {
1029 $weighted_query .= "an=\"$operand\"";
1030 }
1031
1032 # If the index is numeric, don't autoquote it.
1033 elsif ( $index =~ /,st-numeric$/ ) {
1034 $weighted_query .= " $index=$operand";
1035 }
1036
1037 # If the index already has more than one qualifier, wrap the operand
1038 # in quotes and pass it back (assumption is that the user knows what they
1039 # are doing and won't appreciate us mucking up their query
1040 elsif ( $index =~ ',' ) {
1041 $weighted_query .= " $index=\"$operand\"";
1042 }
1043
1044 #TODO: build better cases based on specific search indexes
1045 else {
1046 $weighted_query .= " $index,ext,r1=\"$operand\""; # exact index
1047 #$weighted_query .= " or (title-sort-az=0 or $index,startswithnt,st-word,r3=$operand #)";
1048 $weighted_query .= " or $index,phr,r3=\"$operand\""; # phrase index
1049 $weighted_query .= " or $index,wrdl,r6=\"$operand\""; # word list index
1050 $weighted_query .= " or $index,wrdl,fuzzy,r8=\"$operand\""
1051 if $fuzzy_enabled; # add fuzzy, word list
1052 $weighted_query .= " or $index,wrdl,rt,r9=\"$stemmed_operand\""
1053 if ( $stemming and $stemmed_operand ); # add stemming, right truncation
1054 }
1055
1056 $weighted_query .= "))"; # close rank specification
1057 return $weighted_query;
1058 }
1059
1060 =head2 getIndexes
1061
1062 Return an array with available indexes.
1063
1064 =cut
1065
1066 sub getIndexes{
1067 my @indexes = (
1068 # biblio indexes
1069 'ab',
1070 'Abstract',
1071 'acqdate',
1072 'allrecords',
1073 'an',
1074 'Any',
1075 'at',
1076 'au',
1077 'aub',
1078 'aud',
1079 'audience',
1080 'auo',
1081 'aut',
1082 'Author',
1083 'Author-in-order ',
1084 'Author-personal-bibliography',
1085 'Authority-Number',
1086 'authtype',
1087 'bc',
1088 'Bib-level',
1089 'biblionumber',
1090 'bio',
1091 'biography',
1092 'callnum',
1093 'cfn',
1094 'Chronological-subdivision',
1095 'cn-bib-source',
1096 'cn-bib-sort',
1097 'cn-class',
1098 'cn-item',
1099 'cn-prefix',
1100 'cn-suffix',
1101 'cpn',
1102 'Code-institution',
1103 'Conference-name',
1104 'Conference-name-heading',
1105 'Conference-name-see',
1106 'Conference-name-seealso',
1107 'Content-type',
1108 'Control-number',
1109 'copydate',
1110 'Corporate-name',
1111 'Corporate-name-heading',
1112 'Corporate-name-see',
1113 'Corporate-name-seealso',
1114 'Country-publication',
1115 'ctype',
1116 'curriculum',
1117 'date-entered-on-file',
1118 'Date-of-acquisition',
1119 'Date-of-publication',
1120 'Date-time-last-modified',
1121 'Dewey-classification',
1122 'Dissertation-information',
1123 'diss',
1124 'dtlm',
1125 'EAN',
1126 'extent',
1127 'fic',
1128 'fiction',
1129 'Form-subdivision',
1130 'format',
1131 'Geographic-subdivision',
1132 'he',
1133 'Heading',
1134 'Heading-use-main-or-added-entry',
1135 'Heading-use-series-added-entry ',
1136 'Heading-use-subject-added-entry',
1137 'Host-item',
1138 'id-other',
1139 'Illustration-code',
1140 'Index-term-genre',
1141 'Index-term-uncontrolled',
1142 'Interest-age-level',
1143 'Interest-grade-level',
1144 'ISBN',
1145 'isbn',
1146 'ISSN',
1147 'issn',
1148 'itemtype',
1149 'kw',
1150 'Koha-Auth-Number',
1151 'l-format',
1152 'language',
1153 'language-original',
1154 'lc-card',
1155 'LC-card-number',
1156 'lcn',
1157 'lex',
1158 'lexile-number',
1159 'llength',
1160 'ln',
1161 'ln-audio',
1162 'ln-subtitle',
1163 'Local-classification',
1164 'Local-number',
1165 'Match-heading',
1166 'Match-heading-see-from',
1167 'Material-type',
1168 'mc-itemtype',
1169 'mc-rtype',
1170 'mus',
1171 'name',
1172 'Music-number',
1173 'Name-geographic',
1174 'Name-geographic-heading',
1175 'Name-geographic-see',
1176 'Name-geographic-seealso',
1177 'nb',
1178 'Note',
1179 'notes',
1180 'ns',
1181 'nt',
1182 'pb',
1183 'Personal-name',
1184 'Personal-name-heading',
1185 'Personal-name-see',
1186 'Personal-name-seealso',
1187 'pl',
1188 'Place-publication',
1189 'pn',
1190 'popularity',
1191 'pubdate',
1192 'Publisher',
1193 'Provider',
1194 'pv',
1195 'Reading-grade-level',
1196 'Record-control-number',
1197 'rcn',
1198 'Record-type',
1199 'rtype',
1200 'se',
1201 'See',
1202 'See-also',
1203 'sn',
1204 'Stock-number',
1205 'su',
1206 'Subject',
1207 'Subject-heading-thesaurus',
1208 'Subject-name-personal',
1209 'Subject-subdivision',
1210 'Summary',
1211 'Suppress',
1212 'su-geo',
1213 'su-na',
1214 'su-to',
1215 'su-ut',
1216 'ut',
1217 'Term-genre-form',
1218 'Term-genre-form-heading',
1219 'Term-genre-form-see',
1220 'Term-genre-form-seealso',
1221 'ti',
1222 'Title',
1223 'Title-cover',
1224 'Title-series',
1225 'Title-uniform',
1226 'Title-uniform-heading',
1227 'Title-uniform-see',
1228 'Title-uniform-seealso',
1229 'totalissues',
1230 'yr',
1231
1232 # items indexes
1233 'acqsource',
1234 'barcode',
1235 'bc',
1236 'branch',
1237 'ccode',
1238 'classification-source',
1239 'cn-sort',
1240 'coded-location-qualifier',
1241 'copynumber',
1242 'damaged',
1243 'datelastborrowed',
1244 'datelastseen',
1245 'holdingbranch',
1246 'homebranch',
1247 'issues',
1248 'item',
1249 'itemnumber',
1250 'itype',
1251 'Local-classification',
1252 'location',
1253 'lost',
1254 'materials-specified',
1255 'mc-ccode',
1256 'mc-itype',
1257 'mc-loc',
1258 'notforloan',
1259 'Number-local-acquisition',
1260 'onloan',
1261 'price',
1262 'renewals',
1263 'replacementprice',
1264 'replacementpricedate',
1265 'reserves',
1266 'restricted',
1267 'stack',
1268 'stocknumber',
1269 'inv',
1270 'uri',
1271 'withdrawn',
1272
1273 # subject related
1274 );
1275
1276 return \@indexes;
1277 }
1278
1279 =head2 _handle_exploding_index
1280
1281 my $query = _handle_exploding_index($index, $term)
1282
1283 Callback routine to generate the search for "exploding" indexes (i.e.
1284 those indexes which are turned into multiple or-connected searches based
1285 on authority data).
1286
1287 =cut
1288
1289 sub _handle_exploding_index {
1290 my ($QParser, $filter, $params, $negate, $server) = @_;
1291 my $index = $filter;
1292 my $term = join(' ', @$params);
1293
1294 return unless ($index =~ m/(su-br|su-na|su-rl)/ && $term);
1295
1296 my $marcflavour = C4::Context->preference('marcflavour');
1297
1298 my $codesubfield = $marcflavour eq 'UNIMARC' ? '5' : 'w';
1299 my $wantedcodes = '';
1300 my @subqueries = ( "\@attr 1=Subject \@attr 4=1 \"$term\"");
1301 my ($error, $results, $total_hits) = SimpleSearch( "he:$term", undef, undef, [ "authorityserver" ] );
1302 foreach my $auth (@$results) {
1303 my $record = MARC::Record->new_from_usmarc($auth);
1304 my @references = $record->field('5..');
1305 if (@references) {
1306 if ($index eq 'su-br') {
1307 $wantedcodes = 'g';
1308 } elsif ($index eq 'su-na') {
1309 $wantedcodes = 'h';
1310 } elsif ($index eq 'su-rl') {
1311 $wantedcodes = '';
1312 }
1313 foreach my $reference (@references) {
1314 my $codes = $reference->subfield($codesubfield);
1315 push @subqueries, '@attr 1=Subject @attr 4=1 "' . $reference->as_string('abcdefghijlmnopqrstuvxyz') . '"' if (($codes && $codes eq $wantedcodes) || !$wantedcodes);
1316 }
1317 }
1318 }
1319 my $query = ' @or ' x (scalar(@subqueries) - 1) . join(' ', @subqueries);
1320 return $query;
1321 }
1322
1323 =head2 parseQuery
1324
1325 ( $operators, $operands, $indexes, $limits,
1326 $sort_by, $scan, $lang ) =
1327 buildQuery ( $operators, $operands, $indexes, $limits, $sort_by, $scan, $lang);
1328
1329 Shim function to ease the transition from buildQuery to a new QueryParser.
1330 This function is called at the beginning of buildQuery, and modifies
1331 buildQuery's input. If it can handle the input, it returns a query that
1332 buildQuery will not try to parse.
1333
1334 =cut
1335
1336 sub parseQuery {
1337 my ( $operators, $operands, $indexes, $limits, $sort_by, $scan, $lang) = @_;
1338
1339 my @operators = $operators ? @$operators : ();
1340 my @indexes = $indexes ? @$indexes : ();
1341 my @operands = $operands ? @$operands : ();
1342 my @limits = $limits ? @$limits : ();
1343 my @sort_by = $sort_by ? @$sort_by : ();
1344
1345 my $query = $operands[0];
1346 my $index;
1347 my $term;
1348 my $query_desc;
1349
1350 my $QParser;
1351 $QParser = C4::Context->queryparser if (C4::Context->preference('UseQueryParser') || $query =~ s/^qp=//);
1352 undef $QParser if ($query =~ m/^(ccl=|pqf=|cql=)/ || grep (/\w,\w|\w=\w/, @operands, @indexes) );
1353 undef $QParser if (scalar @limits > 0);
1354
1355 if ($QParser)
1356 {
1357 $QParser->custom_data->{'QueryAutoTruncate'} = C4::Context->preference('QueryAutoTruncate');
1358 $query = '';
1359 for ( my $ii = 0 ; $ii <= @operands ; $ii++ ) {
1360 next unless $operands[$ii];
1361 $query .= $operators[ $ii - 1 ] eq 'or' ? ' || ' : ' && '
1362 if ($query);
1363 if ( $operands[$ii] =~ /^[^"]\W*[-|_\w]*:\w.*[^"]$/ ) {
1364 $query .= $operands[$ii];
1365 }
1366 elsif ( $indexes[$ii] =~ m/su-/ ) {
1367 $query .= $indexes[$ii] . '(' . $operands[$ii] . ')';
1368 }
1369 else {
1370 $query .=
1371 ( $indexes[$ii] ? "$indexes[$ii]:" : '' ) . $operands[$ii];
1372 }
1373 }
1374 foreach my $limit (@limits) {
1375 }
1376 if ( scalar(@sort_by) > 0 ) {
1377 my $modifier_re =
1378 '#(' . join( '|', @{ $QParser->modifiers } ) . ')';
1379 $query =~ s/$modifier_re//g;
1380 foreach my $modifier (@sort_by) {
1381 $query .= " #$modifier";
1382 }
1383 }
1384
1385 $query_desc = $query;
1386 $query_desc =~ s/\s+/ /g;
1387 if ( C4::Context->preference("QueryWeightFields") ) {
1388 }
1389 $QParser->add_bib1_filter_map( 'su-br' => 'biblioserver' =>
1390 { 'target_syntax_callback' => \&_handle_exploding_index } );
1391 $QParser->add_bib1_filter_map( 'su-na' => 'biblioserver' =>
1392 { 'target_syntax_callback' => \&_handle_exploding_index } );
1393 $QParser->add_bib1_filter_map( 'su-rl' => 'biblioserver' =>
1394 { 'target_syntax_callback' => \&_handle_exploding_index } );
1395 $QParser->parse($query);
1396 $operands[0] = "pqf=" . $QParser->target_syntax('biblioserver');
1397 }
1398 else {
1399 require Koha::QueryParser::Driver::PQF;
1400 my $modifier_re = '#(' . join( '|', @{Koha::QueryParser::Driver::PQF->modifiers}) . ')';
1401 s/$modifier_re//g for @operands;
1402 }
1403
1404 return ( $operators, \@operands, $indexes, $limits, $sort_by, $scan, $lang, $query_desc);
1405 }
1406
1407 =head2 buildQuery
1408
1409 ( $error, $query,
1410 $simple_query, $query_cgi,
1411 $query_desc, $limit,
1412 $limit_cgi, $limit_desc,
1413 $query_type ) = buildQuery ( $operators, $operands, $indexes, $limits, $sort_by, $scan, $lang);
1414
1415 Build queries and limits in CCL, CGI, Human,
1416 handle truncation, stemming, field weighting, fuzziness, etc.
1417
1418 See verbose embedded documentation.
1419
1420
1421 =cut
1422
1423 sub buildQuery {
1424 my ( $operators, $operands, $indexes, $limits, $sort_by, $scan, $lang) = @_;
1425
1426 warn "---------\nEnter buildQuery\n---------" if $DEBUG;
1427
1428 my $query_desc;
1429 ( $operators, $operands, $indexes, $limits, $sort_by, $scan, $lang, $query_desc) = parseQuery($operators, $operands, $indexes, $limits, $sort_by, $scan, $lang);
1430
1431 # dereference
1432 my @operators = $operators ? @$operators : ();
1433 my @indexes = $indexes ? @$indexes : ();
1434 my @operands = $operands ? @$operands : ();
1435 my @limits = $limits ? @$limits : ();
1436 my @sort_by = $sort_by ? @$sort_by : ();
1437
1438 my $stemming = C4::Context->preference("QueryStemming") || 0;
1439 my $auto_truncation = C4::Context->preference("QueryAutoTruncate") || 0;
1440 my $weight_fields = C4::Context->preference("QueryWeightFields") || 0;
1441 my $fuzzy_enabled = C4::Context->preference("QueryFuzzy") || 0;
1442
1443 my $query = $operands[0];
1444 my $simple_query = $operands[0];
1445
1446 # initialize the variables we're passing back
1447 my $query_cgi;
1448 my $query_type;
1449
1450 my $limit;
1451 my $limit_cgi;
1452 my $limit_desc;
1453
1454 my $cclq = 0;
1455 my $cclindexes = getIndexes();
1456 if ( $query !~ /\s*(ccl=|pqf=|cql=)/ ) {
1457 while ( !$cclq && $query =~ /(?:^|\W)([\w-]+)(,[\w-]+)*[:=]/g ) {
1458 my $dx = lc($1);
1459 $cclq = grep { lc($_) eq $dx } @$cclindexes;
1460 }
1461 $query = "ccl=$query" if $cclq;
1462 }
1463
1464 # for handling ccl, cql, pqf queries in diagnostic mode, skip the rest of the steps
1465 # DIAGNOSTIC ONLY!!
1466 if ( $query =~ /^ccl=/ ) {
1467 my $q=$';
1468 # This is needed otherwise ccl= and &limit won't work together, and
1469 # this happens when selecting a subject on the opac-detail page
1470 @limits = grep {!/^$/} @limits;
1471 if ( @limits ) {
1472 $q .= ' and '.join(' and ', @limits);
1473 }
1474 return ( undef, $q, $q, "q=ccl=".uri_escape_utf8($q), $q, '', '', '', 'ccl' );
1475 }
1476 if ( $query =~ /^cql=/ ) {
1477 return ( undef, $', $', "q=cql=".uri_escape_utf8($'), $', '', '', '', 'cql' );
1478 }
1479 if ( $query =~ /^pqf=/ ) {
1480 if ($query_desc) {
1481 $query_cgi = "q=".uri_escape_utf8($query_desc);
1482 } else {
1483 $query_desc = $';
1484 $query_cgi = "q=pqf=".uri_escape_utf8($');
1485 }
1486 return ( undef, $', $', $query_cgi, $query_desc, '', '', '', 'pqf' );
1487 }
1488
1489 # pass nested queries directly
1490 # FIXME: need better handling of some of these variables in this case
1491 # Nested queries aren't handled well and this implementation is flawed and causes users to be
1492 # unable to search for anything containing () commenting out, will be rewritten for 3.4.0
1493 # if ( $query =~ /(\(|\))/ ) {
1494 # return (
1495 # undef, $query, $simple_query, $query_cgi,
1496 # $query, $limit, $limit_cgi, $limit_desc,
1497 # 'ccl'
1498 # );
1499 # }
1500
1501 # Form-based queries are non-nested and fixed depth, so we can easily modify the incoming
1502 # query operands and indexes and add stemming, truncation, field weighting, etc.
1503 # Once we do so, we'll end up with a value in $query, just like if we had an
1504 # incoming $query from the user
1505 else {
1506 $query = ""
1507 ; # clear it out so we can populate properly with field-weighted, stemmed, etc. query
1508 my $previous_operand
1509 ; # a flag used to keep track if there was a previous query
1510 # if there was, we can apply the current operator
1511 # for every operand
1512 for ( my $i = 0 ; $i <= @operands ; $i++ ) {
1513
1514 # COMBINE OPERANDS, INDEXES AND OPERATORS
1515 if ( $operands[$i] ) {
1516 $operands[$i]=~s/^\s+//;
1517
1518 # A flag to determine whether or not to add the index to the query
1519 my $indexes_set;
1520
1521 # If the user is sophisticated enough to specify an index, turn off field weighting, and stemming handling
1522 if ( $operands[$i] =~ /\w(:|=)/ || $scan ) {
1523 $weight_fields = 0;
1524 $stemming = 0;
1525 } else {
1526 $operands[$i] =~ s/\?/{?}/g; # need to escape question marks
1527 }
1528 my $operand = $operands[$i];
1529 my $index = $indexes[$i];
1530
1531 # Add index-specific attributes
1532
1533 #Afaik, this 'yr' condition will only ever be met in the staff client advanced search
1534 #for "Publication date", since typing 'yr:YYYY' into the search box produces a CCL query,
1535 #which is processed higher up in this sub. Other than that, year searches are typically
1536 #handled as limits which are not processed her either.
1537
1538 # Search ranges: Date of Publication, st-numeric
1539 if ( $index =~ /(yr|st-numeric)/ ) {
1540 #weight_fields/relevance search causes errors with date ranges
1541 #In the case of YYYY-, it will only return records with a 'yr' of YYYY (not the range)
1542 #In the case of YYYY-YYYY, it will return no results
1543 $stemming = $auto_truncation = $weight_fields = $fuzzy_enabled = 0;
1544 }
1545
1546 # Date of Acquisition
1547 elsif ( $index =~ /acqdate/ ) {
1548 #stemming and auto_truncation would have zero impact since it already is YYYY-MM-DD format
1549 #Weight_fields probably SHOULD be turned OFF, otherwise you'll get records floating to the
1550 #top of the results just because they have lots of item records matching that date.
1551 #Fuzzy actually only applies during _build_weighted_query, and is reset there anyway, so
1552 #irrelevant here
1553 $stemming = $auto_truncation = $weight_fields = $fuzzy_enabled = 0;
1554 }
1555 # ISBN,ISSN,Standard Number, don't need special treatment
1556 elsif ( $index eq 'nb' || $index eq 'ns' ) {
1557 (
1558 $stemming, $auto_truncation,
1559 $weight_fields, $fuzzy_enabled
1560 ) = ( 0, 0, 0, 0 );
1561
1562 if ( $index eq 'nb' ) {
1563 if ( C4::Context->preference("SearchWithISBNVariations") ) {
1564 my @isbns = C4::Koha::GetVariationsOfISBN( $operand );
1565 $operands[$i] = $operand = '(nb=' . join(' OR nb=', @isbns) . ')';
1566 $indexes[$i] = $index = '';
1567 }
1568 }
1569 }
1570
1571 if(not $index){
1572 $index = 'kw';
1573 }
1574
1575 # Set default structure attribute (word list)
1576 my $struct_attr = q{};
1577 unless ( $indexes_set || !$index || $index =~ /,(st-|phr|ext|wrdl)/ || $index =~ /^(nb|ns)$/ ) {
1578 $struct_attr = ",wrdl";
1579 }
1580
1581 # Some helpful index variants
1582 my $index_plus = $index . $struct_attr . ':';
1583 my $index_plus_comma = $index . $struct_attr . ',';
1584
1585 if ($auto_truncation){
1586 unless ( $index =~ /,(st-|phr|ext)/ ) {
1587 #FIXME only valid with LTR scripts
1588 $operand=join(" ",map{
1589 (index($_,"*")>0?"$_":"$_*")
1590 }split (/\s+/,$operand));
1591 warn $operand if $DEBUG;
1592 }
1593 }
1594
1595 # Detect Truncation
1596 my $truncated_operand;
1597 my( $nontruncated, $righttruncated, $lefttruncated,
1598 $rightlefttruncated, $regexpr
1599 ) = _detect_truncation( $operand, $index );
1600 warn
1601 "TRUNCATION: NON:>@$nontruncated< RIGHT:>@$righttruncated< LEFT:>@$lefttruncated< RIGHTLEFT:>@$rightlefttruncated< REGEX:>@$regexpr<"
1602 if $DEBUG;
1603
1604 # Apply Truncation
1605 if (
1606 scalar(@$righttruncated) + scalar(@$lefttruncated) +
1607 scalar(@$rightlefttruncated) > 0 )
1608 {
1609
1610 # Don't field weight or add the index to the query, we do it here
1611 $indexes_set = 1;
1612 undef $weight_fields;
1613 my $previous_truncation_operand;
1614 if (scalar @$nontruncated) {
1615 $truncated_operand .= "$index_plus @$nontruncated ";
1616 $previous_truncation_operand = 1;
1617 }
1618 if (scalar @$righttruncated) {
1619 $truncated_operand .= "and " if $previous_truncation_operand;
1620 $truncated_operand .= $index_plus_comma . "rtrn:@$righttruncated ";
1621 $previous_truncation_operand = 1;
1622 }
1623 if (scalar @$lefttruncated) {
1624 $truncated_operand .= "and " if $previous_truncation_operand;
1625 $truncated_operand .= $index_plus_comma . "ltrn:@$lefttruncated ";
1626 $previous_truncation_operand = 1;
1627 }
1628 if (scalar @$rightlefttruncated) {
1629 $truncated_operand .= "and " if $previous_truncation_operand;
1630 $truncated_operand .= $index_plus_comma . "rltrn:@$rightlefttruncated ";
1631 $previous_truncation_operand = 1;
1632 }
1633 }
1634 $operand = $truncated_operand if $truncated_operand;
1635 warn "TRUNCATED OPERAND: >$truncated_operand<" if $DEBUG;
1636
1637 # Handle Stemming
1638 my $stemmed_operand;
1639 $stemmed_operand = _build_stemmed_operand($operand, $lang)
1640 if $stemming;
1641
1642 warn "STEMMED OPERAND: >$stemmed_operand<" if $DEBUG;
1643
1644 # Handle Field Weighting
1645 my $weighted_operand;
1646 if ($weight_fields) {
1647 $weighted_operand = _build_weighted_query( $operand, $stemmed_operand, $index );
1648 $operand = $weighted_operand;
1649 $indexes_set = 1;
1650 }
1651
1652 warn "FIELD WEIGHTED OPERAND: >$weighted_operand<" if $DEBUG;
1653
1654 ($query,$query_cgi,$query_desc,$previous_operand) = _build_initial_query({
1655 query => $query,
1656 query_cgi => $query_cgi,
1657 query_desc => $query_desc,
1658 operator => ($operators[ $i - 1 ]) ? $operators[ $i - 1 ] : '',
1659 parsed_operand => $operand,
1660 original_operand => ($operands[$i]) ? $operands[$i] : '',
1661 index => $index,
1662 index_plus => $index_plus,
1663 indexes_set => $indexes_set,
1664 previous_operand => $previous_operand,
1665 });
1666
1667 } #/if $operands
1668 } # /for
1669 }
1670 warn "QUERY BEFORE LIMITS: >$query<" if $DEBUG;
1671
1672 # add limits
1673 my %group_OR_limits;
1674 my $availability_limit;
1675 foreach my $this_limit (@limits) {
1676 next unless $this_limit;
1677 if ( $this_limit =~ /available/ ) {
1678 #
1679 ## 'available' is defined as (items.onloan is NULL) and (items.itemlost = 0)
1680 ## In English:
1681 ## all records not indexed in the onloan register (zebra) and all records with a value of lost equal to 0
1682 $availability_limit .=
1683 "( ( allrecords,AlwaysMatches='' not onloan,AlwaysMatches='') and (lost,st-numeric=0) )"; #or ( allrecords,AlwaysMatches='' not lost,AlwaysMatches='')) )";
1684 $limit_cgi .= "&limit=available";
1685 $limit_desc .= "";
1686 }
1687
1688 # group_OR_limits, prefixed by mc-
1689 # OR every member of the group
1690 elsif ( $this_limit =~ /mc/ ) {
1691 my ($k,$v) = split(/:/, $this_limit,2);
1692 if ( $k !~ /mc-i(tem)?type/ ) {
1693 # in case the mc-ccode value has complicating chars like ()'s inside it we wrap in quotes
1694 $this_limit =~ tr/"//d;
1695 $this_limit = $k.":'".$v."'";
1696 }
1697
1698 $group_OR_limits{$k} .= " or " if $group_OR_limits{$k};
1699 $limit_desc .= " or " if $group_OR_limits{$k};
1700 $group_OR_limits{$k} .= "$this_limit";
1701 $limit_cgi .= "&limit=" . uri_escape_utf8($this_limit);
1702 $limit_desc .= " $this_limit";
1703 }
1704
1705 # Regular old limits
1706 else {
1707 $limit .= " and " if $limit || $query;
1708 $limit .= "$this_limit";
1709 $limit_cgi .= "&limit=" . uri_escape_utf8($this_limit);
1710 if ($this_limit =~ /^branch:(.+)/) {
1711 my $branchcode = $1;
1712 my $branchname = GetBranchName($branchcode);
1713 if (defined $branchname) {
1714 $limit_desc .= " branch:$branchname";
1715 } else {
1716 $limit_desc .= " $this_limit";
1717 }
1718 } else {
1719 $limit_desc .= " $this_limit";
1720 }
1721 }
1722 }
1723 foreach my $k (keys (%group_OR_limits)) {
1724 $limit .= " and " if ( $query || $limit );
1725 $limit .= "($group_OR_limits{$k})";
1726 }
1727 if ($availability_limit) {
1728 $limit .= " and " if ( $query || $limit );
1729 $limit .= "($availability_limit)";
1730 }
1731
1732 # Normalize the query and limit strings
1733 # This is flawed , means we can't search anything with : in it
1734 # if user wants to do ccl or cql, start the query with that
1735 # $query =~ s/:/=/g;
1736 #NOTE: We use several several different regexps here as you can't have variable length lookback assertions
1737 $query =~ s/(?<=(ti|au|pb|su|an|kw|mc|nb|ns)):/=/g;
1738 $query =~ s/(?<=(wrdl)):/=/g;
1739 $query =~ s/(?<=(trn|phr)):/=/g;
1740 $query =~ s/(?<=(st-numeric)):/=/g;
1741 $query =~ s/(?<=(st-year)):/=/g;
1742 $query =~ s/(?<=(st-date-normalized)):/=/g;
1743 $limit =~ s/:/=/g;
1744 for ( $query, $query_desc, $limit, $limit_desc ) {
1745 s/ +/ /g; # remove extra spaces
1746 s/^ //g; # remove any beginning spaces
1747 s/ $//g; # remove any ending spaces
1748 s/==/=/g; # remove double == from query
1749 }
1750 $query_cgi =~ s/^&//; # remove unnecessary & from beginning of the query cgi
1751
1752 for ($query_cgi,$simple_query) {
1753 s/"//g;
1754 }
1755 # append the limit to the query
1756 $query .= " " . $limit;
1757
1758 # Warnings if DEBUG
1759 if ($DEBUG) {
1760 warn "QUERY:" . $query;
1761 warn "QUERY CGI:" . $query_cgi;
1762 warn "QUERY DESC:" . $query_desc;
1763 warn "LIMIT:" . $limit;
1764 warn "LIMIT CGI:" . $limit_cgi;
1765 warn "LIMIT DESC:" . $limit_desc;
1766 warn "---------\nLeave buildQuery\n---------";
1767 }
1768
1769 return (
1770 undef, $query, $simple_query, $query_cgi,
1771 $query_desc, $limit, $limit_cgi, $limit_desc,
1772 $query_type
1773 );
1774 }
1775
1776 =head2 _build_initial_query
1777
1778 ($query, $query_cgi, $query_desc, $previous_operand) = _build_initial_query($initial_query_params);
1779
1780 Build a section of the initial query containing indexes, operators, and operands.
1781
1782 =cut
1783
1784 sub _build_initial_query {
1785 my ($params) = @_;
1786
1787 my $operator = "";
1788 if ($params->{previous_operand}){
1789 #If there is a previous operand, add a supplied operator or the default 'and'
1790 $operator = ($params->{operator}) ? " ".($params->{operator})." " : ' and ';
1791 }
1792
1793 #NOTE: indexes_set is typically set when doing truncation or field weighting
1794 my $operand = ($params->{indexes_set}) ? $params->{parsed_operand} : $params->{index_plus}.$params->{parsed_operand};
1795
1796 #e.g. "kw,wrdl:test"
1797 #e.g. " and kw,wrdl:test"
1798 $params->{query} .= $operator . $operand;
1799
1800 $params->{query_cgi} .= "&op=".uri_escape_utf8($operator) if $operator;
1801 $params->{query_cgi} .= "&idx=".uri_escape_utf8($params->{index}) if $params->{index};
1802 $params->{query_cgi} .= "&q=".uri_escape_utf8($params->{original_operand}) if $params->{original_operand};
1803
1804 #e.g. " and kw,wrdl: test"
1805 $params->{query_desc} .= $operator . $params->{index_plus} . " " . $params->{original_operand};
1806
1807 $params->{previous_operand} = 1 unless $params->{previous_operand}; #If there is no previous operand, mark this as one
1808
1809 return ($params->{query}, $params->{query_cgi}, $params->{query_desc}, $params->{previous_operand});
1810 }
1811
1812 =head2 searchResults
1813
1814 my @search_results = searchResults($search_context, $searchdesc, $hits,
1815 $results_per_page, $offset, $scan,
1816 @marcresults);
1817
1818 Format results in a form suitable for passing to the template
1819
1820 =cut
1821
1822 # IMO this subroutine is pretty messy still -- it's responsible for
1823 # building the HTML output for the template
1824 sub searchResults {
1825 my ( $search_context, $searchdesc, $hits, $results_per_page, $offset, $scan, $marcresults ) = @_;
1826 my $dbh = C4::Context->dbh;
1827 my @newresults;
1828
1829 require C4::Items;
1830
1831 $search_context = 'opac' if !$search_context || $search_context ne 'intranet';
1832 my ($is_opac, $hidelostitems);
1833 if ($search_context eq 'opac') {
1834 $hidelostitems = C4::Context->preference('hidelostitems');
1835 $is_opac = 1;
1836 }
1837
1838 #Build branchnames hash
1839 #find branchname
1840 #get branch information.....
1841 my %branches;
1842 my $bsth =$dbh->prepare("SELECT branchcode,branchname FROM branches"); # FIXME : use C4::Branch::GetBranches
1843 $bsth->execute();
1844 while ( my $bdata = $bsth->fetchrow_hashref ) {
1845 $branches{ $bdata->{'branchcode'} } = $bdata->{'branchname'};
1846 }
1847 # FIXME - We build an authorised values hash here, using the default framework
1848 # though it is possible to have different authvals for different fws.
1849
1850 my $shelflocations =GetKohaAuthorisedValues('items.location','');
1851
1852 # get notforloan authorised value list (see $shelflocations FIXME)
1853 my $notforloan_authorised_value = GetAuthValCode('items.notforloan','');
1854
1855 #Get itemtype hash
1856 my %itemtypes = %{ GetItemTypes() };
1857
1858 #search item field code
1859 my ($itemtag, undef) = &GetMarcFromKohaField( "items.itemnumber", "" );
1860
1861 ## find column names of items related to MARC
1862 my %subfieldstosearch;
1863 my @columns = Koha::Database->new()->schema()->resultset('Item')->result_source->columns;
1864 for my $column ( @columns ) {
1865 my ( $tagfield, $tagsubfield ) =
1866 &GetMarcFromKohaField( "items." . $column, "" );
1867 if ( defined $tagsubfield ) {
1868 $subfieldstosearch{$column} = $tagsubfield;
1869 }
1870 }
1871
1872 # handle which records to actually retrieve
1873 my $times;
1874 if ( $hits && $offset + $results_per_page <= $hits ) {
1875 $times = $offset + $results_per_page;
1876 }
1877 else {
1878 $times = $hits; # FIXME: if $hits is undefined, why do we want to equal it?
1879 }
1880
1881 my $marcflavour = C4::Context->preference("marcflavour");
1882 # We get the biblionumber position in MARC
1883 my ($bibliotag,$bibliosubf)=GetMarcFromKohaField('biblio.biblionumber','');
1884
1885 # set stuff for XSLT processing here once, not later again for every record we retrieved
1886 my $interface = $search_context eq 'opac' ? 'OPAC' : '';
1887 my $xslsyspref = $interface . "XSLTResultsDisplay";
1888 my $xslfile = C4::Context->preference($xslsyspref);
1889 my $lang = $xslfile ? C4::Languages::getlanguage() : undef;
1890 my $sysxml = $xslfile ? C4::XSLT::get_xslt_sysprefs() : undef;
1891
1892 # loop through all of the records we've retrieved
1893 for ( my $i = $offset ; $i <= $times - 1 ; $i++ ) {
1894
1895 my $marcrecord;
1896 if ($scan) {
1897 # For Scan searches we built USMARC data
1898 $marcrecord = MARC::Record->new_from_usmarc( $marcresults->[$i]);
1899 } else {
1900 # Normal search, render from Zebra's output
1901 $marcrecord = new_record_from_zebra(
1902 'biblioserver',
1903 $marcresults->[$i]
1904 );
1905
1906 if ( ! defined $marcrecord ) {
1907 warn "ERROR DECODING RECORD - $@: " . $marcresults->[$i];
1908 next;
1909 }
1910 }
1911
1912 my $fw = $scan
1913 ? undef
1914 : $bibliotag < 10
1915 ? GetFrameworkCode($marcrecord->field($bibliotag)->data)
1916 : GetFrameworkCode($marcrecord->subfield($bibliotag,$bibliosubf));
1917
1918 SetUTF8Flag($marcrecord);
1919 my $oldbiblio = TransformMarcToKoha( $marcrecord, $fw );
1920 $oldbiblio->{subtitle} = GetRecordValue('subtitle', $marcrecord, $fw);
1921 $oldbiblio->{result_number} = $i + 1;
1922
1923 # add imageurl to itemtype if there is one
1924 $oldbiblio->{imageurl} = getitemtypeimagelocation( $search_context, $itemtypes{ $oldbiblio->{itemtype} }->{imageurl} );
1925
1926 $oldbiblio->{normalized_upc} = GetNormalizedUPC( $marcrecord,$marcflavour);
1927 $oldbiblio->{normalized_ean} = GetNormalizedEAN( $marcrecord,$marcflavour);
1928 $oldbiblio->{normalized_oclc} = GetNormalizedOCLCNumber($marcrecord,$marcflavour);
1929 $oldbiblio->{normalized_isbn} = GetNormalizedISBN(undef,$marcrecord,$marcflavour);
1930 $oldbiblio->{content_identifier_exists} = 1 if ($oldbiblio->{normalized_isbn} or $oldbiblio->{normalized_oclc} or $oldbiblio->{normalized_ean} or $oldbiblio->{normalized_upc});
1931
1932 # edition information, if any
1933 $oldbiblio->{edition} = $oldbiblio->{editionstatement};
1934 $oldbiblio->{description} = $itemtypes{ $oldbiblio->{itemtype} }->{translated_description};
1935 # Build summary if there is one (the summary is defined in the itemtypes table)
1936 # FIXME: is this used anywhere, I think it can be commented out? -- JF
1937 if ( $itemtypes{ $oldbiblio->{itemtype} }->{summary} ) {
1938 my $summary = $itemtypes{ $oldbiblio->{itemtype} }->{summary};
1939 my @fields = $marcrecord->fields();
1940
1941 my $newsummary;
1942 foreach my $line ( "$summary\n" =~ /(.*)\n/g ){
1943 my $tags = {};
1944 foreach my $tag ( $line =~ /\[(\d{3}[\w|\d])\]/ ) {
1945 $tag =~ /(.{3})(.)/;
1946 if($marcrecord->field($1)){
1947 my @abc = $marcrecord->field($1)->subfield($2);
1948 $tags->{$tag} = $#abc + 1 ;
1949 }
1950 }
1951
1952 # We catch how many times to repeat this line
1953 my $max = 0;
1954 foreach my $tag (keys(%$tags)){
1955 $max = $tags->{$tag} if($tags->{$tag} > $max);
1956 }
1957
1958 # we replace, and repeat each line
1959 for (my $i = 0 ; $i < $max ; $i++){
1960 my $newline = $line;
1961
1962 foreach my $tag ( $newline =~ /\[(\d{3}[\w|\d])\]/g ) {
1963 $tag =~ /(.{3})(.)/;
1964
1965 if($marcrecord->field($1)){
1966 my @repl = $marcrecord->field($1)->subfield($2);
1967 my $subfieldvalue = $repl[$i];
1968 $newline =~ s/\[$tag\]/$subfieldvalue/g;
1969 }
1970 }
1971 $newsummary .= "$newline\n";
1972 }
1973 }
1974
1975 $newsummary =~ s/\[(.*?)]//g;
1976 $newsummary =~ s/\n/<br\/>/g;
1977 $oldbiblio->{summary} = $newsummary;
1978 }
1979
1980 # Pull out the items fields
1981 my @fields = $marcrecord->field($itemtag);
1982 my $marcflavor = C4::Context->preference("marcflavour");
1983 # adding linked items that belong to host records
1984 my $analyticsfield = '773';
1985 if ($marcflavor eq 'MARC21' || $marcflavor eq 'NORMARC') {
1986 $analyticsfield = '773';
1987 } elsif ($marcflavor eq 'UNIMARC') {
1988 $analyticsfield = '461';
1989 }
1990 foreach my $hostfield ( $marcrecord->field($analyticsfield)) {
1991 my $hostbiblionumber = $hostfield->subfield("0");
1992 my $linkeditemnumber = $hostfield->subfield("9");
1993 if(!$hostbiblionumber eq undef){
1994 my $hostbiblio = GetMarcBiblio($hostbiblionumber, 1);
1995 my ($itemfield, undef) = GetMarcFromKohaField( 'items.itemnumber', GetFrameworkCode($hostbiblionumber) );
1996 if(!$hostbiblio eq undef){
1997 my @hostitems = $hostbiblio->field($itemfield);
1998 foreach my $hostitem (@hostitems){
1999 if ($hostitem->subfield("9") eq $linkeditemnumber){
2000 my $linkeditem =$hostitem;
2001 # append linked items if they exist
2002 if (!$linkeditem eq undef){
2003 push (@fields, $linkeditem);}
2004 }
2005 }
2006 }
2007 }
2008 }
2009
2010 # Setting item statuses for display
2011 my @available_items_loop;
2012 my @onloan_items_loop;
2013 my @other_items_loop;
2014
2015 my $available_items;
2016 my $onloan_items;
2017 my $other_items;
2018
2019 my $ordered_count = 0;
2020 my $available_count = 0;
2021 my $onloan_count = 0;
2022 my $longoverdue_count = 0;
2023 my $other_count = 0;
2024 my $withdrawn_count = 0;
2025 my $itemlost_count = 0;
2026 my $hideatopac_count = 0;
2027 my $itembinding_count = 0;
2028 my $itemdamaged_count = 0;
2029 my $item_in_transit_count = 0;
2030 my $can_place_holds = 0;
2031 my $item_onhold_count = 0;
2032 my $notforloan_count = 0;
2033 my $items_count = scalar(@fields);
2034 my $maxitems_pref = C4::Context->preference('maxItemsinSearchResults');
2035 my $maxitems = $maxitems_pref ? $maxitems_pref - 1 : 1;
2036 my @hiddenitems; # hidden itemnumbers based on OpacHiddenItems syspref
2037
2038 # loop through every item
2039 foreach my $field (@fields) {
2040 my $item;
2041
2042 # populate the items hash
2043 foreach my $code ( keys %subfieldstosearch ) {
2044 $item->{$code} = $field->subfield( $subfieldstosearch{$code} );
2045 }
2046 $item->{description} = $itemtypes{ $item->{itype} }{translated_description};
2047
2048 # OPAC hidden items
2049 if ($is_opac) {
2050 # hidden because lost
2051 if ($hidelostitems && $item->{itemlost}) {
2052 $hideatopac_count++;
2053 next;
2054 }
2055 # hidden based on OpacHiddenItems syspref
2056 my @hi = C4::Items::GetHiddenItemnumbers($item);
2057 if (scalar @hi) {
2058 push @hiddenitems, @hi;
2059 $hideatopac_count++;
2060 next;
2061 }
2062 }
2063
2064 my $hbranch = C4::Context->preference('StaffSearchResultsDisplayBranch');
2065 my $otherbranch = $hbranch eq 'homebranch' ? 'holdingbranch' : 'homebranch';
2066
2067 # set item's branch name, use HomeOrHoldingBranch syspref first, fall back to the other one
2068 if ($item->{$hbranch}) {
2069 $item->{'branchname'} = $branches{$item->{$hbranch}};
2070 }
2071 elsif ($item->{$otherbranch}) { # Last resort
2072 $item->{'branchname'} = $branches{$item->{$otherbranch}};
2073 }
2074
2075 my $prefix = $item->{$hbranch} . '--' . $item->{location} . $item->{itype} . $item->{itemcallnumber};
2076 # For each grouping of items (onloan, available, unavailable), we build a key to store relevant info about that item
2077 my $userenv = C4::Context->userenv;
2078 if ( $item->{onloan}
2079 && !( C4::Members::GetHideLostItemsPreference( $userenv->{'number'} ) && $item->{itemlost} ) )
2080 {
2081 $onloan_count++;
2082 my $key = $prefix . $item->{onloan} . $item->{barcode};
2083 $onloan_items->{$key}->{due_date} = output_pref( { dt => dt_from_string( $item->{onloan} ), dateonly => 1 } );
2084 $onloan_items->{$key}->{count}++ if $item->{$hbranch};
2085 $onloan_items->{$key}->{branchname} = $item->{branchname};
2086 $onloan_items->{$key}->{location} = $shelflocations->{ $item->{location} };
2087 $onloan_items->{$key}->{itemcallnumber} = $item->{itemcallnumber};
2088 $onloan_items->{$key}->{description} = $item->{description};
2089 $onloan_items->{$key}->{imageurl} =
2090 getitemtypeimagelocation( $search_context, $itemtypes{ $item->{itype} }->{imageurl} );
2091
2092 # if something's checked out and lost, mark it as 'long overdue'
2093 if ( $item->{itemlost} ) {
2094 $onloan_items->{$key}->{longoverdue}++;
2095 $longoverdue_count++;
2096 }
2097 else { # can place holds as long as item isn't lost
2098 $can_place_holds = 1;
2099 }
2100 }
2101
2102 # items not on loan, but still unavailable ( lost, withdrawn, damaged )
2103 else {
2104
2105 $item->{notforloan}=1 if !$item->{notforloan} && $itemtypes{ C4::Context->preference("item-level_itypes")? $item->{itype}: $oldbiblio->{itemtype} }->{notforloan};
2106
2107 # item is on order
2108 if ( $item->{notforloan} < 0 ) {
2109 $ordered_count++;
2110 } elsif ( $item->{notforloan} > 0 ) {
2111 $notforloan_count++;
2112 }
2113
2114 # is item in transit?
2115 my $transfertwhen = '';
2116 my ($transfertfrom, $transfertto);
2117
2118 # is item on the reserve shelf?
2119 my $reservestatus = '';
2120
2121 unless ($item->{withdrawn}
2122 || $item->{itemlost}
2123 || $item->{damaged}
2124 || $item->{notforloan}
2125 || ( C4::Context->preference('MaxSearchResultsItemsPerRecordStatusCheck')
2126 && $items_count > C4::Context->preference('MaxSearchResultsItemsPerRecordStatusCheck') ) ) {
2127
2128 # A couple heuristics to limit how many times
2129 # we query the database for item transfer information, sacrificing
2130 # accuracy in some cases for speed;
2131 #
2132 # 1. don't query if item has one of the other statuses
2133 # 2. don't check transit status if the bib has
2134 # more than 20 items
2135 #
2136 # FIXME: to avoid having the query the database like this, and to make
2137 # the in transit status count as unavailable for search limiting,
2138 # should map transit status to record indexed in Zebra.
2139 #
2140 ($transfertwhen, $transfertfrom, $transfertto) = C4::Circulation::GetTransfers($item->{itemnumber});
2141 $reservestatus = C4::Reserves::GetReserveStatus( $item->{itemnumber} );
2142 }
2143
2144 # item is withdrawn, lost, damaged, not for loan, reserved or in transit
2145 if ( $item->{withdrawn}
2146 || $item->{itemlost}
2147 || $item->{damaged}
2148 || $item->{notforloan}
2149 || $reservestatus eq 'Waiting'
2150 || ($transfertwhen ne ''))
2151 {
2152 $withdrawn_count++ if $item->{withdrawn};
2153 $itemlost_count++ if $item->{itemlost};
2154 $itemdamaged_count++ if $item->{damaged};
2155 $item_in_transit_count++ if $transfertwhen ne '';
2156 $item_onhold_count++ if $reservestatus eq 'Waiting';
2157 $item->{status} = $item->{withdrawn} . "-" . $item->{itemlost} . "-" . $item->{damaged} . "-" . $item->{notforloan};
2158
2159 # can place a hold on a item if
2160 # not lost nor withdrawn
2161 # not damaged unless AllowHoldsOnDamagedItems is true
2162 # item is either for loan or on order (notforloan < 0)
2163 $can_place_holds = 1
2164 if (
2165 !$item->{itemlost}
2166 && !$item->{withdrawn}
2167 && ( !$item->{damaged} || C4::Context->preference('AllowHoldsOnDamagedItems') )
2168 && ( !$item->{notforloan} || $item->{notforloan} < 0 )
2169 );
2170
2171 $other_count++;
2172
2173 my $key = $prefix . $item->{status};
2174 foreach (qw(withdrawn itemlost damaged branchname itemcallnumber)) {
2175 $other_items->{$key}->{$_} = $item->{$_};
2176 }
2177 $other_items->{$key}->{intransit} = ( $transfertwhen ne '' ) ? 1 : 0;
2178 $other_items->{$key}->{onhold} = ($reservestatus) ? 1 : 0;
2179 $other_items->{$key}->{notforloan} = GetAuthorisedValueDesc('','',$item->{notforloan},'','',$notforloan_authorised_value) if $notforloan_authorised_value and $item->{notforloan};
2180 $other_items->{$key}->{count}++ if $item->{$hbranch};
2181 $other_items->{$key}->{location} = $shelflocations->{ $item->{location} };
2182 $other_items->{$key}->{description} = $item->{description};
2183 $other_items->{$key}->{imageurl} = getitemtypeimagelocation( $search_context, $itemtypes{ $item->{itype} }->{imageurl} );
2184 }
2185 # item is available
2186 else {
2187 $can_place_holds = 1;
2188 $available_count++;
2189 $available_items->{$prefix}->{count}++ if $item->{$hbranch};
2190 foreach (qw(branchname itemcallnumber description)) {
2191 $available_items->{$prefix}->{$_} = $item->{$_};
2192 }
2193 $available_items->{$prefix}->{location} = $shelflocations->{ $item->{location} };
2194 $available_items->{$prefix}->{imageurl} = getitemtypeimagelocation( $search_context, $itemtypes{ $item->{itype} }->{imageurl} );
2195 }
2196 }
2197 } # notforloan, item level and biblioitem level
2198
2199 # if all items are hidden, do not show the record
2200 if ($items_count > 0 && $hideatopac_count == $items_count) {
2201 next;
2202 }
2203
2204 my ( $availableitemscount, $onloanitemscount, $otheritemscount );
2205 for my $key ( sort keys %$onloan_items ) {
2206 (++$onloanitemscount > $maxitems) and last;
2207 push @onloan_items_loop, $onloan_items->{$key};
2208 }
2209 for my $key ( sort keys %$other_items ) {
2210 (++$otheritemscount > $maxitems) and last;
2211 push @other_items_loop, $other_items->{$key};
2212 }
2213 for my $key ( sort keys %$available_items ) {
2214 (++$availableitemscount > $maxitems) and last;
2215 push @available_items_loop, $available_items->{$key}
2216 }
2217
2218 # XSLT processing of some stuff
2219 # we fetched the sysprefs already before the loop through all retrieved record!
2220 if (!$scan && $xslfile) {
2221 $oldbiblio->{XSLTResultsRecord} = XSLTParse4Display($oldbiblio->{biblionumber}, $marcrecord, $xslsyspref, 1, \@hiddenitems, $sysxml, $xslfile, $lang);
2222 # the last parameter tells Koha to clean up the problematic ampersand entities that Zebra outputs
2223 }
2224
2225 # if biblio level itypes are used and itemtype is notforloan, it can't be reserved either
2226 if (!C4::Context->preference("item-level_itypes")) {
2227 if ($itemtypes{ $oldbiblio->{itemtype} }->{notforloan}) {
2228 $can_place_holds = 0;
2229 }
2230 }
2231 $oldbiblio->{norequests} = 1 unless $can_place_holds;
2232 $oldbiblio->{itemsplural} = 1 if $items_count > 1;
2233 $oldbiblio->{items_count} = $items_count;
2234 $oldbiblio->{available_items_loop} = \@available_items_loop;
2235 $oldbiblio->{onloan_items_loop} = \@onloan_items_loop;
2236 $oldbiblio->{other_items_loop} = \@other_items_loop;
2237 $oldbiblio->{availablecount} = $available_count;
2238 $oldbiblio->{availableplural} = 1 if $available_count > 1;
2239 $oldbiblio->{onloancount} = $onloan_count;
2240 $oldbiblio->{onloanplural} = 1 if $onloan_count > 1;
2241 $oldbiblio->{othercount} = $other_count;
2242 $oldbiblio->{otherplural} = 1 if $other_count > 1;
2243 $oldbiblio->{withdrawncount} = $withdrawn_count;
2244 $oldbiblio->{itemlostcount} = $itemlost_count;
2245 $oldbiblio->{damagedcount} = $itemdamaged_count;
2246 $oldbiblio->{intransitcount} = $item_in_transit_count;
2247 $oldbiblio->{onholdcount} = $item_onhold_count;
2248 $oldbiblio->{orderedcount} = $ordered_count;
2249 $oldbiblio->{notforloancount} = $notforloan_count;
2250
2251 if (C4::Context->preference("AlternateHoldingsField") && $items_count == 0) {
2252 my $fieldspec = C4::Context->preference("AlternateHoldingsField");
2253 my $subfields = substr $fieldspec, 3;
2254 my $holdingsep = C4::Context->preference("AlternateHoldingsSeparator") || ' ';
2255 my @alternateholdingsinfo = ();
2256 my @holdingsfields = $marcrecord->field(substr $fieldspec, 0, 3);
2257 my $alternateholdingscount = 0;
2258
2259 for my $field (@holdingsfields) {
2260 my %holding = ( holding => '' );
2261 my $havesubfield = 0;
2262 for my $subfield ($field->subfields()) {
2263 if ((index $subfields, $$subfield[0]) >= 0) {
2264 $holding{'holding'} .= $holdingsep if (length $holding{'holding'} > 0);
2265 $holding{'holding'} .= $$subfield[1];
2266 $havesubfield++;
2267 }
2268 }
2269 if ($havesubfield) {
2270 push(@alternateholdingsinfo, \%holding);
2271 $alternateholdingscount++;
2272 }
2273 }
2274
2275 $oldbiblio->{'ALTERNATEHOLDINGS'} = \@alternateholdingsinfo;
2276 $oldbiblio->{'alternateholdings_count'} = $alternateholdingscount;
2277 }
2278
2279 push( @newresults, $oldbiblio );
2280 }
2281
2282 return @newresults;
2283 }
2284
2285 =head2 SearchAcquisitions
2286 Search for acquisitions
2287 =cut
2288
2289 sub SearchAcquisitions{
2290 my ($datebegin, $dateend, $itemtypes,$criteria, $orderby) = @_;
2291
2292 my $dbh=C4::Context->dbh;
2293 # Variable initialization
2294 my $str=qq|
2295 SELECT marcxml
2296 FROM biblio
2297 LEFT JOIN biblioitems ON biblioitems.biblionumber=biblio.biblionumber
2298 LEFT JOIN items ON items.biblionumber=biblio.biblionumber
2299 WHERE dateaccessioned BETWEEN ? AND ?
2300 |;
2301
2302 my (@params,@loopcriteria);
2303
2304 push @params, $datebegin->output("iso");
2305 push @params, $dateend->output("iso");
2306
2307 if (scalar(@$itemtypes)>0 and $criteria ne "itemtype" ){
2308 if(C4::Context->preference("item-level_itypes")){
2309 $str .= "AND items.itype IN (?".( ',?' x scalar @$itemtypes - 1 ).") ";
2310 }else{
2311 $str .= "AND biblioitems.itemtype IN (?".( ',?' x scalar @$itemtypes - 1 ).") ";
2312 }
2313 push @params, @$itemtypes;
2314 }
2315
2316 if ($criteria =~/itemtype/){
2317 if(C4::Context->preference("item-level_itypes")){
2318 $str .= "AND items.itype=? ";
2319 }else{
2320 $str .= "AND biblioitems.itemtype=? ";
2321 }
2322
2323 if(scalar(@$itemtypes) == 0){
2324 my $itypes = GetItemTypes();
2325 for my $key (keys %$itypes){
2326 push @$itemtypes, $key;
2327 }
2328 }
2329
2330 @loopcriteria= @$itemtypes;
2331 }elsif ($criteria=~/itemcallnumber/){
2332 $str .= "AND (items.itemcallnumber LIKE CONCAT(?,'%')
2333 OR items.itemcallnumber is NULL
2334 OR items.itemcallnumber = '')";
2335
2336 @loopcriteria = ("AA".."ZZ", "") unless (scalar(@loopcriteria)>0);
2337 }else {
2338 $str .= "AND biblio.title LIKE CONCAT(?,'%') ";
2339 @loopcriteria = ("A".."z") unless (scalar(@loopcriteria)>0);
2340 }
2341
2342 if ($orderby =~ /date_desc/){
2343 $str.=" ORDER BY dateaccessioned DESC";
2344 } else {
2345 $str.=" ORDER BY title";
2346 }
2347
2348 my $qdataacquisitions=$dbh->prepare($str);
2349
2350 my @loopacquisitions;
2351 foreach my $value(@loopcriteria){
2352 push @params,$value;
2353 my %cell;
2354 $cell{"title"}=$value;
2355 $cell{"titlecode"}=$value;
2356
2357 eval{$qdataacquisitions->execute(@params);};
2358
2359 if ($@){ warn "recentacquisitions Error :$@";}
2360 else {
2361 my @loopdata;
2362 while (my $data=$qdataacquisitions->fetchrow_hashref){
2363 push @loopdata, {"summary"=>GetBiblioSummary( $data->{'marcxml'} ) };
2364 }
2365 $cell{"loopdata"}=\@loopdata;
2366 }
2367 push @loopacquisitions,\%cell if (scalar(@{$cell{loopdata}})>0);
2368 pop @params;
2369 }
2370 $qdataacquisitions->finish;
2371 return \@loopacquisitions;
2372 }
2373
2374 =head2 enabled_staff_search_views
2375
2376 %hash = enabled_staff_search_views()
2377
2378 This function returns a hash that contains three flags obtained from the system
2379 preferences, used to determine whether a particular staff search results view
2380 is enabled.
2381
2382 =over 2
2383
2384 =item C<Output arg:>
2385
2386 * $hash{can_view_MARC} is true only if the MARC view is enabled
2387 * $hash{can_view_ISBD} is true only if the ISBD view is enabled
2388 * $hash{can_view_labeledMARC} is true only if the Labeled MARC view is enabled
2389
2390 =item C<usage in the script:>
2391
2392 =back
2393
2394 $template->param ( C4::Search::enabled_staff_search_views );
2395
2396 =cut
2397
2398 sub enabled_staff_search_views
2399 {
2400 return (
2401 can_view_MARC => C4::Context->preference('viewMARC'), # 1 if the staff search allows the MARC view
2402 can_view_ISBD => C4::Context->preference('viewISBD'), # 1 if the staff search allows the ISBD view
2403 can_view_labeledMARC => C4::Context->preference('viewLabeledMARC'), # 1 if the staff search allows the Labeled MARC view
2404 );
2405 }
2406
2407 =head2 z3950_search_args
2408
2409 $arrayref = z3950_search_args($matchpoints)
2410
2411 This function returns an array reference that contains the search parameters to be
2412 passed to the Z39.50 search script (z3950_search.pl). The array elements
2413 are hash refs whose keys are name and value, and whose values are the
2414 name of a search parameter, the value of that search parameter and the URL encoded
2415 value of that parameter.
2416
2417 The search parameter names are lccn, isbn, issn, title, author, dewey and subject.
2418
2419 The search parameter values are obtained from the bibliographic record whose
2420 data is in a hash reference in $matchpoints, as returned by Biblio::GetBiblioData().
2421
2422 If $matchpoints is a scalar, it is assumed to be an unnamed query descriptor, e.g.
2423 a general purpose search argument. In this case, the returned array contains only
2424 entry: the key is 'title' and the value is derived from $matchpoints.
2425
2426 If a search parameter value is undefined or empty, it is not included in the returned
2427 array.
2428
2429 The returned array reference may be passed directly to the template parameters.
2430
2431 =over 2
2432
2433 =item C<Output arg:>
2434
2435 * $array containing hash refs as described above
2436
2437 =item C<usage in the script:>
2438
2439 =back
2440
2441 $data = Biblio::GetBiblioData($bibno);
2442 $template->param ( MYLOOP => C4::Search::z3950_search_args($data) )
2443
2444 *OR*
2445
2446 $template->param ( MYLOOP => C4::Search::z3950_search_args($searchscalar) )
2447
2448 =cut
2449
2450 sub z3950_search_args {
2451 my $bibrec = shift;
2452
2453 my $isbn_string = ref( $bibrec ) ? $bibrec->{title} : $bibrec;
2454 my $isbn = Business::ISBN->new( $isbn_string );
2455
2456 if (defined $isbn && $isbn->is_valid)
2457 {
2458 if ( ref($bibrec) ) {
2459 $bibrec->{isbn} = $isbn_string;
2460 $bibrec->{title} = undef;
2461 } else {
2462 $bibrec = { isbn => $isbn_string };
2463 }
2464 }
2465 else {
2466 $bibrec = { title => $bibrec } if !ref $bibrec;
2467 }
2468 my $array = [];
2469 for my $field (qw/ lccn isbn issn title author dewey subject /)
2470 {
2471 push @$array, { name => $field, value => $bibrec->{$field} }
2472 if defined $bibrec->{$field};
2473 }
2474 return $array;
2475 }
2476
2477 =head2 GetDistinctValues($field);
2478
2479 C<$field> is a reference to the fields array
2480
2481 =cut
2482
2483 sub GetDistinctValues {
2484 my ($fieldname,$string)=@_;
2485 # returns a reference to a hash of references to branches...
2486 if ($fieldname=~/\./){
2487 my ($table,$column)=split /\./, $fieldname;
2488 my $dbh = C4::Context->dbh;
2489 warn "select DISTINCT($column) as value, count(*) as cnt from $table group by lib order by $column " if $DEBUG;
2490 my $sth = $dbh->prepare("select DISTINCT($column) as value, count(*) as cnt from $table ".($string?" where $column like \"$string%\"":"")."group by value order by $column ");
2491 $sth->execute;
2492 my $elements=$sth->fetchall_arrayref({});
2493 return $elements;
2494 }
2495 else {
2496 $string||= qq("");
2497 my @servers=qw<biblioserver authorityserver>;
2498 my (@zconns,@results);
2499 for ( my $i = 0 ; $i < @servers ; $i++ ) {
2500 $zconns[$i] = C4::Context->Zconn( $servers[$i], 1 );
2501 $results[$i] =
2502 $zconns[$i]->scan(
2503 ZOOM::Query::CCL2RPN->new( qq"$fieldname $string", $zconns[$i])
2504 );
2505 }
2506 # The big moment: asynchronously retrieve results from all servers
2507 my @elements;
2508 _ZOOM_event_loop(
2509 \@zconns,
2510 \@results,
2511 sub {
2512 my ( $i, $size ) = @_;
2513 for ( my $j = 0 ; $j < $size ; $j++ ) {
2514 my %hashscan;
2515 @hashscan{qw(value cnt)} =
2516 $results[ $i - 1 ]->display_term($j);
2517 push @elements, \%hashscan;
2518 }
2519 }
2520 );
2521 return \@elements;
2522 }
2523 }
2524
2525 =head2 _ZOOM_event_loop
2526
2527 _ZOOM_event_loop(\@zconns, \@results, sub {
2528 my ( $i, $size ) = @_;
2529 ....
2530 } );
2531
2532 Processes a ZOOM event loop and passes control to a closure for
2533 processing the results, and destroying the resultsets.
2534
2535 =cut
2536
2537 sub _ZOOM_event_loop {
2538 my ($zconns, $results, $callback) = @_;
2539 while ( ( my $i = ZOOM::event( $zconns ) ) != 0 ) {
2540 my $ev = $zconns->[ $i - 1 ]->last_event();
2541 if ( $ev == ZOOM::Event::ZEND ) {
2542 next unless $results->[ $i - 1 ];
2543 my $size = $results->[ $i - 1 ]->size();
2544 if ( $size > 0 ) {
2545 $callback->($i, $size);
2546 }
2547 }
2548 }
2549
2550 foreach my $result (@$results) {
2551 $result->destroy();
2552 }
2553 }
2554
2555 =head2 new_record_from_zebra
2556
2557 Given raw data from a searchengine result set, return a MARC::Record object
2558
2559 This helper function is needed to take into account all the involved
2560 system preferences and configuration variables to properly create the
2561 MARC::Record object.
2562
2563 If we are using GRS-1, then the raw data we get from Zebra should be USMARC
2564 data. If we are using DOM, then it has to be MARCXML.
2565
2566 If we are using elasticsearch, it'll already be a MARC::Record and this
2567 function needs a new name.
2568
2569 =cut
2570
2571 sub new_record_from_zebra {
2572
2573 my $server = shift;
2574 my $raw_data = shift;
2575 # Set the default indexing modes
2576 my $search_engine = C4::Context->preference("SearchEngine");
2577 if ($search_engine eq 'Elasticsearch') {
2578 return $raw_data;
2579 }
2580 my $index_mode = ( $server eq 'biblioserver' )
2581 ? C4::Context->config('zebra_bib_index_mode') // 'dom'
2582 : C4::Context->config('zebra_auth_index_mode') // 'dom';
2583
2584 my $marc_record = eval {
2585 if ( $index_mode eq 'dom' ) {
2586 MARC::Record->new_from_xml( $raw_data, 'UTF-8' );
2587 } else {
2588 MARC::Record->new_from_usmarc( $raw_data );
2589 }
2590 };
2591
2592 if ($@) {
2593 return;
2594 } else {
2595 return $marc_record;
2596 }
2597
2598 }
2599
2600 END { } # module clean-up code here (global destructor)
2601
2602 1;
2603 __END__
2604
2605 =head1 AUTHOR
2606
2607 Koha Development Team <http://koha-community.org/>
2608
2609 =cut
Koha ILS