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 = q{};
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 = q{};
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 = q{};
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_cgi    //= q{};
1515     $simple_query //= q{};
1516     $limit =~ s/:/=/g;
1517     for ( $query, $query_desc, $limit, $limit_desc ) {
1518         s/  +/ /g;    # remove extra spaces
1519         s/^ //g;     # remove any beginning spaces
1520         s/ $//g;     # remove any ending spaces
1521         s/==/=/g;    # remove double == from query
1522     }
1523     $query_cgi =~ s/^&//; # remove unnecessary & from beginning of the query cgi
1524
1525     for ($query_cgi,$simple_query) {
1526         s/"//g;
1527     }
1528     # append the limit to the query
1529     $query .= " " . $limit;
1530
1531     Koha::Logger->get->debug(
1532         sprintf "buildQuery returns\nQUERY:%s\nQUERY CGI:%s\nQUERY DESC:%s\nLIMIT:%s\nLIMIT CGI:%s\nLIMIT DESC:%s",
1533         $query, $query_cgi, $query_desc, $limit, $limit_cgi, $limit_desc );
1534
1535     return (
1536         undef,              $query, $simple_query, $query_cgi,
1537         $query_desc,        $limit, $limit_cgi,    $limit_desc,
1538         $query_type
1539     );
1540 }
1541
1542 =head2 _build_initial_query
1543
1544   ($query, $query_cgi, $query_desc, $previous_operand) = _build_initial_query($initial_query_params);
1545
1546   Build a section of the initial query containing indexes, operators, and operands.
1547
1548 =cut
1549
1550 sub _build_initial_query {
1551     my ($params) = @_;
1552
1553     my $operator = "";
1554     if ($params->{previous_operand}){
1555         #If there is a previous operand, add a supplied operator or the default 'and'
1556         $operator = ($params->{operator}) ? " ".($params->{operator})." " : ' and ';
1557     }
1558
1559     #NOTE: indexes_set is typically set when doing truncation or field weighting
1560     my $operand = ($params->{indexes_set}) ? $params->{parsed_operand} : $params->{index_plus}.$params->{parsed_operand};
1561
1562     #e.g. "kw,wrdl:test"
1563     #e.g. " and kw,wrdl:test"
1564     $params->{query} .= $operator . $operand;
1565
1566     $params->{query_cgi} .= "&op=".uri_escape_utf8($operator) if $operator;
1567     $params->{query_cgi} .= "&idx=".uri_escape_utf8($params->{index}) if $params->{index};
1568     $params->{query_cgi} .= "&q=".uri_escape_utf8($params->{original_operand}) if $params->{original_operand};
1569
1570     #e.g. " and kw,wrdl: test"
1571     $params->{query_desc} .= $operator . ( $params->{index_plus} // q{} ) . " " . ( $params->{original_operand} // q{} );
1572
1573     $params->{previous_operand} = 1 unless $params->{previous_operand}; #If there is no previous operand, mark this as one
1574
1575     return ($params->{query}, $params->{query_cgi}, $params->{query_desc}, $params->{previous_operand});
1576 }
1577
1578 =head2 searchResults
1579
1580   my @search_results = searchResults($search_context, $searchdesc, $hits,
1581                                      $results_per_page, $offset, $scan,
1582                                      @marcresults);
1583
1584 Format results in a form suitable for passing to the template
1585
1586 =cut
1587
1588 # IMO this subroutine is pretty messy still -- it's responsible for
1589 # building the HTML output for the template
1590 sub searchResults {
1591     my ( $search_context, $searchdesc, $hits, $results_per_page, $offset, $scan, $marcresults, $xslt_variables ) = @_;
1592     my $dbh = C4::Context->dbh;
1593     my @newresults;
1594
1595     require C4::Items;
1596
1597     $search_context->{'interface'} = 'opac' if !$search_context->{'interface'} || $search_context->{'interface'} ne 'intranet';
1598     my ($is_opac, $hidelostitems);
1599     if ($search_context->{'interface'} eq 'opac') {
1600         $hidelostitems = C4::Context->preference('hidelostitems');
1601         $is_opac       = 1;
1602     }
1603
1604     my $record_processor = Koha::RecordProcessor->new({
1605         filters => 'ViewPolicy'
1606     });
1607
1608     #Build branchnames hash
1609     my %branches = map { $_->branchcode => $_->branchname } Koha::Libraries->search({}, { order_by => 'branchname' });
1610
1611 # FIXME - We build an authorised values hash here, using the default framework
1612 # though it is possible to have different authvals for different fws.
1613
1614     my $shelflocations =
1615       { map { $_->{authorised_value} => $_->{lib} } Koha::AuthorisedValues->get_descriptions_by_koha_field( { frameworkcode => '', kohafield => 'items.location' } ) };
1616
1617     # get notforloan authorised value list (see $shelflocations  FIXME)
1618     my $av = Koha::MarcSubfieldStructures->search({ frameworkcode => '', kohafield => 'items.notforloan', authorised_value => [ -and => {'!=' => undef }, {'!=' => ''}] });
1619     my $notforloan_authorised_value = $av->count ? $av->next->authorised_value : undef;
1620
1621     #Get itemtype hash
1622     my $itemtypes = Koha::ItemTypes->search_with_localization;
1623     my %itemtypes = map { $_->{itemtype} => $_ } @{ $itemtypes->unblessed };
1624
1625     #search item field code
1626     my ($itemtag, undef) = &GetMarcFromKohaField( "items.itemnumber" );
1627
1628     ## find column names of items related to MARC
1629     my %subfieldstosearch;
1630     my @columns = Koha::Database->new()->schema()->resultset('Item')->result_source->columns;
1631     for my $column ( @columns ) {
1632         my ( $tagfield, $tagsubfield ) =
1633           &GetMarcFromKohaField( "items." . $column );
1634         if ( defined $tagsubfield ) {
1635             $subfieldstosearch{$column} = $tagsubfield;
1636         }
1637     }
1638
1639     # handle which records to actually retrieve
1640     my $times; # Times is which record to process up to
1641     if ( $hits && $offset + $results_per_page <= $hits ) {
1642         $times = $offset + $results_per_page;
1643     }
1644     else {
1645         $times = $hits; # If less hits than results_per_page+offset we go to the end
1646     }
1647
1648     my $marcflavour = C4::Context->preference("marcflavour");
1649     # We get the biblionumber position in MARC
1650     my ($bibliotag,$bibliosubf)=GetMarcFromKohaField( 'biblio.biblionumber' );
1651
1652     # set stuff for XSLT processing here once, not later again for every record we retrieved
1653     my $xslfile;
1654     my $xslsyspref;
1655     if( $is_opac ){
1656         $xslsyspref = "OPACXSLTResultsDisplay";
1657         $xslfile = C4::Context->preference( $xslsyspref );
1658     } else {
1659         $xslsyspref = "XSLTResultsDisplay";
1660         $xslfile = C4::Context->preference( $xslsyspref ) || "default";
1661     }
1662     my $lang   = $xslfile ? C4::Languages::getlanguage()  : undef;
1663     my $sysxml = $xslfile ? C4::XSLT::get_xslt_sysprefs() : undef;
1664
1665     my $userenv = C4::Context->userenv;
1666     my $logged_in_user
1667         = ( defined $userenv and $userenv->{number} )
1668         ? Koha::Patrons->find( $userenv->{number} )
1669         : undef;
1670     my $patron_category_hide_lost_items = ($logged_in_user) ? $logged_in_user->category->hidelostitems : 0;
1671
1672     # loop through all of the records we've retrieved
1673     for ( my $i = $offset ; $i <= $times - 1 ; $i++ ) {
1674
1675         my $marcrecord;
1676         if ($scan) {
1677             # For Scan searches we built USMARC data
1678             $marcrecord = MARC::Record->new_from_usmarc( $marcresults->[$i]);
1679         } else {
1680             # Normal search, render from Zebra's output
1681             $marcrecord = new_record_from_zebra(
1682                 'biblioserver',
1683                 $marcresults->[$i]
1684             );
1685
1686             if ( ! defined $marcrecord ) {
1687                 warn "ERROR DECODING RECORD - $@: " . $marcresults->[$i];
1688                 next;
1689             }
1690         }
1691
1692         my $fw = $scan
1693              ? undef
1694              : $bibliotag < 10
1695                ? GetFrameworkCode($marcrecord->field($bibliotag)->data)
1696                : GetFrameworkCode($marcrecord->subfield($bibliotag,$bibliosubf));
1697
1698         SetUTF8Flag($marcrecord);
1699         my $oldbiblio = TransformMarcToKoha( $marcrecord, $fw, 'no_items' );
1700         $oldbiblio->{result_number} = $i + 1;
1701
1702                 $oldbiblio->{normalized_upc}  = GetNormalizedUPC(       $marcrecord,$marcflavour);
1703                 $oldbiblio->{normalized_ean}  = GetNormalizedEAN(       $marcrecord,$marcflavour);
1704                 $oldbiblio->{normalized_oclc} = GetNormalizedOCLCNumber($marcrecord,$marcflavour);
1705         $oldbiblio->{normalized_isbn} = GetNormalizedISBN($oldbiblio->{isbn},$marcrecord,$marcflavour); # Use existing ISBN from record if we got one
1706                 $oldbiblio->{content_identifier_exists} = 1 if ($oldbiblio->{normalized_isbn} or $oldbiblio->{normalized_oclc} or $oldbiblio->{normalized_ean} or $oldbiblio->{normalized_upc});
1707
1708                 # edition information, if any
1709         $oldbiblio->{edition} = $oldbiblio->{editionstatement};
1710
1711         my $itemtype = $oldbiblio->{itemtype} ? $itemtypes{$oldbiblio->{itemtype}} : undef;
1712         # add imageurl to itemtype if there is one
1713         $oldbiblio->{imageurl} = $itemtype ? getitemtypeimagelocation( $search_context->{'interface'}, $itemtype->{imageurl} ) : q{};
1714         # Build summary if there is one (the summary is defined in the itemtypes table)
1715         $oldbiblio->{description} = $itemtype ? $itemtype->{translated_description} : q{};
1716
1717         # FIXME: this is only used in the deprecated non-XLST opac results
1718         if ( !$xslfile && $is_opac && $itemtype && $itemtype->{summary} ) {
1719             my $summary = $itemtypes{ $oldbiblio->{itemtype} }->{summary};
1720             my @fields  = $marcrecord->fields();
1721
1722             my $newsummary;
1723             foreach my $line ( "$summary\n" =~ /(.*)\n/g ){
1724                 my $tags = {};
1725                 foreach my $tag ( $line =~ /\[(\d{3}[\w|\d])\]/ ) {
1726                     $tag =~ /(.{3})(.)/;
1727                     if($marcrecord->field($1)){
1728                         my @abc = $marcrecord->field($1)->subfield($2);
1729                         $tags->{$tag} = $#abc + 1 ;
1730                     }
1731                 }
1732
1733                 # We catch how many times to repeat this line
1734                 my $max = 0;
1735                 foreach my $tag (keys(%$tags)){
1736                     $max = $tags->{$tag} if($tags->{$tag} > $max);
1737                  }
1738
1739                 # we replace, and repeat each line
1740                 for (my $i = 0 ; $i < $max ; $i++){
1741                     my $newline = $line;
1742
1743                     foreach my $tag ( $newline =~ /\[(\d{3}[\w|\d])\]/g ) {
1744                         $tag =~ /(.{3})(.)/;
1745
1746                         if($marcrecord->field($1)){
1747                             my @repl = $marcrecord->field($1)->subfield($2);
1748                             my $subfieldvalue = $repl[$i];
1749                             $newline =~ s/\[$tag\]/$subfieldvalue/g;
1750                         }
1751                     }
1752                     $newsummary .= "$newline\n";
1753                 }
1754             }
1755
1756             $newsummary =~ s/\[(.*?)]//g;
1757             $newsummary =~ s/\n/<br\/>/g;
1758             $oldbiblio->{summary} = $newsummary;
1759         }
1760
1761         # Pull out the items fields
1762         my @fields = $marcrecord->field($itemtag);
1763         my $marcflavor = C4::Context->preference("marcflavour");
1764
1765         # adding linked items that belong to host records
1766         if ( C4::Context->preference('EasyAnalyticalRecords') ) {
1767             my $analyticsfield = '773';
1768             if ($marcflavor eq 'MARC21' || $marcflavor eq 'NORMARC') {
1769                 $analyticsfield = '773';
1770             } elsif ($marcflavor eq 'UNIMARC') {
1771                 $analyticsfield = '461';
1772             }
1773             foreach my $hostfield ( $marcrecord->field($analyticsfield)) {
1774                 my $hostbiblionumber = $hostfield->subfield("0");
1775                 my $linkeditemnumber = $hostfield->subfield("9");
1776                 if( $hostbiblionumber ) {
1777                     my $linkeditemmarc = C4::Items::GetMarcItem( $hostbiblionumber, $linkeditemnumber );
1778                     if ($linkeditemmarc) {
1779                         my $linkeditemfield = $linkeditemmarc->field($itemtag);
1780                         if ($linkeditemfield) {
1781                             push( @fields, $linkeditemfield );
1782                         }
1783                     }
1784                 }
1785             }
1786         }
1787
1788         # Setting item statuses for display
1789         my @available_items_loop;
1790         my @onloan_items_loop;
1791         my @other_items_loop;
1792
1793         my $available_items;
1794         my $onloan_items;
1795         my $other_items;
1796
1797         my $ordered_count         = 0;
1798         my $available_count       = 0;
1799         my $onloan_count          = 0;
1800         my $longoverdue_count     = 0;
1801         my $other_count           = 0;
1802         my $withdrawn_count        = 0;
1803         my $itemlost_count        = 0;
1804         my $hideatopac_count      = 0;
1805         my $itembinding_count     = 0;
1806         my $itemdamaged_count     = 0;
1807         my $item_in_transit_count = 0;
1808         my $can_place_holds       = 0;
1809         my $item_onhold_count     = 0;
1810         my $notforloan_count      = 0;
1811         my $items_count           = scalar(@fields);
1812         my $maxitems_pref = C4::Context->preference('maxItemsinSearchResults');
1813         my $maxitems = $maxitems_pref ? $maxitems_pref - 1 : 1;
1814         my @hiddenitems; # hidden itemnumbers based on OpacHiddenItems syspref
1815
1816         # loop through every item
1817         foreach my $field (@fields) {
1818             my $item;
1819
1820             # populate the items hash
1821             foreach my $code ( keys %subfieldstosearch ) {
1822                 $item->{$code} = $field->subfield( $subfieldstosearch{$code} );
1823             }
1824             $item->{description} = $itemtypes{ $item->{itype} }{translated_description} if $item->{itype};
1825
1826                 # OPAC hidden items
1827             if ($is_opac) {
1828                 # hidden because lost
1829                 if ($hidelostitems && $item->{itemlost}) {
1830                     $hideatopac_count++;
1831                     next;
1832                 }
1833                 # hidden based on OpacHiddenItems syspref
1834                 my @hi = C4::Items::GetHiddenItemnumbers({ items=> [ $item ], borcat => $search_context->{category} });
1835                 if (scalar @hi) {
1836                     push @hiddenitems, @hi;
1837                     $hideatopac_count++;
1838                     next;
1839                 }
1840             }
1841
1842             my $hbranch     = C4::Context->preference('StaffSearchResultsDisplayBranch');
1843             my $otherbranch = $hbranch eq 'homebranch' ? 'holdingbranch' : 'homebranch';
1844
1845             # set item's branch name, use HomeOrHoldingBranch syspref first, fall back to the other one
1846             if ($item->{$hbranch}) {
1847                 $item->{'branchname'} = $branches{$item->{$hbranch}};
1848             }
1849             elsif ($item->{$otherbranch}) {     # Last resort
1850                 $item->{'branchname'} = $branches{$item->{$otherbranch}};
1851             }
1852
1853             my $prefix =
1854                 ( $item->{$hbranch} ? $item->{$hbranch} . '--' : q{} )
1855               . ( $item->{location} ? $item->{location} : q{} )
1856               . ( $item->{itype}    ? $item->{itype}    : q{} )
1857               . ( $item->{itemcallnumber} ? $item->{itemcallnumber} : q{} );
1858 # For each grouping of items (onloan, available, unavailable), we build a key to store relevant info about that item
1859             if ( $item->{onloan}
1860                 and $logged_in_user
1861                 and !( $patron_category_hide_lost_items and $item->{itemlost} ) )
1862             {
1863                 $onloan_count++;
1864                 my $key = $prefix . $item->{onloan} . $item->{barcode};
1865                 $onloan_items->{$key}->{due_date} = $item->{onloan};
1866                 $onloan_items->{$key}->{count}++ if $item->{$hbranch};
1867                 $onloan_items->{$key}->{branchname}     = $item->{branchname};
1868                 $onloan_items->{$key}->{location}       = $shelflocations->{ $item->{location} } if $item->{location};
1869                 $onloan_items->{$key}->{itemcallnumber} = $item->{itemcallnumber};
1870                 $onloan_items->{$key}->{description}    = $item->{description};
1871                 $onloan_items->{$key}->{imageurl} =
1872                   getitemtypeimagelocation( $search_context->{'interface'}, $itemtypes{ $item->{itype} }->{imageurl} );
1873
1874                 # if something's checked out and lost, mark it as 'long overdue'
1875                 if ( $item->{itemlost} ) {
1876                     $onloan_items->{$key}->{longoverdue}++;
1877                     $longoverdue_count++;
1878                 }
1879                 else {    # can place holds as long as item isn't lost
1880                     $can_place_holds = 1;
1881                 }
1882             }
1883
1884          # items not on loan, but still unavailable ( lost, withdrawn, damaged )
1885             else {
1886
1887                 my $itemtype = C4::Context->preference("item-level_itypes")? $item->{itype}: $oldbiblio->{itemtype};
1888                 $item->{notforloan} = 1 if !$item->{notforloan} &&
1889                     $itemtype && $itemtypes{ $itemtype }->{notforloan};
1890
1891                 # item is on order
1892                 if ( $item->{notforloan} < 0 ) {
1893                     $ordered_count++;
1894                 } elsif ( $item->{notforloan} > 0 ) {
1895                     $notforloan_count++;
1896                 }
1897
1898                 # is item in transit?
1899                 my $transfertwhen = '';
1900                 my ($transfertfrom, $transfertto);
1901
1902                 # is item on the reserve shelf?
1903                 my $reservestatus = '';
1904
1905                 unless ($item->{withdrawn}
1906                         || $item->{itemlost}
1907                         || $item->{damaged}
1908                         || $item->{notforloan}
1909                         || ( C4::Context->preference('MaxSearchResultsItemsPerRecordStatusCheck')
1910                         && $items_count > C4::Context->preference('MaxSearchResultsItemsPerRecordStatusCheck') ) ) {
1911
1912                     # A couple heuristics to limit how many times
1913                     # we query the database for item transfer information, sacrificing
1914                     # accuracy in some cases for speed;
1915                     #
1916                     # 1. don't query if item has one of the other statuses
1917                     # 2. don't check transit status if the bib has
1918                     #    more than 20 items
1919                     #
1920                     # FIXME: to avoid having the query the database like this, and to make
1921                     #        the in transit status count as unavailable for search limiting,
1922                     #        should map transit status to record indexed in Zebra.
1923                     #
1924                     ($transfertwhen, $transfertfrom, $transfertto) = C4::Circulation::GetTransfers($item->{itemnumber});
1925                     $reservestatus = C4::Reserves::GetReserveStatus( $item->{itemnumber} );
1926                 }
1927
1928                 # item is withdrawn, lost, damaged, not for loan, reserved or in transit
1929                 if (   $item->{withdrawn}
1930                     || $item->{itemlost}
1931                     || $item->{damaged}
1932                     || $item->{notforloan}
1933                     || $reservestatus eq 'Waiting'
1934                     || ($transfertwhen && $transfertwhen ne ''))
1935                 {
1936                     $withdrawn_count++        if $item->{withdrawn};
1937                     $itemlost_count++        if $item->{itemlost};
1938                     $itemdamaged_count++     if $item->{damaged};
1939                     $item_in_transit_count++ if $transfertwhen && $transfertwhen ne '';
1940                     $item_onhold_count++     if $reservestatus eq 'Waiting';
1941                     $item->{status} = ($item->{withdrawn}//q{}) . "-" . ($item->{itemlost}//q{}) . "-" . ($item->{damaged}//q{}) . "-" . ($item->{notforloan}//q{});
1942
1943                     # can place a hold on a item if
1944                     # not lost nor withdrawn
1945                     # not damaged unless AllowHoldsOnDamagedItems is true
1946                     # item is either for loan or on order (notforloan < 0)
1947                     $can_place_holds = 1
1948                       if (
1949                            !$item->{itemlost}
1950                         && !$item->{withdrawn}
1951                         && ( !$item->{damaged} || C4::Context->preference('AllowHoldsOnDamagedItems') )
1952                         && ( !$item->{notforloan} || $item->{notforloan} < 0 )
1953                       );
1954
1955                     $other_count++;
1956
1957                     my $key = $prefix . $item->{status};
1958                     foreach (qw(withdrawn itemlost damaged branchname itemcallnumber)) {
1959                         $other_items->{$key}->{$_} = $item->{$_};
1960                     }
1961                     $other_items->{$key}->{intransit} = ( $transfertwhen ne '' ) ? 1 : 0;
1962                     $other_items->{$key}->{onhold} = ($reservestatus) ? 1 : 0;
1963                     $other_items->{$key}->{notforloan} = GetAuthorisedValueDesc('','',$item->{notforloan},'','',$notforloan_authorised_value) if $notforloan_authorised_value and $item->{notforloan};
1964                     $other_items->{$key}->{count}++ if $item->{$hbranch};
1965                     $other_items->{$key}->{location} = $shelflocations->{ $item->{location} } if $item->{location};
1966                     $other_items->{$key}->{description} = $item->{description};
1967                     $other_items->{$key}->{imageurl} = getitemtypeimagelocation( $search_context->{'interface'}, $itemtypes{ $item->{itype}//q{} }->{imageurl} );
1968                 }
1969                 # item is available
1970                 else {
1971                     $can_place_holds = 1;
1972                     $available_count++;
1973                     $available_items->{$prefix}->{count}++ if $item->{$hbranch};
1974                     foreach (qw(branchname itemcallnumber description)) {
1975                         $available_items->{$prefix}->{$_} = $item->{$_};
1976                     }
1977                     $available_items->{$prefix}->{location} = $shelflocations->{ $item->{location} } if $item->{location};
1978                     $available_items->{$prefix}->{imageurl} = getitemtypeimagelocation( $search_context->{'interface'}, $itemtypes{ $item->{itype}//q{} }->{imageurl} );
1979                 }
1980             }
1981         }    # notforloan, item level and biblioitem level
1982
1983         # if all items are hidden, do not show the record
1984         if ( C4::Context->preference('OpacHiddenItemsHidesRecord') && $items_count > 0 && $hideatopac_count == $items_count) {
1985             next;
1986         }
1987
1988         my ( $availableitemscount, $onloanitemscount, $otheritemscount );
1989         for my $key ( sort keys %$onloan_items ) {
1990             (++$onloanitemscount > $maxitems) and last;
1991             push @onloan_items_loop, $onloan_items->{$key};
1992         }
1993         for my $key ( sort keys %$other_items ) {
1994             (++$otheritemscount > $maxitems) and last;
1995             push @other_items_loop, $other_items->{$key};
1996         }
1997         for my $key ( sort keys %$available_items ) {
1998             (++$availableitemscount > $maxitems) and last;
1999             push @available_items_loop, $available_items->{$key}
2000         }
2001
2002         # XSLT processing of some stuff
2003         # we fetched the sysprefs already before the loop through all retrieved record!
2004         if (!$scan && $xslfile) {
2005             $record_processor->options({
2006                 frameworkcode => $fw,
2007                 interface     => $search_context->{'interface'}
2008             });
2009
2010             $record_processor->process($marcrecord);
2011             $oldbiblio->{XSLTResultsRecord} = XSLTParse4Display($oldbiblio->{biblionumber}, $marcrecord, $xslsyspref, 1, \@hiddenitems, $sysxml, $xslfile, $lang, $xslt_variables);
2012         }
2013
2014         # if biblio level itypes are used and itemtype is notforloan, it can't be reserved either
2015         if (!C4::Context->preference("item-level_itypes")) {
2016             if ($itemtype && $itemtype->{notforloan}) {
2017                 $can_place_holds = 0;
2018             }
2019         }
2020         $oldbiblio->{norequests} = 1 unless $can_place_holds;
2021         $oldbiblio->{items_count}          = $items_count;
2022         $oldbiblio->{available_items_loop} = \@available_items_loop;
2023         $oldbiblio->{onloan_items_loop}    = \@onloan_items_loop;
2024         $oldbiblio->{other_items_loop}     = \@other_items_loop;
2025         $oldbiblio->{availablecount}       = $available_count;
2026         $oldbiblio->{availableplural}      = 1 if $available_count > 1;
2027         $oldbiblio->{onloancount}          = $onloan_count;
2028         $oldbiblio->{onloanplural}         = 1 if $onloan_count > 1;
2029         $oldbiblio->{othercount}           = $other_count;
2030         $oldbiblio->{otherplural}          = 1 if $other_count > 1;
2031         $oldbiblio->{withdrawncount}        = $withdrawn_count;
2032         $oldbiblio->{itemlostcount}        = $itemlost_count;
2033         $oldbiblio->{damagedcount}         = $itemdamaged_count;
2034         $oldbiblio->{intransitcount}       = $item_in_transit_count;
2035         $oldbiblio->{onholdcount}          = $item_onhold_count;
2036         $oldbiblio->{orderedcount}         = $ordered_count;
2037         $oldbiblio->{notforloancount}      = $notforloan_count;
2038
2039         if (C4::Context->preference("AlternateHoldingsField") && $items_count == 0) {
2040             my $fieldspec = C4::Context->preference("AlternateHoldingsField");
2041             my $subfields = substr $fieldspec, 3;
2042             my $holdingsep = C4::Context->preference("AlternateHoldingsSeparator") || ' ';
2043             my @alternateholdingsinfo = ();
2044             my @holdingsfields = $marcrecord->field(substr $fieldspec, 0, 3);
2045             my $alternateholdingscount = 0;
2046
2047             for my $field (@holdingsfields) {
2048                 my %holding = ( holding => '' );
2049                 my $havesubfield = 0;
2050                 for my $subfield ($field->subfields()) {
2051                     if ((index $subfields, $$subfield[0]) >= 0) {
2052                         $holding{'holding'} .= $holdingsep if (length $holding{'holding'} > 0);
2053                         $holding{'holding'} .= $$subfield[1];
2054                         $havesubfield++;
2055                     }
2056                 }
2057                 if ($havesubfield) {
2058                     push(@alternateholdingsinfo, \%holding);
2059                     $alternateholdingscount++;
2060                 }
2061             }
2062
2063             $oldbiblio->{'ALTERNATEHOLDINGS'} = \@alternateholdingsinfo;
2064             $oldbiblio->{'alternateholdings_count'} = $alternateholdingscount;
2065         }
2066
2067         $oldbiblio->{biblio_object} = Koha::Biblios->find( $oldbiblio->{biblionumber} );
2068
2069         push( @newresults, $oldbiblio );
2070     }
2071
2072     return @newresults;
2073 }
2074
2075 =head2 enabled_staff_search_views
2076
2077 %hash = enabled_staff_search_views()
2078
2079 This function returns a hash that contains three flags obtained from the system
2080 preferences, used to determine whether a particular staff search results view
2081 is enabled.
2082
2083 =over 2
2084
2085 =item C<Output arg:>
2086
2087     * $hash{can_view_MARC} is true only if the MARC view is enabled
2088     * $hash{can_view_ISBD} is true only if the ISBD view is enabled
2089     * $hash{can_view_labeledMARC} is true only if the Labeled MARC view is enabled
2090
2091 =item C<usage in the script:>
2092
2093 =back
2094
2095 $template->param ( C4::Search::enabled_staff_search_views );
2096
2097 =cut
2098
2099 sub enabled_staff_search_views
2100 {
2101         return (
2102                 can_view_MARC                   => C4::Context->preference('viewMARC'),                 # 1 if the staff search allows the MARC view
2103                 can_view_ISBD                   => C4::Context->preference('viewISBD'),                 # 1 if the staff search allows the ISBD view
2104                 can_view_labeledMARC    => C4::Context->preference('viewLabeledMARC'),  # 1 if the staff search allows the Labeled MARC view
2105         );
2106 }
2107
2108 =head2 z3950_search_args
2109
2110 $arrayref = z3950_search_args($matchpoints)
2111
2112 This function returns an array reference that contains the search parameters to be
2113 passed to the Z39.50 search script (z3950_search.pl). The array elements
2114 are hash refs whose keys are name and value, and whose values are the
2115 name of a search parameter, the value of that search parameter and the URL encoded
2116 value of that parameter.
2117
2118 The search parameter names are lccn, isbn, issn, title, author, dewey and subject.
2119
2120 The search parameter values are obtained from the bibliographic record whose
2121 data is in a hash reference in $matchpoints, as returned by Biblio::GetBiblioData().
2122
2123 If $matchpoints is a scalar, it is assumed to be an unnamed query descriptor, e.g.
2124 a general purpose search argument. In this case, the returned array contains only
2125 entry: the key is 'title' and the value is derived from $matchpoints.
2126
2127 If a search parameter value is undefined or empty, it is not included in the returned
2128 array.
2129
2130 The returned array reference may be passed directly to the template parameters.
2131
2132 =over 2
2133
2134 =item C<Output arg:>
2135
2136     * $array containing hash refs as described above
2137
2138 =item C<usage in the script:>
2139
2140 =back
2141
2142 $data = Biblio::GetBiblioData($bibno);
2143 $template->param ( MYLOOP => C4::Search::z3950_search_args($data) )
2144
2145 *OR*
2146
2147 $template->param ( MYLOOP => C4::Search::z3950_search_args($searchscalar) )
2148
2149 =cut
2150
2151 sub z3950_search_args {
2152     my $bibrec = shift;
2153
2154     my $isbn_string = ref( $bibrec ) ? $bibrec->{title} : $bibrec;
2155     my $isbn = Business::ISBN->new( $isbn_string );
2156
2157     if (defined $isbn && $isbn->is_valid)
2158     {
2159         if ( ref($bibrec) ) {
2160             $bibrec->{isbn} = $isbn_string;
2161             $bibrec->{title} = undef;
2162         } else {
2163             $bibrec = { isbn => $isbn_string };
2164         }
2165     }
2166     else {
2167         $bibrec = { title => $bibrec } if !ref $bibrec;
2168     }
2169     my $array = [];
2170     for my $field (qw/ lccn isbn issn title author dewey subject /)
2171     {
2172         push @$array, { name => $field, value => $bibrec->{$field} }
2173           if defined $bibrec->{$field};
2174     }
2175     return $array;
2176 }
2177
2178 =head2 GetDistinctValues($field);
2179
2180 C<$field> is a reference to the fields array
2181
2182 =cut
2183
2184 sub GetDistinctValues {
2185     my ($fieldname,$string)=@_;
2186     # returns a reference to a hash of references to branches...
2187     if ($fieldname=~/\./){
2188                         my ($table,$column)=split /\./, $fieldname;
2189                         my $dbh = C4::Context->dbh;
2190                         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 ");
2191                         $sth->execute;
2192                         my $elements=$sth->fetchall_arrayref({});
2193                         return $elements;
2194    }
2195    else {
2196                 $string||= qq("");
2197                 my @servers=qw<biblioserver authorityserver>;
2198                 my (@zconns,@results);
2199         for ( my $i = 0 ; $i < @servers ; $i++ ) {
2200                 $zconns[$i] = C4::Context->Zconn( $servers[$i], 1 );
2201                         $results[$i] =
2202                       $zconns[$i]->scan(
2203                         ZOOM::Query::CCL2RPN->new( qq"$fieldname $string", $zconns[$i])
2204                       );
2205                 }
2206                 # The big moment: asynchronously retrieve results from all servers
2207                 my @elements;
2208         _ZOOM_event_loop(
2209             \@zconns,
2210             \@results,
2211             sub {
2212                 my ( $i, $size ) = @_;
2213                 for ( my $j = 0 ; $j < $size ; $j++ ) {
2214                     my %hashscan;
2215                     @hashscan{qw(value cnt)} =
2216                       $results[ $i - 1 ]->display_term($j);
2217                     push @elements, \%hashscan;
2218                 }
2219             }
2220         );
2221                 return \@elements;
2222    }
2223 }
2224
2225 =head2 _ZOOM_event_loop
2226
2227     _ZOOM_event_loop(\@zconns, \@results, sub {
2228         my ( $i, $size ) = @_;
2229         ....
2230     } );
2231
2232 Processes a ZOOM event loop and passes control to a closure for
2233 processing the results, and destroying the resultsets.
2234
2235 =cut
2236
2237 sub _ZOOM_event_loop {
2238     my ($zconns, $results, $callback) = @_;
2239     while ( ( my $i = ZOOM::event( $zconns ) ) != 0 ) {
2240         my $ev = $zconns->[ $i - 1 ]->last_event();
2241         if ( $ev == ZOOM::Event::ZEND ) {
2242             next unless $results->[ $i - 1 ];
2243             my $size = $results->[ $i - 1 ]->size();
2244             if ( $size > 0 ) {
2245                 $callback->($i, $size);
2246             }
2247         }
2248     }
2249
2250     foreach my $result (@$results) {
2251         $result->destroy();
2252     }
2253 }
2254
2255 =head2 new_record_from_zebra
2256
2257 Given raw data from a searchengine result set, return a MARC::Record object
2258
2259 This helper function is needed to take into account all the involved
2260 system preferences and configuration variables to properly create the
2261 MARC::Record object.
2262
2263 If we are using GRS-1, then the raw data we get from Zebra should be USMARC
2264 data. If we are using DOM, then it has to be MARCXML.
2265
2266 If we are using elasticsearch, it'll already be a MARC::Record and this
2267 function needs a new name.
2268
2269 =cut
2270
2271 sub new_record_from_zebra {
2272
2273     my $server   = shift;
2274     my $raw_data = shift;
2275     # Set the default indexing modes
2276     my $search_engine = C4::Context->preference("SearchEngine");
2277     if ($search_engine eq 'Elasticsearch') {
2278         return ref $raw_data eq 'MARC::Record' ? $raw_data : MARC::Record->new_from_xml( $raw_data, 'UTF-8' );
2279     }
2280     my $index_mode = ( $server eq 'biblioserver' )
2281                         ? C4::Context->config('zebra_bib_index_mode') // 'dom'
2282                         : C4::Context->config('zebra_auth_index_mode') // 'dom';
2283
2284     my $marc_record =  eval {
2285         if ( $index_mode eq 'dom' ) {
2286             MARC::Record->new_from_xml( $raw_data, 'UTF-8' );
2287         } else {
2288             MARC::Record->new_from_usmarc( $raw_data );
2289         }
2290     };
2291
2292     if ($@) {
2293         return;
2294     } else {
2295         return $marc_record;
2296     }
2297
2298 }
2299
2300 END { }    # module clean-up code here (global destructor)
2301
2302 1;
2303 __END__
2304
2305 =head1 AUTHOR
2306
2307 Koha Development Team <http://koha-community.org/>
2308
2309 =cut