fixes to search results list, ccl.properties tweak
[wip/koha-chris_n.git] / C4 / Search.pm
1 package C4::Search;
2
3 # This file is part of Koha.
4 #
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
8 # version.
9 #
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.
13 #
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
17
18 use strict;
19 require Exporter;
20 use C4::Context;
21 use C4::Biblio;    # GetMarcFromKohaField
22 use C4::Koha;      # getFacets
23 use Lingua::Stem;
24 use C4::Dates qw(format_date);
25
26 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $DEBUG);
27
28 # set the version for version checking
29 BEGIN {
30         $VERSION = 3.01;
31         $DEBUG = ($ENV{DEBUG}) ? 1 : 0;
32 }
33
34 =head1 NAME
35
36 C4::Search - Functions for searching the Koha catalog.
37
38 =head1 SYNOPSIS
39
40 see opac/opac-search.pl or catalogue/search.pl for example of usage
41
42 =head1 DESCRIPTION
43
44 This module provides the searching facilities for the Koha into a zebra catalog.
45
46 =head1 FUNCTIONS
47
48 =cut
49
50 @ISA    = qw(Exporter);
51 @EXPORT = qw(
52   &SimpleSearch
53   &findseealso
54   &FindDuplicate
55   &searchResults
56   &getRecords
57   &buildQuery
58   &NZgetRecords
59   &ModBiblios
60 );
61
62 # make all your functions, whether exported or not;
63
64 =head2 findseealso($dbh,$fields);
65
66 C<$dbh> is a link to the DB handler.
67
68 use C4::Context;
69 my $dbh =C4::Context->dbh;
70
71 C<$fields> is a reference to the fields array
72
73 This function modify the @$fields array and add related fields to search on.
74
75 =cut
76
77 sub findseealso {
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} );
85     }
86 }
87
88 =head2 FindDuplicate
89
90 ($biblionumber,$biblionumber,$title) = FindDuplicate($record);
91
92 =cut
93
94 sub FindDuplicate {
95     my ($record) = @_;
96     my $dbh = C4::Context->dbh;
97     my $result = TransformMarcToKoha( $dbh, $record, '' );
98     my $sth;
99     my $query;
100     my $search;
101     my $type;
102     my ( $biblionumber, $title );
103
104     # search duplicate on ISBN, easy and fast..
105     # ... normalize first
106     if ( $result->{isbn} ) {
107         $result->{isbn} =~ s/\(.*$//;
108         $result->{isbn} =~ s/\s+$//; 
109     }
110     #$search->{'avoidquerylog'}=1;
111     if ( $result->{isbn} ) {
112         $query = "isbn=$result->{isbn}";
113     }
114     else {
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}";
131         }     
132     }
133     my ($error,$searchresults) =
134       SimpleSearch($query); # FIXME :: hardcoded !
135     my @results;
136     foreach my $possible_duplicate_record (@$searchresults) {
137         my $marcrecord =
138           MARC::Record->new_from_usmarc($possible_duplicate_record);
139         my $result = TransformMarcToKoha( $dbh, $marcrecord, '' );
140         
141         # FIXME :: why 2 $biblionumber ?
142         if ($result){
143           push @results, $result->{'biblionumber'};
144           push @results, $result->{'title'};
145         }
146     }
147     return @results;  
148 }
149
150 =head2 SimpleSearch
151
152 ($error,$results) = SimpleSearch($query,@servers);
153
154 this function performs a simple search on the catalog using zoom.
155
156 =over 2
157
158 =item C<input arg:>
159
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-conf.xml
162
163 =item C<Output arg:>
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.
166
167 =item C<usage in the script:>
168
169 =back
170
171 my ($error, $marcresults) = SimpleSearch($query);
172
173 if (defined $error) {
174     $template->param(query_error => $error);
175     warn "error: ".$error;
176     output_html_with_http_headers $input, $cookie, $template->output;
177     exit;
178 }
179
180 my $hits = scalar @$marcresults;
181 my @results;
182
183 for(my $i=0;$i<$hits;$i++) {
184     my %resultsloop;
185     my $marcrecord = MARC::File::USMARC::decode($marcresults->[$i]);
186     my $biblio = TransformMarcToKoha(C4::Context->dbh,$marcrecord,'');
187
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'};
196
197     push @results, \%resultsloop;
198 }
199 $template->param(result=>\@results);
200
201 =cut
202
203 sub SimpleSearch {
204     my $query   = shift;
205     if (C4::Context->preference('NoZebra')) {
206         my $result = NZorder(NZanalyse($query))->{'biblioserver'};
207         my $search_result = ( $result->{hits} && $result->{hits} > 0 ? $result->{'RECORDS'} : [] );
208         return (undef,$search_result);
209     } else {
210         my @servers = @_;
211         my @results;
212         my @tmpresults;
213         my @zconns;
214         return ( "No query entered", undef ) unless $query;
215     
216         #@servers = (C4::Context->config("biblioserver")) unless @servers;
217         @servers =
218         ("biblioserver") unless @servers
219         ;    # FIXME hardcoded value. See catalog/search.pl & opac-search.pl too.
220     
221         # Connect & Search
222         for ( my $i = 0 ; $i < @servers ; $i++ ) {
223             eval {
224                 $zconns[$i] = C4::Context->Zconn( $servers[$i], 1 );
225                 $tmpresults[$i] =
226                 $zconns[$i]
227                 ->search( new ZOOM::Query::CCL2RPN( $query, $zconns[$i] ) );
228         
229                 # getting error message if one occured.
230                 my $error =
231                   $zconns[$i]->errmsg() . " ("
232                 . $zconns[$i]->errcode() . ") "
233                 . $zconns[$i]->addinfo() . " "
234                 . $zconns[$i]->diagset();
235     
236                 return ( $error, undef ) if $zconns[$i]->errcode();
237             };
238             if ($@) {
239                 # caught a ZOOM::Exception
240                 my $error = 
241                   $@->message() . " ("
242                 . $@->code() . ") "
243                 . $@->addinfo() . " "
244                 . $@->diagset();
245                 warn $error;
246                 return ( $error, undef );
247             }
248         }
249         my $hits;
250         my $ev;
251         while ( ( my $i = ZOOM::event( \@zconns ) ) != 0 ) {
252             $ev = $zconns[ $i - 1 ]->last_event();
253             if ( $ev == ZOOM::Event::ZEND ) {
254                 $hits = $tmpresults[ $i - 1 ]->size();
255             }
256             if ( $hits > 0 ) {
257                 for ( my $j = 0 ; $j < $hits ; $j++ ) {
258                     my $record = $tmpresults[ $i - 1 ]->record($j)->raw();
259                     push @results, $record;
260                 }
261             }
262         }
263         return ( undef, \@results );
264     }
265 }
266
267 # performs the search
268 sub getRecords {
269     my (
270         $koha_query,     $simple_query,  $sort_by_ref,
271         $servers_ref,    $results_per_page, $offset,
272         $expanded_facet, $branches,         $query_type,
273         $scan
274     ) = @_;
275 #     warn "Query : $koha_query";
276     my @servers = @$servers_ref;
277     my @sort_by = @$sort_by_ref;
278
279     # create the zoom connection and query object
280     my $zconn;
281     my @zconns;
282     my @results;
283     my $results_hashref = ();
284
285     ### FACETED RESULTS
286     my $facets_counter = ();
287     my $facets_info    = ();
288     my $facets         = getFacets();
289
290     #### INITIALIZE SOME VARS USED CREATE THE FACETED RESULTS
291     my @facets_loop;    # stores the ref to array of hashes for template
292     for ( my $i = 0 ; $i < @servers ; $i++ ) {
293         $zconns[$i] = C4::Context->Zconn( $servers[$i], 1 );
294
295 # perform the search, create the results objects
296 # if this is a local search, use the $koha-query, if it's a federated one, use the federated-query
297         my $query_to_use;
298         if ( $servers[$i] =~ /biblioserver/ ) {
299             $query_to_use = $koha_query;
300         }
301         else {
302             $query_to_use = $simple_query;
303         }
304
305                 #$query_to_use = $simple_query if $scan;
306                 #warn $simple_query if ($scan && $DEBUG);
307         # check if we've got a query_type defined
308         eval {
309             if ($query_type)
310             {
311                 if ( $query_type =~ /^ccl/ ) {
312                     $query_to_use =~
313                       s/\:/\=/g;    # change : to = last minute (FIXME)
314
315                     #                 warn "CCL : $query_to_use";
316                     $results[$i] =
317                       $zconns[$i]->search(
318                         new ZOOM::Query::CCL2RPN( $query_to_use, $zconns[$i] )
319                       );
320                 }
321                 elsif ( $query_type =~ /^cql/ ) {
322
323                     #                 warn "CQL : $query_to_use";
324                     $results[$i] =
325                       $zconns[$i]->search(
326                         new ZOOM::Query::CQL( $query_to_use, $zconns[$i] ) );
327                 }
328                 elsif ( $query_type =~ /^pqf/ ) {
329
330                     #                 warn "PQF : $query_to_use";
331                     $results[$i] =
332                       $zconns[$i]->search(
333                         new ZOOM::Query::PQF( $query_to_use, $zconns[$i] ) );
334                 }
335             }
336             else {
337                 if ($scan) {
338                      #               warn "preparing to scan:$query_to_use";
339                     $results[$i] =
340                       $zconns[$i]->scan(
341                         new ZOOM::Query::CCL2RPN( $query_to_use, $zconns[$i] )
342                       );
343                 }
344                 else {
345                     #             warn "LAST : $query_to_use";
346                     $results[$i] =
347                       $zconns[$i]->search(
348                         new ZOOM::Query::CCL2RPN( $query_to_use, $zconns[$i] )
349                       );
350                 }
351             }
352         };
353         if ($@) {
354             warn "WARNING: query problem with $query_to_use " . $@;
355         }
356
357         # concatenate the sort_by limits and pass them to the results object
358         my $sort_by;
359         foreach my $sort (@sort_by) {
360             if ($sort eq "author_az") {
361                 $sort_by.="1=1003 <i ";
362             }
363             elsif ($sort eq "author_za") {
364                 $sort_by.="1=1003 >i ";
365             }
366             elsif ($sort eq "popularity_asc") {
367                 $sort_by.="1=9003 <i ";
368             }
369             elsif ($sort eq "popularity_dsc") {
370                 $sort_by.="1=9003 >i ";
371             }
372             elsif ($sort eq "call_number_asc") {
373                 $sort_by.="1=20  <i ";
374             }
375             elsif ($sort eq "call_number_dsc") {
376                 $sort_by.="1=20 >i ";
377             }
378             elsif ($sort eq "pubdate_asc") {
379                 $sort_by.="1=31 <i ";
380             }
381             elsif ($sort eq "pubdate_dsc") {
382                 $sort_by.="1=31 >i ";
383             }
384             elsif ($sort eq "acqdate_asc") {
385                 $sort_by.="1=32 <i ";
386             }
387             elsif ($sort eq "acqdate_dsc") {
388                 $sort_by.="1=32 >i ";
389             }
390             elsif ($sort eq "title_az") {
391                 $sort_by.="1=4 <i ";
392             }
393             elsif ($sort eq "title_za") {
394                 $sort_by.="1=4 >i ";
395             }
396         }
397         if ($sort_by) {
398             if ( $results[$i]->sort( "yaz", $sort_by ) < 0) {
399                 warn "WARNING sort $sort_by failed";
400             }
401         }
402     }
403     while ( ( my $i = ZOOM::event( \@zconns ) ) != 0 ) {
404         my $ev = $zconns[ $i - 1 ]->last_event();
405         if ( $ev == ZOOM::Event::ZEND ) {
406             my $size = $results[ $i - 1 ]->size();
407             if ( $size > 0 ) {
408                 my $results_hash;
409                 #$results_hash->{'server'} = $servers[$i-1];
410                 # loop through the results
411                 $results_hash->{'hits'} = $size;
412                 my $times;
413                 if ( $offset + $results_per_page <= $size ) {
414                     $times = $offset + $results_per_page;
415                 }
416                 else {
417                     $times = $size;
418                 }
419                 for ( my $j = $offset ; $j < $times ; $j++ )
420                 {   #(($offset+$count<=$size) ? ($offset+$count):$size) ; $j++){
421                     my $records_hash;
422                     my $record;
423                     my $facet_record;
424                     ## This is just an index scan
425                     if ($scan) {
426                         my ( $term, $occ ) = $results[ $i - 1 ]->term($j);
427                  # here we create a minimal MARC record and hand it off to the
428                  # template just like a normal result ... perhaps not ideal, but
429                  # it works for now
430                         my $tmprecord = MARC::Record->new();
431                         $tmprecord->encoding('UTF-8');
432                         my $tmptitle;
433                                                 my $tmpauthor;
434                         # the minimal record in author/title (depending on MARC flavour)
435                         if ( C4::Context->preference("marcflavour") eq
436                             "UNIMARC" )
437                         {
438                             $tmptitle = MARC::Field->new(
439                                 '200', ' ', ' ',
440                                 a => $term,
441                                 f => $occ
442                             );
443                         }
444                         else {
445                             $tmptitle = MARC::Field->new('245', ' ', ' ',a => $term,);
446                                                         $tmpauthor = MARC::Field->new('100', ' ', ' ',a => $occ,);
447                         }
448                         $tmprecord->append_fields($tmptitle);
449                                                 $tmprecord->append_fields($tmpauthor);
450                         $results_hash->{'RECORDS'}[$j] = $tmprecord->as_usmarc();
451                     }
452                     else {
453                         $record = $results[ $i - 1 ]->record($j)->raw();
454
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);
460
461                         #warn $servers[$i-1].$facet_record->title();
462                         for ( my $k = 0 ; $k <= @$facets ; $k++ ) {
463                             if ( $facets->[$k] ) {
464                                 my @fields;
465                                 for my $tag ( @{ $facets->[$k]->{'tags'} } ) {
466                                     push @fields, $facet_record->field($tag);
467                                 }
468                                 for my $field (@fields) {
469                                     my @subfields = $field->subfields();
470                                     for my $subfield (@subfields) {
471                                         my ( $code, $data ) = @$subfield;
472                                         if ( $code eq
473                                             $facets->[$k]->{'subfield'} )
474                                         {
475                                             $facets_counter->{ $facets->[$k]
476                                                   ->{'link_value'} }->{$data}++;
477                                         }
478                                     }
479                                 }
480                                 $facets_info->{ $facets->[$k]->{'link_value'} }
481                                   ->{'label_value'} =
482                                   $facets->[$k]->{'label_value'};
483                                 $facets_info->{ $facets->[$k]->{'link_value'} }
484                                   ->{'expanded'} = $facets->[$k]->{'expanded'};
485                             }
486                         }
487                     }
488                 }
489                 $results_hashref->{ $servers[ $i - 1 ] } = $results_hash;
490             }
491
492             #print "connection ", $i-1, ": $size hits";
493             #print $results[$i-1]->record(0)->render() if $size > 0;
494             # BUILD FACETS
495             for my $link_value (
496                 sort { $facets_counter->{$b} <=> $facets_counter->{$a} }
497                 keys %$facets_counter
498               )
499             {
500                 my $expandable;
501                 my $number_of_facets;
502                 my @this_facets_array;
503                 for my $one_facet (
504                     sort {
505                         $facets_counter->{$link_value}
506                           ->{$b} <=> $facets_counter->{$link_value}->{$a}
507                     } keys %{ $facets_counter->{$link_value} }
508                   )
509                 {
510                     $number_of_facets++;
511                     if (   ( $number_of_facets < 6 )
512                         || ( $expanded_facet eq $link_value )
513                         || ( $facets_info->{$link_value}->{'expanded'} ) )
514                     {
515
516                        # sanitize the link value ), ( will cause errors with CCL
517                         my $facet_link_value = $one_facet;
518                         $facet_link_value =~ s/(\(|\))/ /g;
519
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;
524
525                        # well, if it's a branch, label by the name, not the code
526                         if ( $link_value =~ /branch/ ) {
527                             $facet_label_value =
528                               $branches->{$one_facet}->{'branchname'};
529                         }
530
531                  # but we're down with the whole label being in the link's title
532                         my $facet_title_value = $one_facet;
533
534                         push @this_facets_array,
535                           (
536                             {
537                                 facet_count =>
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,
543                             },
544                           );
545                     }
546                 }
547                 unless ( $facets_info->{$link_value}->{'expanded'} ) {
548                     $expandable = 1
549                       if ( ( $number_of_facets > 6 )
550                         && ( $expanded_facet ne $link_value ) );
551                 }
552                 push @facets_loop,
553                   (
554                     {
555                         type_link_value => $link_value,
556                         type_id         => $link_value . "_id",
557                         type_label      =>
558                           $facets_info->{$link_value}->{'label_value'},
559                         facets     => \@this_facets_array,
560                         expandable => $expandable,
561                         expand     => $link_value,
562                     }
563                   );
564             }
565         }
566     }
567     return ( undef, $results_hashref, \@facets_loop );
568 }
569
570 # STOPWORDS
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, $_;
587                         }
588         }
589     }
590     return ($operand, \@stopwords_removed);
591 }
592
593 # TRUNCATION
594 sub _detect_truncation {
595     my ($operand,$index) = @_;
596     my (@nontruncated,@righttruncated,@lefttruncated,@rightlefttruncated,@regexpr);
597     $operand =~s/^ //g;
598     my @wordlist= split (/\s/,$operand);
599     foreach my $word (@wordlist){
600         if ($word=~s/^\*([^\*]+)\*$/$1/){
601             push @rightlefttruncated,$word;
602         } 
603         elsif($word=~s/^\*([^\*]+)$/$1/){
604             push @lefttruncated,$word;
605         } 
606         elsif ($word=~s/^([^\*]+)\*$/$1/){
607             push @righttruncated,$word;
608         } 
609         elsif (index($word,"*")<0){
610             push @nontruncated,$word;
611         }
612         else {
613             push @regexpr,$word;
614         }
615     }
616     return (\@nontruncated,\@righttruncated,\@lefttruncated,\@rightlefttruncated,\@regexpr);
617 }
618
619 sub _build_stemmed_operand {
620     my ($operand) = @_;
621     my $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(
626             {
627                 'and' => 'and',
628                 'or'  => 'or',
629                 'not' => 'not',
630             }
631                     
632         );
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 .= " ";
639     }
640     #warn "STEMMED OPERAND: $stemmed_operand";
641     return $stemmed_operand;
642 }
643
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;
651
652     my $weighted_query .= "(rk=(";     # Specifies that we're applying rank
653
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 wrdl,fuzzy,r8=\"$operand\"" if $fuzzy_enabled; # add fuzzy, word list
662         $weighted_query .= " or wrdl,right-Truncation,r9=\"$stemmed_operand\"" if ($stemming and $stemmed_operand); # add stemming, right truncation
663                 $weighted_query .= " or wrdl,r9=\"$operand\"";
664
665        # embedded sorting: 0 a-z; 1 z-a
666        # $weighted_query .= ") or (sort1,aut=1";
667     }
668         elsif ( $index eq 'bc' ) {
669                 $weighted_query .= "bc=\"$operand\"";
670         }
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\"";
675     }
676     #TODO: build better cases based on specific search indexes
677     else {
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,wrdl,r3=\"$operand\"";      # word list index
682     }
683     $weighted_query .= "))";    # close rank specification
684     return $weighted_query;
685 }
686
687 # build the query itself
688 sub buildQuery {
689     my ( $operators, $operands, $indexes, $limits, $sort_by, $scan) = @_;
690
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;
696
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     # no stemming/weight/fuzzy in NoZebra
702     if (C4::Context->preference("NoZebra")) {
703         $stemming =0;
704         $weight_fields=0;
705         $fuzzy_enabled=0;
706     }
707         my $remove_stopwords = C4::Context->preference("QueryRemoveStopwords")  || 0;
708
709     my $query = $operands[0];
710         my $simple_query = $operands[0];
711         my $query_cgi;
712         my $query_desc;
713         my $query_type;
714
715         my $limit;
716         my $limit_cgi;
717         my $limit_desc;
718
719         my $stopwords_removed;
720
721         # for handling ccl, cql, pqf queries in diagnostic mode, skip the rest of the steps
722         # DIAGNOSTIC ONLY!!
723     if ( $query =~ /^ccl=/ ) {
724         return ( undef, $', $', $', $', '', '', '', '', 'ccl' );
725     }
726     if ( $query =~ /^cql=/ ) {
727         return ( undef, $', $', $', $', '', '', '', '', 'cql' );
728     }
729     if ( $query =~ /^pqf=/ ) {
730         return ( undef, $', $', $', $', '', '', '', '', 'pqf' );
731     }
732
733         # pass nested queries directly
734     if ( $query =~ /(\(|\))/ ) {
735         return ( undef, $query, $simple_query, $query_cgi, $query, $limit, $limit_cgi, $limit_desc, $stopwords_removed, 'ccl' );
736     }
737
738 # form-based queries are limited to non-nested at a specific depth, so we can easily
739 # modify the incoming query operands and indexes to do stemming and field weighting
740 # Once we do so, we'll end up with a value in $query, just like if we had an
741 # incoming $query from the user
742     else {
743         $query = ""; # clear it out so we can populate properly with field-weighted stemmed query
744         my $previous_operand;    # a flag used to keep track if there was a previous query
745                                 # if there was, we can apply the current operator
746         # for every operand
747         for ( my $i = 0 ; $i <= @operands ; $i++ ) {
748
749             # COMBINE OPERANDS, INDEXES AND OPERATORS
750             if ( $operands[$i] ) {
751
752                                 # a flag to determine whether or not to add the index to the query
753                                 my $indexes_set;
754
755                                 # if the user is sophisticated enough to specify an index, turn off field weighting, stemming, and stopword handling
756                                 if ($operands[$i] =~ /(:|=)/ || $scan) {
757                                         $weight_fields = 0;
758                                         $stemming = 0;
759                                         $remove_stopwords = 0;
760                                 }
761                 my $operand = $operands[$i];
762                 my $index   = $indexes[$i];
763
764                                 # add some attributes for certain index types
765                                 # Date of Publication
766                                 if ($index eq 'yr') {
767                                         $index .=",st-numeric";
768                                         $indexes_set++;
769                                         ($stemming,$auto_truncation,$weight_fields, $fuzzy_enabled, $remove_stopwords) = (0,0,0,0,0);
770                                 }
771                                 # Date of Acquisition
772                                 elsif ($index eq 'acqdate') {
773                                         $index.=",st-date-normalized";
774                                         $indexes_set++;
775                                         ($stemming,$auto_truncation,$weight_fields, $fuzzy_enabled, $remove_stopwords) = (0,0,0,0,0);
776
777                                 }
778
779                                 # set default structure attribute (word list)
780                                 my $struct_attr;
781                                 unless (!$index || $index =~ /(st-|phr|ext|wrdl)/) {
782                                         $struct_attr = ",wrdl";
783                                 }
784                                 # some helpful index modifs
785                 my $index_plus = $index.$struct_attr.":" if $index;
786                 my $index_plus_comma=$index.$struct_attr."," if $index;
787
788                 # Remove Stopwords
789                                 if ($remove_stopwords) {
790                 ($operand, $stopwords_removed) = _remove_stopwords($operand,$index);
791                         warn "OPERAND w/out STOPWORDS: >$operand<" if $DEBUG;
792                                         warn "REMOVED STOPWORDS: @$stopwords_removed" if ($stopwords_removed && $DEBUG);
793                                 }
794
795                 # Detect Truncation
796                 my ($nontruncated,$righttruncated,$lefttruncated,$rightlefttruncated,$regexpr);
797                 my $truncated_operand;
798                 ($nontruncated,$righttruncated,$lefttruncated,$rightlefttruncated,$regexpr) = _detect_truncation($operand,$index);
799                 warn "TRUNCATION: NON:>@$nontruncated< RIGHT:>@$righttruncated< LEFT:>@$lefttruncated< RIGHTLEFT:>@$rightlefttruncated< REGEX:>@$regexpr<" if $DEBUG;
800
801                 # Apply Truncation
802                 if (scalar(@$righttruncated)+scalar(@$lefttruncated)+scalar(@$rightlefttruncated)>0){
803                                         # don't field weight or add the index to the query, we do it here
804                     $indexes_set = 1;
805                     undef $weight_fields;
806                     my $previous_truncation_operand;
807                     if (scalar(@$nontruncated)>0) {
808                         $truncated_operand.= "$index_plus @$nontruncated ";
809                         $previous_truncation_operand = 1;
810                     }
811                     if (scalar(@$righttruncated)>0){
812                         $truncated_operand .= "and " if $previous_truncation_operand;
813                         $truncated_operand .= "$index_plus_comma"."rtrn:@$righttruncated ";
814                         $previous_truncation_operand = 1;
815                     }
816                     if (scalar(@$lefttruncated)>0){
817                         $truncated_operand .= "and " if $previous_truncation_operand;
818                         $truncated_operand .= "$index_plus_comma"."ltrn:@$lefttruncated ";
819                         $previous_truncation_operand = 1;
820                     }
821                     if (scalar(@$rightlefttruncated)>0){
822                         $truncated_operand .= "and " if $previous_truncation_operand;
823                         $truncated_operand .= "$index_plus_comma"."rltrn:@$rightlefttruncated ";
824                         $previous_truncation_operand = 1;
825                     }
826                 }
827                 $operand = $truncated_operand if $truncated_operand;
828                 warn "TRUNCATED OPERAND: >$truncated_operand<" if $DEBUG;
829
830                 # Handle Stemming
831                 my $stemmed_operand;
832                 $stemmed_operand = _build_stemmed_operand($operand) if $stemming;
833                 warn "STEMMED OPERAND: >$stemmed_operand<" if $DEBUG;
834
835                 # Handle Field Weighting
836                 my $weighted_operand;
837                 $weighted_operand = _build_weighted_query($operand,$stemmed_operand,$index) if $weight_fields;
838                 warn "FIELD WEIGHTED OPERAND: >$weighted_operand<" if $DEBUG;
839                 $operand = $weighted_operand if $weight_fields;
840                 $indexes_set = 1 if $weight_fields;
841
842                 # If there's a previous operand, we need to add an operator
843                 if ($previous_operand) {
844
845                     # user-specified operator
846                     if ( $operators[$i-1] ) {
847                         $query .= " $operators[$i-1] ";
848                         $query .= " $index_plus " unless $indexes_set;
849                         $query .= " $operand";
850                                                 $query_cgi .="&op=$operators[$i-1]";
851                                                 $query_cgi .="&idx=$index" if $index;
852                                                 $query_cgi .="&q=$operands[$i]" if $operands[$i];
853                                                 $query_desc .=" $operators[$i-1] $index_plus $operands[$i]";
854                     }
855
856                     # the default operator is and
857                     else {
858                         $query .= " and ";
859                         $query .= "$index_plus " unless $indexes_set;
860                         $query .= "$operand";
861                                                 $query_cgi .="&op=and&idx=$index" if $index;
862                                                 $query_cgi .="&q=$operands[$i]" if $operands[$i];
863                         $query_desc .= " and $index_plus $operands[$i]";
864                     }
865                 }
866
867                                 # there isn't a pervious operand, don't need an operator
868                 else { 
869                                         # field-weighted queries already have indexes set
870                                         $query .=" $index_plus " unless $indexes_set;
871                                         $query .= $operand;
872                                         $query_desc .= " $index_plus $operands[$i]";
873                                         $query_cgi.="&idx=$index" if $index;
874                                         $query_cgi.="&q=$operands[$i]" if $operands[$i];
875
876                     $previous_operand = 1;
877                 }
878             }    #/if $operands
879         }    # /for
880     }
881     warn "QUERY BEFORE LIMITS: >$query<" if $DEBUG;
882
883     # add limits
884         $DEBUG=1;
885         my $group_OR_limits;
886         my $availability_limit;
887     foreach my $this_limit (@limits) {
888         if ( $this_limit =~ /available/ ) {
889                         # available is defined as (items.notloan is NULL) and (items.itemlost > 0 or NULL) (last clause handles NULL values for lost in zebra)
890                         # all records not indexed in the onloan register and allrecords not indexed in the lost register, or where the value of lost is equal to or less than 0
891                         $availability_limit .="( ( allrecords,AlwaysMatches='' not onloan,AlwaysMatches='') and ((lost,st-numeric <= 0) or ( allrecords,AlwaysMatches='' not lost,AlwaysMatches='')) )";
892                         $limit_cgi .= "&limit=available";
893                         $limit_desc .="";
894         }
895
896                 # these are treated as OR
897         elsif ( $this_limit =~ /mc/ ) {
898             $group_OR_limits .= " or " if $group_OR_limits;
899                         $limit_desc .=" or " if $group_OR_limits;
900                         $group_OR_limits .= "$this_limit";
901                         $limit_cgi .="&limit=$this_limit";
902                         $limit_desc .= " $this_limit";
903         }
904                 # regular old limits
905                 else {
906                         $limit .= " and " if $limit || $query;
907                         $limit .= "$this_limit";
908                         $limit_cgi .="&limit=$this_limit";
909                         $limit_desc .=" $this_limit";
910                 }
911     }
912         if ($group_OR_limits) {
913                 $limit.=" and " if ($query || $limit );
914                 $limit.="($group_OR_limits)";
915         }
916         if ($availability_limit) {
917                 $limit.=" and " if ($query || $limit );
918                 $limit.="($availability_limit)";
919         }
920         # normalize the strings
921         $query =~ s/:/=/g;
922         $limit =~ s/:/=/g;
923         for ($query, $query_desc, $limit, $limit_desc) {
924                 $_ =~ s/  / /g;    # remove extra spaces
925         $_ =~ s/^ //g;     # remove any beginning spaces
926                 $_ =~ s/ $//g;     # remove any ending spaces
927         $_ =~ s/==/=/g;    # remove double == from query
928
929         }
930         $query_cgi =~ s/^&//;
931
932         # append the limit to the query
933         $query .= " ".$limit;
934
935     warn "QUERY:".$query if $DEBUG;
936         warn "QUERY CGI:".$query_cgi if $DEBUG;
937     warn "QUERY DESC:".$query_desc if $DEBUG;
938     warn "LIMIT:".$limit if $DEBUG;
939     warn "LIMIT CGI:".$limit_cgi if $DEBUG;
940     warn "LIMIT DESC:".$limit_desc if $DEBUG;
941
942         return ( undef, $query,$simple_query,$query_cgi,$query_desc,$limit,$limit_cgi,$limit_desc,$stopwords_removed,$query_type );
943 }
944
945 # IMO this subroutine is pretty messy still -- it's responsible for
946 # building the HTML output for the template
947 sub searchResults {
948     my ( $searchdesc, $hits, $results_per_page, $offset, @marcresults ) = @_;
949
950     my $dbh = C4::Context->dbh;
951     my $toggle;
952     my $even = 1;
953     my @newresults;
954     my $span_terms_hashref;
955     for my $span_term ( split( / /, $searchdesc ) ) {
956         $span_term =~ s/(.*=|\)|\(|\+|\.)//g;
957         $span_terms_hashref->{$span_term}++;
958     }
959
960     #Build brancnames hash
961     #find branchname
962     #get branch information.....
963     my %branches;
964     my $bsth =
965       $dbh->prepare("SELECT branchcode,branchname FROM branches")
966       ;    # FIXME : use C4::Koha::GetBranches
967     $bsth->execute();
968     while ( my $bdata = $bsth->fetchrow_hashref ) {
969         $branches{ $bdata->{'branchcode'} } = $bdata->{'branchname'};
970     }
971         my %locations;
972         my $lsch = $dbh->prepare("SELECT authorised_value,lib FROM authorised_values WHERE category = 'SHELF_LOC'");
973         $lsch->execute();
974         while (my $ldata = $lsch->fetchrow_hashref ) {
975                 $locations{ $ldata->{'authorised_value'} } = $ldata->{'lib'};
976         }
977
978     #Build itemtype hash
979     #find itemtype & itemtype image
980     my %itemtypes;
981     $bsth =
982       $dbh->prepare("SELECT itemtype,description,imageurl,summary,notforloan FROM itemtypes");
983     $bsth->execute();
984     while ( my $bdata = $bsth->fetchrow_hashref ) {
985         $itemtypes{ $bdata->{'itemtype'} }->{description} =
986           $bdata->{'description'};
987         $itemtypes{ $bdata->{'itemtype'} }->{imageurl} = $bdata->{'imageurl'};
988         $itemtypes{ $bdata->{'itemtype'} }->{summary} = $bdata->{'summary'};
989         $itemtypes{ $bdata->{'itemtype'} }->{notforloan} = $bdata->{'notforloan'};
990     }
991
992     #search item field code
993     my $sth =
994       $dbh->prepare(
995 "select tagfield from marc_subfield_structure where kohafield like 'items.itemnumber'"
996       );
997     $sth->execute;
998     my ($itemtag) = $sth->fetchrow;
999
1000     ## find column names of items related to MARC
1001     my $sth2 = $dbh->prepare("SHOW COLUMNS from items");
1002     $sth2->execute;
1003     my %subfieldstosearch;
1004     while ( ( my $column ) = $sth2->fetchrow ) {
1005         my ( $tagfield, $tagsubfield ) =
1006           &GetMarcFromKohaField( "items." . $column, "" );
1007         $subfieldstosearch{$column} = $tagsubfield;
1008     }
1009     my $times;
1010
1011     if ( $hits && $offset + $results_per_page <= $hits ) {
1012         $times = $offset + $results_per_page;
1013     }
1014     else {
1015         $times = $hits;
1016     }
1017
1018     for ( my $i = $offset ; $i <= $times - 1 ; $i++ ) {
1019         my $marcrecord;
1020         $marcrecord = MARC::File::USMARC::decode( $marcresults[$i] );
1021         my $oldbiblio = TransformMarcToKoha( $dbh, $marcrecord, '' );
1022                 $oldbiblio->{result_number} = $i+1;
1023         # add image url if there is one
1024         if ( $itemtypes{ $oldbiblio->{itemtype} }->{imageurl} =~ /^http:/ ) {
1025             $oldbiblio->{imageurl} =
1026               $itemtypes{ $oldbiblio->{itemtype} }->{imageurl};
1027             $oldbiblio->{description} =
1028               $itemtypes{ $oldbiblio->{itemtype} }->{description};
1029         }
1030         else {
1031             $oldbiblio->{imageurl} =
1032               getitemtypeimagesrc() . "/"
1033               . $itemtypes{ $oldbiblio->{itemtype} }->{imageurl}
1034               if ( $itemtypes{ $oldbiblio->{itemtype} }->{imageurl} );
1035             $oldbiblio->{description} =
1036               $itemtypes{ $oldbiblio->{itemtype} }->{description};
1037         }
1038         #
1039         # build summary if there is one (the summary is defined in itemtypes table
1040         #
1041         if ($itemtypes{ $oldbiblio->{itemtype} }->{summary}) {
1042             my $summary = $itemtypes{ $oldbiblio->{itemtype} }->{summary};
1043             my @fields = $marcrecord->fields();
1044             foreach my $field (@fields) {
1045                 my $tag = $field->tag();
1046                 my $tagvalue = $field->as_string();
1047                 $summary =~ s/\[(.?.?.?.?)$tag\*(.*?)]/$1$tagvalue$2\[$1$tag$2]/g;
1048                 unless ($tag<10) {
1049                     my @subf = $field->subfields;
1050                     for my $i (0..$#subf) {
1051                         my $subfieldcode = $subf[$i][0];
1052                         my $subfieldvalue = $subf[$i][1];
1053                         my $tagsubf = $tag.$subfieldcode;
1054                         $summary =~ s/\[(.?.?.?.?)$tagsubf(.*?)]/$1$subfieldvalue$2\[$1$tagsubf$2]/g;
1055                     }
1056                 }
1057             }
1058             $summary =~ s/\[(.*?)]//g;
1059             $summary =~ s/\n/<br>/g;
1060             $oldbiblio->{summary} = $summary;
1061         }
1062         # add spans to search term in results for search term highlighting
1063         # save a native author, for the <a href=search.lq=<!--tmpl_var name="author"-->> link
1064                 my $searchhighlightblob;
1065                 for my $highlight_field ($marcrecord->fields) {
1066                         next if $highlight_field->tag() =~ /(^00)/; # skip fixed fields
1067                         my $match;
1068                         my $field = $highlight_field->as_string();
1069                         for my $term ( keys %$span_terms_hashref ) {
1070                                 if (($field =~ /$term/i) && (length($term) > 3)) {
1071                                         $field =~ s/$term/<span class=\"term\">$&<\/span>/gi;
1072                                         $match++;
1073                                 }
1074                         }
1075                         $searchhighlightblob .= $field." ... " if $match;
1076                 }
1077                 $oldbiblio->{'searchhighlightblob'} = $searchhighlightblob;
1078
1079         $oldbiblio->{'author_nospan'} = $oldbiblio->{'author'};
1080         for my $term ( keys %$span_terms_hashref ) {
1081             my $old_term = $term;
1082             if ( length($term) > 3 ) {
1083                 $term =~ s/(.*=|\)|\(|\+|\.|\?|\[|\]|\\|\*)//g;
1084                 $oldbiblio->{'title'} =~ s/$term/<span class=\"term\">$&<\/span>/gi;
1085                 $oldbiblio->{'subtitle'} =~ s/$term/<span class=\"term\">$&<\/span>/gi;
1086                 $oldbiblio->{'author'} =~ s/$term/<span class=\"term\">$&<\/span>/gi;
1087                 $oldbiblio->{'publishercode'} =~ s/$term/<span class=\"term\">$&<\/span>/gi;
1088                 $oldbiblio->{'place'} =~ s/$term/<span class=\"term\">$&<\/span>/gi;
1089                 $oldbiblio->{'pages'} =~ s/$term/<span class=\"term\">$&<\/span>/gi;
1090                 $oldbiblio->{'notes'} =~ s/$term/<span class=\"term\">$&<\/span>/gi;
1091                 $oldbiblio->{'size'}  =~ s/$term/<span class=\"term\">$&<\/span>/gi;
1092             }
1093         }
1094
1095         if ( $i % 2 ) {
1096             $toggle = "#ffffcc";
1097         }
1098         else {
1099             $toggle = "white";
1100         }
1101         $oldbiblio->{'toggle'} = $toggle;
1102         my @fields = $marcrecord->field($itemtag);
1103
1104 # Setting item statuses for display
1105         my @available_items_loop;
1106                 my @onloan_items_loop;
1107                 my @other_items_loop;
1108
1109         my $available_items;
1110                 my $onloan_items;
1111                 my $other_items;
1112
1113         my $ordered_count     = 0;
1114                 my $available_count   = 0;
1115         my $onloan_count      = 0;
1116                 my $longoverdue_count = 0;
1117                 my $other_count       = 0;
1118         my $wthdrawn_count    = 0;
1119         my $itemlost_count    = 0;
1120                 my $itembinding_count = 0;
1121                 my $itemdamaged_count = 0;
1122         my $can_place_holds   = 0;
1123         my $items_count=scalar(@fields);
1124                 my $items_counter;
1125                 my $maxitems = (C4::Context->preference('maxItemsinSearchResults')) ? C4::Context->preference('maxItemsinSearchResults')- 1 : 1;
1126         foreach my $field (@fields) {
1127             my $item;
1128                         $items_counter++;
1129
1130                         # populate the items hash 
1131             foreach my $code ( keys %subfieldstosearch ) {
1132                 $item->{$code} = $field->subfield( $subfieldstosearch{$code} );
1133             }
1134
1135                         # set item's branch name, use homebranch first, fall back to holdingbranch
1136             if ($item->{'homebranch'}) {
1137                     $item->{'branchname'} = $branches{$item->{homebranch}};
1138             }
1139             # Last resort
1140             elsif ($item->{'holdingbranch'}) {
1141                                          $item->{'branchname'} = $branches{$item->{holdingbranch}};
1142             }
1143                         # key for items results is built from branchcode . coded location qualifier . itemcallnumber
1144                         if ($item->{onloan}) {
1145                                 $onloan_count++;
1146                                 $onloan_items->{ $item->{'homebranch'}.'--'.$item->{location}.$item->{'itemcallnumber'}.$item->{due_date} }->{due_date} = format_date($item->{onloan});
1147                 $onloan_items->{ $item->{'homebranch'}.'--'.$item->{location}.$item->{'itemcallnumber'}.$item->{due_date} }->{count}++ if $item->{'homebranch'};
1148                 $onloan_items->{ $item->{'homebranch'}.'--'.$item->{location}.$item->{'itemcallnumber'}.$item->{due_date} }->{branchname} = $item->{'branchname'};
1149                 $onloan_items->{ $item->{'homebranch'}.'--'.$item->{location}.$item->{'itemcallnumber'}.$item->{due_date} }->{location} =  $locations{$item->{location}};
1150                 $onloan_items->{ $item->{'homebranch'}.'--'.$item->{location}.$item->{'itemcallnumber'}.$item->{due_date} }->{itemcallnumber} = $item->{itemcallnumber};
1151
1152                                 # if something's checked out and lost, mark it as 'long overdue'
1153                                 if ( $item->{itemlost} ) {
1154                                         $onloan_items->{ $item->{'homebranch'}.'--'.$item->{location}.$item->{'itemcallnumber'}.$item->{due_date} }->{longoverdue}++;
1155                         $longoverdue_count++;
1156                                 }
1157                                 # can place holds as long as this item isn't lost
1158                                 else {
1159                                         $can_place_holds = 1;
1160                                 }
1161                         }
1162
1163                         # items not on loan, but still unavailable ( lost, withdrawn, damaged )
1164                         else { 
1165                 # item is on order
1166                 if ( $item->{notforloan} == -1) {
1167                         $ordered_count++;
1168                 }
1169
1170                                 # item is withdrawn, lost or damaged
1171                                 if ( $item->{wthdrawn} || $item->{itemlost} || $item->{damaged} ) {
1172                         $wthdrawn_count++ if $item->{wthdrawn};
1173                         $itemlost_count++ if $item->{itemlost};
1174                         $itemdamaged_count++ if $item->{damaged};
1175                                         $item->{status} = $item->{wthdrawn}."-".$item->{itemlost}."-".$item->{damaged};
1176                         $other_count++;
1177                         $other_items->{ $item->{'homebranch'}.'--'.$item->{location}.$item->{'itemcallnumber'}.$item->{status} }->{wthdrawn} = $item->{wthdrawn};
1178                                         $other_items->{ $item->{'homebranch'}.'--'.$item->{location}.$item->{'itemcallnumber'}.$item->{status} }->{itemlost} = $item->{itemlost};
1179                                         $other_items->{ $item->{'homebranch'}.'--'.$item->{location}.$item->{'itemcallnumber'}.$item->{status} }->{damaged} = $item->{damaged};
1180                         $other_items->{ $item->{'homebranch'}.'--'.$item->{location}.$item->{'itemcallnumber'}.$item->{status} }->{count}++ if $item->{'homebranch'};
1181                         $other_items->{ $item->{'homebranch'}.'--'.$item->{location}.$item->{'itemcallnumber'}.$item->{status} }->{branchname} = $item->{'branchname'};
1182                         $other_items->{ $item->{'homebranch'}.'--'.$item->{location}.$item->{'itemcallnumber'}.$item->{status} }->{location} =  $locations{$item->{location}};
1183                         $other_items->{ $item->{'homebranch'}.'--'.$item->{location}.$item->{'itemcallnumber'}.$item->{status} }->{itemcallnumber} = $item->{itemcallnumber};
1184                                 }
1185
1186                                 # item is available
1187                                 else {
1188                                         $can_place_holds = 1;
1189                                         $available_count++;
1190                                         $available_items->{ $item->{'homebranch'}.'--'.$item->{location}.$item->{'itemcallnumber'} }->{count}++ if $item->{'homebranch'};
1191                                         $available_items->{ $item->{'homebranch'}.'--'.$item->{location}.$item->{'itemcallnumber'} }->{branchname} = $item->{'branchname'};
1192                                         $available_items->{ $item->{'homebranch'}.'--'.$item->{location}.$item->{'itemcallnumber'} }->{location} =  $locations{$item->{location}};
1193                                         $available_items->{ $item->{'homebranch'}.'--'.$item->{location}.$item->{'itemcallnumber'} }->{itemcallnumber} = $item->{itemcallnumber};
1194                                 }
1195                         }
1196         } # notforloan, item level and biblioitem level
1197                 my ($availableitemscount, $onloanitemscount, $otheritemscount);
1198                 my $maxitems = (C4::Context->preference('maxItemsinSearchResults')) ? C4::Context->preference('maxItemsinSearchResults')- 1 : 1;
1199         for my $key ( sort keys %$onloan_items ) {
1200             $onloanitemscount++;
1201                         push @onloan_items_loop, $onloan_items->{$key} unless $onloanitemscount > $maxitems;
1202         }
1203         for my $key ( sort keys %$other_items ) {
1204             $otheritemscount++;
1205             push @other_items_loop, $other_items->{$key} unless $otheritemscount > $maxitems;
1206         }
1207         for my $key ( sort keys %$available_items ) {
1208             $availableitemscount++;
1209             push @available_items_loop, $available_items->{$key} unless $availableitemscount > $maxitems;
1210         }
1211                 # last check for norequest : if itemtype is notforloan, it can't be reserved either, whatever the items
1212         $can_place_holds = 0 if $itemtypes{$oldbiblio->{itemtype}}->{notforloan};
1213         $oldbiblio->{norequests}    = 1 unless $can_place_holds;
1214                 $oldbiblio->{itemsplural} = 1 if $items_count>1;
1215         $oldbiblio->{items_count}    = $items_count;
1216         $oldbiblio->{available_items_loop}    = \@available_items_loop;
1217                 $oldbiblio->{onloan_items_loop} = \@onloan_items_loop;
1218                 $oldbiblio->{other_items_loop} = \@other_items_loop;
1219                 $oldbiblio->{availablecount} = $available_count;
1220                 $oldbiblio->{availableplural} = 1 if $available_count>1;
1221         $oldbiblio->{onloancount}   = $onloan_count;
1222                 $oldbiblio->{onloanplural} = 1 if $onloan_count>1;
1223                 $oldbiblio->{othercount}   = $other_count;
1224                 $oldbiblio->{otherplural} = 1 if $other_count>1;
1225         $oldbiblio->{wthdrawncount} = $wthdrawn_count;
1226         $oldbiblio->{itemlostcount} = $itemlost_count;
1227                 $oldbiblio->{damagedcount} = $itemdamaged_count;
1228         $oldbiblio->{orderedcount}  = $ordered_count;
1229         $oldbiblio->{isbn}          =~ s/-//g; # deleting - in isbn to enable amazon content 
1230         push( @newresults, $oldbiblio );
1231     }
1232     return @newresults;
1233 }
1234
1235
1236
1237 #----------------------------------------------------------------------
1238 #
1239 # Non-Zebra GetRecords#
1240 #----------------------------------------------------------------------
1241
1242 =head2 NZgetRecords
1243
1244   NZgetRecords has the same API as zera getRecords, even if some parameters are not managed
1245
1246 =cut
1247 sub NZgetRecords {
1248     my ($query,$simple_query,$sort_by_ref,$servers_ref,$results_per_page,$offset,$expanded_facet,$branches,$query_type,$scan) = @_;
1249     my $result = NZanalyse($query);
1250     return (undef,NZorder($result,@$sort_by_ref[0],$results_per_page,$offset),undef);
1251 }
1252
1253 =head2 NZanalyse
1254
1255   NZanalyse : get a CQL string as parameter, and returns a list of biblionumber;title,biblionumber;title,...
1256   the list is built from an inverted index in the nozebra SQL table
1257   note that title is here only for convenience : the sorting will be very fast when requested on title
1258   if the sorting is requested on something else, we will have to reread all results, and that may be longer.
1259
1260 =cut
1261
1262 sub NZanalyse {
1263     my ($string,$server) = @_;
1264     # $server contains biblioserver or authorities, depending on what we search on.
1265     #warn "querying : $string on $server";
1266     $server='biblioserver' unless $server;
1267
1268     # if we have a ", replace the content to discard temporarily any and/or/not inside
1269     my $commacontent;
1270     if ($string =~/"/) {
1271         $string =~ s/"(.*?)"/__X__/;
1272         $commacontent = $1;
1273                 warn "commacontent : $commacontent" if $DEBUG;
1274     }
1275     # split the query string in 3 parts : X AND Y means : $left="X", $operand="AND" and $right="Y"
1276     # then, call again NZanalyse with $left and $right
1277     # (recursive until we find a leaf (=> something without and/or/not)
1278     # delete repeated operator... Would then go in infinite loop
1279     while ($string =~s/( and| or| not| AND| OR| NOT)\1/$1/g){
1280     }
1281     #process parenthesis before.   
1282     if ($string =~ /^\s*\((.*)\)(( and | or | not | AND | OR | NOT )(.*))?/){
1283       my $left = $1;
1284 #       warn "left :".$left;   
1285       my $right = $4;
1286       my $operator = lc($3); # FIXME: and/or/not are operators, not operands
1287       my $leftresult = NZanalyse($left,$server);
1288       if ($operator) {
1289         my $rightresult = NZanalyse($right,$server);
1290         # OK, we have the results for right and left part of the query
1291         # depending of operand, intersect, union or exclude both lists
1292         # to get a result list
1293         if ($operator eq ' and ') {
1294             my @leftresult = split /;/, $leftresult;
1295 #             my @rightresult = split /;/,$leftresult;
1296             my $finalresult;
1297             # parse the left results, and if the biblionumber exist in the right result, save it in finalresult
1298             # the result is stored twice, to have the same weight for AND than OR.
1299             # example : TWO : 61,61,64,121 (two is twice in the biblio #61) / TOWER : 61,64,130
1300             # result : 61,61,61,61,64,64 for two AND tower : 61 has more weight than 64
1301             foreach (@leftresult) {
1302                 if ($rightresult =~ "$_;") {
1303                     $finalresult .= "$_;$_;";
1304                 }
1305             }
1306             return $finalresult;
1307         } elsif ($operator eq ' or ') {
1308             # just merge the 2 strings
1309             return $leftresult.$rightresult;
1310         } elsif ($operator eq ' not ') {
1311             my @leftresult = split /;/, $leftresult;
1312 #             my @rightresult = split /;/,$leftresult;
1313             my $finalresult;
1314             foreach (@leftresult) {
1315                 unless ($rightresult =~ "$_;") {
1316                     $finalresult .= "$_;";
1317                 }
1318             }
1319             return $finalresult;
1320         } else {
1321             # this error is impossible, because of the regexp that isolate the operand, but just in case...
1322             return $leftresult;
1323             exit;        
1324         }
1325       }   
1326     }  
1327     warn "string :".$string if $DEBUG;
1328     $string =~ /(.*?)( and | or | not | AND | OR | NOT )(.*)/;
1329     my $left = $1;   
1330     my $right = $3;
1331     my $operand = lc($2); # FIXME: and/or/not are operators, not operands
1332     # it's not a leaf, we have a and/or/not
1333     if ($operand) {
1334         # reintroduce comma content if needed
1335         $right =~ s/__X__/"$commacontent"/ if $commacontent;
1336         $left =~ s/__X__/"$commacontent"/ if $commacontent;
1337         warn "node : $left / $operand / $right\n" if $DEBUG;
1338         my $leftresult = NZanalyse($left,$server);
1339         my $rightresult = NZanalyse($right,$server);
1340         # OK, we have the results for right and left part of the query
1341         # depending of operand, intersect, union or exclude both lists
1342         # to get a result list
1343         if ($operand eq ' and ') {
1344             my @leftresult = split /;/, $leftresult;
1345 #             my @rightresult = split /;/,$leftresult;
1346             my $finalresult;
1347             # parse the left results, and if the biblionumber exist in the right result, save it in finalresult
1348             # the result is stored twice, to have the same weight for AND than OR.
1349             # example : TWO : 61,61,64,121 (two is twice in the biblio #61) / TOWER : 61,64,130
1350             # result : 61,61,61,61,64,64 for two AND tower : 61 has more weight than 64
1351             foreach (@leftresult) {
1352                 if ($rightresult =~ "$_;") {
1353                     $finalresult .= "$_;$_;";
1354                 }
1355             }
1356             return $finalresult;
1357         } elsif ($operand eq ' or ') {
1358             # just merge the 2 strings
1359             return $leftresult.$rightresult;
1360         } elsif ($operand eq ' not ') {
1361             my @leftresult = split /;/, $leftresult;
1362 #             my @rightresult = split /;/,$leftresult;
1363             my $finalresult;
1364             foreach (@leftresult) {
1365                 unless ($rightresult =~ "$_;") {
1366                     $finalresult .= "$_;";
1367                 }
1368             }
1369             return $finalresult;
1370         } else {
1371             # this error is impossible, because of the regexp that isolate the operand, but just in case...
1372             die "error : operand unknown : $operand for $string";
1373         }
1374     # it's a leaf, do the real SQL query and return the result
1375     } else {
1376         $string =~  s/__X__/"$commacontent"/ if $commacontent;
1377         $string =~ s/-|\.|\?|,|;|!|'|\(|\)|\[|\]|{|}|"|&|\+|\*|\// /g;
1378         warn "leaf : $string\n" if $DEBUG;
1379         # parse the string in in operator/operand/value again
1380         $string =~ /(.*)(>=|<=)(.*)/;
1381         my $left = $1;
1382         my $operator = $2;
1383         my $right = $3;
1384         unless ($operator) {
1385             $string =~ /(.*)(>|<|=)(.*)/;
1386             $left = $1;
1387             $operator = $2;
1388             $right = $3;
1389         }
1390         my $results;
1391         # strip adv, zebra keywords, currently not handled in nozebra: wrdl, ext, phr...
1392         $left =~ s/[ ,].*$//;
1393         # automatic replace for short operators
1394         $left='title' if $left =~ '^ti$';
1395         $left='author' if $left =~ '^au$';
1396         $left='publisher' if $left =~ '^pb$';
1397         $left='subject' if $left =~ '^su$';
1398         $left='koha-Auth-Number' if $left =~ '^an$';
1399         $left='keyword' if $left =~ '^kw$';
1400         if ($operator && $left  ne 'keyword' ) {
1401             #do a specific search
1402             my $dbh = C4::Context->dbh;
1403             $operator='LIKE' if $operator eq '=' and $right=~ /%/;
1404             my $sth = $dbh->prepare("SELECT biblionumbers,value FROM nozebra WHERE server=? AND indexname=? AND value $operator ?");
1405             warn "$left / $operator / $right\n";
1406             # split each word, query the DB and build the biblionumbers result
1407             #sanitizing leftpart      
1408             $left=~s/^\s+|\s+$//;
1409             my ($biblionumbers,$value);
1410             foreach (split / /,$right) {
1411                 next unless $_;
1412                 warn "EXECUTE : $server, $left, $_";
1413                 $sth->execute($server, $left, $_) or warn "execute failed: $!";
1414                 while (my ($line,$value) = $sth->fetchrow) {
1415                     # if we are dealing with a numeric value, use only numeric results (in case of >=, <=, > or <)
1416                     # otherwise, fill the result
1417                     $biblionumbers .= $line unless ($right =~ /\d/ && $value =~ /\D/);
1418 #                     warn "result : $value ". ($right =~ /\d/) . "==".(!$value =~ /\d/) ;#= $line";
1419                 }
1420                 # do a AND with existing list if there is one, otherwise, use the biblionumbers list as 1st result list
1421                 if ($results) {
1422                     my @leftresult = split /;/, $biblionumbers;
1423                     my $temp;
1424                     foreach my $entry (@leftresult) { # $_ contains biblionumber,title-weight
1425                         # remove weight at the end
1426                         my $cleaned = $entry;
1427                         $cleaned =~ s/-\d*$//;
1428                         # if the entry already in the hash, take it & increase weight
1429                          warn "===== $cleaned =====" if $DEBUG;
1430                         if ($results =~ "$cleaned") {
1431                             $temp .= "$entry;$entry;";
1432                              warn "INCLUDING $entry" if $DEBUG;
1433                         }
1434                     }
1435                     $results = $temp;
1436                 } else {
1437                     $results = $biblionumbers;
1438                 }
1439             }
1440         } else {
1441             #do a complete search (all indexes), if index='kw' do complete search too.
1442             my $dbh = C4::Context->dbh;
1443             my $sth = $dbh->prepare("SELECT biblionumbers FROM nozebra WHERE server=? AND value LIKE ?");
1444             # split each word, query the DB and build the biblionumbers result
1445             foreach (split / /,$string) {
1446                 next if C4::Context->stopwords->{uc($_)}; # skip if stopword
1447                 warn "search on all indexes on $_" if $DEBUG;
1448                 my $biblionumbers;
1449                 next unless $_;
1450                 $sth->execute($server, $_);
1451                 while (my $line = $sth->fetchrow) {
1452                     $biblionumbers .= $line;
1453                 }
1454                 # do a AND with existing list if there is one, otherwise, use the biblionumbers list as 1st result list
1455                 if ($results) {
1456                  warn "RES for $_ = $biblionumbers" if $DEBUG;
1457                     my @leftresult = split /;/, $biblionumbers;
1458                     my $temp;
1459                     foreach my $entry (@leftresult) { # $_ contains biblionumber,title-weight
1460                         # remove weight at the end
1461                         my $cleaned = $entry;
1462                         $cleaned =~ s/-\d*$//;
1463                         # if the entry already in the hash, take it & increase weight
1464                          warn "===== $cleaned =====" if $DEBUG;
1465                         if ($results =~ "$cleaned") {
1466                             $temp .= "$entry;$entry;";
1467                              warn "INCLUDING $entry" if $DEBUG;
1468                         }
1469                     }
1470                     $results = $temp;
1471                 } else {
1472                  warn "NEW RES for $_ = $biblionumbers" if $DEBUG;
1473                     $results = $biblionumbers;
1474                 }
1475             }
1476         }
1477          warn "return : $results for LEAF : $string" if $DEBUG;
1478         return $results;
1479     }
1480 }
1481
1482 =head2 NZorder
1483
1484   $finalresult = NZorder($biblionumbers, $ordering,$results_per_page,$offset);
1485   
1486   TODO :: Description
1487
1488 =cut
1489
1490
1491 sub NZorder {
1492     my ($biblionumbers, $ordering,$results_per_page,$offset) = @_;
1493     warn "biblionumbers = $biblionumbers and ordering = $ordering\n" if $DEBUG;
1494     # order title asc by default
1495 #     $ordering = '1=36 <i' unless $ordering;
1496     $results_per_page=20 unless $results_per_page;
1497     $offset = 0 unless $offset;
1498     my $dbh = C4::Context->dbh;
1499     #
1500     # order by POPULARITY
1501     #
1502     if ($ordering =~ /popularity/) {
1503         my %result;
1504         my %popularity;
1505         # popularity is not in MARC record, it's builded from a specific query
1506         my $sth = $dbh->prepare("select sum(issues) from items where biblionumber=?");
1507         foreach (split /;/,$biblionumbers) {
1508             my ($biblionumber,$title) = split /,/,$_;
1509             $result{$biblionumber}=GetMarcBiblio($biblionumber);
1510             $sth->execute($biblionumber);
1511             my $popularity= $sth->fetchrow ||0;
1512             # hint : the key is popularity.title because we can have
1513             # many results with the same popularity. In this cas, sub-ordering is done by title
1514             # we also have biblionumber to avoid bug for 2 biblios with the same title & popularity
1515             # (un-frequent, I agree, but we won't forget anything that way ;-)
1516             $popularity{sprintf("%10d",$popularity).$title.$biblionumber} = $biblionumber;
1517         }
1518         # sort the hash and return the same structure as GetRecords (Zebra querying)
1519         my $result_hash;
1520         my $numbers=0;
1521         if ($ordering eq 'popularity_dsc') { # sort popularity DESC
1522             foreach my $key (sort {$b cmp $a} (keys %popularity)) {
1523                 $result_hash->{'RECORDS'}[$numbers++] = $result{$popularity{$key}}->as_usmarc();
1524             }
1525         } else { # sort popularity ASC
1526             foreach my $key (sort (keys %popularity)) {
1527                 $result_hash->{'RECORDS'}[$numbers++] = $result{$popularity{$key}}->as_usmarc();
1528             }
1529         }
1530         my $finalresult=();
1531         $result_hash->{'hits'} = $numbers;
1532         $finalresult->{'biblioserver'} = $result_hash;
1533         return $finalresult;
1534     #
1535     # ORDER BY author
1536     #
1537     } elsif ($ordering =~/author/){
1538         my %result;
1539         foreach (split /;/,$biblionumbers) {
1540             my ($biblionumber,$title) = split /,/,$_;
1541             my $record=GetMarcBiblio($biblionumber);
1542             my $author;
1543             if (C4::Context->preference('marcflavour') eq 'UNIMARC') {
1544                 $author=$record->subfield('200','f');
1545                 $author=$record->subfield('700','a') unless $author;
1546             } else {
1547                 $author=$record->subfield('100','a');
1548             }
1549             # hint : the result is sorted by title.biblionumber because we can have X biblios with the same title
1550             # and we don't want to get only 1 result for each of them !!!
1551             $result{$author.$biblionumber}=$record;
1552         }
1553         # sort the hash and return the same structure as GetRecords (Zebra querying)
1554         my $result_hash;
1555         my $numbers=0;
1556         if ($ordering eq 'author_za') { # sort by author desc
1557             foreach my $key (sort { $b cmp $a } (keys %result)) {
1558                 $result_hash->{'RECORDS'}[$numbers++] = $result{$key}->as_usmarc();
1559             }
1560         } else { # sort by author ASC
1561             foreach my $key (sort (keys %result)) {
1562                 $result_hash->{'RECORDS'}[$numbers++] = $result{$key}->as_usmarc();
1563             }
1564         }
1565         my $finalresult=();
1566         $result_hash->{'hits'} = $numbers;
1567         $finalresult->{'biblioserver'} = $result_hash;
1568         return $finalresult;
1569     #
1570     # ORDER BY callnumber
1571     #
1572     } elsif ($ordering =~/callnumber/){
1573         my %result;
1574         foreach (split /;/,$biblionumbers) {
1575             my ($biblionumber,$title) = split /,/,$_;
1576             my $record=GetMarcBiblio($biblionumber);
1577             my $callnumber;
1578             my ($callnumber_tag,$callnumber_subfield)=GetMarcFromKohaField($dbh,'items.itemcallnumber');
1579             ($callnumber_tag,$callnumber_subfield)= GetMarcFromKohaField('biblioitems.callnumber') unless $callnumber_tag;
1580             if (C4::Context->preference('marcflavour') eq 'UNIMARC') {
1581                 $callnumber=$record->subfield('200','f');
1582             } else {
1583                 $callnumber=$record->subfield('100','a');
1584             }
1585             # hint : the result is sorted by title.biblionumber because we can have X biblios with the same title
1586             # and we don't want to get only 1 result for each of them !!!
1587             $result{$callnumber.$biblionumber}=$record;
1588         }
1589         # sort the hash and return the same structure as GetRecords (Zebra querying)
1590         my $result_hash;
1591         my $numbers=0;
1592         if ($ordering eq 'call_number_dsc') { # sort by title desc
1593             foreach my $key (sort { $b cmp $a } (keys %result)) {
1594                 $result_hash->{'RECORDS'}[$numbers++] = $result{$key}->as_usmarc();
1595             }
1596         } else { # sort by title ASC
1597             foreach my $key (sort { $a cmp $b } (keys %result)) {
1598                 $result_hash->{'RECORDS'}[$numbers++] = $result{$key}->as_usmarc();
1599             }
1600         }
1601         my $finalresult=();
1602         $result_hash->{'hits'} = $numbers;
1603         $finalresult->{'biblioserver'} = $result_hash;
1604         return $finalresult;
1605     } elsif ($ordering =~ /pubdate/){ #pub year
1606         my %result;
1607         foreach (split /;/,$biblionumbers) {
1608             my ($biblionumber,$title) = split /,/,$_;
1609             my $record=GetMarcBiblio($biblionumber);
1610             my ($publicationyear_tag,$publicationyear_subfield)=GetMarcFromKohaField('biblioitems.publicationyear','');
1611             my $publicationyear=$record->subfield($publicationyear_tag,$publicationyear_subfield);
1612             # hint : the result is sorted by title.biblionumber because we can have X biblios with the same title
1613             # and we don't want to get only 1 result for each of them !!!
1614             $result{$publicationyear.$biblionumber}=$record;
1615         }
1616         # sort the hash and return the same structure as GetRecords (Zebra querying)
1617         my $result_hash;
1618         my $numbers=0;
1619         if ($ordering eq 'pubdate_dsc') { # sort by pubyear desc
1620             foreach my $key (sort { $b cmp $a } (keys %result)) {
1621                 $result_hash->{'RECORDS'}[$numbers++] = $result{$key}->as_usmarc();
1622             }
1623         } else { # sort by pub year ASC
1624             foreach my $key (sort (keys %result)) {
1625                 $result_hash->{'RECORDS'}[$numbers++] = $result{$key}->as_usmarc();
1626             }
1627         }
1628         my $finalresult=();
1629         $result_hash->{'hits'} = $numbers;
1630         $finalresult->{'biblioserver'} = $result_hash;
1631         return $finalresult;
1632     #
1633     # ORDER BY title
1634     #
1635     } elsif ($ordering =~ /title/) { 
1636         # the title is in the biblionumbers string, so we just need to build a hash, sort it and return
1637         my %result;
1638         foreach (split /;/,$biblionumbers) {
1639             my ($biblionumber,$title) = split /,/,$_;
1640             # hint : the result is sorted by title.biblionumber because we can have X biblios with the same title
1641             # and we don't want to get only 1 result for each of them !!!
1642             # hint & speed improvement : we can order without reading the record
1643             # so order, and read records only for the requested page !
1644             $result{$title.$biblionumber}=$biblionumber;
1645         }
1646         # sort the hash and return the same structure as GetRecords (Zebra querying)
1647         my $result_hash;
1648         my $numbers=0;
1649         if ($ordering eq 'title_az') { # sort by title desc
1650             foreach my $key (sort (keys %result)) {
1651                 $result_hash->{'RECORDS'}[$numbers++] = $result{$key};
1652             }
1653         } else { # sort by title ASC
1654             foreach my $key (sort { $b cmp $a } (keys %result)) {
1655                 $result_hash->{'RECORDS'}[$numbers++] = $result{$key};
1656             }
1657         }
1658         # limit the $results_per_page to result size if it's more
1659         $results_per_page = $numbers-1 if $numbers < $results_per_page;
1660         # for the requested page, replace biblionumber by the complete record
1661         # speed improvement : avoid reading too much things
1662         for (my $counter=$offset;$counter<=$offset+$results_per_page;$counter++) {
1663             $result_hash->{'RECORDS'}[$counter] = GetMarcBiblio($result_hash->{'RECORDS'}[$counter])->as_usmarc;
1664         }
1665         my $finalresult=();
1666         $result_hash->{'hits'} = $numbers;
1667         $finalresult->{'biblioserver'} = $result_hash;
1668         return $finalresult;
1669     } else {
1670     #
1671     # order by ranking
1672     #
1673         # we need 2 hashes to order by ranking : the 1st one to count the ranking, the 2nd to order by ranking
1674         my %result;
1675         my %count_ranking;
1676         foreach (split /;/,$biblionumbers) {
1677             my ($biblionumber,$title) = split /,/,$_;
1678             $title =~ /(.*)-(\d)/;
1679             # get weight 
1680             my $ranking =$2;
1681             # note that we + the ranking because ranking is calculated on weight of EACH term requested.
1682             # if we ask for "two towers", and "two" has weight 2 in biblio N, and "towers" has weight 4 in biblio N
1683             # biblio N has ranking = 6
1684             $count_ranking{$biblionumber} += $ranking;
1685         }
1686         # build the result by "inverting" the count_ranking hash
1687         # 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
1688 #         warn "counting";
1689         foreach (keys %count_ranking) {
1690             $result{sprintf("%10d",$count_ranking{$_}).'-'.$_} = $_;
1691         }
1692         # sort the hash and return the same structure as GetRecords (Zebra querying)
1693         my $result_hash;
1694         my $numbers=0;
1695             foreach my $key (sort {$b cmp $a} (keys %result)) {
1696                 $result_hash->{'RECORDS'}[$numbers++] = $result{$key};
1697             }
1698         # limit the $results_per_page to result size if it's more
1699         $results_per_page = $numbers-1 if $numbers < $results_per_page;
1700         # for the requested page, replace biblionumber by the complete record
1701         # speed improvement : avoid reading too much things
1702         for (my $counter=$offset;$counter<=$offset+$results_per_page;$counter++) {
1703             $result_hash->{'RECORDS'}[$counter] = GetMarcBiblio($result_hash->{'RECORDS'}[$counter])->as_usmarc if $result_hash->{'RECORDS'}[$counter];
1704         }
1705         my $finalresult=();
1706         $result_hash->{'hits'} = $numbers;
1707         $finalresult->{'biblioserver'} = $result_hash;
1708         return $finalresult;
1709     }
1710 }
1711 =head2 ModBiblios
1712
1713 ($countchanged,$listunchanged) = ModBiblios($listbiblios, $tagsubfield,$initvalue,$targetvalue,$test);
1714
1715 this function changes all the values $initvalue in subfield $tag$subfield in any record in $listbiblios
1716 test parameter if set donot perform change to records in database.
1717
1718 =over 2
1719
1720 =item C<input arg:>
1721
1722     * $listbiblios is an array ref to marcrecords to be changed
1723     * $tagsubfield is the reference of the subfield to change.
1724     * $initvalue is the value to search the record for
1725     * $targetvalue is the value to set the subfield to
1726     * $test is to be set only not to perform changes in database.
1727
1728 =item C<Output arg:>
1729     * $countchanged counts all the changes performed.
1730     * $listunchanged contains the list of all the biblionumbers of records unchanged.
1731
1732 =item C<usage in the script:>
1733
1734 =back
1735
1736 my ($countchanged, $listunchanged) = EditBiblios($results->{RECORD}, $tagsubfield,$initvalue,$targetvalue);;
1737 #If one wants to display unchanged records, you should get biblios foreach @$listunchanged 
1738 $template->param(countchanged => $countchanged, loopunchanged=>$listunchanged);
1739
1740 =cut
1741
1742 sub ModBiblios{
1743   my ($listbiblios,$tagsubfield,$initvalue,$targetvalue,$test)=@_;
1744   my $countmatched;
1745   my @unmatched;
1746   my ($tag,$subfield)=($1,$2) if ($tagsubfield=~/^(\d{1,3})([a-z0-9A-Z@])?$/); 
1747   if ((length($tag)<3)&& $subfield=~/0-9/){
1748     $tag=$tag.$subfield;
1749     undef $subfield;
1750   } 
1751   my ($bntag,$bnsubf) = GetMarcFromKohaField('biblio.biblionumber');
1752   my ($itemtag,$itemsubf) = GetMarcFromKohaField('items.itemnumber');
1753   foreach my $usmarc (@$listbiblios){
1754     my $record; 
1755     $record=eval{MARC::Record->new_from_usmarc($usmarc)};
1756     my $biblionumber;
1757     if ($@){
1758       # usmarc is not a valid usmarc May be a biblionumber
1759       if ($tag eq $itemtag){
1760         my $bib=GetBiblioFromItemNumber($usmarc);   
1761         $record=GetMarcItem($bib->{'biblionumber'},$usmarc) ;   
1762         $biblionumber=$bib->{'biblionumber'};
1763       } else {   
1764         $record=GetMarcBiblio($usmarc);   
1765         $biblionumber=$usmarc;
1766       }   
1767     }  else {
1768       if ($bntag >= 010){
1769         $biblionumber = $record->subfield($bntag,$bnsubf);
1770       }else {
1771         $biblionumber=$record->field($bntag)->data;
1772       }
1773     }  
1774     #GetBiblionumber is to be written.
1775     #Could be replaced by TransformMarcToKoha (But Would be longer)
1776     if ($record->field($tag)){
1777       my $modify=0;  
1778       foreach my $field ($record->field($tag)){
1779         if ($subfield){
1780           if ($field->delete_subfield('code' =>$subfield,'match'=>qr($initvalue))){
1781             $countmatched++;
1782             $modify=1;      
1783             $field->update($subfield,$targetvalue) if ($targetvalue);
1784           }
1785         } else {
1786           if ($tag >= 010){
1787             if ($field->delete_field($field)){
1788               $countmatched++;
1789               $modify=1;      
1790             }
1791           } else {
1792             $field->data=$targetvalue if ($field->data=~qr($initvalue));
1793           }     
1794         }    
1795       }
1796 #       warn $record->as_formatted;
1797       if ($modify){
1798         ModBiblio($record,$biblionumber,GetFrameworkCode($biblionumber)) unless ($test);
1799       } else {
1800         push @unmatched, $biblionumber;   
1801       }      
1802     } else {
1803       push @unmatched, $biblionumber;
1804     }
1805   }
1806   return ($countmatched,\@unmatched);
1807 }
1808
1809 END { }    # module clean-up code here (global destructor)
1810
1811 1;
1812 __END__
1813
1814 =head1 AUTHOR
1815
1816 Koha Developement team <info@koha.org>
1817
1818 =cut