C4/Search.pm

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