C4/Search.pm

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