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; # CheckReserves
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
74 &enabled_staff_search_views
78 # make all your functions, whether exported or not;
82 ($biblionumber,$biblionumber,$title) = FindDuplicate($record);
84 This function attempts to find duplicate records using a hard-coded, fairly simplistic algorithm
90 my $dbh = C4::Context->dbh;
91 my $result = TransformMarcToKoha( $dbh, $record, '' );
96 my ( $biblionumber, $title );
98 # search duplicate on ISBN, easy and fast..
100 if ( $result->{isbn} ) {
101 $result->{isbn} =~ s/\(.*$//;
102 $result->{isbn} =~ s/\s+$//;
103 $query = "isbn=$result->{isbn}";
106 $result->{title} =~ s /\\//g;
107 $result->{title} =~ s /\"//g;
108 $result->{title} =~ s /\(//g;
109 $result->{title} =~ s /\)//g;
111 # FIXME: instead of removing operators, could just do
112 # quotes around the value
113 $result->{title} =~ s/(and|or|not)//g;
114 $query = "ti,ext=$result->{title}";
115 $query .= " and itemtype=$result->{itemtype}"
116 if ( $result->{itemtype} );
117 if ( $result->{author} ) {
118 $result->{author} =~ s /\\//g;
119 $result->{author} =~ s /\"//g;
120 $result->{author} =~ s /\(//g;
121 $result->{author} =~ s /\)//g;
123 # remove valid operators
124 $result->{author} =~ s/(and|or|not)//g;
125 $query .= " and au,ext=$result->{author}";
129 my ( $error, $searchresults, undef ) = SimpleSearch($query); # FIXME :: hardcoded !
131 if (!defined $error) {
132 foreach my $possible_duplicate_record (@{$searchresults}) {
134 MARC::Record->new_from_usmarc($possible_duplicate_record);
135 my $result = TransformMarcToKoha( $dbh, $marcrecord, '' );
137 # FIXME :: why 2 $biblionumber ?
139 push @results, $result->{'biblionumber'};
140 push @results, $result->{'title'};
149 ( $error, $results, $total_hits ) = SimpleSearch( $query, $offset, $max_results, [@servers] );
151 This function provides a simple search API on the bibliographic catalog
157 * $query can be a simple keyword or a complete CCL query
158 * @servers is optional. Defaults to biblioserver as found in koha-conf.xml
159 * $offset - If present, represents the number of records at the beggining to omit. Defaults to 0
160 * $max_results - if present, determines the maximum number of records to fetch. undef is All. defaults to undef.
165 Returns an array consisting of three elements
166 * $error is undefined unless an error is detected
167 * $results is a reference to an array of records.
168 * $total_hits is the number of hits that would have been returned with no limit
170 If an error is returned the two other return elements are undefined. If error itself is undefined
171 the other two elements are always defined
173 =item C<usage in the script:>
177 my ( $error, $marcresults, $total_hits ) = SimpleSearch($query);
179 if (defined $error) {
180 $template->param(query_error => $error);
181 warn "error: ".$error;
182 output_html_with_http_headers $input, $cookie, $template->output;
186 my $hits = @{$marcresults};
189 for my $r ( @{$marcresults} ) {
190 my $marcrecord = MARC::File::USMARC::decode($r);
191 my $biblio = TransformMarcToKoha(C4::Context->dbh,$marcrecord,q{});
193 #build the iarray of hashs for the template.
195 title => $biblio->{'title'},
196 subtitle => $biblio->{'subtitle'},
197 biblionumber => $biblio->{'biblionumber'},
198 author => $biblio->{'author'},
199 publishercode => $biblio->{'publishercode'},
200 publicationyear => $biblio->{'publicationyear'},
205 $template->param(result=>\@results);
210 my ( $query, $offset, $max_results, $servers ) = @_;
212 if ( C4::Context->preference('NoZebra') ) {
213 my $result = NZorder( NZanalyse($query) )->{'biblioserver'};
216 && $result->{hits} > 0 ? $result->{'RECORDS'} : [] );
217 return ( undef, $search_result, scalar($result->{hits}) );
220 return ( 'No query entered', undef, undef ) unless $query;
221 # FIXME hardcoded value. See catalog/search.pl & opac-search.pl too.
222 my @servers = defined ( $servers ) ? @$servers : ( 'biblioserver' );
229 # Initialize & Search Zebra
230 for ( my $i = 0 ; $i < @servers ; $i++ ) {
232 $zconns[$i] = C4::Context->Zconn( $servers[$i], 1 );
233 $zoom_queries[$i] = new ZOOM::Query::CCL2RPN( $query, $zconns[$i]);
234 $tmpresults[$i] = $zconns[$i]->search( $zoom_queries[$i] );
238 $zconns[$i]->errmsg() . " ("
239 . $zconns[$i]->errcode() . ") "
240 . $zconns[$i]->addinfo() . " "
241 . $zconns[$i]->diagset();
243 return ( $error, undef, undef ) if $zconns[$i]->errcode();
247 # caught a ZOOM::Exception
251 . $@->addinfo() . " "
253 warn $error." for query: $query";
254 return ( $error, undef, undef );
263 my $first_record = defined($offset) ? $offset + 1 : 1;
264 my $hits = $tmpresults[ $i - 1 ]->size();
265 $total_hits += $hits;
266 my $last_record = $hits;
267 if ( defined $max_results && $offset + $max_results < $hits ) {
268 $last_record = $offset + $max_results;
271 for my $j ( $first_record .. $last_record ) {
273 $tmpresults[ $i - 1 ]->record( $j - 1 )->raw()
275 push @{$results}, $record;
280 foreach my $zoom_query (@zoom_queries) {
281 $zoom_query->destroy();
284 return ( undef, $results, $total_hits );
290 ( undef, $results_hashref, \@facets_loop ) = getRecords (
292 $koha_query, $simple_query, $sort_by_ref, $servers_ref,
293 $results_per_page, $offset, $expanded_facet, $branches,$itemtypes,
297 The all singing, all dancing, multi-server, asynchronous, scanning,
298 searching, record nabbing, facet-building
300 See verbse embedded documentation.
306 $koha_query, $simple_query, $sort_by_ref, $servers_ref,
307 $results_per_page, $offset, $expanded_facet, $branches,
308 $itemtypes, $query_type, $scan, $opac
311 my @servers = @$servers_ref;
312 my @sort_by = @$sort_by_ref;
314 # Initialize variables for the ZOOM connection and results object
318 my $results_hashref = ();
320 # Initialize variables for the faceted results objects
321 my $facets_counter = ();
322 my $facets_info = ();
323 my $facets = getFacets();
324 my $facets_maxrecs = C4::Context->preference('maxRecordsForFacets')||20;
326 my @facets_loop; # stores the ref to array of hashes for template facets loop
328 ### LOOP THROUGH THE SERVERS
329 for ( my $i = 0 ; $i < @servers ; $i++ ) {
330 $zconns[$i] = C4::Context->Zconn( $servers[$i], 1 );
332 # perform the search, create the results objects
333 # if this is a local search, use the $koha-query, if it's a federated one, use the federated-query
334 my $query_to_use = ($servers[$i] =~ /biblioserver/) ? $koha_query : $simple_query;
336 #$query_to_use = $simple_query if $scan;
337 warn $simple_query if ( $scan and $DEBUG );
339 # Check if we've got a query_type defined, if so, use it
342 if ($query_type =~ /^ccl/) {
343 $query_to_use =~ s/\:/\=/g; # change : to = last minute (FIXME)
344 $results[$i] = $zconns[$i]->search(new ZOOM::Query::CCL2RPN($query_to_use, $zconns[$i]));
345 } elsif ($query_type =~ /^cql/) {
346 $results[$i] = $zconns[$i]->search(new ZOOM::Query::CQL($query_to_use, $zconns[$i]));
347 } elsif ($query_type =~ /^pqf/) {
348 $results[$i] = $zconns[$i]->search(new ZOOM::Query::PQF($query_to_use, $zconns[$i]));
350 warn "Unknown query_type '$query_type'. Results undetermined.";
353 $results[$i] = $zconns[$i]->scan( new ZOOM::Query::CCL2RPN($query_to_use, $zconns[$i]));
355 $results[$i] = $zconns[$i]->search(new ZOOM::Query::CCL2RPN($query_to_use, $zconns[$i]));
359 warn "WARNING: query problem with $query_to_use " . $@;
362 # Concatenate the sort_by limits and pass them to the results object
363 # Note: sort will override rank
365 foreach my $sort (@sort_by) {
366 if ( $sort eq "author_az" || $sort eq "author_asc" ) {
367 $sort_by .= "1=1003 <i ";
369 elsif ( $sort eq "author_za" || $sort eq "author_dsc" ) {
370 $sort_by .= "1=1003 >i ";
372 elsif ( $sort eq "popularity_asc" ) {
373 $sort_by .= "1=9003 <i ";
375 elsif ( $sort eq "popularity_dsc" ) {
376 $sort_by .= "1=9003 >i ";
378 elsif ( $sort eq "call_number_asc" ) {
379 $sort_by .= "1=8007 <i ";
381 elsif ( $sort eq "call_number_dsc" ) {
382 $sort_by .= "1=8007 >i ";
384 elsif ( $sort eq "pubdate_asc" ) {
385 $sort_by .= "1=31 <i ";
387 elsif ( $sort eq "pubdate_dsc" ) {
388 $sort_by .= "1=31 >i ";
390 elsif ( $sort eq "acqdate_asc" ) {
391 $sort_by .= "1=32 <i ";
393 elsif ( $sort eq "acqdate_dsc" ) {
394 $sort_by .= "1=32 >i ";
396 elsif ( $sort eq "title_az" || $sort eq "title_asc" ) {
397 $sort_by .= "1=4 <i ";
399 elsif ( $sort eq "title_za" || $sort eq "title_dsc" ) {
400 $sort_by .= "1=4 >i ";
403 warn "Ignoring unrecognized sort '$sort' requested" if $sort_by;
406 if ($sort_by && !$scan) {
407 if ( $results[$i]->sort( "yaz", $sort_by ) < 0 ) {
408 warn "WARNING sort $sort_by failed";
411 } # finished looping through servers
413 # The big moment: asynchronously retrieve results from all servers
418 my ( $i, $size ) = @_;
421 # loop through the results
422 $results_hash->{'hits'} = $size;
424 if ( $offset + $results_per_page <= $size ) {
425 $times = $offset + $results_per_page;
430 for ( my $j = $offset ; $j < $times ; $j++ ) {
434 ## Check if it's an index scan
436 my ( $term, $occ ) = $results[ $i - 1 ]->term($j);
438 # here we create a minimal MARC record and hand it off to the
439 # template just like a normal result ... perhaps not ideal, but
441 my $tmprecord = MARC::Record->new();
442 $tmprecord->encoding('UTF-8');
446 # the minimal record in author/title (depending on MARC flavour)
447 if ( C4::Context->preference("marcflavour") eq
450 $tmptitle = MARC::Field->new(
455 $tmprecord->append_fields($tmptitle);
459 MARC::Field->new( '245', ' ', ' ', a => $term, );
461 MARC::Field->new( '100', ' ', ' ', a => $occ, );
462 $tmprecord->append_fields($tmptitle);
463 $tmprecord->append_fields($tmpauthor);
465 $results_hash->{'RECORDS'}[$j] =
466 $tmprecord->as_usmarc();
471 $record = $results[ $i - 1 ]->record($j)->raw();
473 # warn "RECORD $j:".$record;
474 $results_hash->{'RECORDS'}[$j] = $record;
478 $results_hashref->{ $servers[ $i - 1 ] } = $results_hash;
480 # Fill the facets while we're looping, but only for the biblioserver and not for a scan
481 if ( !$scan && $servers[ $i - 1 ] =~ /biblioserver/ ) {
484 $size > $facets_maxrecs ? $facets_maxrecs : $size;
485 for my $facet (@$facets) {
486 for ( my $j = 0 ; $j < $jmax ; $j++ ) {
488 $results[ $i - 1 ]->record($j)->render();
490 foreach my $tag ( @{ $facet->{tags} } ) {
493 my $tag_num = substr( $tag, 0, 3 );
494 my $letters = substr( $tag, 3 );
496 '\n' . $tag_num . ' ([^z][^\n]+)';
497 $field_pattern = '\n' . $tag_num . ' ([^\n]+)'
498 if ( int($tag_num) < 10 );
500 ( $render_record =~ /$field_pattern/g );
501 foreach my $field_token (@field_tokens) {
502 my @subf = ( $field_token =~
503 /\$([a-zA-Z0-9]) ([^\$]+)/g );
505 for ( my $i = 0 ; $i < @subf ; $i += 2 ) {
506 if ( $letters =~ $subf[$i] ) {
507 my $value = $subf[ $i + 1 ];
510 push @values, $value;
513 my $data = join( $facet->{sep}, @values );
514 unless ( $data ~~ @used_datas ) {
515 $facets_counter->{ $facet->{idx} }
517 push @used_datas, $data;
522 $facets_info->{ $facet->{idx} }->{label_value} =
524 $facets_info->{ $facet->{idx} }->{expanded} =
529 # warn "connection ", $i-1, ": $size hits";
530 # warn $results[$i-1]->record(0)->render() if $size > 0;
533 if ( $servers[ $i - 1 ] =~ /biblioserver/ ) {
535 sort { $facets_counter->{$b} <=> $facets_counter->{$a} }
536 keys %$facets_counter
540 my $number_of_facets;
541 my @this_facets_array;
544 $facets_counter->{$link_value}
545 ->{$b} <=> $facets_counter->{$link_value}
547 } keys %{ $facets_counter->{$link_value} }
551 if ( ( $number_of_facets < 6 )
552 || ( $expanded_facet eq $link_value )
553 || ( $facets_info->{$link_value}->{'expanded'} )
557 # Sanitize the link value : parenthesis, question and exclamation mark will cause errors with CCL
558 my $facet_link_value = $one_facet;
559 $facet_link_value =~ s/[()!?¡¿؟]/ /g;
561 # fix the length that will display in the label,
562 my $facet_label_value = $one_facet;
563 my $facet_max_length = C4::Context->preference(
564 'FacetLabelTruncationLength')
567 substr( $one_facet, 0, $facet_max_length )
569 if length($facet_label_value) >
572 # if it's a branch, label by the name, not the code,
573 if ( $link_value =~ /branch/ ) {
574 if ( defined $branches
575 && ref($branches) eq "HASH"
576 && defined $branches->{$one_facet}
577 && ref( $branches->{$one_facet} ) eq
581 $branches->{$one_facet}
585 $facet_label_value = "*";
589 # if it's a itemtype, label by the name, not the code,
590 if ( $link_value =~ /itype/ ) {
591 if ( defined $itemtypes
592 && ref($itemtypes) eq "HASH"
593 && defined $itemtypes->{$one_facet}
594 && ref( $itemtypes->{$one_facet} ) eq
598 $itemtypes->{$one_facet}
603 # also, if it's a location code, use the name instead of the code
604 if ( $link_value =~ /location/ ) {
606 GetKohaAuthorisedValueLib( 'LOC',
610 # but we're down with the whole label being in the link's title.
611 push @this_facets_array,
614 $facets_counter->{$link_value}
616 facet_label_value => $facet_label_value,
617 facet_title_value => $one_facet,
618 facet_link_value => $facet_link_value,
619 type_link_value => $link_value,
621 if ($facet_label_value);
625 # handle expanded option
626 unless ( $facets_info->{$link_value}->{'expanded'} ) {
628 if ( ( $number_of_facets > 6 )
629 && ( $expanded_facet ne $link_value ) );
633 type_link_value => $link_value,
634 type_id => $link_value . "_id",
636 . $facets_info->{$link_value}->{'label_value'} =>
638 facets => \@this_facets_array,
639 expandable => $expandable,
640 expand => $link_value,
644 $facets_info->{$link_value}->{'label_value'} =~
647 and ( C4::Context->preference('singleBranchMode') )
653 return ( undef, $results_hashref, \@facets_loop );
658 $koha_query, $simple_query, $sort_by_ref, $servers_ref,
659 $results_per_page, $offset, $expanded_facet, $branches,
663 my $paz = C4::Search::PazPar2->new(C4::Context->config('pazpar2url'));
665 $paz->search($simple_query);
666 sleep 1; # FIXME: WHY?
669 my $results_hashref = {};
670 my $stats = XMLin($paz->stat);
671 my $results = XMLin($paz->show($offset, $results_per_page, 'work-title:1'), forcearray => 1);
673 # for a grouped search result, the number of hits
674 # is the number of groups returned; 'bib_hits' will have
675 # the total number of bibs.
676 $results_hashref->{'biblioserver'}->{'hits'} = $results->{'merged'}->[0];
677 $results_hashref->{'biblioserver'}->{'bib_hits'} = $stats->{'hits'};
679 HIT: foreach my $hit (@{ $results->{'hit'} }) {
680 my $recid = $hit->{recid}->[0];
682 my $work_title = $hit->{'md-work-title'}->[0];
684 if (exists $hit->{'md-work-author'}) {
685 $work_author = $hit->{'md-work-author'}->[0];
687 my $group_label = (defined $work_author) ? "$work_title / $work_author" : $work_title;
689 my $result_group = {};
690 $result_group->{'group_label'} = $group_label;
691 $result_group->{'group_merge_key'} = $recid;
694 if (exists $hit->{count}) {
695 $count = $hit->{count}->[0];
697 $result_group->{'group_count'} = $count;
699 for (my $i = 0; $i < $count; $i++) {
700 # FIXME -- may need to worry about diacritics here
701 my $rec = $paz->record($recid, $i);
702 push @{ $result_group->{'RECORDS'} }, $rec;
705 push @{ $results_hashref->{'biblioserver'}->{'GROUPS'} }, $result_group;
708 # pass through facets
709 my $termlist_xml = $paz->termlist('author,subject');
710 my $terms = XMLin($termlist_xml, forcearray => 1);
711 my @facets_loop = ();
712 #die Dumper($results);
713 # foreach my $list (sort keys %{ $terms->{'list'} }) {
715 # foreach my $facet (sort @{ $terms->{'list'}->{$list}->{'term'} } ) {
717 # facet_label_value => $facet->{'name'}->[0],
720 # push @facets_loop, ( {
721 # type_label => $list,
722 # facets => \@facets,
726 return ( undef, $results_hashref, \@facets_loop );
730 sub _remove_stopwords {
731 my ( $operand, $index ) = @_;
732 my @stopwords_removed;
734 # phrase and exact-qualified indexes shouldn't have stopwords removed
735 if ( $index !~ m/phr|ext/ ) {
737 # remove stopwords from operand : parse all stopwords & remove them (case insensitive)
738 # we use IsAlpha unicode definition, to deal correctly with diacritics.
739 # otherwise, a French word like "leçon" woudl be split into "le" "çon", "le"
740 # is a stopword, we'd get "çon" and wouldn't find anything...
742 foreach ( keys %{ C4::Context->stopwords } ) {
743 next if ( $_ =~ /(and|or|not)/ ); # don't remove operators
744 if ( my ($matched) = ($operand =~
745 /([^\X\p{isAlnum}]\Q$_\E[^\X\p{isAlnum}]|[^\X\p{isAlnum}]\Q$_\E$|^\Q$_\E[^\X\p{isAlnum}])/gi))
747 $operand =~ s/\Q$matched\E/ /gi;
748 push @stopwords_removed, $_;
752 return ( $operand, \@stopwords_removed );
756 sub _detect_truncation {
757 my ( $operand, $index ) = @_;
758 my ( @nontruncated, @righttruncated, @lefttruncated, @rightlefttruncated,
761 my @wordlist = split( /\s/, $operand );
762 foreach my $word (@wordlist) {
763 if ( $word =~ s/^\*([^\*]+)\*$/$1/ ) {
764 push @rightlefttruncated, $word;
766 elsif ( $word =~ s/^\*([^\*]+)$/$1/ ) {
767 push @lefttruncated, $word;
769 elsif ( $word =~ s/^([^\*]+)\*$/$1/ ) {
770 push @righttruncated, $word;
772 elsif ( index( $word, "*" ) < 0 ) {
773 push @nontruncated, $word;
776 push @regexpr, $word;
780 \@nontruncated, \@righttruncated, \@lefttruncated,
781 \@rightlefttruncated, \@regexpr
786 sub _build_stemmed_operand {
787 my ($operand,$lang) = @_;
788 require Lingua::Stem::Snowball ;
789 my $stemmed_operand=q{};
791 # If operand contains a digit, it is almost certainly an identifier, and should
792 # not be stemmed. This is particularly relevant for ISBNs and ISSNs, which
793 # can contain the letter "X" - for example, _build_stemmend_operand would reduce
794 # "014100018X" to "x ", which for a MARC21 database would bring up irrelevant
795 # results (e.g., "23 x 29 cm." from the 300$c). Bug 2098.
796 return $operand if $operand =~ /\d/;
798 # FIXME: the locale should be set based on the user's language and/or search choice
800 # Make sure we only use the first two letters from the language code
801 $lang = lc(substr($lang, 0, 2));
802 # The language codes for the two variants of Norwegian will now be "nb" and "nn",
803 # none of which Lingua::Stem::Snowball can use, so we need to "translate" them
804 if ($lang eq 'nb' || $lang eq 'nn') {
807 my $stemmer = Lingua::Stem::Snowball->new( lang => $lang,
808 encoding => "UTF-8" );
810 my @words = split( / /, $operand );
811 my @stems = $stemmer->stem(\@words);
812 for my $stem (@stems) {
813 $stemmed_operand .= "$stem";
814 $stemmed_operand .= "?"
815 unless ( $stem =~ /(and$|or$|not$)/ ) || ( length($stem) < 3 );
816 $stemmed_operand .= " ";
818 warn "STEMMED OPERAND: $stemmed_operand" if $DEBUG;
819 return $stemmed_operand;
823 sub _build_weighted_query {
825 # FIELD WEIGHTING - This is largely experimental stuff. What I'm committing works
826 # pretty well but could work much better if we had a smarter query parser
827 my ( $operand, $stemmed_operand, $index ) = @_;
828 my $stemming = C4::Context->preference("QueryStemming") || 0;
829 my $weight_fields = C4::Context->preference("QueryWeightFields") || 0;
830 my $fuzzy_enabled = C4::Context->preference("QueryFuzzy") || 0;
832 my $weighted_query .= "(rk=("; # Specifies that we're applying rank
834 # Keyword, or, no index specified
835 if ( ( $index eq 'kw' ) || ( !$index ) ) {
837 "Title-cover,ext,r1=\"$operand\""; # exact title-cover
838 $weighted_query .= " or ti,ext,r2=\"$operand\""; # exact title
839 $weighted_query .= " or Title-cover,phr,r3=\"$operand\""; # phrase title
840 #$weighted_query .= " or any,ext,r4=$operand"; # exact any
841 #$weighted_query .=" or kw,wrdl,r5=\"$operand\""; # word list any
842 $weighted_query .= " or wrdl,fuzzy,r8=\"$operand\""
843 if $fuzzy_enabled; # add fuzzy, word list
844 $weighted_query .= " or wrdl,right-Truncation,r9=\"$stemmed_operand\""
845 if ( $stemming and $stemmed_operand )
846 ; # add stemming, right truncation
847 $weighted_query .= " or wrdl,r9=\"$operand\"";
849 # embedded sorting: 0 a-z; 1 z-a
850 # $weighted_query .= ") or (sort1,aut=1";
853 # Barcode searches should skip this process
854 elsif ( $index eq 'bc' ) {
855 $weighted_query .= "bc=\"$operand\"";
858 # Authority-number searches should skip this process
859 elsif ( $index eq 'an' ) {
860 $weighted_query .= "an=\"$operand\"";
863 # If the index already has more than one qualifier, wrap the operand
864 # in quotes and pass it back (assumption is that the user knows what they
865 # are doing and won't appreciate us mucking up their query
866 elsif ( $index =~ ',' ) {
867 $weighted_query .= " $index=\"$operand\"";
870 #TODO: build better cases based on specific search indexes
872 $weighted_query .= " $index,ext,r1=\"$operand\""; # exact index
873 #$weighted_query .= " or (title-sort-az=0 or $index,startswithnt,st-word,r3=$operand #)";
874 $weighted_query .= " or $index,phr,r3=\"$operand\""; # phrase index
876 " or $index,rt,wrdl,r3=\"$operand\""; # word list index
879 $weighted_query .= "))"; # close rank specification
880 return $weighted_query;
885 Return an array with available indexes.
907 'Author-personal-bibliography',
917 'Chronological-subdivision',
927 'Conference-name-heading',
928 'Conference-name-see',
929 'Conference-name-seealso',
934 'Corporate-name-heading',
935 'Corporate-name-see',
936 'Corporate-name-seealso',
938 'date-entered-on-file',
939 'Date-of-acquisition',
940 'Date-of-publication',
941 'Dewey-classification',
948 'Geographic-subdivision',
951 'Heading-use-main-or-added-entry',
952 'Heading-use-series-added-entry ',
953 'Heading-use-subject-added-entry',
971 'Local-classification',
974 'Match-heading-see-from',
982 'Name-geographic-heading',
983 'Name-geographic-see',
984 'Name-geographic-seealso',
992 'Personal-name-heading',
994 'Personal-name-seealso',
1001 'Record-control-number',
1012 'Subject-heading-thesaurus',
1013 'Subject-name-personal',
1014 'Subject-subdivision',
1024 'Term-genre-form-heading',
1025 'Term-genre-form-see',
1026 'Term-genre-form-seealso',
1033 'Title-uniform-heading',
1034 'Title-uniform-see',
1035 'Title-uniform-seealso',
1045 'classification-source',
1047 'coded-location-qualifier',
1058 'Local-classification',
1061 'materials-specified',
1070 'replacementpricedate',
1085 =head2 _handle_exploding_index
1087 my $query = _handle_exploding_index($index, $term)
1089 Callback routine to generate the search for "exploding" indexes (i.e.
1090 those indexes which are turned into multiple or-connected searches based
1095 sub _handle_exploding_index {
1096 my ( $index, $term ) = @_;
1098 return unless ($index =~ m/(su-br|su-na|su-rl)/ && $term);
1100 my $marcflavour = C4::Context->preference('marcflavour');
1102 my $codesubfield = $marcflavour eq 'UNIMARC' ? '5' : 'w';
1103 my $wantedcodes = '';
1104 my @subqueries = ( "(su=\"$term\")");
1105 my ($error, $results, $total_hits) = SimpleSearch( "Heading,wrdl=$term", undef, undef, [ "authorityserver" ] );
1106 foreach my $auth (@$results) {
1107 my $record = MARC::Record->new_from_usmarc($auth);
1108 my @references = $record->field('5..');
1110 if ($index eq 'su-br') {
1112 } elsif ($index eq 'su-na') {
1114 } elsif ($index eq 'su-rl') {
1117 foreach my $reference (@references) {
1118 my $codes = $reference->subfield($codesubfield);
1119 push @subqueries, '(su="' . $reference->as_string('abcdefghijlmnopqrstuvxyz') . '")' if (($codes && $codes eq $wantedcodes) || !$wantedcodes);
1123 return join(' or ', @subqueries);
1128 ( $operators, $operands, $indexes, $limits,
1129 $sort_by, $scan, $lang ) =
1130 buildQuery ( $operators, $operands, $indexes, $limits, $sort_by, $scan, $lang);
1132 Shim function to ease the transition from buildQuery to a new QueryParser.
1133 This function is called at the beginning of buildQuery, and modifies
1134 buildQuery's input. If it can handle the input, it returns a query that
1135 buildQuery will not try to parse.
1139 my ( $operators, $operands, $indexes, $limits, $sort_by, $scan, $lang) = @_;
1141 my @operators = $operators ? @$operators : ();
1142 my @indexes = $indexes ? @$indexes : ();
1143 my @operands = $operands ? @$operands : ();
1144 my @limits = $limits ? @$limits : ();
1145 my @sort_by = $sort_by ? @$sort_by : ();
1147 my $query = $operands[0];
1151 # TODO: once we are using QueryParser, all this special case code for
1152 # exploded search indexes will be replaced by a callback to
1153 # _handle_exploding_index
1154 if ( $query =~ m/^(.*)\b(su-br|su-na|su-rl)[:=](\w.*)$/ ) {
1160 for ( my $i = 0 ; $i <= @operands ; $i++ ) {
1161 if ($operands[$i] && $indexes[$i] =~ m/(su-br|su-na|su-rl)/) {
1162 $index = $indexes[$i];
1163 $term = $operands[$i];
1164 } elsif ($operands[$i]) {
1165 $query .= $operators[$i] eq 'or' ? ' or ' : ' and ' if ($query);
1166 $query .= "($indexes[$i]:$operands[$i])";
1172 my $queryPart = _handle_exploding_index($index, $term);
1174 $query .= "($queryPart)";
1177 $operands[0] = "ccl=$query";
1180 return ( $operators, \@operands, $indexes, $limits, $sort_by, $scan, $lang);
1186 $simple_query, $query_cgi,
1187 $query_desc, $limit,
1188 $limit_cgi, $limit_desc,
1189 $stopwords_removed, $query_type ) = buildQuery ( $operators, $operands, $indexes, $limits, $sort_by, $scan, $lang);
1191 Build queries and limits in CCL, CGI, Human,
1192 handle truncation, stemming, field weighting, stopwords, fuzziness, etc.
1194 See verbose embedded documentation.
1200 my ( $operators, $operands, $indexes, $limits, $sort_by, $scan, $lang) = @_;
1202 warn "---------\nEnter buildQuery\n---------" if $DEBUG;
1204 ( $operators, $operands, $indexes, $limits, $sort_by, $scan, $lang) = parseQuery($operators, $operands, $indexes, $limits, $sort_by, $scan, $lang);
1207 my @operators = $operators ? @$operators : ();
1208 my @indexes = $indexes ? @$indexes : ();
1209 my @operands = $operands ? @$operands : ();
1210 my @limits = $limits ? @$limits : ();
1211 my @sort_by = $sort_by ? @$sort_by : ();
1213 my $stemming = C4::Context->preference("QueryStemming") || 0;
1214 my $auto_truncation = C4::Context->preference("QueryAutoTruncate") || 0;
1215 my $weight_fields = C4::Context->preference("QueryWeightFields") || 0;
1216 my $fuzzy_enabled = C4::Context->preference("QueryFuzzy") || 0;
1217 my $remove_stopwords = C4::Context->preference("QueryRemoveStopwords") || 0;
1219 # no stemming/weight/fuzzy in NoZebra
1220 if ( C4::Context->preference("NoZebra") ) {
1224 $auto_truncation = 0;
1227 my $query = $operands[0];
1228 my $simple_query = $operands[0];
1230 # initialize the variables we're passing back
1239 my $stopwords_removed; # flag to determine if stopwords have been removed
1242 my $cclindexes = getIndexes();
1243 if ( $query !~ /\s*ccl=/ ) {
1244 while ( !$cclq && $query =~ /(?:^|\W)([\w-]+)(,[\w-]+)*[:=]/g ) {
1246 $cclq = grep { lc($_) eq $dx } @$cclindexes;
1248 $query = "ccl=$query" if $cclq;
1251 # for handling ccl, cql, pqf queries in diagnostic mode, skip the rest of the steps
1253 if ( $query =~ /^ccl=/ ) {
1255 # This is needed otherwise ccl= and &limit won't work together, and
1256 # this happens when selecting a subject on the opac-detail page
1257 @limits = grep {!/^$/} @limits;
1259 $q .= ' and '.join(' and ', @limits);
1261 return ( undef, $q, $q, "q=ccl=$q", $q, '', '', '', '', 'ccl' );
1263 if ( $query =~ /^cql=/ ) {
1264 return ( undef, $', $', "q=cql=$'", $', '', '', '', '', 'cql' );
1266 if ( $query =~ /^pqf=/ ) {
1267 return ( undef, $', $', "q=pqf=$'", $', '', '', '', '', 'pqf' );
1270 # pass nested queries directly
1271 # FIXME: need better handling of some of these variables in this case
1272 # Nested queries aren't handled well and this implementation is flawed and causes users to be
1273 # unable to search for anything containing () commenting out, will be rewritten for 3.4.0
1274 # if ( $query =~ /(\(|\))/ ) {
1276 # undef, $query, $simple_query, $query_cgi,
1277 # $query, $limit, $limit_cgi, $limit_desc,
1278 # $stopwords_removed, 'ccl'
1282 # Form-based queries are non-nested and fixed depth, so we can easily modify the incoming
1283 # query operands and indexes and add stemming, truncation, field weighting, etc.
1284 # Once we do so, we'll end up with a value in $query, just like if we had an
1285 # incoming $query from the user
1288 ; # clear it out so we can populate properly with field-weighted, stemmed, etc. query
1289 my $previous_operand
1290 ; # a flag used to keep track if there was a previous query
1291 # if there was, we can apply the current operator
1293 for ( my $i = 0 ; $i <= @operands ; $i++ ) {
1295 # COMBINE OPERANDS, INDEXES AND OPERATORS
1296 if ( $operands[$i] ) {
1297 $operands[$i]=~s/^\s+//;
1299 # A flag to determine whether or not to add the index to the query
1302 # If the user is sophisticated enough to specify an index, turn off field weighting, stemming, and stopword handling
1303 if ( $operands[$i] =~ /\w(:|=)/ || $scan ) {
1306 $remove_stopwords = 0;
1308 $operands[$i] =~ s/\?/{?}/g; # need to escape question marks
1310 my $operand = $operands[$i];
1311 my $index = $indexes[$i];
1313 # Add index-specific attributes
1314 # Date of Publication
1315 if ( $index eq 'yr' ) {
1316 $index .= ",st-numeric";
1318 $stemming = $auto_truncation = $weight_fields = $fuzzy_enabled = $remove_stopwords = 0;
1321 # Date of Acquisition
1322 elsif ( $index eq 'acqdate' ) {
1323 $index .= ",st-date-normalized";
1325 $stemming = $auto_truncation = $weight_fields = $fuzzy_enabled = $remove_stopwords = 0;
1327 # ISBN,ISSN,Standard Number, don't need special treatment
1328 elsif ( $index eq 'nb' || $index eq 'ns' ) {
1330 $stemming, $auto_truncation,
1331 $weight_fields, $fuzzy_enabled,
1333 ) = ( 0, 0, 0, 0, 0 );
1341 # Set default structure attribute (word list)
1342 my $struct_attr = q{};
1343 unless ( $indexes_set || !$index || $index =~ /(st-|phr|ext|wrdl|nb|ns)/ ) {
1344 $struct_attr = ",wrdl";
1347 # Some helpful index variants
1348 my $index_plus = $index . $struct_attr . ':';
1349 my $index_plus_comma = $index . $struct_attr . ',';
1352 if ($remove_stopwords) {
1353 ( $operand, $stopwords_removed ) =
1354 _remove_stopwords( $operand, $index );
1355 warn "OPERAND w/out STOPWORDS: >$operand<" if $DEBUG;
1356 warn "REMOVED STOPWORDS: @$stopwords_removed"
1357 if ( $stopwords_removed && $DEBUG );
1360 if ($auto_truncation){
1361 unless ( $index =~ /(st-|phr|ext)/ ) {
1362 #FIXME only valid with LTR scripts
1363 $operand=join(" ",map{
1364 (index($_,"*")>0?"$_":"$_*")
1365 }split (/\s+/,$operand));
1366 warn $operand if $DEBUG;
1371 my $truncated_operand;
1372 my( $nontruncated, $righttruncated, $lefttruncated,
1373 $rightlefttruncated, $regexpr
1374 ) = _detect_truncation( $operand, $index );
1376 "TRUNCATION: NON:>@$nontruncated< RIGHT:>@$righttruncated< LEFT:>@$lefttruncated< RIGHTLEFT:>@$rightlefttruncated< REGEX:>@$regexpr<"
1381 scalar(@$righttruncated) + scalar(@$lefttruncated) +
1382 scalar(@$rightlefttruncated) > 0 )
1385 # Don't field weight or add the index to the query, we do it here
1387 undef $weight_fields;
1388 my $previous_truncation_operand;
1389 if (scalar @$nontruncated) {
1390 $truncated_operand .= "$index_plus @$nontruncated ";
1391 $previous_truncation_operand = 1;
1393 if (scalar @$righttruncated) {
1394 $truncated_operand .= "and " if $previous_truncation_operand;
1395 $truncated_operand .= $index_plus_comma . "rtrn:@$righttruncated ";
1396 $previous_truncation_operand = 1;
1398 if (scalar @$lefttruncated) {
1399 $truncated_operand .= "and " if $previous_truncation_operand;
1400 $truncated_operand .= $index_plus_comma . "ltrn:@$lefttruncated ";
1401 $previous_truncation_operand = 1;
1403 if (scalar @$rightlefttruncated) {
1404 $truncated_operand .= "and " if $previous_truncation_operand;
1405 $truncated_operand .= $index_plus_comma . "rltrn:@$rightlefttruncated ";
1406 $previous_truncation_operand = 1;
1409 $operand = $truncated_operand if $truncated_operand;
1410 warn "TRUNCATED OPERAND: >$truncated_operand<" if $DEBUG;
1413 my $stemmed_operand;
1414 $stemmed_operand = _build_stemmed_operand($operand, $lang)
1417 warn "STEMMED OPERAND: >$stemmed_operand<" if $DEBUG;
1419 # Handle Field Weighting
1420 my $weighted_operand;
1421 if ($weight_fields) {
1422 $weighted_operand = _build_weighted_query( $operand, $stemmed_operand, $index );
1423 $operand = $weighted_operand;
1427 warn "FIELD WEIGHTED OPERAND: >$weighted_operand<" if $DEBUG;
1429 # If there's a previous operand, we need to add an operator
1430 if ($previous_operand) {
1432 # User-specified operator
1433 if ( $operators[ $i - 1 ] ) {
1434 $query .= " $operators[$i-1] ";
1435 $query .= " $index_plus " unless $indexes_set;
1436 $query .= " $operand";
1437 $query_cgi .= "&op=$operators[$i-1]";
1438 $query_cgi .= "&idx=$index" if $index;
1439 $query_cgi .= "&q=$operands[$i]" if $operands[$i];
1441 " $operators[$i-1] $index_plus $operands[$i]";
1444 # Default operator is and
1447 $query .= "$index_plus " unless $indexes_set;
1448 $query .= "$operand";
1449 $query_cgi .= "&op=and&idx=$index" if $index;
1450 $query_cgi .= "&q=$operands[$i]" if $operands[$i];
1451 $query_desc .= " and $index_plus $operands[$i]";
1455 # There isn't a pervious operand, don't need an operator
1458 # Field-weighted queries already have indexes set
1459 $query .= " $index_plus " unless $indexes_set;
1461 $query_desc .= " $index_plus $operands[$i]";
1462 $query_cgi .= "&idx=$index" if $index;
1463 $query_cgi .= "&q=$operands[$i]" if $operands[$i];
1464 $previous_operand = 1;
1469 warn "QUERY BEFORE LIMITS: >$query<" if $DEBUG;
1472 my %group_OR_limits;
1473 my $availability_limit;
1474 foreach my $this_limit (@limits) {
1475 next unless $this_limit;
1476 if ( $this_limit =~ /available/ ) {
1478 ## 'available' is defined as (items.onloan is NULL) and (items.itemlost = 0)
1480 ## all records not indexed in the onloan register (zebra) and all records with a value of lost equal to 0
1481 $availability_limit .=
1482 "( ( allrecords,AlwaysMatches='' not onloan,AlwaysMatches='') and (lost,st-numeric=0) )"; #or ( allrecords,AlwaysMatches='' not lost,AlwaysMatches='')) )";
1483 $limit_cgi .= "&limit=available";
1487 # group_OR_limits, prefixed by mc-
1488 # OR every member of the group
1489 elsif ( $this_limit =~ /mc/ ) {
1490 my ($k,$v) = split(/:/, $this_limit,2);
1491 if ( $k !~ /mc-i(tem)?type/ ) {
1492 # in case the mc-ccode value has complicating chars like ()'s inside it we wrap in quotes
1493 $this_limit =~ tr/"//d;
1494 $this_limit = $k.":\"".$v."\"";
1497 $group_OR_limits{$k} .= " or " if $group_OR_limits{$k};
1498 $limit_desc .= " or " if $group_OR_limits{$k};
1499 $group_OR_limits{$k} .= "$this_limit";
1500 $limit_cgi .= "&limit=$this_limit";
1501 $limit_desc .= " $this_limit";
1504 # Regular old limits
1506 $limit .= " and " if $limit || $query;
1507 $limit .= "$this_limit";
1508 $limit_cgi .= "&limit=$this_limit";
1509 if ($this_limit =~ /^branch:(.+)/) {
1510 my $branchcode = $1;
1511 my $branchname = GetBranchName($branchcode);
1512 if (defined $branchname) {
1513 $limit_desc .= " branch:$branchname";
1515 $limit_desc .= " $this_limit";
1518 $limit_desc .= " $this_limit";
1522 foreach my $k (keys (%group_OR_limits)) {
1523 $limit .= " and " if ( $query || $limit );
1524 $limit .= "($group_OR_limits{$k})";
1526 if ($availability_limit) {
1527 $limit .= " and " if ( $query || $limit );
1528 $limit .= "($availability_limit)";
1531 # Normalize the query and limit strings
1532 # This is flawed , means we can't search anything with : in it
1533 # if user wants to do ccl or cql, start the query with that
1534 # $query =~ s/:/=/g;
1535 $query =~ s/(?<=(ti|au|pb|su|an|kw|mc|nb|ns)):/=/g;
1536 $query =~ s/(?<=(wrdl)):/=/g;
1537 $query =~ s/(?<=(trn|phr)):/=/g;
1539 for ( $query, $query_desc, $limit, $limit_desc ) {
1540 s/ +/ /g; # remove extra spaces
1541 s/^ //g; # remove any beginning spaces
1542 s/ $//g; # remove any ending spaces
1543 s/==/=/g; # remove double == from query
1545 $query_cgi =~ s/^&//; # remove unnecessary & from beginning of the query cgi
1547 for ($query_cgi,$simple_query) {
1550 # append the limit to the query
1551 $query .= " " . $limit;
1555 warn "QUERY:" . $query;
1556 warn "QUERY CGI:" . $query_cgi;
1557 warn "QUERY DESC:" . $query_desc;
1558 warn "LIMIT:" . $limit;
1559 warn "LIMIT CGI:" . $limit_cgi;
1560 warn "LIMIT DESC:" . $limit_desc;
1561 warn "---------\nLeave buildQuery\n---------";
1564 undef, $query, $simple_query, $query_cgi,
1565 $query_desc, $limit, $limit_cgi, $limit_desc,
1566 $stopwords_removed, $query_type
1570 =head2 searchResults
1572 my @search_results = searchResults($search_context, $searchdesc, $hits,
1573 $results_per_page, $offset, $scan,
1576 Format results in a form suitable for passing to the template
1580 # IMO this subroutine is pretty messy still -- it's responsible for
1581 # building the HTML output for the template
1583 my ( $search_context, $searchdesc, $hits, $results_per_page, $offset, $scan, $marcresults ) = @_;
1584 my $dbh = C4::Context->dbh;
1589 $search_context = 'opac' if !$search_context || $search_context ne 'intranet';
1590 my ($is_opac, $hidelostitems);
1591 if ($search_context eq 'opac') {
1592 $hidelostitems = C4::Context->preference('hidelostitems');
1596 #Build branchnames hash
1598 #get branch information.....
1600 my $bsth =$dbh->prepare("SELECT branchcode,branchname FROM branches"); # FIXME : use C4::Branch::GetBranches
1602 while ( my $bdata = $bsth->fetchrow_hashref ) {
1603 $branches{ $bdata->{'branchcode'} } = $bdata->{'branchname'};
1605 # FIXME - We build an authorised values hash here, using the default framework
1606 # though it is possible to have different authvals for different fws.
1608 my $shelflocations =GetKohaAuthorisedValues('items.location','');
1610 # get notforloan authorised value list (see $shelflocations FIXME)
1611 my $notforloan_authorised_value = GetAuthValCode('items.notforloan','');
1613 #Build itemtype hash
1614 #find itemtype & itemtype image
1618 "SELECT itemtype,description,imageurl,summary,notforloan FROM itemtypes"
1621 while ( my $bdata = $bsth->fetchrow_hashref ) {
1622 foreach (qw(description imageurl summary notforloan)) {
1623 $itemtypes{ $bdata->{'itemtype'} }->{$_} = $bdata->{$_};
1627 #search item field code
1628 my ($itemtag, undef) = &GetMarcFromKohaField( "items.itemnumber", "" );
1630 ## find column names of items related to MARC
1631 my $sth2 = $dbh->prepare("SHOW COLUMNS FROM items");
1633 my %subfieldstosearch;
1634 while ( ( my $column ) = $sth2->fetchrow ) {
1635 my ( $tagfield, $tagsubfield ) =
1636 &GetMarcFromKohaField( "items." . $column, "" );
1637 $subfieldstosearch{$column} = $tagsubfield;
1640 # handle which records to actually retrieve
1642 if ( $hits && $offset + $results_per_page <= $hits ) {
1643 $times = $offset + $results_per_page;
1646 $times = $hits; # FIXME: if $hits is undefined, why do we want to equal it?
1649 my $marcflavour = C4::Context->preference("marcflavour");
1650 # We get the biblionumber position in MARC
1651 my ($bibliotag,$bibliosubf)=GetMarcFromKohaField('biblio.biblionumber','');
1653 # loop through all of the records we've retrieved
1654 for ( my $i = $offset ; $i <= $times - 1 ; $i++ ) {
1655 my $marcrecord = MARC::File::USMARC::decode( $marcresults->[$i] );
1659 ? GetFrameworkCode($marcrecord->field($bibliotag)->data)
1660 : GetFrameworkCode($marcrecord->subfield($bibliotag,$bibliosubf));
1661 my $oldbiblio = TransformMarcToKoha( $dbh, $marcrecord, $fw );
1662 $oldbiblio->{subtitle} = GetRecordValue('subtitle', $marcrecord, $fw);
1663 $oldbiblio->{result_number} = $i + 1;
1665 # add imageurl to itemtype if there is one
1666 $oldbiblio->{imageurl} = getitemtypeimagelocation( $search_context, $itemtypes{ $oldbiblio->{itemtype} }->{imageurl} );
1668 $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 ) ) : [];
1669 $oldbiblio->{normalized_upc} = GetNormalizedUPC( $marcrecord,$marcflavour);
1670 $oldbiblio->{normalized_ean} = GetNormalizedEAN( $marcrecord,$marcflavour);
1671 $oldbiblio->{normalized_oclc} = GetNormalizedOCLCNumber($marcrecord,$marcflavour);
1672 $oldbiblio->{normalized_isbn} = GetNormalizedISBN(undef,$marcrecord,$marcflavour);
1673 $oldbiblio->{content_identifier_exists} = 1 if ($oldbiblio->{normalized_isbn} or $oldbiblio->{normalized_oclc} or $oldbiblio->{normalized_ean} or $oldbiblio->{normalized_upc});
1675 # edition information, if any
1676 $oldbiblio->{edition} = $oldbiblio->{editionstatement};
1677 $oldbiblio->{description} = $itemtypes{ $oldbiblio->{itemtype} }->{description};
1678 # Build summary if there is one (the summary is defined in the itemtypes table)
1679 # FIXME: is this used anywhere, I think it can be commented out? -- JF
1680 if ( $itemtypes{ $oldbiblio->{itemtype} }->{summary} ) {
1681 my $summary = $itemtypes{ $oldbiblio->{itemtype} }->{summary};
1682 my @fields = $marcrecord->fields();
1685 foreach my $line ( "$summary\n" =~ /(.*)\n/g ){
1687 foreach my $tag ( $line =~ /\[(\d{3}[\w|\d])\]/ ) {
1688 $tag =~ /(.{3})(.)/;
1689 if($marcrecord->field($1)){
1690 my @abc = $marcrecord->field($1)->subfield($2);
1691 $tags->{$tag} = $#abc + 1 ;
1695 # We catch how many times to repeat this line
1697 foreach my $tag (keys(%$tags)){
1698 $max = $tags->{$tag} if($tags->{$tag} > $max);
1701 # we replace, and repeat each line
1702 for (my $i = 0 ; $i < $max ; $i++){
1703 my $newline = $line;
1705 foreach my $tag ( $newline =~ /\[(\d{3}[\w|\d])\]/g ) {
1706 $tag =~ /(.{3})(.)/;
1708 if($marcrecord->field($1)){
1709 my @repl = $marcrecord->field($1)->subfield($2);
1710 my $subfieldvalue = $repl[$i];
1712 if (! utf8::is_utf8($subfieldvalue)) {
1713 utf8::decode($subfieldvalue);
1716 $newline =~ s/\[$tag\]/$subfieldvalue/g;
1719 $newsummary .= "$newline\n";
1723 $newsummary =~ s/\[(.*?)]//g;
1724 $newsummary =~ s/\n/<br\/>/g;
1725 $oldbiblio->{summary} = $newsummary;
1728 # Pull out the items fields
1729 my @fields = $marcrecord->field($itemtag);
1730 my $marcflavor = C4::Context->preference("marcflavour");
1731 # adding linked items that belong to host records
1732 my $analyticsfield = '773';
1733 if ($marcflavor eq 'MARC21' || $marcflavor eq 'NORMARC') {
1734 $analyticsfield = '773';
1735 } elsif ($marcflavor eq 'UNIMARC') {
1736 $analyticsfield = '461';
1738 foreach my $hostfield ( $marcrecord->field($analyticsfield)) {
1739 my $hostbiblionumber = $hostfield->subfield("0");
1740 my $linkeditemnumber = $hostfield->subfield("9");
1741 if(!$hostbiblionumber eq undef){
1742 my $hostbiblio = GetMarcBiblio($hostbiblionumber, 1);
1743 my ($itemfield, undef) = GetMarcFromKohaField( 'items.itemnumber', GetFrameworkCode($hostbiblionumber) );
1744 if(!$hostbiblio eq undef){
1745 my @hostitems = $hostbiblio->field($itemfield);
1746 foreach my $hostitem (@hostitems){
1747 if ($hostitem->subfield("9") eq $linkeditemnumber){
1748 my $linkeditem =$hostitem;
1749 # append linked items if they exist
1750 if (!$linkeditem eq undef){
1751 push (@fields, $linkeditem);}
1758 # Setting item statuses for display
1759 my @available_items_loop;
1760 my @onloan_items_loop;
1761 my @other_items_loop;
1763 my $available_items;
1767 my $ordered_count = 0;
1768 my $available_count = 0;
1769 my $onloan_count = 0;
1770 my $longoverdue_count = 0;
1771 my $other_count = 0;
1772 my $wthdrawn_count = 0;
1773 my $itemlost_count = 0;
1774 my $hideatopac_count = 0;
1775 my $itembinding_count = 0;
1776 my $itemdamaged_count = 0;
1777 my $item_in_transit_count = 0;
1778 my $can_place_holds = 0;
1779 my $item_onhold_count = 0;
1780 my $items_count = scalar(@fields);
1781 my $maxitems_pref = C4::Context->preference('maxItemsinSearchResults');
1782 my $maxitems = $maxitems_pref ? $maxitems_pref - 1 : 1;
1783 my @hiddenitems; # hidden itemnumbers based on OpacHiddenItems syspref
1785 # loop through every item
1786 foreach my $field (@fields) {
1789 # populate the items hash
1790 foreach my $code ( keys %subfieldstosearch ) {
1791 $item->{$code} = $field->subfield( $subfieldstosearch{$code} );
1793 $item->{description} = $itemtypes{ $item->{itype} }{description};
1797 # hidden because lost
1798 if ($hidelostitems && $item->{itemlost}) {
1799 $hideatopac_count++;
1802 # hidden based on OpacHiddenItems syspref
1803 my @hi = C4::Items::GetHiddenItemnumbers($item);
1805 push @hiddenitems, @hi;
1806 $hideatopac_count++;
1811 my $hbranch = C4::Context->preference('HomeOrHoldingBranch') eq 'homebranch' ? 'homebranch' : 'holdingbranch';
1812 my $otherbranch = C4::Context->preference('HomeOrHoldingBranch') eq 'homebranch' ? 'holdingbranch' : 'homebranch';
1814 # set item's branch name, use HomeOrHoldingBranch syspref first, fall back to the other one
1815 if ($item->{$hbranch}) {
1816 $item->{'branchname'} = $branches{$item->{$hbranch}};
1818 elsif ($item->{$otherbranch}) { # Last resort
1819 $item->{'branchname'} = $branches{$item->{$otherbranch}};
1822 my $prefix = $item->{$hbranch} . '--' . $item->{location} . $item->{itype} . $item->{itemcallnumber};
1823 # For each grouping of items (onloan, available, unavailable), we build a key to store relevant info about that item
1824 my $userenv = C4::Context->userenv;
1825 if ( $item->{onloan} && !(C4::Members::GetHideLostItemsPreference($userenv->{'number'}) && $item->{itemlost}) ) {
1827 my $key = $prefix . $item->{onloan} . $item->{barcode};
1828 $onloan_items->{$key}->{due_date} = format_date($item->{onloan});
1829 $onloan_items->{$key}->{count}++ if $item->{$hbranch};
1830 $onloan_items->{$key}->{branchname} = $item->{branchname};
1831 $onloan_items->{$key}->{location} = $shelflocations->{ $item->{location} };
1832 $onloan_items->{$key}->{itemcallnumber} = $item->{itemcallnumber};
1833 $onloan_items->{$key}->{description} = $item->{description};
1834 $onloan_items->{$key}->{imageurl} = getitemtypeimagelocation( $search_context, $itemtypes{ $item->{itype} }->{imageurl} );
1835 # if something's checked out and lost, mark it as 'long overdue'
1836 if ( $item->{itemlost} ) {
1837 $onloan_items->{$prefix}->{longoverdue}++;
1838 $longoverdue_count++;
1839 } else { # can place holds as long as item isn't lost
1840 $can_place_holds = 1;
1844 # items not on loan, but still unavailable ( lost, withdrawn, damaged )
1848 if ( $item->{notforloan} < 0 ) {
1852 # is item in transit?
1853 my $transfertwhen = '';
1854 my ($transfertfrom, $transfertto);
1856 # is item on the reserve shelf?
1857 my $reservestatus = '';
1860 unless ($item->{wthdrawn}
1861 || $item->{itemlost}
1863 || $item->{notforloan}
1864 || $items_count > 20) {
1866 # A couple heuristics to limit how many times
1867 # we query the database for item transfer information, sacrificing
1868 # accuracy in some cases for speed;
1870 # 1. don't query if item has one of the other statuses
1871 # 2. don't check transit status if the bib has
1872 # more than 20 items
1874 # FIXME: to avoid having the query the database like this, and to make
1875 # the in transit status count as unavailable for search limiting,
1876 # should map transit status to record indexed in Zebra.
1878 ($transfertwhen, $transfertfrom, $transfertto) = C4::Circulation::GetTransfers($item->{itemnumber});
1879 ($reservestatus, $reserveitem, undef) = C4::Reserves::CheckReserves($item->{itemnumber});
1882 # item is withdrawn, lost, damaged, not for loan, reserved or in transit
1883 if ( $item->{wthdrawn}
1884 || $item->{itemlost}
1886 || $item->{notforloan}
1887 || $reservestatus eq 'Waiting'
1888 || ($transfertwhen ne ''))
1890 $wthdrawn_count++ if $item->{wthdrawn};
1891 $itemlost_count++ if $item->{itemlost};
1892 $itemdamaged_count++ if $item->{damaged};
1893 $item_in_transit_count++ if $transfertwhen ne '';
1894 $item_onhold_count++ if $reservestatus eq 'Waiting';
1895 $item->{status} = $item->{wthdrawn} . "-" . $item->{itemlost} . "-" . $item->{damaged} . "-" . $item->{notforloan};
1897 # can place hold on item ?
1898 if ( !$item->{itemlost} ) {
1899 if ( !$item->{wthdrawn} ){
1900 if ( $item->{damaged} ){
1901 if ( C4::Context->preference('AllowHoldsOnDamagedItems') ){
1902 # can place a hold on a damaged item if AllowHoldsOnDamagedItems is true
1903 if ( ( !$item->{notforloan} || $item->{notforloan} < 0 ) ){
1904 # item is either for loan or has notforloan < 0
1905 $can_place_holds = 1;
1908 } elsif ( $item->{notforloan} < 0 ) {
1909 # item is not damaged and notforloan is < 0
1910 $can_place_holds = 1;
1917 my $key = $prefix . $item->{status};
1918 foreach (qw(wthdrawn itemlost damaged branchname itemcallnumber)) {
1919 $other_items->{$key}->{$_} = $item->{$_};
1921 $other_items->{$key}->{intransit} = ( $transfertwhen ne '' ) ? 1 : 0;
1922 $other_items->{$key}->{onhold} = ($reservestatus) ? 1 : 0;
1923 $other_items->{$key}->{notforloan} = GetAuthorisedValueDesc('','',$item->{notforloan},'','',$notforloan_authorised_value) if $notforloan_authorised_value and $item->{notforloan};
1924 $other_items->{$key}->{count}++ if $item->{$hbranch};
1925 $other_items->{$key}->{location} = $shelflocations->{ $item->{location} };
1926 $other_items->{$key}->{description} = $item->{description};
1927 $other_items->{$key}->{imageurl} = getitemtypeimagelocation( $search_context, $itemtypes{ $item->{itype} }->{imageurl} );
1931 $can_place_holds = 1;
1933 $available_items->{$prefix}->{count}++ if $item->{$hbranch};
1934 foreach (qw(branchname itemcallnumber description)) {
1935 $available_items->{$prefix}->{$_} = $item->{$_};
1937 $available_items->{$prefix}->{location} = $shelflocations->{ $item->{location} };
1938 $available_items->{$prefix}->{imageurl} = getitemtypeimagelocation( $search_context, $itemtypes{ $item->{itype} }->{imageurl} );
1941 } # notforloan, item level and biblioitem level
1943 # if all items are hidden, do not show the record
1944 if ($items_count > 0 && $hideatopac_count == $items_count) {
1948 my ( $availableitemscount, $onloanitemscount, $otheritemscount );
1949 for my $key ( sort keys %$onloan_items ) {
1950 (++$onloanitemscount > $maxitems) and last;
1951 push @onloan_items_loop, $onloan_items->{$key};
1953 for my $key ( sort keys %$other_items ) {
1954 (++$otheritemscount > $maxitems) and last;
1955 push @other_items_loop, $other_items->{$key};
1957 for my $key ( sort keys %$available_items ) {
1958 (++$availableitemscount > $maxitems) and last;
1959 push @available_items_loop, $available_items->{$key}
1962 # XSLT processing of some stuff
1964 SetUTF8Flag($marcrecord);
1965 warn $marcrecord->as_formatted if $DEBUG;
1966 my $interface = $search_context eq 'opac' ? 'OPAC' : '';
1967 if (!$scan && C4::Context->preference($interface . "XSLTResultsDisplay")) {
1968 $oldbiblio->{XSLTResultsRecord} = XSLTParse4Display($oldbiblio->{biblionumber}, $marcrecord, $interface."XSLTResultsDisplay", 1, \@hiddenitems);
1969 # the last parameter tells Koha to clean up the problematic ampersand entities that Zebra outputs
1972 # if biblio level itypes are used and itemtype is notforloan, it can't be reserved either
1973 if (!C4::Context->preference("item-level_itypes")) {
1974 if ($itemtypes{ $oldbiblio->{itemtype} }->{notforloan}) {
1975 $can_place_holds = 0;
1978 $oldbiblio->{norequests} = 1 unless $can_place_holds;
1979 $oldbiblio->{itemsplural} = 1 if $items_count > 1;
1980 $oldbiblio->{items_count} = $items_count;
1981 $oldbiblio->{available_items_loop} = \@available_items_loop;
1982 $oldbiblio->{onloan_items_loop} = \@onloan_items_loop;
1983 $oldbiblio->{other_items_loop} = \@other_items_loop;
1984 $oldbiblio->{availablecount} = $available_count;
1985 $oldbiblio->{availableplural} = 1 if $available_count > 1;
1986 $oldbiblio->{onloancount} = $onloan_count;
1987 $oldbiblio->{onloanplural} = 1 if $onloan_count > 1;
1988 $oldbiblio->{othercount} = $other_count;
1989 $oldbiblio->{otherplural} = 1 if $other_count > 1;
1990 $oldbiblio->{wthdrawncount} = $wthdrawn_count;
1991 $oldbiblio->{itemlostcount} = $itemlost_count;
1992 $oldbiblio->{damagedcount} = $itemdamaged_count;
1993 $oldbiblio->{intransitcount} = $item_in_transit_count;
1994 $oldbiblio->{onholdcount} = $item_onhold_count;
1995 $oldbiblio->{orderedcount} = $ordered_count;
1997 if (C4::Context->preference("AlternateHoldingsField") && $items_count == 0) {
1998 my $fieldspec = C4::Context->preference("AlternateHoldingsField");
1999 my $subfields = substr $fieldspec, 3;
2000 my $holdingsep = C4::Context->preference("AlternateHoldingsSeparator") || ' ';
2001 my @alternateholdingsinfo = ();
2002 my @holdingsfields = $marcrecord->field(substr $fieldspec, 0, 3);
2003 my $alternateholdingscount = 0;
2005 for my $field (@holdingsfields) {
2006 my %holding = ( holding => '' );
2007 my $havesubfield = 0;
2008 for my $subfield ($field->subfields()) {
2009 if ((index $subfields, $$subfield[0]) >= 0) {
2010 $holding{'holding'} .= $holdingsep if (length $holding{'holding'} > 0);
2011 $holding{'holding'} .= $$subfield[1];
2015 if ($havesubfield) {
2016 push(@alternateholdingsinfo, \%holding);
2017 $alternateholdingscount++;
2021 $oldbiblio->{'ALTERNATEHOLDINGS'} = \@alternateholdingsinfo;
2022 $oldbiblio->{'alternateholdings_count'} = $alternateholdingscount;
2025 push( @newresults, $oldbiblio );
2031 =head2 SearchAcquisitions
2032 Search for acquisitions
2035 sub SearchAcquisitions{
2036 my ($datebegin, $dateend, $itemtypes,$criteria, $orderby) = @_;
2038 my $dbh=C4::Context->dbh;
2039 # Variable initialization
2043 LEFT JOIN biblioitems ON biblioitems.biblionumber=biblio.biblionumber
2044 LEFT JOIN items ON items.biblionumber=biblio.biblionumber
2045 WHERE dateaccessioned BETWEEN ? AND ?
2048 my (@params,@loopcriteria);
2050 push @params, $datebegin->output("iso");
2051 push @params, $dateend->output("iso");
2053 if (scalar(@$itemtypes)>0 and $criteria ne "itemtype" ){
2054 if(C4::Context->preference("item-level_itypes")){
2055 $str .= "AND items.itype IN (?".( ',?' x scalar @$itemtypes - 1 ).") ";
2057 $str .= "AND biblioitems.itemtype IN (?".( ',?' x scalar @$itemtypes - 1 ).") ";
2059 push @params, @$itemtypes;
2062 if ($criteria =~/itemtype/){
2063 if(C4::Context->preference("item-level_itypes")){
2064 $str .= "AND items.itype=? ";
2066 $str .= "AND biblioitems.itemtype=? ";
2069 if(scalar(@$itemtypes) == 0){
2070 my $itypes = GetItemTypes();
2071 for my $key (keys %$itypes){
2072 push @$itemtypes, $key;
2076 @loopcriteria= @$itemtypes;
2077 }elsif ($criteria=~/itemcallnumber/){
2078 $str .= "AND (items.itemcallnumber LIKE CONCAT(?,'%')
2079 OR items.itemcallnumber is NULL
2080 OR items.itemcallnumber = '')";
2082 @loopcriteria = ("AA".."ZZ", "") unless (scalar(@loopcriteria)>0);
2084 $str .= "AND biblio.title LIKE CONCAT(?,'%') ";
2085 @loopcriteria = ("A".."z") unless (scalar(@loopcriteria)>0);
2088 if ($orderby =~ /date_desc/){
2089 $str.=" ORDER BY dateaccessioned DESC";
2091 $str.=" ORDER BY title";
2094 my $qdataacquisitions=$dbh->prepare($str);
2096 my @loopacquisitions;
2097 foreach my $value(@loopcriteria){
2098 push @params,$value;
2100 $cell{"title"}=$value;
2101 $cell{"titlecode"}=$value;
2103 eval{$qdataacquisitions->execute(@params);};
2105 if ($@){ warn "recentacquisitions Error :$@";}
2108 while (my $data=$qdataacquisitions->fetchrow_hashref){
2109 push @loopdata, {"summary"=>GetBiblioSummary( $data->{'marcxml'} ) };
2111 $cell{"loopdata"}=\@loopdata;
2113 push @loopacquisitions,\%cell if (scalar(@{$cell{loopdata}})>0);
2116 $qdataacquisitions->finish;
2117 return \@loopacquisitions;
2119 #----------------------------------------------------------------------
2121 # Non-Zebra GetRecords#
2122 #----------------------------------------------------------------------
2126 NZgetRecords has the same API as zera getRecords, even if some parameters are not managed
2132 $query, $simple_query, $sort_by_ref, $servers_ref,
2133 $results_per_page, $offset, $expanded_facet, $branches,
2136 warn "query =$query" if $DEBUG;
2137 my $result = NZanalyse($query);
2138 warn "results =$result" if $DEBUG;
2140 NZorder( $result, @$sort_by_ref[0], $results_per_page, $offset ),
2146 NZanalyse : get a CQL string as parameter, and returns a list of biblionumber;title,biblionumber;title,...
2147 the list is built from an inverted index in the nozebra SQL table
2148 note that title is here only for convenience : the sorting will be very fast when requested on title
2149 if the sorting is requested on something else, we will have to reread all results, and that may be longer.
2154 my ( $string, $server ) = @_;
2155 # warn "---------" if $DEBUG;
2156 warn " NZanalyse" if $DEBUG;
2157 # warn "---------" if $DEBUG;
2159 # $server contains biblioserver or authorities, depending on what we search on.
2160 #warn "querying : $string on $server";
2161 $server = 'biblioserver' unless $server;
2163 # if we have a ", replace the content to discard temporarily any and/or/not inside
2165 if ( $string =~ /"/ ) {
2166 $string =~ s/"(.*?)"/__X__/;
2168 warn "commacontent : $commacontent" if $DEBUG;
2171 # split the query string in 3 parts : X AND Y means : $left="X", $operand="AND" and $right="Y"
2172 # then, call again NZanalyse with $left and $right
2173 # (recursive until we find a leaf (=> something without and/or/not)
2174 # delete repeated operator... Would then go in infinite loop
2175 while ( $string =~ s/( and| or| not| AND| OR| NOT)\1/$1/g ) {
2178 #process parenthesis before.
2179 if ( $string =~ /^\s*\((.*)\)(( and | or | not | AND | OR | NOT )(.*))?/ ) {
2182 my $operator = lc($3); # FIXME: and/or/not are operators, not operands
2184 "dealing w/parenthesis before recursive sub call. left :$left operator:$operator right:$right"
2186 my $leftresult = NZanalyse( $left, $server );
2188 my $rightresult = NZanalyse( $right, $server );
2190 # OK, we have the results for right and left part of the query
2191 # depending of operand, intersect, union or exclude both lists
2192 # to get a result list
2193 if ( $operator eq ' and ' ) {
2194 return NZoperatorAND($leftresult,$rightresult);
2196 elsif ( $operator eq ' or ' ) {
2198 # just merge the 2 strings
2199 return $leftresult . $rightresult;
2201 elsif ( $operator eq ' not ' ) {
2202 return NZoperatorNOT($leftresult,$rightresult);
2206 # this error is impossible, because of the regexp that isolate the operand, but just in case...
2210 warn "string :" . $string if $DEBUG;
2214 if ($string =~ /(.*?)( and | or | not | AND | OR | NOT )(.*)/) {
2217 $operator = lc($2); # FIXME: and/or/not are operators, not operands
2219 warn "no parenthesis. left : $left operator: $operator right: $right"
2222 # it's not a leaf, we have a and/or/not
2225 # reintroduce comma content if needed
2226 $right =~ s/__X__/"$commacontent"/ if $commacontent;
2227 $left =~ s/__X__/"$commacontent"/ if $commacontent;
2228 warn "node : $left / $operator / $right\n" if $DEBUG;
2229 my $leftresult = NZanalyse( $left, $server );
2230 my $rightresult = NZanalyse( $right, $server );
2231 warn " leftresult : $leftresult" if $DEBUG;
2232 warn " rightresult : $rightresult" if $DEBUG;
2233 # OK, we have the results for right and left part of the query
2234 # depending of operand, intersect, union or exclude both lists
2235 # to get a result list
2236 if ( $operator eq ' and ' ) {
2237 return NZoperatorAND($leftresult,$rightresult);
2239 elsif ( $operator eq ' or ' ) {
2241 # just merge the 2 strings
2242 return $leftresult . $rightresult;
2244 elsif ( $operator eq ' not ' ) {
2245 return NZoperatorNOT($leftresult,$rightresult);
2249 # this error is impossible, because of the regexp that isolate the operand, but just in case...
2250 die "error : operand unknown : $operator for $string";
2253 # it's a leaf, do the real SQL query and return the result
2256 $string =~ s/__X__/"$commacontent"/ if $commacontent;
2257 $string =~ s/-|\.|\?|,|;|!|'|\(|\)|\[|\]|{|}|"|&|\+|\*|\// /g;
2258 #remove trailing blank at the beginning
2260 warn "leaf:$string" if $DEBUG;
2262 # parse the string in in operator/operand/value again
2266 if ($string =~ /(.*)(>=|<=)(.*)/) {
2273 # warn "handling leaf... left:$left operator:$operator right:$right"
2275 unless ($operator) {
2276 if ($string =~ /(.*)(>|<|=)(.*)/) {
2281 "handling unless (operator)... left:$left operator:$operator right:$right"
2289 # strip adv, zebra keywords, currently not handled in nozebra: wrdl, ext, phr...
2292 # automatic replace for short operators
2293 $left = 'title' if $left =~ '^ti$';
2294 $left = 'author' if $left =~ '^au$';
2295 $left = 'publisher' if $left =~ '^pb$';
2296 $left = 'subject' if $left =~ '^su$';
2297 $left = 'koha-Auth-Number' if $left =~ '^an$';
2298 $left = 'keyword' if $left =~ '^kw$';
2299 $left = 'itemtype' if $left =~ '^mc$'; # Fix for Bug 2599 - Search limits not working for NoZebra
2300 warn "handling leaf... left:$left operator:$operator right:$right" if $DEBUG;
2301 my $dbh = C4::Context->dbh;
2302 if ( $operator && $left ne 'keyword' ) {
2303 #do a specific search
2304 $operator = 'LIKE' if $operator eq '=' and $right =~ /%/;
2305 my $sth = $dbh->prepare(
2306 "SELECT biblionumbers,value FROM nozebra WHERE server=? AND indexname=? AND value $operator ?"
2308 warn "$left / $operator / $right\n" if $DEBUG;
2310 # split each word, query the DB and build the biblionumbers result
2311 #sanitizing leftpart
2312 $left =~ s/^\s+|\s+$//;
2313 foreach ( split / /, $right ) {
2315 $_ =~ s/^\s+|\s+$//;
2317 warn "EXECUTE : $server, $left, $_" if $DEBUG;
2318 $sth->execute( $server, $left, $_ )
2319 or warn "execute failed: $!";
2320 while ( my ( $line, $value ) = $sth->fetchrow ) {
2322 # if we are dealing with a numeric value, use only numeric results (in case of >=, <=, > or <)
2323 # otherwise, fill the result
2324 $biblionumbers .= $line
2325 unless ( $right =~ /^\d+$/ && $value =~ /\D/ );
2326 warn "result : $value "
2327 . ( $right =~ /\d/ ) . "=="
2328 . ( $value =~ /\D/?$line:"" ) if $DEBUG; #= $line";
2331 # do a AND with existing list if there is one, otherwise, use the biblionumbers list as 1st result list
2333 warn "NZAND" if $DEBUG;
2334 $results = NZoperatorAND($biblionumbers,$results);
2336 $results = $biblionumbers;
2341 #do a complete search (all indexes), if index='kw' do complete search too.
2342 my $sth = $dbh->prepare(
2343 "SELECT biblionumbers FROM nozebra WHERE server=? AND value LIKE ?"
2346 # split each word, query the DB and build the biblionumbers result
2347 foreach ( split / /, $string ) {
2348 next if C4::Context->stopwords->{ uc($_) }; # skip if stopword
2349 warn "search on all indexes on $_" if $DEBUG;
2352 $sth->execute( $server, $_ );
2353 while ( my $line = $sth->fetchrow ) {
2354 $biblionumbers .= $line;
2357 # do a AND with existing list if there is one, otherwise, use the biblionumbers list as 1st result list
2359 $results = NZoperatorAND($biblionumbers,$results);
2362 warn "NEW RES for $_ = $biblionumbers" if $DEBUG;
2363 $results = $biblionumbers;
2367 warn "return : $results for LEAF : $string" if $DEBUG;
2370 warn "---------\nLeave NZanalyse\n---------" if $DEBUG;
2374 my ($rightresult, $leftresult)=@_;
2376 my @leftresult = split /;/, $leftresult;
2377 warn " @leftresult / $rightresult \n" if $DEBUG;
2379 # my @rightresult = split /;/,$leftresult;
2382 # parse the left results, and if the biblionumber exist in the right result, save it in finalresult
2383 # the result is stored twice, to have the same weight for AND than OR.
2384 # example : TWO : 61,61,64,121 (two is twice in the biblio #61) / TOWER : 61,64,130
2385 # result : 61,61,61,61,64,64 for two AND tower : 61 has more weight than 64
2386 foreach (@leftresult) {
2389 ( $value, $countvalue ) = ( $1, $2 ) if ($value=~/(.*)-(\d+)$/);
2390 if ( $rightresult =~ /\Q$value\E-(\d+);/ ) {
2391 $countvalue = ( $1 > $countvalue ? $countvalue : $1 );
2393 "$value-$countvalue;$value-$countvalue;";
2396 warn "NZAND DONE : $finalresult \n" if $DEBUG;
2397 return $finalresult;
2401 my ($rightresult, $leftresult)=@_;
2402 return $rightresult.$leftresult;
2406 my ($leftresult, $rightresult)=@_;
2408 my @leftresult = split /;/, $leftresult;
2410 # my @rightresult = split /;/,$leftresult;
2412 foreach (@leftresult) {
2414 $value=$1 if $value=~m/(.*)-\d+$/;
2415 unless ($rightresult =~ "$value-") {
2416 $finalresult .= "$_;";
2419 return $finalresult;
2424 $finalresult = NZorder($biblionumbers, $ordering,$results_per_page,$offset);
2431 my ( $biblionumbers, $ordering, $results_per_page, $offset ) = @_;
2432 warn "biblionumbers = $biblionumbers and ordering = $ordering\n" if $DEBUG;
2434 # order title asc by default
2435 # $ordering = '1=36 <i' unless $ordering;
2436 $results_per_page = 20 unless $results_per_page;
2437 $offset = 0 unless $offset;
2438 my $dbh = C4::Context->dbh;
2441 # order by POPULARITY
2443 if ( $ordering =~ /popularity/ ) {
2447 # popularity is not in MARC record, it's builded from a specific query
2449 $dbh->prepare("select sum(issues) from items where biblionumber=?");
2450 foreach ( split /;/, $biblionumbers ) {
2451 my ( $biblionumber, $title ) = split /,/, $_;
2452 $result{$biblionumber} = GetMarcBiblio($biblionumber);
2453 $sth->execute($biblionumber);
2454 my $popularity = $sth->fetchrow || 0;
2456 # hint : the key is popularity.title because we can have
2457 # many results with the same popularity. In this case, sub-ordering is done by title
2458 # we also have biblionumber to avoid bug for 2 biblios with the same title & popularity
2459 # (un-frequent, I agree, but we won't forget anything that way ;-)
2460 $popularity{ sprintf( "%10d", $popularity ) . $title
2461 . $biblionumber } = $biblionumber;
2464 # sort the hash and return the same structure as GetRecords (Zebra querying)
2467 if ( $ordering eq 'popularity_dsc' ) { # sort popularity DESC
2468 foreach my $key ( sort { $b cmp $a } ( keys %popularity ) ) {
2469 $result_hash->{'RECORDS'}[ $numbers++ ] =
2470 $result{ $popularity{$key} }->as_usmarc();
2473 else { # sort popularity ASC
2474 foreach my $key ( sort ( keys %popularity ) ) {
2475 $result_hash->{'RECORDS'}[ $numbers++ ] =
2476 $result{ $popularity{$key} }->as_usmarc();
2479 my $finalresult = ();
2480 $result_hash->{'hits'} = $numbers;
2481 $finalresult->{'biblioserver'} = $result_hash;
2482 return $finalresult;
2488 elsif ( $ordering =~ /author/ ) {
2490 foreach ( split /;/, $biblionumbers ) {
2491 my ( $biblionumber, $title ) = split /,/, $_;
2492 my $record = GetMarcBiblio($biblionumber);
2494 if ( C4::Context->preference('marcflavour') eq 'UNIMARC' ) {
2495 $author = $record->subfield( '200', 'f' );
2496 $author = $record->subfield( '700', 'a' ) unless $author;
2499 $author = $record->subfield( '100', 'a' );
2502 # hint : the result is sorted by title.biblionumber because we can have X biblios with the same title
2503 # and we don't want to get only 1 result for each of them !!!
2504 $result{ $author . $biblionumber } = $record;
2507 # sort the hash and return the same structure as GetRecords (Zebra querying)
2510 if ( $ordering eq 'author_za' || $ordering eq 'author_dsc' ) { # sort by author desc
2511 foreach my $key ( sort { $b cmp $a } ( keys %result ) ) {
2512 $result_hash->{'RECORDS'}[ $numbers++ ] =
2513 $result{$key}->as_usmarc();
2516 else { # sort by author ASC
2517 foreach my $key ( sort ( keys %result ) ) {
2518 $result_hash->{'RECORDS'}[ $numbers++ ] =
2519 $result{$key}->as_usmarc();
2522 my $finalresult = ();
2523 $result_hash->{'hits'} = $numbers;
2524 $finalresult->{'biblioserver'} = $result_hash;
2525 return $finalresult;
2528 # ORDER BY callnumber
2531 elsif ( $ordering =~ /callnumber/ ) {
2533 foreach ( split /;/, $biblionumbers ) {
2534 my ( $biblionumber, $title ) = split /,/, $_;
2535 my $record = GetMarcBiblio($biblionumber);
2537 my $frameworkcode = GetFrameworkCode($biblionumber);
2538 my ( $callnumber_tag, $callnumber_subfield ) = GetMarcFromKohaField( 'items.itemcallnumber', $frameworkcode);
2539 ( $callnumber_tag, $callnumber_subfield ) = GetMarcFromKohaField('biblioitems.callnumber', $frameworkcode)
2540 unless $callnumber_tag;
2541 if ( C4::Context->preference('marcflavour') eq 'UNIMARC' ) {
2542 $callnumber = $record->subfield( '200', 'f' );
2544 $callnumber = $record->subfield( '100', 'a' );
2547 # hint : the result is sorted by title.biblionumber because we can have X biblios with the same title
2548 # and we don't want to get only 1 result for each of them !!!
2549 $result{ $callnumber . $biblionumber } = $record;
2552 # sort the hash and return the same structure as GetRecords (Zebra querying)
2555 if ( $ordering eq 'call_number_dsc' ) { # sort by title desc
2556 foreach my $key ( sort { $b cmp $a } ( keys %result ) ) {
2557 $result_hash->{'RECORDS'}[ $numbers++ ] =
2558 $result{$key}->as_usmarc();
2561 else { # sort by title ASC
2562 foreach my $key ( sort { $a cmp $b } ( keys %result ) ) {
2563 $result_hash->{'RECORDS'}[ $numbers++ ] =
2564 $result{$key}->as_usmarc();
2567 my $finalresult = ();
2568 $result_hash->{'hits'} = $numbers;
2569 $finalresult->{'biblioserver'} = $result_hash;
2570 return $finalresult;
2572 elsif ( $ordering =~ /pubdate/ ) { #pub year
2574 foreach ( split /;/, $biblionumbers ) {
2575 my ( $biblionumber, $title ) = split /,/, $_;
2576 my $record = GetMarcBiblio($biblionumber);
2577 my ( $publicationyear_tag, $publicationyear_subfield ) =
2578 GetMarcFromKohaField( 'biblioitems.publicationyear', '' );
2579 my $publicationyear =
2580 $record->subfield( $publicationyear_tag,
2581 $publicationyear_subfield );
2583 # hint : the result is sorted by title.biblionumber because we can have X biblios with the same title
2584 # and we don't want to get only 1 result for each of them !!!
2585 $result{ $publicationyear . $biblionumber } = $record;
2588 # sort the hash and return the same structure as GetRecords (Zebra querying)
2591 if ( $ordering eq 'pubdate_dsc' ) { # sort by pubyear desc
2592 foreach my $key ( sort { $b cmp $a } ( keys %result ) ) {
2593 $result_hash->{'RECORDS'}[ $numbers++ ] =
2594 $result{$key}->as_usmarc();
2597 else { # sort by pub year ASC
2598 foreach my $key ( sort ( keys %result ) ) {
2599 $result_hash->{'RECORDS'}[ $numbers++ ] =
2600 $result{$key}->as_usmarc();
2603 my $finalresult = ();
2604 $result_hash->{'hits'} = $numbers;
2605 $finalresult->{'biblioserver'} = $result_hash;
2606 return $finalresult;
2612 elsif ( $ordering =~ /title/ ) {
2614 # the title is in the biblionumbers string, so we just need to build a hash, sort it and return
2616 foreach ( split /;/, $biblionumbers ) {
2617 my ( $biblionumber, $title ) = split /,/, $_;
2619 # hint : the result is sorted by title.biblionumber because we can have X biblios with the same title
2620 # and we don't want to get only 1 result for each of them !!!
2621 # hint & speed improvement : we can order without reading the record
2622 # so order, and read records only for the requested page !
2623 $result{ $title . $biblionumber } = $biblionumber;
2626 # sort the hash and return the same structure as GetRecords (Zebra querying)
2629 if ( $ordering eq 'title_az' ) { # sort by title desc
2630 foreach my $key ( sort ( keys %result ) ) {
2631 $result_hash->{'RECORDS'}[ $numbers++ ] = $result{$key};
2634 else { # sort by title ASC
2635 foreach my $key ( sort { $b cmp $a } ( keys %result ) ) {
2636 $result_hash->{'RECORDS'}[ $numbers++ ] = $result{$key};
2640 # limit the $results_per_page to result size if it's more
2641 $results_per_page = $numbers - 1 if $numbers < $results_per_page;
2643 # for the requested page, replace biblionumber by the complete record
2644 # speed improvement : avoid reading too much things
2646 my $counter = $offset ;
2647 $counter <= $offset + $results_per_page ;
2651 $result_hash->{'RECORDS'}[$counter] =
2652 GetMarcBiblio( $result_hash->{'RECORDS'}[$counter] )->as_usmarc;
2654 my $finalresult = ();
2655 $result_hash->{'hits'} = $numbers;
2656 $finalresult->{'biblioserver'} = $result_hash;
2657 return $finalresult;
2664 # we need 2 hashes to order by ranking : the 1st one to count the ranking, the 2nd to order by ranking
2667 foreach ( split /;/, $biblionumbers ) {
2668 my ( $biblionumber, $title ) = split /,/, $_;
2669 $title =~ /(.*)-(\d)/;
2674 # note that we + the ranking because ranking is calculated on weight of EACH term requested.
2675 # if we ask for "two towers", and "two" has weight 2 in biblio N, and "towers" has weight 4 in biblio N
2676 # biblio N has ranking = 6
2677 $count_ranking{$biblionumber} += $ranking;
2680 # build the result by "inverting" the count_ranking hash
2681 # hing : as usual, we don't order by ranking only, to avoid having only 1 result for each rank. We build an hash on concat(ranking,biblionumber) instead
2683 foreach ( keys %count_ranking ) {
2684 $result{ sprintf( "%10d", $count_ranking{$_} ) . '-' . $_ } = $_;
2687 # sort the hash and return the same structure as GetRecords (Zebra querying)
2690 foreach my $key ( sort { $b cmp $a } ( keys %result ) ) {
2691 $result_hash->{'RECORDS'}[ $numbers++ ] = $result{$key};
2694 # limit the $results_per_page to result size if it's more
2695 $results_per_page = $numbers - 1 if $numbers < $results_per_page;
2697 # for the requested page, replace biblionumber by the complete record
2698 # speed improvement : avoid reading too much things
2700 my $counter = $offset ;
2701 $counter <= $offset + $results_per_page ;
2705 $result_hash->{'RECORDS'}[$counter] =
2706 GetMarcBiblio( $result_hash->{'RECORDS'}[$counter] )->as_usmarc
2707 if $result_hash->{'RECORDS'}[$counter];
2709 my $finalresult = ();
2710 $result_hash->{'hits'} = $numbers;
2711 $finalresult->{'biblioserver'} = $result_hash;
2712 return $finalresult;
2716 =head2 enabled_staff_search_views
2718 %hash = enabled_staff_search_views()
2720 This function returns a hash that contains three flags obtained from the system
2721 preferences, used to determine whether a particular staff search results view
2726 =item C<Output arg:>
2728 * $hash{can_view_MARC} is true only if the MARC view is enabled
2729 * $hash{can_view_ISBD} is true only if the ISBD view is enabled
2730 * $hash{can_view_labeledMARC} is true only if the Labeled MARC view is enabled
2732 =item C<usage in the script:>
2736 $template->param ( C4::Search::enabled_staff_search_views );
2740 sub enabled_staff_search_views
2743 can_view_MARC => C4::Context->preference('viewMARC'), # 1 if the staff search allows the MARC view
2744 can_view_ISBD => C4::Context->preference('viewISBD'), # 1 if the staff search allows the ISBD view
2745 can_view_labeledMARC => C4::Context->preference('viewLabeledMARC'), # 1 if the staff search allows the Labeled MARC view
2749 sub AddSearchHistory{
2750 my ($borrowernumber,$session,$query_desc,$query_cgi, $total)=@_;
2751 my $dbh = C4::Context->dbh;
2753 # Add the request the user just made
2754 my $sql = "INSERT INTO search_history(userid, sessionid, query_desc, query_cgi, total, time) VALUES(?, ?, ?, ?, ?, NOW())";
2755 my $sth = $dbh->prepare($sql);
2756 $sth->execute($borrowernumber, $session, $query_desc, $query_cgi, $total);
2757 return $dbh->last_insert_id(undef, 'search_history', undef,undef,undef);
2760 sub GetSearchHistory{
2761 my ($borrowernumber,$session)=@_;
2762 my $dbh = C4::Context->dbh;
2764 # Add the request the user just made
2765 my $query = "SELECT FROM search_history WHERE (userid=? OR sessionid=?)";
2766 my $sth = $dbh->prepare($query);
2767 $sth->execute($borrowernumber, $session);
2768 return $sth->fetchall_hashref({});
2771 =head2 z3950_search_args
2773 $arrayref = z3950_search_args($matchpoints)
2775 This function returns an array reference that contains the search parameters to be
2776 passed to the Z39.50 search script (z3950_search.pl). The array elements
2777 are hash refs whose keys are name, value and encvalue, and whose values are the
2778 name of a search parameter, the value of that search parameter and the URL encoded
2779 value of that parameter.
2781 The search parameter names are lccn, isbn, issn, title, author, dewey and subject.
2783 The search parameter values are obtained from the bibliographic record whose
2784 data is in a hash reference in $matchpoints, as returned by Biblio::GetBiblioData().
2786 If $matchpoints is a scalar, it is assumed to be an unnamed query descriptor, e.g.
2787 a general purpose search argument. In this case, the returned array contains only
2788 entry: the key is 'title' and the value and encvalue are derived from $matchpoints.
2790 If a search parameter value is undefined or empty, it is not included in the returned
2793 The returned array reference may be passed directly to the template parameters.
2797 =item C<Output arg:>
2799 * $array containing hash refs as described above
2801 =item C<usage in the script:>
2805 $data = Biblio::GetBiblioData($bibno);
2806 $template->param ( MYLOOP => C4::Search::z3950_search_args($data) )
2810 $template->param ( MYLOOP => C4::Search::z3950_search_args($searchscalar) )
2814 sub z3950_search_args {
2816 my $isbn = Business::ISBN->new($bibrec);
2818 if (defined $isbn && $isbn->is_valid)
2820 $bibrec = { isbn => $bibrec } if !ref $bibrec;
2823 $bibrec = { title => $bibrec } if !ref $bibrec;
2826 for my $field (qw/ lccn isbn issn title author dewey subject /)
2828 my $encvalue = URI::Escape::uri_escape_utf8($bibrec->{$field});
2829 push @$array, { name=>$field, value=>$bibrec->{$field}, encvalue=>$encvalue } if defined $bibrec->{$field};
2834 =head2 GetDistinctValues($field);
2836 C<$field> is a reference to the fields array
2840 sub GetDistinctValues {
2841 my ($fieldname,$string)=@_;
2842 # returns a reference to a hash of references to branches...
2843 if ($fieldname=~/\./){
2844 my ($table,$column)=split /\./, $fieldname;
2845 my $dbh = C4::Context->dbh;
2846 warn "select DISTINCT($column) as value, count(*) as cnt from $table group by lib order by $column " if $DEBUG;
2847 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 ");
2849 my $elements=$sth->fetchall_arrayref({});
2854 my @servers=qw<biblioserver authorityserver>;
2855 my (@zconns,@results);
2856 for ( my $i = 0 ; $i < @servers ; $i++ ) {
2857 $zconns[$i] = C4::Context->Zconn( $servers[$i], 1 );
2860 ZOOM::Query::CCL2RPN->new( qq"$fieldname $string", $zconns[$i])
2863 # The big moment: asynchronously retrieve results from all servers
2869 my ( $i, $size ) = @_;
2870 for ( my $j = 0 ; $j < $size ; $j++ ) {
2872 @hashscan{qw(value cnt)} =
2873 $results[ $i - 1 ]->display_term($j);
2874 push @elements, \%hashscan;
2882 =head2 _ZOOM_event_loop
2884 _ZOOM_event_loop(\@zconns, \@results, sub {
2885 my ( $i, $size ) = @_;
2889 Processes a ZOOM event loop and passes control to a closure for
2890 processing the results, and destroying the resultsets.
2894 sub _ZOOM_event_loop {
2895 my ($zconns, $results, $callback) = @_;
2896 while ( ( my $i = ZOOM::event( $zconns ) ) != 0 ) {
2897 my $ev = $zconns->[ $i - 1 ]->last_event();
2898 if ( $ev == ZOOM::Event::ZEND ) {
2899 next unless $results->[ $i - 1 ];
2900 my $size = $results->[ $i - 1 ]->size();
2902 $callback->($i, $size);
2907 foreach my $result (@$results) {
2913 END { } # module clean-up code here (global destructor)
2920 Koha Development Team <http://koha-community.org/>