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