C4/Search.pm

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