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
26 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
28 # set the version for version checking
34 C4::Search - Functions for searching the Koha catalog.
38 see opac/opac-search.pl or catalogue/search.pl for example of usage
42 This module provides the searching facilities for the Koha into a zebra catalog.
60 # make all your functions, whether exported or not;
62 =head2 findseealso($dbh,$fields);
64 C<$dbh> is a link to the DB handler.
67 my $dbh =C4::Context->dbh;
69 C<$fields> is a reference to the fields array
71 This function modify the @$fields array and add related fields to search on.
76 my ( $dbh, $fields ) = @_;
77 my $tagslib = GetMarcStructure( 1 );
78 for ( my $i = 0 ; $i <= $#{$fields} ; $i++ ) {
79 my ($tag) = substr( @$fields[$i], 1, 3 );
80 my ($subfield) = substr( @$fields[$i], 4, 1 );
81 @$fields[$i] .= ',' . $tagslib->{$tag}->{$subfield}->{seealso}
82 if ( $tagslib->{$tag}->{$subfield}->{seealso} );
88 ($biblionumber,$biblionumber,$title) = FindDuplicate($record);
94 my $dbh = C4::Context->dbh;
95 my $result = TransformMarcToKoha( $dbh, $record, '' );
100 my ( $biblionumber, $title );
102 # search duplicate on ISBN, easy and fast..
103 # ... normalize first
104 if ( $result->{isbn} ) {
105 $result->{isbn} =~ s/\(.*$//;
106 $result->{isbn} =~ s/\s+$//;
108 #$search->{'avoidquerylog'}=1;
109 if ( $result->{isbn} ) {
110 $query = "isbn=$result->{isbn}";
113 $result->{title} =~ s /\\//g;
114 $result->{title} =~ s /\"//g;
115 $result->{title} =~ s /\(//g;
116 $result->{title} =~ s /\)//g;
117 # remove valid operators
118 $result->{title} =~ s/(and|or|not)//g;
119 $query = "ti,ext=$result->{title}";
120 $query .= " and itemtype=$result->{itemtype}" if ($result->{itemtype});
121 if ($result->{author}){
122 $result->{author} =~ s /\\//g;
123 $result->{author} =~ s /\"//g;
124 $result->{author} =~ s /\(//g;
125 $result->{author} =~ s /\)//g;
126 # remove valid operators
127 $result->{author} =~ s/(and|or|not)//g;
128 $query .= " and au,ext=$result->{author}";
131 my ($error,$searchresults) =
132 SimpleSearch($query); # FIXME :: hardcoded !
134 foreach my $possible_duplicate_record (@$searchresults) {
136 MARC::Record->new_from_usmarc($possible_duplicate_record);
137 my $result = TransformMarcToKoha( $dbh, $marcrecord, '' );
139 # FIXME :: why 2 $biblionumber ?
141 push @results, $result->{'biblionumber'};
142 push @results, $result->{'title'};
150 ($error,$results) = SimpleSearch($query,@servers);
152 this function performs a simple search on the catalog using zoom.
158 * $query could be a simple keyword or a complete CCL query wich is depending on your ccl file.
159 * @servers is optionnal. default one is read on koha.xml
162 * $error is a string which containt the description error if there is one. Else it's empty.
163 * \@results is an array of marc record.
165 =item C<usage in the script:>
169 my ($error, $marcresults) = SimpleSearch($query);
171 if (defined $error) {
172 $template->param(query_error => $error);
173 warn "error: ".$error;
174 output_html_with_http_headers $input, $cookie, $template->output;
178 my $hits = scalar @$marcresults;
181 for(my $i=0;$i<$hits;$i++) {
183 my $marcrecord = MARC::File::USMARC::decode($marcresults->[$i]);
184 my $biblio = TransformMarcToKoha(C4::Context->dbh,$marcrecord,'');
186 #build the hash for the template.
187 $resultsloop{highlight} = ($i % 2)?(1):(0);
188 $resultsloop{title} = $biblio->{'title'};
189 $resultsloop{subtitle} = $biblio->{'subtitle'};
190 $resultsloop{biblionumber} = $biblio->{'biblionumber'};
191 $resultsloop{author} = $biblio->{'author'};
192 $resultsloop{publishercode} = $biblio->{'publishercode'};
193 $resultsloop{publicationyear} = $biblio->{'publicationyear'};
195 push @results, \%resultsloop;
197 $template->param(result=>\@results);
203 if (C4::Context->preference('NoZebra')) {
204 my $result = NZorder(NZanalyse($query))->{'biblioserver'}->{'RECORDS'};
205 return (undef,$result);
211 return ( "No query entered", undef ) unless $query;
213 #@servers = (C4::Context->config("biblioserver")) unless @servers;
215 ("biblioserver") unless @servers
216 ; # FIXME hardcoded value. See catalog/search.pl & opac-search.pl too.
219 for ( my $i = 0 ; $i < @servers ; $i++ ) {
221 $zconns[$i] = C4::Context->Zconn( $servers[$i], 1 );
224 ->search( new ZOOM::Query::CCL2RPN( $query, $zconns[$i] ) );
226 # getting error message if one occured.
228 $zconns[$i]->errmsg() . " ("
229 . $zconns[$i]->errcode() . ") "
230 . $zconns[$i]->addinfo() . " "
231 . $zconns[$i]->diagset();
233 return ( $error, undef ) if $zconns[$i]->errcode();
236 # caught a ZOOM::Exception
240 . $@->addinfo() . " "
243 return ( $error, undef );
248 while ( ( my $i = ZOOM::event( \@zconns ) ) != 0 ) {
249 $ev = $zconns[ $i - 1 ]->last_event();
250 if ( $ev == ZOOM::Event::ZEND ) {
251 $hits = $tmpresults[ $i - 1 ]->size();
254 for ( my $j = 0 ; $j < $hits ; $j++ ) {
255 my $record = $tmpresults[ $i - 1 ]->record($j)->raw();
256 push @results, $record;
260 return ( undef, \@results );
264 # performs the search
267 $koha_query, $simple_query, $sort_by_ref,
268 $servers_ref, $results_per_page, $offset,
269 $expanded_facet, $branches, $query_type,
272 # warn "Query : $koha_query";
273 my @servers = @$servers_ref;
274 my @sort_by = @$sort_by_ref;
276 # create the zoom connection and query object
280 my $results_hashref = ();
283 my $facets_counter = ();
284 my $facets_info = ();
285 my $facets = getFacets();
287 #### INITIALIZE SOME VARS USED CREATE THE FACETED RESULTS
288 my @facets_loop; # stores the ref to array of hashes for template
289 for ( my $i = 0 ; $i < @servers ; $i++ ) {
290 $zconns[$i] = C4::Context->Zconn( $servers[$i], 1 );
292 # perform the search, create the results objects
293 # if this is a local search, use the $koha-query, if it's a federated one, use the federated-query
295 if ( $servers[$i] =~ /biblioserver/ ) {
296 $query_to_use = $koha_query;
299 $query_to_use = $simple_query;
302 #$query_to_use = $simple_query if $scan;
303 #warn $simple_query if ($scan && $DEBUG);
304 # check if we've got a query_type defined
308 if ( $query_type =~ /^ccl/ ) {
310 s/\:/\=/g; # change : to = last minute (FIXME)
312 # warn "CCL : $query_to_use";
315 new ZOOM::Query::CCL2RPN( $query_to_use, $zconns[$i] )
318 elsif ( $query_type =~ /^cql/ ) {
320 # warn "CQL : $query_to_use";
323 new ZOOM::Query::CQL( $query_to_use, $zconns[$i] ) );
325 elsif ( $query_type =~ /^pqf/ ) {
327 # warn "PQF : $query_to_use";
330 new ZOOM::Query::PQF( $query_to_use, $zconns[$i] ) );
335 # warn "preparing to scan:$query_to_use";
338 new ZOOM::Query::CCL2RPN( $query_to_use, $zconns[$i] )
342 # warn "LAST : $query_to_use";
345 new ZOOM::Query::CCL2RPN( $query_to_use, $zconns[$i] )
351 warn "WARNING: query problem with $query_to_use " . $@;
354 # concatenate the sort_by limits and pass them to the results object
356 foreach my $sort (@sort_by) {
357 if ($sort eq "author_az") {
358 $sort_by.="1=1003 <i ";
360 elsif ($sort eq "author_za") {
361 $sort_by.="1=1003 >i ";
363 elsif ($sort eq "popularity_asc") {
364 $sort_by.="1=9003 <i ";
366 elsif ($sort eq "popularity_dsc") {
367 $sort_by.="1=9003 >i ";
369 elsif ($sort eq "call_number_asc") {
370 $sort_by.="1=20 <i ";
372 elsif ($sort eq "call_number_dsc") {
373 $sort_by.="1=20 >i ";
375 elsif ($sort eq "pubdate_asc") {
376 $sort_by.="1=31 <i ";
378 elsif ($sort eq "pubdate_dsc") {
379 $sort_by.="1=31 >i ";
381 elsif ($sort eq "acqdate_asc") {
382 $sort_by.="1=32 <i ";
384 elsif ($sort eq "acqdate_dsc") {
385 $sort_by.="1=32 >i ";
387 elsif ($sort eq "title_az") {
390 elsif ($sort eq "title_za") {
395 if ( $results[$i]->sort( "yaz", $sort_by ) < 0) {
396 warn "WARNING sort $sort_by failed";
400 while ( ( my $i = ZOOM::event( \@zconns ) ) != 0 ) {
401 my $ev = $zconns[ $i - 1 ]->last_event();
402 if ( $ev == ZOOM::Event::ZEND ) {
403 my $size = $results[ $i - 1 ]->size();
406 #$results_hash->{'server'} = $servers[$i-1];
407 # loop through the results
408 $results_hash->{'hits'} = $size;
410 if ( $offset + $results_per_page <= $size ) {
411 $times = $offset + $results_per_page;
416 for ( my $j = $offset ; $j < $times ; $j++ )
417 { #(($offset+$count<=$size) ? ($offset+$count):$size) ; $j++){
421 ## This is just an index scan
423 my ( $term, $occ ) = $results[ $i - 1 ]->term($j);
424 # here we create a minimal MARC record and hand it off to the
425 # template just like a normal result ... perhaps not ideal, but
427 my $tmprecord = MARC::Record->new();
428 $tmprecord->encoding('UTF-8');
431 # srote the minimal record in author/title (depending on MARC flavour)
432 if ( C4::Context->preference("marcflavour") eq
435 $tmptitle = MARC::Field->new(
442 $tmptitle = MARC::Field->new(
448 $tmprecord->append_fields($tmptitle);
449 $results_hash->{'RECORDS'}[$j] =
450 $tmprecord->as_usmarc();
453 $record = $results[ $i - 1 ]->record($j)->raw();
455 #warn "RECORD $j:".$record;
456 $results_hash->{'RECORDS'}[$j] =
457 $record; # making a reference to a hash
458 # Fill the facets while we're looping
459 $facet_record = MARC::Record->new_from_usmarc($record);
461 #warn $servers[$i-1].$facet_record->title();
462 for ( my $k = 0 ; $k <= @$facets ; $k++ ) {
463 if ( $facets->[$k] ) {
465 for my $tag ( @{ $facets->[$k]->{'tags'} } ) {
466 push @fields, $facet_record->field($tag);
468 for my $field (@fields) {
469 my @subfields = $field->subfields();
470 for my $subfield (@subfields) {
471 my ( $code, $data ) = @$subfield;
473 $facets->[$k]->{'subfield'} )
475 $facets_counter->{ $facets->[$k]
476 ->{'link_value'} }->{$data}++;
480 $facets_info->{ $facets->[$k]->{'link_value'} }
482 $facets->[$k]->{'label_value'};
483 $facets_info->{ $facets->[$k]->{'link_value'} }
484 ->{'expanded'} = $facets->[$k]->{'expanded'};
489 $results_hashref->{ $servers[ $i - 1 ] } = $results_hash;
492 #print "connection ", $i-1, ": $size hits";
493 #print $results[$i-1]->record(0)->render() if $size > 0;
496 sort { $facets_counter->{$b} <=> $facets_counter->{$a} }
497 keys %$facets_counter
501 my $number_of_facets;
502 my @this_facets_array;
505 $facets_counter->{$link_value}
506 ->{$b} <=> $facets_counter->{$link_value}->{$a}
507 } keys %{ $facets_counter->{$link_value} }
511 if ( ( $number_of_facets < 6 )
512 || ( $expanded_facet eq $link_value )
513 || ( $facets_info->{$link_value}->{'expanded'} ) )
516 # sanitize the link value ), ( will cause errors with CCL
517 my $facet_link_value = $one_facet;
518 $facet_link_value =~ s/(\(|\))/ /g;
520 # fix the length that will display in the label
521 my $facet_label_value = $one_facet;
522 $facet_label_value = substr( $one_facet, 0, 20 ) . "..."
523 unless length($facet_label_value) <= 20;
525 # well, if it's a branch, label by the name, not the code
526 if ( $link_value =~ /branch/ ) {
528 $branches->{$one_facet}->{'branchname'};
531 # but we're down with the whole label being in the link's title
532 my $facet_title_value = $one_facet;
534 push @this_facets_array,
538 $facets_counter->{$link_value}->{$one_facet},
539 facet_label_value => $facet_label_value,
540 facet_title_value => $facet_title_value,
541 facet_link_value => $facet_link_value,
542 type_link_value => $link_value,
547 unless ( $facets_info->{$link_value}->{'expanded'} ) {
549 if ( ( $number_of_facets > 6 )
550 && ( $expanded_facet ne $link_value ) );
555 type_link_value => $link_value,
556 type_id => $link_value . "_id",
558 $facets_info->{$link_value}->{'label_value'},
559 facets => \@this_facets_array,
560 expandable => $expandable,
561 expand => $link_value,
567 return ( undef, $results_hashref, \@facets_loop );
571 sub _remove_stopwords {
572 my ($operand,$index) = @_;
573 my @stopwords_removed;
574 # phrase and exact-qualified indexes shouldn't have stopwords removed
575 if ($index!~m/phr|ext/){
576 # remove stopwords from operand : parse all stopwords & remove them (case insensitive)
577 # we use IsAlpha unicode definition, to deal correctly with diacritics.
578 # otherwise, a French word like "leçon" woudl be split into "le" "çon", le
579 # is an empty word, we'd get "çon" and wouldn't find anything...
580 foreach (keys %{C4::Context->stopwords}) {
581 next if ($_ =~/(and|or|not)/); # don't remove operators
582 if ($operand =~ /(\P{IsAlpha}$_\P{IsAlpha}|^$_\P{IsAlpha}|\P{IsAlpha}$_$)/) {
583 $operand=~ s/\P{IsAlpha}$_\P{IsAlpha}/ /gi;
584 $operand=~ s/^$_\P{IsAlpha}/ /gi;
585 $operand=~ s/\P{IsAlpha}$_$/ /gi;
586 push @stopwords_removed, $_;
590 return ($operand, \@stopwords_removed);
594 sub _detect_truncation {
595 my ($operand,$index) = @_;
596 my (@nontruncated,@righttruncated,@lefttruncated,@rightlefttruncated,@regexpr);
598 my @wordlist= split (/\s/,$operand);
599 foreach my $word (@wordlist){
600 if ($word=~s/^\*([^\*]+)\*$/$1/){
601 push @rightlefttruncated,$word;
603 elsif($word=~s/^\*([^\*]+)$/$1/){
604 push @lefttruncated,$word;
606 elsif ($word=~s/^([^\*]+)\*$/$1/){
607 push @righttruncated,$word;
609 elsif (index($word,"*")<0){
610 push @nontruncated,$word;
616 return (\@nontruncated,\@righttruncated,\@lefttruncated,\@rightlefttruncated,\@regexpr);
619 sub _build_stemmed_operand {
622 # FIXME: the locale should be set based on the user's language and/or search choice
623 my $stemmer = Lingua::Stem->new( -locale => 'EN-US' );
624 # FIXME: these should be stored in the db so the librarian can modify the behavior
625 $stemmer->add_exceptions(
633 my @words = split( / /, $operand );
634 my $stems = $stemmer->stem(@words);
635 for my $stem (@$stems) {
636 $stemmed_operand .= "$stem";
637 $stemmed_operand .= "?" unless ( $stem =~ /(and$|or$|not$)/ ) || ( length($stem) < 3 );
638 $stemmed_operand .= " ";
640 #warn "STEMMED OPERAND: $stemmed_operand";
641 return $stemmed_operand;
644 sub _build_weighted_query {
645 # FIELD WEIGHTING - This is largely experimental stuff. What I'm committing works
646 # pretty well but will work much better when we have an actual query parser
647 my ($operand,$stemmed_operand,$index) = @_;
648 my $stemming = C4::Context->preference("QueryStemming") || 0;
649 my $weight_fields = C4::Context->preference("QueryWeightFields") || 0;
650 my $fuzzy_enabled = C4::Context->preference("QueryFuzzy") || 0;
652 my $weighted_query .= "(rk=("; # Specifies that we're applying rank
654 # Keyword, or, no index specified
655 if ( ( $index eq 'kw' ) || ( !$index ) ) {
656 $weighted_query .= "Title-cover,ext,r1=\"$operand\""; # exact title-cover
657 $weighted_query .= " or ti,ext,r2=\"$operand\""; # exact title
658 $weighted_query .= " or ti,phr,r3=\"$operand\""; # phrase title
659 #$weighted_query .= " or any,ext,r4=$operand"; # exact any
660 #$weighted_query .=" or kw,wrdl,r5=\"$operand\""; # word list any
661 $weighted_query .= " or wrd,fuzzy,r8=\"$operand\"" if $fuzzy_enabled; # add fuzzy, word list
662 $weighted_query .= " or wrd,right-Truncation,r9=\"$stemmed_operand\"" if ($stemming and $stemmed_operand); # add stemming, right truncation
663 # embedded sorting: 0 a-z; 1 z-a
664 # $weighted_query .= ") or (sort1,aut=1";
666 elsif ( $index eq 'bc' ) {
667 $weighted_query .= "bc=\"$operand\"";
669 # if the index already has more than one qualifier, just wrap the operand
670 # in quotes and pass it back
671 elsif ($index =~ ',') {
672 $weighted_query .=" $index=\"$operand\"";
674 #TODO: build better cases based on specific search indexes
676 $weighted_query .= " $index,ext,r1=\"$operand\""; # exact index
677 #$weighted_query .= " or (title-sort-az=0 or $index,startswithnt,st-word,r3=$operand #)";
678 $weighted_query .= " or $index,phr,r3=\"$operand\""; # phrase index
679 $weighted_query .= " or $index,rt,wrd,r3=\"$operand\""; # word list index
681 $weighted_query .= "))"; # close rank specification
682 return $weighted_query;
685 # build the query itself
687 my ( $operators, $operands, $indexes, $limits, $sort_by, $scan) = @_;
689 my @operators = @$operators if $operators;
690 my @indexes = @$indexes if $indexes;
691 my @operands = @$operands if $operands;
692 my @limits = @$limits if $limits;
693 my @sort_by = @$sort_by if $sort_by;
695 my $stemming = C4::Context->preference("QueryStemming") || 0;
696 my $auto_truncation = C4::Context->preference("QueryAutoTruncate") || 0;
697 my $weight_fields = C4::Context->preference("QueryWeightFields") || 0;
698 my $fuzzy_enabled = C4::Context->preference("QueryFuzzy") || 0;
699 my $remove_stopwords = C4::Context->preference("QueryRemoveStopwords") || 0;
701 my $query = $operands[0];
702 my $simple_query = $operands[0];
711 my $stopwords_removed;
713 # for handling ccl, cql, pqf queries in diagnostic mode, skip the rest of the steps
715 if ( $query =~ /^ccl=/ ) {
716 return ( undef, $', $', $', $', '', '', '', '', 'ccl' );
718 if ( $query =~ /^cql=/ ) {
719 return ( undef, $', $', $', $', '', '', '', '', 'cql' );
721 if ( $query =~ /^pqf=/ ) {
722 return ( undef, $', $', $', $', '', '', '', '', 'pqf' );
725 # pass nested queries directly
726 if ( $query =~ /(\(|\))/ ) {
727 return ( undef, $query, $simple_query, $query_cgi, $query, $limit, $limit_cgi, $limit_desc, $stopwords_removed, 'ccl' );
730 # form-based queries are limited to non-nested at a specific depth, so we can easily
731 # modify the incoming query operands and indexes to do stemming and field weighting
732 # Once we do so, we'll end up with a value in $query, just like if we had an
733 # incoming $query from the user
735 $query = ""; # clear it out so we can populate properly with field-weighted stemmed query
736 my $previous_operand; # a flag used to keep track if there was a previous query
737 # if there was, we can apply the current operator
739 for ( my $i = 0 ; $i <= @operands ; $i++ ) {
741 # COMBINE OPERANDS, INDEXES AND OPERATORS
742 if ( $operands[$i] ) {
744 # a flag to determine whether or not to add the index to the query
746 # if the user is sophisticated enough to specify an index, turn off some defaults
747 if ($operands[$i] =~ /(:|=)/ || $scan) {
750 $remove_stopwords = 0;
752 my $operand = $operands[$i];
753 my $index = $indexes[$i];
755 # some helpful index modifs
756 my $index_plus = "$index:" if $index;
757 my $index_plus_comma="$index," if $index;
760 if ($remove_stopwords) {
761 ($operand, $stopwords_removed) = _remove_stopwords($operand,$index);
762 warn "OPERAND w/out STOPWORDS: >$operand<" if $DEBUG;
763 warn "REMOVED STOPWORDS: @$stopwords_removed" if ($stopwords_removed && $DEBUG);
767 my ($nontruncated,$righttruncated,$lefttruncated,$rightlefttruncated,$regexpr);
768 my $truncated_operand;
769 ($nontruncated,$righttruncated,$lefttruncated,$rightlefttruncated,$regexpr) = _detect_truncation($operand,$index);
770 warn "TRUNCATION: NON:>@$nontruncated< RIGHT:>@$righttruncated< LEFT:>@$lefttruncated< RIGHTLEFT:>@$rightlefttruncated< REGEX:>@$regexpr<" if $DEBUG;
773 if (scalar(@$righttruncated)+scalar(@$lefttruncated)+scalar(@$rightlefttruncated)>0){
774 # don't field weight or add the index to the query, we do it here
776 undef $weight_fields;
777 my $previous_truncation_operand;
778 if (scalar(@$nontruncated)>0) {
779 $truncated_operand.= "$index_plus @$nontruncated ";
780 $previous_truncation_operand = 1;
782 if (scalar(@$righttruncated)>0){
783 $truncated_operand .= "and " if $previous_truncation_operand;
784 $truncated_operand .= "$index_plus_comma"."rtrn:@$righttruncated ";
785 $previous_truncation_operand = 1;
787 if (scalar(@$lefttruncated)>0){
788 $truncated_operand .= "and " if $previous_truncation_operand;
789 $truncated_operand .= "$index_plus_comma"."ltrn:@$lefttruncated ";
790 $previous_truncation_operand = 1;
792 if (scalar(@$rightlefttruncated)>0){
793 $truncated_operand .= "and " if $previous_truncation_operand;
794 $truncated_operand .= "$index_plus_comma"."rltrn:@$rightlefttruncated ";
795 $previous_truncation_operand = 1;
798 $operand = $truncated_operand if $truncated_operand;
799 warn "TRUNCATED OPERAND: >$truncated_operand<" if $DEBUG;
803 $stemmed_operand = _build_stemmed_operand($operand) if $stemming;
804 warn "STEMMED OPERAND: >$stemmed_operand<" if $DEBUG;
806 # Handle Field Weighting
807 my $weighted_operand;
808 $weighted_operand = _build_weighted_query($operand,$stemmed_operand,$index) if $weight_fields;
809 warn "FIELD WEIGHTED OPERAND: >$weighted_operand<" if $DEBUG;
810 $operand = $weighted_operand if $weight_fields;
811 $indexes_set = 1 if $weight_fields;
813 # If there's a previous operand, we need to add an operator
814 if ($previous_operand) {
816 # user-specified operator
817 if ( $operators[$i-1] ) {
818 $query .= " $operators[$i-1] ";
819 $query .= " $index_plus " unless $indexes_set;
820 $query .= " $operand";
821 $query_cgi .="&op=$operators[$i-1]";
822 $query_cgi .="&idx=$index" if $index;
823 $query_cgi .="&q=$operands[$i]" if $operands[$i];
824 $query_desc .=" $operators[$i-1] $index_plus $operands[$i]";
827 # the default operator is and
830 $query .= "$index_plus " unless $indexes_set;
831 $query .= "$operand";
832 $query_cgi .="&op=and&idx=$index" if $index;
833 $query_cgi .="&q=$operands[$i]" if $operands[$i];
834 $query_desc .= " and $index_plus $operands[$i]";
838 # there isn't a pervious operand, don't need an operator
840 # field-weighted queries already have indexes set
841 $query .=" $index_plus " unless $indexes_set;
843 $query_desc .= " $index_plus $operands[$i]";
844 $query_cgi.="&idx=$index" if $index;
845 $query_cgi.="&q=$operands[$i]" if $operands[$i];
847 $previous_operand = 1;
852 warn "QUERY BEFORE LIMITS: >$query<" if $DEBUG;
856 my $availability_limit;
857 foreach my $this_limit (@limits) {
858 if ( $this_limit =~ /available/ ) {
859 # available is defined as (items.notloan is NULL) and (items.itemlost > 0 or NULL) (last clause handles NULL values for lost in zebra)
860 $availability_limit .="( ( allrecords,AlwaysMatches='' not onloan,AlwaysMatches='') and ((lost,st-numeric gt 0) or ( allrecords,AlwaysMatches='' not lost,AlwaysMatches='')) )";
861 $limit_cgi .= "&limit=available";
865 # these are treated as OR
866 elsif ( $this_limit =~ /mc/ ) {
867 $group_OR_limits .= " or " if $group_OR_limits;
868 $limit_desc .=" or " if $group_OR_limits;
869 $group_OR_limits .= "$this_limit";
870 $limit_cgi .="&limit=$this_limit";
871 $limit_desc .= "$this_limit";
876 $limit .= " and " if $limit || $query;
877 $limit .= "$this_limit";
878 $limit_cgi .="&limit=$this_limit";
879 $limit_desc .=" and $this_limit";
882 if ($group_OR_limits) {
883 $limit.=" and " if ($query || $limit );
884 $limit.="($group_OR_limits)";
886 if ($availability_limit) {
887 $limit.=" not " if ($query || $limit );
888 $limit.="$availability_limit";
890 # normalize the strings
893 for ($query, $query_desc, $limit, $limit_desc) {
894 $_ =~ s/ / /g; # remove extra spaces
895 $_ =~ s/^ //g; # remove any beginning spaces
896 $_ =~ s/ $//g; # remove any ending spaces
897 $_ =~ s/==/=/g; # remove double == from query
900 $query_cgi =~ s/^&//;
902 # append the limit to the query
903 $query .= " ".$limit;
905 warn "QUERY:".$query if $DEBUG;
906 warn "QUERY CGI:".$query_cgi if $DEBUG;
907 warn "QUERY DESC:".$query_desc if $DEBUG;
908 warn "LIMIT:".$limit if $DEBUG;
909 warn "LIMIT CGI:".$limit_cgi if $DEBUG;
910 warn "LIMIT DESC:".$limit_desc if $DEBUG;
912 return ( undef, $query,$simple_query,$query_cgi,$query_desc,$limit,$limit_cgi,$limit_desc,$stopwords_removed,$query_type );
915 # IMO this subroutine is pretty messy still -- it's responsible for
916 # building the HTML output for the template
918 my ( $searchdesc, $hits, $results_per_page, $offset, @marcresults ) = @_;
920 my $dbh = C4::Context->dbh;
924 my $span_terms_hashref;
925 for my $span_term ( split( / /, $searchdesc ) ) {
926 $span_term =~ s/(.*=|\)|\(|\+|\.)//g;
927 $span_terms_hashref->{$span_term}++;
930 #Build brancnames hash
932 #get branch information.....
935 $dbh->prepare("SELECT branchcode,branchname FROM branches")
936 ; # FIXME : use C4::Koha::GetBranches
938 while ( my $bdata = $bsth->fetchrow_hashref ) {
939 $branches{ $bdata->{'branchcode'} } = $bdata->{'branchname'};
943 #find itemtype & itemtype image
946 $dbh->prepare("SELECT itemtype,description,imageurl,summary,notforloan FROM itemtypes");
948 while ( my $bdata = $bsth->fetchrow_hashref ) {
949 $itemtypes{ $bdata->{'itemtype'} }->{description} =
950 $bdata->{'description'};
951 $itemtypes{ $bdata->{'itemtype'} }->{imageurl} = $bdata->{'imageurl'};
952 $itemtypes{ $bdata->{'itemtype'} }->{summary} = $bdata->{'summary'};
953 $itemtypes{ $bdata->{'itemtype'} }->{notforloan} = $bdata->{'notforloan'};
956 #search item field code
959 "select tagfield from marc_subfield_structure where kohafield like 'items.itemnumber'"
962 my ($itemtag) = $sth->fetchrow;
964 ## find column names of items related to MARC
965 my $sth2 = $dbh->prepare("SHOW COLUMNS from items");
967 my %subfieldstosearch;
968 while ( ( my $column ) = $sth2->fetchrow ) {
969 my ( $tagfield, $tagsubfield ) =
970 &GetMarcFromKohaField( "items." . $column, "" );
971 $subfieldstosearch{$column} = $tagsubfield;
975 if ( $hits && $offset + $results_per_page <= $hits ) {
976 $times = $offset + $results_per_page;
982 for ( my $i = $offset ; $i <= $times - 1 ; $i++ ) {
984 $marcrecord = MARC::File::USMARC::decode( $marcresults[$i] );
985 my $oldbiblio = TransformMarcToKoha( $dbh, $marcrecord, '' );
986 $oldbiblio->{result_number} = $i+1;
987 # add image url if there is one
988 if ( $itemtypes{ $oldbiblio->{itemtype} }->{imageurl} =~ /^http:/ ) {
989 $oldbiblio->{imageurl} =
990 $itemtypes{ $oldbiblio->{itemtype} }->{imageurl};
991 $oldbiblio->{description} =
992 $itemtypes{ $oldbiblio->{itemtype} }->{description};
995 $oldbiblio->{imageurl} =
996 getitemtypeimagesrc() . "/"
997 . $itemtypes{ $oldbiblio->{itemtype} }->{imageurl}
998 if ( $itemtypes{ $oldbiblio->{itemtype} }->{imageurl} );
999 $oldbiblio->{description} =
1000 $itemtypes{ $oldbiblio->{itemtype} }->{description};
1003 # build summary if there is one (the summary is defined in itemtypes table
1005 if ($itemtypes{ $oldbiblio->{itemtype} }->{summary}) {
1006 my $summary = $itemtypes{ $oldbiblio->{itemtype} }->{summary};
1007 my @fields = $marcrecord->fields();
1008 foreach my $field (@fields) {
1009 my $tag = $field->tag();
1010 my $tagvalue = $field->as_string();
1011 $summary =~ s/\[(.?.?.?.?)$tag\*(.*?)]/$1$tagvalue$2\[$1$tag$2]/g;
1013 my @subf = $field->subfields;
1014 for my $i (0..$#subf) {
1015 my $subfieldcode = $subf[$i][0];
1016 my $subfieldvalue = $subf[$i][1];
1017 my $tagsubf = $tag.$subfieldcode;
1018 $summary =~ s/\[(.?.?.?.?)$tagsubf(.*?)]/$1$subfieldvalue$2\[$1$tagsubf$2]/g;
1022 $summary =~ s/\[(.*?)]//g;
1023 $summary =~ s/\n/<br>/g;
1024 $oldbiblio->{summary} = $summary;
1026 # add spans to search term in results for search term highlighting
1027 # save a native author, for the <a href=search.lq=<!--tmpl_var name="author"-->> link
1028 $oldbiblio->{'author_nospan'} = $oldbiblio->{'author'};
1029 foreach my $term ( keys %$span_terms_hashref ) {
1030 my $old_term = $term;
1031 if ( length($term) > 3 ) {
1032 $term =~ s/(.*=|\)|\(|\+|\.|\?|\[|\])//g;
1036 #FIXME: is there a better way to do this?
1037 $oldbiblio->{'title'} =~ s/$term/<span class=\"term\">$&<\/span>/gi;
1038 $oldbiblio->{'subtitle'} =~
1039 s/$term/<span class=\"term\">$&<\/span>/gi;
1041 $oldbiblio->{'author'} =~ s/$term/<span class=\"term\">$&<\/span>/gi;
1042 $oldbiblio->{'publishercode'} =~ s/$term/<span class=\"term\">$&<\/span>/gi;
1043 $oldbiblio->{'place'} =~ s/$term/<span class=\"term\">$&<\/span>/gi;
1044 $oldbiblio->{'pages'} =~ s/$term/<span class=\"term\">$&<\/span>/gi;
1045 $oldbiblio->{'notes'} =~ s/$term/<span class=\"term\">$&<\/span>/gi;
1046 $oldbiblio->{'size'} =~ s/$term/<span class=\"term\">$&<\/span>/gi;
1051 $toggle = "#ffffcc";
1056 $oldbiblio->{'toggle'} = $toggle;
1057 my @fields = $marcrecord->field($itemtag);
1060 my $ordered_count = 0;
1061 my $onloan_count = 0;
1062 my $wthdrawn_count = 0;
1063 my $itemlost_count = 0;
1067 # check the loan status of the item :
1068 # it is not stored in the MARC record, for pref (zebra reindexing)
1069 # reason. Thus, we have to get the status from a specific SQL query
1071 my $sth_issue = $dbh->prepare("
1072 SELECT date_due,returndate
1074 WHERE itemnumber=? AND returndate IS NULL");
1075 my $items_count=scalar(@fields);
1076 foreach my $field (@fields) {
1078 foreach my $code ( keys %subfieldstosearch ) {
1079 $item->{$code} = $field->subfield( $subfieldstosearch{$code} );
1081 $sth_issue->execute($item->{itemnumber});
1082 $item->{due_date} = format_date($sth_issue->fetchrow);
1083 $item->{onloan} = 1 if $item->{due_date};
1084 # at least one item can be reserved : suppose no
1086 if ( $item->{wthdrawn} ) {
1088 $items->{ $item->{'homebranch'}.'--'.$item->{'itemcallnumber'} }->{unavailable}=1;
1089 $items->{ $item->{'homebranch'}.'--'.$item->{'itemcallnumber'} }->{wthdrawn}=1;
1091 elsif ( $item->{itemlost} ) {
1093 $items->{ $item->{'homebranch'}.'--'.$item->{'itemcallnumber'} }->{unavailable}=1;
1094 $items->{ $item->{'homebranch'}.'--'.$item->{'itemcallnumber'} }->{itemlost}=1;
1096 unless ( $item->{notforloan}) {
1097 # OK, this one can be issued, so at least one can be reserved
1100 if ( ( $item->{onloan} ) && ( $item->{onloan} != '0000-00-00' ) )
1102 $items->{ $item->{'homebranch'}.'--'.$item->{'itemcallnumber'} }->{unavailable}=1;
1103 $items->{ $item->{'homebranch'}.'--'.$item->{'itemcallnumber'} }->{onloancount} = 1;
1104 $items->{ $item->{'homebranch'}.'--'.$item->{'itemcallnumber'} }->{due_date} = $item->{due_date};
1107 if ( $item->{'homebranch'} ) {
1108 $items->{ $item->{'homebranch'}.'--'.$item->{'itemcallnumber'} }->{count}++;
1112 elsif ( $item->{'holdingbranch'} ) {
1113 $items->{ $item->{'holdingbranch'} }->{count}++;
1115 $items->{ $item->{'homebranch'}.'--'.$item->{'itemcallnumber'} }->{itemcallnumber} = $item->{itemcallnumber};
1116 $items->{ $item->{'homebranch'}.'--'.$item->{'itemcallnumber'} }->{location} = $item->{location};
1117 $items->{ $item->{'homebranch'}.'--'.$item->{'itemcallnumber'} }->{branchcode} = $item->{homebranch};
1118 } # notforloan, item level and biblioitem level
1120 # last check for norequest : if itemtype is notforloan, it can't be reserved either, whatever the items
1121 $norequests = 1 if $itemtypes{$oldbiblio->{itemtype}}->{notforloan};
1123 for my $key ( sort keys %$items ) {
1126 branchname => $branches{$items->{$key}->{branchcode}},
1127 branchcode => $items->{$key}->{branchcode},
1128 count => $items->{$key}->{count},
1129 itemcallnumber => $items->{$key}->{itemcallnumber},
1130 location => $items->{$key}->{location},
1131 onloancount => $items->{$key}->{onloancount},
1132 due_date => $items->{$key}->{due_date},
1133 wthdrawn => $items->{$key}->{wthdrawn},
1134 lost => $items->{$key}->{itemlost},
1136 # only show the number specified by the user
1137 my $maxitems = (C4::Context->preference('maxItemsinSearchResults')) ? C4::Context->preference('maxItemsinSearchResults')- 1 : 1;
1138 push @items_loop, $this_item unless $itemscount > $maxitems;;
1140 $oldbiblio->{norequests} = $norequests;
1141 $oldbiblio->{items_count} = $items_count;
1142 $oldbiblio->{items_loop} = \@items_loop;
1143 $oldbiblio->{onloancount} = $onloan_count;
1144 $oldbiblio->{wthdrawncount} = $wthdrawn_count;
1145 $oldbiblio->{itemlostcount} = $itemlost_count;
1146 $oldbiblio->{orderedcount} = $ordered_count;
1147 $oldbiblio->{isbn} =~ s/-//g; # deleting - in isbn to enable amazon content
1148 push( @newresults, $oldbiblio );
1155 #----------------------------------------------------------------------
1157 # Non-Zebra GetRecords#
1158 #----------------------------------------------------------------------
1162 NZgetRecords has the same API as zera getRecords, even if some parameters are not managed
1166 my ($query,$simple_query,$sort_by_ref,$servers_ref,$results_per_page,$offset,$expanded_facet,$branches,$query_type,$scan) = @_;
1167 my $result = NZanalyse($query);
1168 return (undef,NZorder($result,@$sort_by_ref[0],$results_per_page,$offset),undef);
1173 NZanalyse : get a CQL string as parameter, and returns a list of biblionumber;title,biblionumber;title,...
1174 the list is built from an inverted index in the nozebra SQL table
1175 note that title is here only for convenience : the sorting will be very fast when requested on title
1176 if the sorting is requested on something else, we will have to reread all results, and that may be longer.
1181 my ($string,$server) = @_;
1182 # $server contains biblioserver or authorities, depending on what we search on.
1183 #warn "querying : $string on $server";
1184 $server='biblioserver' unless $server;
1186 # if we have a ", replace the content to discard temporarily any and/or/not inside
1188 if ($string =~/"/) {
1189 $string =~ s/"(.*?)"/__X__/;
1191 warn "commacontent : $commacontent" if $DEBUG;
1193 # split the query string in 3 parts : X AND Y means : $left="X", $operand="AND" and $right="Y"
1194 # then, call again NZanalyse with $left and $right
1195 # (recursive until we find a leaf (=> something without and/or/not)
1196 # delete repeated operator... Would then go in infinite loop
1197 while ($string =~s/( and| or| not| AND| OR| NOT)\1/$1/g){
1199 #process parenthesis before.
1200 if ($string =~ /^\s*\((.*)\)(( and | or | not | AND | OR | NOT )(.*))?/){
1202 # warn "left :".$left;
1204 my $operator = lc($3); # FIXME: and/or/not are operators, not operands
1205 my $leftresult = NZanalyse($left,$server);
1207 my $rightresult = NZanalyse($right,$server);
1208 # OK, we have the results for right and left part of the query
1209 # depending of operand, intersect, union or exclude both lists
1210 # to get a result list
1211 if ($operator eq ' and ') {
1212 my @leftresult = split /;/, $leftresult;
1213 # my @rightresult = split /;/,$leftresult;
1215 # parse the left results, and if the biblionumber exist in the right result, save it in finalresult
1216 # the result is stored twice, to have the same weight for AND than OR.
1217 # example : TWO : 61,61,64,121 (two is twice in the biblio #61) / TOWER : 61,64,130
1218 # result : 61,61,61,61,64,64 for two AND tower : 61 has more weight than 64
1219 foreach (@leftresult) {
1220 if ($rightresult =~ "$_;") {
1221 $finalresult .= "$_;$_;";
1224 return $finalresult;
1225 } elsif ($operator eq ' or ') {
1226 # just merge the 2 strings
1227 return $leftresult.$rightresult;
1228 } elsif ($operator eq ' not ') {
1229 my @leftresult = split /;/, $leftresult;
1230 # my @rightresult = split /;/,$leftresult;
1232 foreach (@leftresult) {
1233 unless ($rightresult =~ "$_;") {
1234 $finalresult .= "$_;";
1237 return $finalresult;
1239 # this error is impossible, because of the regexp that isolate the operand, but just in case...
1245 warn "string :".$string if $DEBUG;
1246 $string =~ /(.*?)( and | or | not | AND | OR | NOT )(.*)/;
1249 my $operand = lc($2); # FIXME: and/or/not are operators, not operands
1250 # it's not a leaf, we have a and/or/not
1252 # reintroduce comma content if needed
1253 $right =~ s/__X__/"$commacontent"/ if $commacontent;
1254 $left =~ s/__X__/"$commacontent"/ if $commacontent;
1255 warn "node : $left / $operand / $right\n" if $DEBUG;
1256 my $leftresult = NZanalyse($left,$server);
1257 my $rightresult = NZanalyse($right,$server);
1258 # OK, we have the results for right and left part of the query
1259 # depending of operand, intersect, union or exclude both lists
1260 # to get a result list
1261 if ($operand eq ' and ') {
1262 my @leftresult = split /;/, $leftresult;
1263 # my @rightresult = split /;/,$leftresult;
1265 # parse the left results, and if the biblionumber exist in the right result, save it in finalresult
1266 # the result is stored twice, to have the same weight for AND than OR.
1267 # example : TWO : 61,61,64,121 (two is twice in the biblio #61) / TOWER : 61,64,130
1268 # result : 61,61,61,61,64,64 for two AND tower : 61 has more weight than 64
1269 foreach (@leftresult) {
1270 if ($rightresult =~ "$_;") {
1271 $finalresult .= "$_;$_;";
1274 return $finalresult;
1275 } elsif ($operand eq ' or ') {
1276 # just merge the 2 strings
1277 return $leftresult.$rightresult;
1278 } elsif ($operand eq ' not ') {
1279 my @leftresult = split /;/, $leftresult;
1280 # my @rightresult = split /;/,$leftresult;
1282 foreach (@leftresult) {
1283 unless ($rightresult =~ "$_;") {
1284 $finalresult .= "$_;";
1287 return $finalresult;
1289 # this error is impossible, because of the regexp that isolate the operand, but just in case...
1290 die "error : operand unknown : $operand for $string";
1292 # it's a leaf, do the real SQL query and return the result
1294 $string =~ s/__X__/"$commacontent"/ if $commacontent;
1295 $string =~ s/-|\.|\?|,|;|!|'|\(|\)|\[|\]|{|}|"|&|\+|\*|\// /g;
1296 warn "leaf : $string\n" if $DEBUG;
1297 # parse the string in in operator/operand/value again
1298 $string =~ /(.*)(>=|<=)(.*)/;
1302 unless ($operator) {
1303 $string =~ /(.*)(>|<|=)(.*)/;
1309 # automatic replace for short operators
1310 $left='title' if $left =~ '^ti$';
1311 $left='author' if $left =~ '^au$';
1312 $left='publisher' if $left =~ '^pb$';
1313 $left='subject' if $left =~ '^su$';
1314 $left='koha-Auth-Number' if $left =~ '^an$';
1315 $left='keyword' if $left =~ '^kw$';
1317 #do a specific search
1318 my $dbh = C4::Context->dbh;
1319 $operator='LIKE' if $operator eq '=' and $right=~ /%/;
1320 my $sth = $dbh->prepare("SELECT biblionumbers,value FROM nozebra WHERE server=? AND indexname=? AND value $operator ?");
1321 warn "$left / $operator / $right\n";
1322 # split each word, query the DB and build the biblionumbers result
1323 #sanitizing leftpart
1324 $left=~s/^\s+|\s+$//;
1325 my ($biblionumbers,$value);
1326 foreach (split / /,$right) {
1328 warn "EXECUTE : $server, $left, $_";
1329 $sth->execute($server, $left, $_) or warn "execute failed: $!";
1330 while (my ($line,$value) = $sth->fetchrow) {
1331 # if we are dealing with a numeric value, use only numeric results (in case of >=, <=, > or <)
1332 # otherwise, fill the result
1333 $biblionumbers .= $line unless ($right =~ /\d/ && $value =~ /\D/);
1334 # warn "result : $value ". ($right =~ /\d/) . "==".(!$value =~ /\d/) ;#= $line";
1336 # do a AND with existing list if there is one, otherwise, use the biblionumbers list as 1st result list
1338 my @leftresult = split /;/, $biblionumbers;
1340 foreach my $entry (@leftresult) { # $_ contains biblionumber,title-weight
1341 # remove weight at the end
1342 my $cleaned = $entry;
1343 $cleaned =~ s/-\d*$//;
1344 # if the entry already in the hash, take it & increase weight
1345 warn "===== $cleaned =====" if $DEBUG;
1346 if ($results =~ "$cleaned") {
1347 $temp .= "$entry;$entry;";
1348 warn "INCLUDING $entry" if $DEBUG;
1353 $results = $biblionumbers;
1357 #do a complete search (all indexes)
1358 my $dbh = C4::Context->dbh;
1359 my $sth = $dbh->prepare("SELECT biblionumbers FROM nozebra WHERE server=? AND value LIKE ?");
1360 # split each word, query the DB and build the biblionumbers result
1361 foreach (split / /,$string) {
1362 next if C4::Context->stopwords->{uc($_)}; # skip if stopword
1363 warn "search on all indexes on $_" if $DEBUG;
1366 $sth->execute($server, $_);
1367 while (my $line = $sth->fetchrow) {
1368 $biblionumbers .= $line;
1370 # do a AND with existing list if there is one, otherwise, use the biblionumbers list as 1st result list
1372 warn "RES for $_ = $biblionumbers" if $DEBUG;
1373 my @leftresult = split /;/, $biblionumbers;
1375 foreach my $entry (@leftresult) { # $_ contains biblionumber,title-weight
1376 # remove weight at the end
1377 my $cleaned = $entry;
1378 $cleaned =~ s/-\d*$//;
1379 # if the entry already in the hash, take it & increase weight
1380 warn "===== $cleaned =====" if $DEBUG;
1381 if ($results =~ "$cleaned") {
1382 $temp .= "$entry;$entry;";
1383 warn "INCLUDING $entry" if $DEBUG;
1388 warn "NEW RES for $_ = $biblionumbers" if $DEBUG;
1389 $results = $biblionumbers;
1393 # warn "return : $results for LEAF : $string" if $DEBUG;
1400 $finalresult = NZorder($biblionumbers, $ordering,$results_per_page,$offset);
1408 my ($biblionumbers, $ordering,$results_per_page,$offset) = @_;
1409 # order title asc by default
1410 # $ordering = '1=36 <i' unless $ordering;
1411 $results_per_page=20 unless $results_per_page;
1412 $offset = 0 unless $offset;
1413 my $dbh = C4::Context->dbh;
1415 # order by POPULARITY
1417 if ($ordering =~ /popularity/) {
1420 # popularity is not in MARC record, it's builded from a specific query
1421 my $sth = $dbh->prepare("select sum(issues) from items where biblionumber=?");
1422 foreach (split /;/,$biblionumbers) {
1423 my ($biblionumber,$title) = split /,/,$_;
1424 $result{$biblionumber}=GetMarcBiblio($biblionumber);
1425 $sth->execute($biblionumber);
1426 my $popularity= $sth->fetchrow ||0;
1427 # hint : the key is popularity.title because we can have
1428 # many results with the same popularity. In this cas, sub-ordering is done by title
1429 # we also have biblionumber to avoid bug for 2 biblios with the same title & popularity
1430 # (un-frequent, I agree, but we won't forget anything that way ;-)
1431 $popularity{sprintf("%10d",$popularity).$title.$biblionumber} = $biblionumber;
1433 # sort the hash and return the same structure as GetRecords (Zebra querying)
1436 if ($ordering eq 'popularity_dsc') { # sort popularity DESC
1437 foreach my $key (sort {$b cmp $a} (keys %popularity)) {
1438 $result_hash->{'RECORDS'}[$numbers++] = $result{$popularity{$key}}->as_usmarc();
1440 } else { # sort popularity ASC
1441 foreach my $key (sort (keys %popularity)) {
1442 $result_hash->{'RECORDS'}[$numbers++] = $result{$popularity{$key}}->as_usmarc();
1446 $result_hash->{'hits'} = $numbers;
1447 $finalresult->{'biblioserver'} = $result_hash;
1448 return $finalresult;
1452 } elsif ($ordering =~/author/){
1454 foreach (split /;/,$biblionumbers) {
1455 my ($biblionumber,$title) = split /,/,$_;
1456 my $record=GetMarcBiblio($biblionumber);
1458 if (C4::Context->preference('marcflavour') eq 'UNIMARC') {
1459 $author=$record->subfield('200','f');
1460 $author=$record->subfield('700','a') unless $author;
1462 $author=$record->subfield('100','a');
1464 # hint : the result is sorted by title.biblionumber because we can have X biblios with the same title
1465 # and we don't want to get only 1 result for each of them !!!
1466 $result{$author.$biblionumber}=$record;
1468 # sort the hash and return the same structure as GetRecords (Zebra querying)
1471 if ($ordering eq 'author_za') { # sort by author desc
1472 foreach my $key (sort { $b cmp $a } (keys %result)) {
1473 $result_hash->{'RECORDS'}[$numbers++] = $result{$key}->as_usmarc();
1475 } else { # sort by author ASC
1476 foreach my $key (sort (keys %result)) {
1477 $result_hash->{'RECORDS'}[$numbers++] = $result{$key}->as_usmarc();
1481 $result_hash->{'hits'} = $numbers;
1482 $finalresult->{'biblioserver'} = $result_hash;
1483 return $finalresult;
1485 # ORDER BY callnumber
1487 } elsif ($ordering =~/callnumber/){
1489 foreach (split /;/,$biblionumbers) {
1490 my ($biblionumber,$title) = split /,/,$_;
1491 my $record=GetMarcBiblio($biblionumber);
1493 my ($callnumber_tag,$callnumber_subfield)=GetMarcFromKohaField($dbh,'items.itemcallnumber');
1494 ($callnumber_tag,$callnumber_subfield)= GetMarcFromKohaField('biblioitems.callnumber') unless $callnumber_tag;
1495 if (C4::Context->preference('marcflavour') eq 'UNIMARC') {
1496 $callnumber=$record->subfield('200','f');
1498 $callnumber=$record->subfield('100','a');
1500 # hint : the result is sorted by title.biblionumber because we can have X biblios with the same title
1501 # and we don't want to get only 1 result for each of them !!!
1502 $result{$callnumber.$biblionumber}=$record;
1504 # sort the hash and return the same structure as GetRecords (Zebra querying)
1507 if ($ordering eq 'call_number_dsc') { # sort by title desc
1508 foreach my $key (sort { $b cmp $a } (keys %result)) {
1509 $result_hash->{'RECORDS'}[$numbers++] = $result{$key}->as_usmarc();
1511 } else { # sort by title ASC
1512 foreach my $key (sort { $a cmp $b } (keys %result)) {
1513 $result_hash->{'RECORDS'}[$numbers++] = $result{$key}->as_usmarc();
1517 $result_hash->{'hits'} = $numbers;
1518 $finalresult->{'biblioserver'} = $result_hash;
1519 return $finalresult;
1520 } elsif ($ordering =~ /pubdate/){ #pub year
1522 foreach (split /;/,$biblionumbers) {
1523 my ($biblionumber,$title) = split /,/,$_;
1524 my $record=GetMarcBiblio($biblionumber);
1525 my ($publicationyear_tag,$publicationyear_subfield)=GetMarcFromKohaField('biblioitems.publicationyear','');
1526 my $publicationyear=$record->subfield($publicationyear_tag,$publicationyear_subfield);
1527 # hint : the result is sorted by title.biblionumber because we can have X biblios with the same title
1528 # and we don't want to get only 1 result for each of them !!!
1529 $result{$publicationyear.$biblionumber}=$record;
1531 # sort the hash and return the same structure as GetRecords (Zebra querying)
1534 if ($ordering eq 'pubdate_dsc') { # sort by pubyear desc
1535 foreach my $key (sort { $b cmp $a } (keys %result)) {
1536 $result_hash->{'RECORDS'}[$numbers++] = $result{$key}->as_usmarc();
1538 } else { # sort by pub year ASC
1539 foreach my $key (sort (keys %result)) {
1540 $result_hash->{'RECORDS'}[$numbers++] = $result{$key}->as_usmarc();
1544 $result_hash->{'hits'} = $numbers;
1545 $finalresult->{'biblioserver'} = $result_hash;
1546 return $finalresult;
1550 } elsif ($ordering =~ /title/) {
1551 # the title is in the biblionumbers string, so we just need to build a hash, sort it and return
1553 foreach (split /;/,$biblionumbers) {
1554 my ($biblionumber,$title) = split /,/,$_;
1555 # hint : the result is sorted by title.biblionumber because we can have X biblios with the same title
1556 # and we don't want to get only 1 result for each of them !!!
1557 # hint & speed improvement : we can order without reading the record
1558 # so order, and read records only for the requested page !
1559 $result{$title.$biblionumber}=$biblionumber;
1561 # sort the hash and return the same structure as GetRecords (Zebra querying)
1564 if ($ordering eq 'title_az') { # sort by title desc
1565 foreach my $key (sort (keys %result)) {
1566 $result_hash->{'RECORDS'}[$numbers++] = $result{$key};
1568 } else { # sort by title ASC
1569 foreach my $key (sort { $b cmp $a } (keys %result)) {
1570 $result_hash->{'RECORDS'}[$numbers++] = $result{$key};
1573 # limit the $results_per_page to result size if it's more
1574 $results_per_page = $numbers-1 if $numbers < $results_per_page;
1575 # for the requested page, replace biblionumber by the complete record
1576 # speed improvement : avoid reading too much things
1577 for (my $counter=$offset;$counter<=$offset+$results_per_page;$counter++) {
1578 $result_hash->{'RECORDS'}[$counter] = GetMarcBiblio($result_hash->{'RECORDS'}[$counter])->as_usmarc;
1581 $result_hash->{'hits'} = $numbers;
1582 $finalresult->{'biblioserver'} = $result_hash;
1583 return $finalresult;
1588 # we need 2 hashes to order by ranking : the 1st one to count the ranking, the 2nd to order by ranking
1591 foreach (split /;/,$biblionumbers) {
1592 my ($biblionumber,$title) = split /,/,$_;
1593 $title =~ /(.*)-(\d)/;
1596 # note that we + the ranking because ranking is calculated on weight of EACH term requested.
1597 # if we ask for "two towers", and "two" has weight 2 in biblio N, and "towers" has weight 4 in biblio N
1598 # biblio N has ranking = 6
1599 $count_ranking{$biblionumber} += $ranking;
1601 # build the result by "inverting" the count_ranking hash
1602 # 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
1604 foreach (keys %count_ranking) {
1605 $result{sprintf("%10d",$count_ranking{$_}).'-'.$_} = $_;
1607 # sort the hash and return the same structure as GetRecords (Zebra querying)
1610 foreach my $key (sort {$b cmp $a} (keys %result)) {
1611 $result_hash->{'RECORDS'}[$numbers++] = $result{$key};
1613 # limit the $results_per_page to result size if it's more
1614 $results_per_page = $numbers-1 if $numbers < $results_per_page;
1615 # for the requested page, replace biblionumber by the complete record
1616 # speed improvement : avoid reading too much things
1617 for (my $counter=$offset;$counter<=$offset+$results_per_page;$counter++) {
1618 $result_hash->{'RECORDS'}[$counter] = GetMarcBiblio($result_hash->{'RECORDS'}[$counter])->as_usmarc if $result_hash->{'RECORDS'}[$counter];
1621 $result_hash->{'hits'} = $numbers;
1622 $finalresult->{'biblioserver'} = $result_hash;
1623 return $finalresult;
1628 ($countchanged,$listunchanged) = ModBiblios($listbiblios, $tagsubfield,$initvalue,$targetvalue,$test);
1630 this function changes all the values $initvalue in subfield $tag$subfield in any record in $listbiblios
1631 test parameter if set donot perform change to records in database.
1637 * $listbiblios is an array ref to marcrecords to be changed
1638 * $tagsubfield is the reference of the subfield to change.
1639 * $initvalue is the value to search the record for
1640 * $targetvalue is the value to set the subfield to
1641 * $test is to be set only not to perform changes in database.
1643 =item C<Output arg:>
1644 * $countchanged counts all the changes performed.
1645 * $listunchanged contains the list of all the biblionumbers of records unchanged.
1647 =item C<usage in the script:>
1651 my ($countchanged, $listunchanged) = EditBiblios($results->{RECORD}, $tagsubfield,$initvalue,$targetvalue);;
1652 #If one wants to display unchanged records, you should get biblios foreach @$listunchanged
1653 $template->param(countchanged => $countchanged, loopunchanged=>$listunchanged);
1658 my ($listbiblios,$tagsubfield,$initvalue,$targetvalue,$test)=@_;
1661 my ($tag,$subfield)=($1,$2) if ($tagsubfield=~/^(\d{1,3})([a-z0-9A-Z@])?$/);
1662 if ((length($tag)<3)&& $subfield=~/0-9/){
1663 $tag=$tag.$subfield;
1666 my ($bntag,$bnsubf) = GetMarcFromKohaField('biblio.biblionumber');
1667 my ($itemtag,$itemsubf) = GetMarcFromKohaField('items.itemnumber');
1668 foreach my $usmarc (@$listbiblios){
1670 $record=eval{MARC::Record->new_from_usmarc($usmarc)};
1673 # usmarc is not a valid usmarc May be a biblionumber
1674 if ($tag eq $itemtag){
1675 my $bib=GetBiblioFromItemNumber($usmarc);
1676 $record=GetMarcItem($bib->{'biblionumber'},$usmarc) ;
1677 $biblionumber=$bib->{'biblionumber'};
1679 $record=GetMarcBiblio($usmarc);
1680 $biblionumber=$usmarc;
1684 $biblionumber = $record->subfield($bntag,$bnsubf);
1686 $biblionumber=$record->field($bntag)->data;
1689 #GetBiblionumber is to be written.
1690 #Could be replaced by TransformMarcToKoha (But Would be longer)
1691 if ($record->field($tag)){
1693 foreach my $field ($record->field($tag)){
1695 if ($field->delete_subfield('code' =>$subfield,'match'=>qr($initvalue))){
1698 $field->update($subfield,$targetvalue) if ($targetvalue);
1702 if ($field->delete_field($field)){
1707 $field->data=$targetvalue if ($field->data=~qr($initvalue));
1711 # warn $record->as_formatted;
1713 ModBiblio($record,$biblionumber,GetFrameworkCode($biblionumber)) unless ($test);
1715 push @unmatched, $biblionumber;
1718 push @unmatched, $biblionumber;
1721 return ($countmatched,\@unmatched);
1724 END { } # module clean-up code here (global destructor)
1731 Koha Developement team <info@koha.org>