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