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