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