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