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 the searching facilities for the Koha into a zebra catalog.
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 modify the @$fields array and add related fields to search on.
78 my ( $dbh, $fields ) = @_;
79 my $tagslib = GetMarcStructure( 1 );
80 for ( my $i = 0 ; $i <= $#{$fields} ; $i++ ) {
81 my ($tag) = substr( @$fields[$i], 1, 3 );
82 my ($subfield) = substr( @$fields[$i], 4, 1 );
83 @$fields[$i] .= ',' . $tagslib->{$tag}->{$subfield}->{seealso}
84 if ( $tagslib->{$tag}->{$subfield}->{seealso} );
90 ($biblionumber,$biblionumber,$title) = FindDuplicate($record);
96 my $dbh = C4::Context->dbh;
97 my $result = TransformMarcToKoha( $dbh, $record, '' );
102 my ( $biblionumber, $title );
104 # search duplicate on ISBN, easy and fast..
105 # ... normalize first
106 if ( $result->{isbn} ) {
107 $result->{isbn} =~ s/\(.*$//;
108 $result->{isbn} =~ s/\s+$//;
110 #$search->{'avoidquerylog'}=1;
111 if ( $result->{isbn} ) {
112 $query = "isbn=$result->{isbn}";
115 $result->{title} =~ s /\\//g;
116 $result->{title} =~ s /\"//g;
117 $result->{title} =~ s /\(//g;
118 $result->{title} =~ s /\)//g;
119 # remove valid operators
120 $result->{title} =~ s/(and|or|not)//g;
121 $query = "ti,ext=$result->{title}";
122 $query .= " and itemtype=$result->{itemtype}" if ($result->{itemtype});
123 if ($result->{author}){
124 $result->{author} =~ s /\\//g;
125 $result->{author} =~ s /\"//g;
126 $result->{author} =~ s /\(//g;
127 $result->{author} =~ s /\)//g;
128 # remove valid operators
129 $result->{author} =~ s/(and|or|not)//g;
130 $query .= " and au,ext=$result->{author}";
133 my ($error,$searchresults) =
134 SimpleSearch($query); # FIXME :: hardcoded !
136 foreach my $possible_duplicate_record (@$searchresults) {
138 MARC::Record->new_from_usmarc($possible_duplicate_record);
139 my $result = TransformMarcToKoha( $dbh, $marcrecord, '' );
141 # FIXME :: why 2 $biblionumber ?
143 push @results, $result->{'biblionumber'};
144 push @results, $result->{'title'};
152 ($error,$results) = SimpleSearch($query,@servers);
154 this function performs a simple search on the catalog using zoom.
160 * $query could be a simple keyword or a complete CCL query wich is depending on your ccl file.
161 * @servers is optionnal. default one is read on koha.xml
164 * $error is a string which containt the description error if there is one. Else it's empty.
165 * \@results is an array of marc record.
167 =item C<usage in the script:>
171 my ($error, $marcresults) = SimpleSearch($query);
173 if (defined $error) {
174 $template->param(query_error => $error);
175 warn "error: ".$error;
176 output_html_with_http_headers $input, $cookie, $template->output;
180 my $hits = scalar @$marcresults;
183 for(my $i=0;$i<$hits;$i++) {
185 my $marcrecord = MARC::File::USMARC::decode($marcresults->[$i]);
186 my $biblio = TransformMarcToKoha(C4::Context->dbh,$marcrecord,'');
188 #build the hash for the template.
189 $resultsloop{highlight} = ($i % 2)?(1):(0);
190 $resultsloop{title} = $biblio->{'title'};
191 $resultsloop{subtitle} = $biblio->{'subtitle'};
192 $resultsloop{biblionumber} = $biblio->{'biblionumber'};
193 $resultsloop{author} = $biblio->{'author'};
194 $resultsloop{publishercode} = $biblio->{'publishercode'};
195 $resultsloop{publicationyear} = $biblio->{'publicationyear'};
197 push @results, \%resultsloop;
199 $template->param(result=>\@results);
205 if (C4::Context->preference('NoZebra')) {
206 my $result = NZorder(NZanalyse($query))->{'biblioserver'}->{'RECORDS'};
207 return (undef,$result);
213 return ( "No query entered", undef ) unless $query;
215 #@servers = (C4::Context->config("biblioserver")) unless @servers;
217 ("biblioserver") unless @servers
218 ; # FIXME hardcoded value. See catalog/search.pl & opac-search.pl too.
221 for ( my $i = 0 ; $i < @servers ; $i++ ) {
223 $zconns[$i] = C4::Context->Zconn( $servers[$i], 1 );
226 ->search( new ZOOM::Query::CCL2RPN( $query, $zconns[$i] ) );
228 # getting error message if one occured.
230 $zconns[$i]->errmsg() . " ("
231 . $zconns[$i]->errcode() . ") "
232 . $zconns[$i]->addinfo() . " "
233 . $zconns[$i]->diagset();
235 return ( $error, undef ) if $zconns[$i]->errcode();
238 # caught a ZOOM::Exception
242 . $@->addinfo() . " "
245 return ( $error, undef );
250 while ( ( my $i = ZOOM::event( \@zconns ) ) != 0 ) {
251 $ev = $zconns[ $i - 1 ]->last_event();
252 if ( $ev == ZOOM::Event::ZEND ) {
253 $hits = $tmpresults[ $i - 1 ]->size();
256 for ( my $j = 0 ; $j < $hits ; $j++ ) {
257 my $record = $tmpresults[ $i - 1 ]->record($j)->raw();
258 push @results, $record;
262 return ( undef, \@results );
266 # performs the search
269 $koha_query, $simple_query, $sort_by_ref,
270 $servers_ref, $results_per_page, $offset,
271 $expanded_facet, $branches, $query_type,
274 # warn "Query : $koha_query";
275 my @servers = @$servers_ref;
276 my @sort_by = @$sort_by_ref;
278 # create the zoom connection and query object
282 my $results_hashref = ();
285 my $facets_counter = ();
286 my $facets_info = ();
287 my $facets = getFacets();
289 #### INITIALIZE SOME VARS USED CREATE THE FACETED RESULTS
290 my @facets_loop; # stores the ref to array of hashes for template
291 for ( my $i = 0 ; $i < @servers ; $i++ ) {
292 $zconns[$i] = C4::Context->Zconn( $servers[$i], 1 );
294 # perform the search, create the results objects
295 # if this is a local search, use the $koha-query, if it's a federated one, use the federated-query
297 if ( $servers[$i] =~ /biblioserver/ ) {
298 $query_to_use = $koha_query;
301 $query_to_use = $simple_query;
304 #$query_to_use = $simple_query if $scan;
305 #warn $simple_query if ($scan && $DEBUG);
306 # check if we've got a query_type defined
310 if ( $query_type =~ /^ccl/ ) {
312 s/\:/\=/g; # change : to = last minute (FIXME)
314 # warn "CCL : $query_to_use";
317 new ZOOM::Query::CCL2RPN( $query_to_use, $zconns[$i] )
320 elsif ( $query_type =~ /^cql/ ) {
322 # warn "CQL : $query_to_use";
325 new ZOOM::Query::CQL( $query_to_use, $zconns[$i] ) );
327 elsif ( $query_type =~ /^pqf/ ) {
329 # warn "PQF : $query_to_use";
332 new ZOOM::Query::PQF( $query_to_use, $zconns[$i] ) );
337 # warn "preparing to scan:$query_to_use";
340 new ZOOM::Query::CCL2RPN( $query_to_use, $zconns[$i] )
344 # warn "LAST : $query_to_use";
347 new ZOOM::Query::CCL2RPN( $query_to_use, $zconns[$i] )
353 warn "WARNING: query problem with $query_to_use " . $@;
356 # concatenate the sort_by limits and pass them to the results object
358 foreach my $sort (@sort_by) {
359 if ($sort eq "author_az") {
360 $sort_by.="1=1003 <i ";
362 elsif ($sort eq "author_za") {
363 $sort_by.="1=1003 >i ";
365 elsif ($sort eq "popularity_asc") {
366 $sort_by.="1=9003 <i ";
368 elsif ($sort eq "popularity_dsc") {
369 $sort_by.="1=9003 >i ";
371 elsif ($sort eq "call_number_asc") {
372 $sort_by.="1=20 <i ";
374 elsif ($sort eq "call_number_dsc") {
375 $sort_by.="1=20 >i ";
377 elsif ($sort eq "pubdate_asc") {
378 $sort_by.="1=31 <i ";
380 elsif ($sort eq "pubdate_dsc") {
381 $sort_by.="1=31 >i ";
383 elsif ($sort eq "acqdate_asc") {
384 $sort_by.="1=32 <i ";
386 elsif ($sort eq "acqdate_dsc") {
387 $sort_by.="1=32 >i ";
389 elsif ($sort eq "title_az") {
392 elsif ($sort eq "title_za") {
397 if ( $results[$i]->sort( "yaz", $sort_by ) < 0) {
398 warn "WARNING sort $sort_by failed";
402 while ( ( my $i = ZOOM::event( \@zconns ) ) != 0 ) {
403 my $ev = $zconns[ $i - 1 ]->last_event();
404 if ( $ev == ZOOM::Event::ZEND ) {
405 my $size = $results[ $i - 1 ]->size();
408 #$results_hash->{'server'} = $servers[$i-1];
409 # loop through the results
410 $results_hash->{'hits'} = $size;
412 if ( $offset + $results_per_page <= $size ) {
413 $times = $offset + $results_per_page;
418 for ( my $j = $offset ; $j < $times ; $j++ )
419 { #(($offset+$count<=$size) ? ($offset+$count):$size) ; $j++){
423 ## This is just an index scan
425 my ( $term, $occ ) = $results[ $i - 1 ]->term($j);
426 # here we create a minimal MARC record and hand it off to the
427 # template just like a normal result ... perhaps not ideal, but
429 my $tmprecord = MARC::Record->new();
430 $tmprecord->encoding('UTF-8');
433 # srote the minimal record in author/title (depending on MARC flavour)
434 if ( C4::Context->preference("marcflavour") eq
437 $tmptitle = MARC::Field->new(
444 $tmptitle = MARC::Field->new(
450 $tmprecord->append_fields($tmptitle);
451 $results_hash->{'RECORDS'}[$j] =
452 $tmprecord->as_usmarc();
455 $record = $results[ $i - 1 ]->record($j)->raw();
457 #warn "RECORD $j:".$record;
458 $results_hash->{'RECORDS'}[$j] =
459 $record; # making a reference to a hash
460 # Fill the facets while we're looping
461 $facet_record = MARC::Record->new_from_usmarc($record);
463 #warn $servers[$i-1].$facet_record->title();
464 for ( my $k = 0 ; $k <= @$facets ; $k++ ) {
465 if ( $facets->[$k] ) {
467 for my $tag ( @{ $facets->[$k]->{'tags'} } ) {
468 push @fields, $facet_record->field($tag);
470 for my $field (@fields) {
471 my @subfields = $field->subfields();
472 for my $subfield (@subfields) {
473 my ( $code, $data ) = @$subfield;
475 $facets->[$k]->{'subfield'} )
477 $facets_counter->{ $facets->[$k]
478 ->{'link_value'} }->{$data}++;
482 $facets_info->{ $facets->[$k]->{'link_value'} }
484 $facets->[$k]->{'label_value'};
485 $facets_info->{ $facets->[$k]->{'link_value'} }
486 ->{'expanded'} = $facets->[$k]->{'expanded'};
491 $results_hashref->{ $servers[ $i - 1 ] } = $results_hash;
494 #print "connection ", $i-1, ": $size hits";
495 #print $results[$i-1]->record(0)->render() if $size > 0;
498 sort { $facets_counter->{$b} <=> $facets_counter->{$a} }
499 keys %$facets_counter
503 my $number_of_facets;
504 my @this_facets_array;
507 $facets_counter->{$link_value}
508 ->{$b} <=> $facets_counter->{$link_value}->{$a}
509 } keys %{ $facets_counter->{$link_value} }
513 if ( ( $number_of_facets < 6 )
514 || ( $expanded_facet eq $link_value )
515 || ( $facets_info->{$link_value}->{'expanded'} ) )
518 # sanitize the link value ), ( will cause errors with CCL
519 my $facet_link_value = $one_facet;
520 $facet_link_value =~ s/(\(|\))/ /g;
522 # fix the length that will display in the label
523 my $facet_label_value = $one_facet;
524 $facet_label_value = substr( $one_facet, 0, 20 ) . "..."
525 unless length($facet_label_value) <= 20;
527 # well, if it's a branch, label by the name, not the code
528 if ( $link_value =~ /branch/ ) {
530 $branches->{$one_facet}->{'branchname'};
533 # but we're down with the whole label being in the link's title
534 my $facet_title_value = $one_facet;
536 push @this_facets_array,
540 $facets_counter->{$link_value}->{$one_facet},
541 facet_label_value => $facet_label_value,
542 facet_title_value => $facet_title_value,
543 facet_link_value => $facet_link_value,
544 type_link_value => $link_value,
549 unless ( $facets_info->{$link_value}->{'expanded'} ) {
551 if ( ( $number_of_facets > 6 )
552 && ( $expanded_facet ne $link_value ) );
557 type_link_value => $link_value,
558 type_id => $link_value . "_id",
560 $facets_info->{$link_value}->{'label_value'},
561 facets => \@this_facets_array,
562 expandable => $expandable,
563 expand => $link_value,
569 return ( undef, $results_hashref, \@facets_loop );
573 sub _remove_stopwords {
574 my ($operand,$index) = @_;
575 my @stopwords_removed;
576 # phrase and exact-qualified indexes shouldn't have stopwords removed
577 if ($index!~m/phr|ext/){
578 # remove stopwords from operand : parse all stopwords & remove them (case insensitive)
579 # we use IsAlpha unicode definition, to deal correctly with diacritics.
580 # otherwise, a French word like "leçon" woudl be split into "le" "çon", le
581 # is an empty word, we'd get "çon" and wouldn't find anything...
582 foreach (keys %{C4::Context->stopwords}) {
583 next if ($_ =~/(and|or|not)/); # don't remove operators
584 if ($operand =~ /(\P{IsAlpha}$_\P{IsAlpha}|^$_\P{IsAlpha}|\P{IsAlpha}$_$)/) {
585 $operand=~ s/\P{IsAlpha}$_\P{IsAlpha}/ /gi;
586 $operand=~ s/^$_\P{IsAlpha}/ /gi;
587 $operand=~ s/\P{IsAlpha}$_$/ /gi;
588 push @stopwords_removed, $_;
592 return ($operand, \@stopwords_removed);
596 sub _detect_truncation {
597 my ($operand,$index) = @_;
598 my (@nontruncated,@righttruncated,@lefttruncated,@rightlefttruncated,@regexpr);
600 my @wordlist= split (/\s/,$operand);
601 foreach my $word (@wordlist){
602 if ($word=~s/^\*([^\*]+)\*$/$1/){
603 push @rightlefttruncated,$word;
605 elsif($word=~s/^\*([^\*]+)$/$1/){
606 push @lefttruncated,$word;
608 elsif ($word=~s/^([^\*]+)\*$/$1/){
609 push @righttruncated,$word;
611 elsif (index($word,"*")<0){
612 push @nontruncated,$word;
618 return (\@nontruncated,\@righttruncated,\@lefttruncated,\@rightlefttruncated,\@regexpr);
621 sub _build_stemmed_operand {
624 # FIXME: the locale should be set based on the user's language and/or search choice
625 my $stemmer = Lingua::Stem->new( -locale => 'EN-US' );
626 # FIXME: these should be stored in the db so the librarian can modify the behavior
627 $stemmer->add_exceptions(
635 my @words = split( / /, $operand );
636 my $stems = $stemmer->stem(@words);
637 for my $stem (@$stems) {
638 $stemmed_operand .= "$stem";
639 $stemmed_operand .= "?" unless ( $stem =~ /(and$|or$|not$)/ ) || ( length($stem) < 3 );
640 $stemmed_operand .= " ";
642 #warn "STEMMED OPERAND: $stemmed_operand";
643 return $stemmed_operand;
646 sub _build_weighted_query {
647 # FIELD WEIGHTING - This is largely experimental stuff. What I'm committing works
648 # pretty well but will work much better when we have an actual query parser
649 my ($operand,$stemmed_operand,$index) = @_;
650 my $stemming = C4::Context->preference("QueryStemming") || 0;
651 my $weight_fields = C4::Context->preference("QueryWeightFields") || 0;
652 my $fuzzy_enabled = C4::Context->preference("QueryFuzzy") || 0;
654 my $weighted_query .= "(rk=("; # Specifies that we're applying rank
656 # Keyword, or, no index specified
657 if ( ( $index eq 'kw' ) || ( !$index ) ) {
658 $weighted_query .= "Title-cover,ext,r1=\"$operand\""; # exact title-cover
659 $weighted_query .= " or ti,ext,r2=\"$operand\""; # exact title
660 $weighted_query .= " or ti,phr,r3=\"$operand\""; # phrase title
661 #$weighted_query .= " or any,ext,r4=$operand"; # exact any
662 #$weighted_query .=" or kw,wrdl,r5=\"$operand\""; # word list any
663 $weighted_query .= " or wrd,fuzzy,r8=\"$operand\"" if $fuzzy_enabled; # add fuzzy, word list
664 $weighted_query .= " or wrd,right-Truncation,r9=\"$stemmed_operand\"" if ($stemming and $stemmed_operand); # add stemming, right truncation
665 # embedded sorting: 0 a-z; 1 z-a
666 # $weighted_query .= ") or (sort1,aut=1";
668 elsif ( $index eq 'bc' ) {
669 $weighted_query .= "bc=\"$operand\"";
671 # if the index already has more than one qualifier, just wrap the operand
672 # in quotes and pass it back
673 elsif ($index =~ ',') {
674 $weighted_query .=" $index=\"$operand\"";
676 #TODO: build better cases based on specific search indexes
678 $weighted_query .= " $index,ext,r1=\"$operand\""; # exact index
679 #$weighted_query .= " or (title-sort-az=0 or $index,startswithnt,st-word,r3=$operand #)";
680 $weighted_query .= " or $index,phr,r3=\"$operand\""; # phrase index
681 $weighted_query .= " or $index,rt,wrd,r3=\"$operand\""; # word list index
683 $weighted_query .= "))"; # close rank specification
684 return $weighted_query;
687 # build the query itself
689 my ( $operators, $operands, $indexes, $limits, $sort_by, $scan) = @_;
691 my @operators = @$operators if $operators;
692 my @indexes = @$indexes if $indexes;
693 my @operands = @$operands if $operands;
694 my @limits = @$limits if $limits;
695 my @sort_by = @$sort_by if $sort_by;
697 my $stemming = C4::Context->preference("QueryStemming") || 0;
698 my $auto_truncation = C4::Context->preference("QueryAutoTruncate") || 0;
699 my $weight_fields = C4::Context->preference("QueryWeightFields") || 0;
700 my $fuzzy_enabled = C4::Context->preference("QueryFuzzy") || 0;
701 my $remove_stopwords = C4::Context->preference("QueryRemoveStopwords") || 0;
703 my $query = $operands[0];
704 my $simple_query = $operands[0];
713 my $stopwords_removed;
715 # for handling ccl, cql, pqf queries in diagnostic mode, skip the rest of the steps
717 if ( $query =~ /^ccl=/ ) {
718 return ( undef, $', $', $', $', '', '', '', '', 'ccl' );
720 if ( $query =~ /^cql=/ ) {
721 return ( undef, $', $', $', $', '', '', '', '', 'cql' );
723 if ( $query =~ /^pqf=/ ) {
724 return ( undef, $', $', $', $', '', '', '', '', 'pqf' );
727 # pass nested queries directly
728 if ( $query =~ /(\(|\))/ ) {
729 return ( undef, $query, $simple_query, $query_cgi, $query, $limit, $limit_cgi, $limit_desc, $stopwords_removed, 'ccl' );
732 # form-based queries are limited to non-nested at a specific depth, so we can easily
733 # modify the incoming query operands and indexes to do stemming and field weighting
734 # Once we do so, we'll end up with a value in $query, just like if we had an
735 # incoming $query from the user
737 $query = ""; # clear it out so we can populate properly with field-weighted stemmed query
738 my $previous_operand; # a flag used to keep track if there was a previous query
739 # if there was, we can apply the current operator
741 for ( my $i = 0 ; $i <= @operands ; $i++ ) {
743 # COMBINE OPERANDS, INDEXES AND OPERATORS
744 if ( $operands[$i] ) {
746 # a flag to determine whether or not to add the index to the query
748 # if the user is sophisticated enough to specify an index, turn off some defaults
749 if ($operands[$i] =~ /(:|=)/ || $scan) {
752 $remove_stopwords = 0;
754 my $operand = $operands[$i];
755 my $index = $indexes[$i];
757 # some helpful index modifs
758 my $index_plus = "$index:" if $index;
759 my $index_plus_comma="$index," if $index;
762 if ($remove_stopwords) {
763 ($operand, $stopwords_removed) = _remove_stopwords($operand,$index);
764 warn "OPERAND w/out STOPWORDS: >$operand<" if $DEBUG;
765 warn "REMOVED STOPWORDS: @$stopwords_removed" if ($stopwords_removed && $DEBUG);
769 my ($nontruncated,$righttruncated,$lefttruncated,$rightlefttruncated,$regexpr);
770 my $truncated_operand;
771 ($nontruncated,$righttruncated,$lefttruncated,$rightlefttruncated,$regexpr) = _detect_truncation($operand,$index);
772 warn "TRUNCATION: NON:>@$nontruncated< RIGHT:>@$righttruncated< LEFT:>@$lefttruncated< RIGHTLEFT:>@$rightlefttruncated< REGEX:>@$regexpr<" if $DEBUG;
775 if (scalar(@$righttruncated)+scalar(@$lefttruncated)+scalar(@$rightlefttruncated)>0){
776 # don't field weight or add the index to the query, we do it here
778 undef $weight_fields;
779 my $previous_truncation_operand;
780 if (scalar(@$nontruncated)>0) {
781 $truncated_operand.= "$index_plus @$nontruncated ";
782 $previous_truncation_operand = 1;
784 if (scalar(@$righttruncated)>0){
785 $truncated_operand .= "and " if $previous_truncation_operand;
786 $truncated_operand .= "$index_plus_comma"."rtrn:@$righttruncated ";
787 $previous_truncation_operand = 1;
789 if (scalar(@$lefttruncated)>0){
790 $truncated_operand .= "and " if $previous_truncation_operand;
791 $truncated_operand .= "$index_plus_comma"."ltrn:@$lefttruncated ";
792 $previous_truncation_operand = 1;
794 if (scalar(@$rightlefttruncated)>0){
795 $truncated_operand .= "and " if $previous_truncation_operand;
796 $truncated_operand .= "$index_plus_comma"."rltrn:@$rightlefttruncated ";
797 $previous_truncation_operand = 1;
800 $operand = $truncated_operand if $truncated_operand;
801 warn "TRUNCATED OPERAND: >$truncated_operand<" if $DEBUG;
805 $stemmed_operand = _build_stemmed_operand($operand) if $stemming;
806 warn "STEMMED OPERAND: >$stemmed_operand<" if $DEBUG;
808 # Handle Field Weighting
809 my $weighted_operand;
810 $weighted_operand = _build_weighted_query($operand,$stemmed_operand,$index) if $weight_fields;
811 warn "FIELD WEIGHTED OPERAND: >$weighted_operand<" if $DEBUG;
812 $operand = $weighted_operand if $weight_fields;
813 $indexes_set = 1 if $weight_fields;
815 # If there's a previous operand, we need to add an operator
816 if ($previous_operand) {
818 # user-specified operator
819 if ( $operators[$i-1] ) {
820 $query .= " $operators[$i-1] ";
821 $query .= " $index_plus " unless $indexes_set;
822 $query .= " $operand";
823 $query_cgi .="&op=$operators[$i-1]";
824 $query_cgi .="&idx=$index" if $index;
825 $query_cgi .="&q=$operands[$i]" if $operands[$i];
826 $query_desc .=" $operators[$i-1] $index_plus $operands[$i]";
829 # the default operator is and
832 $query .= "$index_plus " unless $indexes_set;
833 $query .= "$operand";
834 $query_cgi .="&op=and&idx=$index" if $index;
835 $query_cgi .="&q=$operands[$i]" if $operands[$i];
836 $query_desc .= " and $index_plus $operands[$i]";
840 # there isn't a pervious operand, don't need an operator
842 # field-weighted queries already have indexes set
843 $query .=" $index_plus " unless $indexes_set;
845 $query_desc .= " $index_plus $operands[$i]";
846 $query_cgi.="&idx=$index" if $index;
847 $query_cgi.="&q=$operands[$i]" if $operands[$i];
849 $previous_operand = 1;
854 warn "QUERY BEFORE LIMITS: >$query<" if $DEBUG;
858 my $availability_limit;
859 foreach my $this_limit (@limits) {
860 if ( $this_limit =~ /available/ ) {
861 # available is defined as (items.notloan is NULL) and (items.itemlost > 0 or NULL) (last clause handles NULL values for lost in zebra)
862 $availability_limit .="( ( allrecords,AlwaysMatches='' not onloan,AlwaysMatches='') and ((lost,st-numeric gt 0) or ( allrecords,AlwaysMatches='' not lost,AlwaysMatches='')) )";
863 $limit_cgi .= "&limit=available";
867 # these are treated as OR
868 elsif ( $this_limit =~ /mc/ ) {
869 $group_OR_limits .= " or " if $group_OR_limits;
870 $limit_desc .=" or " if $group_OR_limits;
871 $group_OR_limits .= "$this_limit";
872 $limit_cgi .="&limit=$this_limit";
873 $limit_desc .= "$this_limit";
878 $limit .= " and " if $limit || $query;
879 $limit .= "$this_limit";
880 $limit_cgi .="&limit=$this_limit";
881 $limit_desc .=" and $this_limit";
884 if ($group_OR_limits) {
885 $limit.=" and " if ($query || $limit );
886 $limit.="($group_OR_limits)";
888 if ($availability_limit) {
889 $limit.=" not " if ($query || $limit );
890 $limit.="$availability_limit";
892 # normalize the strings
895 for ($query, $query_desc, $limit, $limit_desc) {
896 $_ =~ s/ / /g; # remove extra spaces
897 $_ =~ s/^ //g; # remove any beginning spaces
898 $_ =~ s/ $//g; # remove any ending spaces
899 $_ =~ s/==/=/g; # remove double == from query
902 $query_cgi =~ s/^&//;
904 # append the limit to the query
905 $query .= " ".$limit;
907 warn "QUERY:".$query if $DEBUG;
908 warn "QUERY CGI:".$query_cgi if $DEBUG;
909 warn "QUERY DESC:".$query_desc if $DEBUG;
910 warn "LIMIT:".$limit if $DEBUG;
911 warn "LIMIT CGI:".$limit_cgi if $DEBUG;
912 warn "LIMIT DESC:".$limit_desc if $DEBUG;
914 return ( undef, $query,$simple_query,$query_cgi,$query_desc,$limit,$limit_cgi,$limit_desc,$stopwords_removed,$query_type );
917 # IMO this subroutine is pretty messy still -- it's responsible for
918 # building the HTML output for the template
920 my ( $searchdesc, $hits, $results_per_page, $offset, @marcresults ) = @_;
922 my $dbh = C4::Context->dbh;
926 my $span_terms_hashref;
927 for my $span_term ( split( / /, $searchdesc ) ) {
928 $span_term =~ s/(.*=|\)|\(|\+|\.)//g;
929 $span_terms_hashref->{$span_term}++;
932 #Build brancnames hash
934 #get branch information.....
937 $dbh->prepare("SELECT branchcode,branchname FROM branches")
938 ; # FIXME : use C4::Koha::GetBranches
940 while ( my $bdata = $bsth->fetchrow_hashref ) {
941 $branches{ $bdata->{'branchcode'} } = $bdata->{'branchname'};
945 #find itemtype & itemtype image
948 $dbh->prepare("SELECT itemtype,description,imageurl,summary,notforloan FROM itemtypes");
950 while ( my $bdata = $bsth->fetchrow_hashref ) {
951 $itemtypes{ $bdata->{'itemtype'} }->{description} =
952 $bdata->{'description'};
953 $itemtypes{ $bdata->{'itemtype'} }->{imageurl} = $bdata->{'imageurl'};
954 $itemtypes{ $bdata->{'itemtype'} }->{summary} = $bdata->{'summary'};
955 $itemtypes{ $bdata->{'itemtype'} }->{notforloan} = $bdata->{'notforloan'};
958 #search item field code
961 "select tagfield from marc_subfield_structure where kohafield like 'items.itemnumber'"
964 my ($itemtag) = $sth->fetchrow;
966 ## find column names of items related to MARC
967 my $sth2 = $dbh->prepare("SHOW COLUMNS from items");
969 my %subfieldstosearch;
970 while ( ( my $column ) = $sth2->fetchrow ) {
971 my ( $tagfield, $tagsubfield ) =
972 &GetMarcFromKohaField( "items." . $column, "" );
973 $subfieldstosearch{$column} = $tagsubfield;
977 if ( $hits && $offset + $results_per_page <= $hits ) {
978 $times = $offset + $results_per_page;
984 for ( my $i = $offset ; $i <= $times - 1 ; $i++ ) {
986 $marcrecord = MARC::File::USMARC::decode( $marcresults[$i] );
987 my $oldbiblio = TransformMarcToKoha( $dbh, $marcrecord, '' );
988 $oldbiblio->{result_number} = $i+1;
989 # add image url if there is one
990 if ( $itemtypes{ $oldbiblio->{itemtype} }->{imageurl} =~ /^http:/ ) {
991 $oldbiblio->{imageurl} =
992 $itemtypes{ $oldbiblio->{itemtype} }->{imageurl};
993 $oldbiblio->{description} =
994 $itemtypes{ $oldbiblio->{itemtype} }->{description};
997 $oldbiblio->{imageurl} =
998 getitemtypeimagesrc() . "/"
999 . $itemtypes{ $oldbiblio->{itemtype} }->{imageurl}
1000 if ( $itemtypes{ $oldbiblio->{itemtype} }->{imageurl} );
1001 $oldbiblio->{description} =
1002 $itemtypes{ $oldbiblio->{itemtype} }->{description};
1005 # build summary if there is one (the summary is defined in itemtypes table
1007 if ($itemtypes{ $oldbiblio->{itemtype} }->{summary}) {
1008 my $summary = $itemtypes{ $oldbiblio->{itemtype} }->{summary};
1009 my @fields = $marcrecord->fields();
1010 foreach my $field (@fields) {
1011 my $tag = $field->tag();
1012 my $tagvalue = $field->as_string();
1013 $summary =~ s/\[(.?.?.?.?)$tag\*(.*?)]/$1$tagvalue$2\[$1$tag$2]/g;
1015 my @subf = $field->subfields;
1016 for my $i (0..$#subf) {
1017 my $subfieldcode = $subf[$i][0];
1018 my $subfieldvalue = $subf[$i][1];
1019 my $tagsubf = $tag.$subfieldcode;
1020 $summary =~ s/\[(.?.?.?.?)$tagsubf(.*?)]/$1$subfieldvalue$2\[$1$tagsubf$2]/g;
1024 $summary =~ s/\[(.*?)]//g;
1025 $summary =~ s/\n/<br>/g;
1026 $oldbiblio->{summary} = $summary;
1028 # add spans to search term in results for search term highlighting
1029 # save a native author, for the <a href=search.lq=<!--tmpl_var name="author"-->> link
1030 $oldbiblio->{'author_nospan'} = $oldbiblio->{'author'};
1031 foreach my $term ( keys %$span_terms_hashref ) {
1032 my $old_term = $term;
1033 if ( length($term) > 3 ) {
1034 $term =~ s/(.*=|\)|\(|\+|\.|\?|\[|\])//g;
1038 #FIXME: is there a better way to do this?
1039 $oldbiblio->{'title'} =~ s/$term/<span class=\"term\">$&<\/span>/gi;
1040 $oldbiblio->{'subtitle'} =~
1041 s/$term/<span class=\"term\">$&<\/span>/gi;
1043 $oldbiblio->{'author'} =~ s/$term/<span class=\"term\">$&<\/span>/gi;
1044 $oldbiblio->{'publishercode'} =~ s/$term/<span class=\"term\">$&<\/span>/gi;
1045 $oldbiblio->{'place'} =~ s/$term/<span class=\"term\">$&<\/span>/gi;
1046 $oldbiblio->{'pages'} =~ s/$term/<span class=\"term\">$&<\/span>/gi;
1047 $oldbiblio->{'notes'} =~ s/$term/<span class=\"term\">$&<\/span>/gi;
1048 $oldbiblio->{'size'} =~ s/$term/<span class=\"term\">$&<\/span>/gi;
1053 $toggle = "#ffffcc";
1058 $oldbiblio->{'toggle'} = $toggle;
1059 my @fields = $marcrecord->field($itemtag);
1062 my $ordered_count = 0;
1063 my $onloan_count = 0;
1064 my $wthdrawn_count = 0;
1065 my $itemlost_count = 0;
1069 # check the loan status of the item :
1070 # it is not stored in the MARC record, for pref (zebra reindexing)
1071 # reason. Thus, we have to get the status from a specific SQL query
1073 my $sth_issue = $dbh->prepare("
1074 SELECT date_due,returndate
1076 WHERE itemnumber=? AND returndate IS NULL");
1077 my $items_count=scalar(@fields);
1078 foreach my $field (@fields) {
1080 foreach my $code ( keys %subfieldstosearch ) {
1081 $item->{$code} = $field->subfield( $subfieldstosearch{$code} );
1083 $sth_issue->execute($item->{itemnumber});
1084 $item->{due_date} = format_date($sth_issue->fetchrow);
1085 $item->{onloan} = 1 if $item->{due_date};
1086 # at least one item can be reserved : suppose no
1088 if ( $item->{wthdrawn} ) {
1090 $items->{ $item->{'homebranch'}.'--'.$item->{'itemcallnumber'} }->{unavailable}=1;
1091 $items->{ $item->{'homebranch'}.'--'.$item->{'itemcallnumber'} }->{wthdrawn}=1;
1093 elsif ( $item->{itemlost} ) {
1095 $items->{ $item->{'homebranch'}.'--'.$item->{'itemcallnumber'} }->{unavailable}=1;
1096 $items->{ $item->{'homebranch'}.'--'.$item->{'itemcallnumber'} }->{itemlost}=1;
1098 unless ( $item->{notforloan}) {
1099 # OK, this one can be issued, so at least one can be reserved
1102 if ( ( $item->{onloan} ) && ( $item->{onloan} != '0000-00-00' ) )
1104 $items->{ $item->{'homebranch'}.'--'.$item->{'itemcallnumber'} }->{unavailable}=1;
1105 $items->{ $item->{'homebranch'}.'--'.$item->{'itemcallnumber'} }->{onloancount} = 1;
1106 $items->{ $item->{'homebranch'}.'--'.$item->{'itemcallnumber'} }->{due_date} = $item->{due_date};
1109 if ( $item->{'homebranch'} ) {
1110 $items->{ $item->{'homebranch'}.'--'.$item->{'itemcallnumber'} }->{count}++;
1114 elsif ( $item->{'holdingbranch'} ) {
1115 $items->{ $item->{'holdingbranch'} }->{count}++;
1117 $items->{ $item->{'homebranch'}.'--'.$item->{'itemcallnumber'} }->{itemcallnumber} = $item->{itemcallnumber};
1118 $items->{ $item->{'homebranch'}.'--'.$item->{'itemcallnumber'} }->{location} = $item->{location};
1119 $items->{ $item->{'homebranch'}.'--'.$item->{'itemcallnumber'} }->{branchcode} = $item->{homebranch};
1120 } # notforloan, item level and biblioitem level
1122 # last check for norequest : if itemtype is notforloan, it can't be reserved either, whatever the items
1123 $norequests = 1 if $itemtypes{$oldbiblio->{itemtype}}->{notforloan};
1125 for my $key ( sort keys %$items ) {
1128 branchname => $branches{$items->{$key}->{branchcode}},
1129 branchcode => $items->{$key}->{branchcode},
1130 count => $items->{$key}->{count},
1131 itemcallnumber => $items->{$key}->{itemcallnumber},
1132 location => $items->{$key}->{location},
1133 onloancount => $items->{$key}->{onloancount},
1134 due_date => $items->{$key}->{due_date},
1135 wthdrawn => $items->{$key}->{wthdrawn},
1136 lost => $items->{$key}->{itemlost},
1138 # only show the number specified by the user
1139 my $maxitems = (C4::Context->preference('maxItemsinSearchResults')) ? C4::Context->preference('maxItemsinSearchResults')- 1 : 1;
1140 push @items_loop, $this_item unless $itemscount > $maxitems;;
1142 $oldbiblio->{norequests} = $norequests;
1143 $oldbiblio->{items_count} = $items_count;
1144 $oldbiblio->{items_loop} = \@items_loop;
1145 $oldbiblio->{onloancount} = $onloan_count;
1146 $oldbiblio->{wthdrawncount} = $wthdrawn_count;
1147 $oldbiblio->{itemlostcount} = $itemlost_count;
1148 $oldbiblio->{orderedcount} = $ordered_count;
1149 $oldbiblio->{isbn} =~ s/-//g; # deleting - in isbn to enable amazon content
1150 push( @newresults, $oldbiblio );
1157 #----------------------------------------------------------------------
1159 # Non-Zebra GetRecords#
1160 #----------------------------------------------------------------------
1164 NZgetRecords has the same API as zera getRecords, even if some parameters are not managed
1168 my ($query,$simple_query,$sort_by_ref,$servers_ref,$results_per_page,$offset,$expanded_facet,$branches,$query_type,$scan) = @_;
1169 my $result = NZanalyse($query);
1170 return (undef,NZorder($result,@$sort_by_ref[0],$results_per_page,$offset),undef);
1175 NZanalyse : get a CQL string as parameter, and returns a list of biblionumber;title,biblionumber;title,...
1176 the list is built from an inverted index in the nozebra SQL table
1177 note that title is here only for convenience : the sorting will be very fast when requested on title
1178 if the sorting is requested on something else, we will have to reread all results, and that may be longer.
1183 my ($string,$server) = @_;
1184 # $server contains biblioserver or authorities, depending on what we search on.
1185 #warn "querying : $string on $server";
1186 $server='biblioserver' unless $server;
1188 # if we have a ", replace the content to discard temporarily any and/or/not inside
1190 if ($string =~/"/) {
1191 $string =~ s/"(.*?)"/__X__/;
1193 warn "commacontent : $commacontent" if $DEBUG;
1195 # split the query string in 3 parts : X AND Y means : $left="X", $operand="AND" and $right="Y"
1196 # then, call again NZanalyse with $left and $right
1197 # (recursive until we find a leaf (=> something without and/or/not)
1198 # delete repeated operator... Would then go in infinite loop
1199 while ($string =~s/( and| or| not| AND| OR| NOT)\1/$1/g){
1201 #process parenthesis before.
1202 if ($string =~ /^\s*\((.*)\)(( and | or | not | AND | OR | NOT )(.*))?/){
1204 # warn "left :".$left;
1206 my $operator = lc($3); # FIXME: and/or/not are operators, not operands
1207 my $leftresult = NZanalyse($left,$server);
1209 my $rightresult = NZanalyse($right,$server);
1210 # OK, we have the results for right and left part of the query
1211 # depending of operand, intersect, union or exclude both lists
1212 # to get a result list
1213 if ($operator eq ' and ') {
1214 my @leftresult = split /;/, $leftresult;
1215 # my @rightresult = split /;/,$leftresult;
1217 # parse the left results, and if the biblionumber exist in the right result, save it in finalresult
1218 # the result is stored twice, to have the same weight for AND than OR.
1219 # example : TWO : 61,61,64,121 (two is twice in the biblio #61) / TOWER : 61,64,130
1220 # result : 61,61,61,61,64,64 for two AND tower : 61 has more weight than 64
1221 foreach (@leftresult) {
1222 if ($rightresult =~ "$_;") {
1223 $finalresult .= "$_;$_;";
1226 return $finalresult;
1227 } elsif ($operator eq ' or ') {
1228 # just merge the 2 strings
1229 return $leftresult.$rightresult;
1230 } elsif ($operator eq ' not ') {
1231 my @leftresult = split /;/, $leftresult;
1232 # my @rightresult = split /;/,$leftresult;
1234 foreach (@leftresult) {
1235 unless ($rightresult =~ "$_;") {
1236 $finalresult .= "$_;";
1239 return $finalresult;
1241 # this error is impossible, because of the regexp that isolate the operand, but just in case...
1247 warn "string :".$string if $DEBUG;
1248 $string =~ /(.*?)( and | or | not | AND | OR | NOT )(.*)/;
1251 my $operand = lc($2); # FIXME: and/or/not are operators, not operands
1252 # it's not a leaf, we have a and/or/not
1254 # reintroduce comma content if needed
1255 $right =~ s/__X__/"$commacontent"/ if $commacontent;
1256 $left =~ s/__X__/"$commacontent"/ if $commacontent;
1257 warn "node : $left / $operand / $right\n" if $DEBUG;
1258 my $leftresult = NZanalyse($left,$server);
1259 my $rightresult = NZanalyse($right,$server);
1260 # OK, we have the results for right and left part of the query
1261 # depending of operand, intersect, union or exclude both lists
1262 # to get a result list
1263 if ($operand eq ' and ') {
1264 my @leftresult = split /;/, $leftresult;
1265 # my @rightresult = split /;/,$leftresult;
1267 # parse the left results, and if the biblionumber exist in the right result, save it in finalresult
1268 # the result is stored twice, to have the same weight for AND than OR.
1269 # example : TWO : 61,61,64,121 (two is twice in the biblio #61) / TOWER : 61,64,130
1270 # result : 61,61,61,61,64,64 for two AND tower : 61 has more weight than 64
1271 foreach (@leftresult) {
1272 if ($rightresult =~ "$_;") {
1273 $finalresult .= "$_;$_;";
1276 return $finalresult;
1277 } elsif ($operand eq ' or ') {
1278 # just merge the 2 strings
1279 return $leftresult.$rightresult;
1280 } elsif ($operand eq ' not ') {
1281 my @leftresult = split /;/, $leftresult;
1282 # my @rightresult = split /;/,$leftresult;
1284 foreach (@leftresult) {
1285 unless ($rightresult =~ "$_;") {
1286 $finalresult .= "$_;";
1289 return $finalresult;
1291 # this error is impossible, because of the regexp that isolate the operand, but just in case...
1292 die "error : operand unknown : $operand for $string";
1294 # it's a leaf, do the real SQL query and return the result
1296 $string =~ s/__X__/"$commacontent"/ if $commacontent;
1297 $string =~ s/-|\.|\?|,|;|!|'|\(|\)|\[|\]|{|}|"|&|\+|\*|\// /g;
1298 warn "leaf : $string\n" if $DEBUG;
1299 # parse the string in in operator/operand/value again
1300 $string =~ /(.*)(>=|<=)(.*)/;
1304 unless ($operator) {
1305 $string =~ /(.*)(>|<|=)(.*)/;
1311 # automatic replace for short operators
1312 $left='title' if $left =~ '^ti$';
1313 $left='author' if $left =~ '^au$';
1314 $left='publisher' if $left =~ '^pb$';
1315 $left='subject' if $left =~ '^su$';
1316 $left='koha-Auth-Number' if $left =~ '^an$';
1317 $left='keyword' if $left =~ '^kw$';
1319 #do a specific search
1320 my $dbh = C4::Context->dbh;
1321 $operator='LIKE' if $operator eq '=' and $right=~ /%/;
1322 my $sth = $dbh->prepare("SELECT biblionumbers,value FROM nozebra WHERE server=? AND indexname=? AND value $operator ?");
1323 warn "$left / $operator / $right\n";
1324 # split each word, query the DB and build the biblionumbers result
1325 #sanitizing leftpart
1326 $left=~s/^\s+|\s+$//;
1327 my ($biblionumbers,$value);
1328 foreach (split / /,$right) {
1330 warn "EXECUTE : $server, $left, $_";
1331 $sth->execute($server, $left, $_) or warn "execute failed: $!";
1332 while (my ($line,$value) = $sth->fetchrow) {
1333 # if we are dealing with a numeric value, use only numeric results (in case of >=, <=, > or <)
1334 # otherwise, fill the result
1335 $biblionumbers .= $line unless ($right =~ /\d/ && $value =~ /\D/);
1336 # warn "result : $value ". ($right =~ /\d/) . "==".(!$value =~ /\d/) ;#= $line";
1338 # do a AND with existing list if there is one, otherwise, use the biblionumbers list as 1st result list
1340 my @leftresult = split /;/, $biblionumbers;
1342 foreach my $entry (@leftresult) { # $_ contains biblionumber,title-weight
1343 # remove weight at the end
1344 my $cleaned = $entry;
1345 $cleaned =~ s/-\d*$//;
1346 # if the entry already in the hash, take it & increase weight
1347 warn "===== $cleaned =====" if $DEBUG;
1348 if ($results =~ "$cleaned") {
1349 $temp .= "$entry;$entry;";
1350 warn "INCLUDING $entry" if $DEBUG;
1355 $results = $biblionumbers;
1359 #do a complete search (all indexes)
1360 my $dbh = C4::Context->dbh;
1361 my $sth = $dbh->prepare("SELECT biblionumbers FROM nozebra WHERE server=? AND value LIKE ?");
1362 # split each word, query the DB and build the biblionumbers result
1363 foreach (split / /,$string) {
1364 next if C4::Context->stopwords->{uc($_)}; # skip if stopword
1365 warn "search on all indexes on $_" if $DEBUG;
1368 $sth->execute($server, $_);
1369 while (my $line = $sth->fetchrow) {
1370 $biblionumbers .= $line;
1372 # do a AND with existing list if there is one, otherwise, use the biblionumbers list as 1st result list
1374 warn "RES for $_ = $biblionumbers" if $DEBUG;
1375 my @leftresult = split /;/, $biblionumbers;
1377 foreach my $entry (@leftresult) { # $_ contains biblionumber,title-weight
1378 # remove weight at the end
1379 my $cleaned = $entry;
1380 $cleaned =~ s/-\d*$//;
1381 # if the entry already in the hash, take it & increase weight
1382 warn "===== $cleaned =====" if $DEBUG;
1383 if ($results =~ "$cleaned") {
1384 $temp .= "$entry;$entry;";
1385 warn "INCLUDING $entry" if $DEBUG;
1390 warn "NEW RES for $_ = $biblionumbers" if $DEBUG;
1391 $results = $biblionumbers;
1395 # warn "return : $results for LEAF : $string" if $DEBUG;
1402 $finalresult = NZorder($biblionumbers, $ordering,$results_per_page,$offset);
1410 my ($biblionumbers, $ordering,$results_per_page,$offset) = @_;
1411 # order title asc by default
1412 # $ordering = '1=36 <i' unless $ordering;
1413 $results_per_page=20 unless $results_per_page;
1414 $offset = 0 unless $offset;
1415 my $dbh = C4::Context->dbh;
1417 # order by POPULARITY
1419 if ($ordering =~ /popularity/) {
1422 # popularity is not in MARC record, it's builded from a specific query
1423 my $sth = $dbh->prepare("select sum(issues) from items where biblionumber=?");
1424 foreach (split /;/,$biblionumbers) {
1425 my ($biblionumber,$title) = split /,/,$_;
1426 $result{$biblionumber}=GetMarcBiblio($biblionumber);
1427 $sth->execute($biblionumber);
1428 my $popularity= $sth->fetchrow ||0;
1429 # hint : the key is popularity.title because we can have
1430 # many results with the same popularity. In this cas, sub-ordering is done by title
1431 # we also have biblionumber to avoid bug for 2 biblios with the same title & popularity
1432 # (un-frequent, I agree, but we won't forget anything that way ;-)
1433 $popularity{sprintf("%10d",$popularity).$title.$biblionumber} = $biblionumber;
1435 # sort the hash and return the same structure as GetRecords (Zebra querying)
1438 if ($ordering eq 'popularity_dsc') { # sort popularity DESC
1439 foreach my $key (sort {$b cmp $a} (keys %popularity)) {
1440 $result_hash->{'RECORDS'}[$numbers++] = $result{$popularity{$key}}->as_usmarc();
1442 } else { # sort popularity ASC
1443 foreach my $key (sort (keys %popularity)) {
1444 $result_hash->{'RECORDS'}[$numbers++] = $result{$popularity{$key}}->as_usmarc();
1448 $result_hash->{'hits'} = $numbers;
1449 $finalresult->{'biblioserver'} = $result_hash;
1450 return $finalresult;
1454 } elsif ($ordering =~/author/){
1456 foreach (split /;/,$biblionumbers) {
1457 my ($biblionumber,$title) = split /,/,$_;
1458 my $record=GetMarcBiblio($biblionumber);
1460 if (C4::Context->preference('marcflavour') eq 'UNIMARC') {
1461 $author=$record->subfield('200','f');
1462 $author=$record->subfield('700','a') unless $author;
1464 $author=$record->subfield('100','a');
1466 # hint : the result is sorted by title.biblionumber because we can have X biblios with the same title
1467 # and we don't want to get only 1 result for each of them !!!
1468 $result{$author.$biblionumber}=$record;
1470 # sort the hash and return the same structure as GetRecords (Zebra querying)
1473 if ($ordering eq 'author_za') { # sort by author desc
1474 foreach my $key (sort { $b cmp $a } (keys %result)) {
1475 $result_hash->{'RECORDS'}[$numbers++] = $result{$key}->as_usmarc();
1477 } else { # sort by author ASC
1478 foreach my $key (sort (keys %result)) {
1479 $result_hash->{'RECORDS'}[$numbers++] = $result{$key}->as_usmarc();
1483 $result_hash->{'hits'} = $numbers;
1484 $finalresult->{'biblioserver'} = $result_hash;
1485 return $finalresult;
1487 # ORDER BY callnumber
1489 } elsif ($ordering =~/callnumber/){
1491 foreach (split /;/,$biblionumbers) {
1492 my ($biblionumber,$title) = split /,/,$_;
1493 my $record=GetMarcBiblio($biblionumber);
1495 my ($callnumber_tag,$callnumber_subfield)=GetMarcFromKohaField($dbh,'items.itemcallnumber');
1496 ($callnumber_tag,$callnumber_subfield)= GetMarcFromKohaField('biblioitems.callnumber') unless $callnumber_tag;
1497 if (C4::Context->preference('marcflavour') eq 'UNIMARC') {
1498 $callnumber=$record->subfield('200','f');
1500 $callnumber=$record->subfield('100','a');
1502 # hint : the result is sorted by title.biblionumber because we can have X biblios with the same title
1503 # and we don't want to get only 1 result for each of them !!!
1504 $result{$callnumber.$biblionumber}=$record;
1506 # sort the hash and return the same structure as GetRecords (Zebra querying)
1509 if ($ordering eq 'call_number_dsc') { # sort by title desc
1510 foreach my $key (sort { $b cmp $a } (keys %result)) {
1511 $result_hash->{'RECORDS'}[$numbers++] = $result{$key}->as_usmarc();
1513 } else { # sort by title ASC
1514 foreach my $key (sort { $a cmp $b } (keys %result)) {
1515 $result_hash->{'RECORDS'}[$numbers++] = $result{$key}->as_usmarc();
1519 $result_hash->{'hits'} = $numbers;
1520 $finalresult->{'biblioserver'} = $result_hash;
1521 return $finalresult;
1522 } elsif ($ordering =~ /pubdate/){ #pub year
1524 foreach (split /;/,$biblionumbers) {
1525 my ($biblionumber,$title) = split /,/,$_;
1526 my $record=GetMarcBiblio($biblionumber);
1527 my ($publicationyear_tag,$publicationyear_subfield)=GetMarcFromKohaField('biblioitems.publicationyear','');
1528 my $publicationyear=$record->subfield($publicationyear_tag,$publicationyear_subfield);
1529 # hint : the result is sorted by title.biblionumber because we can have X biblios with the same title
1530 # and we don't want to get only 1 result for each of them !!!
1531 $result{$publicationyear.$biblionumber}=$record;
1533 # sort the hash and return the same structure as GetRecords (Zebra querying)
1536 if ($ordering eq 'pubdate_dsc') { # sort by pubyear desc
1537 foreach my $key (sort { $b cmp $a } (keys %result)) {
1538 $result_hash->{'RECORDS'}[$numbers++] = $result{$key}->as_usmarc();
1540 } else { # sort by pub year ASC
1541 foreach my $key (sort (keys %result)) {
1542 $result_hash->{'RECORDS'}[$numbers++] = $result{$key}->as_usmarc();
1546 $result_hash->{'hits'} = $numbers;
1547 $finalresult->{'biblioserver'} = $result_hash;
1548 return $finalresult;
1552 } elsif ($ordering =~ /title/) {
1553 # the title is in the biblionumbers string, so we just need to build a hash, sort it and return
1555 foreach (split /;/,$biblionumbers) {
1556 my ($biblionumber,$title) = split /,/,$_;
1557 # hint : the result is sorted by title.biblionumber because we can have X biblios with the same title
1558 # and we don't want to get only 1 result for each of them !!!
1559 # hint & speed improvement : we can order without reading the record
1560 # so order, and read records only for the requested page !
1561 $result{$title.$biblionumber}=$biblionumber;
1563 # sort the hash and return the same structure as GetRecords (Zebra querying)
1566 if ($ordering eq 'title_az') { # sort by title desc
1567 foreach my $key (sort (keys %result)) {
1568 $result_hash->{'RECORDS'}[$numbers++] = $result{$key};
1570 } else { # sort by title ASC
1571 foreach my $key (sort { $b cmp $a } (keys %result)) {
1572 $result_hash->{'RECORDS'}[$numbers++] = $result{$key};
1575 # limit the $results_per_page to result size if it's more
1576 $results_per_page = $numbers-1 if $numbers < $results_per_page;
1577 # for the requested page, replace biblionumber by the complete record
1578 # speed improvement : avoid reading too much things
1579 for (my $counter=$offset;$counter<=$offset+$results_per_page;$counter++) {
1580 $result_hash->{'RECORDS'}[$counter] = GetMarcBiblio($result_hash->{'RECORDS'}[$counter])->as_usmarc;
1583 $result_hash->{'hits'} = $numbers;
1584 $finalresult->{'biblioserver'} = $result_hash;
1585 return $finalresult;
1590 # we need 2 hashes to order by ranking : the 1st one to count the ranking, the 2nd to order by ranking
1593 foreach (split /;/,$biblionumbers) {
1594 my ($biblionumber,$title) = split /,/,$_;
1595 $title =~ /(.*)-(\d)/;
1598 # note that we + the ranking because ranking is calculated on weight of EACH term requested.
1599 # if we ask for "two towers", and "two" has weight 2 in biblio N, and "towers" has weight 4 in biblio N
1600 # biblio N has ranking = 6
1601 $count_ranking{$biblionumber} += $ranking;
1603 # build the result by "inverting" the count_ranking hash
1604 # 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
1606 foreach (keys %count_ranking) {
1607 $result{sprintf("%10d",$count_ranking{$_}).'-'.$_} = $_;
1609 # sort the hash and return the same structure as GetRecords (Zebra querying)
1612 foreach my $key (sort {$b cmp $a} (keys %result)) {
1613 $result_hash->{'RECORDS'}[$numbers++] = $result{$key};
1615 # limit the $results_per_page to result size if it's more
1616 $results_per_page = $numbers-1 if $numbers < $results_per_page;
1617 # for the requested page, replace biblionumber by the complete record
1618 # speed improvement : avoid reading too much things
1619 for (my $counter=$offset;$counter<=$offset+$results_per_page;$counter++) {
1620 $result_hash->{'RECORDS'}[$counter] = GetMarcBiblio($result_hash->{'RECORDS'}[$counter])->as_usmarc if $result_hash->{'RECORDS'}[$counter];
1623 $result_hash->{'hits'} = $numbers;
1624 $finalresult->{'biblioserver'} = $result_hash;
1625 return $finalresult;
1630 ($countchanged,$listunchanged) = ModBiblios($listbiblios, $tagsubfield,$initvalue,$targetvalue,$test);
1632 this function changes all the values $initvalue in subfield $tag$subfield in any record in $listbiblios
1633 test parameter if set donot perform change to records in database.
1639 * $listbiblios is an array ref to marcrecords to be changed
1640 * $tagsubfield is the reference of the subfield to change.
1641 * $initvalue is the value to search the record for
1642 * $targetvalue is the value to set the subfield to
1643 * $test is to be set only not to perform changes in database.
1645 =item C<Output arg:>
1646 * $countchanged counts all the changes performed.
1647 * $listunchanged contains the list of all the biblionumbers of records unchanged.
1649 =item C<usage in the script:>
1653 my ($countchanged, $listunchanged) = EditBiblios($results->{RECORD}, $tagsubfield,$initvalue,$targetvalue);;
1654 #If one wants to display unchanged records, you should get biblios foreach @$listunchanged
1655 $template->param(countchanged => $countchanged, loopunchanged=>$listunchanged);
1660 my ($listbiblios,$tagsubfield,$initvalue,$targetvalue,$test)=@_;
1663 my ($tag,$subfield)=($1,$2) if ($tagsubfield=~/^(\d{1,3})([a-z0-9A-Z@])?$/);
1664 if ((length($tag)<3)&& $subfield=~/0-9/){
1665 $tag=$tag.$subfield;
1668 my ($bntag,$bnsubf) = GetMarcFromKohaField('biblio.biblionumber');
1669 my ($itemtag,$itemsubf) = GetMarcFromKohaField('items.itemnumber');
1670 foreach my $usmarc (@$listbiblios){
1672 $record=eval{MARC::Record->new_from_usmarc($usmarc)};
1675 # usmarc is not a valid usmarc May be a biblionumber
1676 if ($tag eq $itemtag){
1677 my $bib=GetBiblioFromItemNumber($usmarc);
1678 $record=GetMarcItem($bib->{'biblionumber'},$usmarc) ;
1679 $biblionumber=$bib->{'biblionumber'};
1681 $record=GetMarcBiblio($usmarc);
1682 $biblionumber=$usmarc;
1686 $biblionumber = $record->subfield($bntag,$bnsubf);
1688 $biblionumber=$record->field($bntag)->data;
1691 #GetBiblionumber is to be written.
1692 #Could be replaced by TransformMarcToKoha (But Would be longer)
1693 if ($record->field($tag)){
1695 foreach my $field ($record->field($tag)){
1697 if ($field->delete_subfield('code' =>$subfield,'match'=>qr($initvalue))){
1700 $field->update($subfield,$targetvalue) if ($targetvalue);
1704 if ($field->delete_field($field)){
1709 $field->data=$targetvalue if ($field->data=~qr($initvalue));
1713 # warn $record->as_formatted;
1715 ModBiblio($record,$biblionumber,GetFrameworkCode($biblionumber)) unless ($test);
1717 push @unmatched, $biblionumber;
1720 push @unmatched, $biblionumber;
1723 return ($countmatched,\@unmatched);
1726 END { } # module clean-up code here (global destructor)
1733 Koha Developement team <info@koha.org>