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