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