fix for bug 1208, exact barcode search
[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=1;
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,     $simple_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 = $simple_query;
288         }
289
290                 $query_to_use = $simple_query if $scan;
291
292         # check if we've got a query_type defined
293         eval {
294             if ($query_type)
295             {
296                 if ( $query_type =~ /^ccl/ ) {
297                     $query_to_use =~
298                       s/\:/\=/g;    # change : to = last minute (FIXME)
299
300                     #                 warn "CCL : $query_to_use";
301                     $results[$i] =
302                       $zconns[$i]->search(
303                         new ZOOM::Query::CCL2RPN( $query_to_use, $zconns[$i] )
304                       );
305                 }
306                 elsif ( $query_type =~ /^cql/ ) {
307
308                     #                 warn "CQL : $query_to_use";
309                     $results[$i] =
310                       $zconns[$i]->search(
311                         new ZOOM::Query::CQL( $query_to_use, $zconns[$i] ) );
312                 }
313                 elsif ( $query_type =~ /^pqf/ ) {
314
315                     #                 warn "PQF : $query_to_use";
316                     $results[$i] =
317                       $zconns[$i]->search(
318                         new ZOOM::Query::PQF( $query_to_use, $zconns[$i] ) );
319                 }
320             }
321             else {
322                 if ($scan) {
323                      #               warn "preparing to scan:$query_to_use";
324                     $results[$i] =
325                       $zconns[$i]->scan(
326                         new ZOOM::Query::CCL2RPN( $query_to_use, $zconns[$i] )
327                       );
328                 }
329                 else {
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                  # here we create a minimal MARC record and hand it off to the
413                  # template just like a normal result ... perhaps not ideal, but
414                  # it works for now
415                         my $tmprecord = MARC::Record->new();
416                         $tmprecord->encoding('UTF-8');
417                         my $tmptitle;
418
419                         # srote the minimal record in author/title (depending on MARC flavour)
420                         if ( C4::Context->preference("marcflavour") eq
421                             "UNIMARC" )
422                         {
423                             $tmptitle = MARC::Field->new(
424                                 '200', ' ', ' ',
425                                 a => $term,
426                                 f => $occ
427                             );
428                         }
429                         else {
430                             $tmptitle = MARC::Field->new(
431                                 '245', ' ', ' ',
432                                 a => $term,
433                                 b => $occ
434                             );
435                         }
436                         $tmprecord->append_fields($tmptitle);
437                         $results_hash->{'RECORDS'}[$j] =
438                           $tmprecord->as_usmarc();
439                     }
440                     else {
441                         $record = $results[ $i - 1 ]->record($j)->raw();
442
443                         #warn "RECORD $j:".$record;
444                         $results_hash->{'RECORDS'}[$j] =
445                           $record;    # making a reference to a hash
446                                       # Fill the facets while we're looping
447                         $facet_record = MARC::Record->new_from_usmarc($record);
448
449                         #warn $servers[$i-1].$facet_record->title();
450                         for ( my $k = 0 ; $k <= @$facets ; $k++ ) {
451                             if ( $facets->[$k] ) {
452                                 my @fields;
453                                 for my $tag ( @{ $facets->[$k]->{'tags'} } ) {
454                                     push @fields, $facet_record->field($tag);
455                                 }
456                                 for my $field (@fields) {
457                                     my @subfields = $field->subfields();
458                                     for my $subfield (@subfields) {
459                                         my ( $code, $data ) = @$subfield;
460                                         if ( $code eq
461                                             $facets->[$k]->{'subfield'} )
462                                         {
463                                             $facets_counter->{ $facets->[$k]
464                                                   ->{'link_value'} }->{$data}++;
465                                         }
466                                     }
467                                 }
468                                 $facets_info->{ $facets->[$k]->{'link_value'} }
469                                   ->{'label_value'} =
470                                   $facets->[$k]->{'label_value'};
471                                 $facets_info->{ $facets->[$k]->{'link_value'} }
472                                   ->{'expanded'} = $facets->[$k]->{'expanded'};
473                             }
474                         }
475                     }
476                 }
477                 $results_hashref->{ $servers[ $i - 1 ] } = $results_hash;
478             }
479
480             #print "connection ", $i-1, ": $size hits";
481             #print $results[$i-1]->record(0)->render() if $size > 0;
482             # BUILD FACETS
483             for my $link_value (
484                 sort { $facets_counter->{$b} <=> $facets_counter->{$a} }
485                 keys %$facets_counter
486               )
487             {
488                 my $expandable;
489                 my $number_of_facets;
490                 my @this_facets_array;
491                 for my $one_facet (
492                     sort {
493                         $facets_counter->{$link_value}
494                           ->{$b} <=> $facets_counter->{$link_value}->{$a}
495                     } keys %{ $facets_counter->{$link_value} }
496                   )
497                 {
498                     $number_of_facets++;
499                     if (   ( $number_of_facets < 6 )
500                         || ( $expanded_facet eq $link_value )
501                         || ( $facets_info->{$link_value}->{'expanded'} ) )
502                     {
503
504                        # sanitize the link value ), ( will cause errors with CCL
505                         my $facet_link_value = $one_facet;
506                         $facet_link_value =~ s/(\(|\))/ /g;
507
508                         # fix the length that will display in the label
509                         my $facet_label_value = $one_facet;
510                         $facet_label_value = substr( $one_facet, 0, 20 ) . "..."
511                           unless length($facet_label_value) <= 20;
512
513                        # well, if it's a branch, label by the name, not the code
514                         if ( $link_value =~ /branch/ ) {
515                             $facet_label_value =
516                               $branches->{$one_facet}->{'branchname'};
517                         }
518
519                  # but we're down with the whole label being in the link's title
520                         my $facet_title_value = $one_facet;
521
522                         push @this_facets_array,
523                           (
524                             {
525                                 facet_count =>
526                                   $facets_counter->{$link_value}->{$one_facet},
527                                 facet_label_value => $facet_label_value,
528                                 facet_title_value => $facet_title_value,
529                                 facet_link_value  => $facet_link_value,
530                                 type_link_value   => $link_value,
531                             },
532                           );
533                     }
534                 }
535                 unless ( $facets_info->{$link_value}->{'expanded'} ) {
536                     $expandable = 1
537                       if ( ( $number_of_facets > 6 )
538                         && ( $expanded_facet ne $link_value ) );
539                 }
540                 push @facets_loop,
541                   (
542                     {
543                         type_link_value => $link_value,
544                         type_id         => $link_value . "_id",
545                         type_label      =>
546                           $facets_info->{$link_value}->{'label_value'},
547                         facets     => \@this_facets_array,
548                         expandable => $expandable,
549                         expand     => $link_value,
550                     }
551                   );
552             }
553         }
554     }
555     return ( undef, $results_hashref, \@facets_loop );
556 }
557
558 # STOPWORDS
559 sub _remove_stopwords {
560     my ($operand,$index) = @_;
561         my @stopwords_removed;
562     # phrase and exact-qualified indexes shouldn'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'd get "çon" and wouldn't find anything...
568         foreach (keys %{C4::Context->stopwords}) {
569             next if ($_ =~/(and|or|not)/); # don't remove operators
570                         if ($operand =~ /(\P{IsAlpha}$_\P{IsAlpha}|^$_\P{IsAlpha}|\P{IsAlpha}$_$)/) {
571                 $operand=~ s/\P{IsAlpha}$_\P{IsAlpha}/ /gi;
572                 $operand=~ s/^$_\P{IsAlpha}/ /gi;
573                 $operand=~ s/\P{IsAlpha}$_$/ /gi;
574                                 push @stopwords_removed, $_;
575                         }
576         }
577     }
578     return ($operand, \@stopwords_removed);
579 }
580
581 # TRUNCATION
582 sub _detect_truncation {
583     my ($operand,$index) = @_;
584     my (@nontruncated,@righttruncated,@lefttruncated,@rightlefttruncated,@regexpr);
585     $operand =~s/^ //g;
586     my @wordlist= split (/\s/,$operand);
587     foreach my $word (@wordlist){
588         if ($word=~s/^\*([^\*]+)\*$/$1/){
589             push @rightlefttruncated,$word;
590         } 
591         elsif($word=~s/^\*([^\*]+)$/$1/){
592             push @lefttruncated,$word;
593         } 
594         elsif ($word=~s/^([^\*]+)\*$/$1/){
595             push @righttruncated,$word;
596         } 
597         elsif (index($word,"*")<0){
598             push @nontruncated,$word;
599         }
600         else {
601             push @regexpr,$word;
602         }
603     }
604     return (\@nontruncated,\@righttruncated,\@lefttruncated,\@rightlefttruncated,\@regexpr);
605 }
606
607 sub _build_stemmed_operand {
608     my ($operand) = @_;
609     my $stemmed_operand;
610     # FIXME: the locale should be set based on the user's language and/or search choice
611     my $stemmer = Lingua::Stem->new( -locale => 'EN-US' );
612     # FIXME: these should be stored in the db so the librarian can modify the behavior
613     $stemmer->add_exceptions(
614             {
615                 'and' => 'and',
616                 'or'  => 'or',
617                 'not' => 'not',
618             }
619                     
620         );
621     my @words = split( / /, $operand );
622     my $stems = $stemmer->stem(@words);
623     for my $stem (@$stems) {
624             $stemmed_operand .= "$stem";
625             $stemmed_operand .= "?" unless ( $stem =~ /(and$|or$|not$)/ ) || ( length($stem) < 3 );
626             $stemmed_operand .= " ";
627     }
628     #warn "STEMMED OPERAND: $stemmed_operand";
629     return $stemmed_operand;
630 }
631
632 sub _build_weighted_query {
633     # FIELD WEIGHTING - This is largely experimental stuff. What I'm committing works
634     # pretty well but will work much better when we have an actual query parser
635     my ($operand,$stemmed_operand,$index) = @_;
636     my $stemming      = C4::Context->preference("QueryStemming")     || 0;
637     my $weight_fields = C4::Context->preference("QueryWeightFields") || 0;
638     my $fuzzy_enabled = C4::Context->preference("QueryFuzzy") || 0;
639
640     my $weighted_query .= "(rk=(";     # Specifies that we're applying rank
641
642     # Keyword, or, no index specified
643     if ( ( $index eq 'kw' ) || ( !$index ) ) {
644         $weighted_query .= "Title-cover,ext,r1=\"$operand\"";       # exact title-cover
645         $weighted_query .= " or ti,ext,r2=\"$operand\"";            # exact title
646         $weighted_query .= " or ti,phr,r3=\"$operand\"";            # phrase title
647        #$weighted_query .= " or any,ext,r4=$operand";               # exact any
648        #$weighted_query .=" or kw,wrdl,r5=\"$operand\"";            # word list any
649         $weighted_query .= " or wrd,fuzzy,r8=\"$operand\"" if $fuzzy_enabled; # add fuzzy, word list
650         $weighted_query .= " or wrd,right-Truncation,r9=\"$stemmed_operand\"" if ($stemming and $stemmed_operand); # add stemming, right truncation
651        # embedded sorting: 0 a-z; 1 z-a
652        # $weighted_query .= ") or (sort1,aut=1";
653     }
654         elsif ( $index eq 'bc' ) {
655                 $weighted_query .= "bc=\"$operand\"";
656         }
657     # if the index already has more than one qualifier, just wrap the operand 
658     # in quotes and pass it back
659     elsif ($index =~ ',') {
660         $weighted_query .=" $index=\"$operand\"";
661     }
662     #TODO: build better cases based on specific search indexes
663     else {
664        $weighted_query .= " $index,ext,r1=\"$operand\"";            # exact index
665        #$weighted_query .= " or (title-sort-az=0 or $index,startswithnt,st-word,r3=$operand #)";
666        $weighted_query .= " or $index,phr,r3=\"$operand\"";         # phrase index
667        $weighted_query .= " or $index,rt,wrd,r3=\"$operand\"";      # word list index
668     }
669     $weighted_query .= "))";    # close rank specification
670     return $weighted_query;
671 }
672
673 # build the query itself
674 sub buildQuery {
675     my ( $operators, $operands, $indexes, $limits, $sort_by ) = @_;
676
677     my @operators = @$operators if $operators;
678     my @indexes   = @$indexes   if $indexes;
679     my @operands  = @$operands  if $operands;
680     my @limits    = @$limits    if $limits;
681     my @sort_by   = @$sort_by   if $sort_by;
682
683     my $stemming      = C4::Context->preference("QueryStemming")                || 0;
684         my $auto_truncation = C4::Context->preference("QueryAutoTruncate")              || 0;
685     my $weight_fields = C4::Context->preference("QueryWeightFields")            || 0;
686     my $fuzzy_enabled = C4::Context->preference("QueryFuzzy")                           || 0;
687         my $remove_stopwords = C4::Context->preference("QueryRemoveStopwords")  || 0;
688
689     my $query = $operands[0];
690         my $simple_query = $operands[0];
691         my $query_cgi;
692         my $query_desc;
693         my $query_type;
694
695         my $limit;
696         my $limit_cgi;
697         my $limit_desc;
698
699         my $stopwords_removed;
700
701         # for handling ccl, cql, pqf queries in diagnostic mode, skip the rest of the steps
702         # DIAGNOSTIC ONLY!!
703     if ( $query =~ /^ccl=/ ) {
704         return ( undef, $', $', $', $', '', '', '', '', 'ccl' );
705     }
706     if ( $query =~ /^cql=/ ) {
707         return ( undef, $', $', $', $', '', '', '', '', 'cql' );
708     }
709     if ( $query =~ /^pqf=/ ) {
710         return ( undef, $', $', $', $', '', '', '', '', 'pqf' );
711     }
712
713         # pass nested queries directly
714     if ( $query =~ /(\(|\))/ ) {
715         return ( undef, $query, $simple_query, $query_cgi, $query, $limit, $limit_cgi, $limit_desc, $stopwords_removed, 'ccl' );
716     }
717
718 # form-based queries are limited to non-nested at a specific depth, so we can easily
719 # modify the incoming query operands and indexes to do stemming and field weighting
720 # Once we do so, we'll end up with a value in $query, just like if we had an
721 # incoming $query from the user
722     else {
723         $query = ""; # clear it out so we can populate properly with field-weighted stemmed query
724         my $previous_operand;    # a flag used to keep track if there was a previous query
725                                 # if there was, we can apply the current operator
726         # for every operand
727         for ( my $i = 0 ; $i <= @operands ; $i++ ) {
728
729             # COMBINE OPERANDS, INDEXES AND OPERATORS
730             if ( $operands[$i] ) {
731
732                                 # a flag to determine whether or not to add the index to the query
733                                 my $indexes_set;
734                                 # if the user is sophisticated enough to specify an index, turn off some defaults
735                                 if ($operands[$i] =~ /(:|=)/) {
736                                         $weight_fields = 0;
737                                         $stemming = 0;
738                                         $remove_stopwords = 0;
739                                 }
740                 my $operand = $operands[$i];
741                 my $index   = $indexes[$i];
742
743                                 # some helpful index modifs
744                 my $index_plus = "$index:" if $index;
745                 my $index_plus_comma="$index," if $index;
746
747                 # Remove Stopwords
748                                 if ($remove_stopwords) {
749                 ($operand, $stopwords_removed) = _remove_stopwords($operand,$index);
750                         warn "OPERAND w/out STOPWORDS: >$operand<" if $DEBUG;
751                                         warn "REMOVED STOPWORDS: @$stopwords_removed" if ($stopwords_removed && $DEBUG);
752                                 }
753
754                 # Detect Truncation
755                 my ($nontruncated,$righttruncated,$lefttruncated,$rightlefttruncated,$regexpr);
756                 my $truncated_operand;
757                 ($nontruncated,$righttruncated,$lefttruncated,$rightlefttruncated,$regexpr) = _detect_truncation($operand,$index);
758                 warn "TRUNCATION: NON:>@$nontruncated< RIGHT:>@$righttruncated< LEFT:>@$lefttruncated< RIGHTLEFT:>@$rightlefttruncated< REGEX:>@$regexpr<" if $DEBUG;
759
760                 # Apply Truncation
761                 if (scalar(@$righttruncated)+scalar(@$lefttruncated)+scalar(@$rightlefttruncated)>0){
762                                         # don't field weight or add the index to the query, we do it here
763                     $indexes_set = 1;
764                     undef $weight_fields;
765                     my $previous_truncation_operand;
766                     if (scalar(@$nontruncated)>0) {
767                         $truncated_operand.= "$index_plus @$nontruncated ";
768                         $previous_truncation_operand = 1;
769                     }
770                     if (scalar(@$righttruncated)>0){
771                         $truncated_operand .= "and " if $previous_truncation_operand;
772                         $truncated_operand .= "$index_plus_comma"."rtrn:@$righttruncated ";
773                         $previous_truncation_operand = 1;
774                     }
775                     if (scalar(@$lefttruncated)>0){
776                         $truncated_operand .= "and " if $previous_truncation_operand;
777                         $truncated_operand .= "$index_plus_comma"."ltrn:@$lefttruncated ";
778                         $previous_truncation_operand = 1;
779                     }
780                     if (scalar(@$rightlefttruncated)>0){
781                         $truncated_operand .= "and " if $previous_truncation_operand;
782                         $truncated_operand .= "$index_plus_comma"."rltrn:@$rightlefttruncated ";
783                         $previous_truncation_operand = 1;
784                     }
785                 }
786                 $operand = $truncated_operand if $truncated_operand;
787                 warn "TRUNCATED OPERAND: >$truncated_operand<" if $DEBUG;
788
789                 # Handle Stemming
790                 my $stemmed_operand;
791                 $stemmed_operand = _build_stemmed_operand($operand) if $stemming;
792                 warn "STEMMED OPERAND: >$stemmed_operand<" if $DEBUG;
793
794                 # Handle Field Weighting
795                 my $weighted_operand;
796                 $weighted_operand = _build_weighted_query($operand,$stemmed_operand,$index) if $weight_fields;
797                 warn "FIELD WEIGHTED OPERAND: >$weighted_operand<" if $DEBUG;
798                 $operand = $weighted_operand if $weight_fields;
799                 $indexes_set = 1 if $weight_fields;
800
801                 # If there's a previous operand, we need to add an operator
802                 if ($previous_operand) {
803
804                     # user-specified operator
805                     if ( $operators[$i-1] ) {
806                         $query .= " $operators[$i-1] ";
807                         $query .= " $index_plus " unless $indexes_set;
808                         $query .= " $operand";
809                                                 $query_cgi .="&op=$operators[$i-1]";
810                                                 $query_cgi .="&idx=$index" if $index;
811                                                 $query_cgi .="&q=$operands[$i]" if $operands[$i];
812                                                 $query_desc .=" $operators[$i-1] $index_plus $operands[$i]";
813                     }
814
815                     # the default operator is and
816                     else {
817                         $query .= " and ";
818                         $query .= "$index_plus " unless $indexes_set;
819                         $query .= "$operand";
820                                                 $query_cgi .="&op=and&idx=$index" if $index;
821                                                 $query_cgi .="&q=$operands[$i]" if $operands[$i];
822                         $query_desc .= " and $index_plus $operands[$i]";
823                     }
824                 }
825
826                                 # there isn't a pervious operand, don't need an operator
827                 else { 
828                                         # field-weighted queries already have indexes set
829                                         $query .=" $index_plus " unless $indexes_set;
830                                         $query .= $operand;
831                                         $query_desc .= " $index_plus $operands[$i]";
832                                         $query_cgi.="&idx=$index" if $index;
833                                         $query_cgi.="&q=$operands[$i]" if $operands[$i];
834
835                     $previous_operand = 1;
836                 }
837             }    #/if $operands
838         }    # /for
839     }
840     warn "QUERY BEFORE LIMITS: >$query<" if $DEBUG;
841
842     # add limits
843         my $group_OR_limits;
844         my $availability_limit;
845     foreach my $this_limit (@limits) {
846         if ( $this_limit =~ /available/ ) {
847                         # available is defined as (items.notloan is NULL) and (items.itemlost > 0 or NULL) (last clause handles NULL values for lost in zebra)
848                         $availability_limit .="( ( allrecords,AlwaysMatches='' not onloan,AlwaysMatches='') and ((lost,st-numeric gt 0) or ( allrecords,AlwaysMatches='' not lost,AlwaysMatches='')) )";
849                         $limit_cgi .= "&limit=available";
850                         $limit_desc .="";
851         }
852
853                 # these are treated as OR
854         elsif ( $this_limit =~ /mc/ ) {
855             $group_OR_limits .= " or " if $group_OR_limits;
856                         $limit_desc .=" or " if $group_OR_limits;
857                         $group_OR_limits .= "$this_limit";
858                         $limit_cgi .="&limit=$this_limit";
859                         $limit_desc .= "$this_limit";
860         }
861
862                 # regular old limits
863                 else {
864                         $limit .= " and " if $limit || $query;
865                         $limit .= "$this_limit";
866                         $limit_cgi .="&limit=$this_limit";
867                         $limit_desc .=" and $this_limit";
868                 }
869     }
870         if ($group_OR_limits) {
871                 $limit.=" and " if ($query || $limit );
872                 $limit.="($group_OR_limits)";
873         }
874         if ($availability_limit) {
875                 $limit.=" not " if ($query || $limit );
876                 $limit.="$availability_limit";
877         }
878         # normalize the strings
879         for ($query, $query_desc, $limit, $limit_desc) {
880                 $_ =~ s/  / /g;    # remove extra spaces
881         $_ =~ s/^ //g;     # remove any beginning spaces
882                 $_ =~ s/ $//g;     # remove any ending spaces
883         $_ =~ s/==/=/g;    # remove double == from query
884
885         }
886         $query =~ s/:/=/g;
887         $limit =~ s/:/=/g;
888         $query_cgi =~ s/^&//;
889
890         # append the limit to the query
891         $query .= " ".$limit;
892
893     warn "QUERY:".$query if $DEBUG;
894         warn "QUERY CGI:".$query_cgi if $DEBUG;
895     warn "QUERY DESC:".$query_desc if $DEBUG;
896     warn "LIMIT:".$limit if $DEBUG;
897     warn "LIMIT CGI:".$limit_cgi if $DEBUG;
898     warn "LIMIT DESC:".$limit_desc if $DEBUG;
899
900         return ( undef, $query,$simple_query,$query_cgi,$query_desc,$limit,$limit_cgi,$limit_desc,$stopwords_removed,$query_type );
901 }
902
903 # IMO this subroutine is pretty messy still -- it's responsible for
904 # building the HTML output for the template
905 sub searchResults {
906     my ( $searchdesc, $hits, $results_per_page, $offset, @marcresults ) = @_;
907
908     my $dbh = C4::Context->dbh;
909     my $toggle;
910     my $even = 1;
911     my @newresults;
912     my $span_terms_hashref;
913     for my $span_term ( split( / /, $searchdesc ) ) {
914         $span_term =~ s/(.*=|\)|\(|\+|\.)//g;
915         $span_terms_hashref->{$span_term}++;
916     }
917
918     #Build brancnames hash
919     #find branchname
920     #get branch information.....
921     my %branches;
922     my $bsth =
923       $dbh->prepare("SELECT branchcode,branchname FROM branches")
924       ;    # FIXME : use C4::Koha::GetBranches
925     $bsth->execute();
926     while ( my $bdata = $bsth->fetchrow_hashref ) {
927         $branches{ $bdata->{'branchcode'} } = $bdata->{'branchname'};
928     }
929
930     #Build itemtype hash
931     #find itemtype & itemtype image
932     my %itemtypes;
933     $bsth =
934       $dbh->prepare("SELECT itemtype,description,imageurl,summary,notforloan FROM itemtypes");
935     $bsth->execute();
936     while ( my $bdata = $bsth->fetchrow_hashref ) {
937         $itemtypes{ $bdata->{'itemtype'} }->{description} =
938           $bdata->{'description'};
939         $itemtypes{ $bdata->{'itemtype'} }->{imageurl} = $bdata->{'imageurl'};
940         $itemtypes{ $bdata->{'itemtype'} }->{summary} = $bdata->{'summary'};
941         $itemtypes{ $bdata->{'itemtype'} }->{notforloan} = $bdata->{'notforloan'};
942     }
943
944     #search item field code
945     my $sth =
946       $dbh->prepare(
947 "select tagfield from marc_subfield_structure where kohafield like 'items.itemnumber'"
948       );
949     $sth->execute;
950     my ($itemtag) = $sth->fetchrow;
951
952     ## find column names of items related to MARC
953     my $sth2 = $dbh->prepare("SHOW COLUMNS from items");
954     $sth2->execute;
955     my %subfieldstosearch;
956     while ( ( my $column ) = $sth2->fetchrow ) {
957         my ( $tagfield, $tagsubfield ) =
958           &GetMarcFromKohaField( "items." . $column, "" );
959         $subfieldstosearch{$column} = $tagsubfield;
960     }
961     my $times;
962
963     if ( $hits && $offset + $results_per_page <= $hits ) {
964         $times = $offset + $results_per_page;
965     }
966     else {
967         $times = $hits;
968     }
969
970     for ( my $i = $offset ; $i <= $times - 1 ; $i++ ) {
971         my $marcrecord;
972         $marcrecord = MARC::File::USMARC::decode( $marcresults[$i] );
973         my $oldbiblio = TransformMarcToKoha( $dbh, $marcrecord, '' );
974                 $oldbiblio->{result_number} = $i+1;
975         # add image url if there is one
976         if ( $itemtypes{ $oldbiblio->{itemtype} }->{imageurl} =~ /^http:/ ) {
977             $oldbiblio->{imageurl} =
978               $itemtypes{ $oldbiblio->{itemtype} }->{imageurl};
979             $oldbiblio->{description} =
980               $itemtypes{ $oldbiblio->{itemtype} }->{description};
981         }
982         else {
983             $oldbiblio->{imageurl} =
984               getitemtypeimagesrc() . "/"
985               . $itemtypes{ $oldbiblio->{itemtype} }->{imageurl}
986               if ( $itemtypes{ $oldbiblio->{itemtype} }->{imageurl} );
987             $oldbiblio->{description} =
988               $itemtypes{ $oldbiblio->{itemtype} }->{description};
989         }
990         #
991         # build summary if there is one (the summary is defined in itemtypes table
992         #
993         if ($itemtypes{ $oldbiblio->{itemtype} }->{summary}) {
994             my $summary = $itemtypes{ $oldbiblio->{itemtype} }->{summary};
995             my @fields = $marcrecord->fields();
996             foreach my $field (@fields) {
997                 my $tag = $field->tag();
998                 my $tagvalue = $field->as_string();
999                 $summary =~ s/\[(.?.?.?.?)$tag\*(.*?)]/$1$tagvalue$2\[$1$tag$2]/g;
1000                 unless ($tag<10) {
1001                     my @subf = $field->subfields;
1002                     for my $i (0..$#subf) {
1003                         my $subfieldcode = $subf[$i][0];
1004                         my $subfieldvalue = $subf[$i][1];
1005                         my $tagsubf = $tag.$subfieldcode;
1006                         $summary =~ s/\[(.?.?.?.?)$tagsubf(.*?)]/$1$subfieldvalue$2\[$1$tagsubf$2]/g;
1007                     }
1008                 }
1009             }
1010             $summary =~ s/\[(.*?)]//g;
1011             $summary =~ s/\n/<br>/g;
1012             $oldbiblio->{summary} = $summary;
1013         }
1014         # add spans to search term in results for search term highlighting
1015         foreach my $term ( keys %$span_terms_hashref ) {
1016             my $old_term = $term;
1017             if ( length($term) > 3 ) {
1018                 $term =~ s/(.*=|\)|\(|\+|\.|\?|\[|\])//g;
1019                 $term =~ s/\\//g;
1020                 $term =~ s/\*//g;
1021
1022                 #FIXME: is there a better way to do this?
1023                 $oldbiblio->{'title'} =~ s/$term/<span class=\"term\">$&<\/span>/gi;
1024                 $oldbiblio->{'subtitle'} =~
1025                   s/$term/<span class=\"term\">$&<\/span>/gi;
1026
1027                 $oldbiblio->{'author'} =~ s/$term/<span class=\"term\">$&<\/span>/gi;
1028                 $oldbiblio->{'publishercode'} =~ s/$term/<span class=\"term\">$&<\/span>/gi;
1029                 $oldbiblio->{'place'} =~ s/$term/<span class=\"term\">$&<\/span>/gi;
1030                 $oldbiblio->{'pages'} =~ s/$term/<span class=\"term\">$&<\/span>/gi;
1031                 $oldbiblio->{'notes'} =~ s/$term/<span class=\"term\">$&<\/span>/gi;
1032                 $oldbiblio->{'size'}  =~ s/$term/<span class=\"term\">$&<\/span>/gi;
1033             }
1034         }
1035
1036         if ( $i % 2 ) {
1037             $toggle = "#ffffcc";
1038         }
1039         else {
1040             $toggle = "white";
1041         }
1042         $oldbiblio->{'toggle'} = $toggle;
1043         my @fields = $marcrecord->field($itemtag);
1044         my @items_loop;
1045         my $items;
1046         my $ordered_count     = 0;
1047         my $onloan_count      = 0;
1048         my $wthdrawn_count    = 0;
1049         my $itemlost_count    = 0;
1050         my $norequests        = 1;
1051
1052         #
1053         # check the loan status of the item : 
1054         # it is not stored in the MARC record, for pref (zebra reindexing)
1055         # reason. Thus, we have to get the status from a specific SQL query
1056         #
1057         my $sth_issue = $dbh->prepare("
1058             SELECT date_due,returndate 
1059             FROM issues 
1060             WHERE itemnumber=? AND returndate IS NULL");
1061         my $items_count=scalar(@fields);
1062         foreach my $field (@fields) {
1063             my $item;
1064             foreach my $code ( keys %subfieldstosearch ) {
1065                 $item->{$code} = $field->subfield( $subfieldstosearch{$code} );
1066             }
1067             $sth_issue->execute($item->{itemnumber});
1068             $item->{due_date} = format_date($sth_issue->fetchrow);
1069             $item->{onloan} = 1 if $item->{due_date};
1070             # at least one item can be reserved : suppose no
1071             $norequests = 1;
1072             if ( $item->{wthdrawn} ) {
1073                 $wthdrawn_count++;
1074                 $items->{ $item->{'homebranch'}.'--'.$item->{'itemcallnumber'} }->{unavailable}=1;
1075                 $items->{ $item->{'homebranch'}.'--'.$item->{'itemcallnumber'} }->{wthdrawn}=1;
1076             }
1077             elsif ( $item->{itemlost} ) {
1078                 $itemlost_count++;
1079                 $items->{ $item->{'homebranch'}.'--'.$item->{'itemcallnumber'} }->{unavailable}=1;
1080                 $items->{ $item->{'homebranch'}.'--'.$item->{'itemcallnumber'} }->{itemlost}=1;
1081             }
1082             unless ( $item->{notforloan}) {
1083                 # OK, this one can be issued, so at least one can be reserved
1084                 $norequests = 0;
1085             }
1086             if ( ( $item->{onloan} ) && ( $item->{onloan} != '0000-00-00' ) )
1087             {
1088                 $items->{ $item->{'homebranch'}.'--'.$item->{'itemcallnumber'} }->{unavailable}=1;
1089                 $items->{ $item->{'homebranch'}.'--'.$item->{'itemcallnumber'} }->{onloancount} = 1;
1090                 $items->{ $item->{'homebranch'}.'--'.$item->{'itemcallnumber'} }->{due_date} = $item->{due_date};
1091                 $onloan_count++;
1092             }
1093             if ( $item->{'homebranch'} ) {
1094                 $items->{ $item->{'homebranch'}.'--'.$item->{'itemcallnumber'} }->{count}++;
1095             }
1096
1097             # Last resort
1098             elsif ( $item->{'holdingbranch'} ) {
1099                 $items->{ $item->{'holdingbranch'} }->{count}++;
1100             }
1101             $items->{ $item->{'homebranch'}.'--'.$item->{'itemcallnumber'} }->{itemcallnumber} =                $item->{itemcallnumber};
1102             $items->{ $item->{'homebranch'}.'--'.$item->{'itemcallnumber'} }->{location} =                $item->{location};
1103             $items->{ $item->{'homebranch'}.'--'.$item->{'itemcallnumber'} }->{branchcode} =               $item->{homebranch};
1104         }    # notforloan, item level and biblioitem level
1105
1106         # last check for norequest : if itemtype is notforloan, it can't be reserved either, whatever the items
1107         $norequests = 1 if $itemtypes{$oldbiblio->{itemtype}}->{notforloan};
1108
1109         for my $key ( sort keys %$items ) {
1110             my $this_item = {
1111                 branchname     => $branches{$items->{$key}->{branchcode}},
1112                 branchcode     => $items->{$key}->{branchcode},
1113                 count          => $items->{$key}->{count},
1114                 itemcallnumber => $items->{$key}->{itemcallnumber},
1115                 location => $items->{$key}->{location},
1116                 onloancount      => $items->{$key}->{onloancount},
1117                 due_date         => $items->{$key}->{due_date},
1118                 wthdrawn      => $items->{$key}->{wthdrawn},
1119                 lost         => $items->{$key}->{itemlost},
1120             };
1121             push @items_loop, $this_item;
1122         }
1123         $oldbiblio->{norequests}    = $norequests;
1124         $oldbiblio->{items_count}    = $items_count;
1125         $oldbiblio->{items_loop}    = \@items_loop;
1126         $oldbiblio->{onloancount}   = $onloan_count;
1127         $oldbiblio->{wthdrawncount} = $wthdrawn_count;
1128         $oldbiblio->{itemlostcount} = $itemlost_count;
1129         $oldbiblio->{orderedcount}  = $ordered_count;
1130         $oldbiblio->{isbn}          =~ s/-//g; # deleting - in isbn to enable amazon content 
1131         push( @newresults, $oldbiblio );
1132     }
1133     return @newresults;
1134 }
1135
1136
1137
1138 #----------------------------------------------------------------------
1139 #
1140 # Non-Zebra GetRecords#
1141 #----------------------------------------------------------------------
1142
1143 =head2 NZgetRecords
1144
1145   NZgetRecords has the same API as zera getRecords, even if some parameters are not managed
1146
1147 =cut
1148 sub NZgetRecords {
1149     my ($query,$simple_query,$sort_by_ref,$servers_ref,$results_per_page,$offset,$expanded_facet,$branches,$query_type,$scan) = @_;
1150     my $result = NZanalyse($query);
1151     return (undef,NZorder($result,@$sort_by_ref[0],$results_per_page,$offset),undef);
1152 }
1153
1154 =head2 NZanalyse
1155
1156   NZanalyse : get a CQL string as parameter, and returns a list of biblionumber;title,biblionumber;title,...
1157   the list is built from an inverted index in the nozebra SQL table
1158   note that title is here only for convenience : the sorting will be very fast when requested on title
1159   if the sorting is requested on something else, we will have to reread all results, and that may be longer.
1160
1161 =cut
1162
1163 sub NZanalyse {
1164     my ($string,$server) = @_;
1165     # $server contains biblioserver or authorities, depending on what we search on.
1166     #warn "querying : $string on $server";
1167     $server='biblioserver' unless $server;
1168
1169     # if we have a ", replace the content to discard temporarily any and/or/not inside
1170     my $commacontent;
1171     if ($string =~/"/) {
1172         $string =~ s/"(.*?)"/__X__/;
1173         $commacontent = $1;
1174                 warn "commacontent : $commacontent" if $DEBUG;
1175     }
1176     # split the query string in 3 parts : X AND Y means : $left="X", $operand="AND" and $right="Y"
1177     # then, call again NZanalyse with $left and $right
1178     # (recursive until we find a leaf (=> something without and/or/not)
1179     $string =~ /(.*)( and | or | not | AND | OR | NOT )(.*)/;
1180     my $left = $1;
1181     my $right = $3;
1182     my $operand = lc($2); # FIXME: and/or/not are operators, not operands
1183     # it's not a leaf, we have a and/or/not
1184     if ($operand) {
1185         # reintroduce comma content if needed
1186         $right =~ s/__X__/"$commacontent"/ if $commacontent;
1187         $left =~ s/__X__/"$commacontent"/ if $commacontent;
1188         warn "node : $left / $operand / $right\n" if $DEBUG;
1189         my $leftresult = NZanalyse($left,$server);
1190         my $rightresult = NZanalyse($right,$server);
1191         # OK, we have the results for right and left part of the query
1192         # depending of operand, intersect, union or exclude both lists
1193         # to get a result list
1194         if ($operand eq ' and ') {
1195             my @leftresult = split /;/, $leftresult;
1196 #             my @rightresult = split /;/,$leftresult;
1197             my $finalresult;
1198             # parse the left results, and if the biblionumber exist in the right result, save it in finalresult
1199             # the result is stored twice, to have the same weight for AND than OR.
1200             # example : TWO : 61,61,64,121 (two is twice in the biblio #61) / TOWER : 61,64,130
1201             # result : 61,61,61,61,64,64 for two AND tower : 61 has more weight than 64
1202             foreach (@leftresult) {
1203                 if ($rightresult =~ "$_;") {
1204                     $finalresult .= "$_;$_;";
1205                 }
1206             }
1207             return $finalresult;
1208         } elsif ($operand eq ' or ') {
1209             # just merge the 2 strings
1210             return $leftresult.$rightresult;
1211         } elsif ($operand eq ' not ') {
1212             my @leftresult = split /;/, $leftresult;
1213 #             my @rightresult = split /;/,$leftresult;
1214             my $finalresult;
1215             foreach (@leftresult) {
1216                 unless ($rightresult =~ "$_;") {
1217                     $finalresult .= "$_;";
1218                 }
1219             }
1220             return $finalresult;
1221         } else {
1222             # this error is impossible, because of the regexp that isolate the operand, but just in case...
1223             die "error : operand unknown : $operand for $string";
1224         }
1225     # it's a leaf, do the real SQL query and return the result
1226     } else {
1227         $string =~  s/__X__/"$commacontent"/ if $commacontent;
1228         $string =~ s/-|\.|\?|,|;|!|'|\(|\)|\[|\]|{|}|"|&|\+|\*|\// /g;
1229          warn "leaf : $string\n" if $DEBUG;
1230         # parse the string in in operator/operand/value again
1231         $string =~ /(.*)(>=|<=)(.*)/;
1232         my $left = $1;
1233         my $operator = $2;
1234         my $right = $3;
1235         unless ($operator) {
1236             $string =~ /(.*)(>|<|=)(.*)/;
1237             $left = $1;
1238             $operator = $2;
1239             $right = $3;
1240         }
1241         my $results;
1242         # automatic replace for short operators
1243         $left='title' if $left =~ '^ti';
1244         $left='author' if $left =~ '^au';
1245         $left='publisher' if $left =~ '^pb';
1246         $left='subject' if $left =~ '^su';
1247         $left='koha-Auth-Number' if $left =~ '^an';
1248         $left='keyword' if $left =~ '^kw';
1249         if ($operator) {
1250             #do a specific search
1251             my $dbh = C4::Context->dbh;
1252             $operator='LIKE' if $operator eq '=' and $right=~ /%/;
1253             my $sth = $dbh->prepare("SELECT biblionumbers,value FROM nozebra WHERE server=? AND indexname=? AND value $operator ?");
1254             warn "$left / $operator / $right\n";
1255             # split each word, query the DB and build the biblionumbers result
1256             foreach (split / /,$right) {
1257                 my ($biblionumbers,$value);
1258                 next unless $_;
1259                 warn "EXECUTE : $server, $left, $_";
1260                 $sth->execute($server, $left, $_) or warn "execute failed: $!";
1261                 while (my ($line,$value) = $sth->fetchrow) {
1262                     # if we are dealing with a numeric value, use only numeric results (in case of >=, <=, > or <)
1263                     # otherwise, fill the result
1264                     $biblionumbers .= $line unless ($right =~ /\d/ && $value =~ /\D/);
1265                     warn "result : $value ". ($right =~ /\d/) . "==".(!$value =~ /\d/) ;#= $line";
1266                 }
1267                 # do a AND with existing list if there is one, otherwise, use the biblionumbers list as 1st result list
1268                 if ($results) {
1269                     my @leftresult = split /;/, $biblionumbers;
1270                     my $temp;
1271                     foreach my $entry (@leftresult) { # $_ contains biblionumber,title-weight
1272                         # remove weight at the end
1273                         my $cleaned = $entry;
1274                         $cleaned =~ s/-\d*$//;
1275                         # if the entry already in the hash, take it & increase weight
1276                          warn "===== $cleaned =====" if $DEBUG;
1277                         if ($results =~ "$cleaned") {
1278                             $temp .= "$entry;$entry;";
1279                              warn "INCLUDING $entry" if $DEBUG;
1280                         }
1281                     }
1282                     $results = $temp;
1283                 } else {
1284                     $results = $biblionumbers;
1285                 }
1286             }
1287         } else {
1288             #do a complete search (all indexes)
1289             my $dbh = C4::Context->dbh;
1290             my $sth = $dbh->prepare("SELECT biblionumbers FROM nozebra WHERE server=? AND value LIKE ?");
1291             # split each word, query the DB and build the biblionumbers result
1292             foreach (split / /,$string) {
1293                 next if C4::Context->stopwords->{uc($_)}; # skip if stopword
1294                 warn "search on all indexes on $_" if $DEBUG;
1295                 my $biblionumbers;
1296                 next unless $_;
1297                 $sth->execute($server, $_);
1298                 while (my $line = $sth->fetchrow) {
1299                     $biblionumbers .= $line;
1300                 }
1301                 # do a AND with existing list if there is one, otherwise, use the biblionumbers list as 1st result list
1302                 if ($results) {
1303                  warn "RES for $_ = $biblionumbers" if $DEBUG;
1304                     my @leftresult = split /;/, $biblionumbers;
1305                     my $temp;
1306                     foreach my $entry (@leftresult) { # $_ contains biblionumber,title-weight
1307                         # remove weight at the end
1308                         my $cleaned = $entry;
1309                         $cleaned =~ s/-\d*$//;
1310                         # if the entry already in the hash, take it & increase weight
1311                          warn "===== $cleaned =====" if $DEBUG;
1312                         if ($results =~ "$cleaned") {
1313                             $temp .= "$entry;$entry;";
1314                              warn "INCLUDING $entry" if $DEBUG;
1315                         }
1316                     }
1317                     $results = $temp;
1318                 } else {
1319                  warn "NEW RES for $_ = $biblionumbers" if $DEBUG;
1320                     $results = $biblionumbers;
1321                 }
1322             }
1323         }
1324          warn "return : $results for LEAF : $string" if $DEBUG;
1325         return $results;
1326     }
1327 }
1328
1329 =head2 NZorder
1330
1331   $finalresult = NZorder($biblionumbers, $ordering,$results_per_page,$offset);
1332   
1333   TODO :: Description
1334
1335 =cut
1336
1337
1338 sub NZorder {
1339     my ($biblionumbers, $ordering,$results_per_page,$offset) = @_;
1340     # order title asc by default
1341 #     $ordering = '1=36 <i' unless $ordering;
1342     $results_per_page=20 unless $results_per_page;
1343     $offset = 0 unless $offset;
1344     my $dbh = C4::Context->dbh;
1345     #
1346     # order by POPULARITY
1347     #
1348     if ($ordering =~ /popularity/) {
1349         my %result;
1350         my %popularity;
1351         # popularity is not in MARC record, it's builded from a specific query
1352         my $sth = $dbh->prepare("select sum(issues) from items where biblionumber=?");
1353         foreach (split /;/,$biblionumbers) {
1354             my ($biblionumber,$title) = split /,/,$_;
1355             $result{$biblionumber}=GetMarcBiblio($biblionumber);
1356             $sth->execute($biblionumber);
1357             my $popularity= $sth->fetchrow ||0;
1358             # hint : the key is popularity.title because we can have
1359             # many results with the same popularity. In this cas, sub-ordering is done by title
1360             # we also have biblionumber to avoid bug for 2 biblios with the same title & popularity
1361             # (un-frequent, I agree, but we won't forget anything that way ;-)
1362             $popularity{sprintf("%10d",$popularity).$title.$biblionumber} = $biblionumber;
1363         }
1364         # sort the hash and return the same structure as GetRecords (Zebra querying)
1365         my $result_hash;
1366         my $numbers=0;
1367         if ($ordering eq 'popularity_dsc') { # sort popularity DESC
1368             foreach my $key (sort {$b cmp $a} (keys %popularity)) {
1369                 $result_hash->{'RECORDS'}[$numbers++] = $result{$popularity{$key}}->as_usmarc();
1370             }
1371         } else { # sort popularity ASC
1372             foreach my $key (sort (keys %popularity)) {
1373                 $result_hash->{'RECORDS'}[$numbers++] = $result{$popularity{$key}}->as_usmarc();
1374             }
1375         }
1376         my $finalresult=();
1377         $result_hash->{'hits'} = $numbers;
1378         $finalresult->{'biblioserver'} = $result_hash;
1379         return $finalresult;
1380     #
1381     # ORDER BY author
1382     #
1383     } elsif ($ordering =~/author/){
1384         my %result;
1385         foreach (split /;/,$biblionumbers) {
1386             my ($biblionumber,$title) = split /,/,$_;
1387             my $record=GetMarcBiblio($biblionumber);
1388             my $author;
1389             if (C4::Context->preference('marcflavour') eq 'UNIMARC') {
1390                 $author=$record->subfield('200','f');
1391                 $author=$record->subfield('700','a') unless $author;
1392             } else {
1393                 $author=$record->subfield('100','a');
1394             }
1395             # hint : the result is sorted by title.biblionumber because we can have X biblios with the same title
1396             # and we don't want to get only 1 result for each of them !!!
1397             $result{$author.$biblionumber}=$record;
1398         }
1399         # sort the hash and return the same structure as GetRecords (Zebra querying)
1400         my $result_hash;
1401         my $numbers=0;
1402         if ($ordering eq 'author_za') { # sort by author desc
1403             foreach my $key (sort { $b cmp $a } (keys %result)) {
1404                 $result_hash->{'RECORDS'}[$numbers++] = $result{$key}->as_usmarc();
1405             }
1406         } else { # sort by author ASC
1407             foreach my $key (sort (keys %result)) {
1408                 $result_hash->{'RECORDS'}[$numbers++] = $result{$key}->as_usmarc();
1409             }
1410         }
1411         my $finalresult=();
1412         $result_hash->{'hits'} = $numbers;
1413         $finalresult->{'biblioserver'} = $result_hash;
1414         return $finalresult;
1415     #
1416     # ORDER BY callnumber
1417     #
1418     } elsif ($ordering =~/callnumber/){
1419         my %result;
1420         foreach (split /;/,$biblionumbers) {
1421             my ($biblionumber,$title) = split /,/,$_;
1422             my $record=GetMarcBiblio($biblionumber);
1423             my $callnumber;
1424             my ($callnumber_tag,$callnumber_subfield)=GetMarcFromKohaField($dbh,'items.itemcallnumber');
1425             ($callnumber_tag,$callnumber_subfield)= GetMarcFromKohaField('biblioitems.callnumber') unless $callnumber_tag;
1426             if (C4::Context->preference('marcflavour') eq 'UNIMARC') {
1427                 $callnumber=$record->subfield('200','f');
1428             } else {
1429                 $callnumber=$record->subfield('100','a');
1430             }
1431             # hint : the result is sorted by title.biblionumber because we can have X biblios with the same title
1432             # and we don't want to get only 1 result for each of them !!!
1433             $result{$callnumber.$biblionumber}=$record;
1434         }
1435         # sort the hash and return the same structure as GetRecords (Zebra querying)
1436         my $result_hash;
1437         my $numbers=0;
1438         if ($ordering eq 'call_number_dsc') { # sort by title desc
1439             foreach my $key (sort { $b cmp $a } (keys %result)) {
1440                 $result_hash->{'RECORDS'}[$numbers++] = $result{$key}->as_usmarc();
1441             }
1442         } else { # sort by title ASC
1443             foreach my $key (sort { $a cmp $b } (keys %result)) {
1444                 $result_hash->{'RECORDS'}[$numbers++] = $result{$key}->as_usmarc();
1445             }
1446         }
1447         my $finalresult=();
1448         $result_hash->{'hits'} = $numbers;
1449         $finalresult->{'biblioserver'} = $result_hash;
1450         return $finalresult;
1451     } elsif ($ordering =~ /pubdate/){ #pub year
1452         my %result;
1453         foreach (split /;/,$biblionumbers) {
1454             my ($biblionumber,$title) = split /,/,$_;
1455             my $record=GetMarcBiblio($biblionumber);
1456             my ($publicationyear_tag,$publicationyear_subfield)=GetMarcFromKohaField('biblioitems.publicationyear','');
1457             my $publicationyear=$record->subfield($publicationyear_tag,$publicationyear_subfield);
1458             # hint : the result is sorted by title.biblionumber because we can have X biblios with the same title
1459             # and we don't want to get only 1 result for each of them !!!
1460             $result{$publicationyear.$biblionumber}=$record;
1461         }
1462         # sort the hash and return the same structure as GetRecords (Zebra querying)
1463         my $result_hash;
1464         my $numbers=0;
1465         if ($ordering eq 'pubdate_dsc') { # sort by pubyear desc
1466             foreach my $key (sort { $b cmp $a } (keys %result)) {
1467                 $result_hash->{'RECORDS'}[$numbers++] = $result{$key}->as_usmarc();
1468             }
1469         } else { # sort by pub year ASC
1470             foreach my $key (sort (keys %result)) {
1471                 $result_hash->{'RECORDS'}[$numbers++] = $result{$key}->as_usmarc();
1472             }
1473         }
1474         my $finalresult=();
1475         $result_hash->{'hits'} = $numbers;
1476         $finalresult->{'biblioserver'} = $result_hash;
1477         return $finalresult;
1478     #
1479     # ORDER BY title
1480     #
1481     } elsif ($ordering =~ /title/) { 
1482         # the title is in the biblionumbers string, so we just need to build a hash, sort it and return
1483         my %result;
1484         foreach (split /;/,$biblionumbers) {
1485             my ($biblionumber,$title) = split /,/,$_;
1486             # hint : the result is sorted by title.biblionumber because we can have X biblios with the same title
1487             # and we don't want to get only 1 result for each of them !!!
1488             # hint & speed improvement : we can order without reading the record
1489             # so order, and read records only for the requested page !
1490             $result{$title.$biblionumber}=$biblionumber;
1491         }
1492         # sort the hash and return the same structure as GetRecords (Zebra querying)
1493         my $result_hash;
1494         my $numbers=0;
1495         if ($ordering eq 'title_az') { # sort by title desc
1496             foreach my $key (sort (keys %result)) {
1497                 $result_hash->{'RECORDS'}[$numbers++] = $result{$key};
1498             }
1499         } else { # sort by title ASC
1500             foreach my $key (sort { $b cmp $a } (keys %result)) {
1501                 $result_hash->{'RECORDS'}[$numbers++] = $result{$key};
1502             }
1503         }
1504         # limit the $results_per_page to result size if it's more
1505         $results_per_page = $numbers-1 if $numbers < $results_per_page;
1506         # for the requested page, replace biblionumber by the complete record
1507         # speed improvement : avoid reading too much things
1508         for (my $counter=$offset;$counter<=$offset+$results_per_page;$counter++) {
1509             $result_hash->{'RECORDS'}[$counter] = GetMarcBiblio($result_hash->{'RECORDS'}[$counter])->as_usmarc;
1510         }
1511         my $finalresult=();
1512         $result_hash->{'hits'} = $numbers;
1513         $finalresult->{'biblioserver'} = $result_hash;
1514         return $finalresult;
1515     } else {
1516     #
1517     # order by ranking
1518     #
1519         # we need 2 hashes to order by ranking : the 1st one to count the ranking, the 2nd to order by ranking
1520         my %result;
1521         my %count_ranking;
1522         foreach (split /;/,$biblionumbers) {
1523             my ($biblionumber,$title) = split /,/,$_;
1524             $title =~ /(.*)-(\d)/;
1525             # get weight 
1526             my $ranking =$2;
1527             # note that we + the ranking because ranking is calculated on weight of EACH term requested.
1528             # if we ask for "two towers", and "two" has weight 2 in biblio N, and "towers" has weight 4 in biblio N
1529             # biblio N has ranking = 6
1530             $count_ranking{$biblionumber} += $ranking;
1531         }
1532         # build the result by "inverting" the count_ranking hash
1533         # 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
1534 #         warn "counting";
1535         foreach (keys %count_ranking) {
1536             $result{sprintf("%10d",$count_ranking{$_}).'-'.$_} = $_;
1537         }
1538         # sort the hash and return the same structure as GetRecords (Zebra querying)
1539         my $result_hash;
1540         my $numbers=0;
1541             foreach my $key (sort {$b cmp $a} (keys %result)) {
1542                 $result_hash->{'RECORDS'}[$numbers++] = $result{$key};
1543             }
1544         # limit the $results_per_page to result size if it's more
1545         $results_per_page = $numbers-1 if $numbers < $results_per_page;
1546         # for the requested page, replace biblionumber by the complete record
1547         # speed improvement : avoid reading too much things
1548         for (my $counter=$offset;$counter<=$offset+$results_per_page;$counter++) {
1549             $result_hash->{'RECORDS'}[$counter] = GetMarcBiblio($result_hash->{'RECORDS'}[$counter])->as_usmarc if $result_hash->{'RECORDS'}[$counter];
1550         }
1551         my $finalresult=();
1552         $result_hash->{'hits'} = $numbers;
1553         $finalresult->{'biblioserver'} = $result_hash;
1554         return $finalresult;
1555     }
1556 }
1557 =head2 ModBiblios
1558
1559 ($countchanged,$listunchanged) = ModBiblios($listbiblios, $tagsubfield,$initvalue,$targetvalue,$test);
1560
1561 this function changes all the values $initvalue in subfield $tag$subfield in any record in $listbiblios
1562 test parameter if set donot perform change to records in database.
1563
1564 =over 2
1565
1566 =item C<input arg:>
1567
1568     * $listbiblios is an array ref to marcrecords to be changed
1569     * $tagsubfield is the reference of the subfield to change.
1570     * $initvalue is the value to search the record for
1571     * $targetvalue is the value to set the subfield to
1572     * $test is to be set only not to perform changes in database.
1573
1574 =item C<Output arg:>
1575     * $countchanged counts all the changes performed.
1576     * $listunchanged contains the list of all the biblionumbers of records unchanged.
1577
1578 =item C<usage in the script:>
1579
1580 =back
1581
1582 my ($countchanged, $listunchanged) = EditBiblios($results->{RECORD}, $tagsubfield,$initvalue,$targetvalue);;
1583 #If one wants to display unchanged records, you should get biblios foreach @$listunchanged 
1584 $template->param(countchanged => $countchanged, loopunchanged=>$listunchanged);
1585
1586 =cut
1587
1588 sub ModBiblios{
1589   my ($listbiblios,$tagsubfield,$initvalue,$targetvalue,$test)=@_;
1590   my $countmatched;
1591   my @unmatched;
1592   my ($tag,$subfield)=($1,$2) if ($tagsubfield=~/^(\d{1,3})([a-z0-9A-Z@])?$/); 
1593   if ((length($tag)<3)&& $subfield=~/0-9/){
1594     $tag=$tag.$subfield;
1595     undef $subfield;
1596   } 
1597   my ($bntag,$bnsubf) = GetMarcFromKohaField('biblio.biblionumber');
1598   my ($itemtag,$itemsubf) = GetMarcFromKohaField('items.itemnumber');
1599   foreach my $usmarc (@$listbiblios){
1600     my $record; 
1601     $record=eval{MARC::Record->new_from_usmarc($usmarc)};
1602     my $biblionumber;
1603     if ($@){
1604       # usmarc is not a valid usmarc May be a biblionumber
1605       if ($tag eq $itemtag){
1606         my $bib=GetBiblioFromItemNumber($usmarc);   
1607         $record=GetMarcItem($bib->{'biblionumber'},$usmarc) ;   
1608         $biblionumber=$bib->{'biblionumber'};
1609       } else {   
1610         $record=GetMarcBiblio($usmarc);   
1611         $biblionumber=$usmarc;
1612       }   
1613     }  else {
1614       if ($bntag >= 010){
1615         $biblionumber = $record->subfield($bntag,$bnsubf);
1616       }else {
1617         $biblionumber=$record->field($bntag)->data;
1618       }
1619     }  
1620     #GetBiblionumber is to be written.
1621     #Could be replaced by TransformMarcToKoha (But Would be longer)
1622     if ($record->field($tag)){
1623       my $modify=0;  
1624       foreach my $field ($record->field($tag)){
1625         if ($subfield){
1626           if ($field->delete_subfield('code' =>$subfield,'match'=>qr($initvalue))){
1627             $countmatched++;
1628             $modify=1;      
1629             $field->update($subfield,$targetvalue) if ($targetvalue);
1630           }
1631         } else {
1632           if ($tag >= 010){
1633             if ($field->delete_field($field)){
1634               $countmatched++;
1635               $modify=1;      
1636             }
1637           } else {
1638             $field->data=$targetvalue if ($field->data=~qr($initvalue));
1639           }     
1640         }    
1641       }
1642 #       warn $record->as_formatted;
1643       if ($modify){
1644         ModBiblio($record,$biblionumber,GetFrameworkCode($biblionumber)) unless ($test);
1645       } else {
1646         push @unmatched, $biblionumber;   
1647       }      
1648     } else {
1649       push @unmatched, $biblionumber;
1650     }
1651   }
1652   return ($countmatched,\@unmatched);
1653 }
1654
1655 END { }    # module clean-up code here (global destructor)
1656
1657 1;
1658 __END__
1659
1660 =head1 AUTHOR
1661
1662 Koha Developement team <info@koha.org>
1663
1664 =cut