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