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
 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},
 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
 992 # FIXME
 993 #  Ugh ... this is ugly, I'll re-write it better above then delete it
 994 #     my $norequests = 1;
 995 #     my $noitems    = 1;
 996 #     if (@items) {
 997 #         $noitems = 0;
 998 #         foreach my $itm (@items) {
 999 #             $norequests = 0 unless $itm->{'itemnotforloan'};
1000 #         }
1001 #     }
1002 #     $oldbiblio->{'noitems'} = $noitems;
1003 #     $oldbiblio->{'norequests'} = $norequests;
1004 #     $oldbiblio->{'even'} = $even = not $even;
1005 #     $oldbiblio->{'itemcount'} = $counts{'total'};
1006 #     my $totalitemcounts = 0;
1007 #     foreach my $key (keys %counts){
1008 #         if ($key ne 'total'){
1009 #             $totalitemcounts+= $counts{$key};
1010 #             $oldbiblio->{'locationhash'}->{$key}=$counts{$key};
1011 #         }
1012 #     }
1013 #     my ($locationtext, $locationtextonly, $notavailabletext) = ('','','');
1014 #     foreach (sort keys %{$oldbiblio->{'locationhash'}}) {
1015 #         if ($_ eq 'notavailable') {
1016 #             $notavailabletext="Not available";
1017 #             my $c=$oldbiblio->{'locationhash'}->{$_};
1018 #             $oldbiblio->{'not-available-p'}=$c;
1019 #         } else {
1020 #             $locationtext.="$_";
1021 #             my $c=$oldbiblio->{'locationhash'}->{$_};
1022 #             if ($_ eq 'Item Lost') {
1023 #                 $oldbiblio->{'lost-p'} = $c;
1024 #             } elsif ($_ eq 'Withdrawn') {
1025 #                 $oldbiblio->{'withdrawn-p'} = $c;
1026 #             } elsif ($_ eq 'On Loan') {
1027 #                 $oldbiblio->{'on-loan-p'} = $c;
1028 #             } else {
1029 #                 $locationtextonly.= $_;
1030 #                 $locationtextonly.= " ($c)<br/> " if $totalitemcounts > 1;
1031 #             }
1032 #             if ($totalitemcounts>1) {
1033 #                 $locationtext.=" ($c)<br/> ";
1034 #             }
1035 #         }
1036 #     }
1037 #     if ($notavailabletext) {
1038 #         $locationtext.= $notavailabletext;
1039 #     } else {
1040 #         $locationtext=~s/, $//;
1041 #     }
1042 #     $oldbiblio->{'location'} = $locationtext;
1043 #     $oldbiblio->{'location-only'} = $locationtextonly;
1044 #     $oldbiblio->{'use-location-flags-p'} = 1;
1045
1046         push( @newresults, $oldbiblio );
1047     }
1048     return @newresults;
1049 }
1050
1051
1052 =head2 EditBiblios
1053
1054 ($countchanged,$listunchanged) = EditBiblios($listbiblios, $tagsubfield,$initvalue,$targetvalue,$test);
1055
1056 this function changes all the values $initvalue in subfield $tag$subfield in any record in $listbiblios
1057 test parameter if set donot perform change to records in database.
1058
1059 =over 2
1060
1061 =item C<input arg:>
1062
1063     * $listbiblios is an array ref to marcrecords to be changed
1064     * $tagsubfield is the reference of the subfield to change.
1065     * $initvalue is the value to search the record for
1066     * $targetvalue is the value to set the subfield to
1067     * $test is to be set only not to perform changes in database.
1068
1069 =item C<Output arg:>
1070     * $countchanged counts all the changes performed.
1071     * $listunchanged contains the list of all the biblionumbers of records unchanged.
1072
1073 =item C<usage in the script:>
1074
1075 =back
1076
1077 my ($countchanged, $listunchanged) = EditBiblios($results->{RECORD}, $tagsubfield,$initvalue,$targetvalue);;
1078 #If one wants to display unchanged records, you should get biblios foreach @$listunchanged
1079 $template->param(countchanged => $countchanged, loopunchanged=>$listunchanged);
1080
1081 =cut
1082 sub EditBiblios{
1083   my ($listbiblios,$tagsubfield,$initvalue,$targetvalue,$test)=@_;
1084   my $countmatched;
1085   my @unmatched;
1086   my ($tag,$subfield)=($1,$2) if ($tagsubfield=~/^(\d{1,3})(.)$/);
1087   my ($bntag,$bnsubf) = GetMarcFromKohaField('biblio.biblionumber');
1088
1089   foreach my $usmarc (@$listbiblios){
1090     my $record=MARC::Record->new_from_usmarc($usmarc);
1091     my $biblionumber;
1092     if ($bntag>10){
1093       $biblionumber = $record->subfield($bntag,$bnsubf);
1094     }else {
1095       $biblionumber=$record->field($bntag)->data;
1096     }
1097     #GetBiblionumber is to be written.
1098     #Could be replaced by TransformMarcToKoha (But Would be longer)
1099     if ($record->field($tag)){
1100       foreach my $field ($record->field($tag)){
1101         if ($field->delete_subfield('code' =>$subfield,'match'=>qr($initvalue))){
1102           $countmatched++;
1103           $field->update($subfield,$targetvalue) if ($targetvalue);
1104         }
1105       }
1106 #       warn $record->as_formatted;
1107       ModBiblio($record,$biblionumber,GetFrameworkCode($biblionumber)) unless ($test);
1108     } else {
1109       push @unmatched, $biblionumber;
1110     }
1111   }
1112   return ($countmatched,\@unmatched);
1113 }
1114
1115 #----------------------------------------------------------------------
1116 #
1117 # Non-Zebra GetRecords#
1118 #----------------------------------------------------------------------
1119
1120 =item
1121   NZgetRecords has the same API as zera getRecords, even if some parameters are not managed
1122 =cut
1123
1124 sub NZgetRecords {
1125     my (
1126         $koha_query,     $federated_query,  $sort_by_ref,
1127         $servers_ref,    $results_per_page, $offset,
1128         $expanded_facet, $branches,         $query_type,
1129         $scan
1130     ) = @_;
1131     my $result = NZanalyse($koha_query);
1132 #     use Data::Dumper;
1133 #     warn "==========".@$sort_by_ref[0];
1134     return (undef,NZorder($result,@$sort_by_ref[0],$results_per_page,$offset),undef);
1135 }
1136
1137 =item
1138
1139   NZanalyse : get a CQL string as parameter, and returns a list of biblionumber;title,biblionumber;title,...
1140   the list is builded from inverted index in nozebra SQL table
1141   note that title is here only for convenience : the sorting will be very fast when requested on title
1142   if the sorting is requested on something else, we will have to reread all results, and that may be longer.
1143
1144 =cut
1145
1146 sub NZanalyse {
1147     my ($string,$server) = @_;
1148     # $server contains biblioserver or authorities, depending on what we search on.
1149     warn "querying : $string on $server";
1150     $server='biblioserver' unless $server;
1151     # if we have a ", replace the content to discard temporarily any and/or/not inside
1152     my $commacontent;
1153     if ($string =~/"/) {
1154         $string =~ s/"(.*?)"/__X__/;
1155         $commacontent = $1;
1156 #         print "commacontent : $commacontent\n";
1157     }
1158     # split the query string in 3 parts : X AND Y means : $left="X", $operand="AND" and $right="Y"
1159     # then, call again NZanalyse with $left and $right
1160     # (recursive until we find a leaf (=> something without and/or/not)
1161     $string =~ /(.*)( and | or | not | AND | OR | NOT )(.*)/;
1162     my $left = $1;
1163     my $right = $3;
1164     my $operand = lc($2);
1165     # it's not a leaf, we have a and/or/not
1166     if ($operand) {
1167         # reintroduce comma content if needed
1168         $right =~ s/__X__/"$commacontent"/ if $commacontent;
1169         $left =~ s/__X__/"$commacontent"/ if $commacontent;
1170 #         warn "node : $left / $operand / $right\n";
1171         my $leftresult = NZanalyse($left,$server);
1172         my $rightresult = NZanalyse($right,$server);
1173         # OK, we have the results for right and left part of the query
1174         # depending of operand, intersect, union or exclude both lists
1175         # to get a result list
1176         if ($operand eq ' and ') {
1177             my @leftresult = split /;/, $leftresult;
1178 #             my @rightresult = split /;/,$leftresult;
1179             my $finalresult;
1180             # parse the left results, and if the biblionumber exist in the right result, save it in finalresult
1181             # the result is stored twice, to have the same weight for AND than OR.
1182             # example : TWO : 61,61,64,121 (two is twice in the biblio #61) / TOWER : 61,64,130
1183             # result : 61,61,61,61,64,64 for two AND tower : 61 has more weight than 64
1184             foreach (@leftresult) {
1185                 if ($rightresult =~ "$_;") {
1186                     $finalresult .= "$_;$_;";
1187                 }
1188             }
1189             return $finalresult;
1190         } elsif ($operand eq ' or ') {
1191             # just merge the 2 strings
1192             return $leftresult.$rightresult;
1193         } elsif ($operand eq ' not ') {
1194             my @leftresult = split /;/, $leftresult;
1195 #             my @rightresult = split /;/,$leftresult;
1196             my $finalresult;
1197             foreach (@leftresult) {
1198                 unless ($rightresult =~ "$_;") {
1199                     $finalresult .= "$_;";
1200                 }
1201             }
1202             return $finalresult;
1203         } else {
1204             # this error is impossible, because of the regexp that isolate the operand, but just in case...
1205             die "error : operand unknown : $operand for $string";
1206         }
1207     # it's a leaf, do the real SQL query and return the result
1208     } else {
1209         $string =~  s/__X__/"$commacontent"/ if $commacontent;
1210         $string =~ s/-|\.|\?|,|;|!|'|\(|\)|\[|\]|{|}|"|<|>|&|\+|\*|\// /g;
1211 #         warn "leaf : $string\n";
1212         # parse the string in in operator/operand/value again
1213         $string =~ /(.*)(=|>|>=|<|<=)(.*)/;
1214         my $left = $1;
1215         my $operator = $2;
1216         my $right = $3;
1217         my $results;
1218         # automatic replace for short operators
1219         $left='title' if $left eq 'ti';
1220         $left='author' if $left eq 'au';
1221         $left='publisher' if $left eq 'pb';
1222         $left='subject' if $left eq 'su';
1223         $left='koha-Auth-Number' if $left eq 'an';
1224         if ($operator) {
1225             #do a specific search
1226             my $dbh = C4::Context->dbh;
1227             $operator='LIKE' if $operator eq '=' and $right=~ /%/;
1228             my $sth = $dbh->prepare("SELECT biblionumbers FROM nozebra WHERE server=? AND indexname=? AND value $operator ?");
1229             warn "$left / $operator / $right\n";
1230             # split each word, query the DB and build the biblionumbers result
1231             foreach (split / /,$right) {
1232                 my $biblionumbers;
1233                 next unless $_;
1234 #                 warn "EXECUTE : $server, $left, $_";
1235                 $sth->execute($server, $left, $_);
1236                 while (my $line = $sth->fetchrow) {
1237                     $biblionumbers .= $line;
1238 #                     warn "result : $line";
1239                 }
1240                 # do a AND with existing list if there is one, otherwise, use the biblionumbers list as 1st result list
1241                 if ($results) {
1242                     my @leftresult = split /;/, $biblionumbers;
1243                     my $temp;
1244                     foreach (@leftresult) {
1245                         if ($results =~ "$_;") {
1246                             $temp .= "$_;$_;";
1247                         }
1248                     }
1249                     $results = $temp;
1250                 } else {
1251                     $results = $biblionumbers;
1252                 }
1253             }
1254         } else {
1255             #do a complete search (all indexes)
1256             my $dbh = C4::Context->dbh;
1257             my $sth = $dbh->prepare("SELECT biblionumbers FROM nozebra WHERE server=? AND value LIKE ?");
1258             # split each word, query the DB and build the biblionumbers result
1259             foreach (split / /,$string) {
1260 #                 warn "search on all indexes on $_";
1261                 my $biblionumbers;
1262                 next unless $_;
1263                 $sth->execute($server, $_);
1264                 while (my $line = $sth->fetchrow) {
1265                     $biblionumbers .= $line;
1266                 }
1267                 # do a AND with existing list if there is one, otherwise, use the biblionumbers list as 1st result list
1268                 if ($results) {
1269                     my @leftresult = split /;/, $biblionumbers;
1270                     my $temp;
1271                     foreach (@leftresult) {
1272                         if ($results =~ "$_;") {
1273                             $temp .= "$_;$_;";
1274                         }
1275                     }
1276                     $results = $temp;
1277                 } else {
1278                     $results = $biblionumbers;
1279                 }
1280             }
1281         }
1282 #         warn "return : $results for LEAF : $string";
1283         return $results;
1284     }
1285 }
1286
1287 sub NZorder {
1288     my ($biblionumbers, $ordering,$results_per_page,$offset) = @_;
1289     # order title asc by default
1290 #     $ordering = '1=36 <i' unless $ordering;
1291     $results_per_page=20 unless $results_per_page;
1292     $offset = 0 unless $offset;
1293     my $dbh = C4::Context->dbh;
1294     #
1295     # order by POPULARITY
1296     #
1297     if ($ordering =~ /1=9523/) {
1298         my %result;
1299         my %popularity;
1300         # popularity is not in MARC record, it's builded from a specific query
1301         my $sth = $dbh->prepare("select sum(issues) from items where biblionumber=?");
1302         foreach (split /;/,$biblionumbers) {
1303             my ($biblionumber,$title) = split /,/,$_;
1304             $result{$biblionumber}=GetMarcBiblio($biblionumber);
1305             $sth->execute($biblionumber);
1306             my $popularity= $sth->fetchrow ||0;
1307             # hint : the key is popularity.title because we can have
1308             # many results with the same popularity. In this cas, sub-ordering is done by title
1309             # we also have biblionumber to avoid bug for 2 biblios with the same title & popularity
1310             # (un-frequent, I agree, but we won't forget anything that way ;-)
1311             $popularity{sprintf("%10d",$popularity).$title.$biblionumber} = $biblionumber;
1312         }
1313         # sort the hash and return the same structure as GetRecords (Zebra querying)
1314         my $result_hash;
1315         my $numbers=0;
1316         if ($ordering eq '1=9523 >i') { # sort popularity DESC
1317             foreach my $key (sort {$b cmp $a} (keys %popularity)) {
1318                 $result_hash->{'RECORDS'}[$numbers++] = $result{$popularity{$key}}->as_usmarc();
1319             }
1320         } else { # sort popularity ASC
1321             foreach my $key (sort (keys %popularity)) {
1322                 $result_hash->{'RECORDS'}[$numbers++] = $result{$popularity{$key}}->as_usmarc();
1323             }
1324         }
1325         my $finalresult=();
1326         $result_hash->{'hits'} = $numbers;
1327         $finalresult->{'biblioserver'} = $result_hash;
1328         return $finalresult;
1329     #
1330     # ORDER BY author
1331     #
1332     } elsif ($ordering eq '1=1003 <i'){
1333         my %result;
1334         foreach (split /;/,$biblionumbers) {
1335             my ($biblionumber,$title) = split /,/,$_;
1336             my $record=GetMarcBiblio($biblionumber);
1337             my $author;
1338             if (C4::Context->preference('marcflavour') eq 'UNIMARC') {
1339                 $author=$record->subfield('200','f');
1340                 $author=$record->subfield('700','a') unless $author;
1341             } else {
1342                 $author=$record->subfield('100','a');
1343             }
1344             # hint : the result is sorted by title.biblionumber because we can have X biblios with the same title
1345             # and we don't want to get only 1 result for each of them !!!
1346             $result{$author.$biblionumber}=$record;
1347         }
1348         # sort the hash and return the same structure as GetRecords (Zebra querying)
1349         my $result_hash;
1350         my $numbers=0;
1351         if ($ordering eq '1=1003 <i') { # sort by author desc
1352             foreach my $key (sort (keys %result)) {
1353                 $result_hash->{'RECORDS'}[$numbers++] = $result{$key}->as_usmarc();
1354             }
1355         } else { # sort by author ASC
1356             foreach my $key (sort { $a cmp $b } (keys %result)) {
1357                 $result_hash->{'RECORDS'}[$numbers++] = $result{$key}->as_usmarc();
1358             }
1359         }
1360         my $finalresult=();
1361         $result_hash->{'hits'} = $numbers;
1362         $finalresult->{'biblioserver'} = $result_hash;
1363         return $finalresult;
1364     #
1365     # ORDER BY callnumber
1366     #
1367     } elsif ($ordering eq '1=20 <i'){
1368         my %result;
1369         foreach (split /;/,$biblionumbers) {
1370             my ($biblionumber,$title) = split /,/,$_;
1371             my $record=GetMarcBiblio($biblionumber);
1372             my $callnumber;
1373             my ($callnumber_tag,$callnumber_subfield)=GetMarcFromKohaField($dbh,'items.itemcallnumber');
1374             ($callnumber_tag,$callnumber_subfield)= GetMarcFromKohaField('biblioitems.callnumber') unless $callnumber_tag;
1375             if (C4::Context->preference('marcflavour') eq 'UNIMARC') {
1376                 $callnumber=$record->subfield('200','f');
1377             } else {
1378                 $callnumber=$record->subfield('100','a');
1379             }
1380             # hint : the result is sorted by title.biblionumber because we can have X biblios with the same title
1381             # and we don't want to get only 1 result for each of them !!!
1382             $result{$callnumber.$biblionumber}=$record;
1383         }
1384         # sort the hash and return the same structure as GetRecords (Zebra querying)
1385         my $result_hash;
1386         my $numbers=0;
1387         if ($ordering eq '1=1003 <i') { # sort by title desc
1388             foreach my $key (sort (keys %result)) {
1389                 $result_hash->{'RECORDS'}[$numbers++] = $result{$key}->as_usmarc();
1390             }
1391         } else { # sort by title ASC
1392             foreach my $key (sort { $a cmp $b } (keys %result)) {
1393                 $result_hash->{'RECORDS'}[$numbers++] = $result{$key}->as_usmarc();
1394             }
1395         }
1396         my $finalresult=();
1397         $result_hash->{'hits'} = $numbers;
1398         $finalresult->{'biblioserver'} = $result_hash;
1399         return $finalresult;
1400     } elsif ($ordering =~ /1=31/){ #pub year
1401         my %result;
1402         foreach (split /;/,$biblionumbers) {
1403             my ($biblionumber,$title) = split /,/,$_;
1404             my $record=GetMarcBiblio($biblionumber);
1405             my ($publicationyear_tag,$publicationyear_subfield)=GetMarcFromKohaField($dbh,'biblioitems.publicationyear');
1406             my $publicationyear=$record->subfield($publicationyear_tag,$publicationyear_subfield);
1407             # hint : the result is sorted by title.biblionumber because we can have X biblios with the same title
1408             # and we don't want to get only 1 result for each of them !!!
1409             $result{$publicationyear.$biblionumber}=$record;
1410         }
1411         # sort the hash and return the same structure as GetRecords (Zebra querying)
1412         my $result_hash;
1413         my $numbers=0;
1414         if ($ordering eq '1=31 <i') { # sort by pubyear desc
1415             foreach my $key (sort (keys %result)) {
1416                 $result_hash->{'RECORDS'}[$numbers++] = $result{$key}->as_usmarc();
1417             }
1418         } else { # sort by pub year ASC
1419             foreach my $key (sort { $b cmp $a } (keys %result)) {
1420                 $result_hash->{'RECORDS'}[$numbers++] = $result{$key}->as_usmarc();
1421             }
1422         }
1423         my $finalresult=();
1424         $result_hash->{'hits'} = $numbers;
1425         $finalresult->{'biblioserver'} = $result_hash;
1426         return $finalresult;
1427     #
1428     # ORDER BY title
1429     #
1430     } elsif ($ordering =~ /1=36/) {
1431         # the title is in the biblionumbers string, so we just need to build a hash, sort it and return
1432         my %result;
1433         foreach (split /;/,$biblionumbers) {
1434             my ($biblionumber,$title) = split /,/,$_;
1435             # hint : the result is sorted by title.biblionumber because we can have X biblios with the same title
1436             # and we don't want to get only 1 result for each of them !!!
1437             # hint & speed improvement : we can order without reading the record
1438             # so order, and read records only for the requested page !
1439             $result{$title.$biblionumber}=$biblionumber;
1440         }
1441         # sort the hash and return the same structure as GetRecords (Zebra querying)
1442         my $result_hash;
1443         my $numbers=0;
1444         if ($ordering eq '1=36 <i') { # sort by title desc
1445             foreach my $key (sort (keys %result)) {
1446                 $result_hash->{'RECORDS'}[$numbers++] = $result{$key};
1447             }
1448         } else { # sort by title ASC
1449             foreach my $key (sort { $b cmp $a } (keys %result)) {
1450                 $result_hash->{'RECORDS'}[$numbers++] = $result{$key};
1451             }
1452         }
1453         # limit the $results_per_page to result size if it's more
1454         $results_per_page = $numbers-1 if $numbers < $results_per_page;
1455         # for the requested page, replace biblionumber by the complete record
1456         # speed improvement : avoid reading too much things
1457         for (my $counter=$offset;$counter<=$offset+$results_per_page;$counter++) {
1458             $result_hash->{'RECORDS'}[$counter] = GetMarcBiblio($result_hash->{'RECORDS'}[$counter])->as_usmarc;
1459         }
1460         my $finalresult=();
1461         $result_hash->{'hits'} = $numbers;
1462         $finalresult->{'biblioserver'} = $result_hash;
1463         return $finalresult;
1464     } else {
1465     #
1466     # order by ranking
1467     #
1468         # we need 2 hashes to order by ranking : the 1st one to count the ranking, the 2nd to order by ranking
1469         my %result;
1470         my %count_ranking;
1471         foreach (split /;/,$biblionumbers) {
1472             my ($biblionumber,$title) = split /,/,$_;
1473             $title =~ /(.*)-(\d)/;
1474             # get weight
1475             my $ranking =$2;
1476             # note that we + the ranking because ranking is calculated on weight of EACH term requested.
1477             # if we ask for "two towers", and "two" has weight 2 in biblio N, and "towers" has weight 4 in biblio N
1478             # biblio N has ranking = 6
1479             $count_ranking{$biblionumber} += $ranking;
1480         }
1481         # build the result by "inverting" the count_ranking hash
1482         # 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
1483 #         warn "counting";
1484         foreach (keys %count_ranking) {
1485             $result{sprintf("%10d",$count_ranking{$_}).'-'.$_} = $_;
1486         }
1487         # sort the hash and return the same structure as GetRecords (Zebra querying)
1488         my $result_hash;
1489         my $numbers=0;
1490             foreach my $key (sort {$b cmp $a} (keys %result)) {
1491                 $result_hash->{'RECORDS'}[$numbers++] = $result{$key};
1492             }
1493         # limit the $results_per_page to result size if it's more
1494         $results_per_page = $numbers-1 if $numbers < $results_per_page;
1495         # for the requested page, replace biblionumber by the complete record
1496         # speed improvement : avoid reading too much things
1497         for (my $counter=$offset;$counter<=$offset+$results_per_page;$counter++) {
1498             $result_hash->{'RECORDS'}[$counter] = GetMarcBiblio($result_hash->{'RECORDS'}[$counter])->as_usmarc;
1499         }
1500         my $finalresult=();
1501         $result_hash->{'hits'} = $numbers;
1502         $finalresult->{'biblioserver'} = $result_hash;
1503         return $finalresult;
1504     }
1505 }
1506
1507 END { }    # module clean-up code here (global destructor)
1508
1509 1;
1510 __END__
1511
1512 =head1 AUTHOR
1513
1514 Koha Developement team <info@koha.org>
1515
1516 =cut