C4/Search.pm

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