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