C4/Search.pm

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