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