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