C4/Search.pm

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