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
   6 # under the terms of the GNU General Public License as published by
   7 # the Free Software Foundation; either version 3 of the License, or
   8 # (at your option) any later version.
   9 #
  10 # Koha is distributed in the hope that it will be useful, but
  11 # WITHOUT ANY WARRANTY; without even the implied warranty of
  12 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  13 # GNU General Public License for more details.
  14 #
  15 # You should have received a copy of the GNU General Public License
  16 # along with Koha; if not, see <http://www.gnu.org/licenses>.
  17
  18 use strict;
  19 #use warnings; FIXME - Bug 2505
  20 require Exporter;
  21 use C4::Context;
  22 use C4::Biblio;    # GetMarcFromKohaField, GetBiblioData
  23 use C4::Koha;      # getFacets
  24 use Koha::DateUtils;
  25 use Koha::Libraries;
  26 use Lingua::Stem;
  27 use C4::Search::PazPar2;
  28 use XML::Simple;
  29 use C4::XSLT;
  30 use C4::Reserves;    # GetReserveStatus
  31 use C4::Debug;
  32 use C4::Charset;
  33 use Koha::AuthorisedValues;
  34 use Koha::ItemTypes;
  35 use Koha::Libraries;
  36 use Koha::Patrons;
  37 use YAML;
  38 use URI::Escape;
  39 use Business::ISBN;
  40 use MARC::Record;
  41 use MARC::Field;
  42 use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $DEBUG);
  43
  44 BEGIN {
  45     $DEBUG = ($ENV{DEBUG}) ? 1 : 0;
  46 }
  47
  48 =head1 NAME
  49
  50 C4::Search - Functions for searching the Koha catalog.
  51
  52 =head1 SYNOPSIS
  53
  54 See opac/opac-search.pl or catalogue/search.pl for example of usage
  55
  56 =head1 DESCRIPTION
  57
  58 This module provides searching functions for Koha's bibliographic databases
  59
  60 =head1 FUNCTIONS
  61
  62 =cut
  63
  64 @ISA    = qw(Exporter);
  65 @EXPORT = qw(
  66   &FindDuplicate
  67   &SimpleSearch
  68   &searchResults
  69   &getRecords
  70   &buildQuery
  71   &GetDistinctValues
  72   &enabled_staff_search_views
  73 );
  74
  75 # make all your functions, whether exported or not;
  76
  77 =head2 FindDuplicate
  78
  79 ($biblionumber,$biblionumber,$title) = FindDuplicate($record);
  80
  81 This function attempts to find duplicate records using a hard-coded, fairly simplistic algorithm
  82
  83 =cut
  84
  85 sub FindDuplicate {
  86     my ($record) = @_;
  87     my $dbh = C4::Context->dbh;
  88     my $result = TransformMarcToKoha( $record, '' );
  89     my $sth;
  90     my $query;
  91     my $search;
  92     my $type;
  93     my ( $biblionumber, $title );
  94
  95     # search duplicate on ISBN, easy and fast..
  96     # ... normalize first
  97     if ( $result->{isbn} ) {
  98         $result->{isbn} =~ s/\(.*$//;
  99         $result->{isbn} =~ s/\s+$//;
 100         $query = "isbn:$result->{isbn}";
 101     }
 102     else {
 103         my $QParser;
 104         $QParser = C4::Context->queryparser if (C4::Context->preference('UseQueryParser'));
 105         my $titleindex;
 106         my $authorindex;
 107         my $op;
 108
 109         if ($QParser) {
 110             $titleindex = 'title|exact';
 111             $authorindex = 'author|exact';
 112             $op = '&&';
 113             $QParser->custom_data->{'QueryAutoTruncate'} = C4::Context->preference('QueryAutoTruncate');
 114         } else {
 115             $titleindex = 'ti,ext';
 116             $authorindex = 'au,ext';
 117             $op = 'and';
 118         }
 119
 120         $result->{title} =~ s /\\//g;
 121         $result->{title} =~ s /\"//g;
 122         $result->{title} =~ s /\(//g;
 123         $result->{title} =~ s /\)//g;
 124
 125         # FIXME: instead of removing operators, could just do
 126         # quotes around the value
 127         $result->{title} =~ s/(and|or|not)//g;
 128         $query = "$titleindex:\"$result->{title}\"";
 129         if   ( $result->{author} ) {
 130             $result->{author} =~ s /\\//g;
 131             $result->{author} =~ s /\"//g;
 132             $result->{author} =~ s /\(//g;
 133             $result->{author} =~ s /\)//g;
 134
 135             # remove valid operators
 136             $result->{author} =~ s/(and|or|not)//g;
 137             $query .= " $op $authorindex:\"$result->{author}\"";
 138         }
 139     }
 140
 141     my ( $error, $searchresults, undef ) = SimpleSearch($query); # FIXME :: hardcoded !
 142     my @results;
 143     if (!defined $error) {
 144         foreach my $possible_duplicate_record (@{$searchresults}) {
 145             my $marcrecord = new_record_from_zebra(
 146                 'biblioserver',
 147                 $possible_duplicate_record
 148             );
 149
 150             my $result = TransformMarcToKoha( $marcrecord, '' );
 151
 152             # FIXME :: why 2 $biblionumber ?
 153             if ($result) {
 154                 push @results, $result->{'biblionumber'};
 155                 push @results, $result->{'title'};
 156             }
 157         }
 158     }
 159     return @results;
 160 }
 161
 162 =head2 SimpleSearch
 163
 164 ( $error, $results, $total_hits ) = SimpleSearch( $query, $offset, $max_results, [@servers], [%options] );
 165
 166 This function provides a simple search API on the bibliographic catalog
 167
 168 =over 2
 169
 170 =item C<input arg:>
 171
 172     * $query can be a simple keyword or a complete CCL query
 173     * @servers is optional. Defaults to biblioserver as found in koha-conf.xml
 174     * $offset - If present, represents the number of records at the beginning to omit. Defaults to 0
 175     * $max_results - if present, determines the maximum number of records to fetch. undef is All. defaults to undef.
 176     * %options is optional. (e.g. "skip_normalize" allows you to skip changing : to = )
 177
 178
 179 =item C<Return:>
 180
 181     Returns an array consisting of three elements
 182     * $error is undefined unless an error is detected
 183     * $results is a reference to an array of records.
 184     * $total_hits is the number of hits that would have been returned with no limit
 185
 186     If an error is returned the two other return elements are undefined. If error itself is undefined
 187     the other two elements are always defined
 188
 189 =item C<usage in the script:>
 190
 191 =back
 192
 193 my ( $error, $marcresults, $total_hits ) = SimpleSearch($query);
 194
 195 if (defined $error) {
 196     $template->param(query_error => $error);
 197     warn "error: ".$error;
 198     output_html_with_http_headers $input, $cookie, $template->output;
 199     exit;
 200 }
 201
 202 my $hits = @{$marcresults};
 203 my @results;
 204
 205 for my $r ( @{$marcresults} ) {
 206     my $marcrecord = MARC::File::USMARC::decode($r);
 207     my $biblio = TransformMarcToKoha($marcrecord,q{});
 208
 209     #build the iarray of hashs for the template.
 210     push @results, {
 211         title           => $biblio->{'title'},
 212         subtitle        => $biblio->{'subtitle'},
 213         biblionumber    => $biblio->{'biblionumber'},
 214         author          => $biblio->{'author'},
 215         publishercode   => $biblio->{'publishercode'},
 216         publicationyear => $biblio->{'publicationyear'},
 217         };
 218
 219 }
 220
 221 $template->param(result=>\@results);
 222
 223 =cut
 224
 225 sub SimpleSearch {
 226     my ( $query, $offset, $max_results, $servers, %options )  = @_;
 227
 228     return ( 'No query entered', undef, undef ) unless $query;
 229     # FIXME hardcoded value. See catalog/search.pl & opac-search.pl too.
 230     my @servers = defined ( $servers ) ? @$servers : ( 'biblioserver' );
 231     my @zoom_queries;
 232     my @tmpresults;
 233     my @zconns;
 234     my $results = [];
 235     my $total_hits = 0;
 236
 237     my $QParser;
 238     $QParser = C4::Context->queryparser if (C4::Context->preference('UseQueryParser') && ! ($query =~ m/\w,\w|\w=\w/));
 239     if ($QParser) {
 240         $QParser->custom_data->{'QueryAutoTruncate'} = C4::Context->preference('QueryAutoTruncate');
 241     }
 242
 243     # Initialize & Search Zebra
 244     for ( my $i = 0 ; $i < @servers ; $i++ ) {
 245         eval {
 246             $zconns[$i] = C4::Context->Zconn( $servers[$i], 1 );
 247             if ($QParser) {
 248                 $query =~ s/=/:/g unless $options{skip_normalize};
 249                 $QParser->parse( $query );
 250                 $query = $QParser->target_syntax($servers[$i]);
 251                 $zoom_queries[$i] = new ZOOM::Query::PQF( $query, $zconns[$i]);
 252             } else {
 253                 $query =~ s/:/=/g unless $options{skip_normalize};
 254                 $zoom_queries[$i] = new ZOOM::Query::CCL2RPN( $query, $zconns[$i]);
 255             }
 256             $tmpresults[$i] = $zconns[$i]->search( $zoom_queries[$i] );
 257
 258             # error handling
 259             my $error =
 260                 $zconns[$i]->errmsg() . " ("
 261               . $zconns[$i]->errcode() . ") "
 262               . $zconns[$i]->addinfo() . " "
 263               . $zconns[$i]->diagset();
 264
 265             return ( $error, undef, undef ) if $zconns[$i]->errcode();
 266         };
 267         if ($@) {
 268
 269             # caught a ZOOM::Exception
 270             my $error =
 271                 $@->message() . " ("
 272               . $@->code() . ") "
 273               . $@->addinfo() . " "
 274               . $@->diagset();
 275             warn $error." for query: $query";
 276             return ( $error, undef, undef );
 277         }
 278     }
 279
 280     _ZOOM_event_loop(
 281         \@zconns,
 282         \@tmpresults,
 283         sub {
 284             my ($i, $size) = @_;
 285             my $first_record = defined($offset) ? $offset + 1 : 1;
 286             my $hits = $tmpresults[ $i - 1 ]->size();
 287             $total_hits += $hits;
 288             my $last_record = $hits;
 289             if ( defined $max_results && $offset + $max_results < $hits ) {
 290                 $last_record = $offset + $max_results;
 291             }
 292
 293             for my $j ( $first_record .. $last_record ) {
 294                 my $record = eval {
 295                   $tmpresults[ $i - 1 ]->record( $j - 1 )->raw()
 296                   ;    # 0 indexed
 297                 };
 298                 push @{$results}, $record if defined $record;
 299             }
 300         }
 301     );
 302
 303     foreach my $zoom_query (@zoom_queries) {
 304         $zoom_query->destroy();
 305     }
 306
 307     return ( undef, $results, $total_hits );
 308 }
 309
 310 =head2 getRecords
 311
 312 ( undef, $results_hashref, \@facets_loop ) = getRecords (
 313
 314         $koha_query,       $simple_query, $sort_by_ref,    $servers_ref,
 315         $results_per_page, $offset,       $expanded_facet, $branches,$itemtypes,
 316         $query_type,       $scan
 317     );
 318
 319 The all singing, all dancing, multi-server, asynchronous, scanning,
 320 searching, record nabbing, facet-building
 321
 322 See verbse embedded documentation.
 323
 324 =cut
 325
 326 sub getRecords {
 327     my (
 328         $koha_query,       $simple_query, $sort_by_ref,    $servers_ref,
 329         $results_per_page, $offset,       $expanded_facet, $branches,
 330         $itemtypes,        $query_type,   $scan,           $opac
 331     ) = @_;
 332
 333     my @servers = @$servers_ref;
 334     my @sort_by = @$sort_by_ref;
 335
 336     # Initialize variables for the ZOOM connection and results object
 337     my $zconn;
 338     my @zconns;
 339     my @results;
 340     my $results_hashref = ();
 341
 342     # TODO simplify this structure ( { branchcode => $branchname } is enought) and remove this parameter
 343     $branches ||= { map { $_->branchcode => { branchname => $_->branchname } } Koha::Libraries->search };
 344
 345     # Initialize variables for the faceted results objects
 346     my $facets_counter = {};
 347     my $facets_info    = {};
 348     my $facets         = getFacets();
 349
 350     my @facets_loop;    # stores the ref to array of hashes for template facets loop
 351
 352     ### LOOP THROUGH THE SERVERS
 353     for ( my $i = 0 ; $i < @servers ; $i++ ) {
 354         $zconns[$i] = C4::Context->Zconn( $servers[$i], 1 );
 355
 356 # perform the search, create the results objects
 357 # if this is a local search, use the $koha-query, if it's a federated one, use the federated-query
 358         my $query_to_use = ($servers[$i] =~ /biblioserver/) ? $koha_query : $simple_query;
 359
 360         #$query_to_use = $simple_query if $scan;
 361         warn $simple_query if ( $scan and $DEBUG );
 362
 363         # Check if we've got a query_type defined, if so, use it
 364         eval {
 365             if ($query_type) {
 366                 if ($query_type =~ /^ccl/) {
 367                     $query_to_use =~ s/\:/\=/g;    # change : to = last minute (FIXME)
 368                     $results[$i] = $zconns[$i]->search(new ZOOM::Query::CCL2RPN($query_to_use, $zconns[$i]));
 369                 } elsif ($query_type =~ /^cql/) {
 370                     $results[$i] = $zconns[$i]->search(new ZOOM::Query::CQL($query_to_use, $zconns[$i]));
 371                 } elsif ($query_type =~ /^pqf/) {
 372                     $results[$i] = $zconns[$i]->search(new ZOOM::Query::PQF($query_to_use, $zconns[$i]));
 373                 } else {
 374                     warn "Unknown query_type '$query_type'.  Results undetermined.";
 375                 }
 376             } elsif ($scan) {
 377                     $results[$i] = $zconns[$i]->scan(  new ZOOM::Query::CCL2RPN($query_to_use, $zconns[$i]));
 378             } else {
 379                     $results[$i] = $zconns[$i]->search(new ZOOM::Query::CCL2RPN($query_to_use, $zconns[$i]));
 380             }
 381         };
 382         if ($@) {
 383             warn "WARNING: query problem with $query_to_use " . $@;
 384         }
 385
 386         # Concatenate the sort_by limits and pass them to the results object
 387         # Note: sort will override rank
 388         my $sort_by;
 389         foreach my $sort (@sort_by) {
 390             if ( $sort eq "author_az" || $sort eq "author_asc" ) {
 391                 $sort_by .= "1=1003 <i ";
 392             }
 393             elsif ( $sort eq "author_za" || $sort eq "author_dsc" ) {
 394                 $sort_by .= "1=1003 >i ";
 395             }
 396             elsif ( $sort eq "popularity_asc" ) {
 397                 $sort_by .= "1=9003 <i ";
 398             }
 399             elsif ( $sort eq "popularity_dsc" ) {
 400                 $sort_by .= "1=9003 >i ";
 401             }
 402             elsif ( $sort eq "call_number_asc" ) {
 403                 $sort_by .= "1=8007  <i ";
 404             }
 405             elsif ( $sort eq "call_number_dsc" ) {
 406                 $sort_by .= "1=8007 >i ";
 407             }
 408             elsif ( $sort eq "pubdate_asc" ) {
 409                 $sort_by .= "1=31 <i ";
 410             }
 411             elsif ( $sort eq "pubdate_dsc" ) {
 412                 $sort_by .= "1=31 >i ";
 413             }
 414             elsif ( $sort eq "acqdate_asc" ) {
 415                 $sort_by .= "1=32 <i ";
 416             }
 417             elsif ( $sort eq "acqdate_dsc" ) {
 418                 $sort_by .= "1=32 >i ";
 419             }
 420             elsif ( $sort eq "title_az" || $sort eq "title_asc" ) {
 421                 $sort_by .= "1=4 <i ";
 422             }
 423             elsif ( $sort eq "title_za" || $sort eq "title_dsc" ) {
 424                 $sort_by .= "1=4 >i ";
 425             }
 426             else {
 427                 warn "Ignoring unrecognized sort '$sort' requested" if $sort_by;
 428             }
 429         }
 430         if ( $sort_by && !$scan && $results[$i] ) {
 431             if ( $results[$i]->sort( "yaz", $sort_by ) < 0 ) {
 432                 warn "WARNING sort $sort_by failed";
 433             }
 434         }
 435     }    # finished looping through servers
 436
 437     # The big moment: asynchronously retrieve results from all servers
 438         _ZOOM_event_loop(
 439             \@zconns,
 440             \@results,
 441             sub {
 442                 my ( $i, $size ) = @_;
 443                 my $results_hash;
 444
 445                 # loop through the results
 446                 $results_hash->{'hits'} = $size;
 447                 my $times;
 448                 if ( $offset + $results_per_page <= $size ) {
 449                     $times = $offset + $results_per_page;
 450                 }
 451                 else {
 452                     $times = $size;
 453                 }
 454
 455                 for ( my $j = $offset ; $j < $times ; $j++ ) {
 456                     my $records_hash;
 457                     my $record;
 458
 459                     ## Check if it's an index scan
 460                     if ($scan) {
 461                         my ( $term, $occ ) = $results[ $i - 1 ]->display_term($j);
 462
 463                  # here we create a minimal MARC record and hand it off to the
 464                  # template just like a normal result ... perhaps not ideal, but
 465                  # it works for now
 466                         my $tmprecord = MARC::Record->new();
 467                         $tmprecord->encoding('UTF-8');
 468                         my $tmptitle;
 469                         my $tmpauthor;
 470
 471                 # the minimal record in author/title (depending on MARC flavour)
 472                         if ( C4::Context->preference("marcflavour") eq
 473                             "UNIMARC" )
 474                         {
 475                             $tmptitle = MARC::Field->new(
 476                                 '200', ' ', ' ',
 477                                 a => $term,
 478                                 f => $occ
 479                             );
 480                             $tmprecord->append_fields($tmptitle);
 481                         }
 482                         else {
 483                             $tmptitle =
 484                               MARC::Field->new( '245', ' ', ' ', a => $term, );
 485                             $tmpauthor =
 486                               MARC::Field->new( '100', ' ', ' ', a => $occ, );
 487                             $tmprecord->append_fields($tmptitle);
 488                             $tmprecord->append_fields($tmpauthor);
 489                         }
 490                         $results_hash->{'RECORDS'}[$j] =
 491                           $tmprecord->as_usmarc();
 492                     }
 493
 494                     # not an index scan
 495                     else {
 496                         $record = $results[ $i - 1 ]->record($j)->raw();
 497                         # warn "RECORD $j:".$record;
 498                         $results_hash->{'RECORDS'}[$j] = $record;
 499                     }
 500
 501                 }
 502                 $results_hashref->{ $servers[ $i - 1 ] } = $results_hash;
 503
 504                 # Fill the facets while we're looping, but only for the
 505                 # biblioserver and not for a scan
 506                 if ( !$scan && $servers[ $i - 1 ] =~ /biblioserver/ ) {
 507                     $facets_counter = GetFacets( $results[ $i - 1 ] );
 508                     $facets_info    = _get_facets_info( $facets );
 509                 }
 510
 511                 # BUILD FACETS
 512                 if ( $servers[ $i - 1 ] =~ /biblioserver/ ) {
 513                     for my $link_value (
 514                         sort { $facets_counter->{$b} <=> $facets_counter->{$a} }
 515                         keys %$facets_counter
 516                       )
 517                     {
 518                         my $expandable;
 519                         my $number_of_facets;
 520                         my @this_facets_array;
 521                         for my $one_facet (
 522                             sort {
 523                                 $facets_counter->{$link_value}
 524                                   ->{$b} <=> $facets_counter->{$link_value}
 525                                   ->{$a}
 526                             } keys %{ $facets_counter->{$link_value} }
 527                           )
 528                         {
 529                             $number_of_facets++;
 530                             if (   ( $number_of_facets <= 5 )
 531                                 || ( $expanded_facet eq $link_value )
 532                                 || ( $facets_info->{$link_value}->{'expanded'} )
 533                               )
 534                             {
 535
 536 # Sanitize the link value : parenthesis, question and exclamation mark will cause errors with CCL
 537                                 my $facet_link_value = $one_facet;
 538                                 $facet_link_value =~ s/[()!?¡¿؟]/ /g;
 539
 540                                 # fix the length that will display in the label,
 541                                 my $facet_label_value = $one_facet;
 542                                 my $facet_max_length  = C4::Context->preference(
 543                                     'FacetLabelTruncationLength')
 544                                   || 20;
 545                                 $facet_label_value =
 546                                   substr( $one_facet, 0, $facet_max_length )
 547                                   . "..."
 548                                   if length($facet_label_value) >
 549                                       $facet_max_length;
 550
 551                             # if it's a branch, label by the name, not the code,
 552                                 if ( $link_value =~ /branch/ ) {
 553                                     if (   defined $branches
 554                                         && ref($branches) eq "HASH"
 555                                         && defined $branches->{$one_facet}
 556                                         && ref( $branches->{$one_facet} ) eq
 557                                         "HASH" )
 558                                     {
 559                                         $facet_label_value =
 560                                           $branches->{$one_facet}
 561                                           ->{'branchname'};
 562                                     }
 563                                     else {
 564                                         $facet_label_value = "*";
 565                                     }
 566                                 }
 567
 568                           # if it's a itemtype, label by the name, not the code,
 569                                 if ( $link_value =~ /itype/ ) {
 570                                     if (   defined $itemtypes
 571                                         && ref($itemtypes) eq "HASH"
 572                                         && defined $itemtypes->{$one_facet}
 573                                         && ref( $itemtypes->{$one_facet} ) eq
 574                                         "HASH" )
 575                                     {
 576                                         $facet_label_value =
 577                                           $itemtypes->{$one_facet}
 578                                           ->{translated_description};
 579                                     }
 580                                 }
 581
 582                # also, if it's a location code, use the name instead of the code
 583                                 if ( $link_value =~ /location/ ) {
 584                                     # TODO Retrieve all authorised values at once, instead of 1 query per entry
 585                                     my $av = Koha::AuthorisedValues->search({ category => 'LOC', authorised_value => $one_facet });
 586                                     $facet_label_value = $av->count ? $av->next->opac_description : '';
 587                                 }
 588
 589                 # but we're down with the whole label being in the link's title.
 590                                 push @this_facets_array,
 591                                   {
 592                                     facet_count =>
 593                                       $facets_counter->{$link_value}
 594                                       ->{$one_facet},
 595                                     facet_label_value => $facet_label_value,
 596                                     facet_title_value => $one_facet,
 597                                     facet_link_value  => $facet_link_value,
 598                                     type_link_value   => $link_value,
 599                                   }
 600                                   if ($facet_label_value);
 601                             }
 602                         }
 603
 604                         # handle expanded option
 605                         unless ( $facets_info->{$link_value}->{'expanded'} ) {
 606                             $expandable = 1
 607                               if ( ( $number_of_facets > 5 )
 608                                 && ( $expanded_facet ne $link_value ) );
 609                         }
 610                         push @facets_loop,
 611                           {
 612                             type_link_value => $link_value,
 613                             type_id         => $link_value . "_id",
 614                             "type_label_"
 615                               . $facets_info->{$link_value}->{'label_value'} =>
 616                               1,
 617                             facets     => \@this_facets_array,
 618                             expandable => $expandable,
 619                             expand     => $link_value,
 620                           }
 621                           unless (
 622                             (
 623                                 $facets_info->{$link_value}->{'label_value'} =~
 624                                 /Libraries/
 625                             )
 626                             and ( Koha::Libraries->search->count == 1 )
 627                           );
 628                     }
 629                 }
 630             }
 631         );
 632
 633     # This sorts the facets into alphabetical order
 634     if (@facets_loop) {
 635         foreach my $f (@facets_loop) {
 636             $f->{facets} = [ sort { uc($a->{facet_label_value}) cmp uc($b->{facet_label_value}) } @{ $f->{facets} } ];
 637         }
 638         @facets_loop = sort {$a->{expand} cmp $b->{expand}} @facets_loop;
 639     }
 640
 641     return ( undef, $results_hashref, \@facets_loop );
 642 }
 643
 644 sub GetFacets {
 645
 646     my $rs = shift;
 647     my $facets;
 648
 649     my $indexing_mode    = C4::Context->config('zebra_bib_index_mode') // 'dom';
 650     my $use_zebra_facets = C4::Context->config('use_zebra_facets') // 0;
 651
 652     if ( $indexing_mode eq 'dom' &&
 653          $use_zebra_facets ) {
 654         $facets = _get_facets_from_zebra( $rs );
 655     } else {
 656         $facets = _get_facets_from_records( $rs );
 657     }
 658
 659     return $facets;
 660 }
 661
 662 sub _get_facets_from_records {
 663
 664     my $rs = shift;
 665
 666     my $facets_maxrecs = C4::Context->preference('maxRecordsForFacets') // 20;
 667     my $facets_config  = getFacets();
 668     my $facets         = {};
 669     my $size           = $rs->size();
 670     my $jmax           = $size > $facets_maxrecs
 671                             ? $facets_maxrecs
 672                             : $size;
 673
 674     for ( my $j = 0 ; $j < $jmax ; $j++ ) {
 675
 676         my $marc_record = new_record_from_zebra (
 677                 'biblioserver',
 678                 $rs->record( $j )->raw()
 679         );
 680
 681         if ( ! defined $marc_record ) {
 682             warn "ERROR DECODING RECORD - $@: " .
 683                 $rs->record( $j )->raw();
 684             next;
 685         }
 686
 687         _get_facets_data_from_record( $marc_record, $facets_config, $facets );
 688     }
 689
 690     return $facets;
 691 }
 692
 693 =head2 _get_facets_data_from_record
 694
 695     C4::Search::_get_facets_data_from_record( $marc_record, $facets, $facets_counter );
 696
 697 Internal function that extracts facets information from a MARC::Record object
 698 and populates $facets_counter for using in getRecords.
 699
 700 $facets is expected to be filled with C4::Koha::getFacets output (i.e. the configured
 701 facets for Zebra).
 702
 703 =cut
 704
 705 sub _get_facets_data_from_record {
 706
 707     my ( $marc_record, $facets, $facets_counter ) = @_;
 708
 709     for my $facet (@$facets) {
 710
 711         my @used_datas = ();
 712
 713         foreach my $tag ( @{ $facet->{ tags } } ) {
 714
 715             # tag number is the first three digits
 716             my $tag_num          = substr( $tag, 0, 3 );
 717             # subfields are the remainder
 718             my $subfield_letters = substr( $tag, 3 );
 719
 720             my @fields = $marc_record->field( $tag_num );
 721             foreach my $field (@fields) {
 722                 # If $field->indicator(1) eq 'z', it means it is a 'see from'
 723                 # field introduced because of IncludeSeeFromInSearches, so skip it
 724                 next if $field->indicator(1) eq 'z';
 725
 726                 my $data = $field->as_string( $subfield_letters, $facet->{ sep } );
 727
 728                 unless ( grep { /^\Q$data\E$/ } @used_datas ) {
 729                     push @used_datas, $data;
 730                     $facets_counter->{ $facet->{ idx } }->{ $data }++;
 731                 }
 732             }
 733         }
 734     }
 735 }
 736
 737 =head2 _get_facets_from_zebra
 738
 739     my $facets = _get_facets_from_zebra( $result_set )
 740
 741 Retrieves facets for a specified result set. It loops through the facets defined
 742 in C4::Koha::getFacets and returns a hash with the following structure:
 743
 744    {  facet_idx => {
 745             facet_value => count
 746       },
 747       ...
 748    }
 749
 750 =cut
 751
 752 sub _get_facets_from_zebra {
 753
 754     my $rs = shift;
 755
 756     # save current elementSetName
 757     my $elementSetName = $rs->option( 'elementSetName' );
 758
 759     my $facets_loop = getFacets();
 760     my $facets_data  = {};
 761     # loop through defined facets and fill the facets hashref
 762     foreach my $facet ( @$facets_loop ) {
 763
 764         my $idx = $facet->{ idx };
 765         my $sep = $facet->{ sep };
 766         my $facet_values = _get_facet_from_result_set( $idx, $rs, $sep );
 767         if ( $facet_values ) {
 768             # we've actually got a result
 769             $facets_data->{ $idx } = $facet_values;
 770         }
 771     }
 772     # set elementSetName to its previous value to avoid side effects
 773     $rs->option( elementSetName => $elementSetName );
 774
 775     return $facets_data;
 776 }
 777
 778 =head2 _get_facet_from_result_set
 779
 780     my $facet_values =
 781         C4::Search::_get_facet_from_result_set( $facet_idx, $result_set, $sep )
 782
 783 Internal function that extracts facet information for a specific index ($facet_idx) and
 784 returns a hash containing facet values and count:
 785
 786     {
 787         $facet_value => $count ,
 788         ...
 789     }
 790
 791 Warning: this function has the side effect of changing the elementSetName for the result
 792 set. It is a helper function for the main loop, which takes care of backing it up for
 793 restoring.
 794
 795 =cut
 796
 797 sub _get_facet_from_result_set {
 798
 799     my $facet_idx = shift;
 800     my $rs        = shift;
 801     my $sep       = shift;
 802
 803     my $internal_sep  = '<*>';
 804     my $facetMaxCount = C4::Context->preference('FacetMaxCount') // 20;
 805
 806     return if ( ! defined $facet_idx || ! defined $rs );
 807     # zebra's facet element, untokenized index
 808     my $facet_element = 'zebra::facet::' . $facet_idx . ':0:' . $facetMaxCount;
 809     # configure zebra results for retrieving the desired facet
 810     $rs->option( elementSetName => $facet_element );
 811     # get the facet record from result set
 812     my $facet = $rs->record( 0 )->raw;
 813     # if the facet has no restuls...
 814     return if !defined $facet;
 815     # TODO: benchmark DOM vs. SAX performance
 816     my $facet_dom = XML::LibXML->load_xml(
 817       string => ($facet)
 818     );
 819     my @terms = $facet_dom->getElementsByTagName('term');
 820     return if ! @terms;
 821
 822     my $facets = {};
 823     foreach my $term ( @terms ) {
 824         my $facet_value = $term->textContent;
 825         $facet_value =~ s/\Q$internal_sep\E/$sep/ if defined $sep;
 826         $facets->{ $facet_value } = $term->getAttribute( 'occur' );
 827     }
 828
 829     return $facets;
 830 }
 831
 832 =head2 _get_facets_info
 833
 834     my $facets_info = C4::Search::_get_facets_info( $facets )
 835
 836 Internal function that extracts facets information and properly builds
 837 the data structure needed to render facet labels.
 838
 839 =cut
 840
 841 sub _get_facets_info {
 842
 843     my $facets = shift;
 844
 845     my $facets_info = {};
 846
 847     for my $facet ( @$facets ) {
 848         $facets_info->{ $facet->{ idx } }->{ label_value } = $facet->{ label };
 849         $facets_info->{ $facet->{ idx } }->{ expanded }    = $facet->{ expanded };
 850     }
 851
 852     return $facets_info;
 853 }
 854
 855 sub pazGetRecords {
 856     my (
 857         $koha_query,       $simple_query, $sort_by_ref,    $servers_ref,
 858         $results_per_page, $offset,       $expanded_facet, $branches,
 859         $query_type,       $scan
 860     ) = @_;
 861     #NOTE: Parameter $branches is not used here !
 862
 863     my $paz = C4::Search::PazPar2->new(C4::Context->config('pazpar2url'));
 864     $paz->init();
 865     $paz->search($simple_query);
 866     sleep 1;   # FIXME: WHY?
 867
 868     # do results
 869     my $results_hashref = {};
 870     my $stats = XMLin($paz->stat);
 871     my $results = XMLin($paz->show($offset, $results_per_page, 'work-title:1'), forcearray => 1);
 872
 873     # for a grouped search result, the number of hits
 874     # is the number of groups returned; 'bib_hits' will have
 875     # the total number of bibs.
 876     $results_hashref->{'biblioserver'}->{'hits'} = $results->{'merged'}->[0];
 877     $results_hashref->{'biblioserver'}->{'bib_hits'} = $stats->{'hits'};
 878
 879     HIT: foreach my $hit (@{ $results->{'hit'} }) {
 880         my $recid = $hit->{recid}->[0];
 881
 882         my $work_title = $hit->{'md-work-title'}->[0];
 883         my $work_author;
 884         if (exists $hit->{'md-work-author'}) {
 885             $work_author = $hit->{'md-work-author'}->[0];
 886         }
 887         my $group_label = (defined $work_author) ? "$work_title / $work_author" : $work_title;
 888
 889         my $result_group = {};
 890         $result_group->{'group_label'} = $group_label;
 891         $result_group->{'group_merge_key'} = $recid;
 892
 893         my $count = 1;
 894         if (exists $hit->{count}) {
 895             $count = $hit->{count}->[0];
 896         }
 897         $result_group->{'group_count'} = $count;
 898
 899         for (my $i = 0; $i < $count; $i++) {
 900             # FIXME -- may need to worry about diacritics here
 901             my $rec = $paz->record($recid, $i);
 902             push @{ $result_group->{'RECORDS'} }, $rec;
 903         }
 904
 905         push @{ $results_hashref->{'biblioserver'}->{'GROUPS'} }, $result_group;
 906     }
 907
 908     # pass through facets
 909     my $termlist_xml = $paz->termlist('author,subject');
 910     my $terms = XMLin($termlist_xml, forcearray => 1);
 911     my @facets_loop = ();
 912     #die Dumper($results);
 913 #    foreach my $list (sort keys %{ $terms->{'list'} }) {
 914 #        my @facets = ();
 915 #        foreach my $facet (sort @{ $terms->{'list'}->{$list}->{'term'} } ) {
 916 #            push @facets, {
 917 #                facet_label_value => $facet->{'name'}->[0],
 918 #            };
 919 #        }
 920 #        push @facets_loop, ( {
 921 #            type_label => $list,
 922 #            facets => \@facets,
 923 #        } );
 924 #    }
 925
 926     return ( undef, $results_hashref, \@facets_loop );
 927 }
 928
 929 # TRUNCATION
 930 sub _detect_truncation {
 931     my ( $operand, $index ) = @_;
 932     my ( @nontruncated, @righttruncated, @lefttruncated, @rightlefttruncated,
 933         @regexpr );
 934     $operand =~ s/^ //g;
 935     my @wordlist = split( /\s/, $operand );
 936     foreach my $word (@wordlist) {
 937         if ( $word =~ s/^\*([^\*]+)\*$/$1/ ) {
 938             push @rightlefttruncated, $word;
 939         }
 940         elsif ( $word =~ s/^\*([^\*]+)$/$1/ ) {
 941             push @lefttruncated, $word;
 942         }
 943         elsif ( $word =~ s/^([^\*]+)\*$/$1/ ) {
 944             push @righttruncated, $word;
 945         }
 946         elsif ( index( $word, "*" ) < 0 ) {
 947             push @nontruncated, $word;
 948         }
 949         else {
 950             push @regexpr, $word;
 951         }
 952     }
 953     return (
 954         \@nontruncated,       \@righttruncated, \@lefttruncated,
 955         \@rightlefttruncated, \@regexpr
 956     );
 957 }
 958
 959 # STEMMING
 960 sub _build_stemmed_operand {
 961     my ($operand,$lang) = @_;
 962     require Lingua::Stem::Snowball ;
 963     my $stemmed_operand=q{};
 964
 965     # If operand contains a digit, it is almost certainly an identifier, and should
 966     # not be stemmed.  This is particularly relevant for ISBNs and ISSNs, which
 967     # can contain the letter "X" - for example, _build_stemmend_operand would reduce
 968     # "014100018X" to "x ", which for a MARC21 database would bring up irrelevant
 969     # results (e.g., "23 x 29 cm." from the 300$c).  Bug 2098.
 970     return $operand if $operand =~ /\d/;
 971
 972 # FIXME: the locale should be set based on the user's language and/or search choice
 973     #warn "$lang";
 974     # Make sure we only use the first two letters from the language code
 975     $lang = lc(substr($lang, 0, 2));
 976     # The language codes for the two variants of Norwegian will now be "nb" and "nn",
 977     # none of which Lingua::Stem::Snowball can use, so we need to "translate" them
 978     if ($lang eq 'nb' || $lang eq 'nn') {
 979       $lang = 'no';
 980     }
 981     my $stemmer = Lingua::Stem::Snowball->new( lang => $lang,
 982                                                encoding => "UTF-8" );
 983
 984     my @words = split( / /, $operand );
 985     my @stems = $stemmer->stem(\@words);
 986     for my $stem (@stems) {
 987         $stemmed_operand .= "$stem";
 988         $stemmed_operand .= "?"
 989           unless ( $stem =~ /(and$|or$|not$)/ ) || ( length($stem) < 3 );
 990         $stemmed_operand .= " ";
 991     }
 992     warn "STEMMED OPERAND: $stemmed_operand" if $DEBUG;
 993     return $stemmed_operand;
 994 }
 995
 996 # FIELD WEIGHTING
 997 sub _build_weighted_query {
 998
 999 # FIELD WEIGHTING - This is largely experimental stuff. What I'm committing works
1000 # pretty well but could work much better if we had a smarter query parser
1001     my ( $operand, $stemmed_operand, $index ) = @_;
1002     my $stemming      = C4::Context->preference("QueryStemming")     || 0;
1003     my $weight_fields = C4::Context->preference("QueryWeightFields") || 0;
1004     my $fuzzy_enabled = C4::Context->preference("QueryFuzzy")        || 0;
1005     $operand =~ s/"/ /g;    # Bug 7518: searches with quotation marks don't work
1006
1007     my $weighted_query .= "(rk=(";    # Specifies that we're applying rank
1008
1009     # Keyword, or, no index specified
1010     if ( ( $index eq 'kw' ) || ( !$index ) ) {
1011         $weighted_query .=
1012           "Title-cover,ext,r1=\"$operand\"";    # exact title-cover
1013         $weighted_query .= " or ti,ext,r2=\"$operand\"";    # exact title
1014         $weighted_query .= " or Title-cover,phr,r3=\"$operand\"";    # phrase title
1015         $weighted_query .= " or ti,wrdl,r4=\"$operand\"";    # words in title
1016           #$weighted_query .= " or any,ext,r4=$operand";               # exact any
1017           #$weighted_query .=" or kw,wrdl,r5=\"$operand\"";            # word list any
1018         $weighted_query .= " or wrdl,fuzzy,r8=\"$operand\""
1019           if $fuzzy_enabled;    # add fuzzy, word list
1020         $weighted_query .= " or wrdl,right-Truncation,r9=\"$stemmed_operand\""
1021           if ( $stemming and $stemmed_operand )
1022           ;                     # add stemming, right truncation
1023         $weighted_query .= " or wrdl,r9=\"$operand\"";
1024
1025         # embedded sorting: 0 a-z; 1 z-a
1026         # $weighted_query .= ") or (sort1,aut=1";
1027     }
1028
1029     # Barcode searches should skip this process
1030     elsif ( $index eq 'bc' ) {
1031         $weighted_query .= "bc=\"$operand\"";
1032     }
1033
1034     # Authority-number searches should skip this process
1035     elsif ( $index eq 'an' ) {
1036         $weighted_query .= "an=\"$operand\"";
1037     }
1038
1039     # If the index is numeric, don't autoquote it.
1040     elsif ( $index =~ /,st-numeric$/ ) {
1041         $weighted_query .= " $index=$operand";
1042     }
1043
1044     # If the index already has more than one qualifier, wrap the operand
1045     # in quotes and pass it back (assumption is that the user knows what they
1046     # are doing and won't appreciate us mucking up their query
1047     elsif ( $index =~ ',' ) {
1048         $weighted_query .= " $index=\"$operand\"";
1049     }
1050
1051     #TODO: build better cases based on specific search indexes
1052     else {
1053         $weighted_query .= " $index,ext,r1=\"$operand\"";    # exact index
1054           #$weighted_query .= " or (title-sort-az=0 or $index,startswithnt,st-word,r3=$operand #)";
1055         $weighted_query .= " or $index,phr,r3=\"$operand\"";    # phrase index
1056         $weighted_query .= " or $index,wrdl,r6=\"$operand\"";    # word list index
1057         $weighted_query .= " or $index,wrdl,fuzzy,r8=\"$operand\""
1058           if $fuzzy_enabled;    # add fuzzy, word list
1059         $weighted_query .= " or $index,wrdl,rt,r9=\"$stemmed_operand\""
1060           if ( $stemming and $stemmed_operand );    # add stemming, right truncation
1061     }
1062
1063     $weighted_query .= "))";                       # close rank specification
1064     return $weighted_query;
1065 }
1066
1067 =head2 getIndexes
1068
1069 Return an array with available indexes.
1070
1071 =cut
1072
1073 sub getIndexes{
1074     my @indexes = (
1075                     # biblio indexes
1076                     'ab',
1077                     'Abstract',
1078                     'acqdate',
1079                     'allrecords',
1080                     'an',
1081                     'Any',
1082                     'at',
1083                     'au',
1084                     'aub',
1085                     'aud',
1086                     'audience',
1087                     'auo',
1088                     'aut',
1089                     'Author',
1090                     'Author-in-order ',
1091                     'Author-personal-bibliography',
1092                     'Authority-Number',
1093                     'authtype',
1094                     'bc',
1095                     'Bib-level',
1096                     'biblionumber',
1097                     'bio',
1098                     'biography',
1099                     'callnum',
1100                     'cfn',
1101                     'Chronological-subdivision',
1102                     'cn-bib-source',
1103                     'cn-bib-sort',
1104                     'cn-class',
1105                     'cn-item',
1106                     'cn-prefix',
1107                     'cn-suffix',
1108                     'cpn',
1109                     'Code-institution',
1110                     'Conference-name',
1111                     'Conference-name-heading',
1112                     'Conference-name-see',
1113                     'Conference-name-seealso',
1114                     'Content-type',
1115                     'Control-number',
1116                     'copydate',
1117                     'Corporate-name',
1118                     'Corporate-name-heading',
1119                     'Corporate-name-see',
1120                     'Corporate-name-seealso',
1121                     'Country-publication',
1122                     'ctype',
1123                     'curriculum',
1124                     'date-entered-on-file',
1125                     'Date-of-acquisition',
1126                     'Date-of-publication',
1127                     'Date-time-last-modified',
1128                     'Dewey-classification',
1129                     'Dissertation-information',
1130                     'diss',
1131                     'dtlm',
1132                     'EAN',
1133                     'extent',
1134                     'fic',
1135                     'fiction',
1136                     'Form-subdivision',
1137                     'format',
1138                     'Geographic-subdivision',
1139                     'he',
1140                     'Heading',
1141                     'Heading-use-main-or-added-entry',
1142                     'Heading-use-series-added-entry ',
1143                     'Heading-use-subject-added-entry',
1144                     'Host-item',
1145                     'id-other',
1146                     'ident',
1147                     'Identifier-standard',
1148                     'Illustration-code',
1149                     'Index-term-genre',
1150                     'Index-term-uncontrolled',
1151                     'Interest-age-level',
1152                     'Interest-grade-level',
1153                     'ISBN',
1154                     'isbn',
1155                     'ISSN',
1156                     'issn',
1157                     'itemtype',
1158                     'kw',
1159                     'Koha-Auth-Number',
1160                     'l-format',
1161                     'language',
1162                     'language-original',
1163                     'lc-card',
1164                     'LC-card-number',
1165                     'lcn',
1166                     'lex',
1167                     'lexile-number',
1168                     'llength',
1169                     'ln',
1170                     'ln-audio',
1171                     'ln-subtitle',
1172                     'Local-classification',
1173                     'Local-number',
1174                     'Match-heading',
1175                     'Match-heading-see-from',
1176                     'Material-type',
1177                     'mc-itemtype',
1178                     'mc-rtype',
1179                     'mus',
1180                     'name',
1181                     'Music-number',
1182                     'Name-geographic',
1183                     'Name-geographic-heading',
1184                     'Name-geographic-see',
1185                     'Name-geographic-seealso',
1186                     'nb',
1187                     'Note',
1188                     'notes',
1189                     'ns',
1190                     'nt',
1191                     'Other-control-number',
1192                     'pb',
1193                     'Personal-name',
1194                     'Personal-name-heading',
1195                     'Personal-name-see',
1196                     'Personal-name-seealso',
1197                     'pl',
1198                     'Place-publication',
1199                     'pn',
1200                     'popularity',
1201                     'pubdate',
1202                     'Publisher',
1203                     'Provider',
1204                     'pv',
1205                     'Reading-grade-level',
1206                     'Record-control-number',
1207                     'rcn',
1208                     'Record-type',
1209                     'rtype',
1210                     'se',
1211                     'See',
1212                     'See-also',
1213                     'sn',
1214                     'Stock-number',
1215                     'su',
1216                     'Subject',
1217                     'Subject-heading-thesaurus',
1218                     'Subject-name-personal',
1219                     'Subject-subdivision',
1220                     'Summary',
1221                     'Suppress',
1222                     'su-geo',
1223                     'su-na',
1224                     'su-to',
1225                     'su-ut',
1226                     'ut',
1227                     'Term-genre-form',
1228                     'Term-genre-form-heading',
1229                     'Term-genre-form-see',
1230                     'Term-genre-form-seealso',
1231                     'ti',
1232                     'Title',
1233                     'Title-cover',
1234                     'Title-series',
1235                     'Title-uniform',
1236                     'Title-uniform-heading',
1237                     'Title-uniform-see',
1238                     'Title-uniform-seealso',
1239                     'totalissues',
1240                     'yr',
1241
1242                     # items indexes
1243                     'acqsource',
1244                     'barcode',
1245                     'bc',
1246                     'branch',
1247                     'ccode',
1248                     'classification-source',
1249                     'cn-sort',
1250                     'coded-location-qualifier',
1251                     'copynumber',
1252                     'damaged',
1253                     'datelastborrowed',
1254                     'datelastseen',
1255                     'holdingbranch',
1256                     'homebranch',
1257                     'issues',
1258                     'item',
1259                     'itemnumber',
1260                     'itype',
1261                     'Local-classification',
1262                     'location',
1263                     'lost',
1264                     'materials-specified',
1265                     'mc-ccode',
1266                     'mc-itype',
1267                     'mc-loc',
1268                     'notforloan',
1269                     'Number-local-acquisition',
1270                     'onloan',
1271                     'price',
1272                     'renewals',
1273                     'replacementprice',
1274                     'replacementpricedate',
1275                     'reserves',
1276                     'restricted',
1277                     'stack',
1278                     'stocknumber',
1279                     'inv',
1280                     'uri',
1281                     'withdrawn',
1282
1283                     # subject related
1284                   );
1285
1286     return \@indexes;
1287 }
1288
1289 =head2 _handle_exploding_index
1290
1291     my $query = _handle_exploding_index($index, $term)
1292
1293 Callback routine to generate the search for "exploding" indexes (i.e.
1294 those indexes which are turned into multiple or-connected searches based
1295 on authority data).
1296
1297 =cut
1298
1299 sub _handle_exploding_index {
1300     my ($QParser, $filter, $params, $negate, $server) = @_;
1301     my $index = $filter;
1302     my $term = join(' ', @$params);
1303
1304     return unless ($index =~ m/(su-br|su-na|su-rl)/ && $term);
1305
1306     my $marcflavour = C4::Context->preference('marcflavour');
1307
1308     my $codesubfield = $marcflavour eq 'UNIMARC' ? '5' : 'w';
1309     my $wantedcodes = '';
1310     my @subqueries = ( "\@attr 1=Subject \@attr 4=1 \"$term\"");
1311     my ($error, $results, $total_hits) = SimpleSearch( "he:$term", undef, undef, [ "authorityserver" ] );
1312     foreach my $auth (@$results) {
1313         my $record = MARC::Record->new_from_usmarc($auth);
1314         my @references = $record->field('5..');
1315         if (@references) {
1316             if ($index eq 'su-br') {
1317                 $wantedcodes = 'g';
1318             } elsif ($index eq 'su-na') {
1319                 $wantedcodes = 'h';
1320             } elsif ($index eq 'su-rl') {
1321                 $wantedcodes = '';
1322             }
1323             foreach my $reference (@references) {
1324                 my $codes = $reference->subfield($codesubfield);
1325                 push @subqueries, '@attr 1=Subject @attr 4=1 "' . $reference->as_string('abcdefghijlmnopqrstuvxyz') . '"' if (($codes && $codes eq $wantedcodes) || !$wantedcodes);
1326             }
1327         }
1328     }
1329     my $query = ' @or ' x (scalar(@subqueries) - 1) . join(' ', @subqueries);
1330     return $query;
1331 }
1332
1333 =head2 parseQuery
1334
1335     ( $operators, $operands, $indexes, $limits,
1336       $sort_by, $scan, $lang ) =
1337             buildQuery ( $operators, $operands, $indexes, $limits, $sort_by, $scan, $lang);
1338
1339 Shim function to ease the transition from buildQuery to a new QueryParser.
1340 This function is called at the beginning of buildQuery, and modifies
1341 buildQuery's input. If it can handle the input, it returns a query that
1342 buildQuery will not try to parse.
1343
1344 =cut
1345
1346 sub parseQuery {
1347     my ( $operators, $operands, $indexes, $limits, $sort_by, $scan, $lang) = @_;
1348
1349     my @operators = $operators ? @$operators : ();
1350     my @indexes   = $indexes   ? @$indexes   : ();
1351     my @operands  = $operands  ? @$operands  : ();
1352     my @limits    = $limits    ? @$limits    : ();
1353     my @sort_by   = $sort_by   ? @$sort_by   : ();
1354
1355     my $query = $operands[0];
1356     my $index;
1357     my $term;
1358     my $query_desc;
1359
1360     my $QParser;
1361     $QParser = C4::Context->queryparser if (C4::Context->preference('UseQueryParser') || $query =~ s/^qp=//);
1362     undef $QParser if ($query =~ m/^(ccl=|pqf=|cql=)/ || grep (/\w,\w|\w=\w/, @operands, @indexes) );
1363     undef $QParser if (scalar @limits > 0);
1364
1365     if ($QParser)
1366     {
1367         $QParser->custom_data->{'QueryAutoTruncate'} = C4::Context->preference('QueryAutoTruncate');
1368         $query = '';
1369         for ( my $ii = 0 ; $ii <= @operands ; $ii++ ) {
1370             next unless $operands[$ii];
1371             $query .= $operators[ $ii - 1 ] eq 'or' ? ' || ' : ' && '
1372               if ($query);
1373             if ( $operands[$ii] =~ /^[^"]\W*[-|_\w]*:\w.*[^"]$/ ) {
1374                 $query .= $operands[$ii];
1375             }
1376             elsif ( $indexes[$ii] =~ m/su-/ ) {
1377                 $query .= $indexes[$ii] . '(' . $operands[$ii] . ')';
1378             }
1379             else {
1380                 $query .=
1381                   ( $indexes[$ii] ? "$indexes[$ii]:" : '' ) . $operands[$ii];
1382             }
1383         }
1384         foreach my $limit (@limits) {
1385         }
1386         if ( scalar(@sort_by) > 0 ) {
1387             my $modifier_re =
1388               '#(' . join( '|', @{ $QParser->modifiers } ) . ')';
1389             $query =~ s/$modifier_re//g;
1390             foreach my $modifier (@sort_by) {
1391                 $query .= " #$modifier";
1392             }
1393         }
1394
1395         $query_desc = $query;
1396         $query_desc =~ s/\s+/ /g;
1397         if ( C4::Context->preference("QueryWeightFields") ) {
1398         }
1399         $QParser->add_bib1_filter_map( 'su-br' => 'biblioserver' =>
1400               { 'target_syntax_callback' => \&_handle_exploding_index } );
1401         $QParser->add_bib1_filter_map( 'su-na' => 'biblioserver' =>
1402               { 'target_syntax_callback' => \&_handle_exploding_index } );
1403         $QParser->add_bib1_filter_map( 'su-rl' => 'biblioserver' =>
1404               { 'target_syntax_callback' => \&_handle_exploding_index } );
1405         $QParser->parse($query);
1406         $operands[0] = "pqf=" . $QParser->target_syntax('biblioserver');
1407     }
1408     else {
1409         require Koha::QueryParser::Driver::PQF;
1410         my $modifier_re = '#(' . join( '|', @{Koha::QueryParser::Driver::PQF->modifiers}) . ')';
1411         s/$modifier_re//g for @operands;
1412     }
1413
1414     return ( $operators, \@operands, $indexes, $limits, $sort_by, $scan, $lang, $query_desc);
1415 }
1416
1417 =head2 buildQuery
1418
1419 ( $error, $query,
1420 $simple_query, $query_cgi,
1421 $query_desc, $limit,
1422 $limit_cgi, $limit_desc,
1423 $query_type ) = buildQuery ( $operators, $operands, $indexes, $limits, $sort_by, $scan, $lang);
1424
1425 Build queries and limits in CCL, CGI, Human,
1426 handle truncation, stemming, field weighting, fuzziness, etc.
1427
1428 See verbose embedded documentation.
1429
1430
1431 =cut
1432
1433 sub buildQuery {
1434     my ( $operators, $operands, $indexes, $limits, $sort_by, $scan, $lang) = @_;
1435
1436     warn "---------\nEnter buildQuery\n---------" if $DEBUG;
1437
1438     my $query_desc;
1439     ( $operators, $operands, $indexes, $limits, $sort_by, $scan, $lang, $query_desc) = parseQuery($operators, $operands, $indexes, $limits, $sort_by, $scan, $lang);
1440
1441     # dereference
1442     my @operators = $operators ? @$operators : ();
1443     my @indexes   = $indexes   ? @$indexes   : ();
1444     my @operands  = $operands  ? @$operands  : ();
1445     my @limits    = $limits    ? @$limits    : ();
1446     my @sort_by   = $sort_by   ? @$sort_by   : ();
1447
1448     my $stemming         = C4::Context->preference("QueryStemming")        || 0;
1449     my $auto_truncation  = C4::Context->preference("QueryAutoTruncate")    || 0;
1450     my $weight_fields    = C4::Context->preference("QueryWeightFields")    || 0;
1451     my $fuzzy_enabled    = C4::Context->preference("QueryFuzzy")           || 0;
1452
1453     my $query        = $operands[0];
1454     my $simple_query = $operands[0];
1455
1456     # initialize the variables we're passing back
1457     my $query_cgi;
1458     my $query_type;
1459
1460     my $limit;
1461     my $limit_cgi;
1462     my $limit_desc;
1463
1464     my $cclq       = 0;
1465     my $cclindexes = getIndexes();
1466     if ( $query !~ /\s*(ccl=|pqf=|cql=)/ ) {
1467         while ( !$cclq && $query =~ /(?:^|\W)([\w-]+)(,[\w-]+)*[:=]/g ) {
1468             my $dx = lc($1);
1469             $cclq = grep { lc($_) eq $dx } @$cclindexes;
1470         }
1471         $query = "ccl=$query" if $cclq;
1472     }
1473
1474 # for handling ccl, cql, pqf queries in diagnostic mode, skip the rest of the steps
1475 # DIAGNOSTIC ONLY!!
1476     if ( $query =~ /^ccl=/ ) {
1477         my $q=$';
1478         # This is needed otherwise ccl= and &limit won't work together, and
1479         # this happens when selecting a subject on the opac-detail page
1480         @limits = grep {!/^$/} @limits;
1481         my $original_q = $q; # without available part
1482         unless ( grep { /^available$/ } @limits ) {
1483             $q =~ s| and \( \( allrecords,AlwaysMatches:'' not onloan,AlwaysMatches:''\) and \(lost,st-numeric=0\) \)||;
1484             $original_q = $q;
1485         }
1486         if ( @limits ) {
1487             if ( grep { /^available$/ } @limits ) {
1488                 $q .= q| and ( ( allrecords,AlwaysMatches:'' not onloan,AlwaysMatches:'') and (lost,st-numeric=0) )|;
1489                 delete $limits['available'];
1490             }
1491             $q .= ' and '.join(' and ', @limits) if @limits;
1492         }
1493         return ( undef, $q, $q, "q=ccl=".uri_escape_utf8($q), $original_q, '', '', '', 'ccl' );
1494     }
1495     if ( $query =~ /^cql=/ ) {
1496         return ( undef, $', $', "q=cql=".uri_escape_utf8($'), $', '', '', '', 'cql' );
1497     }
1498     if ( $query =~ /^pqf=/ ) {
1499         if ($query_desc) {
1500             $query_cgi = "q=".uri_escape_utf8($query_desc);
1501         } else {
1502             $query_desc = $';
1503             $query_cgi = "q=pqf=".uri_escape_utf8($');
1504         }
1505         return ( undef, $', $', $query_cgi, $query_desc, '', '', '', 'pqf' );
1506     }
1507
1508     # pass nested queries directly
1509     # FIXME: need better handling of some of these variables in this case
1510     # Nested queries aren't handled well and this implementation is flawed and causes users to be
1511     # unable to search for anything containing () commenting out, will be rewritten for 3.4.0
1512 #    if ( $query =~ /(\(|\))/ ) {
1513 #        return (
1514 #            undef,              $query, $simple_query, $query_cgi,
1515 #            $query,             $limit, $limit_cgi,    $limit_desc,
1516 #            'ccl'
1517 #        );
1518 #    }
1519
1520 # Form-based queries are non-nested and fixed depth, so we can easily modify the incoming
1521 # query operands and indexes and add stemming, truncation, field weighting, etc.
1522 # Once we do so, we'll end up with a value in $query, just like if we had an
1523 # incoming $query from the user
1524     else {
1525         $query = ""
1526           ; # clear it out so we can populate properly with field-weighted, stemmed, etc. query
1527         my $previous_operand
1528           ;    # a flag used to keep track if there was a previous query
1529                # if there was, we can apply the current operator
1530                # for every operand
1531         for ( my $i = 0 ; $i <= @operands ; $i++ ) {
1532
1533             # COMBINE OPERANDS, INDEXES AND OPERATORS
1534             if ( $operands[$i] ) {
1535                 $operands[$i]=~s/^\s+//;
1536
1537               # A flag to determine whether or not to add the index to the query
1538                 my $indexes_set;
1539
1540 # If the user is sophisticated enough to specify an index, turn off field weighting, and stemming handling
1541                 if ( $operands[$i] =~ /\w(:|=)/ || $scan ) {
1542                     $weight_fields    = 0;
1543                     $stemming         = 0;
1544                 } else {
1545                     $operands[$i] =~ s/\?/{?}/g; # need to escape question marks
1546                 }
1547                 my $operand = $operands[$i];
1548                 my $index   = $indexes[$i];
1549
1550                 # Add index-specific attributes
1551
1552                 #Afaik, this 'yr' condition will only ever be met in the staff client advanced search
1553                 #for "Publication date", since typing 'yr:YYYY' into the search box produces a CCL query,
1554                 #which is processed higher up in this sub. Other than that, year searches are typically
1555                 #handled as limits which are not processed her either.
1556
1557                 # Search ranges: Date of Publication, st-numeric
1558                 if ( $index =~ /(yr|st-numeric)/ ) {
1559                     #weight_fields/relevance search causes errors with date ranges
1560                     #In the case of YYYY-, it will only return records with a 'yr' of YYYY (not the range)
1561                     #In the case of YYYY-YYYY, it will return no results
1562                     $stemming = $auto_truncation = $weight_fields = $fuzzy_enabled = 0;
1563                 }
1564
1565                 # Date of Acquisition
1566                 elsif ( $index =~ /acqdate/ ) {
1567                     #stemming and auto_truncation would have zero impact since it already is YYYY-MM-DD format
1568                     #Weight_fields probably SHOULD be turned OFF, otherwise you'll get records floating to the
1569                       #top of the results just because they have lots of item records matching that date.
1570                     #Fuzzy actually only applies during _build_weighted_query, and is reset there anyway, so
1571                       #irrelevant here
1572                     $stemming = $auto_truncation = $weight_fields = $fuzzy_enabled = 0;
1573                 }
1574                 # ISBN,ISSN,Standard Number, don't need special treatment
1575                 elsif ( $index eq 'nb' || $index eq 'ns' ) {
1576                     (
1577                         $stemming,      $auto_truncation,
1578                         $weight_fields, $fuzzy_enabled
1579                     ) = ( 0, 0, 0, 0 );
1580
1581                     if ( $index eq 'nb' ) {
1582                         if ( C4::Context->preference("SearchWithISBNVariations") ) {
1583                             my @isbns = C4::Koha::GetVariationsOfISBN( $operand );
1584                             $operands[$i] = $operand =  '(nb=' . join(' OR nb=', @isbns) . ')';
1585                             $indexes[$i] = $index = '';
1586                         }
1587                     }
1588                 }
1589
1590                 if(not $index){
1591                     $index = 'kw';
1592                 }
1593
1594                 # Set default structure attribute (word list)
1595                 my $struct_attr = q{};
1596                 unless ( $indexes_set || !$index || $index =~ /,(st-|phr|ext|wrdl)/ || $index =~ /^(nb|ns)$/ ) {
1597                     $struct_attr = ",wrdl";
1598                 }
1599
1600                 # Some helpful index variants
1601                 my $index_plus       = $index . $struct_attr . ':';
1602                 my $index_plus_comma = $index . $struct_attr . ',';
1603
1604                 if ($auto_truncation){
1605                         unless ( $index =~ /,(st-|phr|ext)/ ) {
1606                                                 #FIXME only valid with LTR scripts
1607                                                 $operand=join(" ",map{
1608                                                                                         (index($_,"*")>0?"$_":"$_*")
1609                                                                                          }split (/\s+/,$operand));
1610                                                 warn $operand if $DEBUG;
1611                                         }
1612                                 }
1613
1614                 # Detect Truncation
1615                 my $truncated_operand;
1616                 my( $nontruncated, $righttruncated, $lefttruncated,
1617                     $rightlefttruncated, $regexpr
1618                 ) = _detect_truncation( $operand, $index );
1619                 warn
1620 "TRUNCATION: NON:>@$nontruncated< RIGHT:>@$righttruncated< LEFT:>@$lefttruncated< RIGHTLEFT:>@$rightlefttruncated< REGEX:>@$regexpr<"
1621                   if $DEBUG;
1622
1623                 # Apply Truncation
1624                 if (
1625                     scalar(@$righttruncated) + scalar(@$lefttruncated) +
1626                     scalar(@$rightlefttruncated) > 0 )
1627                 {
1628
1629                # Don't field weight or add the index to the query, we do it here
1630                     $indexes_set = 1;
1631                     undef $weight_fields;
1632                     my $previous_truncation_operand;
1633                     if (scalar @$nontruncated) {
1634                         $truncated_operand .= "$index_plus @$nontruncated ";
1635                         $previous_truncation_operand = 1;
1636                     }
1637                     if (scalar @$righttruncated) {
1638                         $truncated_operand .= "and " if $previous_truncation_operand;
1639                         $truncated_operand .= $index_plus_comma . "rtrn:@$righttruncated ";
1640                         $previous_truncation_operand = 1;
1641                     }
1642                     if (scalar @$lefttruncated) {
1643                         $truncated_operand .= "and " if $previous_truncation_operand;
1644                         $truncated_operand .= $index_plus_comma . "ltrn:@$lefttruncated ";
1645                         $previous_truncation_operand = 1;
1646                     }
1647                     if (scalar @$rightlefttruncated) {
1648                         $truncated_operand .= "and " if $previous_truncation_operand;
1649                         $truncated_operand .= $index_plus_comma . "rltrn:@$rightlefttruncated ";
1650                         $previous_truncation_operand = 1;
1651                     }
1652                 }
1653                 $operand = $truncated_operand if $truncated_operand;
1654                 warn "TRUNCATED OPERAND: >$truncated_operand<" if $DEBUG;
1655
1656                 # Handle Stemming
1657                 my $stemmed_operand;
1658                 $stemmed_operand = _build_stemmed_operand($operand, $lang)
1659                                                                                 if $stemming;
1660
1661                 warn "STEMMED OPERAND: >$stemmed_operand<" if $DEBUG;
1662
1663                 # Handle Field Weighting
1664                 my $weighted_operand;
1665                 if ($weight_fields) {
1666                     $weighted_operand = _build_weighted_query( $operand, $stemmed_operand, $index );
1667                     $operand = $weighted_operand;
1668                     $indexes_set = 1;
1669                 }
1670
1671                 warn "FIELD WEIGHTED OPERAND: >$weighted_operand<" if $DEBUG;
1672
1673                 ($query,$query_cgi,$query_desc,$previous_operand) = _build_initial_query({
1674                     query => $query,
1675                     query_cgi => $query_cgi,
1676                     query_desc => $query_desc,
1677                     operator => ($operators[ $i - 1 ]) ? $operators[ $i - 1 ] : '',
1678                     parsed_operand => $operand,
1679                     original_operand => ($operands[$i]) ? $operands[$i] : '',
1680                     index => $index,
1681                     index_plus => $index_plus,
1682                     indexes_set => $indexes_set,
1683                     previous_operand => $previous_operand,
1684                 });
1685
1686             }    #/if $operands
1687         }    # /for
1688     }
1689     warn "QUERY BEFORE LIMITS: >$query<" if $DEBUG;
1690
1691     # add limits
1692     my %group_OR_limits;
1693     my $availability_limit;
1694     foreach my $this_limit (@limits) {
1695         next unless $this_limit;
1696         if ( $this_limit =~ /available/ ) {
1697 #
1698 ## 'available' is defined as (items.onloan is NULL) and (items.itemlost = 0)
1699 ## In English:
1700 ## all records not indexed in the onloan register (zebra) and all records with a value of lost equal to 0
1701             $availability_limit .=
1702 "( ( allrecords,AlwaysMatches='' not onloan,AlwaysMatches='') and (lost,st-numeric=0) )"; #or ( allrecords,AlwaysMatches='' not lost,AlwaysMatches='')) )";
1703             $limit_cgi  .= "&limit=available";
1704             $limit_desc .= "";
1705         }
1706
1707         # group_OR_limits, prefixed by mc-
1708         # OR every member of the group
1709         elsif ( $this_limit =~ /mc/ ) {
1710             my ($k,$v) = split(/:/, $this_limit,2);
1711             if ( $k !~ /mc-i(tem)?type/ ) {
1712                 # in case the mc-ccode value has complicating chars like ()'s inside it we wrap in quotes
1713                 $this_limit =~ tr/"//d;
1714                 $this_limit = $k.":'".$v."'";
1715             }
1716
1717             $group_OR_limits{$k} .= " or " if $group_OR_limits{$k};
1718             $limit_desc      .= " or " if $group_OR_limits{$k};
1719             $group_OR_limits{$k} .= "$this_limit";
1720             $limit_cgi       .= "&limit=" . uri_escape_utf8($this_limit);
1721             $limit_desc      .= " $this_limit";
1722         }
1723
1724         # Regular old limits
1725         else {
1726             $limit .= " and " if $limit || $query;
1727             $limit      .= "$this_limit";
1728             $limit_cgi  .= "&limit=" . uri_escape_utf8($this_limit);
1729             if ($this_limit =~ /^branch:(.+)/) {
1730                 my $branchcode = $1;
1731                 my $library = Koha::Libraries->find( $branchcode );
1732                 if (defined $library) {
1733                     $limit_desc .= " branch:" . $library->branchname;
1734                 } else {
1735                     $limit_desc .= " $this_limit";
1736                 }
1737             } else {
1738                 $limit_desc .= " $this_limit";
1739             }
1740         }
1741     }
1742     foreach my $k (keys (%group_OR_limits)) {
1743         $limit .= " and " if ( $query || $limit );
1744         $limit .= "($group_OR_limits{$k})";
1745     }
1746     if ($availability_limit) {
1747         $limit .= " and " if ( $query || $limit );
1748         $limit .= "($availability_limit)";
1749     }
1750
1751     # Normalize the query and limit strings
1752     # This is flawed , means we can't search anything with : in it
1753     # if user wants to do ccl or cql, start the query with that
1754 #    $query =~ s/:/=/g;
1755     #NOTE: We use several several different regexps here as you can't have variable length lookback assertions
1756     $query =~ s/(?<=(ti|au|pb|su|an|kw|mc|nb|ns)):/=/g;
1757     $query =~ s/(?<=(wrdl)):/=/g;
1758     $query =~ s/(?<=(trn|phr)):/=/g;
1759     $query =~ s/(?<=(st-numeric)):/=/g;
1760     $query =~ s/(?<=(st-year)):/=/g;
1761     $query =~ s/(?<=(st-date-normalized)):/=/g;
1762     $limit =~ s/:/=/g;
1763     for ( $query, $query_desc, $limit, $limit_desc ) {
1764         s/  +/ /g;    # remove extra spaces
1765         s/^ //g;     # remove any beginning spaces
1766         s/ $//g;     # remove any ending spaces
1767         s/==/=/g;    # remove double == from query
1768     }
1769     $query_cgi =~ s/^&//; # remove unnecessary & from beginning of the query cgi
1770
1771     for ($query_cgi,$simple_query) {
1772         s/"//g;
1773     }
1774     # append the limit to the query
1775     $query .= " " . $limit;
1776
1777     # Warnings if DEBUG
1778     if ($DEBUG) {
1779         warn "QUERY:" . $query;
1780         warn "QUERY CGI:" . $query_cgi;
1781         warn "QUERY DESC:" . $query_desc;
1782         warn "LIMIT:" . $limit;
1783         warn "LIMIT CGI:" . $limit_cgi;
1784         warn "LIMIT DESC:" . $limit_desc;
1785         warn "---------\nLeave buildQuery\n---------";
1786     }
1787
1788     return (
1789         undef,              $query, $simple_query, $query_cgi,
1790         $query_desc,        $limit, $limit_cgi,    $limit_desc,
1791         $query_type
1792     );
1793 }
1794
1795 =head2 _build_initial_query
1796
1797   ($query, $query_cgi, $query_desc, $previous_operand) = _build_initial_query($initial_query_params);
1798
1799   Build a section of the initial query containing indexes, operators, and operands.
1800
1801 =cut
1802
1803 sub _build_initial_query {
1804     my ($params) = @_;
1805
1806     my $operator = "";
1807     if ($params->{previous_operand}){
1808         #If there is a previous operand, add a supplied operator or the default 'and'
1809         $operator = ($params->{operator}) ? " ".($params->{operator})." " : ' and ';
1810     }
1811
1812     #NOTE: indexes_set is typically set when doing truncation or field weighting
1813     my $operand = ($params->{indexes_set}) ? $params->{parsed_operand} : $params->{index_plus}.$params->{parsed_operand};
1814
1815     #e.g. "kw,wrdl:test"
1816     #e.g. " and kw,wrdl:test"
1817     $params->{query} .= $operator . $operand;
1818
1819     $params->{query_cgi} .= "&op=".uri_escape_utf8($operator) if $operator;
1820     $params->{query_cgi} .= "&idx=".uri_escape_utf8($params->{index}) if $params->{index};
1821     $params->{query_cgi} .= "&q=".uri_escape_utf8($params->{original_operand}) if $params->{original_operand};
1822
1823     #e.g. " and kw,wrdl: test"
1824     $params->{query_desc} .= $operator . $params->{index_plus} . " " . $params->{original_operand};
1825
1826     $params->{previous_operand} = 1 unless $params->{previous_operand}; #If there is no previous operand, mark this as one
1827
1828     return ($params->{query}, $params->{query_cgi}, $params->{query_desc}, $params->{previous_operand});
1829 }
1830
1831 =head2 searchResults
1832
1833   my @search_results = searchResults($search_context, $searchdesc, $hits,
1834                                      $results_per_page, $offset, $scan,
1835                                      @marcresults);
1836
1837 Format results in a form suitable for passing to the template
1838
1839 =cut
1840
1841 # IMO this subroutine is pretty messy still -- it's responsible for
1842 # building the HTML output for the template
1843 sub searchResults {
1844     my ( $search_context, $searchdesc, $hits, $results_per_page, $offset, $scan, $marcresults ) = @_;
1845     my $dbh = C4::Context->dbh;
1846     my @newresults;
1847
1848     require C4::Items;
1849
1850     $search_context = 'opac' if !$search_context || $search_context ne 'intranet';
1851     my ($is_opac, $hidelostitems);
1852     if ($search_context eq 'opac') {
1853         $hidelostitems = C4::Context->preference('hidelostitems');
1854         $is_opac       = 1;
1855     }
1856
1857     #Build branchnames hash
1858     my %branches = map { $_->branchcode => $_->branchname } Koha::Libraries->search({}, { order_by => 'branchname' });
1859
1860 # FIXME - We build an authorised values hash here, using the default framework
1861 # though it is possible to have different authvals for different fws.
1862
1863     my $shelflocations =
1864       { map { $_->{authorised_value} => $_->{lib} } Koha::AuthorisedValues->get_descriptions_by_koha_field( { frameworkcode => '', kohafield => 'items.location' } ) };
1865
1866     # get notforloan authorised value list (see $shelflocations  FIXME)
1867     my $av = Koha::MarcSubfieldStructures->search({ frameworkcode => '', kohafield => 'items.notforloan', authorised_value => { not => undef } });
1868     my $notforloan_authorised_value = $av->count ? $av->next->authorised_value : undef;
1869
1870     #Get itemtype hash
1871     my $itemtypes = Koha::ItemTypes->search_with_localization;
1872     my %itemtypes = map { $_->{itemtype} => $_ } @{ $itemtypes->unblessed };
1873
1874     #search item field code
1875     my ($itemtag, undef) = &GetMarcFromKohaField( "items.itemnumber", "" );
1876
1877     ## find column names of items related to MARC
1878     my %subfieldstosearch;
1879     my @columns = Koha::Database->new()->schema()->resultset('Item')->result_source->columns;
1880     for my $column ( @columns ) {
1881         my ( $tagfield, $tagsubfield ) =
1882           &GetMarcFromKohaField( "items." . $column, "" );
1883         if ( defined $tagsubfield ) {
1884             $subfieldstosearch{$column} = $tagsubfield;
1885         }
1886     }
1887
1888     # handle which records to actually retrieve
1889     my $times;
1890     if ( $hits && $offset + $results_per_page <= $hits ) {
1891         $times = $offset + $results_per_page;
1892     }
1893     else {
1894         $times = $hits;  # FIXME: if $hits is undefined, why do we want to equal it?
1895     }
1896
1897     my $marcflavour = C4::Context->preference("marcflavour");
1898     # We get the biblionumber position in MARC
1899     my ($bibliotag,$bibliosubf)=GetMarcFromKohaField('biblio.biblionumber','');
1900
1901     # set stuff for XSLT processing here once, not later again for every record we retrieved
1902     my $interface = $search_context eq 'opac' ? 'OPAC' : '';
1903     my $xslsyspref = $interface . "XSLTResultsDisplay";
1904     my $xslfile = C4::Context->preference($xslsyspref);
1905     my $lang   = $xslfile ? C4::Languages::getlanguage()  : undef;
1906     my $sysxml = $xslfile ? C4::XSLT::get_xslt_sysprefs() : undef;
1907
1908     # loop through all of the records we've retrieved
1909     for ( my $i = $offset ; $i <= $times - 1 ; $i++ ) {
1910
1911         my $marcrecord;
1912         if ($scan) {
1913             # For Scan searches we built USMARC data
1914             $marcrecord = MARC::Record->new_from_usmarc( $marcresults->[$i]);
1915         } else {
1916             # Normal search, render from Zebra's output
1917             $marcrecord = new_record_from_zebra(
1918                 'biblioserver',
1919                 $marcresults->[$i]
1920             );
1921
1922             if ( ! defined $marcrecord ) {
1923                 warn "ERROR DECODING RECORD - $@: " . $marcresults->[$i];
1924                 next;
1925             }
1926         }
1927
1928         my $fw = $scan
1929              ? undef
1930              : $bibliotag < 10
1931                ? GetFrameworkCode($marcrecord->field($bibliotag)->data)
1932                : GetFrameworkCode($marcrecord->subfield($bibliotag,$bibliosubf));
1933
1934         SetUTF8Flag($marcrecord);
1935         my $oldbiblio = TransformMarcToKoha( $marcrecord, $fw );
1936         $oldbiblio->{subtitle} = GetRecordValue('subtitle', $marcrecord, $fw);
1937         $oldbiblio->{result_number} = $i + 1;
1938
1939         # add imageurl to itemtype if there is one
1940         $oldbiblio->{imageurl} = getitemtypeimagelocation( $search_context, $itemtypes{ $oldbiblio->{itemtype} }->{imageurl} );
1941
1942                 $oldbiblio->{normalized_upc}  = GetNormalizedUPC(       $marcrecord,$marcflavour);
1943                 $oldbiblio->{normalized_ean}  = GetNormalizedEAN(       $marcrecord,$marcflavour);
1944                 $oldbiblio->{normalized_oclc} = GetNormalizedOCLCNumber($marcrecord,$marcflavour);
1945                 $oldbiblio->{normalized_isbn} = GetNormalizedISBN(undef,$marcrecord,$marcflavour);
1946                 $oldbiblio->{content_identifier_exists} = 1 if ($oldbiblio->{normalized_isbn} or $oldbiblio->{normalized_oclc} or $oldbiblio->{normalized_ean} or $oldbiblio->{normalized_upc});
1947
1948                 # edition information, if any
1949         $oldbiblio->{edition} = $oldbiblio->{editionstatement};
1950         $oldbiblio->{description} = $itemtypes{ $oldbiblio->{itemtype} }->{translated_description};
1951  # Build summary if there is one (the summary is defined in the itemtypes table)
1952  # FIXME: is this used anywhere, I think it can be commented out? -- JF
1953         if ( $itemtypes{ $oldbiblio->{itemtype} }->{summary} ) {
1954             my $summary = $itemtypes{ $oldbiblio->{itemtype} }->{summary};
1955             my @fields  = $marcrecord->fields();
1956
1957             my $newsummary;
1958             foreach my $line ( "$summary\n" =~ /(.*)\n/g ){
1959                 my $tags = {};
1960                 foreach my $tag ( $line =~ /\[(\d{3}[\w|\d])\]/ ) {
1961                     $tag =~ /(.{3})(.)/;
1962                     if($marcrecord->field($1)){
1963                         my @abc = $marcrecord->field($1)->subfield($2);
1964                         $tags->{$tag} = $#abc + 1 ;
1965                     }
1966                 }
1967
1968                 # We catch how many times to repeat this line
1969                 my $max = 0;
1970                 foreach my $tag (keys(%$tags)){
1971                     $max = $tags->{$tag} if($tags->{$tag} > $max);
1972                  }
1973
1974                 # we replace, and repeat each line
1975                 for (my $i = 0 ; $i < $max ; $i++){
1976                     my $newline = $line;
1977
1978                     foreach my $tag ( $newline =~ /\[(\d{3}[\w|\d])\]/g ) {
1979                         $tag =~ /(.{3})(.)/;
1980
1981                         if($marcrecord->field($1)){
1982                             my @repl = $marcrecord->field($1)->subfield($2);
1983                             my $subfieldvalue = $repl[$i];
1984                             $newline =~ s/\[$tag\]/$subfieldvalue/g;
1985                         }
1986                     }
1987                     $newsummary .= "$newline\n";
1988                 }
1989             }
1990
1991             $newsummary =~ s/\[(.*?)]//g;
1992             $newsummary =~ s/\n/<br\/>/g;
1993             $oldbiblio->{summary} = $newsummary;
1994         }
1995
1996         # Pull out the items fields
1997         my @fields = $marcrecord->field($itemtag);
1998         my $marcflavor = C4::Context->preference("marcflavour");
1999         # adding linked items that belong to host records
2000         my $analyticsfield = '773';
2001         if ($marcflavor eq 'MARC21' || $marcflavor eq 'NORMARC') {
2002             $analyticsfield = '773';
2003         } elsif ($marcflavor eq 'UNIMARC') {
2004             $analyticsfield = '461';
2005         }
2006         foreach my $hostfield ( $marcrecord->field($analyticsfield)) {
2007             my $hostbiblionumber = $hostfield->subfield("0");
2008             my $linkeditemnumber = $hostfield->subfield("9");
2009             if(!$hostbiblionumber eq undef){
2010                 my $hostbiblio = GetMarcBiblio($hostbiblionumber, 1);
2011                 my ($itemfield, undef) = GetMarcFromKohaField( 'items.itemnumber', GetFrameworkCode($hostbiblionumber) );
2012                 if(!$hostbiblio eq undef){
2013                     my @hostitems = $hostbiblio->field($itemfield);
2014                     foreach my $hostitem (@hostitems){
2015                         if ($hostitem->subfield("9") eq $linkeditemnumber){
2016                             my $linkeditem =$hostitem;
2017                             # append linked items if they exist
2018                             if (!$linkeditem eq undef){
2019                                 push (@fields, $linkeditem);}
2020                         }
2021                     }
2022                 }
2023             }
2024         }
2025
2026         # Setting item statuses for display
2027         my @available_items_loop;
2028         my @onloan_items_loop;
2029         my @other_items_loop;
2030
2031         my $available_items;
2032         my $onloan_items;
2033         my $other_items;
2034
2035         my $ordered_count         = 0;
2036         my $available_count       = 0;
2037         my $onloan_count          = 0;
2038         my $longoverdue_count     = 0;
2039         my $other_count           = 0;
2040         my $withdrawn_count        = 0;
2041         my $itemlost_count        = 0;
2042         my $hideatopac_count      = 0;
2043         my $itembinding_count     = 0;
2044         my $itemdamaged_count     = 0;
2045         my $item_in_transit_count = 0;
2046         my $can_place_holds       = 0;
2047         my $item_onhold_count     = 0;
2048         my $notforloan_count      = 0;
2049         my $items_count           = scalar(@fields);
2050         my $maxitems_pref = C4::Context->preference('maxItemsinSearchResults');
2051         my $maxitems = $maxitems_pref ? $maxitems_pref - 1 : 1;
2052         my @hiddenitems; # hidden itemnumbers based on OpacHiddenItems syspref
2053
2054         # loop through every item
2055         foreach my $field (@fields) {
2056             my $item;
2057
2058             # populate the items hash
2059             foreach my $code ( keys %subfieldstosearch ) {
2060                 $item->{$code} = $field->subfield( $subfieldstosearch{$code} );
2061             }
2062             $item->{description} = $itemtypes{ $item->{itype} }{translated_description};
2063
2064                 # OPAC hidden items
2065             if ($is_opac) {
2066                 # hidden because lost
2067                 if ($hidelostitems && $item->{itemlost}) {
2068                     $hideatopac_count++;
2069                     next;
2070                 }
2071                 # hidden based on OpacHiddenItems syspref
2072                 my @hi = C4::Items::GetHiddenItemnumbers($item);
2073                 if (scalar @hi) {
2074                     push @hiddenitems, @hi;
2075                     $hideatopac_count++;
2076                     next;
2077                 }
2078             }
2079
2080             my $hbranch     = C4::Context->preference('StaffSearchResultsDisplayBranch');
2081             my $otherbranch = $hbranch eq 'homebranch' ? 'holdingbranch' : 'homebranch';
2082
2083             # set item's branch name, use HomeOrHoldingBranch syspref first, fall back to the other one
2084             if ($item->{$hbranch}) {
2085                 $item->{'branchname'} = $branches{$item->{$hbranch}};
2086             }
2087             elsif ($item->{$otherbranch}) {     # Last resort
2088                 $item->{'branchname'} = $branches{$item->{$otherbranch}};
2089             }
2090
2091                         my $prefix = $item->{$hbranch} . '--' . $item->{location} . $item->{itype} . $item->{itemcallnumber};
2092 # For each grouping of items (onloan, available, unavailable), we build a key to store relevant info about that item
2093             my $userenv = C4::Context->userenv;
2094             if ( $item->{onloan}
2095                 && $userenv
2096                 && $userenv->{number}
2097                 && !( Koha::Patrons->find($userenv->{number})->category->hidelostitems && $item->{itemlost} ) )
2098             {
2099                 $onloan_count++;
2100                 my $key = $prefix . $item->{onloan} . $item->{barcode};
2101                 $onloan_items->{$key}->{due_date} = $item->{onloan};
2102                 $onloan_items->{$key}->{count}++ if $item->{$hbranch};
2103                 $onloan_items->{$key}->{branchname}     = $item->{branchname};
2104                 $onloan_items->{$key}->{location}       = $shelflocations->{ $item->{location} };
2105                 $onloan_items->{$key}->{itemcallnumber} = $item->{itemcallnumber};
2106                 $onloan_items->{$key}->{description}    = $item->{description};
2107                 $onloan_items->{$key}->{imageurl} =
2108                   getitemtypeimagelocation( $search_context, $itemtypes{ $item->{itype} }->{imageurl} );
2109
2110                 # if something's checked out and lost, mark it as 'long overdue'
2111                 if ( $item->{itemlost} ) {
2112                     $onloan_items->{$key}->{longoverdue}++;
2113                     $longoverdue_count++;
2114                 }
2115                 else {    # can place holds as long as item isn't lost
2116                     $can_place_holds = 1;
2117                 }
2118             }
2119
2120          # items not on loan, but still unavailable ( lost, withdrawn, damaged )
2121             else {
2122
2123                 $item->{notforloan}=1 if !$item->{notforloan}  && $itemtypes{ C4::Context->preference("item-level_itypes")? $item->{itype}: $oldbiblio->{itemtype} }->{notforloan};
2124
2125                 # item is on order
2126                 if ( $item->{notforloan} < 0 ) {
2127                     $ordered_count++;
2128                 } elsif ( $item->{notforloan} > 0 ) {
2129                     $notforloan_count++;
2130                 }
2131
2132                 # is item in transit?
2133                 my $transfertwhen = '';
2134                 my ($transfertfrom, $transfertto);
2135
2136                 # is item on the reserve shelf?
2137                 my $reservestatus = '';
2138
2139                 unless ($item->{withdrawn}
2140                         || $item->{itemlost}
2141                         || $item->{damaged}
2142                         || $item->{notforloan}
2143                         || ( C4::Context->preference('MaxSearchResultsItemsPerRecordStatusCheck')
2144                         && $items_count > C4::Context->preference('MaxSearchResultsItemsPerRecordStatusCheck') ) ) {
2145
2146                     # A couple heuristics to limit how many times
2147                     # we query the database for item transfer information, sacrificing
2148                     # accuracy in some cases for speed;
2149                     #
2150                     # 1. don't query if item has one of the other statuses
2151                     # 2. don't check transit status if the bib has
2152                     #    more than 20 items
2153                     #
2154                     # FIXME: to avoid having the query the database like this, and to make
2155                     #        the in transit status count as unavailable for search limiting,
2156                     #        should map transit status to record indexed in Zebra.
2157                     #
2158                     ($transfertwhen, $transfertfrom, $transfertto) = C4::Circulation::GetTransfers($item->{itemnumber});
2159                     $reservestatus = C4::Reserves::GetReserveStatus( $item->{itemnumber} );
2160                 }
2161
2162                 # item is withdrawn, lost, damaged, not for loan, reserved or in transit
2163                 if (   $item->{withdrawn}
2164                     || $item->{itemlost}
2165                     || $item->{damaged}
2166                     || $item->{notforloan}
2167                     || $reservestatus eq 'Waiting'
2168                     || ($transfertwhen ne ''))
2169                 {
2170                     $withdrawn_count++        if $item->{withdrawn};
2171                     $itemlost_count++        if $item->{itemlost};
2172                     $itemdamaged_count++     if $item->{damaged};
2173                     $item_in_transit_count++ if $transfertwhen ne '';
2174                     $item_onhold_count++     if $reservestatus eq 'Waiting';
2175                     $item->{status} = $item->{withdrawn} . "-" . $item->{itemlost} . "-" . $item->{damaged} . "-" . $item->{notforloan};
2176
2177                     # can place a hold on a item if
2178                     # not lost nor withdrawn
2179                     # not damaged unless AllowHoldsOnDamagedItems is true
2180                     # item is either for loan or on order (notforloan < 0)
2181                     $can_place_holds = 1
2182                       if (
2183                            !$item->{itemlost}
2184                         && !$item->{withdrawn}
2185                         && ( !$item->{damaged} || C4::Context->preference('AllowHoldsOnDamagedItems') )
2186                         && ( !$item->{notforloan} || $item->{notforloan} < 0 )
2187                       );
2188
2189                     $other_count++;
2190
2191                     my $key = $prefix . $item->{status};
2192                     foreach (qw(withdrawn itemlost damaged branchname itemcallnumber)) {
2193                         $other_items->{$key}->{$_} = $item->{$_};
2194                     }
2195                     $other_items->{$key}->{intransit} = ( $transfertwhen ne '' ) ? 1 : 0;
2196                     $other_items->{$key}->{onhold} = ($reservestatus) ? 1 : 0;
2197                     $other_items->{$key}->{notforloan} = GetAuthorisedValueDesc('','',$item->{notforloan},'','',$notforloan_authorised_value) if $notforloan_authorised_value and $item->{notforloan};
2198                                         $other_items->{$key}->{count}++ if $item->{$hbranch};
2199                                         $other_items->{$key}->{location} = $shelflocations->{ $item->{location} };
2200                                         $other_items->{$key}->{description} = $item->{description};
2201                                         $other_items->{$key}->{imageurl} = getitemtypeimagelocation( $search_context, $itemtypes{ $item->{itype} }->{imageurl} );
2202                 }
2203                 # item is available
2204                 else {
2205                     $can_place_holds = 1;
2206                     $available_count++;
2207                                         $available_items->{$prefix}->{count}++ if $item->{$hbranch};
2208                                         foreach (qw(branchname itemcallnumber description)) {
2209                         $available_items->{$prefix}->{$_} = $item->{$_};
2210                                         }
2211                                         $available_items->{$prefix}->{location} = $shelflocations->{ $item->{location} };
2212                                         $available_items->{$prefix}->{imageurl} = getitemtypeimagelocation( $search_context, $itemtypes{ $item->{itype} }->{imageurl} );
2213                 }
2214             }
2215         }    # notforloan, item level and biblioitem level
2216
2217         # if all items are hidden, do not show the record
2218         if ($items_count > 0 && $hideatopac_count == $items_count) {
2219             next;
2220         }
2221
2222         my ( $availableitemscount, $onloanitemscount, $otheritemscount );
2223         for my $key ( sort keys %$onloan_items ) {
2224             (++$onloanitemscount > $maxitems) and last;
2225             push @onloan_items_loop, $onloan_items->{$key};
2226         }
2227         for my $key ( sort keys %$other_items ) {
2228             (++$otheritemscount > $maxitems) and last;
2229             push @other_items_loop, $other_items->{$key};
2230         }
2231         for my $key ( sort keys %$available_items ) {
2232             (++$availableitemscount > $maxitems) and last;
2233             push @available_items_loop, $available_items->{$key}
2234         }
2235
2236         # XSLT processing of some stuff
2237         # we fetched the sysprefs already before the loop through all retrieved record!
2238         if (!$scan && $xslfile) {
2239             $oldbiblio->{XSLTResultsRecord} = XSLTParse4Display($oldbiblio->{biblionumber}, $marcrecord, $xslsyspref, 1, \@hiddenitems, $sysxml, $xslfile, $lang);
2240         # the last parameter tells Koha to clean up the problematic ampersand entities that Zebra outputs
2241         }
2242
2243         # if biblio level itypes are used and itemtype is notforloan, it can't be reserved either
2244         if (!C4::Context->preference("item-level_itypes")) {
2245             if ($itemtypes{ $oldbiblio->{itemtype} }->{notforloan}) {
2246                 $can_place_holds = 0;
2247             }
2248         }
2249         $oldbiblio->{norequests} = 1 unless $can_place_holds;
2250         $oldbiblio->{itemsplural}          = 1 if $items_count > 1;
2251         $oldbiblio->{items_count}          = $items_count;
2252         $oldbiblio->{available_items_loop} = \@available_items_loop;
2253         $oldbiblio->{onloan_items_loop}    = \@onloan_items_loop;
2254         $oldbiblio->{other_items_loop}     = \@other_items_loop;
2255         $oldbiblio->{availablecount}       = $available_count;
2256         $oldbiblio->{availableplural}      = 1 if $available_count > 1;
2257         $oldbiblio->{onloancount}          = $onloan_count;
2258         $oldbiblio->{onloanplural}         = 1 if $onloan_count > 1;
2259         $oldbiblio->{othercount}           = $other_count;
2260         $oldbiblio->{otherplural}          = 1 if $other_count > 1;
2261         $oldbiblio->{withdrawncount}        = $withdrawn_count;
2262         $oldbiblio->{itemlostcount}        = $itemlost_count;
2263         $oldbiblio->{damagedcount}         = $itemdamaged_count;
2264         $oldbiblio->{intransitcount}       = $item_in_transit_count;
2265         $oldbiblio->{onholdcount}          = $item_onhold_count;
2266         $oldbiblio->{orderedcount}         = $ordered_count;
2267         $oldbiblio->{notforloancount}      = $notforloan_count;
2268
2269         if (C4::Context->preference("AlternateHoldingsField") && $items_count == 0) {
2270             my $fieldspec = C4::Context->preference("AlternateHoldingsField");
2271             my $subfields = substr $fieldspec, 3;
2272             my $holdingsep = C4::Context->preference("AlternateHoldingsSeparator") || ' ';
2273             my @alternateholdingsinfo = ();
2274             my @holdingsfields = $marcrecord->field(substr $fieldspec, 0, 3);
2275             my $alternateholdingscount = 0;
2276
2277             for my $field (@holdingsfields) {
2278                 my %holding = ( holding => '' );
2279                 my $havesubfield = 0;
2280                 for my $subfield ($field->subfields()) {
2281                     if ((index $subfields, $$subfield[0]) >= 0) {
2282                         $holding{'holding'} .= $holdingsep if (length $holding{'holding'} > 0);
2283                         $holding{'holding'} .= $$subfield[1];
2284                         $havesubfield++;
2285                     }
2286                 }
2287                 if ($havesubfield) {
2288                     push(@alternateholdingsinfo, \%holding);
2289                     $alternateholdingscount++;
2290                 }
2291             }
2292
2293             $oldbiblio->{'ALTERNATEHOLDINGS'} = \@alternateholdingsinfo;
2294             $oldbiblio->{'alternateholdings_count'} = $alternateholdingscount;
2295         }
2296
2297         push( @newresults, $oldbiblio );
2298     }
2299
2300     return @newresults;
2301 }
2302
2303 =head2 enabled_staff_search_views
2304
2305 %hash = enabled_staff_search_views()
2306
2307 This function returns a hash that contains three flags obtained from the system
2308 preferences, used to determine whether a particular staff search results view
2309 is enabled.
2310
2311 =over 2
2312
2313 =item C<Output arg:>
2314
2315     * $hash{can_view_MARC} is true only if the MARC view is enabled
2316     * $hash{can_view_ISBD} is true only if the ISBD view is enabled
2317     * $hash{can_view_labeledMARC} is true only if the Labeled MARC view is enabled
2318
2319 =item C<usage in the script:>
2320
2321 =back
2322
2323 $template->param ( C4::Search::enabled_staff_search_views );
2324
2325 =cut
2326
2327 sub enabled_staff_search_views
2328 {
2329         return (
2330                 can_view_MARC                   => C4::Context->preference('viewMARC'),                 # 1 if the staff search allows the MARC view
2331                 can_view_ISBD                   => C4::Context->preference('viewISBD'),                 # 1 if the staff search allows the ISBD view
2332                 can_view_labeledMARC    => C4::Context->preference('viewLabeledMARC'),  # 1 if the staff search allows the Labeled MARC view
2333         );
2334 }
2335
2336 =head2 z3950_search_args
2337
2338 $arrayref = z3950_search_args($matchpoints)
2339
2340 This function returns an array reference that contains the search parameters to be
2341 passed to the Z39.50 search script (z3950_search.pl). The array elements
2342 are hash refs whose keys are name and value, and whose values are the
2343 name of a search parameter, the value of that search parameter and the URL encoded
2344 value of that parameter.
2345
2346 The search parameter names are lccn, isbn, issn, title, author, dewey and subject.
2347
2348 The search parameter values are obtained from the bibliographic record whose
2349 data is in a hash reference in $matchpoints, as returned by Biblio::GetBiblioData().
2350
2351 If $matchpoints is a scalar, it is assumed to be an unnamed query descriptor, e.g.
2352 a general purpose search argument. In this case, the returned array contains only
2353 entry: the key is 'title' and the value is derived from $matchpoints.
2354
2355 If a search parameter value is undefined or empty, it is not included in the returned
2356 array.
2357
2358 The returned array reference may be passed directly to the template parameters.
2359
2360 =over 2
2361
2362 =item C<Output arg:>
2363
2364     * $array containing hash refs as described above
2365
2366 =item C<usage in the script:>
2367
2368 =back
2369
2370 $data = Biblio::GetBiblioData($bibno);
2371 $template->param ( MYLOOP => C4::Search::z3950_search_args($data) )
2372
2373 *OR*
2374
2375 $template->param ( MYLOOP => C4::Search::z3950_search_args($searchscalar) )
2376
2377 =cut
2378
2379 sub z3950_search_args {
2380     my $bibrec = shift;
2381
2382     my $isbn_string = ref( $bibrec ) ? $bibrec->{title} : $bibrec;
2383     my $isbn = Business::ISBN->new( $isbn_string );
2384
2385     if (defined $isbn && $isbn->is_valid)
2386     {
2387         if ( ref($bibrec) ) {
2388             $bibrec->{isbn} = $isbn_string;
2389             $bibrec->{title} = undef;
2390         } else {
2391             $bibrec = { isbn => $isbn_string };
2392         }
2393     }
2394     else {
2395         $bibrec = { title => $bibrec } if !ref $bibrec;
2396     }
2397     my $array = [];
2398     for my $field (qw/ lccn isbn issn title author dewey subject /)
2399     {
2400         push @$array, { name => $field, value => $bibrec->{$field} }
2401           if defined $bibrec->{$field};
2402     }
2403     return $array;
2404 }
2405
2406 =head2 GetDistinctValues($field);
2407
2408 C<$field> is a reference to the fields array
2409
2410 =cut
2411
2412 sub GetDistinctValues {
2413     my ($fieldname,$string)=@_;
2414     # returns a reference to a hash of references to branches...
2415     if ($fieldname=~/\./){
2416                         my ($table,$column)=split /\./, $fieldname;
2417                         my $dbh = C4::Context->dbh;
2418                         warn "select DISTINCT($column) as value, count(*) as cnt from $table group by lib order by $column " if $DEBUG;
2419                         my $sth = $dbh->prepare("select DISTINCT($column) as value, count(*) as cnt from $table ".($string?" where $column like \"$string%\"":"")."group by value order by $column ");
2420                         $sth->execute;
2421                         my $elements=$sth->fetchall_arrayref({});
2422                         return $elements;
2423    }
2424    else {
2425                 $string||= qq("");
2426                 my @servers=qw<biblioserver authorityserver>;
2427                 my (@zconns,@results);
2428         for ( my $i = 0 ; $i < @servers ; $i++ ) {
2429                 $zconns[$i] = C4::Context->Zconn( $servers[$i], 1 );
2430                         $results[$i] =
2431                       $zconns[$i]->scan(
2432                         ZOOM::Query::CCL2RPN->new( qq"$fieldname $string", $zconns[$i])
2433                       );
2434                 }
2435                 # The big moment: asynchronously retrieve results from all servers
2436                 my @elements;
2437         _ZOOM_event_loop(
2438             \@zconns,
2439             \@results,
2440             sub {
2441                 my ( $i, $size ) = @_;
2442                 for ( my $j = 0 ; $j < $size ; $j++ ) {
2443                     my %hashscan;
2444                     @hashscan{qw(value cnt)} =
2445                       $results[ $i - 1 ]->display_term($j);
2446                     push @elements, \%hashscan;
2447                 }
2448             }
2449         );
2450                 return \@elements;
2451    }
2452 }
2453
2454 =head2 _ZOOM_event_loop
2455
2456     _ZOOM_event_loop(\@zconns, \@results, sub {
2457         my ( $i, $size ) = @_;
2458         ....
2459     } );
2460
2461 Processes a ZOOM event loop and passes control to a closure for
2462 processing the results, and destroying the resultsets.
2463
2464 =cut
2465
2466 sub _ZOOM_event_loop {
2467     my ($zconns, $results, $callback) = @_;
2468     while ( ( my $i = ZOOM::event( $zconns ) ) != 0 ) {
2469         my $ev = $zconns->[ $i - 1 ]->last_event();
2470         if ( $ev == ZOOM::Event::ZEND ) {
2471             next unless $results->[ $i - 1 ];
2472             my $size = $results->[ $i - 1 ]->size();
2473             if ( $size > 0 ) {
2474                 $callback->($i, $size);
2475             }
2476         }
2477     }
2478
2479     foreach my $result (@$results) {
2480         $result->destroy();
2481     }
2482 }
2483
2484 =head2 new_record_from_zebra
2485
2486 Given raw data from a searchengine result set, return a MARC::Record object
2487
2488 This helper function is needed to take into account all the involved
2489 system preferences and configuration variables to properly create the
2490 MARC::Record object.
2491
2492 If we are using GRS-1, then the raw data we get from Zebra should be USMARC
2493 data. If we are using DOM, then it has to be MARCXML.
2494
2495 If we are using elasticsearch, it'll already be a MARC::Record and this
2496 function needs a new name.
2497
2498 =cut
2499
2500 sub new_record_from_zebra {
2501
2502     my $server   = shift;
2503     my $raw_data = shift;
2504     # Set the default indexing modes
2505     my $search_engine = C4::Context->preference("SearchEngine");
2506     if ($search_engine eq 'Elasticsearch') {
2507         return $raw_data;
2508     }
2509     my $index_mode = ( $server eq 'biblioserver' )
2510                         ? C4::Context->config('zebra_bib_index_mode') // 'dom'
2511                         : C4::Context->config('zebra_auth_index_mode') // 'dom';
2512
2513     my $marc_record =  eval {
2514         if ( $index_mode eq 'dom' ) {
2515             MARC::Record->new_from_xml( $raw_data, 'UTF-8' );
2516         } else {
2517             MARC::Record->new_from_usmarc( $raw_data );
2518         }
2519     };
2520
2521     if ($@) {
2522         return;
2523     } else {
2524         return $marc_record;
2525     }
2526
2527 }
2528
2529 END { }    # module clean-up code here (global destructor)
2530
2531 1;
2532 __END__
2533
2534 =head1 AUTHOR
2535
2536 Koha Development Team <http://koha-community.org/>
2537
2538 =cut