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
1184     if ($QParser)
1185     {
1186         $query = '';
1187         for ( my $ii = 0 ; $ii <= @operands ; $ii++ ) {
1188             next unless $operands[$ii];
1189             $query .= $operators[ $ii - 1 ] eq 'or' ? ' || ' : ' && '
1190               if ($query);
1191             $query .=
1192               ( $indexes[$ii] ? "$indexes[$ii]:" : '' ) . $operands[$ii];
1193         }
1194         foreach my $limit (@limits) {
1195         }
1196         foreach my $modifier (@sort_by) {
1197             $query .= " #$modifier";
1198         }
1199
1200         $query_desc = $query;
1201         if ( C4::Context->preference("QueryWeightFields") ) {
1202         }
1203         $QParser->add_bib1_filter_map( 'biblioserver', 'su-br', { 'callback' => \&_handle_exploding_index });
1204         $QParser->add_bib1_filter_map( 'biblioserver', 'su-na', { 'callback' => \&_handle_exploding_index });
1205         $QParser->add_bib1_filter_map( 'biblioserver', 'su-rl', { 'callback' => \&_handle_exploding_index });
1206         $QParser->parse( $query );
1207         $operands[0] = "pqf=" . $QParser->target_syntax('biblioserver');
1208 # TODO: once we are using QueryParser, all this special case code for
1209 #       exploded search indexes will be replaced by a callback to
1210 #       _handle_exploding_index
1211     }
1212
1213     return ( $operators, \@operands, $indexes, $limits, $sort_by, $scan, $lang, $query_desc);
1214 }
1215
1216 =head2 buildQuery
1217
1218 ( $error, $query,
1219 $simple_query, $query_cgi,
1220 $query_desc, $limit,
1221 $limit_cgi, $limit_desc,
1222 $stopwords_removed, $query_type ) = buildQuery ( $operators, $operands, $indexes, $limits, $sort_by, $scan, $lang);
1223
1224 Build queries and limits in CCL, CGI, Human,
1225 handle truncation, stemming, field weighting, stopwords, fuzziness, etc.
1226
1227 See verbose embedded documentation.
1228
1229
1230 =cut
1231
1232 sub buildQuery {
1233     my ( $operators, $operands, $indexes, $limits, $sort_by, $scan, $lang) = @_;
1234
1235     warn "---------\nEnter buildQuery\n---------" if $DEBUG;
1236
1237     my $query_desc;
1238     ( $operators, $operands, $indexes, $limits, $sort_by, $scan, $lang, $query_desc) = parseQuery($operators, $operands, $indexes, $limits, $sort_by, $scan, $lang);
1239
1240     # dereference
1241     my @operators = $operators ? @$operators : ();
1242     my @indexes   = $indexes   ? @$indexes   : ();
1243     my @operands  = $operands  ? @$operands  : ();
1244     my @limits    = $limits    ? @$limits    : ();
1245     my @sort_by   = $sort_by   ? @$sort_by   : ();
1246
1247     my $stemming         = C4::Context->preference("QueryStemming")        || 0;
1248     my $auto_truncation  = C4::Context->preference("QueryAutoTruncate")    || 0;
1249     my $weight_fields    = C4::Context->preference("QueryWeightFields")    || 0;
1250     my $fuzzy_enabled    = C4::Context->preference("QueryFuzzy")           || 0;
1251     my $remove_stopwords = C4::Context->preference("QueryRemoveStopwords") || 0;
1252
1253     # no stemming/weight/fuzzy in NoZebra
1254     if ( C4::Context->preference("NoZebra") ) {
1255         $stemming         = 0;
1256         $weight_fields    = 0;
1257         $fuzzy_enabled    = 0;
1258         $auto_truncation  = 0;
1259     }
1260
1261     my $query        = $operands[0];
1262     my $simple_query = $operands[0];
1263
1264     # initialize the variables we're passing back
1265     my $query_cgi;
1266     my $query_type;
1267
1268     my $limit;
1269     my $limit_cgi;
1270     my $limit_desc;
1271
1272     my $stopwords_removed;    # flag to determine if stopwords have been removed
1273
1274     my $cclq       = 0;
1275     my $cclindexes = getIndexes();
1276     if ( $query !~ /\s*ccl=/ ) {
1277         while ( !$cclq && $query =~ /(?:^|\W)([\w-]+)(,[\w-]+)*[:=]/g ) {
1278             my $dx = lc($1);
1279             $cclq = grep { lc($_) eq $dx } @$cclindexes;
1280         }
1281         $query = "ccl=$query" if $cclq;
1282     }
1283
1284 # for handling ccl, cql, pqf queries in diagnostic mode, skip the rest of the steps
1285 # DIAGNOSTIC ONLY!!
1286     if ( $query =~ /^ccl=/ ) {
1287         my $q=$';
1288         # This is needed otherwise ccl= and &limit won't work together, and
1289         # this happens when selecting a subject on the opac-detail page
1290         @limits = grep {!/^$/} @limits;
1291         if ( @limits ) {
1292             $q .= ' and '.join(' and ', @limits);
1293         }
1294         return ( undef, $q, $q, "q=ccl=$q", $q, '', '', '', '', 'ccl' );
1295     }
1296     if ( $query =~ /^cql=/ ) {
1297         return ( undef, $', $', "q=cql=$'", $', '', '', '', '', 'cql' );
1298     }
1299     if ( $query =~ /^pqf=/ ) {
1300         if ($query_desc) {
1301             $query_cgi = "q=$query_desc";
1302         } else {
1303             $query_desc = $';
1304             $query_cgi = "q=pqf=$'";
1305         }
1306         return ( undef, $', $', $query_cgi, $query_desc, '', '', '', '', 'pqf' );
1307     }
1308
1309     # pass nested queries directly
1310     # FIXME: need better handling of some of these variables in this case
1311     # Nested queries aren't handled well and this implementation is flawed and causes users to be
1312     # unable to search for anything containing () commenting out, will be rewritten for 3.4.0
1313 #    if ( $query =~ /(\(|\))/ ) {
1314 #        return (
1315 #            undef,              $query, $simple_query, $query_cgi,
1316 #            $query,             $limit, $limit_cgi,    $limit_desc,
1317 #            $stopwords_removed, 'ccl'
1318 #        );
1319 #    }
1320
1321 # Form-based queries are non-nested and fixed depth, so we can easily modify the incoming
1322 # query operands and indexes and add stemming, truncation, field weighting, etc.
1323 # Once we do so, we'll end up with a value in $query, just like if we had an
1324 # incoming $query from the user
1325     else {
1326         $query = ""
1327           ; # clear it out so we can populate properly with field-weighted, stemmed, etc. query
1328         my $previous_operand
1329           ;    # a flag used to keep track if there was a previous query
1330                # if there was, we can apply the current operator
1331                # for every operand
1332         for ( my $i = 0 ; $i <= @operands ; $i++ ) {
1333
1334             # COMBINE OPERANDS, INDEXES AND OPERATORS
1335             if ( $operands[$i] ) {
1336                 $operands[$i]=~s/^\s+//;
1337
1338               # A flag to determine whether or not to add the index to the query
1339                 my $indexes_set;
1340
1341 # If the user is sophisticated enough to specify an index, turn off field weighting, stemming, and stopword handling
1342                 if ( $operands[$i] =~ /\w(:|=)/ || $scan ) {
1343                     $weight_fields    = 0;
1344                     $stemming         = 0;
1345                     $remove_stopwords = 0;
1346                 } else {
1347                     $operands[$i] =~ s/\?/{?}/g; # need to escape question marks
1348                 }
1349                 my $operand = $operands[$i];
1350                 my $index   = $indexes[$i];
1351
1352                 # Add index-specific attributes
1353                 # Date of Publication
1354                 if ( $index eq 'yr' ) {
1355                     $index .= ",st-numeric";
1356                     $indexes_set++;
1357                                         $stemming = $auto_truncation = $weight_fields = $fuzzy_enabled = $remove_stopwords = 0;
1358                 }
1359
1360                 # Date of Acquisition
1361                 elsif ( $index eq 'acqdate' ) {
1362                     $index .= ",st-date-normalized";
1363                     $indexes_set++;
1364                                         $stemming = $auto_truncation = $weight_fields = $fuzzy_enabled = $remove_stopwords = 0;
1365                 }
1366                 # ISBN,ISSN,Standard Number, don't need special treatment
1367                 elsif ( $index eq 'nb' || $index eq 'ns' ) {
1368                     (
1369                         $stemming,      $auto_truncation,
1370                         $weight_fields, $fuzzy_enabled,
1371                         $remove_stopwords
1372                     ) = ( 0, 0, 0, 0, 0 );
1373
1374                 }
1375
1376                 if(not $index){
1377                     $index = 'kw';
1378                 }
1379
1380                 # Set default structure attribute (word list)
1381                 my $struct_attr = q{};
1382                 unless ( $indexes_set || !$index || $index =~ /(st-|phr|ext|wrdl|nb|ns)/ ) {
1383                     $struct_attr = ",wrdl";
1384                 }
1385
1386                 # Some helpful index variants
1387                 my $index_plus       = $index . $struct_attr . ':';
1388                 my $index_plus_comma = $index . $struct_attr . ',';
1389
1390                 # Remove Stopwords
1391                 if ($remove_stopwords) {
1392                     ( $operand, $stopwords_removed ) =
1393                       _remove_stopwords( $operand, $index );
1394                     warn "OPERAND w/out STOPWORDS: >$operand<" if $DEBUG;
1395                     warn "REMOVED STOPWORDS: @$stopwords_removed"
1396                       if ( $stopwords_removed && $DEBUG );
1397                 }
1398
1399                 if ($auto_truncation){
1400                                         unless ( $index =~ /(st-|phr|ext)/ ) {
1401                                                 #FIXME only valid with LTR scripts
1402                                                 $operand=join(" ",map{
1403                                                                                         (index($_,"*")>0?"$_":"$_*")
1404                                                                                          }split (/\s+/,$operand));
1405                                                 warn $operand if $DEBUG;
1406                                         }
1407                                 }
1408
1409                 # Detect Truncation
1410                 my $truncated_operand;
1411                 my( $nontruncated, $righttruncated, $lefttruncated,
1412                     $rightlefttruncated, $regexpr
1413                 ) = _detect_truncation( $operand, $index );
1414                 warn
1415 "TRUNCATION: NON:>@$nontruncated< RIGHT:>@$righttruncated< LEFT:>@$lefttruncated< RIGHTLEFT:>@$rightlefttruncated< REGEX:>@$regexpr<"
1416                   if $DEBUG;
1417
1418                 # Apply Truncation
1419                 if (
1420                     scalar(@$righttruncated) + scalar(@$lefttruncated) +
1421                     scalar(@$rightlefttruncated) > 0 )
1422                 {
1423
1424                # Don't field weight or add the index to the query, we do it here
1425                     $indexes_set = 1;
1426                     undef $weight_fields;
1427                     my $previous_truncation_operand;
1428                     if (scalar @$nontruncated) {
1429                         $truncated_operand .= "$index_plus @$nontruncated ";
1430                         $previous_truncation_operand = 1;
1431                     }
1432                     if (scalar @$righttruncated) {
1433                         $truncated_operand .= "and " if $previous_truncation_operand;
1434                         $truncated_operand .= $index_plus_comma . "rtrn:@$righttruncated ";
1435                         $previous_truncation_operand = 1;
1436                     }
1437                     if (scalar @$lefttruncated) {
1438                         $truncated_operand .= "and " if $previous_truncation_operand;
1439                         $truncated_operand .= $index_plus_comma . "ltrn:@$lefttruncated ";
1440                         $previous_truncation_operand = 1;
1441                     }
1442                     if (scalar @$rightlefttruncated) {
1443                         $truncated_operand .= "and " if $previous_truncation_operand;
1444                         $truncated_operand .= $index_plus_comma . "rltrn:@$rightlefttruncated ";
1445                         $previous_truncation_operand = 1;
1446                     }
1447                 }
1448                 $operand = $truncated_operand if $truncated_operand;
1449                 warn "TRUNCATED OPERAND: >$truncated_operand<" if $DEBUG;
1450
1451                 # Handle Stemming
1452                 my $stemmed_operand;
1453                 $stemmed_operand = _build_stemmed_operand($operand, $lang)
1454                                                                                 if $stemming;
1455
1456                 warn "STEMMED OPERAND: >$stemmed_operand<" if $DEBUG;
1457
1458                 # Handle Field Weighting
1459                 my $weighted_operand;
1460                 if ($weight_fields) {
1461                     $weighted_operand = _build_weighted_query( $operand, $stemmed_operand, $index );
1462                     $operand = $weighted_operand;
1463                     $indexes_set = 1;
1464                 }
1465
1466                 warn "FIELD WEIGHTED OPERAND: >$weighted_operand<" if $DEBUG;
1467
1468                 # If there's a previous operand, we need to add an operator
1469                 if ($previous_operand) {
1470
1471                     # User-specified operator
1472                     if ( $operators[ $i - 1 ] ) {
1473                         $query     .= " $operators[$i-1] ";
1474                         $query     .= " $index_plus " unless $indexes_set;
1475                         $query     .= " $operand";
1476                         $query_cgi .= "&op=$operators[$i-1]";
1477                         $query_cgi .= "&idx=$index" if $index;
1478                         $query_cgi .= "&q=$operands[$i]" if $operands[$i];
1479                         $query_desc .=
1480                           " $operators[$i-1] $index_plus $operands[$i]";
1481                     }
1482
1483                     # Default operator is and
1484                     else {
1485                         $query      .= " and ";
1486                         $query      .= "$index_plus " unless $indexes_set;
1487                         $query      .= "$operand";
1488                         $query_cgi  .= "&op=and&idx=$index" if $index;
1489                         $query_cgi  .= "&q=$operands[$i]" if $operands[$i];
1490                         $query_desc .= " and $index_plus $operands[$i]";
1491                     }
1492                 }
1493
1494                 # There isn't a pervious operand, don't need an operator
1495                 else {
1496
1497                     # Field-weighted queries already have indexes set
1498                     $query .= " $index_plus " unless $indexes_set;
1499                     $query .= $operand;
1500                     $query_desc .= " $index_plus $operands[$i]";
1501                     $query_cgi  .= "&idx=$index" if $index;
1502                     $query_cgi  .= "&q=$operands[$i]" if $operands[$i];
1503                     $previous_operand = 1;
1504                 }
1505             }    #/if $operands
1506         }    # /for
1507     }
1508     warn "QUERY BEFORE LIMITS: >$query<" if $DEBUG;
1509
1510     # add limits
1511     my %group_OR_limits;
1512     my $availability_limit;
1513     foreach my $this_limit (@limits) {
1514         next unless $this_limit;
1515         if ( $this_limit =~ /available/ ) {
1516 #
1517 ## 'available' is defined as (items.onloan is NULL) and (items.itemlost = 0)
1518 ## In English:
1519 ## all records not indexed in the onloan register (zebra) and all records with a value of lost equal to 0
1520             $availability_limit .=
1521 "( ( allrecords,AlwaysMatches='' not onloan,AlwaysMatches='') and (lost,st-numeric=0) )"; #or ( allrecords,AlwaysMatches='' not lost,AlwaysMatches='')) )";
1522             $limit_cgi  .= "&limit=available";
1523             $limit_desc .= "";
1524         }
1525
1526         # group_OR_limits, prefixed by mc-
1527         # OR every member of the group
1528         elsif ( $this_limit =~ /mc/ ) {
1529             my ($k,$v) = split(/:/, $this_limit,2);
1530             if ( $k !~ /mc-i(tem)?type/ ) {
1531                 # in case the mc-ccode value has complicating chars like ()'s inside it we wrap in quotes
1532                 $this_limit =~ tr/"//d;
1533                 $this_limit = $k.":\"".$v."\"";
1534             }
1535
1536             $group_OR_limits{$k} .= " or " if $group_OR_limits{$k};
1537             $limit_desc      .= " or " if $group_OR_limits{$k};
1538             $group_OR_limits{$k} .= "$this_limit";
1539             $limit_cgi       .= "&limit=$this_limit";
1540             $limit_desc      .= " $this_limit";
1541         }
1542
1543         # Regular old limits
1544         else {
1545             $limit .= " and " if $limit || $query;
1546             $limit      .= "$this_limit";
1547             $limit_cgi  .= "&limit=$this_limit";
1548             if ($this_limit =~ /^branch:(.+)/) {
1549                 my $branchcode = $1;
1550                 my $branchname = GetBranchName($branchcode);
1551                 if (defined $branchname) {
1552                     $limit_desc .= " branch:$branchname";
1553                 } else {
1554                     $limit_desc .= " $this_limit";
1555                 }
1556             } else {
1557                 $limit_desc .= " $this_limit";
1558             }
1559         }
1560     }
1561     foreach my $k (keys (%group_OR_limits)) {
1562         $limit .= " and " if ( $query || $limit );
1563         $limit .= "($group_OR_limits{$k})";
1564     }
1565     if ($availability_limit) {
1566         $limit .= " and " if ( $query || $limit );
1567         $limit .= "($availability_limit)";
1568     }
1569
1570     # Normalize the query and limit strings
1571     # This is flawed , means we can't search anything with : in it
1572     # if user wants to do ccl or cql, start the query with that
1573 #    $query =~ s/:/=/g;
1574     $query =~ s/(?<=(ti|au|pb|su|an|kw|mc|nb|ns)):/=/g;
1575     $query =~ s/(?<=(wrdl)):/=/g;
1576     $query =~ s/(?<=(trn|phr)):/=/g;
1577     $limit =~ s/:/=/g;
1578     for ( $query, $query_desc, $limit, $limit_desc ) {
1579         s/  +/ /g;    # remove extra spaces
1580         s/^ //g;     # remove any beginning spaces
1581         s/ $//g;     # remove any ending spaces
1582         s/==/=/g;    # remove double == from query
1583     }
1584     $query_cgi =~ s/^&//; # remove unnecessary & from beginning of the query cgi
1585
1586     for ($query_cgi,$simple_query) {
1587         s/"//g;
1588     }
1589     # append the limit to the query
1590     $query .= " " . $limit;
1591
1592     # Warnings if DEBUG
1593     if ($DEBUG) {
1594         warn "QUERY:" . $query;
1595         warn "QUERY CGI:" . $query_cgi;
1596         warn "QUERY DESC:" . $query_desc;
1597         warn "LIMIT:" . $limit;
1598         warn "LIMIT CGI:" . $limit_cgi;
1599         warn "LIMIT DESC:" . $limit_desc;
1600         warn "---------\nLeave buildQuery\n---------";
1601     }
1602     return (
1603         undef,              $query, $simple_query, $query_cgi,
1604         $query_desc,        $limit, $limit_cgi,    $limit_desc,
1605         $stopwords_removed, $query_type
1606     );
1607 }
1608
1609 =head2 searchResults
1610
1611   my @search_results = searchResults($search_context, $searchdesc, $hits,
1612                                      $results_per_page, $offset, $scan,
1613                                      @marcresults);
1614
1615 Format results in a form suitable for passing to the template
1616
1617 =cut
1618
1619 # IMO this subroutine is pretty messy still -- it's responsible for
1620 # building the HTML output for the template
1621 sub searchResults {
1622     my ( $search_context, $searchdesc, $hits, $results_per_page, $offset, $scan, $marcresults ) = @_;
1623     my $dbh = C4::Context->dbh;
1624     my @newresults;
1625
1626     require C4::Items;
1627
1628     $search_context = 'opac' if !$search_context || $search_context ne 'intranet';
1629     my ($is_opac, $hidelostitems);
1630     if ($search_context eq 'opac') {
1631         $hidelostitems = C4::Context->preference('hidelostitems');
1632         $is_opac       = 1;
1633     }
1634
1635     #Build branchnames hash
1636     #find branchname
1637     #get branch information.....
1638     my %branches;
1639     my $bsth =$dbh->prepare("SELECT branchcode,branchname FROM branches"); # FIXME : use C4::Branch::GetBranches
1640     $bsth->execute();
1641     while ( my $bdata = $bsth->fetchrow_hashref ) {
1642         $branches{ $bdata->{'branchcode'} } = $bdata->{'branchname'};
1643     }
1644 # FIXME - We build an authorised values hash here, using the default framework
1645 # though it is possible to have different authvals for different fws.
1646
1647     my $shelflocations =GetKohaAuthorisedValues('items.location','');
1648
1649     # get notforloan authorised value list (see $shelflocations  FIXME)
1650     my $notforloan_authorised_value = GetAuthValCode('items.notforloan','');
1651
1652     #Build itemtype hash
1653     #find itemtype & itemtype image
1654     my %itemtypes;
1655     $bsth =
1656       $dbh->prepare(
1657         "SELECT itemtype,description,imageurl,summary,notforloan FROM itemtypes"
1658       );
1659     $bsth->execute();
1660     while ( my $bdata = $bsth->fetchrow_hashref ) {
1661                 foreach (qw(description imageurl summary notforloan)) {
1662                 $itemtypes{ $bdata->{'itemtype'} }->{$_} = $bdata->{$_};
1663                 }
1664     }
1665
1666     #search item field code
1667     my ($itemtag, undef) = &GetMarcFromKohaField( "items.itemnumber", "" );
1668
1669     ## find column names of items related to MARC
1670     my $sth2 = $dbh->prepare("SHOW COLUMNS FROM items");
1671     $sth2->execute;
1672     my %subfieldstosearch;
1673     while ( ( my $column ) = $sth2->fetchrow ) {
1674         my ( $tagfield, $tagsubfield ) =
1675           &GetMarcFromKohaField( "items." . $column, "" );
1676         $subfieldstosearch{$column} = $tagsubfield;
1677     }
1678
1679     # handle which records to actually retrieve
1680     my $times;
1681     if ( $hits && $offset + $results_per_page <= $hits ) {
1682         $times = $offset + $results_per_page;
1683     }
1684     else {
1685         $times = $hits;  # FIXME: if $hits is undefined, why do we want to equal it?
1686     }
1687
1688         my $marcflavour = C4::Context->preference("marcflavour");
1689     # We get the biblionumber position in MARC
1690     my ($bibliotag,$bibliosubf)=GetMarcFromKohaField('biblio.biblionumber','');
1691
1692     # loop through all of the records we've retrieved
1693     for ( my $i = $offset ; $i <= $times - 1 ; $i++ ) {
1694         my $marcrecord = MARC::File::USMARC::decode( $marcresults->[$i] );
1695         my $fw = $scan
1696              ? undef
1697              : $bibliotag < 10
1698                ? GetFrameworkCode($marcrecord->field($bibliotag)->data)
1699                : GetFrameworkCode($marcrecord->subfield($bibliotag,$bibliosubf));
1700         my $oldbiblio = TransformMarcToKoha( $dbh, $marcrecord, $fw );
1701         $oldbiblio->{subtitle} = GetRecordValue('subtitle', $marcrecord, $fw);
1702         $oldbiblio->{result_number} = $i + 1;
1703
1704         # add imageurl to itemtype if there is one
1705         $oldbiblio->{imageurl} = getitemtypeimagelocation( $search_context, $itemtypes{ $oldbiblio->{itemtype} }->{imageurl} );
1706
1707         $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 ) ) : [];
1708                 $oldbiblio->{normalized_upc}  = GetNormalizedUPC(       $marcrecord,$marcflavour);
1709                 $oldbiblio->{normalized_ean}  = GetNormalizedEAN(       $marcrecord,$marcflavour);
1710                 $oldbiblio->{normalized_oclc} = GetNormalizedOCLCNumber($marcrecord,$marcflavour);
1711                 $oldbiblio->{normalized_isbn} = GetNormalizedISBN(undef,$marcrecord,$marcflavour);
1712                 $oldbiblio->{content_identifier_exists} = 1 if ($oldbiblio->{normalized_isbn} or $oldbiblio->{normalized_oclc} or $oldbiblio->{normalized_ean} or $oldbiblio->{normalized_upc});
1713
1714                 # edition information, if any
1715         $oldbiblio->{edition} = $oldbiblio->{editionstatement};
1716                 $oldbiblio->{description} = $itemtypes{ $oldbiblio->{itemtype} }->{description};
1717  # Build summary if there is one (the summary is defined in the itemtypes table)
1718  # FIXME: is this used anywhere, I think it can be commented out? -- JF
1719         if ( $itemtypes{ $oldbiblio->{itemtype} }->{summary} ) {
1720             my $summary = $itemtypes{ $oldbiblio->{itemtype} }->{summary};
1721             my @fields  = $marcrecord->fields();
1722
1723             my $newsummary;
1724             foreach my $line ( "$summary\n" =~ /(.*)\n/g ){
1725                 my $tags = {};
1726                 foreach my $tag ( $line =~ /\[(\d{3}[\w|\d])\]/ ) {
1727                     $tag =~ /(.{3})(.)/;
1728                     if($marcrecord->field($1)){
1729                         my @abc = $marcrecord->field($1)->subfield($2);
1730                         $tags->{$tag} = $#abc + 1 ;
1731                     }
1732                 }
1733
1734                 # We catch how many times to repeat this line
1735                 my $max = 0;
1736                 foreach my $tag (keys(%$tags)){
1737                     $max = $tags->{$tag} if($tags->{$tag} > $max);
1738                  }
1739
1740                 # we replace, and repeat each line
1741                 for (my $i = 0 ; $i < $max ; $i++){
1742                     my $newline = $line;
1743
1744                     foreach my $tag ( $newline =~ /\[(\d{3}[\w|\d])\]/g ) {
1745                         $tag =~ /(.{3})(.)/;
1746
1747                         if($marcrecord->field($1)){
1748                             my @repl = $marcrecord->field($1)->subfield($2);
1749                             my $subfieldvalue = $repl[$i];
1750
1751                             if (! utf8::is_utf8($subfieldvalue)) {
1752                                 utf8::decode($subfieldvalue);
1753                             }
1754
1755                              $newline =~ s/\[$tag\]/$subfieldvalue/g;
1756                         }
1757                     }
1758                     $newsummary .= "$newline\n";
1759                 }
1760             }
1761
1762             $newsummary =~ s/\[(.*?)]//g;
1763             $newsummary =~ s/\n/<br\/>/g;
1764             $oldbiblio->{summary} = $newsummary;
1765         }
1766
1767         # Pull out the items fields
1768         my @fields = $marcrecord->field($itemtag);
1769         my $marcflavor = C4::Context->preference("marcflavour");
1770         # adding linked items that belong to host records
1771         my $analyticsfield = '773';
1772         if ($marcflavor eq 'MARC21' || $marcflavor eq 'NORMARC') {
1773             $analyticsfield = '773';
1774         } elsif ($marcflavor eq 'UNIMARC') {
1775             $analyticsfield = '461';
1776         }
1777         foreach my $hostfield ( $marcrecord->field($analyticsfield)) {
1778             my $hostbiblionumber = $hostfield->subfield("0");
1779             my $linkeditemnumber = $hostfield->subfield("9");
1780             if(!$hostbiblionumber eq undef){
1781                 my $hostbiblio = GetMarcBiblio($hostbiblionumber, 1);
1782                 my ($itemfield, undef) = GetMarcFromKohaField( 'items.itemnumber', GetFrameworkCode($hostbiblionumber) );
1783                 if(!$hostbiblio eq undef){
1784                     my @hostitems = $hostbiblio->field($itemfield);
1785                     foreach my $hostitem (@hostitems){
1786                         if ($hostitem->subfield("9") eq $linkeditemnumber){
1787                             my $linkeditem =$hostitem;
1788                             # append linked items if they exist
1789                             if (!$linkeditem eq undef){
1790                                 push (@fields, $linkeditem);}
1791                         }
1792                     }
1793                 }
1794             }
1795         }
1796
1797         # Setting item statuses for display
1798         my @available_items_loop;
1799         my @onloan_items_loop;
1800         my @other_items_loop;
1801
1802         my $available_items;
1803         my $onloan_items;
1804         my $other_items;
1805
1806         my $ordered_count         = 0;
1807         my $available_count       = 0;
1808         my $onloan_count          = 0;
1809         my $longoverdue_count     = 0;
1810         my $other_count           = 0;
1811         my $wthdrawn_count        = 0;
1812         my $itemlost_count        = 0;
1813         my $hideatopac_count      = 0;
1814         my $itembinding_count     = 0;
1815         my $itemdamaged_count     = 0;
1816         my $item_in_transit_count = 0;
1817         my $can_place_holds       = 0;
1818         my $item_onhold_count     = 0;
1819         my $items_count           = scalar(@fields);
1820         my $maxitems_pref = C4::Context->preference('maxItemsinSearchResults');
1821         my $maxitems = $maxitems_pref ? $maxitems_pref - 1 : 1;
1822         my @hiddenitems; # hidden itemnumbers based on OpacHiddenItems syspref
1823
1824         # loop through every item
1825         foreach my $field (@fields) {
1826             my $item;
1827
1828             # populate the items hash
1829             foreach my $code ( keys %subfieldstosearch ) {
1830                 $item->{$code} = $field->subfield( $subfieldstosearch{$code} );
1831             }
1832             $item->{description} = $itemtypes{ $item->{itype} }{description};
1833
1834                 # OPAC hidden items
1835             if ($is_opac) {
1836                 # hidden because lost
1837                 if ($hidelostitems && $item->{itemlost}) {
1838                     $hideatopac_count++;
1839                     next;
1840                 }
1841                 # hidden based on OpacHiddenItems syspref
1842                 my @hi = C4::Items::GetHiddenItemnumbers($item);
1843                 if (scalar @hi) {
1844                     push @hiddenitems, @hi;
1845                     $hideatopac_count++;
1846                     next;
1847                 }
1848             }
1849
1850             my $hbranch     = C4::Context->preference('HomeOrHoldingBranch') eq 'homebranch' ? 'homebranch'    : 'holdingbranch';
1851             my $otherbranch = C4::Context->preference('HomeOrHoldingBranch') eq 'homebranch' ? 'holdingbranch' : 'homebranch';
1852
1853             # set item's branch name, use HomeOrHoldingBranch syspref first, fall back to the other one
1854             if ($item->{$hbranch}) {
1855                 $item->{'branchname'} = $branches{$item->{$hbranch}};
1856             }
1857             elsif ($item->{$otherbranch}) {     # Last resort
1858                 $item->{'branchname'} = $branches{$item->{$otherbranch}};
1859             }
1860
1861                         my $prefix = $item->{$hbranch} . '--' . $item->{location} . $item->{itype} . $item->{itemcallnumber};
1862 # For each grouping of items (onloan, available, unavailable), we build a key to store relevant info about that item
1863             my $userenv = C4::Context->userenv;
1864             if ( $item->{onloan} && !(C4::Members::GetHideLostItemsPreference($userenv->{'number'}) && $item->{itemlost}) ) {
1865                 $onloan_count++;
1866                                 my $key = $prefix . $item->{onloan} . $item->{barcode};
1867                                 $onloan_items->{$key}->{due_date} = format_date($item->{onloan});
1868                                 $onloan_items->{$key}->{count}++ if $item->{$hbranch};
1869                                 $onloan_items->{$key}->{branchname} = $item->{branchname};
1870                                 $onloan_items->{$key}->{location} = $shelflocations->{ $item->{location} };
1871                                 $onloan_items->{$key}->{itemcallnumber} = $item->{itemcallnumber};
1872                                 $onloan_items->{$key}->{description} = $item->{description};
1873                                 $onloan_items->{$key}->{imageurl} = getitemtypeimagelocation( $search_context, $itemtypes{ $item->{itype} }->{imageurl} );
1874                 # if something's checked out and lost, mark it as 'long overdue'
1875                 if ( $item->{itemlost} ) {
1876                     $onloan_items->{$prefix}->{longoverdue}++;
1877                     $longoverdue_count++;
1878                 } else {        # can place holds as long as item isn't lost
1879                     $can_place_holds = 1;
1880                 }
1881             }
1882
1883          # items not on loan, but still unavailable ( lost, withdrawn, damaged )
1884             else {
1885
1886                 # item is on order
1887                 if ( $item->{notforloan} < 0 ) {
1888                     $ordered_count++;
1889                 }
1890
1891                 # is item in transit?
1892                 my $transfertwhen = '';
1893                 my ($transfertfrom, $transfertto);
1894
1895                 # is item on the reserve shelf?
1896                 my $reservestatus = '';
1897
1898                 unless ($item->{wthdrawn}
1899                         || $item->{itemlost}
1900                         || $item->{damaged}
1901                         || $item->{notforloan}
1902                         || $items_count > 20) {
1903
1904                     # A couple heuristics to limit how many times
1905                     # we query the database for item transfer information, sacrificing
1906                     # accuracy in some cases for speed;
1907                     #
1908                     # 1. don't query if item has one of the other statuses
1909                     # 2. don't check transit status if the bib has
1910                     #    more than 20 items
1911                     #
1912                     # FIXME: to avoid having the query the database like this, and to make
1913                     #        the in transit status count as unavailable for search limiting,
1914                     #        should map transit status to record indexed in Zebra.
1915                     #
1916                     ($transfertwhen, $transfertfrom, $transfertto) = C4::Circulation::GetTransfers($item->{itemnumber});
1917                     $reservestatus = C4::Reserves::GetReserveStatus( $item->{itemnumber}, $oldbiblio->{biblionumber} );
1918                 }
1919
1920                 # item is withdrawn, lost, damaged, not for loan, reserved or in transit
1921                 if (   $item->{wthdrawn}
1922                     || $item->{itemlost}
1923                     || $item->{damaged}
1924                     || $item->{notforloan}
1925                     || $reservestatus eq 'Waiting'
1926                     || ($transfertwhen ne ''))
1927                 {
1928                     $wthdrawn_count++        if $item->{wthdrawn};
1929                     $itemlost_count++        if $item->{itemlost};
1930                     $itemdamaged_count++     if $item->{damaged};
1931                     $item_in_transit_count++ if $transfertwhen ne '';
1932                     $item_onhold_count++     if $reservestatus eq 'Waiting';
1933                     $item->{status} = $item->{wthdrawn} . "-" . $item->{itemlost} . "-" . $item->{damaged} . "-" . $item->{notforloan};
1934
1935                     # can place hold on item ?
1936                     if ( !$item->{itemlost} ) {
1937                         if ( !$item->{wthdrawn} ){
1938                             if ( $item->{damaged} ){
1939                                 if ( C4::Context->preference('AllowHoldsOnDamagedItems') ){
1940                                     # can place a hold on a damaged item if AllowHoldsOnDamagedItems is true
1941                                     if ( ( !$item->{notforloan} || $item->{notforloan} < 0 ) ){
1942                                         # item is either for loan or has notforloan < 0
1943                                         $can_place_holds = 1;
1944                                     }
1945                                 }
1946                             } elsif ( $item->{notforloan} < 0 ) {
1947                                 # item is not damaged and notforloan is < 0
1948                                 $can_place_holds = 1;
1949                             }
1950                         }
1951                     }
1952
1953                     $other_count++;
1954
1955                     my $key = $prefix . $item->{status};
1956                     foreach (qw(wthdrawn itemlost damaged branchname itemcallnumber)) {
1957                         $other_items->{$key}->{$_} = $item->{$_};
1958                     }
1959                     $other_items->{$key}->{intransit} = ( $transfertwhen ne '' ) ? 1 : 0;
1960                     $other_items->{$key}->{onhold} = ($reservestatus) ? 1 : 0;
1961                     $other_items->{$key}->{notforloan} = GetAuthorisedValueDesc('','',$item->{notforloan},'','',$notforloan_authorised_value) if $notforloan_authorised_value and $item->{notforloan};
1962                                         $other_items->{$key}->{count}++ if $item->{$hbranch};
1963                                         $other_items->{$key}->{location} = $shelflocations->{ $item->{location} };
1964                                         $other_items->{$key}->{description} = $item->{description};
1965                                         $other_items->{$key}->{imageurl} = getitemtypeimagelocation( $search_context, $itemtypes{ $item->{itype} }->{imageurl} );
1966                 }
1967                 # item is available
1968                 else {
1969                     $can_place_holds = 1;
1970                     $available_count++;
1971                                         $available_items->{$prefix}->{count}++ if $item->{$hbranch};
1972                                         foreach (qw(branchname itemcallnumber description)) {
1973                         $available_items->{$prefix}->{$_} = $item->{$_};
1974                                         }
1975                                         $available_items->{$prefix}->{location} = $shelflocations->{ $item->{location} };
1976                                         $available_items->{$prefix}->{imageurl} = getitemtypeimagelocation( $search_context, $itemtypes{ $item->{itype} }->{imageurl} );
1977                 }
1978             }
1979         }    # notforloan, item level and biblioitem level
1980
1981         # if all items are hidden, do not show the record
1982         if ($items_count > 0 && $hideatopac_count == $items_count) {
1983             next;
1984         }
1985
1986         my ( $availableitemscount, $onloanitemscount, $otheritemscount );
1987         for my $key ( sort keys %$onloan_items ) {
1988             (++$onloanitemscount > $maxitems) and last;
1989             push @onloan_items_loop, $onloan_items->{$key};
1990         }
1991         for my $key ( sort keys %$other_items ) {
1992             (++$otheritemscount > $maxitems) and last;
1993             push @other_items_loop, $other_items->{$key};
1994         }
1995         for my $key ( sort keys %$available_items ) {
1996             (++$availableitemscount > $maxitems) and last;
1997             push @available_items_loop, $available_items->{$key}
1998         }
1999
2000         # XSLT processing of some stuff
2001         use C4::Charset;
2002         SetUTF8Flag($marcrecord);
2003         warn $marcrecord->as_formatted if $DEBUG;
2004         my $interface = $search_context eq 'opac' ? 'OPAC' : '';
2005         if (!$scan && C4::Context->preference($interface . "XSLTResultsDisplay")) {
2006             $oldbiblio->{XSLTResultsRecord} = XSLTParse4Display($oldbiblio->{biblionumber}, $marcrecord, $interface."XSLTResultsDisplay", 1, \@hiddenitems);
2007             # the last parameter tells Koha to clean up the problematic ampersand entities that Zebra outputs
2008         }
2009
2010         # if biblio level itypes are used and itemtype is notforloan, it can't be reserved either
2011         if (!C4::Context->preference("item-level_itypes")) {
2012             if ($itemtypes{ $oldbiblio->{itemtype} }->{notforloan}) {
2013                 $can_place_holds = 0;
2014             }
2015         }
2016         $oldbiblio->{norequests} = 1 unless $can_place_holds;
2017         $oldbiblio->{itemsplural}          = 1 if $items_count > 1;
2018         $oldbiblio->{items_count}          = $items_count;
2019         $oldbiblio->{available_items_loop} = \@available_items_loop;
2020         $oldbiblio->{onloan_items_loop}    = \@onloan_items_loop;
2021         $oldbiblio->{other_items_loop}     = \@other_items_loop;
2022         $oldbiblio->{availablecount}       = $available_count;
2023         $oldbiblio->{availableplural}      = 1 if $available_count > 1;
2024         $oldbiblio->{onloancount}          = $onloan_count;
2025         $oldbiblio->{onloanplural}         = 1 if $onloan_count > 1;
2026         $oldbiblio->{othercount}           = $other_count;
2027         $oldbiblio->{otherplural}          = 1 if $other_count > 1;
2028         $oldbiblio->{wthdrawncount}        = $wthdrawn_count;
2029         $oldbiblio->{itemlostcount}        = $itemlost_count;
2030         $oldbiblio->{damagedcount}         = $itemdamaged_count;
2031         $oldbiblio->{intransitcount}       = $item_in_transit_count;
2032         $oldbiblio->{onholdcount}          = $item_onhold_count;
2033         $oldbiblio->{orderedcount}         = $ordered_count;
2034
2035         if (C4::Context->preference("AlternateHoldingsField") && $items_count == 0) {
2036             my $fieldspec = C4::Context->preference("AlternateHoldingsField");
2037             my $subfields = substr $fieldspec, 3;
2038             my $holdingsep = C4::Context->preference("AlternateHoldingsSeparator") || ' ';
2039             my @alternateholdingsinfo = ();
2040             my @holdingsfields = $marcrecord->field(substr $fieldspec, 0, 3);
2041             my $alternateholdingscount = 0;
2042
2043             for my $field (@holdingsfields) {
2044                 my %holding = ( holding => '' );
2045                 my $havesubfield = 0;
2046                 for my $subfield ($field->subfields()) {
2047                     if ((index $subfields, $$subfield[0]) >= 0) {
2048                         $holding{'holding'} .= $holdingsep if (length $holding{'holding'} > 0);
2049                         $holding{'holding'} .= $$subfield[1];
2050                         $havesubfield++;
2051                     }
2052                 }
2053                 if ($havesubfield) {
2054                     push(@alternateholdingsinfo, \%holding);
2055                     $alternateholdingscount++;
2056                 }
2057             }
2058
2059             $oldbiblio->{'ALTERNATEHOLDINGS'} = \@alternateholdingsinfo;
2060             $oldbiblio->{'alternateholdings_count'} = $alternateholdingscount;
2061         }
2062
2063         push( @newresults, $oldbiblio );
2064     }
2065
2066     return @newresults;
2067 }
2068
2069 =head2 SearchAcquisitions
2070     Search for acquisitions
2071 =cut
2072
2073 sub SearchAcquisitions{
2074     my ($datebegin, $dateend, $itemtypes,$criteria, $orderby) = @_;
2075
2076     my $dbh=C4::Context->dbh;
2077     # Variable initialization
2078     my $str=qq|
2079     SELECT marcxml
2080     FROM biblio
2081     LEFT JOIN biblioitems ON biblioitems.biblionumber=biblio.biblionumber
2082     LEFT JOIN items ON items.biblionumber=biblio.biblionumber
2083     WHERE dateaccessioned BETWEEN ? AND ?
2084     |;
2085
2086     my (@params,@loopcriteria);
2087
2088     push @params, $datebegin->output("iso");
2089     push @params, $dateend->output("iso");
2090
2091     if (scalar(@$itemtypes)>0 and $criteria ne "itemtype" ){
2092         if(C4::Context->preference("item-level_itypes")){
2093             $str .= "AND items.itype IN (?".( ',?' x scalar @$itemtypes - 1 ).") ";
2094         }else{
2095             $str .= "AND biblioitems.itemtype IN (?".( ',?' x scalar @$itemtypes - 1 ).") ";
2096         }
2097         push @params, @$itemtypes;
2098     }
2099
2100     if ($criteria =~/itemtype/){
2101         if(C4::Context->preference("item-level_itypes")){
2102             $str .= "AND items.itype=? ";
2103         }else{
2104             $str .= "AND biblioitems.itemtype=? ";
2105         }
2106
2107         if(scalar(@$itemtypes) == 0){
2108             my $itypes = GetItemTypes();
2109             for my $key (keys %$itypes){
2110                 push @$itemtypes, $key;
2111             }
2112         }
2113
2114         @loopcriteria= @$itemtypes;
2115     }elsif ($criteria=~/itemcallnumber/){
2116         $str .= "AND (items.itemcallnumber LIKE CONCAT(?,'%')
2117                  OR items.itemcallnumber is NULL
2118                  OR items.itemcallnumber = '')";
2119
2120         @loopcriteria = ("AA".."ZZ", "") unless (scalar(@loopcriteria)>0);
2121     }else {
2122         $str .= "AND biblio.title LIKE CONCAT(?,'%') ";
2123         @loopcriteria = ("A".."z") unless (scalar(@loopcriteria)>0);
2124     }
2125
2126     if ($orderby =~ /date_desc/){
2127         $str.=" ORDER BY dateaccessioned DESC";
2128     } else {
2129         $str.=" ORDER BY title";
2130     }
2131
2132     my $qdataacquisitions=$dbh->prepare($str);
2133
2134     my @loopacquisitions;
2135     foreach my $value(@loopcriteria){
2136         push @params,$value;
2137         my %cell;
2138         $cell{"title"}=$value;
2139         $cell{"titlecode"}=$value;
2140
2141         eval{$qdataacquisitions->execute(@params);};
2142
2143         if ($@){ warn "recentacquisitions Error :$@";}
2144         else {
2145             my @loopdata;
2146             while (my $data=$qdataacquisitions->fetchrow_hashref){
2147                 push @loopdata, {"summary"=>GetBiblioSummary( $data->{'marcxml'} ) };
2148             }
2149             $cell{"loopdata"}=\@loopdata;
2150         }
2151         push @loopacquisitions,\%cell if (scalar(@{$cell{loopdata}})>0);
2152         pop @params;
2153     }
2154     $qdataacquisitions->finish;
2155     return \@loopacquisitions;
2156 }
2157 #----------------------------------------------------------------------
2158 #
2159 # Non-Zebra GetRecords#
2160 #----------------------------------------------------------------------
2161
2162 =head2 NZgetRecords
2163
2164   NZgetRecords has the same API as zera getRecords, even if some parameters are not managed
2165
2166 =cut
2167
2168 sub NZgetRecords {
2169     my (
2170         $query,            $simple_query, $sort_by_ref,    $servers_ref,
2171         $results_per_page, $offset,       $expanded_facet, $branches,
2172         $query_type,       $scan
2173     ) = @_;
2174     warn "query =$query" if $DEBUG;
2175     my $result = NZanalyse($query);
2176     warn "results =$result" if $DEBUG;
2177     return ( undef,
2178         NZorder( $result, @$sort_by_ref[0], $results_per_page, $offset ),
2179         undef );
2180 }
2181
2182 =head2 NZanalyse
2183
2184   NZanalyse : get a CQL string as parameter, and returns a list of biblionumber;title,biblionumber;title,...
2185   the list is built from an inverted index in the nozebra SQL table
2186   note that title is here only for convenience : the sorting will be very fast when requested on title
2187   if the sorting is requested on something else, we will have to reread all results, and that may be longer.
2188
2189 =cut
2190
2191 sub NZanalyse {
2192     my ( $string, $server ) = @_;
2193 #     warn "---------"       if $DEBUG;
2194     warn " NZanalyse" if $DEBUG;
2195 #     warn "---------"       if $DEBUG;
2196
2197  # $server contains biblioserver or authorities, depending on what we search on.
2198  #warn "querying : $string on $server";
2199     $server = 'biblioserver' unless $server;
2200
2201 # if we have a ", replace the content to discard temporarily any and/or/not inside
2202     my $commacontent;
2203     if ( $string =~ /"/ ) {
2204         $string =~ s/"(.*?)"/__X__/;
2205         $commacontent = $1;
2206         warn "commacontent : $commacontent" if $DEBUG;
2207     }
2208
2209 # split the query string in 3 parts : X AND Y means : $left="X", $operand="AND" and $right="Y"
2210 # then, call again NZanalyse with $left and $right
2211 # (recursive until we find a leaf (=> something without and/or/not)
2212 # delete repeated operator... Would then go in infinite loop
2213     while ( $string =~ s/( and| or| not| AND| OR| NOT)\1/$1/g ) {
2214     }
2215
2216     #process parenthesis before.
2217     if ( $string =~ /^\s*\((.*)\)(( and | or | not | AND | OR | NOT )(.*))?/ ) {
2218         my $left     = $1;
2219         my $right    = $4;
2220         my $operator = lc($3);   # FIXME: and/or/not are operators, not operands
2221         warn
2222 "dealing w/parenthesis before recursive sub call. left :$left operator:$operator right:$right"
2223           if $DEBUG;
2224         my $leftresult = NZanalyse( $left, $server );
2225         if ($operator) {
2226             my $rightresult = NZanalyse( $right, $server );
2227
2228             # OK, we have the results for right and left part of the query
2229             # depending of operand, intersect, union or exclude both lists
2230             # to get a result list
2231             if ( $operator eq ' and ' ) {
2232                 return NZoperatorAND($leftresult,$rightresult);
2233             }
2234             elsif ( $operator eq ' or ' ) {
2235
2236                 # just merge the 2 strings
2237                 return $leftresult . $rightresult;
2238             }
2239             elsif ( $operator eq ' not ' ) {
2240                 return NZoperatorNOT($leftresult,$rightresult);
2241             }
2242         }
2243         else {
2244 # this error is impossible, because of the regexp that isolate the operand, but just in case...
2245             return $leftresult;
2246         }
2247     }
2248     warn "string :" . $string if $DEBUG;
2249     my $left = "";
2250     my $right = "";
2251     my $operator = "";
2252     if ($string =~ /(.*?)( and | or | not | AND | OR | NOT )(.*)/) {
2253         $left     = $1;
2254         $right    = $3;
2255         $operator = lc($2);    # FIXME: and/or/not are operators, not operands
2256     }
2257     warn "no parenthesis. left : $left operator: $operator right: $right"
2258       if $DEBUG;
2259
2260     # it's not a leaf, we have a and/or/not
2261     if ($operator) {
2262
2263         # reintroduce comma content if needed
2264         $right =~ s/__X__/"$commacontent"/ if $commacontent;
2265         $left  =~ s/__X__/"$commacontent"/ if $commacontent;
2266         warn "node : $left / $operator / $right\n" if $DEBUG;
2267         my $leftresult  = NZanalyse( $left,  $server );
2268         my $rightresult = NZanalyse( $right, $server );
2269         warn " leftresult : $leftresult" if $DEBUG;
2270         warn " rightresult : $rightresult" if $DEBUG;
2271         # OK, we have the results for right and left part of the query
2272         # depending of operand, intersect, union or exclude both lists
2273         # to get a result list
2274         if ( $operator eq ' and ' ) {
2275             return NZoperatorAND($leftresult,$rightresult);
2276         }
2277         elsif ( $operator eq ' or ' ) {
2278
2279             # just merge the 2 strings
2280             return $leftresult . $rightresult;
2281         }
2282         elsif ( $operator eq ' not ' ) {
2283             return NZoperatorNOT($leftresult,$rightresult);
2284         }
2285         else {
2286
2287 # this error is impossible, because of the regexp that isolate the operand, but just in case...
2288             die "error : operand unknown : $operator for $string";
2289         }
2290
2291         # it's a leaf, do the real SQL query and return the result
2292     }
2293     else {
2294         $string =~ s/__X__/"$commacontent"/ if $commacontent;
2295         $string =~ s/-|\.|\?|,|;|!|'|\(|\)|\[|\]|{|}|"|&|\+|\*|\// /g;
2296         #remove trailing blank at the beginning
2297         $string =~ s/^ //g;
2298         warn "leaf:$string" if $DEBUG;
2299
2300         # parse the string in in operator/operand/value again
2301         my $left = "";
2302         my $operator = "";
2303         my $right = "";
2304         if ($string =~ /(.*)(>=|<=)(.*)/) {
2305             $left     = $1;
2306             $operator = $2;
2307             $right    = $3;
2308         } else {
2309             $left = $string;
2310         }
2311 #         warn "handling leaf... left:$left operator:$operator right:$right"
2312 #           if $DEBUG;
2313         unless ($operator) {
2314             if ($string =~ /(.*)(>|<|=)(.*)/) {
2315                 $left     = $1;
2316                 $operator = $2;
2317                 $right    = $3;
2318                 warn
2319     "handling unless (operator)... left:$left operator:$operator right:$right"
2320                 if $DEBUG;
2321             } else {
2322                 $left = $string;
2323             }
2324         }
2325         my $results;
2326
2327 # strip adv, zebra keywords, currently not handled in nozebra: wrdl, ext, phr...
2328         $left =~ s/ .*$//;
2329
2330         # automatic replace for short operators
2331         $left = 'title'            if $left =~ '^ti$';
2332         $left = 'author'           if $left =~ '^au$';
2333         $left = 'publisher'        if $left =~ '^pb$';
2334         $left = 'subject'          if $left =~ '^su$';
2335         $left = 'koha-Auth-Number' if $left =~ '^an$';
2336         $left = 'keyword'          if $left =~ '^kw$';
2337         $left = 'itemtype'         if $left =~ '^mc$'; # Fix for Bug 2599 - Search limits not working for NoZebra
2338         warn "handling leaf... left:$left operator:$operator right:$right" if $DEBUG;
2339         my $dbh = C4::Context->dbh;
2340         if ( $operator && $left ne 'keyword' ) {
2341             #do a specific search
2342             $operator = 'LIKE' if $operator eq '=' and $right =~ /%/;
2343             my $sth = $dbh->prepare(
2344 "SELECT biblionumbers,value FROM nozebra WHERE server=? AND indexname=? AND value $operator ?"
2345             );
2346             warn "$left / $operator / $right\n" if $DEBUG;
2347
2348             # split each word, query the DB and build the biblionumbers result
2349             #sanitizing leftpart
2350             $left =~ s/^\s+|\s+$//;
2351             foreach ( split / /, $right ) {
2352                 my $biblionumbers;
2353                 $_ =~ s/^\s+|\s+$//;
2354                 next unless $_;
2355                 warn "EXECUTE : $server, $left, $_" if $DEBUG;
2356                 $sth->execute( $server, $left, $_ )
2357                   or warn "execute failed: $!";
2358                 while ( my ( $line, $value ) = $sth->fetchrow ) {
2359
2360 # if we are dealing with a numeric value, use only numeric results (in case of >=, <=, > or <)
2361 # otherwise, fill the result
2362                     $biblionumbers .= $line
2363                       unless ( $right =~ /^\d+$/ && $value =~ /\D/ );
2364                     warn "result : $value "
2365                       . ( $right  =~ /\d/ ) . "=="
2366                       . ( $value =~ /\D/?$line:"" ) if $DEBUG;         #= $line";
2367                 }
2368
2369 # do a AND with existing list if there is one, otherwise, use the biblionumbers list as 1st result list
2370                 if ($results) {
2371                     warn "NZAND" if $DEBUG;
2372                     $results = NZoperatorAND($biblionumbers,$results);
2373                 } else {
2374                     $results = $biblionumbers;
2375                 }
2376             }
2377         }
2378         else {
2379       #do a complete search (all indexes), if index='kw' do complete search too.
2380             my $sth = $dbh->prepare(
2381 "SELECT biblionumbers FROM nozebra WHERE server=? AND value LIKE ?"
2382             );
2383
2384             # split each word, query the DB and build the biblionumbers result
2385             foreach ( split / /, $string ) {
2386                 next if C4::Context->stopwords->{ uc($_) };   # skip if stopword
2387                 warn "search on all indexes on $_" if $DEBUG;
2388                 my $biblionumbers;
2389                 next unless $_;
2390                 $sth->execute( $server, $_ );
2391                 while ( my $line = $sth->fetchrow ) {
2392                     $biblionumbers .= $line;
2393                 }
2394
2395 # do a AND with existing list if there is one, otherwise, use the biblionumbers list as 1st result list
2396                 if ($results) {
2397                     $results = NZoperatorAND($biblionumbers,$results);
2398                 }
2399                 else {
2400                     warn "NEW RES for $_ = $biblionumbers" if $DEBUG;
2401                     $results = $biblionumbers;
2402                 }
2403             }
2404         }
2405         warn "return : $results for LEAF : $string" if $DEBUG;
2406         return $results;
2407     }
2408     warn "---------\nLeave NZanalyse\n---------" if $DEBUG;
2409 }
2410
2411 sub NZoperatorAND{
2412     my ($rightresult, $leftresult)=@_;
2413
2414     my @leftresult = split /;/, $leftresult;
2415     warn " @leftresult / $rightresult \n" if $DEBUG;
2416
2417     #             my @rightresult = split /;/,$leftresult;
2418     my $finalresult;
2419
2420 # parse the left results, and if the biblionumber exist in the right result, save it in finalresult
2421 # the result is stored twice, to have the same weight for AND than OR.
2422 # example : TWO : 61,61,64,121 (two is twice in the biblio #61) / TOWER : 61,64,130
2423 # result : 61,61,61,61,64,64 for two AND tower : 61 has more weight than 64
2424     foreach (@leftresult) {
2425         my $value = $_;
2426         my $countvalue;
2427         ( $value, $countvalue ) = ( $1, $2 ) if ($value=~/(.*)-(\d+)$/);
2428         if ( $rightresult =~ /\Q$value\E-(\d+);/ ) {
2429             $countvalue = ( $1 > $countvalue ? $countvalue : $1 );
2430             $finalresult .=
2431                 "$value-$countvalue;$value-$countvalue;";
2432         }
2433     }
2434     warn "NZAND DONE : $finalresult \n" if $DEBUG;
2435     return $finalresult;
2436 }
2437
2438 sub NZoperatorOR{
2439     my ($rightresult, $leftresult)=@_;
2440     return $rightresult.$leftresult;
2441 }
2442
2443 sub NZoperatorNOT{
2444     my ($leftresult, $rightresult)=@_;
2445
2446     my @leftresult = split /;/, $leftresult;
2447
2448     #             my @rightresult = split /;/,$leftresult;
2449     my $finalresult;
2450     foreach (@leftresult) {
2451         my $value=$_;
2452         $value=$1 if $value=~m/(.*)-\d+$/;
2453         unless ($rightresult =~ "$value-") {
2454             $finalresult .= "$_;";
2455         }
2456     }
2457     return $finalresult;
2458 }
2459
2460 =head2 NZorder
2461
2462   $finalresult = NZorder($biblionumbers, $ordering,$results_per_page,$offset);
2463
2464   TODO :: Description
2465
2466 =cut
2467
2468 sub NZorder {
2469     my ( $biblionumbers, $ordering, $results_per_page, $offset ) = @_;
2470     warn "biblionumbers = $biblionumbers and ordering = $ordering\n" if $DEBUG;
2471
2472     # order title asc by default
2473     #     $ordering = '1=36 <i' unless $ordering;
2474     $results_per_page = 20 unless $results_per_page;
2475     $offset           = 0  unless $offset;
2476     my $dbh = C4::Context->dbh;
2477
2478     #
2479     # order by POPULARITY
2480     #
2481     if ( $ordering =~ /popularity/ ) {
2482         my %result;
2483         my %popularity;
2484
2485         # popularity is not in MARC record, it's builded from a specific query
2486         my $sth =
2487           $dbh->prepare("select sum(issues) from items where biblionumber=?");
2488         foreach ( split /;/, $biblionumbers ) {
2489             my ( $biblionumber, $title ) = split /,/, $_;
2490             $result{$biblionumber} = GetMarcBiblio($biblionumber);
2491             $sth->execute($biblionumber);
2492             my $popularity = $sth->fetchrow || 0;
2493
2494 # hint : the key is popularity.title because we can have
2495 # many results with the same popularity. In this case, sub-ordering is done by title
2496 # we also have biblionumber to avoid bug for 2 biblios with the same title & popularity
2497 # (un-frequent, I agree, but we won't forget anything that way ;-)
2498             $popularity{ sprintf( "%10d", $popularity ) . $title
2499                   . $biblionumber } = $biblionumber;
2500         }
2501
2502     # sort the hash and return the same structure as GetRecords (Zebra querying)
2503         my $result_hash;
2504         my $numbers = 0;
2505         if ( $ordering eq 'popularity_dsc' ) {    # sort popularity DESC
2506             foreach my $key ( sort { $b cmp $a } ( keys %popularity ) ) {
2507                 $result_hash->{'RECORDS'}[ $numbers++ ] =
2508                   $result{ $popularity{$key} }->as_usmarc();
2509             }
2510         }
2511         else {                                    # sort popularity ASC
2512             foreach my $key ( sort ( keys %popularity ) ) {
2513                 $result_hash->{'RECORDS'}[ $numbers++ ] =
2514                   $result{ $popularity{$key} }->as_usmarc();
2515             }
2516         }
2517         my $finalresult = ();
2518         $result_hash->{'hits'}         = $numbers;
2519         $finalresult->{'biblioserver'} = $result_hash;
2520         return $finalresult;
2521
2522         #
2523         # ORDER BY author
2524         #
2525     }
2526     elsif ( $ordering =~ /author/ ) {
2527         my %result;
2528         foreach ( split /;/, $biblionumbers ) {
2529             my ( $biblionumber, $title ) = split /,/, $_;
2530             my $record = GetMarcBiblio($biblionumber);
2531             my $author;
2532             if ( C4::Context->preference('marcflavour') eq 'UNIMARC' ) {
2533                 $author = $record->subfield( '200', 'f' );
2534                 $author = $record->subfield( '700', 'a' ) unless $author;
2535             }
2536             else {
2537                 $author = $record->subfield( '100', 'a' );
2538             }
2539
2540 # hint : the result is sorted by title.biblionumber because we can have X biblios with the same title
2541 # and we don't want to get only 1 result for each of them !!!
2542             $result{ $author . $biblionumber } = $record;
2543         }
2544
2545     # sort the hash and return the same structure as GetRecords (Zebra querying)
2546         my $result_hash;
2547         my $numbers = 0;
2548         if ( $ordering eq 'author_za' || $ordering eq 'author_dsc' ) {    # sort by author desc
2549             foreach my $key ( sort { $b cmp $a } ( keys %result ) ) {
2550                 $result_hash->{'RECORDS'}[ $numbers++ ] =
2551                   $result{$key}->as_usmarc();
2552             }
2553         }
2554         else {                               # sort by author ASC
2555             foreach my $key ( sort ( keys %result ) ) {
2556                 $result_hash->{'RECORDS'}[ $numbers++ ] =
2557                   $result{$key}->as_usmarc();
2558             }
2559         }
2560         my $finalresult = ();
2561         $result_hash->{'hits'}         = $numbers;
2562         $finalresult->{'biblioserver'} = $result_hash;
2563         return $finalresult;
2564
2565         #
2566         # ORDER BY callnumber
2567         #
2568     }
2569     elsif ( $ordering =~ /callnumber/ ) {
2570         my %result;
2571         foreach ( split /;/, $biblionumbers ) {
2572             my ( $biblionumber, $title ) = split /,/, $_;
2573             my $record = GetMarcBiblio($biblionumber);
2574             my $callnumber;
2575             my $frameworkcode = GetFrameworkCode($biblionumber);
2576             my ( $callnumber_tag, $callnumber_subfield ) = GetMarcFromKohaField(  'items.itemcallnumber', $frameworkcode);
2577                ( $callnumber_tag, $callnumber_subfield ) = GetMarcFromKohaField('biblioitems.callnumber', $frameworkcode)
2578                 unless $callnumber_tag;
2579             if ( C4::Context->preference('marcflavour') eq 'UNIMARC' ) {
2580                 $callnumber = $record->subfield( '200', 'f' );
2581             } else {
2582                 $callnumber = $record->subfield( '100', 'a' );
2583             }
2584
2585 # hint : the result is sorted by title.biblionumber because we can have X biblios with the same title
2586 # and we don't want to get only 1 result for each of them !!!
2587             $result{ $callnumber . $biblionumber } = $record;
2588         }
2589
2590     # sort the hash and return the same structure as GetRecords (Zebra querying)
2591         my $result_hash;
2592         my $numbers = 0;
2593         if ( $ordering eq 'call_number_dsc' ) {    # sort by title desc
2594             foreach my $key ( sort { $b cmp $a } ( keys %result ) ) {
2595                 $result_hash->{'RECORDS'}[ $numbers++ ] =
2596                   $result{$key}->as_usmarc();
2597             }
2598         }
2599         else {                                     # sort by title ASC
2600             foreach my $key ( sort { $a cmp $b } ( keys %result ) ) {
2601                 $result_hash->{'RECORDS'}[ $numbers++ ] =
2602                   $result{$key}->as_usmarc();
2603             }
2604         }
2605         my $finalresult = ();
2606         $result_hash->{'hits'}         = $numbers;
2607         $finalresult->{'biblioserver'} = $result_hash;
2608         return $finalresult;
2609     }
2610     elsif ( $ordering =~ /pubdate/ ) {             #pub year
2611         my %result;
2612         foreach ( split /;/, $biblionumbers ) {
2613             my ( $biblionumber, $title ) = split /,/, $_;
2614             my $record = GetMarcBiblio($biblionumber);
2615             my ( $publicationyear_tag, $publicationyear_subfield ) =
2616               GetMarcFromKohaField( 'biblioitems.publicationyear', '' );
2617             my $publicationyear =
2618               $record->subfield( $publicationyear_tag,
2619                 $publicationyear_subfield );
2620
2621 # hint : the result is sorted by title.biblionumber because we can have X biblios with the same title
2622 # and we don't want to get only 1 result for each of them !!!
2623             $result{ $publicationyear . $biblionumber } = $record;
2624         }
2625
2626     # sort the hash and return the same structure as GetRecords (Zebra querying)
2627         my $result_hash;
2628         my $numbers = 0;
2629         if ( $ordering eq 'pubdate_dsc' ) {    # sort by pubyear desc
2630             foreach my $key ( sort { $b cmp $a } ( keys %result ) ) {
2631                 $result_hash->{'RECORDS'}[ $numbers++ ] =
2632                   $result{$key}->as_usmarc();
2633             }
2634         }
2635         else {                                 # sort by pub year ASC
2636             foreach my $key ( sort ( keys %result ) ) {
2637                 $result_hash->{'RECORDS'}[ $numbers++ ] =
2638                   $result{$key}->as_usmarc();
2639             }
2640         }
2641         my $finalresult = ();
2642         $result_hash->{'hits'}         = $numbers;
2643         $finalresult->{'biblioserver'} = $result_hash;
2644         return $finalresult;
2645
2646         #
2647         # ORDER BY title
2648         #
2649     }
2650     elsif ( $ordering =~ /title/ ) {
2651
2652 # the title is in the biblionumbers string, so we just need to build a hash, sort it and return
2653         my %result;
2654         foreach ( split /;/, $biblionumbers ) {
2655             my ( $biblionumber, $title ) = split /,/, $_;
2656
2657 # hint : the result is sorted by title.biblionumber because we can have X biblios with the same title
2658 # and we don't want to get only 1 result for each of them !!!
2659 # hint & speed improvement : we can order without reading the record
2660 # so order, and read records only for the requested page !
2661             $result{ $title . $biblionumber } = $biblionumber;
2662         }
2663
2664     # sort the hash and return the same structure as GetRecords (Zebra querying)
2665         my $result_hash;
2666         my $numbers = 0;
2667         if ( $ordering eq 'title_az' ) {    # sort by title desc
2668             foreach my $key ( sort ( keys %result ) ) {
2669                 $result_hash->{'RECORDS'}[ $numbers++ ] = $result{$key};
2670             }
2671         }
2672         else {                              # sort by title ASC
2673             foreach my $key ( sort { $b cmp $a } ( keys %result ) ) {
2674                 $result_hash->{'RECORDS'}[ $numbers++ ] = $result{$key};
2675             }
2676         }
2677
2678         # limit the $results_per_page to result size if it's more
2679         $results_per_page = $numbers - 1 if $numbers < $results_per_page;
2680
2681         # for the requested page, replace biblionumber by the complete record
2682         # speed improvement : avoid reading too much things
2683         for (
2684             my $counter = $offset ;
2685             $counter <= $offset + $results_per_page ;
2686             $counter++
2687           )
2688         {
2689             $result_hash->{'RECORDS'}[$counter] =
2690               GetMarcBiblio( $result_hash->{'RECORDS'}[$counter] )->as_usmarc;
2691         }
2692         my $finalresult = ();
2693         $result_hash->{'hits'}         = $numbers;
2694         $finalresult->{'biblioserver'} = $result_hash;
2695         return $finalresult;
2696     }
2697     else {
2698
2699 #
2700 # order by ranking
2701 #
2702 # we need 2 hashes to order by ranking : the 1st one to count the ranking, the 2nd to order by ranking
2703         my %result;
2704         my %count_ranking;
2705         foreach ( split /;/, $biblionumbers ) {
2706             my ( $biblionumber, $title ) = split /,/, $_;
2707             $title =~ /(.*)-(\d)/;
2708
2709             # get weight
2710             my $ranking = $2;
2711
2712 # note that we + the ranking because ranking is calculated on weight of EACH term requested.
2713 # if we ask for "two towers", and "two" has weight 2 in biblio N, and "towers" has weight 4 in biblio N
2714 # biblio N has ranking = 6
2715             $count_ranking{$biblionumber} += $ranking;
2716         }
2717
2718 # build the result by "inverting" the count_ranking hash
2719 # 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
2720 #         warn "counting";
2721         foreach ( keys %count_ranking ) {
2722             $result{ sprintf( "%10d", $count_ranking{$_} ) . '-' . $_ } = $_;
2723         }
2724
2725     # sort the hash and return the same structure as GetRecords (Zebra querying)
2726         my $result_hash;
2727         my $numbers = 0;
2728         foreach my $key ( sort { $b cmp $a } ( keys %result ) ) {
2729             $result_hash->{'RECORDS'}[ $numbers++ ] = $result{$key};
2730         }
2731
2732         # limit the $results_per_page to result size if it's more
2733         $results_per_page = $numbers - 1 if $numbers < $results_per_page;
2734
2735         # for the requested page, replace biblionumber by the complete record
2736         # speed improvement : avoid reading too much things
2737         for (
2738             my $counter = $offset ;
2739             $counter <= $offset + $results_per_page ;
2740             $counter++
2741           )
2742         {
2743             $result_hash->{'RECORDS'}[$counter] =
2744               GetMarcBiblio( $result_hash->{'RECORDS'}[$counter] )->as_usmarc
2745               if $result_hash->{'RECORDS'}[$counter];
2746         }
2747         my $finalresult = ();
2748         $result_hash->{'hits'}         = $numbers;
2749         $finalresult->{'biblioserver'} = $result_hash;
2750         return $finalresult;
2751     }
2752 }
2753
2754 =head2 enabled_staff_search_views
2755
2756 %hash = enabled_staff_search_views()
2757
2758 This function returns a hash that contains three flags obtained from the system
2759 preferences, used to determine whether a particular staff search results view
2760 is enabled.
2761
2762 =over 2
2763
2764 =item C<Output arg:>
2765
2766     * $hash{can_view_MARC} is true only if the MARC view is enabled
2767     * $hash{can_view_ISBD} is true only if the ISBD view is enabled
2768     * $hash{can_view_labeledMARC} is true only if the Labeled MARC view is enabled
2769
2770 =item C<usage in the script:>
2771
2772 =back
2773
2774 $template->param ( C4::Search::enabled_staff_search_views );
2775
2776 =cut
2777
2778 sub enabled_staff_search_views
2779 {
2780         return (
2781                 can_view_MARC                   => C4::Context->preference('viewMARC'),                 # 1 if the staff search allows the MARC view
2782                 can_view_ISBD                   => C4::Context->preference('viewISBD'),                 # 1 if the staff search allows the ISBD view
2783                 can_view_labeledMARC    => C4::Context->preference('viewLabeledMARC'),  # 1 if the staff search allows the Labeled MARC view
2784         );
2785 }
2786
2787 sub AddSearchHistory{
2788         my ($borrowernumber,$session,$query_desc,$query_cgi, $total)=@_;
2789     my $dbh = C4::Context->dbh;
2790
2791     # Add the request the user just made
2792     my $sql = "INSERT INTO search_history(userid, sessionid, query_desc, query_cgi, total, time) VALUES(?, ?, ?, ?, ?, NOW())";
2793     my $sth   = $dbh->prepare($sql);
2794     $sth->execute($borrowernumber, $session, $query_desc, $query_cgi, $total);
2795         return $dbh->last_insert_id(undef, 'search_history', undef,undef,undef);
2796 }
2797
2798 sub GetSearchHistory{
2799         my ($borrowernumber,$session)=@_;
2800     my $dbh = C4::Context->dbh;
2801
2802     # Add the request the user just made
2803     my $query = "SELECT FROM search_history WHERE (userid=? OR sessionid=?)";
2804     my $sth   = $dbh->prepare($query);
2805         $sth->execute($borrowernumber, $session);
2806     return  $sth->fetchall_hashref({});
2807 }
2808
2809 =head2 z3950_search_args
2810
2811 $arrayref = z3950_search_args($matchpoints)
2812
2813 This function returns an array reference that contains the search parameters to be
2814 passed to the Z39.50 search script (z3950_search.pl). The array elements
2815 are hash refs whose keys are name, value and encvalue, and whose values are the
2816 name of a search parameter, the value of that search parameter and the URL encoded
2817 value of that parameter.
2818
2819 The search parameter names are lccn, isbn, issn, title, author, dewey and subject.
2820
2821 The search parameter values are obtained from the bibliographic record whose
2822 data is in a hash reference in $matchpoints, as returned by Biblio::GetBiblioData().
2823
2824 If $matchpoints is a scalar, it is assumed to be an unnamed query descriptor, e.g.
2825 a general purpose search argument. In this case, the returned array contains only
2826 entry: the key is 'title' and the value and encvalue are derived from $matchpoints.
2827
2828 If a search parameter value is undefined or empty, it is not included in the returned
2829 array.
2830
2831 The returned array reference may be passed directly to the template parameters.
2832
2833 =over 2
2834
2835 =item C<Output arg:>
2836
2837     * $array containing hash refs as described above
2838
2839 =item C<usage in the script:>
2840
2841 =back
2842
2843 $data = Biblio::GetBiblioData($bibno);
2844 $template->param ( MYLOOP => C4::Search::z3950_search_args($data) )
2845
2846 *OR*
2847
2848 $template->param ( MYLOOP => C4::Search::z3950_search_args($searchscalar) )
2849
2850 =cut
2851
2852 sub z3950_search_args {
2853     my $bibrec = shift;
2854     my $isbn = Business::ISBN->new($bibrec);
2855
2856     if (defined $isbn && $isbn->is_valid)
2857     {
2858         $bibrec = { isbn => $bibrec } if !ref $bibrec;
2859     }
2860     else {
2861         $bibrec = { title => $bibrec } if !ref $bibrec;
2862     }
2863     my $array = [];
2864     for my $field (qw/ lccn isbn issn title author dewey subject /)
2865     {
2866         my $encvalue = URI::Escape::uri_escape_utf8($bibrec->{$field});
2867         push @$array, { name=>$field, value=>$bibrec->{$field}, encvalue=>$encvalue } if defined $bibrec->{$field};
2868     }
2869     return $array;
2870 }
2871
2872 =head2 GetDistinctValues($field);
2873
2874 C<$field> is a reference to the fields array
2875
2876 =cut
2877
2878 sub GetDistinctValues {
2879     my ($fieldname,$string)=@_;
2880     # returns a reference to a hash of references to branches...
2881     if ($fieldname=~/\./){
2882                         my ($table,$column)=split /\./, $fieldname;
2883                         my $dbh = C4::Context->dbh;
2884                         warn "select DISTINCT($column) as value, count(*) as cnt from $table group by lib order by $column " if $DEBUG;
2885                         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 ");
2886                         $sth->execute;
2887                         my $elements=$sth->fetchall_arrayref({});
2888                         return $elements;
2889    }
2890    else {
2891                 $string||= qq("");
2892                 my @servers=qw<biblioserver authorityserver>;
2893                 my (@zconns,@results);
2894         for ( my $i = 0 ; $i < @servers ; $i++ ) {
2895                 $zconns[$i] = C4::Context->Zconn( $servers[$i], 1 );
2896                         $results[$i] =
2897                       $zconns[$i]->scan(
2898                         ZOOM::Query::CCL2RPN->new( qq"$fieldname $string", $zconns[$i])
2899                       );
2900                 }
2901                 # The big moment: asynchronously retrieve results from all servers
2902                 my @elements;
2903         _ZOOM_event_loop(
2904             \@zconns,
2905             \@results,
2906             sub {
2907                 my ( $i, $size ) = @_;
2908                 for ( my $j = 0 ; $j < $size ; $j++ ) {
2909                     my %hashscan;
2910                     @hashscan{qw(value cnt)} =
2911                       $results[ $i - 1 ]->display_term($j);
2912                     push @elements, \%hashscan;
2913                 }
2914             }
2915         );
2916                 return \@elements;
2917    }
2918 }
2919
2920 =head2 _ZOOM_event_loop
2921
2922     _ZOOM_event_loop(\@zconns, \@results, sub {
2923         my ( $i, $size ) = @_;
2924         ....
2925     } );
2926
2927 Processes a ZOOM event loop and passes control to a closure for
2928 processing the results, and destroying the resultsets.
2929
2930 =cut
2931
2932 sub _ZOOM_event_loop {
2933     my ($zconns, $results, $callback) = @_;
2934     while ( ( my $i = ZOOM::event( $zconns ) ) != 0 ) {
2935         my $ev = $zconns->[ $i - 1 ]->last_event();
2936         if ( $ev == ZOOM::Event::ZEND ) {
2937             next unless $results->[ $i - 1 ];
2938             my $size = $results->[ $i - 1 ]->size();
2939             if ( $size > 0 ) {
2940                 $callback->($i, $size);
2941             }
2942         }
2943     }
2944
2945     foreach my $result (@$results) {
2946         $result->destroy();
2947     }
2948 }
2949
2950
2951 END { }    # module clean-up code here (global destructor)
2952
2953 1;
2954 __END__
2955
2956 =head1 AUTHOR
2957
2958 Koha Development Team <http://koha-community.org/>
2959
2960 =cut