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