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