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