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 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                         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     # if the index already has more than one qualifier, just wrap the operand
 655     # in quotes and pass it back
 656     elsif ($index =~ ',') {
 657         $weighted_query .=" $index=\"$operand\"";
 658     }
 659     #TODO: build better cases based on specific search indexes
 660     else {
 661        $weighted_query .= " $index,ext,r1=\"$operand\"";            # exact index
 662        #$weighted_query .= " or (title-sort-az=0 or $index,startswithnt,st-word,r3=$operand #)";
 663        $weighted_query .= " or $index,phr,r3=\"$operand\"";         # phrase index
 664        $weighted_query .= " or $index,rt,wrd,r3=\"$operand\"";      # word list index
 665     }
 666     $weighted_query .= "))";    # close rank specification
 667     return $weighted_query;
 668 }
 669
 670 # build the query itself
 671 sub buildQuery {
 672     my ( $operators, $operands, $indexes, $limits, $sort_by ) = @_;
 673
 674     my @operators = @$operators if $operators;
 675     my @indexes   = @$indexes   if $indexes;
 676     my @operands  = @$operands  if $operands;
 677     my @limits    = @$limits    if $limits;
 678     my @sort_by   = @$sort_by   if $sort_by;
 679
 680     my $stemming      = C4::Context->preference("QueryStemming")     || 0;
 681     my $weight_fields = C4::Context->preference("QueryWeightFields") || 0;
 682     my $fuzzy_enabled = C4::Context->preference("QueryFuzzy") || 0;
 683
 684     my $query = $operands[0];
 685         my $simple_query = $operands[0];
 686         my $query_cgi;
 687         my $query_desc;
 688         my $query_type;
 689
 690         my $limit;
 691         my $limit_cgi;
 692         my $limit_desc;
 693
 694         my $stopwords_removed;
 695 # STEP I: determine if this is a form-based / simple query or if it's nested
 696
 697 # check if this is a known query language query, if it is, return immediately,
 698 # the user is responsible for constructing valid syntax:
 699     if ( $query =~ /^ccl=/ ) {
 700         return ( undef, $', $', $', '', '', '', 'ccl' );
 701     }
 702     if ( $query =~ /^cql=/ ) {
 703         return ( undef, $', $', $', '', '', '', 'cql' );
 704     }
 705     if ( $query =~ /^pqf=/ ) {
 706         return ( undef, $', $', $', '', '', '', 'pqf' );
 707     }
 708
 709         # pass nested queries directly
 710     if ( $query =~ /(\(|\))/ ) {
 711         return ( undef, $query, $query_cgi, $query_desc, $limit, $limit_cgi, $limit_desc, 'ccl' );
 712     }
 713
 714 # form-based queries are limited to non-nested at a specific depth, so we can easily
 715 # modify the incoming query operands and indexes to do stemming and field weighting
 716 # Once we do so, we'll end up with a value in $query, just like if we had an
 717 # incoming $query from the user
 718     else {
 719         $query = ""; # clear it out so we can populate properly with field-weighted stemmed query
 720         my $previous_operand;    # a flag used to keep track if there was a previous query
 721                                 # if there was, we can apply the current operator
 722         # for every operand
 723         for ( my $i = 0 ; $i <= @operands ; $i++ ) {
 724
 725             # COMBINE OPERANDS, INDEXES AND OPERATORS
 726             if ( $operands[$i] ) {
 727
 728                                 $weight_fields = 0 if $operands[$i] =~ /(:|=)/;
 729                 my $operand = $operands[$i];
 730                 my $index   = $indexes[$i];
 731
 732                 # if there's no index, don't use one, it will throw a CCL error
 733                 my $index_plus = "$index:" if $index;
 734                 my $index_plus_comma="$index," if $index;
 735
 736                 # Remove Stopwords
 737                 ($operand, $stopwords_removed) = _remove_stopwords($operand,$index);
 738                 warn "OPERAND w/out STOPWORDS: >$operand<" if $DEBUG;
 739                                 warn "REMOVED STOPWORDS: @$stopwords_removed" if $DEBUG;
 740                 my $indexes_set;
 741
 742                 # Detect Truncation
 743                 my ($nontruncated,$righttruncated,$lefttruncated,$rightlefttruncated,$regexpr);
 744                 my $truncated_operand;
 745                 ($nontruncated,$righttruncated,$lefttruncated,$rightlefttruncated,$regexpr) = _detect_truncation($operand,$index);
 746                 warn "TRUNCATION: NON:>@$nontruncated< RIGHT:>@$righttruncated< LEFT:>@$lefttruncated< RIGHTLEFT:>@$rightlefttruncated< REGEX:>@$regexpr<" if $DEBUG;
 747
 748                 # Apply Truncation
 749                 if (scalar(@$righttruncated)+scalar(@$lefttruncated)+scalar(@$rightlefttruncated)>0){
 750                     $indexes_set = 1;
 751                     undef $weight_fields;
 752                     my $previous_truncation_operand;
 753                     if (scalar(@$nontruncated)>0) {
 754                         $truncated_operand.= "$index_plus @$nontruncated ";
 755                         $previous_truncation_operand = 1;
 756                     }
 757                     if (scalar(@$righttruncated)>0){
 758                         $truncated_operand .= "and " if $previous_truncation_operand;
 759                         $truncated_operand .= "$index_plus_comma"."rtrn:@$righttruncated ";
 760                         $previous_truncation_operand = 1;
 761                     }
 762                     if (scalar(@$lefttruncated)>0){
 763                         $truncated_operand .= "and " if $previous_truncation_operand;
 764                         $truncated_operand .= "$index_plus_comma"."ltrn:@$lefttruncated ";
 765                         $previous_truncation_operand = 1;
 766                     }
 767                     if (scalar(@$rightlefttruncated)>0){
 768                         $truncated_operand .= "and " if $previous_truncation_operand;
 769                         $truncated_operand .= "$index_plus_comma"."rltrn:@$rightlefttruncated ";
 770                         $previous_truncation_operand = 1;
 771                     }
 772                 }
 773                 $operand = $truncated_operand if $truncated_operand;
 774                 warn "TRUNCATED OPERAND: >$truncated_operand<" if $DEBUG;
 775
 776                 # Handle Stemming
 777                 my $stemmed_operand;
 778                 $stemmed_operand = _build_stemmed_operand($operand) if $stemming;
 779                 warn "STEMMED OPERAND: >$stemmed_operand<" if $DEBUG;
 780
 781                 # Handle Field Weighting
 782                 my $weighted_operand;
 783                 $weighted_operand = _build_weighted_query($operand,$stemmed_operand,$index) if $weight_fields;
 784                 warn "FIELD WEIGHTED OPERAND: >$weighted_operand<" if $DEBUG;
 785                 $operand = $weighted_operand if $weight_fields;
 786                 $indexes_set = 1 if $weight_fields;
 787
 788                 # If there's a previous operand, we need to add an operator
 789                 if ($previous_operand) {
 790
 791                     # user-specified operator
 792                     if ( $operators[$i-1] ) {
 793                         $query .= " $operators[$i-1] ";
 794                         $query .= " $index_plus " unless $indexes_set;
 795                         $query .= " $operand";
 796                                                 $query_cgi .="&op=$operators[$i-1]";
 797                                                 $query_cgi .="&idx=$index" if $index;
 798                                                 $query_cgi .="&q=$operands[$i]" if $operands[$i];
 799                                                 $query_desc .=" $operators[$i-1] $index_plus $operands[$i]";
 800                     }
 801
 802                     # the default operator is and
 803                     else {
 804                         $query .= " and ";
 805                         $query .= "$index_plus " unless $indexes_set;
 806                         $query .= "$operand";
 807                                                 $query_cgi .="&op=and&idx=$index" if $index;
 808                                                 $query_cgi .="&q=$operands[$i]" if $operands[$i];
 809                         $query_desc .= " and $index_plus $operands[$i]";
 810                     }
 811                 }
 812
 813                                 # there isn't a pervious operand, don't need an operator
 814                 else {
 815                                         # field-weighted queries already have indexes set
 816                                         $query .=" $index_plus " unless $indexes_set;
 817                                         $query .= $operand;
 818                                         $query_desc .= " $index_plus $operands[$i]";
 819                                         $query_cgi.="&idx=$index" if $index;
 820                                         $query_cgi.="&q=$operands[$i]" if $operands[$i];
 821
 822                     $previous_operand = 1;
 823                 }
 824             }    #/if $operands
 825         }    # /for
 826     }
 827     warn "QUERY BEFORE LIMITS: >$query<" if $DEBUG;
 828
 829     # add limits
 830         my $group_OR_limits;
 831     foreach my $this_limit (@limits) {
 832         if ( $this_limit =~ /available/ ) {
 833                         # FIXME: switch to zebra search for null values
 834             $limit .= " (($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))";
 835                         $limit_cgi .= "&limit=available";
 836                         $limit_desc .="";
 837         }
 838
 839                 # these are treated as OR
 840         elsif ( $this_limit =~ /mc/ ) {
 841             $group_OR_limits .= " or " if $group_OR_limits;
 842                         $limit_desc .=" or " if $group_OR_limits;
 843                         $group_OR_limits .= "$this_limit";
 844                         $limit_cgi .="&limit=$this_limit";
 845                         $limit_desc .= "$this_limit";
 846         }
 847
 848                 # regular old limits
 849                 else {
 850                         $limit .= " and " if $limit || $query;
 851                         $limit .= "$this_limit";
 852                         $limit_cgi .="&limit=$this_limit";
 853                         $limit_desc .=" and $this_limit";
 854                 }
 855     }
 856         if ($group_OR_limits) {
 857                 $limit.=" and " if ($query || $limit );
 858                 $limit.="($group_OR_limits)";
 859         }
 860         # normalize the strings
 861         for ($query, $query_desc, $limit, $limit_desc) {
 862                 $_ =~ s/  / /g;    # remove extra spaces
 863         $_ =~ s/^ //g;     # remove any beginning spaces
 864                 $_ =~ s/ $//g;     # remove any ending spaces
 865         $_ =~ s/:/=/g;     # causes probs for server
 866         $_ =~ s/==/=/g;    # remove double == from query
 867
 868         }
 869
 870         $query_cgi =~ s/^&//;
 871
 872         # append the limit to the query
 873         $query .= $limit;
 874
 875     warn "QUERY:".$query if $DEBUG;
 876         warn "QUERY CGI:".$query_cgi if $DEBUG;
 877     warn "QUERY DESC:".$query_desc if $DEBUG;
 878     warn "LIMIT:".$limit if $DEBUG;
 879     warn "LIMIT CGI:".$limit_cgi if $DEBUG;
 880     warn "LIMIT DESC:".$limit_desc if $DEBUG;
 881
 882         return ( undef, $query,$simple_query,$query_cgi,$query_desc,$limit,$limit_cgi,$limit_desc,$stopwords_removed,$query_type );
 883 }
 884
 885 # IMO this subroutine is pretty messy still -- it's responsible for
 886 # building the HTML output for the template
 887 sub searchResults {
 888     my ( $searchdesc, $hits, $results_per_page, $offset, @marcresults ) = @_;
 889
 890     my $dbh = C4::Context->dbh;
 891     my $toggle;
 892     my $even = 1;
 893     my @newresults;
 894     my $span_terms_hashref;
 895     for my $span_term ( split( / /, $searchdesc ) ) {
 896         $span_term =~ s/(.*=|\)|\(|\+|\.)//g;
 897         $span_terms_hashref->{$span_term}++;
 898     }
 899
 900     #Build brancnames hash
 901     #find branchname
 902     #get branch information.....
 903     my %branches;
 904     my $bsth =
 905       $dbh->prepare("SELECT branchcode,branchname FROM branches")
 906       ;    # FIXME : use C4::Koha::GetBranches
 907     $bsth->execute();
 908     while ( my $bdata = $bsth->fetchrow_hashref ) {
 909         $branches{ $bdata->{'branchcode'} } = $bdata->{'branchname'};
 910     }
 911
 912     #Build itemtype hash
 913     #find itemtype & itemtype image
 914     my %itemtypes;
 915     $bsth =
 916       $dbh->prepare("SELECT itemtype,description,imageurl,summary,notforloan FROM itemtypes");
 917     $bsth->execute();
 918     while ( my $bdata = $bsth->fetchrow_hashref ) {
 919         $itemtypes{ $bdata->{'itemtype'} }->{description} =
 920           $bdata->{'description'};
 921         $itemtypes{ $bdata->{'itemtype'} }->{imageurl} = $bdata->{'imageurl'};
 922         $itemtypes{ $bdata->{'itemtype'} }->{summary} = $bdata->{'summary'};
 923         $itemtypes{ $bdata->{'itemtype'} }->{notforloan} = $bdata->{'notforloan'};
 924     }
 925
 926     #search item field code
 927     my $sth =
 928       $dbh->prepare(
 929 "select tagfield from marc_subfield_structure where kohafield like 'items.itemnumber'"
 930       );
 931     $sth->execute;
 932     my ($itemtag) = $sth->fetchrow;
 933
 934     ## find column names of items related to MARC
 935     my $sth2 = $dbh->prepare("SHOW COLUMNS from items");
 936     $sth2->execute;
 937     my %subfieldstosearch;
 938     while ( ( my $column ) = $sth2->fetchrow ) {
 939         my ( $tagfield, $tagsubfield ) =
 940           &GetMarcFromKohaField( "items." . $column, "" );
 941         $subfieldstosearch{$column} = $tagsubfield;
 942     }
 943     my $times;
 944
 945     if ( $hits && $offset + $results_per_page <= $hits ) {
 946         $times = $offset + $results_per_page;
 947     }
 948     else {
 949         $times = $hits;
 950     }
 951
 952     for ( my $i = $offset ; $i <= $times - 1 ; $i++ ) {
 953         my $marcrecord;
 954         $marcrecord = MARC::File::USMARC::decode( $marcresults[$i] );
 955         my $oldbiblio = TransformMarcToKoha( $dbh, $marcrecord, '' );
 956         # add image url if there is one
 957         if ( $itemtypes{ $oldbiblio->{itemtype} }->{imageurl} =~ /^http:/ ) {
 958             $oldbiblio->{imageurl} =
 959               $itemtypes{ $oldbiblio->{itemtype} }->{imageurl};
 960             $oldbiblio->{description} =
 961               $itemtypes{ $oldbiblio->{itemtype} }->{description};
 962         }
 963         else {
 964             $oldbiblio->{imageurl} =
 965               getitemtypeimagesrc() . "/"
 966               . $itemtypes{ $oldbiblio->{itemtype} }->{imageurl}
 967               if ( $itemtypes{ $oldbiblio->{itemtype} }->{imageurl} );
 968             $oldbiblio->{description} =
 969               $itemtypes{ $oldbiblio->{itemtype} }->{description};
 970         }
 971         #
 972         # build summary if there is one (the summary is defined in itemtypes table
 973         #
 974         if ($itemtypes{ $oldbiblio->{itemtype} }->{summary}) {
 975             my $summary = $itemtypes{ $oldbiblio->{itemtype} }->{summary};
 976             my @fields = $marcrecord->fields();
 977             foreach my $field (@fields) {
 978                 my $tag = $field->tag();
 979                 my $tagvalue = $field->as_string();
 980                 $summary =~ s/\[(.?.?.?.?)$tag\*(.*?)]/$1$tagvalue$2\[$1$tag$2]/g;
 981                 unless ($tag<10) {
 982                     my @subf = $field->subfields;
 983                     for my $i (0..$#subf) {
 984                         my $subfieldcode = $subf[$i][0];
 985                         my $subfieldvalue = $subf[$i][1];
 986                         my $tagsubf = $tag.$subfieldcode;
 987                         $summary =~ s/\[(.?.?.?.?)$tagsubf(.*?)]/$1$subfieldvalue$2\[$1$tagsubf$2]/g;
 988                     }
 989                 }
 990             }
 991             $summary =~ s/\[(.*?)]//g;
 992             $summary =~ s/\n/<br>/g;
 993             $oldbiblio->{summary} = $summary;
 994         }
 995         # add spans to search term in results for search term highlighting
 996         foreach my $term ( keys %$span_terms_hashref ) {
 997             my $old_term = $term;
 998             if ( length($term) > 3 ) {
 999                 $term =~ s/(.*=|\)|\(|\+|\.|\?|\[|\])//g;
1000                 $term =~ s/\\//g;
1001                 $term =~ s/\*//g;
1002
1003                 #FIXME: is there a better way to do this?
1004                 $oldbiblio->{'title'} =~ s/$term/<span class=\"term\">$&<\/span>/gi;
1005                 $oldbiblio->{'subtitle'} =~
1006                   s/$term/<span class=\"term\">$&<\/span>/gi;
1007
1008                 $oldbiblio->{'author'} =~ s/$term/<span class=\"term\">$&<\/span>/gi;
1009                 $oldbiblio->{'publishercode'} =~ s/$term/<span class=\"term\">$&<\/span>/gi;
1010                 $oldbiblio->{'place'} =~ s/$term/<span class=\"term\">$&<\/span>/gi;
1011                 $oldbiblio->{'pages'} =~ s/$term/<span class=\"term\">$&<\/span>/gi;
1012                 $oldbiblio->{'notes'} =~ s/$term/<span class=\"term\">$&<\/span>/gi;
1013                 $oldbiblio->{'size'}  =~ s/$term/<span class=\"term\">$&<\/span>/gi;
1014             }
1015         }
1016
1017         if ( $i % 2 ) {
1018             $toggle = "#ffffcc";
1019         }
1020         else {
1021             $toggle = "white";
1022         }
1023         $oldbiblio->{'toggle'} = $toggle;
1024         my @fields = $marcrecord->field($itemtag);
1025         my @items_loop;
1026         my $items;
1027         my $ordered_count     = 0;
1028         my $onloan_count      = 0;
1029         my $wthdrawn_count    = 0;
1030         my $itemlost_count    = 0;
1031         my $norequests        = 1;
1032
1033         #
1034         # check the loan status of the item :
1035         # it is not stored in the MARC record, for pref (zebra reindexing)
1036         # reason. Thus, we have to get the status from a specific SQL query
1037         #
1038         my $sth_issue = $dbh->prepare("
1039             SELECT date_due,returndate
1040             FROM issues
1041             WHERE itemnumber=? AND returndate IS NULL");
1042         my $items_count=scalar(@fields);
1043         foreach my $field (@fields) {
1044             my $item;
1045             foreach my $code ( keys %subfieldstosearch ) {
1046                 $item->{$code} = $field->subfield( $subfieldstosearch{$code} );
1047             }
1048             $sth_issue->execute($item->{itemnumber});
1049             $item->{due_date} = format_date($sth_issue->fetchrow);
1050             $item->{onloan} = 1 if $item->{due_date};
1051             # at least one item can be reserved : suppose no
1052             $norequests = 1;
1053             if ( $item->{wthdrawn} ) {
1054                 $wthdrawn_count++;
1055                 $items->{ $item->{'homebranch'}.'--'.$item->{'itemcallnumber'} }->{unavailable}=1;
1056                 $items->{ $item->{'homebranch'}.'--'.$item->{'itemcallnumber'} }->{wthdrawn}=1;
1057             }
1058             elsif ( $item->{itemlost} ) {
1059                 $itemlost_count++;
1060                 $items->{ $item->{'homebranch'}.'--'.$item->{'itemcallnumber'} }->{unavailable}=1;
1061                 $items->{ $item->{'homebranch'}.'--'.$item->{'itemcallnumber'} }->{itemlost}=1;
1062             }
1063             unless ( $item->{notforloan}) {
1064                 # OK, this one can be issued, so at least one can be reserved
1065                 $norequests = 0;
1066             }
1067             if ( ( $item->{onloan} ) && ( $item->{onloan} != '0000-00-00' ) )
1068             {
1069                 $items->{ $item->{'homebranch'}.'--'.$item->{'itemcallnumber'} }->{unavailable}=1;
1070                 $items->{ $item->{'homebranch'}.'--'.$item->{'itemcallnumber'} }->{onloancount} = 1;
1071                 $items->{ $item->{'homebranch'}.'--'.$item->{'itemcallnumber'} }->{due_date} = $item->{due_date};
1072                 $onloan_count++;
1073             }
1074             if ( $item->{'homebranch'} ) {
1075                 $items->{ $item->{'homebranch'}.'--'.$item->{'itemcallnumber'} }->{count}++;
1076             }
1077
1078             # Last resort
1079             elsif ( $item->{'holdingbranch'} ) {
1080                 $items->{ $item->{'holdingbranch'} }->{count}++;
1081             }
1082             $items->{ $item->{'homebranch'}.'--'.$item->{'itemcallnumber'} }->{itemcallnumber} =                $item->{itemcallnumber};
1083             $items->{ $item->{'homebranch'}.'--'.$item->{'itemcallnumber'} }->{location} =                $item->{location};
1084             $items->{ $item->{'homebranch'}.'--'.$item->{'itemcallnumber'} }->{branchcode} =               $item->{homebranch};
1085         }    # notforloan, item level and biblioitem level
1086
1087         # last check for norequest : if itemtype is notforloan, it can't be reserved either, whatever the items
1088         $norequests = 1 if $itemtypes{$oldbiblio->{itemtype}}->{notforloan};
1089
1090         for my $key ( sort keys %$items ) {
1091             my $this_item = {
1092                 branchname     => $branches{$items->{$key}->{branchcode}},
1093                 branchcode     => $items->{$key}->{branchcode},
1094                 count          => $items->{$key}->{count},
1095                 itemcallnumber => $items->{$key}->{itemcallnumber},
1096                 location => $items->{$key}->{location},
1097                 onloancount      => $items->{$key}->{onloancount},
1098                 due_date         => $items->{$key}->{due_date},
1099                 wthdrawn      => $items->{$key}->{wthdrawn},
1100                 lost         => $items->{$key}->{itemlost},
1101             };
1102             push @items_loop, $this_item;
1103         }
1104         $oldbiblio->{norequests}    = $norequests;
1105         $oldbiblio->{items_count}    = $items_count;
1106         $oldbiblio->{items_loop}    = \@items_loop;
1107         $oldbiblio->{onloancount}   = $onloan_count;
1108         $oldbiblio->{wthdrawncount} = $wthdrawn_count;
1109         $oldbiblio->{itemlostcount} = $itemlost_count;
1110         $oldbiblio->{orderedcount}  = $ordered_count;
1111         $oldbiblio->{isbn}          =~ s/-//g; # deleting - in isbn to enable amazon content
1112         push( @newresults, $oldbiblio );
1113     }
1114     return @newresults;
1115 }
1116
1117
1118
1119 #----------------------------------------------------------------------
1120 #
1121 # Non-Zebra GetRecords#
1122 #----------------------------------------------------------------------
1123
1124 =head2 NZgetRecords
1125
1126   NZgetRecords has the same API as zera getRecords, even if some parameters are not managed
1127
1128 =cut
1129 sub NZgetRecords {
1130     my ($query,$simple_query,$sort_by_ref,$servers_ref,$results_per_page,$offset,$expanded_facet,$branches,$query_type,$scan) = @_;
1131     my $result = NZanalyse($query);
1132     return (undef,NZorder($result,@$sort_by_ref[0],$results_per_page,$offset),undef);
1133 }
1134
1135 =head2 NZanalyse
1136
1137   NZanalyse : get a CQL string as parameter, and returns a list of biblionumber;title,biblionumber;title,...
1138   the list is builded from inverted index in nozebra SQL table
1139   note that title is here only for convenience : the sorting will be very fast when requested on title
1140   if the sorting is requested on something else, we will have to reread all results, and that may be longer.
1141
1142 =cut
1143
1144 sub NZanalyse {
1145     my ($string,$server) = @_;
1146     # $server contains biblioserver or authorities, depending on what we search on.
1147     #warn "querying : $string on $server";
1148     $server='biblioserver' unless $server;
1149
1150     # if we have a ", replace the content to discard temporarily any and/or/not inside
1151     my $commacontent;
1152     if ($string =~/"/) {
1153         $string =~ s/"(.*?)"/__X__/;
1154         $commacontent = $1;
1155                 warn "commacontent : $commacontent" if $DEBUG;
1156     }
1157     # split the query string in 3 parts : X AND Y means : $left="X", $operand="AND" and $right="Y"
1158     # then, call again NZanalyse with $left and $right
1159     # (recursive until we find a leaf (=> something without and/or/not)
1160     $string =~ /(.*)( and | or | not | AND | OR | NOT )(.*)/;
1161     my $left = $1;
1162     my $right = $3;
1163     my $operand = lc($2); # FIXME: and/or/not are operators, not operands
1164     # it's not a leaf, we have a and/or/not
1165     if ($operand) {
1166         # reintroduce comma content if needed
1167         $right =~ s/__X__/"$commacontent"/ if $commacontent;
1168         $left =~ s/__X__/"$commacontent"/ if $commacontent;
1169         warn "node : $left / $operand / $right\n" if $DEBUG;
1170         my $leftresult = NZanalyse($left,$server);
1171         my $rightresult = NZanalyse($right,$server);
1172         # OK, we have the results for right and left part of the query
1173         # depending of operand, intersect, union or exclude both lists
1174         # to get a result list
1175         if ($operand eq ' and ') {
1176             my @leftresult = split /;/, $leftresult;
1177 #             my @rightresult = split /;/,$leftresult;
1178             my $finalresult;
1179             # parse the left results, and if the biblionumber exist in the right result, save it in finalresult
1180             # the result is stored twice, to have the same weight for AND than OR.
1181             # example : TWO : 61,61,64,121 (two is twice in the biblio #61) / TOWER : 61,64,130
1182             # result : 61,61,61,61,64,64 for two AND tower : 61 has more weight than 64
1183             foreach (@leftresult) {
1184                 if ($rightresult =~ "$_;") {
1185                     $finalresult .= "$_;$_;";
1186                 }
1187             }
1188             return $finalresult;
1189         } elsif ($operand eq ' or ') {
1190             # just merge the 2 strings
1191             return $leftresult.$rightresult;
1192         } elsif ($operand eq ' not ') {
1193             my @leftresult = split /;/, $leftresult;
1194 #             my @rightresult = split /;/,$leftresult;
1195             my $finalresult;
1196             foreach (@leftresult) {
1197                 unless ($rightresult =~ "$_;") {
1198                     $finalresult .= "$_;";
1199                 }
1200             }
1201             return $finalresult;
1202         } else {
1203             # this error is impossible, because of the regexp that isolate the operand, but just in case...
1204             die "error : operand unknown : $operand for $string";
1205         }
1206     # it's a leaf, do the real SQL query and return the result
1207     } else {
1208         $string =~  s/__X__/"$commacontent"/ if $commacontent;
1209         $string =~ s/-|\.|\?|,|;|!|'|\(|\)|\[|\]|{|}|"|&|\+|\*|\// /g;
1210          warn "leaf : $string\n" if $DEBUG;
1211         # parse the string in in operator/operand/value again
1212         $string =~ /(.*)(>=|<=)(.*)/;
1213         my $left = $1;
1214         my $operator = $2;
1215         my $right = $3;
1216         unless ($operator) {
1217             $string =~ /(.*)(>|<|=)(.*)/;
1218             $left = $1;
1219             $operator = $2;
1220             $right = $3;
1221         }
1222         my $results;
1223         # automatic replace for short operators
1224         $left='title' if $left =~ '^ti';
1225         $left='author' if $left =~ '^au';
1226         $left='publisher' if $left =~ '^pb';
1227         $left='subject' if $left =~ '^su';
1228         $left='koha-Auth-Number' if $left =~ '^an';
1229         $left='keyword' if $left =~ '^kw';
1230         if ($operator) {
1231             #do a specific search
1232             my $dbh = C4::Context->dbh;
1233             $operator='LIKE' if $operator eq '=' and $right=~ /%/;
1234             my $sth = $dbh->prepare("SELECT biblionumbers,value FROM nozebra WHERE server=? AND indexname=? AND value $operator ?");
1235             warn "$left / $operator / $right\n";
1236             # split each word, query the DB and build the biblionumbers result
1237             foreach (split / /,$right) {
1238                 my ($biblionumbers,$value);
1239                 next unless $_;
1240                 warn "EXECUTE : $server, $left, $_";
1241                 $sth->execute($server, $left, $_) or warn "execute failed: $!";
1242                 while (my ($line,$value) = $sth->fetchrow) {
1243                     # if we are dealing with a numeric value, use only numeric results (in case of >=, <=, > or <)
1244                     # otherwise, fill the result
1245                     $biblionumbers .= $line unless ($right =~ /\d/ && $value =~ /\D/);
1246                     warn "result : $value ". ($right =~ /\d/) . "==".(!$value =~ /\d/) ;#= $line";
1247                 }
1248                 # do a AND with existing list if there is one, otherwise, use the biblionumbers list as 1st result list
1249                 if ($results) {
1250                     my @leftresult = split /;/, $biblionumbers;
1251                     my $temp;
1252                     foreach my $entry (@leftresult) { # $_ contains biblionumber,title-weight
1253                         # remove weight at the end
1254                         my $cleaned = $entry;
1255                         $cleaned =~ s/-\d*$//;
1256                         # if the entry already in the hash, take it & increase weight
1257                          warn "===== $cleaned =====" if $DEBUG;
1258                         if ($results =~ "$cleaned") {
1259                             $temp .= "$entry;$entry;";
1260                              warn "INCLUDING $entry" if $DEBUG;
1261                         }
1262                     }
1263                     $results = $temp;
1264                 } else {
1265                     $results = $biblionumbers;
1266                 }
1267             }
1268         } else {
1269             #do a complete search (all indexes)
1270             my $dbh = C4::Context->dbh;
1271             my $sth = $dbh->prepare("SELECT biblionumbers FROM nozebra WHERE server=? AND value LIKE ?");
1272             # split each word, query the DB and build the biblionumbers result
1273             foreach (split / /,$string) {
1274                 next if C4::Context->stopwords->{uc($_)}; # skip if stopword
1275                 warn "search on all indexes on $_" if $DEBUG;
1276                 my $biblionumbers;
1277                 next unless $_;
1278                 $sth->execute($server, $_);
1279                 while (my $line = $sth->fetchrow) {
1280                     $biblionumbers .= $line;
1281                 }
1282                 # do a AND with existing list if there is one, otherwise, use the biblionumbers list as 1st result list
1283                 if ($results) {
1284                  warn "RES for $_ = $biblionumbers" if $DEBUG;
1285                     my @leftresult = split /;/, $biblionumbers;
1286                     my $temp;
1287                     foreach my $entry (@leftresult) { # $_ contains biblionumber,title-weight
1288                         # remove weight at the end
1289                         my $cleaned = $entry;
1290                         $cleaned =~ s/-\d*$//;
1291                         # if the entry already in the hash, take it & increase weight
1292                          warn "===== $cleaned =====" if $DEBUG;
1293                         if ($results =~ "$cleaned") {
1294                             $temp .= "$entry;$entry;";
1295                              warn "INCLUDING $entry" if $DEBUG;
1296                         }
1297                     }
1298                     $results = $temp;
1299                 } else {
1300                  warn "NEW RES for $_ = $biblionumbers" if $DEBUG;
1301                     $results = $biblionumbers;
1302                 }
1303             }
1304         }
1305          warn "return : $results for LEAF : $string" if $DEBUG;
1306         return $results;
1307     }
1308 }
1309
1310 =head2 NZorder
1311
1312   $finalresult = NZorder($biblionumbers, $ordering,$results_per_page,$offset);
1313
1314   TODO :: Description
1315
1316 =cut
1317
1318
1319 sub NZorder {
1320     my ($biblionumbers, $ordering,$results_per_page,$offset) = @_;
1321     # order title asc by default
1322 #     $ordering = '1=36 <i' unless $ordering;
1323     $results_per_page=20 unless $results_per_page;
1324     $offset = 0 unless $offset;
1325     my $dbh = C4::Context->dbh;
1326     #
1327     # order by POPULARITY
1328     #
1329     if ($ordering =~ /popularity/) {
1330         my %result;
1331         my %popularity;
1332         # popularity is not in MARC record, it's builded from a specific query
1333         my $sth = $dbh->prepare("select sum(issues) from items where biblionumber=?");
1334         foreach (split /;/,$biblionumbers) {
1335             my ($biblionumber,$title) = split /,/,$_;
1336             $result{$biblionumber}=GetMarcBiblio($biblionumber);
1337             $sth->execute($biblionumber);
1338             my $popularity= $sth->fetchrow ||0;
1339             # hint : the key is popularity.title because we can have
1340             # many results with the same popularity. In this cas, sub-ordering is done by title
1341             # we also have biblionumber to avoid bug for 2 biblios with the same title & popularity
1342             # (un-frequent, I agree, but we won't forget anything that way ;-)
1343             $popularity{sprintf("%10d",$popularity).$title.$biblionumber} = $biblionumber;
1344         }
1345         # sort the hash and return the same structure as GetRecords (Zebra querying)
1346         my $result_hash;
1347         my $numbers=0;
1348         if ($ordering eq 'popularity_dsc') { # sort popularity DESC
1349             foreach my $key (sort {$b cmp $a} (keys %popularity)) {
1350                 $result_hash->{'RECORDS'}[$numbers++] = $result{$popularity{$key}}->as_usmarc();
1351             }
1352         } else { # sort popularity ASC
1353             foreach my $key (sort (keys %popularity)) {
1354                 $result_hash->{'RECORDS'}[$numbers++] = $result{$popularity{$key}}->as_usmarc();
1355             }
1356         }
1357         my $finalresult=();
1358         $result_hash->{'hits'} = $numbers;
1359         $finalresult->{'biblioserver'} = $result_hash;
1360         return $finalresult;
1361     #
1362     # ORDER BY author
1363     #
1364     } elsif ($ordering =~/author/){
1365         my %result;
1366         foreach (split /;/,$biblionumbers) {
1367             my ($biblionumber,$title) = split /,/,$_;
1368             my $record=GetMarcBiblio($biblionumber);
1369             my $author;
1370             if (C4::Context->preference('marcflavour') eq 'UNIMARC') {
1371                 $author=$record->subfield('200','f');
1372                 $author=$record->subfield('700','a') unless $author;
1373             } else {
1374                 $author=$record->subfield('100','a');
1375             }
1376             # hint : the result is sorted by title.biblionumber because we can have X biblios with the same title
1377             # and we don't want to get only 1 result for each of them !!!
1378             $result{$author.$biblionumber}=$record;
1379         }
1380         # sort the hash and return the same structure as GetRecords (Zebra querying)
1381         my $result_hash;
1382         my $numbers=0;
1383         if ($ordering eq 'author_za') { # sort by author desc
1384             foreach my $key (sort { $b cmp $a } (keys %result)) {
1385                 $result_hash->{'RECORDS'}[$numbers++] = $result{$key}->as_usmarc();
1386             }
1387         } else { # sort by author ASC
1388             foreach my $key (sort (keys %result)) {
1389                 $result_hash->{'RECORDS'}[$numbers++] = $result{$key}->as_usmarc();
1390             }
1391         }
1392         my $finalresult=();
1393         $result_hash->{'hits'} = $numbers;
1394         $finalresult->{'biblioserver'} = $result_hash;
1395         return $finalresult;
1396     #
1397     # ORDER BY callnumber
1398     #
1399     } elsif ($ordering =~/callnumber/){
1400         my %result;
1401         foreach (split /;/,$biblionumbers) {
1402             my ($biblionumber,$title) = split /,/,$_;
1403             my $record=GetMarcBiblio($biblionumber);
1404             my $callnumber;
1405             my ($callnumber_tag,$callnumber_subfield)=GetMarcFromKohaField($dbh,'items.itemcallnumber');
1406             ($callnumber_tag,$callnumber_subfield)= GetMarcFromKohaField('biblioitems.callnumber') unless $callnumber_tag;
1407             if (C4::Context->preference('marcflavour') eq 'UNIMARC') {
1408                 $callnumber=$record->subfield('200','f');
1409             } else {
1410                 $callnumber=$record->subfield('100','a');
1411             }
1412             # hint : the result is sorted by title.biblionumber because we can have X biblios with the same title
1413             # and we don't want to get only 1 result for each of them !!!
1414             $result{$callnumber.$biblionumber}=$record;
1415         }
1416         # sort the hash and return the same structure as GetRecords (Zebra querying)
1417         my $result_hash;
1418         my $numbers=0;
1419         if ($ordering eq 'call_number_dsc') { # sort by title desc
1420             foreach my $key (sort { $b cmp $a } (keys %result)) {
1421                 $result_hash->{'RECORDS'}[$numbers++] = $result{$key}->as_usmarc();
1422             }
1423         } else { # sort by title ASC
1424             foreach my $key (sort { $a cmp $b } (keys %result)) {
1425                 $result_hash->{'RECORDS'}[$numbers++] = $result{$key}->as_usmarc();
1426             }
1427         }
1428         my $finalresult=();
1429         $result_hash->{'hits'} = $numbers;
1430         $finalresult->{'biblioserver'} = $result_hash;
1431         return $finalresult;
1432     } elsif ($ordering =~ /pubdate/){ #pub year
1433         my %result;
1434         foreach (split /;/,$biblionumbers) {
1435             my ($biblionumber,$title) = split /,/,$_;
1436             my $record=GetMarcBiblio($biblionumber);
1437             my ($publicationyear_tag,$publicationyear_subfield)=GetMarcFromKohaField('biblioitems.publicationyear','');
1438             my $publicationyear=$record->subfield($publicationyear_tag,$publicationyear_subfield);
1439             # hint : the result is sorted by title.biblionumber because we can have X biblios with the same title
1440             # and we don't want to get only 1 result for each of them !!!
1441             $result{$publicationyear.$biblionumber}=$record;
1442         }
1443         # sort the hash and return the same structure as GetRecords (Zebra querying)
1444         my $result_hash;
1445         my $numbers=0;
1446         if ($ordering eq 'pubdate_dsc') { # sort by pubyear desc
1447             foreach my $key (sort { $b cmp $a } (keys %result)) {
1448                 $result_hash->{'RECORDS'}[$numbers++] = $result{$key}->as_usmarc();
1449             }
1450         } else { # sort by pub year ASC
1451             foreach my $key (sort (keys %result)) {
1452                 $result_hash->{'RECORDS'}[$numbers++] = $result{$key}->as_usmarc();
1453             }
1454         }
1455         my $finalresult=();
1456         $result_hash->{'hits'} = $numbers;
1457         $finalresult->{'biblioserver'} = $result_hash;
1458         return $finalresult;
1459     #
1460     # ORDER BY title
1461     #
1462     } elsif ($ordering =~ /title/) {
1463         # the title is in the biblionumbers string, so we just need to build a hash, sort it and return
1464         my %result;
1465         foreach (split /;/,$biblionumbers) {
1466             my ($biblionumber,$title) = split /,/,$_;
1467             # hint : the result is sorted by title.biblionumber because we can have X biblios with the same title
1468             # and we don't want to get only 1 result for each of them !!!
1469             # hint & speed improvement : we can order without reading the record
1470             # so order, and read records only for the requested page !
1471             $result{$title.$biblionumber}=$biblionumber;
1472         }
1473         # sort the hash and return the same structure as GetRecords (Zebra querying)
1474         my $result_hash;
1475         my $numbers=0;
1476         if ($ordering eq 'title_az') { # sort by title desc
1477             foreach my $key (sort (keys %result)) {
1478                 $result_hash->{'RECORDS'}[$numbers++] = $result{$key};
1479             }
1480         } else { # sort by title ASC
1481             foreach my $key (sort { $b cmp $a } (keys %result)) {
1482                 $result_hash->{'RECORDS'}[$numbers++] = $result{$key};
1483             }
1484         }
1485         # limit the $results_per_page to result size if it's more
1486         $results_per_page = $numbers-1 if $numbers < $results_per_page;
1487         # for the requested page, replace biblionumber by the complete record
1488         # speed improvement : avoid reading too much things
1489         for (my $counter=$offset;$counter<=$offset+$results_per_page;$counter++) {
1490             $result_hash->{'RECORDS'}[$counter] = GetMarcBiblio($result_hash->{'RECORDS'}[$counter])->as_usmarc;
1491         }
1492         my $finalresult=();
1493         $result_hash->{'hits'} = $numbers;
1494         $finalresult->{'biblioserver'} = $result_hash;
1495         return $finalresult;
1496     } else {
1497     #
1498     # order by ranking
1499     #
1500         # we need 2 hashes to order by ranking : the 1st one to count the ranking, the 2nd to order by ranking
1501         my %result;
1502         my %count_ranking;
1503         foreach (split /;/,$biblionumbers) {
1504             my ($biblionumber,$title) = split /,/,$_;
1505             $title =~ /(.*)-(\d)/;
1506             # get weight
1507             my $ranking =$2;
1508             # note that we + the ranking because ranking is calculated on weight of EACH term requested.
1509             # if we ask for "two towers", and "two" has weight 2 in biblio N, and "towers" has weight 4 in biblio N
1510             # biblio N has ranking = 6
1511             $count_ranking{$biblionumber} += $ranking;
1512         }
1513         # build the result by "inverting" the count_ranking hash
1514         # 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
1515 #         warn "counting";
1516         foreach (keys %count_ranking) {
1517             $result{sprintf("%10d",$count_ranking{$_}).'-'.$_} = $_;
1518         }
1519         # sort the hash and return the same structure as GetRecords (Zebra querying)
1520         my $result_hash;
1521         my $numbers=0;
1522             foreach my $key (sort {$b cmp $a} (keys %result)) {
1523                 $result_hash->{'RECORDS'}[$numbers++] = $result{$key};
1524             }
1525         # limit the $results_per_page to result size if it's more
1526         $results_per_page = $numbers-1 if $numbers < $results_per_page;
1527         # for the requested page, replace biblionumber by the complete record
1528         # speed improvement : avoid reading too much things
1529         for (my $counter=$offset;$counter<=$offset+$results_per_page;$counter++) {
1530             $result_hash->{'RECORDS'}[$counter] = GetMarcBiblio($result_hash->{'RECORDS'}[$counter])->as_usmarc if $result_hash->{'RECORDS'}[$counter];
1531         }
1532         my $finalresult=();
1533         $result_hash->{'hits'} = $numbers;
1534         $finalresult->{'biblioserver'} = $result_hash;
1535         return $finalresult;
1536     }
1537 }
1538 =head2 ModBiblios
1539
1540 ($countchanged,$listunchanged) = ModBiblios($listbiblios, $tagsubfield,$initvalue,$targetvalue,$test);
1541
1542 this function changes all the values $initvalue in subfield $tag$subfield in any record in $listbiblios
1543 test parameter if set donot perform change to records in database.
1544
1545 =over 2
1546
1547 =item C<input arg:>
1548
1549     * $listbiblios is an array ref to marcrecords to be changed
1550     * $tagsubfield is the reference of the subfield to change.
1551     * $initvalue is the value to search the record for
1552     * $targetvalue is the value to set the subfield to
1553     * $test is to be set only not to perform changes in database.
1554
1555 =item C<Output arg:>
1556     * $countchanged counts all the changes performed.
1557     * $listunchanged contains the list of all the biblionumbers of records unchanged.
1558
1559 =item C<usage in the script:>
1560
1561 =back
1562
1563 my ($countchanged, $listunchanged) = EditBiblios($results->{RECORD}, $tagsubfield,$initvalue,$targetvalue);;
1564 #If one wants to display unchanged records, you should get biblios foreach @$listunchanged
1565 $template->param(countchanged => $countchanged, loopunchanged=>$listunchanged);
1566
1567 =cut
1568
1569 sub ModBiblios{
1570   my ($listbiblios,$tagsubfield,$initvalue,$targetvalue,$test)=@_;
1571   my $countmatched;
1572   my @unmatched;
1573   my ($tag,$subfield)=($1,$2) if ($tagsubfield=~/^(\d{1,3})([a-z0-9A-Z@])?$/);
1574   if ((length($tag)<3)&& $subfield=~/0-9/){
1575     $tag=$tag.$subfield;
1576     undef $subfield;
1577   }
1578   my ($bntag,$bnsubf) = GetMarcFromKohaField('biblio.biblionumber');
1579   my ($itemtag,$itemsubf) = GetMarcFromKohaField('items.itemnumber');
1580   foreach my $usmarc (@$listbiblios){
1581     my $record;
1582     $record=eval{MARC::Record->new_from_usmarc($usmarc)};
1583     my $biblionumber;
1584     if ($@){
1585       # usmarc is not a valid usmarc May be a biblionumber
1586       if ($tag eq $itemtag){
1587         my $bib=GetBiblioFromItemNumber($usmarc);
1588         $record=GetMarcItem($bib->{'biblionumber'},$usmarc) ;
1589         $biblionumber=$bib->{'biblionumber'};
1590       } else {
1591         $record=GetMarcBiblio($usmarc);
1592         $biblionumber=$usmarc;
1593       }
1594     }  else {
1595       if ($bntag >= 010){
1596         $biblionumber = $record->subfield($bntag,$bnsubf);
1597       }else {
1598         $biblionumber=$record->field($bntag)->data;
1599       }
1600     }
1601     #GetBiblionumber is to be written.
1602     #Could be replaced by TransformMarcToKoha (But Would be longer)
1603     if ($record->field($tag)){
1604       my $modify=0;
1605       foreach my $field ($record->field($tag)){
1606         if ($subfield){
1607           if ($field->delete_subfield('code' =>$subfield,'match'=>qr($initvalue))){
1608             $countmatched++;
1609             $modify=1;
1610             $field->update($subfield,$targetvalue) if ($targetvalue);
1611           }
1612         } else {
1613           if ($tag >= 010){
1614             if ($field->delete_field($field)){
1615               $countmatched++;
1616               $modify=1;
1617             }
1618           } else {
1619             $field->data=$targetvalue if ($field->data=~qr($initvalue));
1620           }
1621         }
1622       }
1623 #       warn $record->as_formatted;
1624       if ($modify){
1625         ModBiblio($record,$biblionumber,GetFrameworkCode($biblionumber)) unless ($test);
1626       } else {
1627         push @unmatched, $biblionumber;
1628       }
1629     } else {
1630       push @unmatched, $biblionumber;
1631     }
1632   }
1633   return ($countmatched,\@unmatched);
1634 }
1635
1636 END { }    # module clean-up code here (global destructor)
1637
1638 1;
1639 __END__
1640
1641 =head1 AUTHOR
1642
1643 Koha Developement team <info@koha.org>
1644
1645 =cut