C4/Search.pm

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