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