3 # This file is part of Koha.
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.
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.
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>.
19 #use warnings; FIXME - Bug 2505
22 use C4::Biblio; # GetMarcFromKohaField, GetBiblioData
23 use C4::Koha; # getFacets
26 use C4::Search::PazPar2;
28 use C4::Members qw(GetHideLostItemsPreference);
31 use C4::Reserves; # GetReserveStatus
40 use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $DEBUG);
43 $DEBUG = ($ENV{DEBUG}) ? 1 : 0;
48 C4::Search - Functions for searching the Koha catalog.
52 See opac/opac-search.pl or catalogue/search.pl for example of usage
56 This module provides searching functions for Koha's bibliographic databases
70 &enabled_staff_search_views
73 # make all your functions, whether exported or not;
77 ($biblionumber,$biblionumber,$title) = FindDuplicate($record);
79 This function attempts to find duplicate records using a hard-coded, fairly simplistic algorithm
85 my $dbh = C4::Context->dbh;
86 my $result = TransformMarcToKoha( $record, '' );
91 my ( $biblionumber, $title );
93 # search duplicate on ISBN, easy and fast..
95 if ( $result->{isbn} ) {
96 $result->{isbn} =~ s/\(.*$//;
97 $result->{isbn} =~ s/\s+$//;
98 $query = "isbn:$result->{isbn}";
102 $QParser = C4::Context->queryparser if (C4::Context->preference('UseQueryParser'));
108 $titleindex = 'title|exact';
109 $authorindex = 'author|exact';
111 $QParser->custom_data->{'QueryAutoTruncate'} = C4::Context->preference('QueryAutoTruncate');
113 $titleindex = 'ti,ext';
114 $authorindex = 'au,ext';
118 $result->{title} =~ s /\\//g;
119 $result->{title} =~ s /\"//g;
120 $result->{title} =~ s /\(//g;
121 $result->{title} =~ s /\)//g;
123 # FIXME: instead of removing operators, could just do
124 # quotes around the value
125 $result->{title} =~ s/(and|or|not)//g;
126 $query = "$titleindex:\"$result->{title}\"";
127 if ( $result->{author} ) {
128 $result->{author} =~ s /\\//g;
129 $result->{author} =~ s /\"//g;
130 $result->{author} =~ s /\(//g;
131 $result->{author} =~ s /\)//g;
133 # remove valid operators
134 $result->{author} =~ s/(and|or|not)//g;
135 $query .= " $op $authorindex:\"$result->{author}\"";
139 my ( $error, $searchresults, undef ) = SimpleSearch($query); # FIXME :: hardcoded !
141 if (!defined $error) {
142 foreach my $possible_duplicate_record (@{$searchresults}) {
143 my $marcrecord = new_record_from_zebra(
145 $possible_duplicate_record
148 my $result = TransformMarcToKoha( $marcrecord, '' );
150 # FIXME :: why 2 $biblionumber ?
152 push @results, $result->{'biblionumber'};
153 push @results, $result->{'title'};
162 ( $error, $results, $total_hits ) = SimpleSearch( $query, $offset, $max_results, [@servers] );
164 This function provides a simple search API on the bibliographic catalog
170 * $query can be a simple keyword or a complete CCL query
171 * @servers is optional. Defaults to biblioserver as found in koha-conf.xml
172 * $offset - If present, represents the number of records at the beginning to omit. Defaults to 0
173 * $max_results - if present, determines the maximum number of records to fetch. undef is All. defaults to undef.
178 Returns an array consisting of three elements
179 * $error is undefined unless an error is detected
180 * $results is a reference to an array of records.
181 * $total_hits is the number of hits that would have been returned with no limit
183 If an error is returned the two other return elements are undefined. If error itself is undefined
184 the other two elements are always defined
186 =item C<usage in the script:>
190 my ( $error, $marcresults, $total_hits ) = SimpleSearch($query);
192 if (defined $error) {
193 $template->param(query_error => $error);
194 warn "error: ".$error;
195 output_html_with_http_headers $input, $cookie, $template->output;
199 my $hits = @{$marcresults};
202 for my $r ( @{$marcresults} ) {
203 my $marcrecord = MARC::File::USMARC::decode($r);
204 my $biblio = TransformMarcToKoha($marcrecord,q{});
206 #build the iarray of hashs for the template.
208 title => $biblio->{'title'},
209 subtitle => $biblio->{'subtitle'},
210 biblionumber => $biblio->{'biblionumber'},
211 author => $biblio->{'author'},
212 publishercode => $biblio->{'publishercode'},
213 publicationyear => $biblio->{'publicationyear'},
218 $template->param(result=>\@results);
223 my ( $query, $offset, $max_results, $servers ) = @_;
225 return ( 'No query entered', undef, undef ) unless $query;
226 # FIXME hardcoded value. See catalog/search.pl & opac-search.pl too.
227 my @servers = defined ( $servers ) ? @$servers : ( 'biblioserver' );
235 $QParser = C4::Context->queryparser if (C4::Context->preference('UseQueryParser') && ! ($query =~ m/\w,\w|\w=\w/));
237 $QParser->custom_data->{'QueryAutoTruncate'} = C4::Context->preference('QueryAutoTruncate');
240 # Initialize & Search Zebra
241 for ( my $i = 0 ; $i < @servers ; $i++ ) {
243 $zconns[$i] = C4::Context->Zconn( $servers[$i], 1 );
246 $QParser->parse( $query );
247 $query = $QParser->target_syntax($servers[$i]);
248 $zoom_queries[$i] = new ZOOM::Query::PQF( $query, $zconns[$i]);
251 $zoom_queries[$i] = new ZOOM::Query::CCL2RPN( $query, $zconns[$i]);
253 $tmpresults[$i] = $zconns[$i]->search( $zoom_queries[$i] );
257 $zconns[$i]->errmsg() . " ("
258 . $zconns[$i]->errcode() . ") "
259 . $zconns[$i]->addinfo() . " "
260 . $zconns[$i]->diagset();
262 return ( $error, undef, undef ) if $zconns[$i]->errcode();
266 # caught a ZOOM::Exception
270 . $@->addinfo() . " "
272 warn $error." for query: $query";
273 return ( $error, undef, undef );
282 my $first_record = defined($offset) ? $offset + 1 : 1;
283 my $hits = $tmpresults[ $i - 1 ]->size();
284 $total_hits += $hits;
285 my $last_record = $hits;
286 if ( defined $max_results && $offset + $max_results < $hits ) {
287 $last_record = $offset + $max_results;
290 for my $j ( $first_record .. $last_record ) {
292 $tmpresults[ $i - 1 ]->record( $j - 1 )->raw()
295 push @{$results}, $record if defined $record;
300 foreach my $zoom_query (@zoom_queries) {
301 $zoom_query->destroy();
304 return ( undef, $results, $total_hits );
309 ( undef, $results_hashref, \@facets_loop ) = getRecords (
311 $koha_query, $simple_query, $sort_by_ref, $servers_ref,
312 $results_per_page, $offset, $expanded_facet, $branches,$itemtypes,
316 The all singing, all dancing, multi-server, asynchronous, scanning,
317 searching, record nabbing, facet-building
319 See verbse embedded documentation.
325 $koha_query, $simple_query, $sort_by_ref, $servers_ref,
326 $results_per_page, $offset, $expanded_facet, $branches,
327 $itemtypes, $query_type, $scan, $opac
330 my @servers = @$servers_ref;
331 my @sort_by = @$sort_by_ref;
333 # Initialize variables for the ZOOM connection and results object
337 my $results_hashref = ();
339 # Initialize variables for the faceted results objects
340 my $facets_counter = {};
341 my $facets_info = {};
342 my $facets = getFacets();
344 my @facets_loop; # stores the ref to array of hashes for template facets loop
346 ### LOOP THROUGH THE SERVERS
347 for ( my $i = 0 ; $i < @servers ; $i++ ) {
348 $zconns[$i] = C4::Context->Zconn( $servers[$i], 1 );
350 # perform the search, create the results objects
351 # if this is a local search, use the $koha-query, if it's a federated one, use the federated-query
352 my $query_to_use = ($servers[$i] =~ /biblioserver/) ? $koha_query : $simple_query;
354 #$query_to_use = $simple_query if $scan;
355 warn $simple_query if ( $scan and $DEBUG );
357 # Check if we've got a query_type defined, if so, use it
360 if ($query_type =~ /^ccl/) {
361 $query_to_use =~ s/\:/\=/g; # change : to = last minute (FIXME)
362 $results[$i] = $zconns[$i]->search(new ZOOM::Query::CCL2RPN($query_to_use, $zconns[$i]));
363 } elsif ($query_type =~ /^cql/) {
364 $results[$i] = $zconns[$i]->search(new ZOOM::Query::CQL($query_to_use, $zconns[$i]));
365 } elsif ($query_type =~ /^pqf/) {
366 $results[$i] = $zconns[$i]->search(new ZOOM::Query::PQF($query_to_use, $zconns[$i]));
368 warn "Unknown query_type '$query_type'. Results undetermined.";
371 $results[$i] = $zconns[$i]->scan( new ZOOM::Query::CCL2RPN($query_to_use, $zconns[$i]));
373 $results[$i] = $zconns[$i]->search(new ZOOM::Query::CCL2RPN($query_to_use, $zconns[$i]));
377 warn "WARNING: query problem with $query_to_use " . $@;
380 # Concatenate the sort_by limits and pass them to the results object
381 # Note: sort will override rank
383 foreach my $sort (@sort_by) {
384 if ( $sort eq "author_az" || $sort eq "author_asc" ) {
385 $sort_by .= "1=1003 <i ";
387 elsif ( $sort eq "author_za" || $sort eq "author_dsc" ) {
388 $sort_by .= "1=1003 >i ";
390 elsif ( $sort eq "popularity_asc" ) {
391 $sort_by .= "1=9003 <i ";
393 elsif ( $sort eq "popularity_dsc" ) {
394 $sort_by .= "1=9003 >i ";
396 elsif ( $sort eq "call_number_asc" ) {
397 $sort_by .= "1=8007 <i ";
399 elsif ( $sort eq "call_number_dsc" ) {
400 $sort_by .= "1=8007 >i ";
402 elsif ( $sort eq "pubdate_asc" ) {
403 $sort_by .= "1=31 <i ";
405 elsif ( $sort eq "pubdate_dsc" ) {
406 $sort_by .= "1=31 >i ";
408 elsif ( $sort eq "acqdate_asc" ) {
409 $sort_by .= "1=32 <i ";
411 elsif ( $sort eq "acqdate_dsc" ) {
412 $sort_by .= "1=32 >i ";
414 elsif ( $sort eq "title_az" || $sort eq "title_asc" ) {
415 $sort_by .= "1=4 <i ";
417 elsif ( $sort eq "title_za" || $sort eq "title_dsc" ) {
418 $sort_by .= "1=4 >i ";
421 warn "Ignoring unrecognized sort '$sort' requested" if $sort_by;
424 if ( $sort_by && !$scan && $results[$i] ) {
425 if ( $results[$i]->sort( "yaz", $sort_by ) < 0 ) {
426 warn "WARNING sort $sort_by failed";
429 } # finished looping through servers
431 # The big moment: asynchronously retrieve results from all servers
436 my ( $i, $size ) = @_;
439 # loop through the results
440 $results_hash->{'hits'} = $size;
442 if ( $offset + $results_per_page <= $size ) {
443 $times = $offset + $results_per_page;
449 for ( my $j = $offset ; $j < $times ; $j++ ) {
453 ## Check if it's an index scan
455 my ( $term, $occ ) = $results[ $i - 1 ]->display_term($j);
457 # here we create a minimal MARC record and hand it off to the
458 # template just like a normal result ... perhaps not ideal, but
460 my $tmprecord = MARC::Record->new();
461 $tmprecord->encoding('UTF-8');
465 # the minimal record in author/title (depending on MARC flavour)
466 if ( C4::Context->preference("marcflavour") eq
469 $tmptitle = MARC::Field->new(
474 $tmprecord->append_fields($tmptitle);
478 MARC::Field->new( '245', ' ', ' ', a => $term, );
480 MARC::Field->new( '100', ' ', ' ', a => $occ, );
481 $tmprecord->append_fields($tmptitle);
482 $tmprecord->append_fields($tmpauthor);
484 $results_hash->{'RECORDS'}[$j] =
485 $tmprecord->as_usmarc();
490 $record = $results[ $i - 1 ]->record($j)->raw();
491 # warn "RECORD $j:".$record;
492 $results_hash->{'RECORDS'}[$j] = $record;
496 $results_hashref->{ $servers[ $i - 1 ] } = $results_hash;
498 # Fill the facets while we're looping, but only for the
499 # biblioserver and not for a scan
500 if ( !$scan && $servers[ $i - 1 ] =~ /biblioserver/ ) {
501 $facets_counter = GetFacets( $results[ $i - 1 ] );
502 $facets_info = _get_facets_info( $facets );
506 if ( $servers[ $i - 1 ] =~ /biblioserver/ ) {
508 sort { $facets_counter->{$b} <=> $facets_counter->{$a} }
509 keys %$facets_counter
513 my $number_of_facets;
514 my @this_facets_array;
517 $facets_counter->{$link_value}
518 ->{$b} <=> $facets_counter->{$link_value}
520 } keys %{ $facets_counter->{$link_value} }
524 if ( ( $number_of_facets <= 5 )
525 || ( $expanded_facet eq $link_value )
526 || ( $facets_info->{$link_value}->{'expanded'} )
530 # Sanitize the link value : parenthesis, question and exclamation mark will cause errors with CCL
531 my $facet_link_value = $one_facet;
532 $facet_link_value =~ s/[()!?¡¿؟]/ /g;
534 # fix the length that will display in the label,
535 my $facet_label_value = $one_facet;
536 my $facet_max_length = C4::Context->preference(
537 'FacetLabelTruncationLength')
540 substr( $one_facet, 0, $facet_max_length )
542 if length($facet_label_value) >
545 # if it's a branch, label by the name, not the code,
546 if ( $link_value =~ /branch/ ) {
547 if ( defined $branches
548 && ref($branches) eq "HASH"
549 && defined $branches->{$one_facet}
550 && ref( $branches->{$one_facet} ) eq
554 $branches->{$one_facet}
558 $facet_label_value = "*";
562 # if it's a itemtype, label by the name, not the code,
563 if ( $link_value =~ /itype/ ) {
564 if ( defined $itemtypes
565 && ref($itemtypes) eq "HASH"
566 && defined $itemtypes->{$one_facet}
567 && ref( $itemtypes->{$one_facet} ) eq
571 $itemtypes->{$one_facet}
572 ->{translated_description};
576 # also, if it's a location code, use the name instead of the code
577 if ( $link_value =~ /location/ ) {
579 GetKohaAuthorisedValueLib( 'LOC',
583 # but we're down with the whole label being in the link's title.
584 push @this_facets_array,
587 $facets_counter->{$link_value}
589 facet_label_value => $facet_label_value,
590 facet_title_value => $one_facet,
591 facet_link_value => $facet_link_value,
592 type_link_value => $link_value,
594 if ($facet_label_value);
598 # handle expanded option
599 unless ( $facets_info->{$link_value}->{'expanded'} ) {
601 if ( ( $number_of_facets > 5 )
602 && ( $expanded_facet ne $link_value ) );
606 type_link_value => $link_value,
607 type_id => $link_value . "_id",
609 . $facets_info->{$link_value}->{'label_value'} =>
611 facets => \@this_facets_array,
612 expandable => $expandable,
613 expand => $link_value,
617 $facets_info->{$link_value}->{'label_value'} =~
620 and ( Koha::Libraries->search->count == 1 )
626 return ( undef, $results_hashref, \@facets_loop );
634 my $indexing_mode = C4::Context->config('zebra_bib_index_mode') // 'dom';
635 my $use_zebra_facets = C4::Context->config('use_zebra_facets') // 0;
637 if ( $indexing_mode eq 'dom' &&
638 $use_zebra_facets ) {
639 $facets = _get_facets_from_zebra( $rs );
641 $facets = _get_facets_from_records( $rs );
647 sub _get_facets_from_records {
651 my $facets_maxrecs = C4::Context->preference('maxRecordsForFacets') // 20;
652 my $facets_config = getFacets();
654 my $size = $rs->size();
655 my $jmax = $size > $facets_maxrecs
659 for ( my $j = 0 ; $j < $jmax ; $j++ ) {
661 my $marc_record = new_record_from_zebra (
663 $rs->record( $j )->raw()
666 if ( ! defined $marc_record ) {
667 warn "ERROR DECODING RECORD - $@: " .
668 $rs->record( $j )->raw();
672 _get_facets_data_from_record( $marc_record, $facets_config, $facets );
678 =head2 _get_facets_data_from_record
680 C4::Search::_get_facets_data_from_record( $marc_record, $facets, $facets_counter );
682 Internal function that extracts facets information from a MARC::Record object
683 and populates $facets_counter for using in getRecords.
685 $facets is expected to be filled with C4::Koha::getFacets output (i.e. the configured
690 sub _get_facets_data_from_record {
692 my ( $marc_record, $facets, $facets_counter ) = @_;
694 for my $facet (@$facets) {
698 foreach my $tag ( @{ $facet->{ tags } } ) {
700 # tag number is the first three digits
701 my $tag_num = substr( $tag, 0, 3 );
702 # subfields are the remainder
703 my $subfield_letters = substr( $tag, 3 );
705 my @fields = $marc_record->field( $tag_num );
706 foreach my $field (@fields) {
707 # If $field->indicator(1) eq 'z', it means it is a 'see from'
708 # field introduced because of IncludeSeeFromInSearches, so skip it
709 next if $field->indicator(1) eq 'z';
711 my $data = $field->as_string( $subfield_letters, $facet->{ sep } );
713 unless ( grep { /^\Q$data\E$/ } @used_datas ) {
714 push @used_datas, $data;
715 $facets_counter->{ $facet->{ idx } }->{ $data }++;
722 =head2 _get_facets_from_zebra
724 my $facets = _get_facets_from_zebra( $result_set )
726 Retrieves facets for a specified result set. It loops through the facets defined
727 in C4::Koha::getFacets and returns a hash with the following structure:
737 sub _get_facets_from_zebra {
741 # save current elementSetName
742 my $elementSetName = $rs->option( 'elementSetName' );
744 my $facets_loop = getFacets();
745 my $facets_data = {};
746 # loop through defined facets and fill the facets hashref
747 foreach my $facet ( @$facets_loop ) {
749 my $idx = $facet->{ idx };
750 my $sep = $facet->{ sep };
751 my $facet_values = _get_facet_from_result_set( $idx, $rs, $sep );
752 if ( $facet_values ) {
753 # we've actually got a result
754 $facets_data->{ $idx } = $facet_values;
757 # set elementSetName to its previous value to avoid side effects
758 $rs->option( elementSetName => $elementSetName );
763 =head2 _get_facet_from_result_set
766 C4::Search::_get_facet_from_result_set( $facet_idx, $result_set, $sep )
768 Internal function that extracts facet information for a specific index ($facet_idx) and
769 returns a hash containing facet values and count:
772 $facet_value => $count ,
776 Warning: this function has the side effect of changing the elementSetName for the result
777 set. It is a helper function for the main loop, which takes care of backing it up for
782 sub _get_facet_from_result_set {
784 my $facet_idx = shift;
788 my $internal_sep = '<*>';
789 my $facetMaxCount = C4::Context->preference('FacetMaxCount') // 20;
791 return if ( ! defined $facet_idx || ! defined $rs );
792 # zebra's facet element, untokenized index
793 my $facet_element = 'zebra::facet::' . $facet_idx . ':0:' . $facetMaxCount;
794 # configure zebra results for retrieving the desired facet
795 $rs->option( elementSetName => $facet_element );
796 # get the facet record from result set
797 my $facet = $rs->record( 0 )->raw;
798 # if the facet has no restuls...
799 return if !defined $facet;
800 # TODO: benchmark DOM vs. SAX performance
801 my $facet_dom = XML::LibXML->load_xml(
804 my @terms = $facet_dom->getElementsByTagName('term');
808 foreach my $term ( @terms ) {
809 my $facet_value = $term->textContent;
810 $facet_value =~ s/\Q$internal_sep\E/$sep/ if defined $sep;
811 $facets->{ $facet_value } = $term->getAttribute( 'occur' );
817 =head2 _get_facets_info
819 my $facets_info = C4::Search::_get_facets_info( $facets )
821 Internal function that extracts facets information and properly builds
822 the data structure needed to render facet labels.
826 sub _get_facets_info {
830 my $facets_info = {};
832 for my $facet ( @$facets ) {
833 $facets_info->{ $facet->{ idx } }->{ label_value } = $facet->{ label };
834 $facets_info->{ $facet->{ idx } }->{ expanded } = $facet->{ expanded };
842 $koha_query, $simple_query, $sort_by_ref, $servers_ref,
843 $results_per_page, $offset, $expanded_facet, $branches,
847 my $paz = C4::Search::PazPar2->new(C4::Context->config('pazpar2url'));
849 $paz->search($simple_query);
850 sleep 1; # FIXME: WHY?
853 my $results_hashref = {};
854 my $stats = XMLin($paz->stat);
855 my $results = XMLin($paz->show($offset, $results_per_page, 'work-title:1'), forcearray => 1);
857 # for a grouped search result, the number of hits
858 # is the number of groups returned; 'bib_hits' will have
859 # the total number of bibs.
860 $results_hashref->{'biblioserver'}->{'hits'} = $results->{'merged'}->[0];
861 $results_hashref->{'biblioserver'}->{'bib_hits'} = $stats->{'hits'};
863 HIT: foreach my $hit (@{ $results->{'hit'} }) {
864 my $recid = $hit->{recid}->[0];
866 my $work_title = $hit->{'md-work-title'}->[0];
868 if (exists $hit->{'md-work-author'}) {
869 $work_author = $hit->{'md-work-author'}->[0];
871 my $group_label = (defined $work_author) ? "$work_title / $work_author" : $work_title;
873 my $result_group = {};
874 $result_group->{'group_label'} = $group_label;
875 $result_group->{'group_merge_key'} = $recid;
878 if (exists $hit->{count}) {
879 $count = $hit->{count}->[0];
881 $result_group->{'group_count'} = $count;
883 for (my $i = 0; $i < $count; $i++) {
884 # FIXME -- may need to worry about diacritics here
885 my $rec = $paz->record($recid, $i);
886 push @{ $result_group->{'RECORDS'} }, $rec;
889 push @{ $results_hashref->{'biblioserver'}->{'GROUPS'} }, $result_group;
892 # pass through facets
893 my $termlist_xml = $paz->termlist('author,subject');
894 my $terms = XMLin($termlist_xml, forcearray => 1);
895 my @facets_loop = ();
896 #die Dumper($results);
897 # foreach my $list (sort keys %{ $terms->{'list'} }) {
899 # foreach my $facet (sort @{ $terms->{'list'}->{$list}->{'term'} } ) {
901 # facet_label_value => $facet->{'name'}->[0],
904 # push @facets_loop, ( {
905 # type_label => $list,
906 # facets => \@facets,
910 return ( undef, $results_hashref, \@facets_loop );
914 sub _detect_truncation {
915 my ( $operand, $index ) = @_;
916 my ( @nontruncated, @righttruncated, @lefttruncated, @rightlefttruncated,
919 my @wordlist = split( /\s/, $operand );
920 foreach my $word (@wordlist) {
921 if ( $word =~ s/^\*([^\*]+)\*$/$1/ ) {
922 push @rightlefttruncated, $word;
924 elsif ( $word =~ s/^\*([^\*]+)$/$1/ ) {
925 push @lefttruncated, $word;
927 elsif ( $word =~ s/^([^\*]+)\*$/$1/ ) {
928 push @righttruncated, $word;
930 elsif ( index( $word, "*" ) < 0 ) {
931 push @nontruncated, $word;
934 push @regexpr, $word;
938 \@nontruncated, \@righttruncated, \@lefttruncated,
939 \@rightlefttruncated, \@regexpr
944 sub _build_stemmed_operand {
945 my ($operand,$lang) = @_;
946 require Lingua::Stem::Snowball ;
947 my $stemmed_operand=q{};
949 # If operand contains a digit, it is almost certainly an identifier, and should
950 # not be stemmed. This is particularly relevant for ISBNs and ISSNs, which
951 # can contain the letter "X" - for example, _build_stemmend_operand would reduce
952 # "014100018X" to "x ", which for a MARC21 database would bring up irrelevant
953 # results (e.g., "23 x 29 cm." from the 300$c). Bug 2098.
954 return $operand if $operand =~ /\d/;
956 # FIXME: the locale should be set based on the user's language and/or search choice
958 # Make sure we only use the first two letters from the language code
959 $lang = lc(substr($lang, 0, 2));
960 # The language codes for the two variants of Norwegian will now be "nb" and "nn",
961 # none of which Lingua::Stem::Snowball can use, so we need to "translate" them
962 if ($lang eq 'nb' || $lang eq 'nn') {
965 my $stemmer = Lingua::Stem::Snowball->new( lang => $lang,
966 encoding => "UTF-8" );
968 my @words = split( / /, $operand );
969 my @stems = $stemmer->stem(\@words);
970 for my $stem (@stems) {
971 $stemmed_operand .= "$stem";
972 $stemmed_operand .= "?"
973 unless ( $stem =~ /(and$|or$|not$)/ ) || ( length($stem) < 3 );
974 $stemmed_operand .= " ";
976 warn "STEMMED OPERAND: $stemmed_operand" if $DEBUG;
977 return $stemmed_operand;
981 sub _build_weighted_query {
983 # FIELD WEIGHTING - This is largely experimental stuff. What I'm committing works
984 # pretty well but could work much better if we had a smarter query parser
985 my ( $operand, $stemmed_operand, $index ) = @_;
986 my $stemming = C4::Context->preference("QueryStemming") || 0;
987 my $weight_fields = C4::Context->preference("QueryWeightFields") || 0;
988 my $fuzzy_enabled = C4::Context->preference("QueryFuzzy") || 0;
989 $operand =~ s/"/ /g; # Bug 7518: searches with quotation marks don't work
991 my $weighted_query .= "(rk=("; # Specifies that we're applying rank
993 # Keyword, or, no index specified
994 if ( ( $index eq 'kw' ) || ( !$index ) ) {
996 "Title-cover,ext,r1=\"$operand\""; # exact title-cover
997 $weighted_query .= " or ti,ext,r2=\"$operand\""; # exact title
998 $weighted_query .= " or Title-cover,phr,r3=\"$operand\""; # phrase title
999 $weighted_query .= " or ti,wrdl,r4=\"$operand\""; # words in title
1000 #$weighted_query .= " or any,ext,r4=$operand"; # exact any
1001 #$weighted_query .=" or kw,wrdl,r5=\"$operand\""; # word list any
1002 $weighted_query .= " or wrdl,fuzzy,r8=\"$operand\""
1003 if $fuzzy_enabled; # add fuzzy, word list
1004 $weighted_query .= " or wrdl,right-Truncation,r9=\"$stemmed_operand\""
1005 if ( $stemming and $stemmed_operand )
1006 ; # add stemming, right truncation
1007 $weighted_query .= " or wrdl,r9=\"$operand\"";
1009 # embedded sorting: 0 a-z; 1 z-a
1010 # $weighted_query .= ") or (sort1,aut=1";
1013 # Barcode searches should skip this process
1014 elsif ( $index eq 'bc' ) {
1015 $weighted_query .= "bc=\"$operand\"";
1018 # Authority-number searches should skip this process
1019 elsif ( $index eq 'an' ) {
1020 $weighted_query .= "an=\"$operand\"";
1023 # If the index is numeric, don't autoquote it.
1024 elsif ( $index =~ /,st-numeric$/ ) {
1025 $weighted_query .= " $index=$operand";
1028 # If the index already has more than one qualifier, wrap the operand
1029 # in quotes and pass it back (assumption is that the user knows what they
1030 # are doing and won't appreciate us mucking up their query
1031 elsif ( $index =~ ',' ) {
1032 $weighted_query .= " $index=\"$operand\"";
1035 #TODO: build better cases based on specific search indexes
1037 $weighted_query .= " $index,ext,r1=\"$operand\""; # exact index
1038 #$weighted_query .= " or (title-sort-az=0 or $index,startswithnt,st-word,r3=$operand #)";
1039 $weighted_query .= " or $index,phr,r3=\"$operand\""; # phrase index
1040 $weighted_query .= " or $index,wrdl,r6=\"$operand\""; # word list index
1041 $weighted_query .= " or $index,wrdl,fuzzy,r8=\"$operand\""
1042 if $fuzzy_enabled; # add fuzzy, word list
1043 $weighted_query .= " or $index,wrdl,rt,r9=\"$stemmed_operand\""
1044 if ( $stemming and $stemmed_operand ); # add stemming, right truncation
1047 $weighted_query .= "))"; # close rank specification
1048 return $weighted_query;
1053 Return an array with available indexes.
1075 'Author-personal-bibliography',
1085 'Chronological-subdivision',
1095 'Conference-name-heading',
1096 'Conference-name-see',
1097 'Conference-name-seealso',
1102 'Corporate-name-heading',
1103 'Corporate-name-see',
1104 'Corporate-name-seealso',
1105 'Country-publication',
1108 'date-entered-on-file',
1109 'Date-of-acquisition',
1110 'Date-of-publication',
1111 'Date-time-last-modified',
1112 'Dewey-classification',
1113 'Dissertation-information',
1122 'Geographic-subdivision',
1125 'Heading-use-main-or-added-entry',
1126 'Heading-use-series-added-entry ',
1127 'Heading-use-subject-added-entry',
1130 'Illustration-code',
1132 'Index-term-uncontrolled',
1133 'Interest-age-level',
1134 'Interest-grade-level',
1144 'language-original',
1154 'Local-classification',
1157 'Match-heading-see-from',
1165 'Name-geographic-heading',
1166 'Name-geographic-see',
1167 'Name-geographic-seealso',
1175 'Personal-name-heading',
1176 'Personal-name-see',
1177 'Personal-name-seealso',
1179 'Place-publication',
1186 'Reading-grade-level',
1187 'Record-control-number',
1198 'Subject-heading-thesaurus',
1199 'Subject-name-personal',
1200 'Subject-subdivision',
1209 'Term-genre-form-heading',
1210 'Term-genre-form-see',
1211 'Term-genre-form-seealso',
1217 'Title-uniform-heading',
1218 'Title-uniform-see',
1219 'Title-uniform-seealso',
1229 'classification-source',
1231 'coded-location-qualifier',
1242 'Local-classification',
1245 'materials-specified',
1250 'Number-local-acquisition',
1255 'replacementpricedate',
1270 =head2 _handle_exploding_index
1272 my $query = _handle_exploding_index($index, $term)
1274 Callback routine to generate the search for "exploding" indexes (i.e.
1275 those indexes which are turned into multiple or-connected searches based
1280 sub _handle_exploding_index {
1281 my ($QParser, $filter, $params, $negate, $server) = @_;
1282 my $index = $filter;
1283 my $term = join(' ', @$params);
1285 return unless ($index =~ m/(su-br|su-na|su-rl)/ && $term);
1287 my $marcflavour = C4::Context->preference('marcflavour');
1289 my $codesubfield = $marcflavour eq 'UNIMARC' ? '5' : 'w';
1290 my $wantedcodes = '';
1291 my @subqueries = ( "\@attr 1=Subject \@attr 4=1 \"$term\"");
1292 my ($error, $results, $total_hits) = SimpleSearch( "he:$term", undef, undef, [ "authorityserver" ] );
1293 foreach my $auth (@$results) {
1294 my $record = MARC::Record->new_from_usmarc($auth);
1295 my @references = $record->field('5..');
1297 if ($index eq 'su-br') {
1299 } elsif ($index eq 'su-na') {
1301 } elsif ($index eq 'su-rl') {
1304 foreach my $reference (@references) {
1305 my $codes = $reference->subfield($codesubfield);
1306 push @subqueries, '@attr 1=Subject @attr 4=1 "' . $reference->as_string('abcdefghijlmnopqrstuvxyz') . '"' if (($codes && $codes eq $wantedcodes) || !$wantedcodes);
1310 my $query = ' @or ' x (scalar(@subqueries) - 1) . join(' ', @subqueries);
1316 ( $operators, $operands, $indexes, $limits,
1317 $sort_by, $scan, $lang ) =
1318 buildQuery ( $operators, $operands, $indexes, $limits, $sort_by, $scan, $lang);
1320 Shim function to ease the transition from buildQuery to a new QueryParser.
1321 This function is called at the beginning of buildQuery, and modifies
1322 buildQuery's input. If it can handle the input, it returns a query that
1323 buildQuery will not try to parse.
1327 my ( $operators, $operands, $indexes, $limits, $sort_by, $scan, $lang) = @_;
1329 my @operators = $operators ? @$operators : ();
1330 my @indexes = $indexes ? @$indexes : ();
1331 my @operands = $operands ? @$operands : ();
1332 my @limits = $limits ? @$limits : ();
1333 my @sort_by = $sort_by ? @$sort_by : ();
1335 my $query = $operands[0];
1341 $QParser = C4::Context->queryparser if (C4::Context->preference('UseQueryParser') || $query =~ s/^qp=//);
1342 undef $QParser if ($query =~ m/^(ccl=|pqf=|cql=)/ || grep (/\w,\w|\w=\w/, @operands, @indexes) );
1343 undef $QParser if (scalar @limits > 0);
1347 $QParser->custom_data->{'QueryAutoTruncate'} = C4::Context->preference('QueryAutoTruncate');
1349 for ( my $ii = 0 ; $ii <= @operands ; $ii++ ) {
1350 next unless $operands[$ii];
1351 $query .= $operators[ $ii - 1 ] eq 'or' ? ' || ' : ' && '
1353 if ( $operands[$ii] =~ /^[^"]\W*[-|_\w]*:\w.*[^"]$/ ) {
1354 $query .= $operands[$ii];
1356 elsif ( $indexes[$ii] =~ m/su-/ ) {
1357 $query .= $indexes[$ii] . '(' . $operands[$ii] . ')';
1361 ( $indexes[$ii] ? "$indexes[$ii]:" : '' ) . $operands[$ii];
1364 foreach my $limit (@limits) {
1366 if ( scalar(@sort_by) > 0 ) {
1368 '#(' . join( '|', @{ $QParser->modifiers } ) . ')';
1369 $query =~ s/$modifier_re//g;
1370 foreach my $modifier (@sort_by) {
1371 $query .= " #$modifier";
1375 $query_desc = $query;
1376 $query_desc =~ s/\s+/ /g;
1377 if ( C4::Context->preference("QueryWeightFields") ) {
1379 $QParser->add_bib1_filter_map( 'su-br' => 'biblioserver' =>
1380 { 'target_syntax_callback' => \&_handle_exploding_index } );
1381 $QParser->add_bib1_filter_map( 'su-na' => 'biblioserver' =>
1382 { 'target_syntax_callback' => \&_handle_exploding_index } );
1383 $QParser->add_bib1_filter_map( 'su-rl' => 'biblioserver' =>
1384 { 'target_syntax_callback' => \&_handle_exploding_index } );
1385 $QParser->parse($query);
1386 $operands[0] = "pqf=" . $QParser->target_syntax('biblioserver');
1389 require Koha::QueryParser::Driver::PQF;
1390 my $modifier_re = '#(' . join( '|', @{Koha::QueryParser::Driver::PQF->modifiers}) . ')';
1391 s/$modifier_re//g for @operands;
1394 return ( $operators, \@operands, $indexes, $limits, $sort_by, $scan, $lang, $query_desc);
1400 $simple_query, $query_cgi,
1401 $query_desc, $limit,
1402 $limit_cgi, $limit_desc,
1403 $query_type ) = buildQuery ( $operators, $operands, $indexes, $limits, $sort_by, $scan, $lang);
1405 Build queries and limits in CCL, CGI, Human,
1406 handle truncation, stemming, field weighting, fuzziness, etc.
1408 See verbose embedded documentation.
1414 my ( $operators, $operands, $indexes, $limits, $sort_by, $scan, $lang) = @_;
1416 warn "---------\nEnter buildQuery\n---------" if $DEBUG;
1419 ( $operators, $operands, $indexes, $limits, $sort_by, $scan, $lang, $query_desc) = parseQuery($operators, $operands, $indexes, $limits, $sort_by, $scan, $lang);
1422 my @operators = $operators ? @$operators : ();
1423 my @indexes = $indexes ? @$indexes : ();
1424 my @operands = $operands ? @$operands : ();
1425 my @limits = $limits ? @$limits : ();
1426 my @sort_by = $sort_by ? @$sort_by : ();
1428 my $stemming = C4::Context->preference("QueryStemming") || 0;
1429 my $auto_truncation = C4::Context->preference("QueryAutoTruncate") || 0;
1430 my $weight_fields = C4::Context->preference("QueryWeightFields") || 0;
1431 my $fuzzy_enabled = C4::Context->preference("QueryFuzzy") || 0;
1433 my $query = $operands[0];
1434 my $simple_query = $operands[0];
1436 # initialize the variables we're passing back
1445 my $cclindexes = getIndexes();
1446 if ( $query !~ /\s*(ccl=|pqf=|cql=)/ ) {
1447 while ( !$cclq && $query =~ /(?:^|\W)([\w-]+)(,[\w-]+)*[:=]/g ) {
1449 $cclq = grep { lc($_) eq $dx } @$cclindexes;
1451 $query = "ccl=$query" if $cclq;
1454 # for handling ccl, cql, pqf queries in diagnostic mode, skip the rest of the steps
1456 if ( $query =~ /^ccl=/ ) {
1458 # This is needed otherwise ccl= and &limit won't work together, and
1459 # this happens when selecting a subject on the opac-detail page
1460 @limits = grep {!/^$/} @limits;
1462 $q .= ' and '.join(' and ', @limits);
1464 return ( undef, $q, $q, "q=ccl=".uri_escape_utf8($q), $q, '', '', '', 'ccl' );
1466 if ( $query =~ /^cql=/ ) {
1467 return ( undef, $', $', "q=cql=".uri_escape_utf8($'), $', '', '', '', 'cql' );
1469 if ( $query =~ /^pqf=/ ) {
1471 $query_cgi = "q=".uri_escape_utf8($query_desc);
1474 $query_cgi = "q=pqf=".uri_escape_utf8($');
1476 return ( undef, $', $', $query_cgi, $query_desc, '', '', '', 'pqf' );
1479 # pass nested queries directly
1480 # FIXME: need better handling of some of these variables in this case
1481 # Nested queries aren't handled well and this implementation is flawed and causes users to be
1482 # unable to search for anything containing () commenting out, will be rewritten for 3.4.0
1483 # if ( $query =~ /(\(|\))/ ) {
1485 # undef, $query, $simple_query, $query_cgi,
1486 # $query, $limit, $limit_cgi, $limit_desc,
1491 # Form-based queries are non-nested and fixed depth, so we can easily modify the incoming
1492 # query operands and indexes and add stemming, truncation, field weighting, etc.
1493 # Once we do so, we'll end up with a value in $query, just like if we had an
1494 # incoming $query from the user
1497 ; # clear it out so we can populate properly with field-weighted, stemmed, etc. query
1498 my $previous_operand
1499 ; # a flag used to keep track if there was a previous query
1500 # if there was, we can apply the current operator
1502 for ( my $i = 0 ; $i <= @operands ; $i++ ) {
1504 # COMBINE OPERANDS, INDEXES AND OPERATORS
1505 if ( $operands[$i] ) {
1506 $operands[$i]=~s/^\s+//;
1508 # A flag to determine whether or not to add the index to the query
1511 # If the user is sophisticated enough to specify an index, turn off field weighting, and stemming handling
1512 if ( $operands[$i] =~ /\w(:|=)/ || $scan ) {
1516 $operands[$i] =~ s/\?/{?}/g; # need to escape question marks
1518 my $operand = $operands[$i];
1519 my $index = $indexes[$i];
1521 # Add index-specific attributes
1523 #Afaik, this 'yr' condition will only ever be met in the staff client advanced search
1524 #for "Publication date", since typing 'yr:YYYY' into the search box produces a CCL query,
1525 #which is processed higher up in this sub. Other than that, year searches are typically
1526 #handled as limits which are not processed her either.
1528 # Search ranges: Date of Publication, st-numeric
1529 if ( $index =~ /(yr|st-numeric)/ ) {
1530 #weight_fields/relevance search causes errors with date ranges
1531 #In the case of YYYY-, it will only return records with a 'yr' of YYYY (not the range)
1532 #In the case of YYYY-YYYY, it will return no results
1533 $stemming = $auto_truncation = $weight_fields = $fuzzy_enabled = 0;
1536 # Date of Acquisition
1537 elsif ( $index =~ /acqdate/ ) {
1538 #stemming and auto_truncation would have zero impact since it already is YYYY-MM-DD format
1539 #Weight_fields probably SHOULD be turned OFF, otherwise you'll get records floating to the
1540 #top of the results just because they have lots of item records matching that date.
1541 #Fuzzy actually only applies during _build_weighted_query, and is reset there anyway, so
1543 $stemming = $auto_truncation = $weight_fields = $fuzzy_enabled = 0;
1545 # ISBN,ISSN,Standard Number, don't need special treatment
1546 elsif ( $index eq 'nb' || $index eq 'ns' ) {
1548 $stemming, $auto_truncation,
1549 $weight_fields, $fuzzy_enabled
1552 if ( $index eq 'nb' ) {
1553 if ( C4::Context->preference("SearchWithISBNVariations") ) {
1554 my @isbns = C4::Koha::GetVariationsOfISBN( $operand );
1555 $operands[$i] = $operand = '(nb=' . join(' OR nb=', @isbns) . ')';
1556 $indexes[$i] = $index = '';
1565 # Set default structure attribute (word list)
1566 my $struct_attr = q{};
1567 unless ( $indexes_set || !$index || $index =~ /,(st-|phr|ext|wrdl)/ || $index =~ /^(nb|ns)$/ ) {
1568 $struct_attr = ",wrdl";
1571 # Some helpful index variants
1572 my $index_plus = $index . $struct_attr . ':';
1573 my $index_plus_comma = $index . $struct_attr . ',';
1575 if ($auto_truncation){
1576 unless ( $index =~ /,(st-|phr|ext)/ ) {
1577 #FIXME only valid with LTR scripts
1578 $operand=join(" ",map{
1579 (index($_,"*")>0?"$_":"$_*")
1580 }split (/\s+/,$operand));
1581 warn $operand if $DEBUG;
1586 my $truncated_operand;
1587 my( $nontruncated, $righttruncated, $lefttruncated,
1588 $rightlefttruncated, $regexpr
1589 ) = _detect_truncation( $operand, $index );
1591 "TRUNCATION: NON:>@$nontruncated< RIGHT:>@$righttruncated< LEFT:>@$lefttruncated< RIGHTLEFT:>@$rightlefttruncated< REGEX:>@$regexpr<"
1596 scalar(@$righttruncated) + scalar(@$lefttruncated) +
1597 scalar(@$rightlefttruncated) > 0 )
1600 # Don't field weight or add the index to the query, we do it here
1602 undef $weight_fields;
1603 my $previous_truncation_operand;
1604 if (scalar @$nontruncated) {
1605 $truncated_operand .= "$index_plus @$nontruncated ";
1606 $previous_truncation_operand = 1;
1608 if (scalar @$righttruncated) {
1609 $truncated_operand .= "and " if $previous_truncation_operand;
1610 $truncated_operand .= $index_plus_comma . "rtrn:@$righttruncated ";
1611 $previous_truncation_operand = 1;
1613 if (scalar @$lefttruncated) {
1614 $truncated_operand .= "and " if $previous_truncation_operand;
1615 $truncated_operand .= $index_plus_comma . "ltrn:@$lefttruncated ";
1616 $previous_truncation_operand = 1;
1618 if (scalar @$rightlefttruncated) {
1619 $truncated_operand .= "and " if $previous_truncation_operand;
1620 $truncated_operand .= $index_plus_comma . "rltrn:@$rightlefttruncated ";
1621 $previous_truncation_operand = 1;
1624 $operand = $truncated_operand if $truncated_operand;
1625 warn "TRUNCATED OPERAND: >$truncated_operand<" if $DEBUG;
1628 my $stemmed_operand;
1629 $stemmed_operand = _build_stemmed_operand($operand, $lang)
1632 warn "STEMMED OPERAND: >$stemmed_operand<" if $DEBUG;
1634 # Handle Field Weighting
1635 my $weighted_operand;
1636 if ($weight_fields) {
1637 $weighted_operand = _build_weighted_query( $operand, $stemmed_operand, $index );
1638 $operand = $weighted_operand;
1642 warn "FIELD WEIGHTED OPERAND: >$weighted_operand<" if $DEBUG;
1644 ($query,$query_cgi,$query_desc,$previous_operand) = _build_initial_query({
1646 query_cgi => $query_cgi,
1647 query_desc => $query_desc,
1648 operator => ($operators[ $i - 1 ]) ? $operators[ $i - 1 ] : '',
1649 parsed_operand => $operand,
1650 original_operand => ($operands[$i]) ? $operands[$i] : '',
1652 index_plus => $index_plus,
1653 indexes_set => $indexes_set,
1654 previous_operand => $previous_operand,
1660 warn "QUERY BEFORE LIMITS: >$query<" if $DEBUG;
1663 my %group_OR_limits;
1664 my $availability_limit;
1665 foreach my $this_limit (@limits) {
1666 next unless $this_limit;
1667 if ( $this_limit =~ /available/ ) {
1669 ## 'available' is defined as (items.onloan is NULL) and (items.itemlost = 0)
1671 ## all records not indexed in the onloan register (zebra) and all records with a value of lost equal to 0
1672 $availability_limit .=
1673 "( ( allrecords,AlwaysMatches='' not onloan,AlwaysMatches='') and (lost,st-numeric=0) )"; #or ( allrecords,AlwaysMatches='' not lost,AlwaysMatches='')) )";
1674 $limit_cgi .= "&limit=available";
1678 # group_OR_limits, prefixed by mc-
1679 # OR every member of the group
1680 elsif ( $this_limit =~ /mc/ ) {
1681 my ($k,$v) = split(/:/, $this_limit,2);
1682 if ( $k !~ /mc-i(tem)?type/ ) {
1683 # in case the mc-ccode value has complicating chars like ()'s inside it we wrap in quotes
1684 $this_limit =~ tr/"//d;
1685 $this_limit = $k.":'".$v."'";
1688 $group_OR_limits{$k} .= " or " if $group_OR_limits{$k};
1689 $limit_desc .= " or " if $group_OR_limits{$k};
1690 $group_OR_limits{$k} .= "$this_limit";
1691 $limit_cgi .= "&limit=" . uri_escape_utf8($this_limit);
1692 $limit_desc .= " $this_limit";
1695 # Regular old limits
1697 $limit .= " and " if $limit || $query;
1698 $limit .= "$this_limit";
1699 $limit_cgi .= "&limit=" . uri_escape_utf8($this_limit);
1700 if ($this_limit =~ /^branch:(.+)/) {
1701 my $branchcode = $1;
1702 my $branchname = GetBranchName($branchcode);
1703 if (defined $branchname) {
1704 $limit_desc .= " branch:$branchname";
1706 $limit_desc .= " $this_limit";
1709 $limit_desc .= " $this_limit";
1713 foreach my $k (keys (%group_OR_limits)) {
1714 $limit .= " and " if ( $query || $limit );
1715 $limit .= "($group_OR_limits{$k})";
1717 if ($availability_limit) {
1718 $limit .= " and " if ( $query || $limit );
1719 $limit .= "($availability_limit)";
1722 # Normalize the query and limit strings
1723 # This is flawed , means we can't search anything with : in it
1724 # if user wants to do ccl or cql, start the query with that
1725 # $query =~ s/:/=/g;
1726 #NOTE: We use several several different regexps here as you can't have variable length lookback assertions
1727 $query =~ s/(?<=(ti|au|pb|su|an|kw|mc|nb|ns)):/=/g;
1728 $query =~ s/(?<=(wrdl)):/=/g;
1729 $query =~ s/(?<=(trn|phr)):/=/g;
1730 $query =~ s/(?<=(st-numeric)):/=/g;
1731 $query =~ s/(?<=(st-year)):/=/g;
1732 $query =~ s/(?<=(st-date-normalized)):/=/g;
1734 for ( $query, $query_desc, $limit, $limit_desc ) {
1735 s/ +/ /g; # remove extra spaces
1736 s/^ //g; # remove any beginning spaces
1737 s/ $//g; # remove any ending spaces
1738 s/==/=/g; # remove double == from query
1740 $query_cgi =~ s/^&//; # remove unnecessary & from beginning of the query cgi
1742 for ($query_cgi,$simple_query) {
1745 # append the limit to the query
1746 $query .= " " . $limit;
1750 warn "QUERY:" . $query;
1751 warn "QUERY CGI:" . $query_cgi;
1752 warn "QUERY DESC:" . $query_desc;
1753 warn "LIMIT:" . $limit;
1754 warn "LIMIT CGI:" . $limit_cgi;
1755 warn "LIMIT DESC:" . $limit_desc;
1756 warn "---------\nLeave buildQuery\n---------";
1760 undef, $query, $simple_query, $query_cgi,
1761 $query_desc, $limit, $limit_cgi, $limit_desc,
1766 =head2 _build_initial_query
1768 ($query, $query_cgi, $query_desc, $previous_operand) = _build_initial_query($initial_query_params);
1770 Build a section of the initial query containing indexes, operators, and operands.
1774 sub _build_initial_query {
1778 if ($params->{previous_operand}){
1779 #If there is a previous operand, add a supplied operator or the default 'and'
1780 $operator = ($params->{operator}) ? " ".($params->{operator})." " : ' and ';
1783 #NOTE: indexes_set is typically set when doing truncation or field weighting
1784 my $operand = ($params->{indexes_set}) ? $params->{parsed_operand} : $params->{index_plus}.$params->{parsed_operand};
1786 #e.g. "kw,wrdl:test"
1787 #e.g. " and kw,wrdl:test"
1788 $params->{query} .= $operator . $operand;
1790 $params->{query_cgi} .= "&op=".uri_escape_utf8($operator) if $operator;
1791 $params->{query_cgi} .= "&idx=".uri_escape_utf8($params->{index}) if $params->{index};
1792 $params->{query_cgi} .= "&q=".uri_escape_utf8($params->{original_operand}) if $params->{original_operand};
1794 #e.g. " and kw,wrdl: test"
1795 $params->{query_desc} .= $operator . $params->{index_plus} . " " . $params->{original_operand};
1797 $params->{previous_operand} = 1 unless $params->{previous_operand}; #If there is no previous operand, mark this as one
1799 return ($params->{query}, $params->{query_cgi}, $params->{query_desc}, $params->{previous_operand});
1802 =head2 searchResults
1804 my @search_results = searchResults($search_context, $searchdesc, $hits,
1805 $results_per_page, $offset, $scan,
1808 Format results in a form suitable for passing to the template
1812 # IMO this subroutine is pretty messy still -- it's responsible for
1813 # building the HTML output for the template
1815 my ( $search_context, $searchdesc, $hits, $results_per_page, $offset, $scan, $marcresults ) = @_;
1816 my $dbh = C4::Context->dbh;
1821 $search_context = 'opac' if !$search_context || $search_context ne 'intranet';
1822 my ($is_opac, $hidelostitems);
1823 if ($search_context eq 'opac') {
1824 $hidelostitems = C4::Context->preference('hidelostitems');
1828 #Build branchnames hash
1830 #get branch information.....
1832 my $bsth =$dbh->prepare("SELECT branchcode,branchname FROM branches"); # FIXME : use C4::Branch::GetBranches
1834 while ( my $bdata = $bsth->fetchrow_hashref ) {
1835 $branches{ $bdata->{'branchcode'} } = $bdata->{'branchname'};
1837 # FIXME - We build an authorised values hash here, using the default framework
1838 # though it is possible to have different authvals for different fws.
1840 my $shelflocations =GetKohaAuthorisedValues('items.location','');
1842 # get notforloan authorised value list (see $shelflocations FIXME)
1843 my $notforloan_authorised_value = GetAuthValCode('items.notforloan','');
1846 my %itemtypes = %{ GetItemTypes() };
1848 #search item field code
1849 my ($itemtag, undef) = &GetMarcFromKohaField( "items.itemnumber", "" );
1851 ## find column names of items related to MARC
1852 my %subfieldstosearch;
1853 my @columns = Koha::Database->new()->schema()->resultset('Item')->result_source->columns;
1854 for my $column ( @columns ) {
1855 my ( $tagfield, $tagsubfield ) =
1856 &GetMarcFromKohaField( "items." . $column, "" );
1857 if ( defined $tagsubfield ) {
1858 $subfieldstosearch{$column} = $tagsubfield;
1862 # handle which records to actually retrieve
1864 if ( $hits && $offset + $results_per_page <= $hits ) {
1865 $times = $offset + $results_per_page;
1868 $times = $hits; # FIXME: if $hits is undefined, why do we want to equal it?
1871 my $marcflavour = C4::Context->preference("marcflavour");
1872 # We get the biblionumber position in MARC
1873 my ($bibliotag,$bibliosubf)=GetMarcFromKohaField('biblio.biblionumber','');
1875 # loop through all of the records we've retrieved
1876 for ( my $i = $offset ; $i <= $times - 1 ; $i++ ) {
1880 # For Scan searches we built USMARC data
1881 $marcrecord = MARC::Record->new_from_usmarc( $marcresults->[$i]);
1883 # Normal search, render from Zebra's output
1884 $marcrecord = new_record_from_zebra(
1889 if ( ! defined $marcrecord ) {
1890 warn "ERROR DECODING RECORD - $@: " . $marcresults->[$i];
1898 ? GetFrameworkCode($marcrecord->field($bibliotag)->data)
1899 : GetFrameworkCode($marcrecord->subfield($bibliotag,$bibliosubf));
1901 SetUTF8Flag($marcrecord);
1902 my $oldbiblio = TransformMarcToKoha( $marcrecord, $fw );
1903 $oldbiblio->{subtitle} = GetRecordValue('subtitle', $marcrecord, $fw);
1904 $oldbiblio->{result_number} = $i + 1;
1906 # add imageurl to itemtype if there is one
1907 $oldbiblio->{imageurl} = getitemtypeimagelocation( $search_context, $itemtypes{ $oldbiblio->{itemtype} }->{imageurl} );
1909 $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 ) ) : [];
1910 $oldbiblio->{normalized_upc} = GetNormalizedUPC( $marcrecord,$marcflavour);
1911 $oldbiblio->{normalized_ean} = GetNormalizedEAN( $marcrecord,$marcflavour);
1912 $oldbiblio->{normalized_oclc} = GetNormalizedOCLCNumber($marcrecord,$marcflavour);
1913 $oldbiblio->{normalized_isbn} = GetNormalizedISBN(undef,$marcrecord,$marcflavour);
1914 $oldbiblio->{content_identifier_exists} = 1 if ($oldbiblio->{normalized_isbn} or $oldbiblio->{normalized_oclc} or $oldbiblio->{normalized_ean} or $oldbiblio->{normalized_upc});
1916 # edition information, if any
1917 $oldbiblio->{edition} = $oldbiblio->{editionstatement};
1918 $oldbiblio->{description} = $itemtypes{ $oldbiblio->{itemtype} }->{translated_description};
1919 # Build summary if there is one (the summary is defined in the itemtypes table)
1920 # FIXME: is this used anywhere, I think it can be commented out? -- JF
1921 if ( $itemtypes{ $oldbiblio->{itemtype} }->{summary} ) {
1922 my $summary = $itemtypes{ $oldbiblio->{itemtype} }->{summary};
1923 my @fields = $marcrecord->fields();
1926 foreach my $line ( "$summary\n" =~ /(.*)\n/g ){
1928 foreach my $tag ( $line =~ /\[(\d{3}[\w|\d])\]/ ) {
1929 $tag =~ /(.{3})(.)/;
1930 if($marcrecord->field($1)){
1931 my @abc = $marcrecord->field($1)->subfield($2);
1932 $tags->{$tag} = $#abc + 1 ;
1936 # We catch how many times to repeat this line
1938 foreach my $tag (keys(%$tags)){
1939 $max = $tags->{$tag} if($tags->{$tag} > $max);
1942 # we replace, and repeat each line
1943 for (my $i = 0 ; $i < $max ; $i++){
1944 my $newline = $line;
1946 foreach my $tag ( $newline =~ /\[(\d{3}[\w|\d])\]/g ) {
1947 $tag =~ /(.{3})(.)/;
1949 if($marcrecord->field($1)){
1950 my @repl = $marcrecord->field($1)->subfield($2);
1951 my $subfieldvalue = $repl[$i];
1952 $newline =~ s/\[$tag\]/$subfieldvalue/g;
1955 $newsummary .= "$newline\n";
1959 $newsummary =~ s/\[(.*?)]//g;
1960 $newsummary =~ s/\n/<br\/>/g;
1961 $oldbiblio->{summary} = $newsummary;
1964 # Pull out the items fields
1965 my @fields = $marcrecord->field($itemtag);
1966 my $marcflavor = C4::Context->preference("marcflavour");
1967 # adding linked items that belong to host records
1968 my $analyticsfield = '773';
1969 if ($marcflavor eq 'MARC21' || $marcflavor eq 'NORMARC') {
1970 $analyticsfield = '773';
1971 } elsif ($marcflavor eq 'UNIMARC') {
1972 $analyticsfield = '461';
1974 foreach my $hostfield ( $marcrecord->field($analyticsfield)) {
1975 my $hostbiblionumber = $hostfield->subfield("0");
1976 my $linkeditemnumber = $hostfield->subfield("9");
1977 if(!$hostbiblionumber eq undef){
1978 my $hostbiblio = GetMarcBiblio($hostbiblionumber, 1);
1979 my ($itemfield, undef) = GetMarcFromKohaField( 'items.itemnumber', GetFrameworkCode($hostbiblionumber) );
1980 if(!$hostbiblio eq undef){
1981 my @hostitems = $hostbiblio->field($itemfield);
1982 foreach my $hostitem (@hostitems){
1983 if ($hostitem->subfield("9") eq $linkeditemnumber){
1984 my $linkeditem =$hostitem;
1985 # append linked items if they exist
1986 if (!$linkeditem eq undef){
1987 push (@fields, $linkeditem);}
1994 # Setting item statuses for display
1995 my @available_items_loop;
1996 my @onloan_items_loop;
1997 my @other_items_loop;
1999 my $available_items;
2003 my $ordered_count = 0;
2004 my $available_count = 0;
2005 my $onloan_count = 0;
2006 my $longoverdue_count = 0;
2007 my $other_count = 0;
2008 my $withdrawn_count = 0;
2009 my $itemlost_count = 0;
2010 my $hideatopac_count = 0;
2011 my $itembinding_count = 0;
2012 my $itemdamaged_count = 0;
2013 my $item_in_transit_count = 0;
2014 my $can_place_holds = 0;
2015 my $item_onhold_count = 0;
2016 my $notforloan_count = 0;
2017 my $items_count = scalar(@fields);
2018 my $maxitems_pref = C4::Context->preference('maxItemsinSearchResults');
2019 my $maxitems = $maxitems_pref ? $maxitems_pref - 1 : 1;
2020 my @hiddenitems; # hidden itemnumbers based on OpacHiddenItems syspref
2022 # loop through every item
2023 foreach my $field (@fields) {
2026 # populate the items hash
2027 foreach my $code ( keys %subfieldstosearch ) {
2028 $item->{$code} = $field->subfield( $subfieldstosearch{$code} );
2030 $item->{description} = $itemtypes{ $item->{itype} }{translated_description};
2034 # hidden because lost
2035 if ($hidelostitems && $item->{itemlost}) {
2036 $hideatopac_count++;
2039 # hidden based on OpacHiddenItems syspref
2040 my @hi = C4::Items::GetHiddenItemnumbers($item);
2042 push @hiddenitems, @hi;
2043 $hideatopac_count++;
2048 my $hbranch = C4::Context->preference('StaffSearchResultsDisplayBranch');
2049 my $otherbranch = $hbranch eq 'homebranch' ? 'holdingbranch' : 'homebranch';
2051 # set item's branch name, use HomeOrHoldingBranch syspref first, fall back to the other one
2052 if ($item->{$hbranch}) {
2053 $item->{'branchname'} = $branches{$item->{$hbranch}};
2055 elsif ($item->{$otherbranch}) { # Last resort
2056 $item->{'branchname'} = $branches{$item->{$otherbranch}};
2059 my $prefix = $item->{$hbranch} . '--' . $item->{location} . $item->{itype} . $item->{itemcallnumber};
2060 # For each grouping of items (onloan, available, unavailable), we build a key to store relevant info about that item
2061 my $userenv = C4::Context->userenv;
2062 if ( $item->{onloan}
2063 && !( C4::Members::GetHideLostItemsPreference( $userenv->{'number'} ) && $item->{itemlost} ) )
2066 my $key = $prefix . $item->{onloan} . $item->{barcode};
2067 $onloan_items->{$key}->{due_date} = output_pref( { dt => dt_from_string( $item->{onloan} ), dateonly => 1 } );
2068 $onloan_items->{$key}->{count}++ if $item->{$hbranch};
2069 $onloan_items->{$key}->{branchname} = $item->{branchname};
2070 $onloan_items->{$key}->{location} = $shelflocations->{ $item->{location} };
2071 $onloan_items->{$key}->{itemcallnumber} = $item->{itemcallnumber};
2072 $onloan_items->{$key}->{description} = $item->{description};
2073 $onloan_items->{$key}->{imageurl} =
2074 getitemtypeimagelocation( $search_context, $itemtypes{ $item->{itype} }->{imageurl} );
2076 # if something's checked out and lost, mark it as 'long overdue'
2077 if ( $item->{itemlost} ) {
2078 $onloan_items->{$key}->{longoverdue}++;
2079 $longoverdue_count++;
2081 else { # can place holds as long as item isn't lost
2082 $can_place_holds = 1;
2086 # items not on loan, but still unavailable ( lost, withdrawn, damaged )
2089 $item->{notforloan}=1 if !$item->{notforloan} && $itemtypes{ C4::Context->preference("item-level_itypes")? $item->{itype}: $oldbiblio->{itemtype} }->{notforloan};
2092 if ( $item->{notforloan} < 0 ) {
2094 } elsif ( $item->{notforloan} > 0 ) {
2095 $notforloan_count++;
2098 # is item in transit?
2099 my $transfertwhen = '';
2100 my ($transfertfrom, $transfertto);
2102 # is item on the reserve shelf?
2103 my $reservestatus = '';
2105 unless ($item->{withdrawn}
2106 || $item->{itemlost}
2108 || $item->{notforloan}
2109 || ( C4::Context->preference('MaxSearchResultsItemsPerRecordStatusCheck')
2110 && $items_count > C4::Context->preference('MaxSearchResultsItemsPerRecordStatusCheck') ) ) {
2112 # A couple heuristics to limit how many times
2113 # we query the database for item transfer information, sacrificing
2114 # accuracy in some cases for speed;
2116 # 1. don't query if item has one of the other statuses
2117 # 2. don't check transit status if the bib has
2118 # more than 20 items
2120 # FIXME: to avoid having the query the database like this, and to make
2121 # the in transit status count as unavailable for search limiting,
2122 # should map transit status to record indexed in Zebra.
2124 ($transfertwhen, $transfertfrom, $transfertto) = C4::Circulation::GetTransfers($item->{itemnumber});
2125 $reservestatus = C4::Reserves::GetReserveStatus( $item->{itemnumber} );
2128 # item is withdrawn, lost, damaged, not for loan, reserved or in transit
2129 if ( $item->{withdrawn}
2130 || $item->{itemlost}
2132 || $item->{notforloan}
2133 || $reservestatus eq 'Waiting'
2134 || ($transfertwhen ne ''))
2136 $withdrawn_count++ if $item->{withdrawn};
2137 $itemlost_count++ if $item->{itemlost};
2138 $itemdamaged_count++ if $item->{damaged};
2139 $item_in_transit_count++ if $transfertwhen ne '';
2140 $item_onhold_count++ if $reservestatus eq 'Waiting';
2141 $item->{status} = $item->{withdrawn} . "-" . $item->{itemlost} . "-" . $item->{damaged} . "-" . $item->{notforloan};
2143 # can place a hold on a item if
2144 # not lost nor withdrawn
2145 # not damaged unless AllowHoldsOnDamagedItems is true
2146 # item is either for loan or on order (notforloan < 0)
2147 $can_place_holds = 1
2150 && !$item->{withdrawn}
2151 && ( !$item->{damaged} || C4::Context->preference('AllowHoldsOnDamagedItems') )
2152 && ( !$item->{notforloan} || $item->{notforloan} < 0 )
2157 my $key = $prefix . $item->{status};
2158 foreach (qw(withdrawn itemlost damaged branchname itemcallnumber)) {
2159 $other_items->{$key}->{$_} = $item->{$_};
2161 $other_items->{$key}->{intransit} = ( $transfertwhen ne '' ) ? 1 : 0;
2162 $other_items->{$key}->{onhold} = ($reservestatus) ? 1 : 0;
2163 $other_items->{$key}->{notforloan} = GetAuthorisedValueDesc('','',$item->{notforloan},'','',$notforloan_authorised_value) if $notforloan_authorised_value and $item->{notforloan};
2164 $other_items->{$key}->{count}++ if $item->{$hbranch};
2165 $other_items->{$key}->{location} = $shelflocations->{ $item->{location} };
2166 $other_items->{$key}->{description} = $item->{description};
2167 $other_items->{$key}->{imageurl} = getitemtypeimagelocation( $search_context, $itemtypes{ $item->{itype} }->{imageurl} );
2171 $can_place_holds = 1;
2173 $available_items->{$prefix}->{count}++ if $item->{$hbranch};
2174 foreach (qw(branchname itemcallnumber description)) {
2175 $available_items->{$prefix}->{$_} = $item->{$_};
2177 $available_items->{$prefix}->{location} = $shelflocations->{ $item->{location} };
2178 $available_items->{$prefix}->{imageurl} = getitemtypeimagelocation( $search_context, $itemtypes{ $item->{itype} }->{imageurl} );
2181 } # notforloan, item level and biblioitem level
2183 # if all items are hidden, do not show the record
2184 if ($items_count > 0 && $hideatopac_count == $items_count) {
2188 my ( $availableitemscount, $onloanitemscount, $otheritemscount );
2189 for my $key ( sort keys %$onloan_items ) {
2190 (++$onloanitemscount > $maxitems) and last;
2191 push @onloan_items_loop, $onloan_items->{$key};
2193 for my $key ( sort keys %$other_items ) {
2194 (++$otheritemscount > $maxitems) and last;
2195 push @other_items_loop, $other_items->{$key};
2197 for my $key ( sort keys %$available_items ) {
2198 (++$availableitemscount > $maxitems) and last;
2199 push @available_items_loop, $available_items->{$key}
2202 # XSLT processing of some stuff
2203 my $interface = $search_context eq 'opac' ? 'OPAC' : '';
2204 if (!$scan && C4::Context->preference($interface . "XSLTResultsDisplay")) {
2205 $oldbiblio->{XSLTResultsRecord} = XSLTParse4Display($oldbiblio->{biblionumber}, $marcrecord, $interface."XSLTResultsDisplay", 1, \@hiddenitems);
2206 # the last parameter tells Koha to clean up the problematic ampersand entities that Zebra outputs
2209 # if biblio level itypes are used and itemtype is notforloan, it can't be reserved either
2210 if (!C4::Context->preference("item-level_itypes")) {
2211 if ($itemtypes{ $oldbiblio->{itemtype} }->{notforloan}) {
2212 $can_place_holds = 0;
2215 $oldbiblio->{norequests} = 1 unless $can_place_holds;
2216 $oldbiblio->{itemsplural} = 1 if $items_count > 1;
2217 $oldbiblio->{items_count} = $items_count;
2218 $oldbiblio->{available_items_loop} = \@available_items_loop;
2219 $oldbiblio->{onloan_items_loop} = \@onloan_items_loop;
2220 $oldbiblio->{other_items_loop} = \@other_items_loop;
2221 $oldbiblio->{availablecount} = $available_count;
2222 $oldbiblio->{availableplural} = 1 if $available_count > 1;
2223 $oldbiblio->{onloancount} = $onloan_count;
2224 $oldbiblio->{onloanplural} = 1 if $onloan_count > 1;
2225 $oldbiblio->{othercount} = $other_count;
2226 $oldbiblio->{otherplural} = 1 if $other_count > 1;
2227 $oldbiblio->{withdrawncount} = $withdrawn_count;
2228 $oldbiblio->{itemlostcount} = $itemlost_count;
2229 $oldbiblio->{damagedcount} = $itemdamaged_count;
2230 $oldbiblio->{intransitcount} = $item_in_transit_count;
2231 $oldbiblio->{onholdcount} = $item_onhold_count;
2232 $oldbiblio->{orderedcount} = $ordered_count;
2233 $oldbiblio->{notforloancount} = $notforloan_count;
2235 if (C4::Context->preference("AlternateHoldingsField") && $items_count == 0) {
2236 my $fieldspec = C4::Context->preference("AlternateHoldingsField");
2237 my $subfields = substr $fieldspec, 3;
2238 my $holdingsep = C4::Context->preference("AlternateHoldingsSeparator") || ' ';
2239 my @alternateholdingsinfo = ();
2240 my @holdingsfields = $marcrecord->field(substr $fieldspec, 0, 3);
2241 my $alternateholdingscount = 0;
2243 for my $field (@holdingsfields) {
2244 my %holding = ( holding => '' );
2245 my $havesubfield = 0;
2246 for my $subfield ($field->subfields()) {
2247 if ((index $subfields, $$subfield[0]) >= 0) {
2248 $holding{'holding'} .= $holdingsep if (length $holding{'holding'} > 0);
2249 $holding{'holding'} .= $$subfield[1];
2253 if ($havesubfield) {
2254 push(@alternateholdingsinfo, \%holding);
2255 $alternateholdingscount++;
2259 $oldbiblio->{'ALTERNATEHOLDINGS'} = \@alternateholdingsinfo;
2260 $oldbiblio->{'alternateholdings_count'} = $alternateholdingscount;
2263 push( @newresults, $oldbiblio );
2269 =head2 SearchAcquisitions
2270 Search for acquisitions
2273 sub SearchAcquisitions{
2274 my ($datebegin, $dateend, $itemtypes,$criteria, $orderby) = @_;
2276 my $dbh=C4::Context->dbh;
2277 # Variable initialization
2281 LEFT JOIN biblioitems ON biblioitems.biblionumber=biblio.biblionumber
2282 LEFT JOIN items ON items.biblionumber=biblio.biblionumber
2283 WHERE dateaccessioned BETWEEN ? AND ?
2286 my (@params,@loopcriteria);
2288 push @params, $datebegin->output("iso");
2289 push @params, $dateend->output("iso");
2291 if (scalar(@$itemtypes)>0 and $criteria ne "itemtype" ){
2292 if(C4::Context->preference("item-level_itypes")){
2293 $str .= "AND items.itype IN (?".( ',?' x scalar @$itemtypes - 1 ).") ";
2295 $str .= "AND biblioitems.itemtype IN (?".( ',?' x scalar @$itemtypes - 1 ).") ";
2297 push @params, @$itemtypes;
2300 if ($criteria =~/itemtype/){
2301 if(C4::Context->preference("item-level_itypes")){
2302 $str .= "AND items.itype=? ";
2304 $str .= "AND biblioitems.itemtype=? ";
2307 if(scalar(@$itemtypes) == 0){
2308 my $itypes = GetItemTypes();
2309 for my $key (keys %$itypes){
2310 push @$itemtypes, $key;
2314 @loopcriteria= @$itemtypes;
2315 }elsif ($criteria=~/itemcallnumber/){
2316 $str .= "AND (items.itemcallnumber LIKE CONCAT(?,'%')
2317 OR items.itemcallnumber is NULL
2318 OR items.itemcallnumber = '')";
2320 @loopcriteria = ("AA".."ZZ", "") unless (scalar(@loopcriteria)>0);
2322 $str .= "AND biblio.title LIKE CONCAT(?,'%') ";
2323 @loopcriteria = ("A".."z") unless (scalar(@loopcriteria)>0);
2326 if ($orderby =~ /date_desc/){
2327 $str.=" ORDER BY dateaccessioned DESC";
2329 $str.=" ORDER BY title";
2332 my $qdataacquisitions=$dbh->prepare($str);
2334 my @loopacquisitions;
2335 foreach my $value(@loopcriteria){
2336 push @params,$value;
2338 $cell{"title"}=$value;
2339 $cell{"titlecode"}=$value;
2341 eval{$qdataacquisitions->execute(@params);};
2343 if ($@){ warn "recentacquisitions Error :$@";}
2346 while (my $data=$qdataacquisitions->fetchrow_hashref){
2347 push @loopdata, {"summary"=>GetBiblioSummary( $data->{'marcxml'} ) };
2349 $cell{"loopdata"}=\@loopdata;
2351 push @loopacquisitions,\%cell if (scalar(@{$cell{loopdata}})>0);
2354 $qdataacquisitions->finish;
2355 return \@loopacquisitions;
2358 =head2 enabled_staff_search_views
2360 %hash = enabled_staff_search_views()
2362 This function returns a hash that contains three flags obtained from the system
2363 preferences, used to determine whether a particular staff search results view
2368 =item C<Output arg:>
2370 * $hash{can_view_MARC} is true only if the MARC view is enabled
2371 * $hash{can_view_ISBD} is true only if the ISBD view is enabled
2372 * $hash{can_view_labeledMARC} is true only if the Labeled MARC view is enabled
2374 =item C<usage in the script:>
2378 $template->param ( C4::Search::enabled_staff_search_views );
2382 sub enabled_staff_search_views
2385 can_view_MARC => C4::Context->preference('viewMARC'), # 1 if the staff search allows the MARC view
2386 can_view_ISBD => C4::Context->preference('viewISBD'), # 1 if the staff search allows the ISBD view
2387 can_view_labeledMARC => C4::Context->preference('viewLabeledMARC'), # 1 if the staff search allows the Labeled MARC view
2391 =head2 z3950_search_args
2393 $arrayref = z3950_search_args($matchpoints)
2395 This function returns an array reference that contains the search parameters to be
2396 passed to the Z39.50 search script (z3950_search.pl). The array elements
2397 are hash refs whose keys are name and value, and whose values are the
2398 name of a search parameter, the value of that search parameter and the URL encoded
2399 value of that parameter.
2401 The search parameter names are lccn, isbn, issn, title, author, dewey and subject.
2403 The search parameter values are obtained from the bibliographic record whose
2404 data is in a hash reference in $matchpoints, as returned by Biblio::GetBiblioData().
2406 If $matchpoints is a scalar, it is assumed to be an unnamed query descriptor, e.g.
2407 a general purpose search argument. In this case, the returned array contains only
2408 entry: the key is 'title' and the value is derived from $matchpoints.
2410 If a search parameter value is undefined or empty, it is not included in the returned
2413 The returned array reference may be passed directly to the template parameters.
2417 =item C<Output arg:>
2419 * $array containing hash refs as described above
2421 =item C<usage in the script:>
2425 $data = Biblio::GetBiblioData($bibno);
2426 $template->param ( MYLOOP => C4::Search::z3950_search_args($data) )
2430 $template->param ( MYLOOP => C4::Search::z3950_search_args($searchscalar) )
2434 sub z3950_search_args {
2437 my $isbn_string = ref( $bibrec ) ? $bibrec->{title} : $bibrec;
2438 my $isbn = Business::ISBN->new( $isbn_string );
2440 if (defined $isbn && $isbn->is_valid)
2442 if ( ref($bibrec) ) {
2443 $bibrec->{isbn} = $isbn_string;
2444 $bibrec->{title} = undef;
2446 $bibrec = { isbn => $isbn_string };
2450 $bibrec = { title => $bibrec } if !ref $bibrec;
2453 for my $field (qw/ lccn isbn issn title author dewey subject /)
2455 push @$array, { name => $field, value => $bibrec->{$field} }
2456 if defined $bibrec->{$field};
2461 =head2 GetDistinctValues($field);
2463 C<$field> is a reference to the fields array
2467 sub GetDistinctValues {
2468 my ($fieldname,$string)=@_;
2469 # returns a reference to a hash of references to branches...
2470 if ($fieldname=~/\./){
2471 my ($table,$column)=split /\./, $fieldname;
2472 my $dbh = C4::Context->dbh;
2473 warn "select DISTINCT($column) as value, count(*) as cnt from $table group by lib order by $column " if $DEBUG;
2474 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 ");
2476 my $elements=$sth->fetchall_arrayref({});
2481 my @servers=qw<biblioserver authorityserver>;
2482 my (@zconns,@results);
2483 for ( my $i = 0 ; $i < @servers ; $i++ ) {
2484 $zconns[$i] = C4::Context->Zconn( $servers[$i], 1 );
2487 ZOOM::Query::CCL2RPN->new( qq"$fieldname $string", $zconns[$i])
2490 # The big moment: asynchronously retrieve results from all servers
2496 my ( $i, $size ) = @_;
2497 for ( my $j = 0 ; $j < $size ; $j++ ) {
2499 @hashscan{qw(value cnt)} =
2500 $results[ $i - 1 ]->display_term($j);
2501 push @elements, \%hashscan;
2509 =head2 _ZOOM_event_loop
2511 _ZOOM_event_loop(\@zconns, \@results, sub {
2512 my ( $i, $size ) = @_;
2516 Processes a ZOOM event loop and passes control to a closure for
2517 processing the results, and destroying the resultsets.
2521 sub _ZOOM_event_loop {
2522 my ($zconns, $results, $callback) = @_;
2523 while ( ( my $i = ZOOM::event( $zconns ) ) != 0 ) {
2524 my $ev = $zconns->[ $i - 1 ]->last_event();
2525 if ( $ev == ZOOM::Event::ZEND ) {
2526 next unless $results->[ $i - 1 ];
2527 my $size = $results->[ $i - 1 ]->size();
2529 $callback->($i, $size);
2534 foreach my $result (@$results) {
2539 =head2 new_record_from_searchengine
2541 Given raw data from a searchengine result set, return a MARC::Record object
2543 This helper function is needed to take into account all the involved
2544 system preferences and configuration variables to properly create the
2545 MARC::Record object.
2547 If we are using GRS-1, then the raw data we get from Zebra should be USMARC
2548 data. If we are using DOM, then it has to be MARCXML.
2550 If we are using elasticsearch, it'll already be a MARC::Record.
2554 sub new_record_from_zebra {
2557 my $raw_data = shift;
2558 # Set the default indexing modes
2559 my $index_mode = ( $server eq 'biblioserver' )
2560 ? C4::Context->config('zebra_bib_index_mode') // 'dom'
2561 : C4::Context->config('zebra_auth_index_mode') // 'dom';
2562 my $search_engine = C4::Context->preference("SearchEngine");
2563 if ($search_engine eq 'Elasticsearch') {
2567 my $marc_record = eval {
2568 if ( $index_mode eq 'dom' ) {
2569 MARC::Record->new_from_xml( $raw_data, 'UTF-8' );
2571 MARC::Record->new_from_usmarc( $raw_data );
2578 return $marc_record;
2583 END { } # module clean-up code here (global destructor)
2590 Koha Development Team <http://koha-community.org/>