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