C4/Search.pm

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