3 # This file is part of Koha.
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
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.
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
19 #use warnings; FIXME - Bug 2505
22 use C4::Biblio; # GetMarcFromKohaField, GetBiblioData
23 use C4::Koha; # getFacets
25 use C4::Search::PazPar2;
27 use C4::Dates qw(format_date);
28 use C4::Members qw(GetHideLostItemsPreference);
31 use C4::Reserves; # GetReserveStatus
40 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $DEBUG);
42 # set the version for version checking
44 $VERSION = 3.07.00.049;
45 $DEBUG = ($ENV{DEBUG}) ? 1 : 0;
50 C4::Search - Functions for searching the Koha catalog.
54 See opac/opac-search.pl or catalogue/search.pl for example of usage
58 This module provides searching functions for Koha's bibliographic databases
72 &enabled_staff_search_views
76 # make all your functions, whether exported or not;
80 ($biblionumber,$biblionumber,$title) = FindDuplicate($record);
82 This function attempts to find duplicate records using a hard-coded, fairly simplistic algorithm
88 my $dbh = C4::Context->dbh;
89 my $result = TransformMarcToKoha( $dbh, $record, '' );
94 my ( $biblionumber, $title );
96 # search duplicate on ISBN, easy and fast..
98 if ( $result->{isbn} ) {
99 $result->{isbn} =~ s/\(.*$//;
100 $result->{isbn} =~ s/\s+$//;
101 $query = "isbn:$result->{isbn}";
105 $QParser = C4::Context->queryparser if (C4::Context->preference('UseQueryParser'));
111 $titleindex = 'title|exact';
112 $authorindex = 'author|exact';
114 $QParser->custom_data->{'QueryAutoTruncate'} = C4::Context->preference('QueryAutoTruncate');
116 $titleindex = 'ti,ext';
117 $authorindex = 'au,ext';
121 $result->{title} =~ s /\\//g;
122 $result->{title} =~ s /\"//g;
123 $result->{title} =~ s /\(//g;
124 $result->{title} =~ s /\)//g;
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;
136 # remove valid operators
137 $result->{author} =~ s/(and|or|not)//g;
138 $query .= " $op $authorindex:\"$result->{author}\"";
142 my ( $error, $searchresults, undef ) = SimpleSearch($query); # FIXME :: hardcoded !
144 if (!defined $error) {
145 foreach my $possible_duplicate_record (@{$searchresults}) {
146 my $marcrecord = new_record_from_zebra(
148 $possible_duplicate_record
151 my $result = TransformMarcToKoha( $dbh, $marcrecord, '' );
153 # FIXME :: why 2 $biblionumber ?
155 push @results, $result->{'biblionumber'};
156 push @results, $result->{'title'};
165 ( $error, $results, $total_hits ) = SimpleSearch( $query, $offset, $max_results, [@servers] );
167 This function provides a simple search API on the bibliographic catalog
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.
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
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
189 =item C<usage in the script:>
193 my ( $error, $marcresults, $total_hits ) = SimpleSearch($query);
195 if (defined $error) {
196 $template->param(query_error => $error);
197 warn "error: ".$error;
198 output_html_with_http_headers $input, $cookie, $template->output;
202 my $hits = @{$marcresults};
205 for my $r ( @{$marcresults} ) {
206 my $marcrecord = MARC::File::USMARC::decode($r);
207 my $biblio = TransformMarcToKoha(C4::Context->dbh,$marcrecord,q{});
209 #build the iarray of hashs for the template.
211 title => $biblio->{'title'},
212 subtitle => $biblio->{'subtitle'},
213 biblionumber => $biblio->{'biblionumber'},
214 author => $biblio->{'author'},
215 publishercode => $biblio->{'publishercode'},
216 publicationyear => $biblio->{'publicationyear'},
221 $template->param(result=>\@results);
226 my ( $query, $offset, $max_results, $servers ) = @_;
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' );
238 $QParser = C4::Context->queryparser if (C4::Context->preference('UseQueryParser') && ! ($query =~ m/\w,\w|\w=\w/));
240 $QParser->custom_data->{'QueryAutoTruncate'} = C4::Context->preference('QueryAutoTruncate');
243 # Initialize & Search Zebra
244 for ( my $i = 0 ; $i < @servers ; $i++ ) {
246 $zconns[$i] = C4::Context->Zconn( $servers[$i], 1 );
249 $QParser->parse( $query );
250 $query = $QParser->target_syntax($servers[$i]);
251 $zoom_queries[$i] = new ZOOM::Query::PQF( $query, $zconns[$i]);
254 $zoom_queries[$i] = new ZOOM::Query::CCL2RPN( $query, $zconns[$i]);
256 $tmpresults[$i] = $zconns[$i]->search( $zoom_queries[$i] );
260 $zconns[$i]->errmsg() . " ("
261 . $zconns[$i]->errcode() . ") "
262 . $zconns[$i]->addinfo() . " "
263 . $zconns[$i]->diagset();
265 return ( $error, undef, undef ) if $zconns[$i]->errcode();
269 # caught a ZOOM::Exception
273 . $@->addinfo() . " "
275 warn $error." for query: $query";
276 return ( $error, undef, undef );
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;
293 for my $j ( $first_record .. $last_record ) {
295 $tmpresults[ $i - 1 ]->record( $j - 1 )->raw()
298 push @{$results}, $record if defined $record;
303 foreach my $zoom_query (@zoom_queries) {
304 $zoom_query->destroy();
307 return ( undef, $results, $total_hits );
312 ( undef, $results_hashref, \@facets_loop ) = getRecords (
314 $koha_query, $simple_query, $sort_by_ref, $servers_ref,
315 $results_per_page, $offset, $expanded_facet, $branches,$itemtypes,
319 The all singing, all dancing, multi-server, asynchronous, scanning,
320 searching, record nabbing, facet-building
322 See verbse embedded documentation.
328 $koha_query, $simple_query, $sort_by_ref, $servers_ref,
329 $results_per_page, $offset, $expanded_facet, $branches,
330 $itemtypes, $query_type, $scan, $opac
333 my @servers = @$servers_ref;
334 my @sort_by = @$sort_by_ref;
336 # Initialize variables for the ZOOM connection and results object
340 my $results_hashref = ();
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;
348 my @facets_loop; # stores the ref to array of hashes for template facets loop
350 ### LOOP THROUGH THE SERVERS
351 for ( my $i = 0 ; $i < @servers ; $i++ ) {
352 $zconns[$i] = C4::Context->Zconn( $servers[$i], 1 );
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;
358 #$query_to_use = $simple_query if $scan;
359 warn $simple_query if ( $scan and $DEBUG );
361 # Check if we've got a query_type defined, if so, use it
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]));
372 warn "Unknown query_type '$query_type'. Results undetermined.";
375 $results[$i] = $zconns[$i]->scan( new ZOOM::Query::CCL2RPN($query_to_use, $zconns[$i]));
377 $results[$i] = $zconns[$i]->search(new ZOOM::Query::CCL2RPN($query_to_use, $zconns[$i]));
381 warn "WARNING: query problem with $query_to_use " . $@;
384 # Concatenate the sort_by limits and pass them to the results object
385 # Note: sort will override rank
387 foreach my $sort (@sort_by) {
388 if ( $sort eq "author_az" || $sort eq "author_asc" ) {
389 $sort_by .= "1=1003 <i ";
391 elsif ( $sort eq "author_za" || $sort eq "author_dsc" ) {
392 $sort_by .= "1=1003 >i ";
394 elsif ( $sort eq "popularity_asc" ) {
395 $sort_by .= "1=9003 <i ";
397 elsif ( $sort eq "popularity_dsc" ) {
398 $sort_by .= "1=9003 >i ";
400 elsif ( $sort eq "call_number_asc" ) {
401 $sort_by .= "1=8007 <i ";
403 elsif ( $sort eq "call_number_dsc" ) {
404 $sort_by .= "1=8007 >i ";
406 elsif ( $sort eq "pubdate_asc" ) {
407 $sort_by .= "1=31 <i ";
409 elsif ( $sort eq "pubdate_dsc" ) {
410 $sort_by .= "1=31 >i ";
412 elsif ( $sort eq "acqdate_asc" ) {
413 $sort_by .= "1=32 <i ";
415 elsif ( $sort eq "acqdate_dsc" ) {
416 $sort_by .= "1=32 >i ";
418 elsif ( $sort eq "title_az" || $sort eq "title_asc" ) {
419 $sort_by .= "1=4 <i ";
421 elsif ( $sort eq "title_za" || $sort eq "title_dsc" ) {
422 $sort_by .= "1=4 >i ";
425 warn "Ignoring unrecognized sort '$sort' requested" if $sort_by;
428 if ( $sort_by && !$scan && $results[$i] ) {
429 if ( $results[$i]->sort( "yaz", $sort_by ) < 0 ) {
430 warn "WARNING sort $sort_by failed";
433 } # finished looping through servers
435 # The big moment: asynchronously retrieve results from all servers
440 my ( $i, $size ) = @_;
443 # loop through the results
444 $results_hash->{'hits'} = $size;
446 if ( $offset + $results_per_page <= $size ) {
447 $times = $offset + $results_per_page;
453 for ( my $j = $offset ; $j < $times ; $j++ ) {
457 ## Check if it's an index scan
459 my ( $term, $occ ) = $results[ $i - 1 ]->display_term($j);
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
464 my $tmprecord = MARC::Record->new();
465 $tmprecord->encoding('UTF-8');
469 # the minimal record in author/title (depending on MARC flavour)
470 if ( C4::Context->preference("marcflavour") eq
473 $tmptitle = MARC::Field->new(
478 $tmprecord->append_fields($tmptitle);
482 MARC::Field->new( '245', ' ', ' ', a => $term, );
484 MARC::Field->new( '100', ' ', ' ', a => $occ, );
485 $tmprecord->append_fields($tmptitle);
486 $tmprecord->append_fields($tmpauthor);
488 $results_hash->{'RECORDS'}[$j] =
489 $tmprecord->as_usmarc();
494 $record = $results[ $i - 1 ]->record($j)->raw();
495 # warn "RECORD $j:".$record;
496 $results_hash->{'RECORDS'}[$j] = $record;
500 $results_hashref->{ $servers[ $i - 1 ] } = $results_hash;
502 # Fill the facets while we're looping, but only for the
503 # biblioserver and not for a scan
504 if ( !$scan && $servers[ $i - 1 ] =~ /biblioserver/ ) {
506 my $jmax = $size > $facets_maxrecs
510 for ( my $j = 0 ; $j < $jmax ; $j++ ) {
512 my $marc_record = new_record_from_zebra (
514 $results[ $i - 1 ]->record($j)->raw()
517 if ( ! defined $marc_record ) {
518 warn "ERROR DECODING RECORD - $@: " .
519 $results[ $i - 1 ]->record($j)->raw();
523 _get_facets_data_from_record( $marc_record, $facets, $facets_counter, $facets_info );
527 # warn "connection ", $i-1, ": $size hits";
528 # warn $results[$i-1]->record(0)->render() if $size > 0;
531 if ( $servers[ $i - 1 ] =~ /biblioserver/ ) {
533 sort { $facets_counter->{$b} <=> $facets_counter->{$a} }
534 keys %$facets_counter
538 my $number_of_facets;
539 my @this_facets_array;
542 $facets_counter->{$link_value}
543 ->{$b} <=> $facets_counter->{$link_value}
545 } keys %{ $facets_counter->{$link_value} }
549 if ( ( $number_of_facets <= 5 )
550 || ( $expanded_facet eq $link_value )
551 || ( $facets_info->{$link_value}->{'expanded'} )
555 # Sanitize the link value : parenthesis, question and exclamation mark will cause errors with CCL
556 my $facet_link_value = $one_facet;
557 $facet_link_value =~ s/[()!?¡¿؟]/ /g;
559 # fix the length that will display in the label,
560 my $facet_label_value = $one_facet;
561 my $facet_max_length = C4::Context->preference(
562 'FacetLabelTruncationLength')
565 substr( $one_facet, 0, $facet_max_length )
567 if length($facet_label_value) >
570 # if it's a branch, label by the name, not the code,
571 if ( $link_value =~ /branch/ ) {
572 if ( defined $branches
573 && ref($branches) eq "HASH"
574 && defined $branches->{$one_facet}
575 && ref( $branches->{$one_facet} ) eq
579 $branches->{$one_facet}
583 $facet_label_value = "*";
587 # if it's a itemtype, label by the name, not the code,
588 if ( $link_value =~ /itype/ ) {
589 if ( defined $itemtypes
590 && ref($itemtypes) eq "HASH"
591 && defined $itemtypes->{$one_facet}
592 && ref( $itemtypes->{$one_facet} ) eq
596 $itemtypes->{$one_facet}
601 # also, if it's a location code, use the name instead of the code
602 if ( $link_value =~ /location/ ) {
604 GetKohaAuthorisedValueLib( 'LOC',
608 # but we're down with the whole label being in the link's title.
609 push @this_facets_array,
612 $facets_counter->{$link_value}
614 facet_label_value => $facet_label_value,
615 facet_title_value => $one_facet,
616 facet_link_value => $facet_link_value,
617 type_link_value => $link_value,
619 if ($facet_label_value);
623 # handle expanded option
624 unless ( $facets_info->{$link_value}->{'expanded'} ) {
626 if ( ( $number_of_facets > 5 )
627 && ( $expanded_facet ne $link_value ) );
631 type_link_value => $link_value,
632 type_id => $link_value . "_id",
634 . $facets_info->{$link_value}->{'label_value'} =>
636 facets => \@this_facets_array,
637 expandable => $expandable,
638 expand => $link_value,
642 $facets_info->{$link_value}->{'label_value'} =~
645 and ( C4::Context->preference('singleBranchMode') )
651 return ( undef, $results_hashref, \@facets_loop );
654 =head2 _get_facets_data_from_record
656 C4::Search::_get_facets_data_from_record( $marc_record, $facets, $facets_counter );
658 Internal function that extracts facets information from a MARC::Record object
659 and populates $facets_counter and $facets_info for using in getRecords.
661 $facets is expected to be filled with C4::Koha::getFacets output (i.e. the configured
666 sub _get_facets_data_from_record {
668 my ( $marc_record, $facets, $facets_counter, $facets_info ) = @_;
670 for my $facet (@$facets) {
674 foreach my $tag ( @{ $facet->{ tags } } ) {
676 # tag number is the first three digits
677 my $tag_num = substr( $tag, 0, 3 );
678 # subfields are the remainder
679 my $subfield_letters = substr( $tag, 3 );
681 my @fields = $marc_record->field( $tag_num );
682 foreach my $field (@fields) {
683 # If $field->indicator(1) eq 'z', it means it is a 'see from'
684 # field introduced because of IncludeSeeFromInSearches, so skip it
685 next if $field->indicator(1) eq 'z';
687 my $data = $field->as_string( $subfield_letters, $facet->{ sep } );
689 unless ( grep { /^\Q$data\E$/ } @used_datas ) {
690 push @used_datas, $data;
691 $facets_counter->{ $facet->{ idx } }->{ $data }++;
695 # update $facets_info so we know what facet categories need to be rendered
696 $facets_info->{ $facet->{ idx } }->{ label_value } = $facet->{ label };
697 $facets_info->{ $facet->{ idx } }->{ expanded } = $facet->{ expanded };
703 $koha_query, $simple_query, $sort_by_ref, $servers_ref,
704 $results_per_page, $offset, $expanded_facet, $branches,
708 my $paz = C4::Search::PazPar2->new(C4::Context->config('pazpar2url'));
710 $paz->search($simple_query);
711 sleep 1; # FIXME: WHY?
714 my $results_hashref = {};
715 my $stats = XMLin($paz->stat);
716 my $results = XMLin($paz->show($offset, $results_per_page, 'work-title:1'), forcearray => 1);
718 # for a grouped search result, the number of hits
719 # is the number of groups returned; 'bib_hits' will have
720 # the total number of bibs.
721 $results_hashref->{'biblioserver'}->{'hits'} = $results->{'merged'}->[0];
722 $results_hashref->{'biblioserver'}->{'bib_hits'} = $stats->{'hits'};
724 HIT: foreach my $hit (@{ $results->{'hit'} }) {
725 my $recid = $hit->{recid}->[0];
727 my $work_title = $hit->{'md-work-title'}->[0];
729 if (exists $hit->{'md-work-author'}) {
730 $work_author = $hit->{'md-work-author'}->[0];
732 my $group_label = (defined $work_author) ? "$work_title / $work_author" : $work_title;
734 my $result_group = {};
735 $result_group->{'group_label'} = $group_label;
736 $result_group->{'group_merge_key'} = $recid;
739 if (exists $hit->{count}) {
740 $count = $hit->{count}->[0];
742 $result_group->{'group_count'} = $count;
744 for (my $i = 0; $i < $count; $i++) {
745 # FIXME -- may need to worry about diacritics here
746 my $rec = $paz->record($recid, $i);
747 push @{ $result_group->{'RECORDS'} }, $rec;
750 push @{ $results_hashref->{'biblioserver'}->{'GROUPS'} }, $result_group;
753 # pass through facets
754 my $termlist_xml = $paz->termlist('author,subject');
755 my $terms = XMLin($termlist_xml, forcearray => 1);
756 my @facets_loop = ();
757 #die Dumper($results);
758 # foreach my $list (sort keys %{ $terms->{'list'} }) {
760 # foreach my $facet (sort @{ $terms->{'list'}->{$list}->{'term'} } ) {
762 # facet_label_value => $facet->{'name'}->[0],
765 # push @facets_loop, ( {
766 # type_label => $list,
767 # facets => \@facets,
771 return ( undef, $results_hashref, \@facets_loop );
775 sub _remove_stopwords {
776 my ( $operand, $index ) = @_;
777 my @stopwords_removed;
779 # phrase and exact-qualified indexes shouldn't have stopwords removed
780 if ( $index !~ m/,(phr|ext)/ ) {
782 # remove stopwords from operand : parse all stopwords & remove them (case insensitive)
783 # we use IsAlpha unicode definition, to deal correctly with diacritics.
784 # otherwise, a French word like "leçon" woudl be split into "le" "çon", "le"
785 # is a stopword, we'd get "çon" and wouldn't find anything...
787 foreach ( keys %{ C4::Context->stopwords } ) {
788 next if ( $_ =~ /(and|or|not)/ ); # don't remove operators
789 if ( my ($matched) = ($operand =~
790 /([^\X\p{isAlnum}]\Q$_\E[^\X\p{isAlnum}]|[^\X\p{isAlnum}]\Q$_\E$|^\Q$_\E[^\X\p{isAlnum}])/gi))
792 $operand =~ s/\Q$matched\E/ /gi;
793 push @stopwords_removed, $_;
797 return ( $operand, \@stopwords_removed );
801 sub _detect_truncation {
802 my ( $operand, $index ) = @_;
803 my ( @nontruncated, @righttruncated, @lefttruncated, @rightlefttruncated,
806 my @wordlist = split( /\s/, $operand );
807 foreach my $word (@wordlist) {
808 if ( $word =~ s/^\*([^\*]+)\*$/$1/ ) {
809 push @rightlefttruncated, $word;
811 elsif ( $word =~ s/^\*([^\*]+)$/$1/ ) {
812 push @lefttruncated, $word;
814 elsif ( $word =~ s/^([^\*]+)\*$/$1/ ) {
815 push @righttruncated, $word;
817 elsif ( index( $word, "*" ) < 0 ) {
818 push @nontruncated, $word;
821 push @regexpr, $word;
825 \@nontruncated, \@righttruncated, \@lefttruncated,
826 \@rightlefttruncated, \@regexpr
831 sub _build_stemmed_operand {
832 my ($operand,$lang) = @_;
833 require Lingua::Stem::Snowball ;
834 my $stemmed_operand=q{};
836 # If operand contains a digit, it is almost certainly an identifier, and should
837 # not be stemmed. This is particularly relevant for ISBNs and ISSNs, which
838 # can contain the letter "X" - for example, _build_stemmend_operand would reduce
839 # "014100018X" to "x ", which for a MARC21 database would bring up irrelevant
840 # results (e.g., "23 x 29 cm." from the 300$c). Bug 2098.
841 return $operand if $operand =~ /\d/;
843 # FIXME: the locale should be set based on the user's language and/or search choice
845 # Make sure we only use the first two letters from the language code
846 $lang = lc(substr($lang, 0, 2));
847 # The language codes for the two variants of Norwegian will now be "nb" and "nn",
848 # none of which Lingua::Stem::Snowball can use, so we need to "translate" them
849 if ($lang eq 'nb' || $lang eq 'nn') {
852 my $stemmer = Lingua::Stem::Snowball->new( lang => $lang,
853 encoding => "UTF-8" );
855 my @words = split( / /, $operand );
856 my @stems = $stemmer->stem(\@words);
857 for my $stem (@stems) {
858 $stemmed_operand .= "$stem";
859 $stemmed_operand .= "?"
860 unless ( $stem =~ /(and$|or$|not$)/ ) || ( length($stem) < 3 );
861 $stemmed_operand .= " ";
863 warn "STEMMED OPERAND: $stemmed_operand" if $DEBUG;
864 return $stemmed_operand;
868 sub _build_weighted_query {
870 # FIELD WEIGHTING - This is largely experimental stuff. What I'm committing works
871 # pretty well but could work much better if we had a smarter query parser
872 my ( $operand, $stemmed_operand, $index ) = @_;
873 my $stemming = C4::Context->preference("QueryStemming") || 0;
874 my $weight_fields = C4::Context->preference("QueryWeightFields") || 0;
875 my $fuzzy_enabled = C4::Context->preference("QueryFuzzy") || 0;
876 $operand =~ s/"/ /g; # Bug 7518: searches with quotation marks don't work
878 my $weighted_query .= "(rk=("; # Specifies that we're applying rank
880 # Keyword, or, no index specified
881 if ( ( $index eq 'kw' ) || ( !$index ) ) {
883 "Title-cover,ext,r1=\"$operand\""; # exact title-cover
884 $weighted_query .= " or ti,ext,r2=\"$operand\""; # exact title
885 $weighted_query .= " or Title-cover,phr,r3=\"$operand\""; # phrase title
886 $weighted_query .= " or ti,wrdl,r4=\"$operand\""; # words in title
887 #$weighted_query .= " or any,ext,r4=$operand"; # exact any
888 #$weighted_query .=" or kw,wrdl,r5=\"$operand\""; # word list any
889 $weighted_query .= " or wrdl,fuzzy,r8=\"$operand\""
890 if $fuzzy_enabled; # add fuzzy, word list
891 $weighted_query .= " or wrdl,right-Truncation,r9=\"$stemmed_operand\""
892 if ( $stemming and $stemmed_operand )
893 ; # add stemming, right truncation
894 $weighted_query .= " or wrdl,r9=\"$operand\"";
896 # embedded sorting: 0 a-z; 1 z-a
897 # $weighted_query .= ") or (sort1,aut=1";
900 # Barcode searches should skip this process
901 elsif ( $index eq 'bc' ) {
902 $weighted_query .= "bc=\"$operand\"";
905 # Authority-number searches should skip this process
906 elsif ( $index eq 'an' ) {
907 $weighted_query .= "an=\"$operand\"";
910 # If the index already has more than one qualifier, wrap the operand
911 # in quotes and pass it back (assumption is that the user knows what they
912 # are doing and won't appreciate us mucking up their query
913 elsif ( $index =~ ',' ) {
914 $weighted_query .= " $index=\"$operand\"";
917 #TODO: build better cases based on specific search indexes
919 $weighted_query .= " $index,ext,r1=\"$operand\""; # exact index
920 #$weighted_query .= " or (title-sort-az=0 or $index,startswithnt,st-word,r3=$operand #)";
921 $weighted_query .= " or $index,phr,r3=\"$operand\""; # phrase index
922 $weighted_query .= " or $index,wrdl,r6=\"$operand\""; # word list index
923 $weighted_query .= " or $index,wrdl,fuzzy,r8=\"$operand\""
924 if $fuzzy_enabled; # add fuzzy, word list
925 $weighted_query .= " or $index,wrdl,rt,r9=\"$stemmed_operand\""
926 if ( $stemming and $stemmed_operand ); # add stemming, right truncation
929 $weighted_query .= "))"; # close rank specification
930 return $weighted_query;
935 Return an array with available indexes.
957 'Author-personal-bibliography',
967 'Chronological-subdivision',
977 'Conference-name-heading',
978 'Conference-name-see',
979 'Conference-name-seealso',
984 'Corporate-name-heading',
985 'Corporate-name-see',
986 'Corporate-name-seealso',
987 'Country-publication',
990 'date-entered-on-file',
991 'Date-of-acquisition',
992 'Date-of-publication',
993 'Dewey-classification',
994 'Dissertation-information',
1001 'Geographic-subdivision',
1004 'Heading-use-main-or-added-entry',
1005 'Heading-use-series-added-entry ',
1006 'Heading-use-subject-added-entry',
1009 'Illustration-code',
1011 'Index-term-uncontrolled',
1021 'language-original',
1030 'Local-classification',
1033 'Match-heading-see-from',
1041 'Name-geographic-heading',
1042 'Name-geographic-see',
1043 'Name-geographic-seealso',
1051 'Personal-name-heading',
1052 'Personal-name-see',
1053 'Personal-name-seealso',
1055 'Place-publication',
1060 'Record-control-number',
1071 'Subject-heading-thesaurus',
1072 'Subject-name-personal',
1073 'Subject-subdivision',
1082 'Term-genre-form-heading',
1083 'Term-genre-form-see',
1084 'Term-genre-form-seealso',
1090 'Title-uniform-heading',
1091 'Title-uniform-see',
1092 'Title-uniform-seealso',
1102 'classification-source',
1104 'coded-location-qualifier',
1115 'Local-classification',
1118 'materials-specified',
1123 'Number-local-acquisition',
1128 'replacementpricedate',
1143 =head2 _handle_exploding_index
1145 my $query = _handle_exploding_index($index, $term)
1147 Callback routine to generate the search for "exploding" indexes (i.e.
1148 those indexes which are turned into multiple or-connected searches based
1153 sub _handle_exploding_index {
1154 my ($QParser, $filter, $params, $negate, $server) = @_;
1155 my $index = $filter;
1156 my $term = join(' ', @$params);
1158 return unless ($index =~ m/(su-br|su-na|su-rl)/ && $term);
1160 my $marcflavour = C4::Context->preference('marcflavour');
1162 my $codesubfield = $marcflavour eq 'UNIMARC' ? '5' : 'w';
1163 my $wantedcodes = '';
1164 my @subqueries = ( "\@attr 1=Subject \@attr 4=1 \"$term\"");
1165 my ($error, $results, $total_hits) = SimpleSearch( "he:$term", undef, undef, [ "authorityserver" ] );
1166 foreach my $auth (@$results) {
1167 my $record = MARC::Record->new_from_usmarc($auth);
1168 my @references = $record->field('5..');
1170 if ($index eq 'su-br') {
1172 } elsif ($index eq 'su-na') {
1174 } elsif ($index eq 'su-rl') {
1177 foreach my $reference (@references) {
1178 my $codes = $reference->subfield($codesubfield);
1179 push @subqueries, '@attr 1=Subject @attr 4=1 "' . $reference->as_string('abcdefghijlmnopqrstuvxyz') . '"' if (($codes && $codes eq $wantedcodes) || !$wantedcodes);
1183 my $query = ' @or ' x (scalar(@subqueries) - 1) . join(' ', @subqueries);
1189 ( $operators, $operands, $indexes, $limits,
1190 $sort_by, $scan, $lang ) =
1191 buildQuery ( $operators, $operands, $indexes, $limits, $sort_by, $scan, $lang);
1193 Shim function to ease the transition from buildQuery to a new QueryParser.
1194 This function is called at the beginning of buildQuery, and modifies
1195 buildQuery's input. If it can handle the input, it returns a query that
1196 buildQuery will not try to parse.
1200 my ( $operators, $operands, $indexes, $limits, $sort_by, $scan, $lang) = @_;
1202 my @operators = $operators ? @$operators : ();
1203 my @indexes = $indexes ? @$indexes : ();
1204 my @operands = $operands ? @$operands : ();
1205 my @limits = $limits ? @$limits : ();
1206 my @sort_by = $sort_by ? @$sort_by : ();
1208 my $query = $operands[0];
1214 $QParser = C4::Context->queryparser if (C4::Context->preference('UseQueryParser') || $query =~ s/^qp=//);
1215 undef $QParser if ($query =~ m/^(ccl=|pqf=|cql=)/ || grep (/\w,\w|\w=\w/, @operands, @indexes) );
1216 undef $QParser if (scalar @limits > 0);
1220 $QParser->custom_data->{'QueryAutoTruncate'} = C4::Context->preference('QueryAutoTruncate');
1222 for ( my $ii = 0 ; $ii <= @operands ; $ii++ ) {
1223 next unless $operands[$ii];
1224 $query .= $operators[ $ii - 1 ] eq 'or' ? ' || ' : ' && '
1226 if ( $operands[$ii] =~ /^[^"]\W*[-|_\w]*:\w.*[^"]$/ ) {
1227 $query .= $operands[$ii];
1229 elsif ( $indexes[$ii] =~ m/su-/ ) {
1230 $query .= $indexes[$ii] . '(' . $operands[$ii] . ')';
1234 ( $indexes[$ii] ? "$indexes[$ii]:" : '' ) . $operands[$ii];
1237 foreach my $limit (@limits) {
1239 if ( scalar(@sort_by) > 0 ) {
1241 '#(' . join( '|', @{ $QParser->modifiers } ) . ')';
1242 $query =~ s/$modifier_re//g;
1243 foreach my $modifier (@sort_by) {
1244 $query .= " #$modifier";
1248 $query_desc = $query;
1249 $query_desc =~ s/\s+/ /g;
1250 if ( C4::Context->preference("QueryWeightFields") ) {
1252 $QParser->add_bib1_filter_map( 'su-br' => 'biblioserver' =>
1253 { 'target_syntax_callback' => \&_handle_exploding_index } );
1254 $QParser->add_bib1_filter_map( 'su-na' => 'biblioserver' =>
1255 { 'target_syntax_callback' => \&_handle_exploding_index } );
1256 $QParser->add_bib1_filter_map( 'su-rl' => 'biblioserver' =>
1257 { 'target_syntax_callback' => \&_handle_exploding_index } );
1258 $QParser->parse($query);
1259 $operands[0] = "pqf=" . $QParser->target_syntax('biblioserver');
1262 require Koha::QueryParser::Driver::PQF;
1263 my $modifier_re = '#(' . join( '|', @{Koha::QueryParser::Driver::PQF->modifiers}) . ')';
1264 s/$modifier_re//g for @operands;
1267 return ( $operators, \@operands, $indexes, $limits, $sort_by, $scan, $lang, $query_desc);
1273 $simple_query, $query_cgi,
1274 $query_desc, $limit,
1275 $limit_cgi, $limit_desc,
1276 $stopwords_removed, $query_type ) = buildQuery ( $operators, $operands, $indexes, $limits, $sort_by, $scan, $lang);
1278 Build queries and limits in CCL, CGI, Human,
1279 handle truncation, stemming, field weighting, stopwords, fuzziness, etc.
1281 See verbose embedded documentation.
1287 my ( $operators, $operands, $indexes, $limits, $sort_by, $scan, $lang) = @_;
1289 warn "---------\nEnter buildQuery\n---------" if $DEBUG;
1292 ( $operators, $operands, $indexes, $limits, $sort_by, $scan, $lang, $query_desc) = parseQuery($operators, $operands, $indexes, $limits, $sort_by, $scan, $lang);
1295 my @operators = $operators ? @$operators : ();
1296 my @indexes = $indexes ? @$indexes : ();
1297 my @operands = $operands ? @$operands : ();
1298 my @limits = $limits ? @$limits : ();
1299 my @sort_by = $sort_by ? @$sort_by : ();
1301 my $stemming = C4::Context->preference("QueryStemming") || 0;
1302 my $auto_truncation = C4::Context->preference("QueryAutoTruncate") || 0;
1303 my $weight_fields = C4::Context->preference("QueryWeightFields") || 0;
1304 my $fuzzy_enabled = C4::Context->preference("QueryFuzzy") || 0;
1305 my $remove_stopwords = C4::Context->preference("QueryRemoveStopwords") || 0;
1307 my $query = $operands[0];
1308 my $simple_query = $operands[0];
1310 # initialize the variables we're passing back
1318 my $stopwords_removed; # flag to determine if stopwords have been removed
1321 my $cclindexes = getIndexes();
1322 if ( $query !~ /\s*(ccl=|pqf=|cql=)/ ) {
1323 while ( !$cclq && $query =~ /(?:^|\W)([\w-]+)(,[\w-]+)*[:=]/g ) {
1325 $cclq = grep { lc($_) eq $dx } @$cclindexes;
1327 $query = "ccl=$query" if $cclq;
1330 # for handling ccl, cql, pqf queries in diagnostic mode, skip the rest of the steps
1332 if ( $query =~ /^ccl=/ ) {
1334 # This is needed otherwise ccl= and &limit won't work together, and
1335 # this happens when selecting a subject on the opac-detail page
1336 @limits = grep {!/^$/} @limits;
1338 $q .= ' and '.join(' and ', @limits);
1340 return ( undef, $q, $q, "q=ccl=".uri_escape($q), $q, '', '', '', '', 'ccl' );
1342 if ( $query =~ /^cql=/ ) {
1343 return ( undef, $', $', "q=cql=".uri_escape($'), $', '', '', '', '', 'cql' );
1345 if ( $query =~ /^pqf=/ ) {
1347 $query_cgi = "q=".uri_escape($query_desc);
1350 $query_cgi = "q=pqf=".uri_escape($');
1352 return ( undef, $', $', $query_cgi, $query_desc, '', '', '', '', 'pqf' );
1355 # pass nested queries directly
1356 # FIXME: need better handling of some of these variables in this case
1357 # Nested queries aren't handled well and this implementation is flawed and causes users to be
1358 # unable to search for anything containing () commenting out, will be rewritten for 3.4.0
1359 # if ( $query =~ /(\(|\))/ ) {
1361 # undef, $query, $simple_query, $query_cgi,
1362 # $query, $limit, $limit_cgi, $limit_desc,
1363 # $stopwords_removed, 'ccl'
1367 # Form-based queries are non-nested and fixed depth, so we can easily modify the incoming
1368 # query operands and indexes and add stemming, truncation, field weighting, etc.
1369 # Once we do so, we'll end up with a value in $query, just like if we had an
1370 # incoming $query from the user
1373 ; # clear it out so we can populate properly with field-weighted, stemmed, etc. query
1374 my $previous_operand
1375 ; # a flag used to keep track if there was a previous query
1376 # if there was, we can apply the current operator
1378 for ( my $i = 0 ; $i <= @operands ; $i++ ) {
1380 # COMBINE OPERANDS, INDEXES AND OPERATORS
1381 if ( $operands[$i] ) {
1382 $operands[$i]=~s/^\s+//;
1384 # A flag to determine whether or not to add the index to the query
1387 # If the user is sophisticated enough to specify an index, turn off field weighting, stemming, and stopword handling
1388 if ( $operands[$i] =~ /\w(:|=)/ || $scan ) {
1391 $remove_stopwords = 0;
1393 $operands[$i] =~ s/\?/{?}/g; # need to escape question marks
1395 my $operand = $operands[$i];
1396 my $index = $indexes[$i];
1398 # Add index-specific attributes
1399 # Date of Publication
1400 if ( $index eq 'yr' ) {
1401 $index .= ",st-numeric";
1403 $stemming = $auto_truncation = $weight_fields = $fuzzy_enabled = $remove_stopwords = 0;
1406 # Date of Acquisition
1407 elsif ( $index eq 'acqdate' ) {
1408 $index .= ",st-date-normalized";
1410 $stemming = $auto_truncation = $weight_fields = $fuzzy_enabled = $remove_stopwords = 0;
1412 # ISBN,ISSN,Standard Number, don't need special treatment
1413 elsif ( $index eq 'nb' || $index eq 'ns' ) {
1415 $stemming, $auto_truncation,
1416 $weight_fields, $fuzzy_enabled,
1418 ) = ( 0, 0, 0, 0, 0 );
1426 # Set default structure attribute (word list)
1427 my $struct_attr = q{};
1428 unless ( $indexes_set || !$index || $index =~ /,(st-|phr|ext|wrdl)/ || $index =~ /^(nb|ns)$/ ) {
1429 $struct_attr = ",wrdl";
1432 # Some helpful index variants
1433 my $index_plus = $index . $struct_attr . ':';
1434 my $index_plus_comma = $index . $struct_attr . ',';
1437 if ($remove_stopwords) {
1438 ( $operand, $stopwords_removed ) =
1439 _remove_stopwords( $operand, $index );
1440 warn "OPERAND w/out STOPWORDS: >$operand<" if $DEBUG;
1441 warn "REMOVED STOPWORDS: @$stopwords_removed"
1442 if ( $stopwords_removed && $DEBUG );
1445 if ($auto_truncation){
1446 unless ( $index =~ /,(st-|phr|ext)/ ) {
1447 #FIXME only valid with LTR scripts
1448 $operand=join(" ",map{
1449 (index($_,"*")>0?"$_":"$_*")
1450 }split (/\s+/,$operand));
1451 warn $operand if $DEBUG;
1456 my $truncated_operand;
1457 my( $nontruncated, $righttruncated, $lefttruncated,
1458 $rightlefttruncated, $regexpr
1459 ) = _detect_truncation( $operand, $index );
1461 "TRUNCATION: NON:>@$nontruncated< RIGHT:>@$righttruncated< LEFT:>@$lefttruncated< RIGHTLEFT:>@$rightlefttruncated< REGEX:>@$regexpr<"
1466 scalar(@$righttruncated) + scalar(@$lefttruncated) +
1467 scalar(@$rightlefttruncated) > 0 )
1470 # Don't field weight or add the index to the query, we do it here
1472 undef $weight_fields;
1473 my $previous_truncation_operand;
1474 if (scalar @$nontruncated) {
1475 $truncated_operand .= "$index_plus @$nontruncated ";
1476 $previous_truncation_operand = 1;
1478 if (scalar @$righttruncated) {
1479 $truncated_operand .= "and " if $previous_truncation_operand;
1480 $truncated_operand .= $index_plus_comma . "rtrn:@$righttruncated ";
1481 $previous_truncation_operand = 1;
1483 if (scalar @$lefttruncated) {
1484 $truncated_operand .= "and " if $previous_truncation_operand;
1485 $truncated_operand .= $index_plus_comma . "ltrn:@$lefttruncated ";
1486 $previous_truncation_operand = 1;
1488 if (scalar @$rightlefttruncated) {
1489 $truncated_operand .= "and " if $previous_truncation_operand;
1490 $truncated_operand .= $index_plus_comma . "rltrn:@$rightlefttruncated ";
1491 $previous_truncation_operand = 1;
1494 $operand = $truncated_operand if $truncated_operand;
1495 warn "TRUNCATED OPERAND: >$truncated_operand<" if $DEBUG;
1498 my $stemmed_operand;
1499 $stemmed_operand = _build_stemmed_operand($operand, $lang)
1502 warn "STEMMED OPERAND: >$stemmed_operand<" if $DEBUG;
1504 # Handle Field Weighting
1505 my $weighted_operand;
1506 if ($weight_fields) {
1507 $weighted_operand = _build_weighted_query( $operand, $stemmed_operand, $index );
1508 $operand = $weighted_operand;
1512 warn "FIELD WEIGHTED OPERAND: >$weighted_operand<" if $DEBUG;
1514 ($query,$query_cgi,$query_desc,$previous_operand) = _build_initial_query({
1516 query_cgi => $query_cgi,
1517 query_desc => $query_desc,
1518 operator => ($operators[ $i - 1 ]) ? $operators[ $i - 1 ] : '',
1519 parsed_operand => $operand,
1520 original_operand => ($operands[$i]) ? $operands[$i] : '',
1522 index_plus => $index_plus,
1523 indexes_set => $indexes_set,
1524 previous_operand => $previous_operand,
1530 warn "QUERY BEFORE LIMITS: >$query<" if $DEBUG;
1533 my %group_OR_limits;
1534 my $availability_limit;
1535 foreach my $this_limit (@limits) {
1536 next unless $this_limit;
1537 if ( $this_limit =~ /available/ ) {
1539 ## 'available' is defined as (items.onloan is NULL) and (items.itemlost = 0)
1541 ## all records not indexed in the onloan register (zebra) and all records with a value of lost equal to 0
1542 $availability_limit .=
1543 "( ( allrecords,AlwaysMatches='' not onloan,AlwaysMatches='') and (lost,st-numeric=0) )"; #or ( allrecords,AlwaysMatches='' not lost,AlwaysMatches='')) )";
1544 $limit_cgi .= "&limit=available";
1548 # group_OR_limits, prefixed by mc-
1549 # OR every member of the group
1550 elsif ( $this_limit =~ /mc/ ) {
1551 my ($k,$v) = split(/:/, $this_limit,2);
1552 if ( $k !~ /mc-i(tem)?type/ ) {
1553 # in case the mc-ccode value has complicating chars like ()'s inside it we wrap in quotes
1554 $this_limit =~ tr/"//d;
1555 $this_limit = $k.":\"".$v."\"";
1558 $group_OR_limits{$k} .= " or " if $group_OR_limits{$k};
1559 $limit_desc .= " or " if $group_OR_limits{$k};
1560 $group_OR_limits{$k} .= "$this_limit";
1561 $limit_cgi .= "&limit=" . uri_escape($this_limit);
1562 $limit_desc .= " $this_limit";
1565 # Regular old limits
1567 $limit .= " and " if $limit || $query;
1568 $limit .= "$this_limit";
1569 $limit_cgi .= "&limit=" . uri_escape($this_limit);
1570 if ($this_limit =~ /^branch:(.+)/) {
1571 my $branchcode = $1;
1572 my $branchname = GetBranchName($branchcode);
1573 if (defined $branchname) {
1574 $limit_desc .= " branch:$branchname";
1576 $limit_desc .= " $this_limit";
1579 $limit_desc .= " $this_limit";
1583 foreach my $k (keys (%group_OR_limits)) {
1584 $limit .= " and " if ( $query || $limit );
1585 $limit .= "($group_OR_limits{$k})";
1587 if ($availability_limit) {
1588 $limit .= " and " if ( $query || $limit );
1589 $limit .= "($availability_limit)";
1592 # Normalize the query and limit strings
1593 # This is flawed , means we can't search anything with : in it
1594 # if user wants to do ccl or cql, start the query with that
1595 # $query =~ s/:/=/g;
1596 $query =~ s/(?<=(ti|au|pb|su|an|kw|mc|nb|ns)):/=/g;
1597 $query =~ s/(?<=(wrdl)):/=/g;
1598 $query =~ s/(?<=(trn|phr)):/=/g;
1600 for ( $query, $query_desc, $limit, $limit_desc ) {
1601 s/ +/ /g; # remove extra spaces
1602 s/^ //g; # remove any beginning spaces
1603 s/ $//g; # remove any ending spaces
1604 s/==/=/g; # remove double == from query
1606 $query_cgi =~ s/^&//; # remove unnecessary & from beginning of the query cgi
1608 for ($query_cgi,$simple_query) {
1611 # append the limit to the query
1612 $query .= " " . $limit;
1616 warn "QUERY:" . $query;
1617 warn "QUERY CGI:" . $query_cgi;
1618 warn "QUERY DESC:" . $query_desc;
1619 warn "LIMIT:" . $limit;
1620 warn "LIMIT CGI:" . $limit_cgi;
1621 warn "LIMIT DESC:" . $limit_desc;
1622 warn "---------\nLeave buildQuery\n---------";
1625 undef, $query, $simple_query, $query_cgi,
1626 $query_desc, $limit, $limit_cgi, $limit_desc,
1627 $stopwords_removed, $query_type
1631 =head2 _build_initial_query
1633 ($query, $query_cgi, $query_desc, $previous_operand) = _build_initial_query($initial_query_params);
1635 Build a section of the initial query containing indexes, operators, and operands.
1639 sub _build_initial_query {
1643 if ($params->{previous_operand}){
1644 #If there is a previous operand, add a supplied operator or the default 'and'
1645 $operator = ($params->{operator}) ? " ".($params->{operator})." " : ' and ';
1648 #NOTE: indexes_set is typically set when doing truncation or field weighting
1649 my $operand = ($params->{indexes_set}) ? $params->{parsed_operand} : $params->{index_plus}.$params->{parsed_operand};
1651 #e.g. "kw,wrdl:test"
1652 #e.g. " and kw,wrdl:test"
1653 $params->{query} .= $operator . $operand;
1655 $params->{query_cgi} .= "&op=".uri_escape($operator) if $operator;
1656 $params->{query_cgi} .= "&idx=".uri_escape($params->{index}) if $params->{index};
1657 $params->{query_cgi} .= "&q=".uri_escape($params->{original_operand}) if $params->{original_operand};
1659 #e.g. " and kw,wrdl: test"
1660 $params->{query_desc} .= $operator . $params->{index_plus} . " " . $params->{original_operand};
1662 $params->{previous_operand} = 1 unless $params->{previous_operand}; #If there is no previous operand, mark this as one
1664 return ($params->{query}, $params->{query_cgi}, $params->{query_desc}, $params->{previous_operand});
1667 =head2 searchResults
1669 my @search_results = searchResults($search_context, $searchdesc, $hits,
1670 $results_per_page, $offset, $scan,
1673 Format results in a form suitable for passing to the template
1677 # IMO this subroutine is pretty messy still -- it's responsible for
1678 # building the HTML output for the template
1680 my ( $search_context, $searchdesc, $hits, $results_per_page, $offset, $scan, $marcresults ) = @_;
1681 my $dbh = C4::Context->dbh;
1686 $search_context = 'opac' if !$search_context || $search_context ne 'intranet';
1687 my ($is_opac, $hidelostitems);
1688 if ($search_context eq 'opac') {
1689 $hidelostitems = C4::Context->preference('hidelostitems');
1693 #Build branchnames hash
1695 #get branch information.....
1697 my $bsth =$dbh->prepare("SELECT branchcode,branchname FROM branches"); # FIXME : use C4::Branch::GetBranches
1699 while ( my $bdata = $bsth->fetchrow_hashref ) {
1700 $branches{ $bdata->{'branchcode'} } = $bdata->{'branchname'};
1702 # FIXME - We build an authorised values hash here, using the default framework
1703 # though it is possible to have different authvals for different fws.
1705 my $shelflocations =GetKohaAuthorisedValues('items.location','');
1707 # get notforloan authorised value list (see $shelflocations FIXME)
1708 my $notforloan_authorised_value = GetAuthValCode('items.notforloan','');
1710 #Build itemtype hash
1711 #find itemtype & itemtype image
1715 "SELECT itemtype,description,imageurl,summary,notforloan FROM itemtypes"
1718 while ( my $bdata = $bsth->fetchrow_hashref ) {
1719 foreach (qw(description imageurl summary notforloan)) {
1720 $itemtypes{ $bdata->{'itemtype'} }->{$_} = $bdata->{$_};
1724 #search item field code
1725 my ($itemtag, undef) = &GetMarcFromKohaField( "items.itemnumber", "" );
1727 ## find column names of items related to MARC
1728 my $sth2 = $dbh->prepare("SHOW COLUMNS FROM items");
1730 my %subfieldstosearch;
1731 while ( ( my $column ) = $sth2->fetchrow ) {
1732 my ( $tagfield, $tagsubfield ) =
1733 &GetMarcFromKohaField( "items." . $column, "" );
1734 if ( defined $tagsubfield ) {
1735 $subfieldstosearch{$column} = $tagsubfield;
1739 # handle which records to actually retrieve
1741 if ( $hits && $offset + $results_per_page <= $hits ) {
1742 $times = $offset + $results_per_page;
1745 $times = $hits; # FIXME: if $hits is undefined, why do we want to equal it?
1748 my $marcflavour = C4::Context->preference("marcflavour");
1749 # We get the biblionumber position in MARC
1750 my ($bibliotag,$bibliosubf)=GetMarcFromKohaField('biblio.biblionumber','');
1752 # loop through all of the records we've retrieved
1753 for ( my $i = $offset ; $i <= $times - 1 ; $i++ ) {
1757 # For Scan searches we built USMARC data
1758 $marcrecord = MARC::Record->new_from_usmarc( $marcresults->[$i]);
1760 # Normal search, render from Zebra's output
1761 $marcrecord = new_record_from_zebra(
1766 if ( ! defined $marcrecord ) {
1767 warn "ERROR DECODING RECORD - $@: " . $marcresults->[$i];
1775 ? GetFrameworkCode($marcrecord->field($bibliotag)->data)
1776 : GetFrameworkCode($marcrecord->subfield($bibliotag,$bibliosubf));
1777 my $oldbiblio = TransformMarcToKoha( $dbh, $marcrecord, $fw );
1778 $oldbiblio->{subtitle} = GetRecordValue('subtitle', $marcrecord, $fw);
1779 $oldbiblio->{result_number} = $i + 1;
1781 # add imageurl to itemtype if there is one
1782 $oldbiblio->{imageurl} = getitemtypeimagelocation( $search_context, $itemtypes{ $oldbiblio->{itemtype} }->{imageurl} );
1784 $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 ) ) : [];
1785 $oldbiblio->{normalized_upc} = GetNormalizedUPC( $marcrecord,$marcflavour);
1786 $oldbiblio->{normalized_ean} = GetNormalizedEAN( $marcrecord,$marcflavour);
1787 $oldbiblio->{normalized_oclc} = GetNormalizedOCLCNumber($marcrecord,$marcflavour);
1788 $oldbiblio->{normalized_isbn} = GetNormalizedISBN(undef,$marcrecord,$marcflavour);
1789 $oldbiblio->{content_identifier_exists} = 1 if ($oldbiblio->{normalized_isbn} or $oldbiblio->{normalized_oclc} or $oldbiblio->{normalized_ean} or $oldbiblio->{normalized_upc});
1791 # edition information, if any
1792 $oldbiblio->{edition} = $oldbiblio->{editionstatement};
1793 $oldbiblio->{description} = $itemtypes{ $oldbiblio->{itemtype} }->{description};
1794 # Build summary if there is one (the summary is defined in the itemtypes table)
1795 # FIXME: is this used anywhere, I think it can be commented out? -- JF
1796 if ( $itemtypes{ $oldbiblio->{itemtype} }->{summary} ) {
1797 my $summary = $itemtypes{ $oldbiblio->{itemtype} }->{summary};
1798 my @fields = $marcrecord->fields();
1801 foreach my $line ( "$summary\n" =~ /(.*)\n/g ){
1803 foreach my $tag ( $line =~ /\[(\d{3}[\w|\d])\]/ ) {
1804 $tag =~ /(.{3})(.)/;
1805 if($marcrecord->field($1)){
1806 my @abc = $marcrecord->field($1)->subfield($2);
1807 $tags->{$tag} = $#abc + 1 ;
1811 # We catch how many times to repeat this line
1813 foreach my $tag (keys(%$tags)){
1814 $max = $tags->{$tag} if($tags->{$tag} > $max);
1817 # we replace, and repeat each line
1818 for (my $i = 0 ; $i < $max ; $i++){
1819 my $newline = $line;
1821 foreach my $tag ( $newline =~ /\[(\d{3}[\w|\d])\]/g ) {
1822 $tag =~ /(.{3})(.)/;
1824 if($marcrecord->field($1)){
1825 my @repl = $marcrecord->field($1)->subfield($2);
1826 my $subfieldvalue = $repl[$i];
1828 if (! utf8::is_utf8($subfieldvalue)) {
1829 utf8::decode($subfieldvalue);
1832 $newline =~ s/\[$tag\]/$subfieldvalue/g;
1835 $newsummary .= "$newline\n";
1839 $newsummary =~ s/\[(.*?)]//g;
1840 $newsummary =~ s/\n/<br\/>/g;
1841 $oldbiblio->{summary} = $newsummary;
1844 # Pull out the items fields
1845 my @fields = $marcrecord->field($itemtag);
1846 my $marcflavor = C4::Context->preference("marcflavour");
1847 # adding linked items that belong to host records
1848 my $analyticsfield = '773';
1849 if ($marcflavor eq 'MARC21' || $marcflavor eq 'NORMARC') {
1850 $analyticsfield = '773';
1851 } elsif ($marcflavor eq 'UNIMARC') {
1852 $analyticsfield = '461';
1854 foreach my $hostfield ( $marcrecord->field($analyticsfield)) {
1855 my $hostbiblionumber = $hostfield->subfield("0");
1856 my $linkeditemnumber = $hostfield->subfield("9");
1857 if(!$hostbiblionumber eq undef){
1858 my $hostbiblio = GetMarcBiblio($hostbiblionumber, 1);
1859 my ($itemfield, undef) = GetMarcFromKohaField( 'items.itemnumber', GetFrameworkCode($hostbiblionumber) );
1860 if(!$hostbiblio eq undef){
1861 my @hostitems = $hostbiblio->field($itemfield);
1862 foreach my $hostitem (@hostitems){
1863 if ($hostitem->subfield("9") eq $linkeditemnumber){
1864 my $linkeditem =$hostitem;
1865 # append linked items if they exist
1866 if (!$linkeditem eq undef){
1867 push (@fields, $linkeditem);}
1874 # Setting item statuses for display
1875 my @available_items_loop;
1876 my @onloan_items_loop;
1877 my @other_items_loop;
1879 my $available_items;
1883 my $ordered_count = 0;
1884 my $available_count = 0;
1885 my $onloan_count = 0;
1886 my $longoverdue_count = 0;
1887 my $other_count = 0;
1888 my $withdrawn_count = 0;
1889 my $itemlost_count = 0;
1890 my $hideatopac_count = 0;
1891 my $itembinding_count = 0;
1892 my $itemdamaged_count = 0;
1893 my $item_in_transit_count = 0;
1894 my $can_place_holds = 0;
1895 my $item_onhold_count = 0;
1896 my $notforloan_count = 0;
1897 my $items_count = scalar(@fields);
1898 my $maxitems_pref = C4::Context->preference('maxItemsinSearchResults');
1899 my $maxitems = $maxitems_pref ? $maxitems_pref - 1 : 1;
1900 my @hiddenitems; # hidden itemnumbers based on OpacHiddenItems syspref
1902 # loop through every item
1903 foreach my $field (@fields) {
1906 # populate the items hash
1907 foreach my $code ( keys %subfieldstosearch ) {
1908 $item->{$code} = $field->subfield( $subfieldstosearch{$code} );
1910 $item->{description} = $itemtypes{ $item->{itype} }{description};
1914 # hidden because lost
1915 if ($hidelostitems && $item->{itemlost}) {
1916 $hideatopac_count++;
1919 # hidden based on OpacHiddenItems syspref
1920 my @hi = C4::Items::GetHiddenItemnumbers($item);
1922 push @hiddenitems, @hi;
1923 $hideatopac_count++;
1928 my $hbranch = C4::Context->preference('StaffSearchResultsDisplayBranch');
1929 my $otherbranch = $hbranch eq 'homebranch' ? 'holdingbranch' : 'homebranch';
1931 # set item's branch name, use HomeOrHoldingBranch syspref first, fall back to the other one
1932 if ($item->{$hbranch}) {
1933 $item->{'branchname'} = $branches{$item->{$hbranch}};
1935 elsif ($item->{$otherbranch}) { # Last resort
1936 $item->{'branchname'} = $branches{$item->{$otherbranch}};
1939 my $prefix = $item->{$hbranch} . '--' . $item->{location} . $item->{itype} . $item->{itemcallnumber};
1940 # For each grouping of items (onloan, available, unavailable), we build a key to store relevant info about that item
1941 my $userenv = C4::Context->userenv;
1942 if ( $item->{onloan} && !(C4::Members::GetHideLostItemsPreference($userenv->{'number'}) && $item->{itemlost}) ) {
1944 my $key = $prefix . $item->{onloan} . $item->{barcode};
1945 $onloan_items->{$key}->{due_date} = format_date($item->{onloan});
1946 $onloan_items->{$key}->{count}++ if $item->{$hbranch};
1947 $onloan_items->{$key}->{branchname} = $item->{branchname};
1948 $onloan_items->{$key}->{location} = $shelflocations->{ $item->{location} };
1949 $onloan_items->{$key}->{itemcallnumber} = $item->{itemcallnumber};
1950 $onloan_items->{$key}->{description} = $item->{description};
1951 $onloan_items->{$key}->{imageurl} = getitemtypeimagelocation( $search_context, $itemtypes{ $item->{itype} }->{imageurl} );
1952 # if something's checked out and lost, mark it as 'long overdue'
1953 if ( $item->{itemlost} ) {
1954 $onloan_items->{$prefix}->{longoverdue}++;
1955 $longoverdue_count++;
1956 } else { # can place holds as long as item isn't lost
1957 $can_place_holds = 1;
1961 # items not on loan, but still unavailable ( lost, withdrawn, damaged )
1965 if ( $item->{notforloan} < 0 ) {
1967 } elsif ( $item->{notforloan} > 0 ) {
1968 $notforloan_count++;
1971 # is item in transit?
1972 my $transfertwhen = '';
1973 my ($transfertfrom, $transfertto);
1975 # is item on the reserve shelf?
1976 my $reservestatus = '';
1978 unless ($item->{withdrawn}
1979 || $item->{itemlost}
1981 || $item->{notforloan}
1982 || $items_count > 20) {
1984 # A couple heuristics to limit how many times
1985 # we query the database for item transfer information, sacrificing
1986 # accuracy in some cases for speed;
1988 # 1. don't query if item has one of the other statuses
1989 # 2. don't check transit status if the bib has
1990 # more than 20 items
1992 # FIXME: to avoid having the query the database like this, and to make
1993 # the in transit status count as unavailable for search limiting,
1994 # should map transit status to record indexed in Zebra.
1996 ($transfertwhen, $transfertfrom, $transfertto) = C4::Circulation::GetTransfers($item->{itemnumber});
1997 $reservestatus = C4::Reserves::GetReserveStatus( $item->{itemnumber}, $oldbiblio->{biblionumber} );
2000 # item is withdrawn, lost, damaged, not for loan, reserved or in transit
2001 if ( $item->{withdrawn}
2002 || $item->{itemlost}
2004 || $item->{notforloan}
2005 || $reservestatus eq 'Waiting'
2006 || ($transfertwhen ne ''))
2008 $withdrawn_count++ if $item->{withdrawn};
2009 $itemlost_count++ if $item->{itemlost};
2010 $itemdamaged_count++ if $item->{damaged};
2011 $item_in_transit_count++ if $transfertwhen ne '';
2012 $item_onhold_count++ if $reservestatus eq 'Waiting';
2013 $item->{status} = $item->{withdrawn} . "-" . $item->{itemlost} . "-" . $item->{damaged} . "-" . $item->{notforloan};
2015 # can place a hold on a item if
2016 # not lost nor withdrawn
2017 # not damaged unless AllowHoldsOnDamagedItems is true
2018 # item is either for loan or on order (notforloan < 0)
2019 $can_place_holds = 1
2022 && !$item->{withdrawn}
2023 && ( !$item->{damaged} || C4::Context->preference('AllowHoldsOnDamagedItems') )
2024 && ( !$item->{notforloan} || $item->{notforloan} < 0 )
2029 my $key = $prefix . $item->{status};
2030 foreach (qw(withdrawn itemlost damaged branchname itemcallnumber)) {
2031 $other_items->{$key}->{$_} = $item->{$_};
2033 $other_items->{$key}->{intransit} = ( $transfertwhen ne '' ) ? 1 : 0;
2034 $other_items->{$key}->{onhold} = ($reservestatus) ? 1 : 0;
2035 $other_items->{$key}->{notforloan} = GetAuthorisedValueDesc('','',$item->{notforloan},'','',$notforloan_authorised_value) if $notforloan_authorised_value and $item->{notforloan};
2036 $other_items->{$key}->{count}++ if $item->{$hbranch};
2037 $other_items->{$key}->{location} = $shelflocations->{ $item->{location} };
2038 $other_items->{$key}->{description} = $item->{description};
2039 $other_items->{$key}->{imageurl} = getitemtypeimagelocation( $search_context, $itemtypes{ $item->{itype} }->{imageurl} );
2043 $can_place_holds = 1;
2045 $available_items->{$prefix}->{count}++ if $item->{$hbranch};
2046 foreach (qw(branchname itemcallnumber description)) {
2047 $available_items->{$prefix}->{$_} = $item->{$_};
2049 $available_items->{$prefix}->{location} = $shelflocations->{ $item->{location} };
2050 $available_items->{$prefix}->{imageurl} = getitemtypeimagelocation( $search_context, $itemtypes{ $item->{itype} }->{imageurl} );
2053 } # notforloan, item level and biblioitem level
2055 # if all items are hidden, do not show the record
2056 if ($items_count > 0 && $hideatopac_count == $items_count) {
2060 my ( $availableitemscount, $onloanitemscount, $otheritemscount );
2061 for my $key ( sort keys %$onloan_items ) {
2062 (++$onloanitemscount > $maxitems) and last;
2063 push @onloan_items_loop, $onloan_items->{$key};
2065 for my $key ( sort keys %$other_items ) {
2066 (++$otheritemscount > $maxitems) and last;
2067 push @other_items_loop, $other_items->{$key};
2069 for my $key ( sort keys %$available_items ) {
2070 (++$availableitemscount > $maxitems) and last;
2071 push @available_items_loop, $available_items->{$key}
2074 # XSLT processing of some stuff
2075 SetUTF8Flag($marcrecord);
2076 warn $marcrecord->as_formatted if $DEBUG;
2077 my $interface = $search_context eq 'opac' ? 'OPAC' : '';
2078 if (!$scan && C4::Context->preference($interface . "XSLTResultsDisplay")) {
2079 $oldbiblio->{XSLTResultsRecord} = XSLTParse4Display($oldbiblio->{biblionumber}, $marcrecord, $interface."XSLTResultsDisplay", 1, \@hiddenitems);
2080 # the last parameter tells Koha to clean up the problematic ampersand entities that Zebra outputs
2083 # if biblio level itypes are used and itemtype is notforloan, it can't be reserved either
2084 if (!C4::Context->preference("item-level_itypes")) {
2085 if ($itemtypes{ $oldbiblio->{itemtype} }->{notforloan}) {
2086 $can_place_holds = 0;
2089 $oldbiblio->{norequests} = 1 unless $can_place_holds;
2090 $oldbiblio->{itemsplural} = 1 if $items_count > 1;
2091 $oldbiblio->{items_count} = $items_count;
2092 $oldbiblio->{available_items_loop} = \@available_items_loop;
2093 $oldbiblio->{onloan_items_loop} = \@onloan_items_loop;
2094 $oldbiblio->{other_items_loop} = \@other_items_loop;
2095 $oldbiblio->{availablecount} = $available_count;
2096 $oldbiblio->{availableplural} = 1 if $available_count > 1;
2097 $oldbiblio->{onloancount} = $onloan_count;
2098 $oldbiblio->{onloanplural} = 1 if $onloan_count > 1;
2099 $oldbiblio->{othercount} = $other_count;
2100 $oldbiblio->{otherplural} = 1 if $other_count > 1;
2101 $oldbiblio->{withdrawncount} = $withdrawn_count;
2102 $oldbiblio->{itemlostcount} = $itemlost_count;
2103 $oldbiblio->{damagedcount} = $itemdamaged_count;
2104 $oldbiblio->{intransitcount} = $item_in_transit_count;
2105 $oldbiblio->{onholdcount} = $item_onhold_count;
2106 $oldbiblio->{orderedcount} = $ordered_count;
2107 $oldbiblio->{notforloancount} = $notforloan_count;
2109 if (C4::Context->preference("AlternateHoldingsField") && $items_count == 0) {
2110 my $fieldspec = C4::Context->preference("AlternateHoldingsField");
2111 my $subfields = substr $fieldspec, 3;
2112 my $holdingsep = C4::Context->preference("AlternateHoldingsSeparator") || ' ';
2113 my @alternateholdingsinfo = ();
2114 my @holdingsfields = $marcrecord->field(substr $fieldspec, 0, 3);
2115 my $alternateholdingscount = 0;
2117 for my $field (@holdingsfields) {
2118 my %holding = ( holding => '' );
2119 my $havesubfield = 0;
2120 for my $subfield ($field->subfields()) {
2121 if ((index $subfields, $$subfield[0]) >= 0) {
2122 $holding{'holding'} .= $holdingsep if (length $holding{'holding'} > 0);
2123 $holding{'holding'} .= $$subfield[1];
2127 if ($havesubfield) {
2128 push(@alternateholdingsinfo, \%holding);
2129 $alternateholdingscount++;
2133 $oldbiblio->{'ALTERNATEHOLDINGS'} = \@alternateholdingsinfo;
2134 $oldbiblio->{'alternateholdings_count'} = $alternateholdingscount;
2137 push( @newresults, $oldbiblio );
2143 =head2 SearchAcquisitions
2144 Search for acquisitions
2147 sub SearchAcquisitions{
2148 my ($datebegin, $dateend, $itemtypes,$criteria, $orderby) = @_;
2150 my $dbh=C4::Context->dbh;
2151 # Variable initialization
2155 LEFT JOIN biblioitems ON biblioitems.biblionumber=biblio.biblionumber
2156 LEFT JOIN items ON items.biblionumber=biblio.biblionumber
2157 WHERE dateaccessioned BETWEEN ? AND ?
2160 my (@params,@loopcriteria);
2162 push @params, $datebegin->output("iso");
2163 push @params, $dateend->output("iso");
2165 if (scalar(@$itemtypes)>0 and $criteria ne "itemtype" ){
2166 if(C4::Context->preference("item-level_itypes")){
2167 $str .= "AND items.itype IN (?".( ',?' x scalar @$itemtypes - 1 ).") ";
2169 $str .= "AND biblioitems.itemtype IN (?".( ',?' x scalar @$itemtypes - 1 ).") ";
2171 push @params, @$itemtypes;
2174 if ($criteria =~/itemtype/){
2175 if(C4::Context->preference("item-level_itypes")){
2176 $str .= "AND items.itype=? ";
2178 $str .= "AND biblioitems.itemtype=? ";
2181 if(scalar(@$itemtypes) == 0){
2182 my $itypes = GetItemTypes();
2183 for my $key (keys %$itypes){
2184 push @$itemtypes, $key;
2188 @loopcriteria= @$itemtypes;
2189 }elsif ($criteria=~/itemcallnumber/){
2190 $str .= "AND (items.itemcallnumber LIKE CONCAT(?,'%')
2191 OR items.itemcallnumber is NULL
2192 OR items.itemcallnumber = '')";
2194 @loopcriteria = ("AA".."ZZ", "") unless (scalar(@loopcriteria)>0);
2196 $str .= "AND biblio.title LIKE CONCAT(?,'%') ";
2197 @loopcriteria = ("A".."z") unless (scalar(@loopcriteria)>0);
2200 if ($orderby =~ /date_desc/){
2201 $str.=" ORDER BY dateaccessioned DESC";
2203 $str.=" ORDER BY title";
2206 my $qdataacquisitions=$dbh->prepare($str);
2208 my @loopacquisitions;
2209 foreach my $value(@loopcriteria){
2210 push @params,$value;
2212 $cell{"title"}=$value;
2213 $cell{"titlecode"}=$value;
2215 eval{$qdataacquisitions->execute(@params);};
2217 if ($@){ warn "recentacquisitions Error :$@";}
2220 while (my $data=$qdataacquisitions->fetchrow_hashref){
2221 push @loopdata, {"summary"=>GetBiblioSummary( $data->{'marcxml'} ) };
2223 $cell{"loopdata"}=\@loopdata;
2225 push @loopacquisitions,\%cell if (scalar(@{$cell{loopdata}})>0);
2228 $qdataacquisitions->finish;
2229 return \@loopacquisitions;
2232 =head2 enabled_staff_search_views
2234 %hash = enabled_staff_search_views()
2236 This function returns a hash that contains three flags obtained from the system
2237 preferences, used to determine whether a particular staff search results view
2242 =item C<Output arg:>
2244 * $hash{can_view_MARC} is true only if the MARC view is enabled
2245 * $hash{can_view_ISBD} is true only if the ISBD view is enabled
2246 * $hash{can_view_labeledMARC} is true only if the Labeled MARC view is enabled
2248 =item C<usage in the script:>
2252 $template->param ( C4::Search::enabled_staff_search_views );
2256 sub enabled_staff_search_views
2259 can_view_MARC => C4::Context->preference('viewMARC'), # 1 if the staff search allows the MARC view
2260 can_view_ISBD => C4::Context->preference('viewISBD'), # 1 if the staff search allows the ISBD view
2261 can_view_labeledMARC => C4::Context->preference('viewLabeledMARC'), # 1 if the staff search allows the Labeled MARC view
2265 sub PurgeSearchHistory{
2266 my ($pSearchhistory)=@_;
2267 my $dbh = C4::Context->dbh;
2268 my $sth = $dbh->prepare("DELETE FROM search_history WHERE time < DATE_SUB( NOW(), INTERVAL ? DAY )");
2269 $sth->execute($pSearchhistory) or die $dbh->errstr;
2272 =head2 z3950_search_args
2274 $arrayref = z3950_search_args($matchpoints)
2276 This function returns an array reference that contains the search parameters to be
2277 passed to the Z39.50 search script (z3950_search.pl). The array elements
2278 are hash refs whose keys are name and value, and whose values are the
2279 name of a search parameter, the value of that search parameter and the URL encoded
2280 value of that parameter.
2282 The search parameter names are lccn, isbn, issn, title, author, dewey and subject.
2284 The search parameter values are obtained from the bibliographic record whose
2285 data is in a hash reference in $matchpoints, as returned by Biblio::GetBiblioData().
2287 If $matchpoints is a scalar, it is assumed to be an unnamed query descriptor, e.g.
2288 a general purpose search argument. In this case, the returned array contains only
2289 entry: the key is 'title' and the value is derived from $matchpoints.
2291 If a search parameter value is undefined or empty, it is not included in the returned
2294 The returned array reference may be passed directly to the template parameters.
2298 =item C<Output arg:>
2300 * $array containing hash refs as described above
2302 =item C<usage in the script:>
2306 $data = Biblio::GetBiblioData($bibno);
2307 $template->param ( MYLOOP => C4::Search::z3950_search_args($data) )
2311 $template->param ( MYLOOP => C4::Search::z3950_search_args($searchscalar) )
2315 sub z3950_search_args {
2318 my $isbn_string = ref( $bibrec ) ? $bibrec->{title} : $bibrec;
2319 my $isbn = Business::ISBN->new( $isbn_string );
2321 if (defined $isbn && $isbn->is_valid)
2323 if ( ref($bibrec) ) {
2324 $bibrec->{isbn} = $isbn_string;
2325 $bibrec->{title} = undef;
2327 $bibrec = { isbn => $isbn_string };
2331 $bibrec = { title => $bibrec } if !ref $bibrec;
2334 for my $field (qw/ lccn isbn issn title author dewey subject /)
2336 push @$array, { name => $field, value => $bibrec->{$field} }
2337 if defined $bibrec->{$field};
2342 =head2 GetDistinctValues($field);
2344 C<$field> is a reference to the fields array
2348 sub GetDistinctValues {
2349 my ($fieldname,$string)=@_;
2350 # returns a reference to a hash of references to branches...
2351 if ($fieldname=~/\./){
2352 my ($table,$column)=split /\./, $fieldname;
2353 my $dbh = C4::Context->dbh;
2354 warn "select DISTINCT($column) as value, count(*) as cnt from $table group by lib order by $column " if $DEBUG;
2355 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 ");
2357 my $elements=$sth->fetchall_arrayref({});
2362 my @servers=qw<biblioserver authorityserver>;
2363 my (@zconns,@results);
2364 for ( my $i = 0 ; $i < @servers ; $i++ ) {
2365 $zconns[$i] = C4::Context->Zconn( $servers[$i], 1 );
2368 ZOOM::Query::CCL2RPN->new( qq"$fieldname $string", $zconns[$i])
2371 # The big moment: asynchronously retrieve results from all servers
2377 my ( $i, $size ) = @_;
2378 for ( my $j = 0 ; $j < $size ; $j++ ) {
2380 @hashscan{qw(value cnt)} =
2381 $results[ $i - 1 ]->display_term($j);
2382 push @elements, \%hashscan;
2390 =head2 _ZOOM_event_loop
2392 _ZOOM_event_loop(\@zconns, \@results, sub {
2393 my ( $i, $size ) = @_;
2397 Processes a ZOOM event loop and passes control to a closure for
2398 processing the results, and destroying the resultsets.
2402 sub _ZOOM_event_loop {
2403 my ($zconns, $results, $callback) = @_;
2404 while ( ( my $i = ZOOM::event( $zconns ) ) != 0 ) {
2405 my $ev = $zconns->[ $i - 1 ]->last_event();
2406 if ( $ev == ZOOM::Event::ZEND ) {
2407 next unless $results->[ $i - 1 ];
2408 my $size = $results->[ $i - 1 ]->size();
2410 $callback->($i, $size);
2415 foreach my $result (@$results) {
2420 =head2 new_record_from_zebra
2422 Given raw data from a Zebra result set, return a MARC::Record object
2424 This helper function is needed to take into account all the involved
2425 system preferences and configuration variables to properly create the
2426 MARC::Record object.
2428 If we are using GRS-1, then the raw data we get from Zebra should be USMARC
2429 data. If we are using DOM, then it has to be MARCXML.
2433 sub new_record_from_zebra {
2436 my $raw_data = shift;
2437 # Set the default indexing modes
2438 my $index_mode = ( $server eq 'biblioserver' )
2439 ? C4::Context->config('zebra_bib_index_mode') // 'grs1'
2440 : C4::Context->config('zebra_auth_index_mode') // 'dom';
2442 my $marc_record = eval {
2443 if ( $index_mode eq 'dom' ) {
2444 MARC::Record->new_from_xml( $raw_data, 'UTF-8' );
2446 MARC::Record->new_from_usmarc( $raw_data );
2453 return $marc_record;
2458 END { } # module clean-up code here (global destructor)
2465 Koha Development Team <http://koha-community.org/>