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
21 use C4::Biblio; # GetMarcFromKohaField
22 use C4::Koha; # getFacets
24 use C4::Dates qw(format_date);
26 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $DEBUG);
28 # set the version for version checking
31 $DEBUG = ($ENV{DEBUG}) ? 1 : 0;
36 C4::Search - Functions for searching the Koha catalog.
40 See opac/opac-search.pl or catalogue/search.pl for example of usage
44 This module provides searching functions for Koha's bibliographic databases
62 # make all your functions, whether exported or not;
64 =head2 findseealso($dbh,$fields);
66 C<$dbh> is a link to the DB handler.
69 my $dbh =C4::Context->dbh;
71 C<$fields> is a reference to the fields array
73 This function modifies the @$fields array and adds related fields to search on.
75 FIXME: this function is probably deprecated in Koha 3
80 my ( $dbh, $fields ) = @_;
81 my $tagslib = GetMarcStructure(1);
82 for ( my $i = 0 ; $i <= $#{$fields} ; $i++ ) {
83 my ($tag) = substr( @$fields[$i], 1, 3 );
84 my ($subfield) = substr( @$fields[$i], 4, 1 );
85 @$fields[$i] .= ',' . $tagslib->{$tag}->{$subfield}->{seealso}
86 if ( $tagslib->{$tag}->{$subfield}->{seealso} );
92 ($biblionumber,$biblionumber,$title) = FindDuplicate($record);
94 This function attempts to find duplicate records using a hard-coded, fairly simplistic algorithm
100 my $dbh = C4::Context->dbh;
101 my $result = TransformMarcToKoha( $dbh, $record, '' );
106 my ( $biblionumber, $title );
108 # search duplicate on ISBN, easy and fast..
109 # ... normalize first
110 if ( $result->{isbn} ) {
111 $result->{isbn} =~ s/\(.*$//;
112 $result->{isbn} =~ s/\s+$//;
113 $query = "isbn=$result->{isbn}";
116 $result->{title} =~ s /\\//g;
117 $result->{title} =~ s /\"//g;
118 $result->{title} =~ s /\(//g;
119 $result->{title} =~ s /\)//g;
121 # FIXME: instead of removing operators, could just do
122 # quotes around the value
123 $result->{title} =~ s/(and|or|not)//g;
124 $query = "ti,ext=$result->{title}";
125 $query .= " and itemtype=$result->{itemtype}"
126 if ( $result->{itemtype} );
127 if ( $result->{author} ) {
128 $result->{author} =~ s /\\//g;
129 $result->{author} =~ s /\"//g;
130 $result->{author} =~ s /\(//g;
131 $result->{author} =~ s /\)//g;
133 # remove valid operators
134 $result->{author} =~ s/(and|or|not)//g;
135 $query .= " and au,ext=$result->{author}";
139 # FIXME: add error handling
140 my ( $error, $searchresults ) = SimpleSearch($query); # FIXME :: hardcoded !
142 foreach my $possible_duplicate_record (@$searchresults) {
144 MARC::Record->new_from_usmarc($possible_duplicate_record);
145 my $result = TransformMarcToKoha( $dbh, $marcrecord, '' );
147 # FIXME :: why 2 $biblionumber ?
149 push @results, $result->{'biblionumber'};
150 push @results, $result->{'title'};
158 ($error,$results) = SimpleSearch($query,@servers);
160 This function provides a simple search API on the bibliographic catalog
166 * $query can be a simple keyword or a complete CCL query
167 * @servers is optional. Defaults to biblioserver as found in koha-conf.xml
170 * $error is a empty unless an error is detected
171 * \@results is an array of records.
173 =item C<usage in the script:>
177 my ($error, $marcresults) = 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 = scalar @$marcresults;
189 for(my $i=0;$i<$hits;$i++) {
191 my $marcrecord = MARC::File::USMARC::decode($marcresults->[$i]);
192 my $biblio = TransformMarcToKoha(C4::Context->dbh,$marcrecord,'');
194 #build the hash for the template.
195 $resultsloop{highlight} = ($i % 2)?(1):(0);
196 $resultsloop{title} = $biblio->{'title'};
197 $resultsloop{subtitle} = $biblio->{'subtitle'};
198 $resultsloop{biblionumber} = $biblio->{'biblionumber'};
199 $resultsloop{author} = $biblio->{'author'};
200 $resultsloop{publishercode} = $biblio->{'publishercode'};
201 $resultsloop{publicationyear} = $biblio->{'publicationyear'};
203 push @results, \%resultsloop;
206 $template->param(result=>\@results);
212 if ( C4::Context->preference('NoZebra') ) {
213 my $result = NZorder( NZanalyse($query) )->{'biblioserver'};
216 && $result->{hits} > 0 ? $result->{'RECORDS'} : [] );
217 return ( undef, $search_result );
224 return ( "No query entered", undef ) unless $query;
226 # FIXME hardcoded value. See catalog/search.pl & opac-search.pl too.
227 @servers = ("biblioserver") unless @servers;
229 # Initialize & Search Zebra
230 for ( my $i = 0 ; $i < @servers ; $i++ ) {
232 $zconns[$i] = C4::Context->Zconn( $servers[$i], 1 );
235 ->search( new ZOOM::Query::CCL2RPN( $query, $zconns[$i] ) );
239 $zconns[$i]->errmsg() . " ("
240 . $zconns[$i]->errcode() . ") "
241 . $zconns[$i]->addinfo() . " "
242 . $zconns[$i]->diagset();
244 return ( $error, undef ) if $zconns[$i]->errcode();
248 # caught a ZOOM::Exception
252 . $@->addinfo() . " "
255 return ( $error, undef );
260 while ( ( my $i = ZOOM::event( \@zconns ) ) != 0 ) {
261 $ev = $zconns[ $i - 1 ]->last_event();
262 if ( $ev == ZOOM::Event::ZEND ) {
263 $hits = $tmpresults[ $i - 1 ]->size();
266 for ( my $j = 0 ; $j < $hits ; $j++ ) {
267 my $record = $tmpresults[ $i - 1 ]->record($j)->raw();
268 push @results, $record;
272 return ( undef, \@results );
278 ( undef, $results_hashref, \@facets_loop ) = getRecords (
280 $koha_query, $simple_query, $sort_by_ref, $servers_ref,
281 $results_per_page, $offset, $expanded_facet, $branches,
285 The all singing, all dancing, multi-server, asynchronous, scanning,
286 searching, record nabbing, facet-building
288 See verbse embedded documentation.
294 $koha_query, $simple_query, $sort_by_ref, $servers_ref,
295 $results_per_page, $offset, $expanded_facet, $branches,
299 my @servers = @$servers_ref;
300 my @sort_by = @$sort_by_ref;
302 # Initialize variables for the ZOOM connection and results object
306 my $results_hashref = ();
308 # Initialize variables for the faceted results objects
309 my $facets_counter = ();
310 my $facets_info = ();
311 my $facets = getFacets();
314 ; # stores the ref to array of hashes for template facets loop
316 ### LOOP THROUGH THE SERVERS
317 for ( my $i = 0 ; $i < @servers ; $i++ ) {
318 $zconns[$i] = C4::Context->Zconn( $servers[$i], 1 );
320 # perform the search, create the results objects
321 # if this is a local search, use the $koha-query, if it's a federated one, use the federated-query
323 if ( $servers[$i] =~ /biblioserver/ ) {
324 $query_to_use = $koha_query;
327 $query_to_use = $simple_query;
330 #$query_to_use = $simple_query if $scan;
331 warn $simple_query if ( $scan and $DEBUG );
333 # Check if we've got a query_type defined, if so, use it
337 if ( $query_type =~ /^ccl/ ) {
339 s/\:/\=/g; # change : to = last minute (FIXME)
342 new ZOOM::Query::CCL2RPN( $query_to_use, $zconns[$i] )
345 elsif ( $query_type =~ /^cql/ ) {
348 new ZOOM::Query::CQL( $query_to_use, $zconns[$i] ) );
350 elsif ( $query_type =~ /^pqf/ ) {
353 new ZOOM::Query::PQF( $query_to_use, $zconns[$i] ) );
360 new ZOOM::Query::CCL2RPN( $query_to_use, $zconns[$i] )
366 new ZOOM::Query::CCL2RPN( $query_to_use, $zconns[$i] )
372 warn "WARNING: query problem with $query_to_use " . $@;
375 # Concatenate the sort_by limits and pass them to the results object
376 # Note: sort will override rank
378 foreach my $sort (@sort_by) {
379 if ( $sort eq "author_az" ) {
380 $sort_by .= "1=1003 <i ";
382 elsif ( $sort eq "author_za" ) {
383 $sort_by .= "1=1003 >i ";
385 elsif ( $sort eq "popularity_asc" ) {
386 $sort_by .= "1=9003 <i ";
388 elsif ( $sort eq "popularity_dsc" ) {
389 $sort_by .= "1=9003 >i ";
391 elsif ( $sort eq "call_number_asc" ) {
392 $sort_by .= "1=20 <i ";
394 elsif ( $sort eq "call_number_dsc" ) {
395 $sort_by .= "1=20 >i ";
397 elsif ( $sort eq "pubdate_asc" ) {
398 $sort_by .= "1=31 <i ";
400 elsif ( $sort eq "pubdate_dsc" ) {
401 $sort_by .= "1=31 >i ";
403 elsif ( $sort eq "acqdate_asc" ) {
404 $sort_by .= "1=32 <i ";
406 elsif ( $sort eq "acqdate_dsc" ) {
407 $sort_by .= "1=32 >i ";
409 elsif ( $sort eq "title_az" ) {
410 $sort_by .= "1=4 <i ";
412 elsif ( $sort eq "title_za" ) {
413 $sort_by .= "1=4 >i ";
417 if ( $results[$i]->sort( "yaz", $sort_by ) < 0 ) {
418 warn "WARNING sort $sort_by failed";
421 } # finished looping through servers
423 # The big moment: asynchronously retrieve results from all servers
424 while ( ( my $i = ZOOM::event( \@zconns ) ) != 0 ) {
425 my $ev = $zconns[ $i - 1 ]->last_event();
426 if ( $ev == ZOOM::Event::ZEND ) {
427 next unless $results[ $i - 1 ];
428 my $size = $results[ $i - 1 ]->size();
432 # loop through the results
433 $results_hash->{'hits'} = $size;
435 if ( $offset + $results_per_page <= $size ) {
436 $times = $offset + $results_per_page;
441 for ( my $j = $offset ; $j < $times ; $j++ ) {
446 ## Check if it's an index scan
448 my ( $term, $occ ) = $results[ $i - 1 ]->term($j);
450 # here we create a minimal MARC record and hand it off to the
451 # template just like a normal result ... perhaps not ideal, but
453 my $tmprecord = MARC::Record->new();
454 $tmprecord->encoding('UTF-8');
458 # the minimal record in author/title (depending on MARC flavour)
459 if ( C4::Context->preference("marcflavour") eq
462 $tmptitle = MARC::Field->new(
470 MARC::Field->new( '245', ' ', ' ', a => $term, );
472 MARC::Field->new( '100', ' ', ' ', a => $occ, );
474 $tmprecord->append_fields($tmptitle);
475 $tmprecord->append_fields($tmpauthor);
476 $results_hash->{'RECORDS'}[$j] =
477 $tmprecord->as_usmarc();
482 $record = $results[ $i - 1 ]->record($j)->raw();
484 # warn "RECORD $j:".$record;
485 $results_hash->{'RECORDS'}[$j] = $record;
487 # Fill the facets while we're looping, but only for the biblioserver
488 $facet_record = MARC::Record->new_from_usmarc($record)
489 if $servers[ $i - 1 ] =~ /biblioserver/;
491 #warn $servers[$i-1]."\n".$record; #.$facet_record->title();
493 for ( my $k = 0 ; $k <= @$facets ; $k++ ) {
495 if ( $facets->[$k] ) {
497 for my $tag ( @{ $facets->[$k]->{'tags'} } )
500 $facet_record->field($tag);
502 for my $field (@fields) {
503 my @subfields = $field->subfields();
504 for my $subfield (@subfields) {
505 my ( $code, $data ) = @$subfield;
507 $facets->[$k]->{'subfield'} )
509 $facets_counter->{ $facets->[$k]
515 $facets_info->{ $facets->[$k]
516 ->{'link_value'} }->{'label_value'} =
517 $facets->[$k]->{'label_value'};
518 $facets_info->{ $facets->[$k]
519 ->{'link_value'} }->{'expanded'} =
520 $facets->[$k]->{'expanded'};
526 $results_hashref->{ $servers[ $i - 1 ] } = $results_hash;
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 )
539 my $number_of_facets;
540 my @this_facets_array;
543 $facets_counter->{$link_value}
544 ->{$b} <=> $facets_counter->{$link_value}->{$a}
545 } keys %{ $facets_counter->{$link_value} }
549 if ( ( $number_of_facets < 6 )
550 || ( $expanded_facet eq $link_value )
551 || ( $facets_info->{$link_value}->{'expanded'} ) )
554 # Sanitize the link value ), ( will cause errors with CCL,
555 my $facet_link_value = $one_facet;
556 $facet_link_value =~ s/(\(|\))/ /g;
558 # fix the length that will display in the label,
559 my $facet_label_value = $one_facet;
561 substr( $one_facet, 0, 20 ) . "..."
562 unless length($facet_label_value) <= 20;
564 # if it's a branch, label by the name, not the code,
565 if ( $link_value =~ /branch/ ) {
567 $branches->{$one_facet}->{'branchname'};
570 # but we're down with the whole label being in the link's title.
571 my $facet_title_value = $one_facet;
573 push @this_facets_array,
577 $facets_counter->{$link_value}
579 facet_label_value => $facet_label_value,
580 facet_title_value => $facet_title_value,
581 facet_link_value => $facet_link_value,
582 type_link_value => $link_value,
588 # handle expanded option
589 unless ( $facets_info->{$link_value}->{'expanded'} ) {
591 if ( ( $number_of_facets > 6 )
592 && ( $expanded_facet ne $link_value ) );
597 type_link_value => $link_value,
598 type_id => $link_value . "_id",
600 $facets_info->{$link_value}->{'label_value'},
601 facets => \@this_facets_array,
602 expandable => $expandable,
603 expand => $link_value,
610 return ( undef, $results_hashref, \@facets_loop );
614 sub _remove_stopwords {
615 my ( $operand, $index ) = @_;
616 my @stopwords_removed;
618 # phrase and exact-qualified indexes shouldn't have stopwords removed
619 if ( $index !~ m/phr|ext/ ) {
621 # remove stopwords from operand : parse all stopwords & remove them (case insensitive)
622 # we use IsAlpha unicode definition, to deal correctly with diacritics.
623 # otherwise, a French word like "leçon" woudl be split into "le" "çon", "le"
624 # is a stopword, we'd get "çon" and wouldn't find anything...
625 foreach ( keys %{ C4::Context->stopwords } ) {
626 next if ( $_ =~ /(and|or|not)/ ); # don't remove operators
628 /(\P{IsAlpha}$_\P{IsAlpha}|^$_\P{IsAlpha}|\P{IsAlpha}$_$)/ )
630 $operand =~ s/\P{IsAlpha}$_\P{IsAlpha}/ /gi;
631 $operand =~ s/^$_\P{IsAlpha}/ /gi;
632 $operand =~ s/\P{IsAlpha}$_$/ /gi;
633 push @stopwords_removed, $_;
637 return ( $operand, \@stopwords_removed );
641 sub _detect_truncation {
642 my ( $operand, $index ) = @_;
643 my ( @nontruncated, @righttruncated, @lefttruncated, @rightlefttruncated,
646 my @wordlist = split( /\s/, $operand );
647 foreach my $word (@wordlist) {
648 if ( $word =~ s/^\*([^\*]+)\*$/$1/ ) {
649 push @rightlefttruncated, $word;
651 elsif ( $word =~ s/^\*([^\*]+)$/$1/ ) {
652 push @lefttruncated, $word;
654 elsif ( $word =~ s/^([^\*]+)\*$/$1/ ) {
655 push @righttruncated, $word;
657 elsif ( index( $word, "*" ) < 0 ) {
658 push @nontruncated, $word;
661 push @regexpr, $word;
665 \@nontruncated, \@righttruncated, \@lefttruncated,
666 \@rightlefttruncated, \@regexpr
671 sub _build_stemmed_operand {
675 # FIXME: the locale should be set based on the user's language and/or search choice
676 my $stemmer = Lingua::Stem->new( -locale => 'EN-US' );
678 # FIXME: these should be stored in the db so the librarian can modify the behavior
679 $stemmer->add_exceptions(
686 my @words = split( / /, $operand );
687 my $stems = $stemmer->stem(@words);
688 for my $stem (@$stems) {
689 $stemmed_operand .= "$stem";
690 $stemmed_operand .= "?"
691 unless ( $stem =~ /(and$|or$|not$)/ ) || ( length($stem) < 3 );
692 $stemmed_operand .= " ";
694 warn "STEMMED OPERAND: $stemmed_operand" if $DEBUG;
695 return $stemmed_operand;
699 sub _build_weighted_query {
701 # FIELD WEIGHTING - This is largely experimental stuff. What I'm committing works
702 # pretty well but could work much better if we had a smarter query parser
703 my ( $operand, $stemmed_operand, $index ) = @_;
704 my $stemming = C4::Context->preference("QueryStemming") || 0;
705 my $weight_fields = C4::Context->preference("QueryWeightFields") || 0;
706 my $fuzzy_enabled = C4::Context->preference("QueryFuzzy") || 0;
708 my $weighted_query .= "(rk=("; # Specifies that we're applying rank
710 # Keyword, or, no index specified
711 if ( ( $index eq 'kw' ) || ( !$index ) ) {
713 "Title-cover,ext,r1=\"$operand\""; # exact title-cover
714 $weighted_query .= " or ti,ext,r2=\"$operand\""; # exact title
715 $weighted_query .= " or ti,phr,r3=\"$operand\""; # phrase title
716 #$weighted_query .= " or any,ext,r4=$operand"; # exact any
717 #$weighted_query .=" or kw,wrdl,r5=\"$operand\""; # word list any
718 $weighted_query .= " or wrdl,fuzzy,r8=\"$operand\""
719 if $fuzzy_enabled; # add fuzzy, word list
720 $weighted_query .= " or wrdl,right-Truncation,r9=\"$stemmed_operand\""
721 if ( $stemming and $stemmed_operand )
722 ; # add stemming, right truncation
723 $weighted_query .= " or wrdl,r9=\"$operand\"";
725 # embedded sorting: 0 a-z; 1 z-a
726 # $weighted_query .= ") or (sort1,aut=1";
729 # Barcode searches should skip this process
730 elsif ( $index eq 'bc' ) {
731 $weighted_query .= "bc=\"$operand\"";
734 # Authority-number searches should skip this process
735 elsif ( $index eq 'an' ) {
736 $weighted_query .= "an=\"$operand\"";
739 # If the index already has more than one qualifier, wrap the operand
740 # in quotes and pass it back (assumption is that the user knows what they
741 # are doing and won't appreciate us mucking up their query
742 elsif ( $index =~ ',' ) {
743 $weighted_query .= " $index=\"$operand\"";
746 #TODO: build better cases based on specific search indexes
748 $weighted_query .= " $index,ext,r1=\"$operand\""; # exact index
749 #$weighted_query .= " or (title-sort-az=0 or $index,startswithnt,st-word,r3=$operand #)";
750 $weighted_query .= " or $index,phr,r3=\"$operand\""; # phrase index
752 " or $index,rt,wrdl,r3=\"$operand\""; # word list index
755 $weighted_query .= "))"; # close rank specification
756 return $weighted_query;
762 $simple_query, $query_cgi,
764 $limit_cgi, $limit_desc,
765 $stopwords_removed, $query_type ) = getRecords ( $operators, $operands, $indexes, $limits, $sort_by, $scan);
767 Build queries and limits in CCL, CGI, Human,
768 handle truncation, stemming, field weighting, stopwords, fuzziness, etc.
770 See verbose embedded documentation.
776 my ( $operators, $operands, $indexes, $limits, $sort_by, $scan ) = @_;
778 warn "---------" if $DEBUG;
779 warn "Enter buildQuery" if $DEBUG;
780 warn "---------" if $DEBUG;
783 my @operators = @$operators if $operators;
784 my @indexes = @$indexes if $indexes;
785 my @operands = @$operands if $operands;
786 my @limits = @$limits if $limits;
787 my @sort_by = @$sort_by if $sort_by;
789 my $stemming = C4::Context->preference("QueryStemming") || 0;
790 my $auto_truncation = C4::Context->preference("QueryAutoTruncate") || 0;
791 my $weight_fields = C4::Context->preference("QueryWeightFields") || 0;
792 my $fuzzy_enabled = C4::Context->preference("QueryFuzzy") || 0;
793 my $remove_stopwords = C4::Context->preference("QueryRemoveStopwords") || 0;
795 # no stemming/weight/fuzzy in NoZebra
796 if ( C4::Context->preference("NoZebra") ) {
802 my $query = $operands[0];
803 my $simple_query = $operands[0];
805 # initialize the variables we're passing back
814 my $stopwords_removed; # flag to determine if stopwords have been removed
816 # for handling ccl, cql, pqf queries in diagnostic mode, skip the rest of the steps
818 if ( $query =~ /^ccl=/ ) {
819 return ( undef, $', $', $', $', '', '', '', '', 'ccl' );
821 if ( $query =~ /^cql=/ ) {
822 return ( undef, $', $', $', $', '', '', '', '', 'cql' );
824 if ( $query =~ /^pqf=/ ) {
825 return ( undef, $', $', $', $', '', '', '', '', 'pqf' );
828 # pass nested queries directly
829 # FIXME: need better handling of some of these variables in this case
830 if ( $query =~ /(\(|\))/ ) {
832 undef, $query, $simple_query, $query_cgi,
833 $query, $limit, $limit_cgi, $limit_desc,
834 $stopwords_removed, 'ccl'
838 # Form-based queries are non-nested and fixed depth, so we can easily modify the incoming
839 # query operands and indexes and add stemming, truncation, field weighting, etc.
840 # Once we do so, we'll end up with a value in $query, just like if we had an
841 # incoming $query from the user
844 ; # clear it out so we can populate properly with field-weighted, stemmed, etc. query
846 ; # a flag used to keep track if there was a previous query
847 # if there was, we can apply the current operator
849 for ( my $i = 0 ; $i <= @operands ; $i++ ) {
851 # COMBINE OPERANDS, INDEXES AND OPERATORS
852 if ( $operands[$i] ) {
854 # A flag to determine whether or not to add the index to the query
857 # If the user is sophisticated enough to specify an index, turn off field weighting, stemming, and stopword handling
858 if ( $operands[$i] =~ /(:|=)/ || $scan ) {
861 $remove_stopwords = 0;
863 my $operand = $operands[$i];
864 my $index = $indexes[$i];
866 # Add index-specific attributes
867 # Date of Publication
868 if ( $index eq 'yr' ) {
869 $index .= ",st-numeric";
872 $stemming, $auto_truncation,
873 $weight_fields, $fuzzy_enabled,
875 ) = ( 0, 0, 0, 0, 0 );
878 # Date of Acquisition
879 elsif ( $index eq 'acqdate' ) {
880 $index .= ",st-date-normalized";
883 $stemming, $auto_truncation,
884 $weight_fields, $fuzzy_enabled,
886 ) = ( 0, 0, 0, 0, 0 );
889 # Set default structure attribute (word list)
891 unless ( !$index || $index =~ /(st-|phr|ext|wrdl)/ ) {
892 $struct_attr = ",wrdl";
895 # Some helpful index variants
896 my $index_plus = $index . $struct_attr . ":" if $index;
897 my $index_plus_comma = $index . $struct_attr . "," if $index;
900 if ($remove_stopwords) {
901 ( $operand, $stopwords_removed ) =
902 _remove_stopwords( $operand, $index );
903 warn "OPERAND w/out STOPWORDS: >$operand<" if $DEBUG;
904 warn "REMOVED STOPWORDS: @$stopwords_removed"
905 if ( $stopwords_removed && $DEBUG );
909 my ( $nontruncated, $righttruncated, $lefttruncated,
910 $rightlefttruncated, $regexpr );
911 my $truncated_operand;
913 $nontruncated, $righttruncated, $lefttruncated,
914 $rightlefttruncated, $regexpr
915 ) = _detect_truncation( $operand, $index );
917 "TRUNCATION: NON:>@$nontruncated< RIGHT:>@$righttruncated< LEFT:>@$lefttruncated< RIGHTLEFT:>@$rightlefttruncated< REGEX:>@$regexpr<"
922 scalar(@$righttruncated) + scalar(@$lefttruncated) +
923 scalar(@$rightlefttruncated) > 0 )
926 # Don't field weight or add the index to the query, we do it here
928 undef $weight_fields;
929 my $previous_truncation_operand;
930 if ( scalar(@$nontruncated) > 0 ) {
931 $truncated_operand .= "$index_plus @$nontruncated ";
932 $previous_truncation_operand = 1;
934 if ( scalar(@$righttruncated) > 0 ) {
935 $truncated_operand .= "and "
936 if $previous_truncation_operand;
937 $truncated_operand .=
938 "$index_plus_comma" . "rtrn:@$righttruncated ";
939 $previous_truncation_operand = 1;
941 if ( scalar(@$lefttruncated) > 0 ) {
942 $truncated_operand .= "and "
943 if $previous_truncation_operand;
944 $truncated_operand .=
945 "$index_plus_comma" . "ltrn:@$lefttruncated ";
946 $previous_truncation_operand = 1;
948 if ( scalar(@$rightlefttruncated) > 0 ) {
949 $truncated_operand .= "and "
950 if $previous_truncation_operand;
951 $truncated_operand .=
952 "$index_plus_comma" . "rltrn:@$rightlefttruncated ";
953 $previous_truncation_operand = 1;
956 $operand = $truncated_operand if $truncated_operand;
957 warn "TRUNCATED OPERAND: >$truncated_operand<" if $DEBUG;
961 $stemmed_operand = _build_stemmed_operand($operand)
963 warn "STEMMED OPERAND: >$stemmed_operand<" if $DEBUG;
965 # Handle Field Weighting
966 my $weighted_operand;
968 _build_weighted_query( $operand, $stemmed_operand, $index )
970 warn "FIELD WEIGHTED OPERAND: >$weighted_operand<" if $DEBUG;
971 $operand = $weighted_operand if $weight_fields;
972 $indexes_set = 1 if $weight_fields;
974 # If there's a previous operand, we need to add an operator
975 if ($previous_operand) {
977 # User-specified operator
978 if ( $operators[ $i - 1 ] ) {
979 $query .= " $operators[$i-1] ";
980 $query .= " $index_plus " unless $indexes_set;
981 $query .= " $operand";
982 $query_cgi .= "&op=$operators[$i-1]";
983 $query_cgi .= "&idx=$index" if $index;
984 $query_cgi .= "&q=$operands[$i]" if $operands[$i];
986 " $operators[$i-1] $index_plus $operands[$i]";
989 # Default operator is and
992 $query .= "$index_plus " unless $indexes_set;
993 $query .= "$operand";
994 $query_cgi .= "&op=and&idx=$index" if $index;
995 $query_cgi .= "&q=$operands[$i]" if $operands[$i];
996 $query_desc .= " and $index_plus $operands[$i]";
1000 # There isn't a pervious operand, don't need an operator
1003 # Field-weighted queries already have indexes set
1004 $query .= " $index_plus " unless $indexes_set;
1006 $query_desc .= " $index_plus $operands[$i]";
1007 $query_cgi .= "&idx=$index" if $index;
1008 $query_cgi .= "&q=$operands[$i]" if $operands[$i];
1009 $previous_operand = 1;
1014 warn "QUERY BEFORE LIMITS: >$query<" if $DEBUG;
1017 my $group_OR_limits;
1018 my $availability_limit;
1019 foreach my $this_limit (@limits) {
1020 if ( $this_limit =~ /available/ ) {
1022 # 'available' is defined as (items.onloan is NULL) and (items.itemlost = 0)
1024 # all records not indexed in the onloan register (zebra) and all records with a value of lost equal to 0
1025 $availability_limit .=
1026 "( ( allrecords,AlwaysMatches='' not onloan,AlwaysMatches='') and (lost,st-numeric=0) )"; #or ( allrecords,AlwaysMatches='' not lost,AlwaysMatches='')) )";
1027 $limit_cgi .= "&limit=available";
1031 # group_OR_limits, prefixed by mc-
1032 # OR every member of the group
1033 elsif ( $this_limit =~ /mc/ ) {
1034 $group_OR_limits .= " or " if $group_OR_limits;
1035 $limit_desc .= " or " if $group_OR_limits;
1036 $group_OR_limits .= "$this_limit";
1037 $limit_cgi .= "&limit=$this_limit";
1038 $limit_desc .= " $this_limit";
1041 # Regular old limits
1043 $limit .= " and " if $limit || $query;
1044 $limit .= "$this_limit";
1045 $limit_cgi .= "&limit=$this_limit";
1046 $limit_desc .= " $this_limit";
1049 if ($group_OR_limits) {
1050 $limit .= " and " if ( $query || $limit );
1051 $limit .= "($group_OR_limits)";
1053 if ($availability_limit) {
1054 $limit .= " and " if ( $query || $limit );
1055 $limit .= "($availability_limit)";
1058 # Normalize the query and limit strings
1061 for ( $query, $query_desc, $limit, $limit_desc ) {
1062 $_ =~ s/ / /g; # remove extra spaces
1063 $_ =~ s/^ //g; # remove any beginning spaces
1064 $_ =~ s/ $//g; # remove any ending spaces
1065 $_ =~ s/==/=/g; # remove double == from query
1067 $query_cgi =~ s/^&//; # remove unnecessary & from beginning of the query cgi
1069 for ($query_cgi,$simple_query) {
1072 # append the limit to the query
1073 $query .= " " . $limit;
1077 warn "QUERY:" . $query;
1078 warn "QUERY CGI:" . $query_cgi;
1079 warn "QUERY DESC:" . $query_desc;
1080 warn "LIMIT:" . $limit;
1081 warn "LIMIT CGI:" . $limit_cgi;
1082 warn "LIMIT DESC:" . $limit_desc;
1084 warn "Leave buildQuery";
1088 undef, $query, $simple_query, $query_cgi,
1089 $query_desc, $limit, $limit_cgi, $limit_desc,
1090 $stopwords_removed, $query_type
1094 =head2 searchResults
1096 Format results in a form suitable for passing to the template
1100 # IMO this subroutine is pretty messy still -- it's responsible for
1101 # building the HTML output for the template
1103 my ( $searchdesc, $hits, $results_per_page, $offset, @marcresults ) = @_;
1104 my $dbh = C4::Context->dbh;
1109 # add search-term highlighting via <span>s on the search terms
1110 my $span_terms_hashref;
1111 for my $span_term ( split( / /, $searchdesc ) ) {
1112 $span_term =~ s/(.*=|\)|\(|\+|\.|\*)//g;
1113 $span_terms_hashref->{$span_term}++;
1116 #Build branchnames hash
1118 #get branch information.....
1121 $dbh->prepare("SELECT branchcode,branchname FROM branches")
1122 ; # FIXME : use C4::Koha::GetBranches
1124 while ( my $bdata = $bsth->fetchrow_hashref ) {
1125 $branches{ $bdata->{'branchcode'} } = $bdata->{'branchname'};
1130 "SELECT authorised_value,lib FROM authorised_values WHERE category = 'LOC'"
1133 while ( my $ldata = $lsch->fetchrow_hashref ) {
1134 $locations{ $ldata->{'authorised_value'} } = $ldata->{'lib'};
1137 #Build itemtype hash
1138 #find itemtype & itemtype image
1142 "SELECT itemtype,description,imageurl,summary,notforloan FROM itemtypes"
1145 while ( my $bdata = $bsth->fetchrow_hashref ) {
1146 $itemtypes{ $bdata->{'itemtype'} }->{description} =
1147 $bdata->{'description'};
1148 $itemtypes{ $bdata->{'itemtype'} }->{imageurl} = $bdata->{'imageurl'};
1149 $itemtypes{ $bdata->{'itemtype'} }->{summary} = $bdata->{'summary'};
1150 $itemtypes{ $bdata->{'itemtype'} }->{notforloan} =
1151 $bdata->{'notforloan'};
1154 #search item field code
1157 "SELECT tagfield FROM marc_subfield_structure WHERE kohafield LIKE 'items.itemnumber'"
1160 my ($itemtag) = $sth->fetchrow;
1162 # get notforloan authorised value list
1165 "SELECT authorised_value FROM `marc_subfield_structure` WHERE kohafield = 'items.notforloan' AND frameworkcode=''"
1168 my ($notforloan_authorised_value) = $sth->fetchrow;
1170 ## find column names of items related to MARC
1171 my $sth2 = $dbh->prepare("SHOW COLUMNS FROM items");
1173 my %subfieldstosearch;
1174 while ( ( my $column ) = $sth2->fetchrow ) {
1175 my ( $tagfield, $tagsubfield ) =
1176 &GetMarcFromKohaField( "items." . $column, "" );
1177 $subfieldstosearch{$column} = $tagsubfield;
1180 # handle which records to actually retrieve
1182 if ( $hits && $offset + $results_per_page <= $hits ) {
1183 $times = $offset + $results_per_page;
1189 # loop through all of the records we've retrieved
1190 for ( my $i = $offset ; $i <= $times - 1 ; $i++ ) {
1192 $marcrecord = MARC::File::USMARC::decode( $marcresults[$i] );
1193 my $oldbiblio = TransformMarcToKoha( $dbh, $marcrecord, '' );
1194 $oldbiblio->{result_number} = $i + 1;
1196 # add imageurl to itemtype if there is one
1197 if ( $itemtypes{ $oldbiblio->{itemtype} }->{imageurl} =~ /^http:/ ) {
1198 $oldbiblio->{imageurl} =
1199 $itemtypes{ $oldbiblio->{itemtype} }->{imageurl};
1200 $oldbiblio->{description} =
1201 $itemtypes{ $oldbiblio->{itemtype} }->{description};
1204 $oldbiblio->{imageurl} =
1205 getitemtypeimagesrc() . "/"
1206 . $itemtypes{ $oldbiblio->{itemtype} }->{imageurl}
1207 if ( $itemtypes{ $oldbiblio->{itemtype} }->{imageurl} );
1208 $oldbiblio->{description} =
1209 $itemtypes{ $oldbiblio->{itemtype} }->{description};
1212 # Build summary if there is one (the summary is defined in the itemtypes table)
1213 # FIXME: is this used anywhere, I think it can be commented out? -- JF
1214 if ( $itemtypes{ $oldbiblio->{itemtype} }->{summary} ) {
1215 my $summary = $itemtypes{ $oldbiblio->{itemtype} }->{summary};
1216 my @fields = $marcrecord->fields();
1217 foreach my $field (@fields) {
1218 my $tag = $field->tag();
1219 my $tagvalue = $field->as_string();
1221 s/\[(.?.?.?.?)$tag\*(.*?)]/$1$tagvalue$2\[$1$tag$2]/g;
1222 unless ( $tag < 10 ) {
1223 my @subf = $field->subfields;
1224 for my $i ( 0 .. $#subf ) {
1225 my $subfieldcode = $subf[$i][0];
1226 my $subfieldvalue = $subf[$i][1];
1227 my $tagsubf = $tag . $subfieldcode;
1229 s/\[(.?.?.?.?)$tagsubf(.*?)]/$1$subfieldvalue$2\[$1$tagsubf$2]/g;
1234 $summary =~ s/\[(.*?)]//g;
1235 $summary =~ s/\n/<br>/g;
1236 $oldbiblio->{summary} = $summary;
1239 # Add search-term highlighting to the whole record where they match using <span>s
1240 if (C4::Context->preference("OpacHighlightedWords")){
1241 my $searchhighlightblob;
1242 for my $highlight_field ( $marcrecord->fields ) {
1244 # FIXME: need to skip title, subtitle, author, etc., as they are handled below
1245 next if $highlight_field->tag() =~ /(^00)/; # skip fixed fields
1246 for my $subfield ($highlight_field->subfields()) {
1248 next if $subfield->[0] eq '9';
1249 my $field = $subfield->[1];
1250 for my $term ( keys %$span_terms_hashref ) {
1251 if ( ( $field =~ /$term/i ) && (( length($term) > 3 ) || ($field =~ / $term /i)) ) {
1252 $field =~ s/$term/<span class=\"term\">$&<\/span>/gi;
1256 $searchhighlightblob .= $field . " ... " if $match;
1260 $searchhighlightblob = ' ... '.$searchhighlightblob if $searchhighlightblob;
1261 $oldbiblio->{'searchhighlightblob'} = $searchhighlightblob;
1263 # save an author with no <span> tag, for the <a href=search.pl?q=<!--tmpl_var name="author"-->> link
1264 $oldbiblio->{'author_nospan'} = $oldbiblio->{'author'};
1266 # Add search-term highlighting to the title, subtitle, etc. fields
1267 for my $term ( keys %$span_terms_hashref ) {
1268 my $old_term = $term;
1269 if ( length($term) > 3 ) {
1270 $term =~ s/(.*=|\)|\(|\+|\.|\?|\[|\]|\\|\*)//g;
1271 $oldbiblio->{'title'} =~
1272 s/$term/<span class=\"term\">$&<\/span>/gi;
1273 $oldbiblio->{'subtitle'} =~
1274 s/$term/<span class=\"term\">$&<\/span>/gi;
1275 $oldbiblio->{'author'} =~
1276 s/$term/<span class=\"term\">$&<\/span>/gi;
1277 $oldbiblio->{'publishercode'} =~
1278 s/$term/<span class=\"term\">$&<\/span>/gi;
1279 $oldbiblio->{'place'} =~
1280 s/$term/<span class=\"term\">$&<\/span>/gi;
1281 $oldbiblio->{'pages'} =~
1282 s/$term/<span class=\"term\">$&<\/span>/gi;
1283 $oldbiblio->{'notes'} =~
1284 s/$term/<span class=\"term\">$&<\/span>/gi;
1285 $oldbiblio->{'size'} =~
1286 s/$term/<span class=\"term\">$&<\/span>/gi;
1291 # surely there's a better way to handle this
1293 $toggle = "#ffffcc";
1298 $oldbiblio->{'toggle'} = $toggle;
1300 # Pull out the items fields
1301 my @fields = $marcrecord->field($itemtag);
1303 # Setting item statuses for display
1304 my @available_items_loop;
1305 my @onloan_items_loop;
1306 my @other_items_loop;
1308 my $available_items;
1312 my $ordered_count = 0;
1313 my $available_count = 0;
1314 my $onloan_count = 0;
1315 my $longoverdue_count = 0;
1316 my $other_count = 0;
1317 my $wthdrawn_count = 0;
1318 my $itemlost_count = 0;
1319 my $itembinding_count = 0;
1320 my $itemdamaged_count = 0;
1321 my $can_place_holds = 0;
1322 my $items_count = scalar(@fields);
1325 ( C4::Context->preference('maxItemsinSearchResults') )
1326 ? C4::Context->preference('maxItemsinSearchResults') - 1
1329 # loop through every item
1330 foreach my $field (@fields) {
1334 # populate the items hash
1335 foreach my $code ( keys %subfieldstosearch ) {
1336 $item->{$code} = $field->subfield( $subfieldstosearch{$code} );
1339 # set item's branch name, use homebranch first, fall back to holdingbranch
1340 if ( $item->{'homebranch'} ) {
1341 $item->{'branchname'} = $branches{ $item->{homebranch} };
1345 elsif ( $item->{'holdingbranch'} ) {
1346 $item->{'branchname'} = $branches{ $item->{holdingbranch} };
1349 # For each grouping of items (onloan, available, unavailable), we build a key to store relevant info about that item
1350 if ( $item->{onloan} ) {
1352 $onloan_items->{ $item->{'homebranch'} . '--' . $item->{location} . $item->{'itype'} . $item->{'itemcallnumber'} . $item->{due_date} }->{due_date} = format_date( $item->{onloan} );
1353 $onloan_items->{ $item->{'homebranch'} . '--' . $item->{location} . $item->{'itype'} . $item->{'itemcallnumber'} . $item->{due_date} }->{count}++ if $item->{'homebranch'};
1354 $onloan_items->{ $item->{'homebranch'} . '--' . $item->{location} . $item->{'itype'} . $item->{'itemcallnumber'} . $item->{due_date} }->{branchname} = $item->{'branchname'};
1355 $onloan_items->{ $item->{'homebranch'} . '--' . $item->{location} . $item->{'itype'} . $item->{'itemcallnumber'} . $item->{due_date} }->{location} = $locations{ $item->{location} };
1356 $onloan_items->{ $item->{'homebranch'} . '--' . $item->{location} . $item->{'itype'} . $item->{'itemcallnumber'} . $item->{due_date} }->{itemcallnumber} = $item->{itemcallnumber};
1357 $onloan_items->{ $item->{'homebranch'} . '--' . $item->{location} . $item->{'itype'} . $item->{'itemcallnumber'} . $item->{due_date} }->{imageurl} = getitemtypeimagesrc() . "/" . $itemtypes{ $item->{itype} }->{imageurl};
1358 # if something's checked out and lost, mark it as 'long overdue'
1359 if ( $item->{itemlost} ) {
1360 $onloan_items->{ $item->{'homebranch'} . '--' . $item->{location} . $item->{'itype'} . $item->{'itemcallnumber'} . $item->{due_date} }->{longoverdue}++;
1361 $longoverdue_count++;
1364 # can place holds as long as this item isn't lost
1366 $can_place_holds = 1;
1370 # items not on loan, but still unavailable ( lost, withdrawn, damaged )
1374 if ( $item->{notforloan} == -1 ) {
1378 # item is withdrawn, lost or damaged
1379 if ( $item->{wthdrawn}
1380 || $item->{itemlost}
1382 || $item->{notforloan} )
1384 $wthdrawn_count++ if $item->{wthdrawn};
1385 $itemlost_count++ if $item->{itemlost};
1386 $itemdamaged_count++ if $item->{damaged};
1387 $item->{status} = $item->{wthdrawn} . "-" . $item->{itemlost} . "-" . $item->{damaged} . "-" . $item->{notforloan};
1390 $other_items->{ $item->{'homebranch'} . '--' . $item->{location} . $item->{'itype'} . $item->{'itemcallnumber'} . $item->{status} }->{wthdrawn} = $item->{wthdrawn};
1391 $other_items->{ $item->{'homebranch'} . '--' . $item->{location} . $item->{'itype'} . $item->{'itemcallnumber'} . $item->{status} }->{itemlost} = $item->{itemlost};
1392 $other_items->{ $item->{'homebranch'} . '--' . $item->{location} . $item->{'itype'} . $item->{'itemcallnumber'} . $item->{status} }->{damaged} = $item->{damaged};
1393 $other_items->{ $item->{'homebranch'} . '--' . $item->{location} . $item->{'itype'} . $item->{'itemcallnumber'} . $item->{status} }->{notforloan} = GetAuthorisedValueDesc( '', '', $item->{notforloan}, '', '', $notforloan_authorised_value ) if $notforloan_authorised_value;
1394 $other_items->{ $item->{'homebranch'} . '--' . $item->{location} . $item->{'itype'} . $item->{'itemcallnumber'} . $item->{status} }->{count}++ if $item->{'homebranch'};
1395 $other_items->{ $item->{'homebranch'} . '--' . $item->{location} . $item->{'itype'} . $item->{'itemcallnumber'} . $item->{status} }->{branchname} = $item->{'branchname'};
1396 $other_items->{ $item->{'homebranch'} . '--' . $item->{location} . $item->{'itype'} . $item->{'itemcallnumber'} . $item->{status} }->{location} = $locations{ $item->{location} };
1397 $other_items->{ $item->{'homebranch'} . '--' . $item->{location} . $item->{'itype'} . $item->{'itemcallnumber'} . $item->{status} }->{itemcallnumber} = $item->{itemcallnumber};
1398 $other_items->{ $item->{'homebranch'} . '--' . $item->{location} . $item->{'itype'} . $item->{'itemcallnumber'} . $item->{status} }->{imageurl} = getitemtypeimagesrc() . "/" . $itemtypes{ $item->{itype} }->{imageurl};
1403 $can_place_holds = 1;
1405 $available_items->{ $item->{'homebranch'} . '--' . $item->{location} . $item->{'itype'} . $item->{'itemcallnumber'} }->{count}++ if $item->{'homebranch'};
1406 $available_items->{ $item->{'homebranch'} . '--' . $item->{location} . $item->{'itype'} . $item->{'itemcallnumber'} }->{branchname} = $item->{'branchname'};
1407 $available_items->{ $item->{'homebranch'} . '--' . $item->{location} . $item->{'itype'} . $item->{'itemcallnumber'} }->{location} = $locations{ $item->{location} };
1408 $available_items->{ $item->{'homebranch'} . '--' . $item->{location} . $item->{'itype'} . $item->{'itemcallnumber'} }->{itemcallnumber} = $item->{itemcallnumber};
1409 $available_items->{ $item->{'homebranch'} . '--' . $item->{location} . $item->{'itype'} . $item->{'itemcallnumber'} }->{imageurl} = getitemtypeimagesrc() . "/" . $itemtypes{ $item->{itype} }->{imageurl};
1412 } # notforloan, item level and biblioitem level
1413 my ( $availableitemscount, $onloanitemscount, $otheritemscount );
1415 ( C4::Context->preference('maxItemsinSearchResults') )
1416 ? C4::Context->preference('maxItemsinSearchResults') - 1
1418 for my $key ( sort keys %$onloan_items ) {
1419 $onloanitemscount++;
1420 push @onloan_items_loop, $onloan_items->{$key}
1421 unless $onloanitemscount > $maxitems;
1423 for my $key ( sort keys %$other_items ) {
1425 push @other_items_loop, $other_items->{$key}
1426 unless $otheritemscount > $maxitems;
1428 for my $key ( sort keys %$available_items ) {
1429 $availableitemscount++;
1430 push @available_items_loop, $available_items->{$key}
1431 unless $availableitemscount > $maxitems;
1434 # last check for norequest : if itemtype is notforloan, it can't be reserved either, whatever the items
1435 $can_place_holds = 0
1436 if $itemtypes{ $oldbiblio->{itemtype} }->{notforloan};
1437 $oldbiblio->{norequests} = 1 unless $can_place_holds;
1438 $oldbiblio->{itemsplural} = 1 if $items_count > 1;
1439 $oldbiblio->{items_count} = $items_count;
1440 $oldbiblio->{available_items_loop} = \@available_items_loop;
1441 $oldbiblio->{onloan_items_loop} = \@onloan_items_loop;
1442 $oldbiblio->{other_items_loop} = \@other_items_loop;
1443 $oldbiblio->{availablecount} = $available_count;
1444 $oldbiblio->{availableplural} = 1 if $available_count > 1;
1445 $oldbiblio->{onloancount} = $onloan_count;
1446 $oldbiblio->{onloanplural} = 1 if $onloan_count > 1;
1447 $oldbiblio->{othercount} = $other_count;
1448 $oldbiblio->{otherplural} = 1 if $other_count > 1;
1449 $oldbiblio->{wthdrawncount} = $wthdrawn_count;
1450 $oldbiblio->{itemlostcount} = $itemlost_count;
1451 $oldbiblio->{damagedcount} = $itemdamaged_count;
1452 $oldbiblio->{orderedcount} = $ordered_count;
1453 $oldbiblio->{isbn} =~
1454 s/-//g; # deleting - in isbn to enable amazon content
1455 push( @newresults, $oldbiblio );
1460 #----------------------------------------------------------------------
1462 # Non-Zebra GetRecords#
1463 #----------------------------------------------------------------------
1467 NZgetRecords has the same API as zera getRecords, even if some parameters are not managed
1473 $query, $simple_query, $sort_by_ref, $servers_ref,
1474 $results_per_page, $offset, $expanded_facet, $branches,
1477 warn "query =$query" if $DEBUG;
1478 my $result = NZanalyse($query);
1479 warn "results =$result" if $DEBUG;
1481 NZorder( $result, @$sort_by_ref[0], $results_per_page, $offset ),
1487 NZanalyse : get a CQL string as parameter, and returns a list of biblionumber;title,biblionumber;title,...
1488 the list is built from an inverted index in the nozebra SQL table
1489 note that title is here only for convenience : the sorting will be very fast when requested on title
1490 if the sorting is requested on something else, we will have to reread all results, and that may be longer.
1495 my ( $string, $server ) = @_;
1496 # warn "---------" if $DEBUG;
1497 warn " NZanalyse" if $DEBUG;
1498 # warn "---------" if $DEBUG;
1500 # $server contains biblioserver or authorities, depending on what we search on.
1501 #warn "querying : $string on $server";
1502 $server = 'biblioserver' unless $server;
1504 # if we have a ", replace the content to discard temporarily any and/or/not inside
1506 if ( $string =~ /"/ ) {
1507 $string =~ s/"(.*?)"/__X__/;
1509 warn "commacontent : $commacontent" if $DEBUG;
1512 # split the query string in 3 parts : X AND Y means : $left="X", $operand="AND" and $right="Y"
1513 # then, call again NZanalyse with $left and $right
1514 # (recursive until we find a leaf (=> something without and/or/not)
1515 # delete repeated operator... Would then go in infinite loop
1516 while ( $string =~ s/( and| or| not| AND| OR| NOT)\1/$1/g ) {
1519 #process parenthesis before.
1520 if ( $string =~ /^\s*\((.*)\)(( and | or | not | AND | OR | NOT )(.*))?/ ) {
1523 my $operator = lc($3); # FIXME: and/or/not are operators, not operands
1525 "dealing w/parenthesis before recursive sub call. left :$left operator:$operator right:$right"
1527 my $leftresult = NZanalyse( $left, $server );
1529 my $rightresult = NZanalyse( $right, $server );
1531 # OK, we have the results for right and left part of the query
1532 # depending of operand, intersect, union or exclude both lists
1533 # to get a result list
1534 if ( $operator eq ' and ' ) {
1535 return NZoperatorAND($leftresult,$rightresult);
1537 elsif ( $operator eq ' or ' ) {
1539 # just merge the 2 strings
1540 return $leftresult . $rightresult;
1542 elsif ( $operator eq ' not ' ) {
1543 return NZoperatorNOT($leftresult,$rightresult);
1547 # this error is impossible, because of the regexp that isolate the operand, but just in case...
1551 warn "string :" . $string if $DEBUG;
1552 $string =~ /(.*?)( and | or | not | AND | OR | NOT )(.*)/;
1555 my $operator = lc($2); # FIXME: and/or/not are operators, not operands
1556 warn "no parenthesis. left : $left operator: $operator right: $right"
1559 # it's not a leaf, we have a and/or/not
1562 # reintroduce comma content if needed
1563 $right =~ s/__X__/"$commacontent"/ if $commacontent;
1564 $left =~ s/__X__/"$commacontent"/ if $commacontent;
1565 warn "node : $left / $operator / $right\n" if $DEBUG;
1566 my $leftresult = NZanalyse( $left, $server );
1567 my $rightresult = NZanalyse( $right, $server );
1568 warn " leftresult : $leftresult" if $DEBUG;
1569 warn " rightresult : $rightresult" if $DEBUG;
1570 # OK, we have the results for right and left part of the query
1571 # depending of operand, intersect, union or exclude both lists
1572 # to get a result list
1573 if ( $operator eq ' and ' ) {
1575 return NZoperatorAND($leftresult,$rightresult);
1577 elsif ( $operator eq ' or ' ) {
1579 # just merge the 2 strings
1580 return $leftresult . $rightresult;
1582 elsif ( $operator eq ' not ' ) {
1583 return NZoperatorNOT($leftresult,$rightresult);
1587 # this error is impossible, because of the regexp that isolate the operand, but just in case...
1588 die "error : operand unknown : $operator for $string";
1591 # it's a leaf, do the real SQL query and return the result
1594 $string =~ s/__X__/"$commacontent"/ if $commacontent;
1595 $string =~ s/-|\.|\?|,|;|!|'|\(|\)|\[|\]|{|}|"|&|\+|\*|\// /g;
1596 warn "leaf:$string" if $DEBUG;
1598 # parse the string in in operator/operand/value again
1599 $string =~ /(.*)(>=|<=)(.*)/;
1603 # warn "handling leaf... left:$left operator:$operator right:$right"
1605 unless ($operator) {
1606 $string =~ /(.*)(>|<|=)(.*)/;
1611 # "handling unless (operator)... left:$left operator:$operator right:$right"
1616 # strip adv, zebra keywords, currently not handled in nozebra: wrdl, ext, phr...
1617 $left =~ s/[, ].*$//;
1619 # automatic replace for short operators
1620 $left = 'title' if $left =~ '^ti$';
1621 $left = 'author' if $left =~ '^au$';
1622 $left = 'publisher' if $left =~ '^pb$';
1623 $left = 'subject' if $left =~ '^su$';
1624 $left = 'koha-Auth-Number' if $left =~ '^an$';
1625 $left = 'keyword' if $left =~ '^kw$';
1626 warn "handling leaf... left:$left operator:$operator right:$right";
1627 if ( $operator && $left ne 'keyword' ) {
1629 #do a specific search
1630 my $dbh = C4::Context->dbh;
1631 $operator = 'LIKE' if $operator eq '=' and $right =~ /%/;
1634 "SELECT biblionumbers,value FROM nozebra WHERE server=? AND indexname=? AND value $operator ?"
1636 warn "$left / $operator / $right\n";
1638 # split each word, query the DB and build the biblionumbers result
1639 #sanitizing leftpart
1640 $left =~ s/^\s+|\s+$//;
1641 foreach ( split / /, $right ) {
1643 $_ =~ s/^\s+|\s+$//;
1645 warn "EXECUTE : $server, $left, $_";
1646 $sth->execute( $server, $left, $_ )
1647 or warn "execute failed: $!";
1648 while ( my ( $line, $value ) = $sth->fetchrow ) {
1650 # if we are dealing with a numeric value, use only numeric results (in case of >=, <=, > or <)
1651 # otherwise, fill the result
1652 $biblionumbers .= $line
1653 unless ( $right =~ /^\d+$/ && $value =~ /\D/ );
1654 warn "result : $value "
1655 . ( $right =~ /\d/ ) . "=="
1656 . ( $value =~ /\D/?$line:"" ); #= $line";
1659 # do a AND with existing list if there is one, otherwise, use the biblionumbers list as 1st result list
1662 $results = NZoperatorAND($biblionumbers,$results);
1665 $results = $biblionumbers;
1671 #do a complete search (all indexes), if index='kw' do complete search too.
1672 my $dbh = C4::Context->dbh;
1675 "SELECT biblionumbers FROM nozebra WHERE server=? AND value LIKE ?"
1678 # split each word, query the DB and build the biblionumbers result
1679 foreach ( split / /, $string ) {
1680 next if C4::Context->stopwords->{ uc($_) }; # skip if stopword
1681 warn "search on all indexes on $_" if $DEBUG;
1684 $sth->execute( $server, $_ );
1685 while ( my $line = $sth->fetchrow ) {
1686 $biblionumbers .= $line;
1689 # do a AND with existing list if there is one, otherwise, use the biblionumbers list as 1st result list
1691 $results = NZoperatorAND($biblionumbers,$results);
1694 warn "NEW RES for $_ = $biblionumbers" if $DEBUG;
1695 $results = $biblionumbers;
1699 warn "return : $results for LEAF : $string" if $DEBUG;
1702 warn "---------" if $DEBUG;
1703 warn "Leave NZanalyse" if $DEBUG;
1704 warn "---------" if $DEBUG;
1708 my ($rightresult, $leftresult)=@_;
1710 my @leftresult = split /;/, $leftresult;
1711 warn " @leftresult / $rightresult \n" if $DEBUG;
1713 # my @rightresult = split /;/,$leftresult;
1716 # parse the left results, and if the biblionumber exist in the right result, save it in finalresult
1717 # the result is stored twice, to have the same weight for AND than OR.
1718 # example : TWO : 61,61,64,121 (two is twice in the biblio #61) / TOWER : 61,64,130
1719 # result : 61,61,61,61,64,64 for two AND tower : 61 has more weight than 64
1720 foreach (@leftresult) {
1723 ( $value, $countvalue ) = ( $1, $2 ) if ($value=~/(.*)-(\d+)$/);
1724 if ( $rightresult =~ /$value-(\d+);/ ) {
1725 $countvalue = ( $1 > $countvalue ? $countvalue : $1 );
1727 "$value-$countvalue;$value-$countvalue;";
1730 warn " $finalresult \n" if $DEBUG;
1731 return $finalresult;
1735 my ($rightresult, $leftresult)=@_;
1736 return $rightresult.$leftresult;
1740 my ($rightresult, $leftresult)=@_;
1742 my @leftresult = split /;/, $leftresult;
1744 # my @rightresult = split /;/,$leftresult;
1746 foreach (@leftresult) {
1748 $value=$1 if $value=~m/(.*)-\d+$/;
1749 unless ($rightresult =~ "$value-") {
1750 $finalresult .= "$_;";
1753 return $finalresult;
1758 $finalresult = NZorder($biblionumbers, $ordering,$results_per_page,$offset);
1765 my ( $biblionumbers, $ordering, $results_per_page, $offset ) = @_;
1766 warn "biblionumbers = $biblionumbers and ordering = $ordering\n" if $DEBUG;
1768 # order title asc by default
1769 # $ordering = '1=36 <i' unless $ordering;
1770 $results_per_page = 20 unless $results_per_page;
1771 $offset = 0 unless $offset;
1772 my $dbh = C4::Context->dbh;
1775 # order by POPULARITY
1777 if ( $ordering =~ /popularity/ ) {
1781 # popularity is not in MARC record, it's builded from a specific query
1783 $dbh->prepare("select sum(issues) from items where biblionumber=?");
1784 foreach ( split /;/, $biblionumbers ) {
1785 my ( $biblionumber, $title ) = split /,/, $_;
1786 $result{$biblionumber} = GetMarcBiblio($biblionumber);
1787 $sth->execute($biblionumber);
1788 my $popularity = $sth->fetchrow || 0;
1790 # hint : the key is popularity.title because we can have
1791 # many results with the same popularity. In this cas, sub-ordering is done by title
1792 # we also have biblionumber to avoid bug for 2 biblios with the same title & popularity
1793 # (un-frequent, I agree, but we won't forget anything that way ;-)
1794 $popularity{ sprintf( "%10d", $popularity ) . $title
1795 . $biblionumber } = $biblionumber;
1798 # sort the hash and return the same structure as GetRecords (Zebra querying)
1801 if ( $ordering eq 'popularity_dsc' ) { # sort popularity DESC
1802 foreach my $key ( sort { $b cmp $a } ( keys %popularity ) ) {
1803 $result_hash->{'RECORDS'}[ $numbers++ ] =
1804 $result{ $popularity{$key} }->as_usmarc();
1807 else { # sort popularity ASC
1808 foreach my $key ( sort ( keys %popularity ) ) {
1809 $result_hash->{'RECORDS'}[ $numbers++ ] =
1810 $result{ $popularity{$key} }->as_usmarc();
1813 my $finalresult = ();
1814 $result_hash->{'hits'} = $numbers;
1815 $finalresult->{'biblioserver'} = $result_hash;
1816 return $finalresult;
1822 elsif ( $ordering =~ /author/ ) {
1824 foreach ( split /;/, $biblionumbers ) {
1825 my ( $biblionumber, $title ) = split /,/, $_;
1826 my $record = GetMarcBiblio($biblionumber);
1828 if ( C4::Context->preference('marcflavour') eq 'UNIMARC' ) {
1829 $author = $record->subfield( '200', 'f' );
1830 $author = $record->subfield( '700', 'a' ) unless $author;
1833 $author = $record->subfield( '100', 'a' );
1836 # hint : the result is sorted by title.biblionumber because we can have X biblios with the same title
1837 # and we don't want to get only 1 result for each of them !!!
1838 $result{ $author . $biblionumber } = $record;
1841 # sort the hash and return the same structure as GetRecords (Zebra querying)
1844 if ( $ordering eq 'author_za' ) { # sort by author desc
1845 foreach my $key ( sort { $b cmp $a } ( keys %result ) ) {
1846 $result_hash->{'RECORDS'}[ $numbers++ ] =
1847 $result{$key}->as_usmarc();
1850 else { # sort by author ASC
1851 foreach my $key ( sort ( keys %result ) ) {
1852 $result_hash->{'RECORDS'}[ $numbers++ ] =
1853 $result{$key}->as_usmarc();
1856 my $finalresult = ();
1857 $result_hash->{'hits'} = $numbers;
1858 $finalresult->{'biblioserver'} = $result_hash;
1859 return $finalresult;
1862 # ORDER BY callnumber
1865 elsif ( $ordering =~ /callnumber/ ) {
1867 foreach ( split /;/, $biblionumbers ) {
1868 my ( $biblionumber, $title ) = split /,/, $_;
1869 my $record = GetMarcBiblio($biblionumber);
1871 my ( $callnumber_tag, $callnumber_subfield ) =
1872 GetMarcFromKohaField( $dbh, 'items.itemcallnumber' );
1873 ( $callnumber_tag, $callnumber_subfield ) =
1874 GetMarcFromKohaField('biblioitems.callnumber')
1875 unless $callnumber_tag;
1876 if ( C4::Context->preference('marcflavour') eq 'UNIMARC' ) {
1877 $callnumber = $record->subfield( '200', 'f' );
1880 $callnumber = $record->subfield( '100', 'a' );
1883 # hint : the result is sorted by title.biblionumber because we can have X biblios with the same title
1884 # and we don't want to get only 1 result for each of them !!!
1885 $result{ $callnumber . $biblionumber } = $record;
1888 # sort the hash and return the same structure as GetRecords (Zebra querying)
1891 if ( $ordering eq 'call_number_dsc' ) { # sort by title desc
1892 foreach my $key ( sort { $b cmp $a } ( keys %result ) ) {
1893 $result_hash->{'RECORDS'}[ $numbers++ ] =
1894 $result{$key}->as_usmarc();
1897 else { # sort by title ASC
1898 foreach my $key ( sort { $a cmp $b } ( keys %result ) ) {
1899 $result_hash->{'RECORDS'}[ $numbers++ ] =
1900 $result{$key}->as_usmarc();
1903 my $finalresult = ();
1904 $result_hash->{'hits'} = $numbers;
1905 $finalresult->{'biblioserver'} = $result_hash;
1906 return $finalresult;
1908 elsif ( $ordering =~ /pubdate/ ) { #pub year
1910 foreach ( split /;/, $biblionumbers ) {
1911 my ( $biblionumber, $title ) = split /,/, $_;
1912 my $record = GetMarcBiblio($biblionumber);
1913 my ( $publicationyear_tag, $publicationyear_subfield ) =
1914 GetMarcFromKohaField( 'biblioitems.publicationyear', '' );
1915 my $publicationyear =
1916 $record->subfield( $publicationyear_tag,
1917 $publicationyear_subfield );
1919 # hint : the result is sorted by title.biblionumber because we can have X biblios with the same title
1920 # and we don't want to get only 1 result for each of them !!!
1921 $result{ $publicationyear . $biblionumber } = $record;
1924 # sort the hash and return the same structure as GetRecords (Zebra querying)
1927 if ( $ordering eq 'pubdate_dsc' ) { # sort by pubyear desc
1928 foreach my $key ( sort { $b cmp $a } ( keys %result ) ) {
1929 $result_hash->{'RECORDS'}[ $numbers++ ] =
1930 $result{$key}->as_usmarc();
1933 else { # sort by pub year ASC
1934 foreach my $key ( sort ( keys %result ) ) {
1935 $result_hash->{'RECORDS'}[ $numbers++ ] =
1936 $result{$key}->as_usmarc();
1939 my $finalresult = ();
1940 $result_hash->{'hits'} = $numbers;
1941 $finalresult->{'biblioserver'} = $result_hash;
1942 return $finalresult;
1948 elsif ( $ordering =~ /title/ ) {
1950 # the title is in the biblionumbers string, so we just need to build a hash, sort it and return
1952 foreach ( split /;/, $biblionumbers ) {
1953 my ( $biblionumber, $title ) = split /,/, $_;
1955 # hint : the result is sorted by title.biblionumber because we can have X biblios with the same title
1956 # and we don't want to get only 1 result for each of them !!!
1957 # hint & speed improvement : we can order without reading the record
1958 # so order, and read records only for the requested page !
1959 $result{ $title . $biblionumber } = $biblionumber;
1962 # sort the hash and return the same structure as GetRecords (Zebra querying)
1965 if ( $ordering eq 'title_az' ) { # sort by title desc
1966 foreach my $key ( sort ( keys %result ) ) {
1967 $result_hash->{'RECORDS'}[ $numbers++ ] = $result{$key};
1970 else { # sort by title ASC
1971 foreach my $key ( sort { $b cmp $a } ( keys %result ) ) {
1972 $result_hash->{'RECORDS'}[ $numbers++ ] = $result{$key};
1976 # limit the $results_per_page to result size if it's more
1977 $results_per_page = $numbers - 1 if $numbers < $results_per_page;
1979 # for the requested page, replace biblionumber by the complete record
1980 # speed improvement : avoid reading too much things
1982 my $counter = $offset ;
1983 $counter <= $offset + $results_per_page ;
1987 $result_hash->{'RECORDS'}[$counter] =
1988 GetMarcBiblio( $result_hash->{'RECORDS'}[$counter] )->as_usmarc;
1990 my $finalresult = ();
1991 $result_hash->{'hits'} = $numbers;
1992 $finalresult->{'biblioserver'} = $result_hash;
1993 return $finalresult;
2000 # we need 2 hashes to order by ranking : the 1st one to count the ranking, the 2nd to order by ranking
2003 foreach ( split /;/, $biblionumbers ) {
2004 my ( $biblionumber, $title ) = split /,/, $_;
2005 $title =~ /(.*)-(\d)/;
2010 # note that we + the ranking because ranking is calculated on weight of EACH term requested.
2011 # if we ask for "two towers", and "two" has weight 2 in biblio N, and "towers" has weight 4 in biblio N
2012 # biblio N has ranking = 6
2013 $count_ranking{$biblionumber} += $ranking;
2016 # build the result by "inverting" the count_ranking hash
2017 # 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
2019 foreach ( keys %count_ranking ) {
2020 $result{ sprintf( "%10d", $count_ranking{$_} ) . '-' . $_ } = $_;
2023 # sort the hash and return the same structure as GetRecords (Zebra querying)
2026 foreach my $key ( sort { $b cmp $a } ( keys %result ) ) {
2027 $result_hash->{'RECORDS'}[ $numbers++ ] = $result{$key};
2030 # limit the $results_per_page to result size if it's more
2031 $results_per_page = $numbers - 1 if $numbers < $results_per_page;
2033 # for the requested page, replace biblionumber by the complete record
2034 # speed improvement : avoid reading too much things
2036 my $counter = $offset ;
2037 $counter <= $offset + $results_per_page ;
2041 $result_hash->{'RECORDS'}[$counter] =
2042 GetMarcBiblio( $result_hash->{'RECORDS'}[$counter] )->as_usmarc
2043 if $result_hash->{'RECORDS'}[$counter];
2045 my $finalresult = ();
2046 $result_hash->{'hits'} = $numbers;
2047 $finalresult->{'biblioserver'} = $result_hash;
2048 return $finalresult;
2054 ($countchanged,$listunchanged) = ModBiblios($listbiblios, $tagsubfield,$initvalue,$targetvalue,$test);
2056 this function changes all the values $initvalue in subfield $tag$subfield in any record in $listbiblios
2057 test parameter if set donot perform change to records in database.
2063 * $listbiblios is an array ref to marcrecords to be changed
2064 * $tagsubfield is the reference of the subfield to change.
2065 * $initvalue is the value to search the record for
2066 * $targetvalue is the value to set the subfield to
2067 * $test is to be set only not to perform changes in database.
2069 =item C<Output arg:>
2070 * $countchanged counts all the changes performed.
2071 * $listunchanged contains the list of all the biblionumbers of records unchanged.
2073 =item C<usage in the script:>
2077 my ($countchanged, $listunchanged) = EditBiblios($results->{RECORD}, $tagsubfield,$initvalue,$targetvalue);;
2078 #If one wants to display unchanged records, you should get biblios foreach @$listunchanged
2079 $template->param(countchanged => $countchanged, loopunchanged=>$listunchanged);
2084 my ( $listbiblios, $tagsubfield, $initvalue, $targetvalue, $test ) = @_;
2087 my ( $tag, $subfield ) = ( $1, $2 )
2088 if ( $tagsubfield =~ /^(\d{1,3})([a-z0-9A-Z@])?$/ );
2089 if ( ( length($tag) < 3 ) && $subfield =~ /0-9/ ) {
2090 $tag = $tag . $subfield;
2093 my ( $bntag, $bnsubf ) = GetMarcFromKohaField('biblio.biblionumber');
2094 my ( $itemtag, $itemsubf ) = GetMarcFromKohaField('items.itemnumber');
2095 if ($tag eq $itemtag) {
2096 # do not allow the embedded item tag to be
2098 warn "Attempting to edit item tag via C4::Search::ModBiblios -- not allowed";
2101 foreach my $usmarc (@$listbiblios) {
2103 $record = eval { MARC::Record->new_from_usmarc($usmarc) };
2107 # usmarc is not a valid usmarc May be a biblionumber
2108 # FIXME - sorry, please let's figure out whether
2109 # this function is to be passed a list of
2110 # record numbers or a list of MARC::Record
2111 # objects. The former is probably better
2112 # because the MARC records supplied by Zebra
2113 # may be not current.
2114 $record = GetMarcBiblio($usmarc);
2115 $biblionumber = $usmarc;
2118 if ( $bntag >= 010 ) {
2119 $biblionumber = $record->subfield( $bntag, $bnsubf );
2122 $biblionumber = $record->field($bntag)->data;
2126 #GetBiblionumber is to be written.
2127 #Could be replaced by TransformMarcToKoha (But Would be longer)
2128 if ( $record->field($tag) ) {
2130 foreach my $field ( $record->field($tag) ) {
2133 $field->delete_subfield(
2134 'code' => $subfield,
2135 'match' => qr($initvalue)
2141 $field->update( $subfield, $targetvalue )
2146 if ( $tag >= 010 ) {
2147 if ( $field->delete_field($field) ) {
2153 $field->data = $targetvalue
2154 if ( $field->data =~ qr($initvalue) );
2159 # warn $record->as_formatted;
2161 ModBiblio( $record, $biblionumber,
2162 GetFrameworkCode($biblionumber) )
2166 push @unmatched, $biblionumber;
2170 push @unmatched, $biblionumber;
2173 return ( $countmatched, \@unmatched );
2176 END { } # module clean-up code here (global destructor)
2183 Koha Developement team <info@koha.org>