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