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