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                     'Bib-level',
 846                     'biblionumber',
 847                     'bio',
 848                     'biography',
 849                     'callnum',
 850                     'cfn',
 851                     'Chronological-subdivision',
 852                     'cn-bib-source',
 853                     'cn-bib-sort',
 854                     'cn-class',
 855                     'cn-item',
 856                     'cn-prefix',
 857                     'cn-suffix',
 858                     'cpn',
 859                     'Code-institution',
 860                     'Conference-name',
 861                     'Conference-name-heading',
 862                     'Conference-name-see',
 863                     'Conference-name-seealso',
 864                     'Content-type',
 865                     'Control-number',
 866                     'copydate',
 867                     'Corporate-name',
 868                     'Corporate-name-heading',
 869                     'Corporate-name-see',
 870                     'Corporate-name-seealso',
 871                     'ctype',
 872                     'date-entered-on-file',
 873                     'Date-of-acquisition',
 874                     'Date-of-publication',
 875                     'Dewey-classification',
 876                     'EAN',
 877                     'extent',
 878                     'fic',
 879                     'fiction',
 880                     'Form-subdivision',
 881                     'format',
 882                     'Geographic-subdivision',
 883                     'he',
 884                     'Heading',
 885                     'Heading-use-main-or-added-entry',
 886                     'Heading-use-series-added-entry ',
 887                     'Heading-use-subject-added-entry',
 888                     'Host-item',
 889                     'id-other',
 890                     'Illustration-code',
 891                     'ISBN',
 892                     'isbn',
 893                     'ISSN',
 894                     'issn',
 895                     'itemtype',
 896                     'kw',
 897                     'Koha-Auth-Number',
 898                     'l-format',
 899                     'language',
 900                     'lc-card',
 901                     'LC-card-number',
 902                     'lcn',
 903                     'llength',
 904                     'ln',
 905                     'Local-classification',
 906                     'Local-number',
 907                     'Match-heading',
 908                     'Match-heading-see-from',
 909                     'Material-type',
 910                     'mc-itemtype',
 911                     'mc-rtype',
 912                     'mus',
 913                     'name',
 914                     'Music-number',
 915                     'Name-geographic',
 916                     'Name-geographic-heading',
 917                     'Name-geographic-see',
 918                     'Name-geographic-seealso',
 919                     'nb',
 920                     'Note',
 921                     'notes',
 922                     'ns',
 923                     'nt',
 924                     'pb',
 925                     'Personal-name',
 926                     'Personal-name-heading',
 927                     'Personal-name-see',
 928                     'Personal-name-seealso',
 929                     'pl',
 930                     'Place-publication',
 931                     'pn',
 932                     'popularity',
 933                     'pubdate',
 934                     'Publisher',
 935                     'Record-control-number',
 936                     'rcn',
 937                     'Record-type',
 938                     'rtype',
 939                     'se',
 940                     'See',
 941                     'See-also',
 942                     'sn',
 943                     'Stock-number',
 944                     'su',
 945                     'Subject',
 946                     'Subject-heading-thesaurus',
 947                     'Subject-name-personal',
 948                     'Subject-subdivision',
 949                     'Summary',
 950                     'Suppress',
 951                     'su-geo',
 952                     'su-na',
 953                     'su-to',
 954                     'su-ut',
 955                     'ut',
 956                     'UPC',
 957                     'Term-genre-form',
 958                     'Term-genre-form-heading',
 959                     'Term-genre-form-see',
 960                     'Term-genre-form-seealso',
 961                     'ti',
 962                     'Title',
 963                     'Title-cover',
 964                     'Title-series',
 965                     'Title-host',
 966                     'Title-uniform',
 967                     'Title-uniform-heading',
 968                     'Title-uniform-see',
 969                     'Title-uniform-seealso',
 970                     'totalissues',
 971                     'yr',
 972
 973                     # items indexes
 974                     'acqsource',
 975                     'barcode',
 976                     'bc',
 977                     'branch',
 978                     'ccode',
 979                     'classification-source',
 980                     'cn-sort',
 981                     'coded-location-qualifier',
 982                     'copynumber',
 983                     'damaged',
 984                     'datelastborrowed',
 985                     'datelastseen',
 986                     'holdingbranch',
 987                     'homebranch',
 988                     'issues',
 989                     'item',
 990                     'itemnumber',
 991                     'itype',
 992                     'Local-classification',
 993                     'location',
 994                     'lost',
 995                     'materials-specified',
 996                     'mc-ccode',
 997                     'mc-itype',
 998                     'mc-loc',
 999                     'notforloan',
1000                     'onloan',
1001                     'price',
1002                     'renewals',
1003                     'replacementprice',
1004                     'replacementpricedate',
1005                     'reserves',
1006                     'restricted',
1007                     'stack',
1008                     'stocknumber',
1009                     'inv',
1010                     'uri',
1011                     'withdrawn',
1012
1013                     # subject related
1014                   );
1015
1016     return \@indexes;
1017 }
1018
1019 =head2 buildQuery
1020
1021 ( $error, $query,
1022 $simple_query, $query_cgi,
1023 $query_desc, $limit,
1024 $limit_cgi, $limit_desc,
1025 $stopwords_removed, $query_type ) = buildQuery ( $operators, $operands, $indexes, $limits, $sort_by, $scan, $lang);
1026
1027 Build queries and limits in CCL, CGI, Human,
1028 handle truncation, stemming, field weighting, stopwords, fuzziness, etc.
1029
1030 See verbose embedded documentation.
1031
1032
1033 =cut
1034
1035 sub buildQuery {
1036     my ( $operators, $operands, $indexes, $limits, $sort_by, $scan, $lang) = @_;
1037
1038     warn "---------\nEnter buildQuery\n---------" if $DEBUG;
1039
1040     # dereference
1041     my @operators = $operators ? @$operators : ();
1042     my @indexes   = $indexes   ? @$indexes   : ();
1043     my @operands  = $operands  ? @$operands  : ();
1044     my @limits    = $limits    ? @$limits    : ();
1045     my @sort_by   = $sort_by   ? @$sort_by   : ();
1046
1047     my $stemming         = C4::Context->preference("QueryStemming")        || 0;
1048     my $auto_truncation  = C4::Context->preference("QueryAutoTruncate")    || 0;
1049     my $weight_fields    = C4::Context->preference("QueryWeightFields")    || 0;
1050     my $fuzzy_enabled    = C4::Context->preference("QueryFuzzy")           || 0;
1051     my $remove_stopwords = C4::Context->preference("QueryRemoveStopwords") || 0;
1052
1053     # no stemming/weight/fuzzy in NoZebra
1054     if ( C4::Context->preference("NoZebra") ) {
1055         $stemming         = 0;
1056         $weight_fields    = 0;
1057         $fuzzy_enabled    = 0;
1058         $auto_truncation  = 0;
1059     }
1060
1061     my $query        = $operands[0];
1062     my $simple_query = $operands[0];
1063
1064     # initialize the variables we're passing back
1065     my $query_cgi;
1066     my $query_desc;
1067     my $query_type;
1068
1069     my $limit;
1070     my $limit_cgi;
1071     my $limit_desc;
1072
1073     my $stopwords_removed;    # flag to determine if stopwords have been removed
1074
1075     my $cclq;
1076     my $cclindexes = getIndexes();
1077     if( $query !~ /\s*ccl=/ ){
1078         for my $index (@$cclindexes){
1079             if($query =~ /($index)(,?\w)*[:=]/){
1080                 $cclq = 1;
1081             }
1082         }
1083         $query = "ccl=$query" if($cclq);
1084     }
1085
1086 # for handling ccl, cql, pqf queries in diagnostic mode, skip the rest of the steps
1087 # DIAGNOSTIC ONLY!!
1088     if ( $query =~ /^ccl=/ ) {
1089         my $q=$';
1090         # This is needed otherwise ccl= and &limit won't work together, and
1091         # this happens when selecting a subject on the opac-detail page
1092         if (@limits) {
1093             $q .= ' and '.join(' and ', @limits);
1094         }
1095         return ( undef, $q, $q, "q=ccl=$q", $q, '', '', '', '', 'ccl' );
1096     }
1097     if ( $query =~ /^cql=/ ) {
1098         return ( undef, $', $', "q=cql=$'", $', '', '', '', '', 'cql' );
1099     }
1100     if ( $query =~ /^pqf=/ ) {
1101         return ( undef, $', $', "q=pqf=$'", $', '', '', '', '', 'pqf' );
1102     }
1103
1104     # pass nested queries directly
1105     # FIXME: need better handling of some of these variables in this case
1106     # Nested queries aren't handled well and this implementation is flawed and causes users to be
1107     # unable to search for anything containing () commenting out, will be rewritten for 3.4.0
1108 #    if ( $query =~ /(\(|\))/ ) {
1109 #        return (
1110 #            undef,              $query, $simple_query, $query_cgi,
1111 #            $query,             $limit, $limit_cgi,    $limit_desc,
1112 #            $stopwords_removed, 'ccl'
1113 #        );
1114 #    }
1115
1116 # Form-based queries are non-nested and fixed depth, so we can easily modify the incoming
1117 # query operands and indexes and add stemming, truncation, field weighting, etc.
1118 # Once we do so, we'll end up with a value in $query, just like if we had an
1119 # incoming $query from the user
1120     else {
1121         $query = ""
1122           ; # clear it out so we can populate properly with field-weighted, stemmed, etc. query
1123         my $previous_operand
1124           ;    # a flag used to keep track if there was a previous query
1125                # if there was, we can apply the current operator
1126                # for every operand
1127         for ( my $i = 0 ; $i <= @operands ; $i++ ) {
1128
1129             # COMBINE OPERANDS, INDEXES AND OPERATORS
1130             if ( $operands[$i] ) {
1131                 $operands[$i]=~s/^\s+//;
1132
1133               # A flag to determine whether or not to add the index to the query
1134                 my $indexes_set;
1135
1136 # If the user is sophisticated enough to specify an index, turn off field weighting, stemming, and stopword handling
1137                 if ( $operands[$i] =~ /\w(:|=)/ || $scan ) {
1138                     $weight_fields    = 0;
1139                     $stemming         = 0;
1140                     $remove_stopwords = 0;
1141                 } else {
1142                     $operands[$i] =~ s/\?/{?}/g; # need to escape question marks
1143                 }
1144                 my $operand = $operands[$i];
1145                 my $index   = $indexes[$i];
1146
1147                 # Add index-specific attributes
1148                 # Date of Publication
1149                 if ( $index eq 'yr' ) {
1150                     $index .= ",st-numeric";
1151                     $indexes_set++;
1152                                         $stemming = $auto_truncation = $weight_fields = $fuzzy_enabled = $remove_stopwords = 0;
1153                 }
1154
1155                 # Date of Acquisition
1156                 elsif ( $index eq 'acqdate' ) {
1157                     $index .= ",st-date-normalized";
1158                     $indexes_set++;
1159                                         $stemming = $auto_truncation = $weight_fields = $fuzzy_enabled = $remove_stopwords = 0;
1160                 }
1161                 # ISBN,ISSN,Standard Number, don't need special treatment
1162                 elsif ( $index eq 'nb' || $index eq 'ns' ) {
1163                     (
1164                         $stemming,      $auto_truncation,
1165                         $weight_fields, $fuzzy_enabled,
1166                         $remove_stopwords
1167                     ) = ( 0, 0, 0, 0, 0 );
1168
1169                 }
1170
1171                 if(not $index){
1172                     $index = 'kw';
1173                 }
1174
1175                 # Set default structure attribute (word list)
1176                 my $struct_attr = q{};
1177                 unless ( $indexes_set || !$index || $index =~ /(st-|phr|ext|wrdl|nb|ns)/ ) {
1178                     $struct_attr = ",wrdl";
1179                 }
1180
1181                 # Some helpful index variants
1182                 my $index_plus       = $index . $struct_attr . ':';
1183                 my $index_plus_comma = $index . $struct_attr . ',';
1184
1185                 # Remove Stopwords
1186                 if ($remove_stopwords) {
1187                     ( $operand, $stopwords_removed ) =
1188                       _remove_stopwords( $operand, $index );
1189                     warn "OPERAND w/out STOPWORDS: >$operand<" if $DEBUG;
1190                     warn "REMOVED STOPWORDS: @$stopwords_removed"
1191                       if ( $stopwords_removed && $DEBUG );
1192                 }
1193
1194                 if ($auto_truncation){
1195                                         unless ( $index =~ /(st-|phr|ext)/ ) {
1196                                                 #FIXME only valid with LTR scripts
1197                                                 $operand=join(" ",map{
1198                                                                                         (index($_,"*")>0?"$_":"$_*")
1199                                                                                          }split (/\s+/,$operand));
1200                                                 warn $operand if $DEBUG;
1201                                         }
1202                                 }
1203
1204                 # Detect Truncation
1205                 my $truncated_operand;
1206                 my( $nontruncated, $righttruncated, $lefttruncated,
1207                     $rightlefttruncated, $regexpr
1208                 ) = _detect_truncation( $operand, $index );
1209                 warn
1210 "TRUNCATION: NON:>@$nontruncated< RIGHT:>@$righttruncated< LEFT:>@$lefttruncated< RIGHTLEFT:>@$rightlefttruncated< REGEX:>@$regexpr<"
1211                   if $DEBUG;
1212
1213                 # Apply Truncation
1214                 if (
1215                     scalar(@$righttruncated) + scalar(@$lefttruncated) +
1216                     scalar(@$rightlefttruncated) > 0 )
1217                 {
1218
1219                # Don't field weight or add the index to the query, we do it here
1220                     $indexes_set = 1;
1221                     undef $weight_fields;
1222                     my $previous_truncation_operand;
1223                     if (scalar @$nontruncated) {
1224                         $truncated_operand .= "$index_plus @$nontruncated ";
1225                         $previous_truncation_operand = 1;
1226                     }
1227                     if (scalar @$righttruncated) {
1228                         $truncated_operand .= "and " if $previous_truncation_operand;
1229                         $truncated_operand .= $index_plus_comma . "rtrn:@$righttruncated ";
1230                         $previous_truncation_operand = 1;
1231                     }
1232                     if (scalar @$lefttruncated) {
1233                         $truncated_operand .= "and " if $previous_truncation_operand;
1234                         $truncated_operand .= $index_plus_comma . "ltrn:@$lefttruncated ";
1235                         $previous_truncation_operand = 1;
1236                     }
1237                     if (scalar @$rightlefttruncated) {
1238                         $truncated_operand .= "and " if $previous_truncation_operand;
1239                         $truncated_operand .= $index_plus_comma . "rltrn:@$rightlefttruncated ";
1240                         $previous_truncation_operand = 1;
1241                     }
1242                 }
1243                 $operand = $truncated_operand if $truncated_operand;
1244                 warn "TRUNCATED OPERAND: >$truncated_operand<" if $DEBUG;
1245
1246                 # Handle Stemming
1247                 my $stemmed_operand;
1248                 $stemmed_operand = _build_stemmed_operand($operand, $lang)
1249                                                                                 if $stemming;
1250
1251                 warn "STEMMED OPERAND: >$stemmed_operand<" if $DEBUG;
1252
1253                 # Handle Field Weighting
1254                 my $weighted_operand;
1255                 if ($weight_fields) {
1256                     $weighted_operand = _build_weighted_query( $operand, $stemmed_operand, $index );
1257                     $operand = $weighted_operand;
1258                     $indexes_set = 1;
1259                 }
1260
1261                 warn "FIELD WEIGHTED OPERAND: >$weighted_operand<" if $DEBUG;
1262
1263                 # If there's a previous operand, we need to add an operator
1264                 if ($previous_operand) {
1265
1266                     # User-specified operator
1267                     if ( $operators[ $i - 1 ] ) {
1268                         $query     .= " $operators[$i-1] ";
1269                         $query     .= " $index_plus " unless $indexes_set;
1270                         $query     .= " $operand";
1271                         $query_cgi .= "&op=$operators[$i-1]";
1272                         $query_cgi .= "&idx=$index" if $index;
1273                         $query_cgi .= "&q=$operands[$i]" if $operands[$i];
1274                         $query_desc .=
1275                           " $operators[$i-1] $index_plus $operands[$i]";
1276                     }
1277
1278                     # Default operator is and
1279                     else {
1280                         $query      .= " and ";
1281                         $query      .= "$index_plus " unless $indexes_set;
1282                         $query      .= "$operand";
1283                         $query_cgi  .= "&op=and&idx=$index" if $index;
1284                         $query_cgi  .= "&q=$operands[$i]" if $operands[$i];
1285                         $query_desc .= " and $index_plus $operands[$i]";
1286                     }
1287                 }
1288
1289                 # There isn't a pervious operand, don't need an operator
1290                 else {
1291
1292                     # Field-weighted queries already have indexes set
1293                     $query .= " $index_plus " unless $indexes_set;
1294                     $query .= $operand;
1295                     $query_desc .= " $index_plus $operands[$i]";
1296                     $query_cgi  .= "&idx=$index" if $index;
1297                     $query_cgi  .= "&q=$operands[$i]" if $operands[$i];
1298                     $previous_operand = 1;
1299                 }
1300             }    #/if $operands
1301         }    # /for
1302     }
1303     warn "QUERY BEFORE LIMITS: >$query<" if $DEBUG;
1304
1305     # add limits
1306     my $group_OR_limits;
1307     my $availability_limit;
1308     foreach my $this_limit (@limits) {
1309         if ( $this_limit =~ /available/ ) {
1310 #
1311 ## 'available' is defined as (items.onloan is NULL) and (items.itemlost = 0)
1312 ## In English:
1313 ## all records not indexed in the onloan register (zebra) and all records with a value of lost equal to 0
1314             $availability_limit .=
1315 "( ( allrecords,AlwaysMatches='' not onloan,AlwaysMatches='') and (lost,st-numeric=0) )"; #or ( allrecords,AlwaysMatches='' not lost,AlwaysMatches='')) )";
1316             $limit_cgi  .= "&limit=available";
1317             $limit_desc .= "";
1318         }
1319
1320         # group_OR_limits, prefixed by mc-
1321         # OR every member of the group
1322         elsif ( $this_limit =~ /mc/ ) {
1323
1324             if ( $this_limit =~ /mc-ccode:/ ) {
1325                 # in case the mc-ccode value has complicating chars like ()'s inside it we wrap in quotes
1326                 $this_limit =~ tr/"//d;
1327                 my ($k,$v) = split(/:/, $this_limit,2);
1328                 $this_limit = $k.":\"".$v."\"";
1329             }
1330
1331             $group_OR_limits .= " or " if $group_OR_limits;
1332             $limit_desc      .= " or " if $group_OR_limits;
1333             $group_OR_limits .= "$this_limit";
1334             $limit_cgi       .= "&limit=$this_limit";
1335             $limit_desc      .= " $this_limit";
1336         }
1337
1338         # Regular old limits
1339         else {
1340             $limit .= " and " if $limit || $query;
1341             $limit      .= "$this_limit";
1342             $limit_cgi  .= "&limit=$this_limit";
1343             if ($this_limit =~ /^branch:(.+)/) {
1344                 my $branchcode = $1;
1345                 my $branchname = GetBranchName($branchcode);
1346                 if (defined $branchname) {
1347                     $limit_desc .= " branch:$branchname";
1348                 } else {
1349                     $limit_desc .= " $this_limit";
1350                 }
1351             } else {
1352                 $limit_desc .= " $this_limit";
1353             }
1354         }
1355     }
1356     if ($group_OR_limits) {
1357         $limit .= " and " if ( $query || $limit );
1358         $limit .= "($group_OR_limits)";
1359     }
1360     if ($availability_limit) {
1361         $limit .= " and " if ( $query || $limit );
1362         $limit .= "($availability_limit)";
1363     }
1364
1365     # Normalize the query and limit strings
1366     # This is flawed , means we can't search anything with : in it
1367     # if user wants to do ccl or cql, start the query with that
1368 #    $query =~ s/:/=/g;
1369     $query =~ s/(?<=(ti|au|pb|su|an|kw|mc|nb|ns)):/=/g;
1370     $query =~ s/(?<=(wrdl)):/=/g;
1371     $query =~ s/(?<=(trn|phr)):/=/g;
1372     $limit =~ s/:/=/g;
1373     for ( $query, $query_desc, $limit, $limit_desc ) {
1374         s/  +/ /g;    # remove extra spaces
1375         s/^ //g;     # remove any beginning spaces
1376         s/ $//g;     # remove any ending spaces
1377         s/==/=/g;    # remove double == from query
1378     }
1379     $query_cgi =~ s/^&//; # remove unnecessary & from beginning of the query cgi
1380
1381     for ($query_cgi,$simple_query) {
1382         s/"//g;
1383     }
1384     # append the limit to the query
1385     $query .= " " . $limit;
1386
1387     # Warnings if DEBUG
1388     if ($DEBUG) {
1389         warn "QUERY:" . $query;
1390         warn "QUERY CGI:" . $query_cgi;
1391         warn "QUERY DESC:" . $query_desc;
1392         warn "LIMIT:" . $limit;
1393         warn "LIMIT CGI:" . $limit_cgi;
1394         warn "LIMIT DESC:" . $limit_desc;
1395         warn "---------\nLeave buildQuery\n---------";
1396     }
1397     return (
1398         undef,              $query, $simple_query, $query_cgi,
1399         $query_desc,        $limit, $limit_cgi,    $limit_desc,
1400         $stopwords_removed, $query_type
1401     );
1402 }
1403
1404 =head2 searchResults
1405
1406   my @search_results = searchResults($search_context, $searchdesc, $hits,
1407                                      $results_per_page, $offset, $scan,
1408                                      @marcresults, $hidelostitems);
1409
1410 Format results in a form suitable for passing to the template
1411
1412 =cut
1413
1414 # IMO this subroutine is pretty messy still -- it's responsible for
1415 # building the HTML output for the template
1416 sub searchResults {
1417     my ( $search_context, $searchdesc, $hits, $results_per_page, $offset, $scan, @marcresults, $hidelostitems ) = @_;
1418     my $dbh = C4::Context->dbh;
1419     my @newresults;
1420
1421     $search_context = 'opac' unless $search_context eq 'opac' or $search_context eq 'intranet';
1422
1423     #Build branchnames hash
1424     #find branchname
1425     #get branch information.....
1426     my %branches;
1427     my $bsth =$dbh->prepare("SELECT branchcode,branchname FROM branches"); # FIXME : use C4::Branch::GetBranches
1428     $bsth->execute();
1429     while ( my $bdata = $bsth->fetchrow_hashref ) {
1430         $branches{ $bdata->{'branchcode'} } = $bdata->{'branchname'};
1431     }
1432 # FIXME - We build an authorised values hash here, using the default framework
1433 # though it is possible to have different authvals for different fws.
1434
1435     my $shelflocations =GetKohaAuthorisedValues('items.location','');
1436
1437     # get notforloan authorised value list (see $shelflocations  FIXME)
1438     my $notforloan_authorised_value = GetAuthValCode('items.notforloan','');
1439
1440     #Build itemtype hash
1441     #find itemtype & itemtype image
1442     my %itemtypes;
1443     $bsth =
1444       $dbh->prepare(
1445         "SELECT itemtype,description,imageurl,summary,notforloan FROM itemtypes"
1446       );
1447     $bsth->execute();
1448     while ( my $bdata = $bsth->fetchrow_hashref ) {
1449                 foreach (qw(description imageurl summary notforloan)) {
1450                 $itemtypes{ $bdata->{'itemtype'} }->{$_} = $bdata->{$_};
1451                 }
1452     }
1453
1454     #search item field code
1455     my $sth =
1456       $dbh->prepare(
1457 "SELECT tagfield FROM marc_subfield_structure WHERE kohafield LIKE 'items.itemnumber'"
1458       );
1459     $sth->execute;
1460     my ($itemtag) = $sth->fetchrow;
1461
1462     ## find column names of items related to MARC
1463     my $sth2 = $dbh->prepare("SHOW COLUMNS FROM items");
1464     $sth2->execute;
1465     my %subfieldstosearch;
1466     while ( ( my $column ) = $sth2->fetchrow ) {
1467         my ( $tagfield, $tagsubfield ) =
1468           &GetMarcFromKohaField( "items." . $column, "" );
1469         $subfieldstosearch{$column} = $tagsubfield;
1470     }
1471
1472     # handle which records to actually retrieve
1473     my $times;
1474     if ( $hits && $offset + $results_per_page <= $hits ) {
1475         $times = $offset + $results_per_page;
1476     }
1477     else {
1478         $times = $hits;  # FIXME: if $hits is undefined, why do we want to equal it?
1479     }
1480
1481         my $marcflavour = C4::Context->preference("marcflavour");
1482     # We get the biblionumber position in MARC
1483     my ($bibliotag,$bibliosubf)=GetMarcFromKohaField('biblio.biblionumber','');
1484     my $fw;
1485
1486     # loop through all of the records we've retrieved
1487     for ( my $i = $offset ; $i <= $times - 1 ; $i++ ) {
1488         my $marcrecord = MARC::File::USMARC::decode( $marcresults[$i] );
1489         $fw = $scan
1490              ? undef
1491              : $bibliotag < 10
1492                ? GetFrameworkCode($marcrecord->field($bibliotag)->data)
1493                : GetFrameworkCode($marcrecord->subfield($bibliotag,$bibliosubf));
1494         my $oldbiblio = TransformMarcToKoha( $dbh, $marcrecord, $fw );
1495         $oldbiblio->{subtitle} = GetRecordValue('subtitle', $marcrecord, $fw);
1496         $oldbiblio->{result_number} = $i + 1;
1497
1498         # add imageurl to itemtype if there is one
1499         $oldbiblio->{imageurl} = getitemtypeimagelocation( $search_context, $itemtypes{ $oldbiblio->{itemtype} }->{imageurl} );
1500
1501         $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 ) ) : [];
1502                 $oldbiblio->{normalized_upc}  = GetNormalizedUPC(       $marcrecord,$marcflavour);
1503                 $oldbiblio->{normalized_ean}  = GetNormalizedEAN(       $marcrecord,$marcflavour);
1504                 $oldbiblio->{normalized_oclc} = GetNormalizedOCLCNumber($marcrecord,$marcflavour);
1505                 $oldbiblio->{normalized_isbn} = GetNormalizedISBN(undef,$marcrecord,$marcflavour);
1506                 $oldbiblio->{content_identifier_exists} = 1 if ($oldbiblio->{normalized_isbn} or $oldbiblio->{normalized_oclc} or $oldbiblio->{normalized_ean} or $oldbiblio->{normalized_upc});
1507
1508                 # edition information, if any
1509         $oldbiblio->{edition} = $oldbiblio->{editionstatement};
1510                 $oldbiblio->{description} = $itemtypes{ $oldbiblio->{itemtype} }->{description};
1511  # Build summary if there is one (the summary is defined in the itemtypes table)
1512  # FIXME: is this used anywhere, I think it can be commented out? -- JF
1513         if ( $itemtypes{ $oldbiblio->{itemtype} }->{summary} ) {
1514             my $summary = $itemtypes{ $oldbiblio->{itemtype} }->{summary};
1515             my @fields  = $marcrecord->fields();
1516
1517             my $newsummary;
1518             foreach my $line ( "$summary\n" =~ /(.*)\n/g ){
1519                 my $tags = {};
1520                 foreach my $tag ( $line =~ /\[(\d{3}[\w|\d])\]/ ) {
1521                     $tag =~ /(.{3})(.)/;
1522                     if($marcrecord->field($1)){
1523                         my @abc = $marcrecord->field($1)->subfield($2);
1524                         $tags->{$tag} = $#abc + 1 ;
1525                     }
1526                 }
1527
1528                 # We catch how many times to repeat this line
1529                 my $max = 0;
1530                 foreach my $tag (keys(%$tags)){
1531                     $max = $tags->{$tag} if($tags->{$tag} > $max);
1532                  }
1533
1534                 # we replace, and repeat each line
1535                 for (my $i = 0 ; $i < $max ; $i++){
1536                     my $newline = $line;
1537
1538                     foreach my $tag ( $newline =~ /\[(\d{3}[\w|\d])\]/g ) {
1539                         $tag =~ /(.{3})(.)/;
1540
1541                         if($marcrecord->field($1)){
1542                             my @repl = $marcrecord->field($1)->subfield($2);
1543                             my $subfieldvalue = $repl[$i];
1544
1545                             if (! utf8::is_utf8($subfieldvalue)) {
1546                                 utf8::decode($subfieldvalue);
1547                             }
1548
1549                              $newline =~ s/\[$tag\]/$subfieldvalue/g;
1550                         }
1551                     }
1552                     $newsummary .= "$newline\n";
1553                 }
1554             }
1555
1556             $newsummary =~ s/\[(.*?)]//g;
1557             $newsummary =~ s/\n/<br\/>/g;
1558             $oldbiblio->{summary} = $newsummary;
1559         }
1560
1561         # Pull out the items fields
1562         my @fields = $marcrecord->field($itemtag);
1563
1564         # Setting item statuses for display
1565         my @available_items_loop;
1566         my @onloan_items_loop;
1567         my @other_items_loop;
1568
1569         my $available_items;
1570         my $onloan_items;
1571         my $other_items;
1572
1573         my $ordered_count         = 0;
1574         my $available_count       = 0;
1575         my $onloan_count          = 0;
1576         my $longoverdue_count     = 0;
1577         my $other_count           = 0;
1578         my $wthdrawn_count        = 0;
1579         my $itemlost_count        = 0;
1580         my $itembinding_count     = 0;
1581         my $itemdamaged_count     = 0;
1582         my $item_in_transit_count = 0;
1583         my $can_place_holds       = 0;
1584         my $item_onhold_count     = 0;
1585         my $items_count           = scalar(@fields);
1586         my $maxitems =
1587           ( C4::Context->preference('maxItemsinSearchResults') )
1588           ? C4::Context->preference('maxItemsinSearchResults') - 1
1589           : 1;
1590
1591         # loop through every item
1592         foreach my $field (@fields) {
1593             my $item;
1594
1595             # populate the items hash
1596             foreach my $code ( keys %subfieldstosearch ) {
1597                 $item->{$code} = $field->subfield( $subfieldstosearch{$code} );
1598             }
1599
1600                 # Hidden items
1601                 my @items = ($item);
1602                 my (@hiddenitems) = GetHiddenItemnumbers(@items);
1603             $item->{'hideatopac'} = 1 if (@hiddenitems);
1604
1605             my $hbranch     = C4::Context->preference('HomeOrHoldingBranch') eq 'homebranch' ? 'homebranch'    : 'holdingbranch';
1606             my $otherbranch = C4::Context->preference('HomeOrHoldingBranch') eq 'homebranch' ? 'holdingbranch' : 'homebranch';
1607
1608             # set item's branch name, use HomeOrHoldingBranch syspref first, fall back to the other one
1609             if ($item->{$hbranch}) {
1610                 $item->{'branchname'} = $branches{$item->{$hbranch}};
1611             }
1612             elsif ($item->{$otherbranch}) {     # Last resort
1613                 $item->{'branchname'} = $branches{$item->{$otherbranch}};
1614             }
1615
1616                         my $prefix = $item->{$hbranch} . '--' . $item->{location} . $item->{itype} . $item->{itemcallnumber};
1617 # For each grouping of items (onloan, available, unavailable), we build a key to store relevant info about that item
1618             my $userenv = C4::Context->userenv;
1619             if ( $item->{onloan} && !(C4::Members::GetHideLostItemsPreference($userenv->{'number'}) && $item->{itemlost}) ) {
1620                 $onloan_count++;
1621                                 my $key = $prefix . $item->{onloan} . $item->{barcode};
1622                                 $onloan_items->{$key}->{due_date} = format_date($item->{onloan});
1623                                 $onloan_items->{$key}->{count}++ if $item->{$hbranch};
1624                                 $onloan_items->{$key}->{branchname} = $item->{branchname};
1625                                 $onloan_items->{$key}->{location} = $shelflocations->{ $item->{location} };
1626                                 $onloan_items->{$key}->{itemcallnumber} = $item->{itemcallnumber};
1627                                 $onloan_items->{$key}->{imageurl} = getitemtypeimagelocation( $search_context, $itemtypes{ $item->{itype} }->{imageurl} );
1628                 # if something's checked out and lost, mark it as 'long overdue'
1629                 if ( $item->{itemlost} ) {
1630                     $onloan_items->{$prefix}->{longoverdue}++;
1631                     $longoverdue_count++;
1632                 } else {        # can place holds as long as item isn't lost
1633                     $can_place_holds = 1;
1634                 }
1635             }
1636
1637          # items not on loan, but still unavailable ( lost, withdrawn, damaged )
1638             else {
1639
1640                 # item is on order
1641                 if ( $item->{notforloan} == -1 ) {
1642                     $ordered_count++;
1643                 }
1644
1645                 # is item in transit?
1646                 my $transfertwhen = '';
1647                 my ($transfertfrom, $transfertto);
1648
1649                 # is item on the reserve shelf?
1650                 my $reservestatus = 0;
1651                 my $reserveitem;
1652
1653                 unless ($item->{wthdrawn}
1654                         || $item->{itemlost}
1655                         || $item->{damaged}
1656                         || $item->{notforloan}
1657                         || $items_count > 20) {
1658
1659                     # A couple heuristics to limit how many times
1660                     # we query the database for item transfer information, sacrificing
1661                     # accuracy in some cases for speed;
1662                     #
1663                     # 1. don't query if item has one of the other statuses
1664                     # 2. don't check transit status if the bib has
1665                     #    more than 20 items
1666                     #
1667                     # FIXME: to avoid having the query the database like this, and to make
1668                     #        the in transit status count as unavailable for search limiting,
1669                     #        should map transit status to record indexed in Zebra.
1670                     #
1671                     ($transfertwhen, $transfertfrom, $transfertto) = C4::Circulation::GetTransfers($item->{itemnumber});
1672                     ($reservestatus, $reserveitem) = C4::Reserves::CheckReserves($item->{itemnumber});
1673                 }
1674
1675                 # item is withdrawn, lost, damaged, not for loan, reserved or in transit
1676                 if (   $item->{wthdrawn}
1677                     || $item->{itemlost}
1678                     || $item->{damaged}
1679                     || $item->{notforloan} > 0
1680                     || $item->{hideatopac}
1681                     || $reservestatus eq 'Waiting'
1682                     || ($transfertwhen ne ''))
1683                 {
1684                     $wthdrawn_count++        if $item->{wthdrawn};
1685                     $itemlost_count++        if $item->{itemlost};
1686                     $itemdamaged_count++     if $item->{damaged};
1687                     $item_in_transit_count++ if $transfertwhen ne '';
1688                     $item_onhold_count++     if $reservestatus eq 'Waiting';
1689                     $item->{status} = $item->{wthdrawn} . "-" . $item->{itemlost} . "-" . $item->{damaged} . "-" . $item->{notforloan};
1690
1691                     # can place hold on item ?
1692                     if ((!$item->{damaged} || C4::Context->preference('AllowHoldsOnDamagedItems'))
1693                       && !$item->{itemlost}
1694                       && !$item->{withdrawn}
1695                     ) {
1696                         $can_place_holds = 1;
1697                     }
1698
1699                     $other_count++;
1700
1701                     my $key = $prefix . $item->{status};
1702                     foreach (qw(wthdrawn itemlost damaged branchname itemcallnumber hideatopac)) {
1703                         $other_items->{$key}->{$_} = $item->{$_};
1704                     }
1705                     $other_items->{$key}->{intransit} = ( $transfertwhen ne '' ) ? 1 : 0;
1706                     $other_items->{$key}->{onhold} = ($reservestatus) ? 1 : 0;
1707                                         $other_items->{$key}->{notforloan} = GetAuthorisedValueDesc('','',$item->{notforloan},'','',$notforloan_authorised_value) if $notforloan_authorised_value;
1708                                         $other_items->{$key}->{count}++ if $item->{$hbranch};
1709                                         $other_items->{$key}->{location} = $shelflocations->{ $item->{location} };
1710                                         $other_items->{$key}->{imageurl} = getitemtypeimagelocation( $search_context, $itemtypes{ $item->{itype} }->{imageurl} );
1711                 }
1712                 # item is available
1713                 else {
1714                     $can_place_holds = 1;
1715                     $available_count++;
1716                                         $available_items->{$prefix}->{count}++ if $item->{$hbranch};
1717                                         foreach (qw(branchname itemcallnumber hideatopac)) {
1718                         $available_items->{$prefix}->{$_} = $item->{$_};
1719                                         }
1720                                         $available_items->{$prefix}->{location} = $shelflocations->{ $item->{location} };
1721                                         $available_items->{$prefix}->{imageurl} = getitemtypeimagelocation( $search_context, $itemtypes{ $item->{itype} }->{imageurl} );
1722                 }
1723             }
1724         }    # notforloan, item level and biblioitem level
1725         my ( $availableitemscount, $onloanitemscount, $otheritemscount );
1726         $maxitems =
1727           ( C4::Context->preference('maxItemsinSearchResults') )
1728           ? C4::Context->preference('maxItemsinSearchResults') - 1
1729           : 1;
1730         for my $key ( sort keys %$onloan_items ) {
1731             (++$onloanitemscount > $maxitems) and last;
1732             push @onloan_items_loop, $onloan_items->{$key};
1733         }
1734         for my $key ( sort keys %$other_items ) {
1735             (++$otheritemscount > $maxitems) and last;
1736             push @other_items_loop, $other_items->{$key};
1737         }
1738         for my $key ( sort keys %$available_items ) {
1739             (++$availableitemscount > $maxitems) and last;
1740             push @available_items_loop, $available_items->{$key}
1741         }
1742
1743         # XSLT processing of some stuff
1744         use C4::Charset;
1745         SetUTF8Flag($marcrecord);
1746         $debug && warn $marcrecord->as_formatted;
1747         if (!$scan && $search_context eq 'opac' && C4::Context->preference("OPACXSLTResultsDisplay")) {
1748             # FIXME note that XSLTResultsDisplay (use of XSLT to format staff interface bib search results)
1749             # is not implemented yet
1750             $oldbiblio->{XSLTResultsRecord} = XSLTParse4Display($oldbiblio->{biblionumber}, $marcrecord, 'Results',
1751                                                                 $search_context, 1);
1752                 # the last parameter tells Koha to clean up the problematic ampersand entities that Zebra outputs
1753
1754         }
1755
1756         # if biblio level itypes are used and itemtype is notforloan, it can't be reserved either
1757         if (!C4::Context->preference("item-level_itypes")) {
1758             if ($itemtypes{ $oldbiblio->{itemtype} }->{notforloan}) {
1759                 $can_place_holds = 0;
1760             }
1761         }
1762         $oldbiblio->{norequests} = 1 unless $can_place_holds;
1763         $oldbiblio->{itemsplural}          = 1 if $items_count > 1;
1764         $oldbiblio->{items_count}          = $items_count;
1765         $oldbiblio->{available_items_loop} = \@available_items_loop;
1766         $oldbiblio->{onloan_items_loop}    = \@onloan_items_loop;
1767         $oldbiblio->{other_items_loop}     = \@other_items_loop;
1768         $oldbiblio->{availablecount}       = $available_count;
1769         $oldbiblio->{availableplural}      = 1 if $available_count > 1;
1770         $oldbiblio->{onloancount}          = $onloan_count;
1771         $oldbiblio->{onloanplural}         = 1 if $onloan_count > 1;
1772         $oldbiblio->{othercount}           = $other_count;
1773         $oldbiblio->{otherplural}          = 1 if $other_count > 1;
1774         $oldbiblio->{wthdrawncount}        = $wthdrawn_count;
1775         $oldbiblio->{itemlostcount}        = $itemlost_count;
1776         $oldbiblio->{damagedcount}         = $itemdamaged_count;
1777         $oldbiblio->{intransitcount}       = $item_in_transit_count;
1778         $oldbiblio->{onholdcount}          = $item_onhold_count;
1779         $oldbiblio->{orderedcount}         = $ordered_count;
1780         $oldbiblio->{isbn} =~
1781           s/-//g;    # deleting - in isbn to enable amazon content
1782
1783         if (C4::Context->preference("AlternateHoldingsField") && $items_count == 0) {
1784             my $fieldspec = C4::Context->preference("AlternateHoldingsField");
1785             my $subfields = substr $fieldspec, 3;
1786             my $holdingsep = C4::Context->preference("AlternateHoldingsSeparator") || ' ';
1787             my @alternateholdingsinfo = ();
1788             my @holdingsfields = $marcrecord->field(substr $fieldspec, 0, 3);
1789             my $alternateholdingscount = 0;
1790
1791             for my $field (@holdingsfields) {
1792                 my %holding = ( holding => '' );
1793                 my $havesubfield = 0;
1794                 for my $subfield ($field->subfields()) {
1795                     if ((index $subfields, $$subfield[0]) >= 0) {
1796                         $holding{'holding'} .= $holdingsep if (length $holding{'holding'} > 0);
1797                         $holding{'holding'} .= $$subfield[1];
1798                         $havesubfield++;
1799                     }
1800                 }
1801                 if ($havesubfield) {
1802                     push(@alternateholdingsinfo, \%holding);
1803                     $alternateholdingscount++;
1804                 }
1805             }
1806
1807             $oldbiblio->{'ALTERNATEHOLDINGS'} = \@alternateholdingsinfo;
1808             $oldbiblio->{'alternateholdings_count'} = $alternateholdingscount;
1809         }
1810
1811         push( @newresults, $oldbiblio )
1812             if(not $hidelostitems
1813                or (($items_count > $itemlost_count )
1814                     && $hidelostitems));
1815     }
1816
1817     return @newresults;
1818 }
1819
1820 =head2 SearchAcquisitions
1821     Search for acquisitions
1822 =cut
1823
1824 sub SearchAcquisitions{
1825     my ($datebegin, $dateend, $itemtypes,$criteria, $orderby) = @_;
1826
1827     my $dbh=C4::Context->dbh;
1828     # Variable initialization
1829     my $str=qq|
1830     SELECT marcxml
1831     FROM biblio
1832     LEFT JOIN biblioitems ON biblioitems.biblionumber=biblio.biblionumber
1833     LEFT JOIN items ON items.biblionumber=biblio.biblionumber
1834     WHERE dateaccessioned BETWEEN ? AND ?
1835     |;
1836
1837     my (@params,@loopcriteria);
1838
1839     push @params, $datebegin->output("iso");
1840     push @params, $dateend->output("iso");
1841
1842     if (scalar(@$itemtypes)>0 and $criteria ne "itemtype" ){
1843         if(C4::Context->preference("item-level_itypes")){
1844             $str .= "AND items.itype IN (?".( ',?' x scalar @$itemtypes - 1 ).") ";
1845         }else{
1846             $str .= "AND biblioitems.itemtype IN (?".( ',?' x scalar @$itemtypes - 1 ).") ";
1847         }
1848         push @params, @$itemtypes;
1849     }
1850
1851     if ($criteria =~/itemtype/){
1852         if(C4::Context->preference("item-level_itypes")){
1853             $str .= "AND items.itype=? ";
1854         }else{
1855             $str .= "AND biblioitems.itemtype=? ";
1856         }
1857
1858         if(scalar(@$itemtypes) == 0){
1859             my $itypes = GetItemTypes();
1860             for my $key (keys %$itypes){
1861                 push @$itemtypes, $key;
1862             }
1863         }
1864
1865         @loopcriteria= @$itemtypes;
1866     }elsif ($criteria=~/itemcallnumber/){
1867         $str .= "AND (items.itemcallnumber LIKE CONCAT(?,'%')
1868                  OR items.itemcallnumber is NULL
1869                  OR items.itemcallnumber = '')";
1870
1871         @loopcriteria = ("AA".."ZZ", "") unless (scalar(@loopcriteria)>0);
1872     }else {
1873         $str .= "AND biblio.title LIKE CONCAT(?,'%') ";
1874         @loopcriteria = ("A".."z") unless (scalar(@loopcriteria)>0);
1875     }
1876
1877     if ($orderby =~ /date_desc/){
1878         $str.=" ORDER BY dateaccessioned DESC";
1879     } else {
1880         $str.=" ORDER BY title";
1881     }
1882
1883     my $qdataacquisitions=$dbh->prepare($str);
1884
1885     my @loopacquisitions;
1886     foreach my $value(@loopcriteria){
1887         push @params,$value;
1888         my %cell;
1889         $cell{"title"}=$value;
1890         $cell{"titlecode"}=$value;
1891
1892         eval{$qdataacquisitions->execute(@params);};
1893
1894         if ($@){ warn "recentacquisitions Error :$@";}
1895         else {
1896             my @loopdata;
1897             while (my $data=$qdataacquisitions->fetchrow_hashref){
1898                 push @loopdata, {"summary"=>GetBiblioSummary( $data->{'marcxml'} ) };
1899             }
1900             $cell{"loopdata"}=\@loopdata;
1901         }
1902         push @loopacquisitions,\%cell if (scalar(@{$cell{loopdata}})>0);
1903         pop @params;
1904     }
1905     $qdataacquisitions->finish;
1906     return \@loopacquisitions;
1907 }
1908 #----------------------------------------------------------------------
1909 #
1910 # Non-Zebra GetRecords#
1911 #----------------------------------------------------------------------
1912
1913 =head2 NZgetRecords
1914
1915   NZgetRecords has the same API as zera getRecords, even if some parameters are not managed
1916
1917 =cut
1918
1919 sub NZgetRecords {
1920     my (
1921         $query,            $simple_query, $sort_by_ref,    $servers_ref,
1922         $results_per_page, $offset,       $expanded_facet, $branches,
1923         $query_type,       $scan
1924     ) = @_;
1925     warn "query =$query" if $DEBUG;
1926     my $result = NZanalyse($query);
1927     warn "results =$result" if $DEBUG;
1928     return ( undef,
1929         NZorder( $result, @$sort_by_ref[0], $results_per_page, $offset ),
1930         undef );
1931 }
1932
1933 =head2 NZanalyse
1934
1935   NZanalyse : get a CQL string as parameter, and returns a list of biblionumber;title,biblionumber;title,...
1936   the list is built from an inverted index in the nozebra SQL table
1937   note that title is here only for convenience : the sorting will be very fast when requested on title
1938   if the sorting is requested on something else, we will have to reread all results, and that may be longer.
1939
1940 =cut
1941
1942 sub NZanalyse {
1943     my ( $string, $server ) = @_;
1944 #     warn "---------"       if $DEBUG;
1945     warn " NZanalyse" if $DEBUG;
1946 #     warn "---------"       if $DEBUG;
1947
1948  # $server contains biblioserver or authorities, depending on what we search on.
1949  #warn "querying : $string on $server";
1950     $server = 'biblioserver' unless $server;
1951
1952 # if we have a ", replace the content to discard temporarily any and/or/not inside
1953     my $commacontent;
1954     if ( $string =~ /"/ ) {
1955         $string =~ s/"(.*?)"/__X__/;
1956         $commacontent = $1;
1957         warn "commacontent : $commacontent" if $DEBUG;
1958     }
1959
1960 # split the query string in 3 parts : X AND Y means : $left="X", $operand="AND" and $right="Y"
1961 # then, call again NZanalyse with $left and $right
1962 # (recursive until we find a leaf (=> something without and/or/not)
1963 # delete repeated operator... Would then go in infinite loop
1964     while ( $string =~ s/( and| or| not| AND| OR| NOT)\1/$1/g ) {
1965     }
1966
1967     #process parenthesis before.
1968     if ( $string =~ /^\s*\((.*)\)(( and | or | not | AND | OR | NOT )(.*))?/ ) {
1969         my $left     = $1;
1970         my $right    = $4;
1971         my $operator = lc($3);   # FIXME: and/or/not are operators, not operands
1972         warn
1973 "dealing w/parenthesis before recursive sub call. left :$left operator:$operator right:$right"
1974           if $DEBUG;
1975         my $leftresult = NZanalyse( $left, $server );
1976         if ($operator) {
1977             my $rightresult = NZanalyse( $right, $server );
1978
1979             # OK, we have the results for right and left part of the query
1980             # depending of operand, intersect, union or exclude both lists
1981             # to get a result list
1982             if ( $operator eq ' and ' ) {
1983                 return NZoperatorAND($leftresult,$rightresult);
1984             }
1985             elsif ( $operator eq ' or ' ) {
1986
1987                 # just merge the 2 strings
1988                 return $leftresult . $rightresult;
1989             }
1990             elsif ( $operator eq ' not ' ) {
1991                 return NZoperatorNOT($leftresult,$rightresult);
1992             }
1993         }
1994         else {
1995 # this error is impossible, because of the regexp that isolate the operand, but just in case...
1996             return $leftresult;
1997         }
1998     }
1999     warn "string :" . $string if $DEBUG;
2000     my $left = "";
2001     my $right = "";
2002     my $operator = "";
2003     if ($string =~ /(.*?)( and | or | not | AND | OR | NOT )(.*)/) {
2004         $left     = $1;
2005         $right    = $3;
2006         $operator = lc($2);    # FIXME: and/or/not are operators, not operands
2007     }
2008     warn "no parenthesis. left : $left operator: $operator right: $right"
2009       if $DEBUG;
2010
2011     # it's not a leaf, we have a and/or/not
2012     if ($operator) {
2013
2014         # reintroduce comma content if needed
2015         $right =~ s/__X__/"$commacontent"/ if $commacontent;
2016         $left  =~ s/__X__/"$commacontent"/ if $commacontent;
2017         warn "node : $left / $operator / $right\n" if $DEBUG;
2018         my $leftresult  = NZanalyse( $left,  $server );
2019         my $rightresult = NZanalyse( $right, $server );
2020         warn " leftresult : $leftresult" if $DEBUG;
2021         warn " rightresult : $rightresult" if $DEBUG;
2022         # OK, we have the results for right and left part of the query
2023         # depending of operand, intersect, union or exclude both lists
2024         # to get a result list
2025         if ( $operator eq ' and ' ) {
2026             return NZoperatorAND($leftresult,$rightresult);
2027         }
2028         elsif ( $operator eq ' or ' ) {
2029
2030             # just merge the 2 strings
2031             return $leftresult . $rightresult;
2032         }
2033         elsif ( $operator eq ' not ' ) {
2034             return NZoperatorNOT($leftresult,$rightresult);
2035         }
2036         else {
2037
2038 # this error is impossible, because of the regexp that isolate the operand, but just in case...
2039             die "error : operand unknown : $operator for $string";
2040         }
2041
2042         # it's a leaf, do the real SQL query and return the result
2043     }
2044     else {
2045         $string =~ s/__X__/"$commacontent"/ if $commacontent;
2046         $string =~ s/-|\.|\?|,|;|!|'|\(|\)|\[|\]|{|}|"|&|\+|\*|\// /g;
2047         #remove trailing blank at the beginning
2048         $string =~ s/^ //g;
2049         warn "leaf:$string" if $DEBUG;
2050
2051         # parse the string in in operator/operand/value again
2052         my $left = "";
2053         my $operator = "";
2054         my $right = "";
2055         if ($string =~ /(.*)(>=|<=)(.*)/) {
2056             $left     = $1;
2057             $operator = $2;
2058             $right    = $3;
2059         } else {
2060             $left = $string;
2061         }
2062 #         warn "handling leaf... left:$left operator:$operator right:$right"
2063 #           if $DEBUG;
2064         unless ($operator) {
2065             if ($string =~ /(.*)(>|<|=)(.*)/) {
2066                 $left     = $1;
2067                 $operator = $2;
2068                 $right    = $3;
2069                 warn
2070     "handling unless (operator)... left:$left operator:$operator right:$right"
2071                 if $DEBUG;
2072             } else {
2073                 $left = $string;
2074             }
2075         }
2076         my $results;
2077
2078 # strip adv, zebra keywords, currently not handled in nozebra: wrdl, ext, phr...
2079         $left =~ s/ .*$//;
2080
2081         # automatic replace for short operators
2082         $left = 'title'            if $left =~ '^ti$';
2083         $left = 'author'           if $left =~ '^au$';
2084         $left = 'publisher'        if $left =~ '^pb$';
2085         $left = 'subject'          if $left =~ '^su$';
2086         $left = 'koha-Auth-Number' if $left =~ '^an$';
2087         $left = 'keyword'          if $left =~ '^kw$';
2088         $left = 'itemtype'         if $left =~ '^mc$'; # Fix for Bug 2599 - Search limits not working for NoZebra
2089         warn "handling leaf... left:$left operator:$operator right:$right" if $DEBUG;
2090         my $dbh = C4::Context->dbh;
2091         if ( $operator && $left ne 'keyword' ) {
2092             #do a specific search
2093             $operator = 'LIKE' if $operator eq '=' and $right =~ /%/;
2094             my $sth = $dbh->prepare(
2095 "SELECT biblionumbers,value FROM nozebra WHERE server=? AND indexname=? AND value $operator ?"
2096             );
2097             warn "$left / $operator / $right\n" if $DEBUG;
2098
2099             # split each word, query the DB and build the biblionumbers result
2100             #sanitizing leftpart
2101             $left =~ s/^\s+|\s+$//;
2102             foreach ( split / /, $right ) {
2103                 my $biblionumbers;
2104                 $_ =~ s/^\s+|\s+$//;
2105                 next unless $_;
2106                 warn "EXECUTE : $server, $left, $_" if $DEBUG;
2107                 $sth->execute( $server, $left, $_ )
2108                   or warn "execute failed: $!";
2109                 while ( my ( $line, $value ) = $sth->fetchrow ) {
2110
2111 # if we are dealing with a numeric value, use only numeric results (in case of >=, <=, > or <)
2112 # otherwise, fill the result
2113                     $biblionumbers .= $line
2114                       unless ( $right =~ /^\d+$/ && $value =~ /\D/ );
2115                     warn "result : $value "
2116                       . ( $right  =~ /\d/ ) . "=="
2117                       . ( $value =~ /\D/?$line:"" ) if $DEBUG;         #= $line";
2118                 }
2119
2120 # do a AND with existing list if there is one, otherwise, use the biblionumbers list as 1st result list
2121                 if ($results) {
2122                     warn "NZAND" if $DEBUG;
2123                     $results = NZoperatorAND($biblionumbers,$results);
2124                 } else {
2125                     $results = $biblionumbers;
2126                 }
2127             }
2128         }
2129         else {
2130       #do a complete search (all indexes), if index='kw' do complete search too.
2131             my $sth = $dbh->prepare(
2132 "SELECT biblionumbers FROM nozebra WHERE server=? AND value LIKE ?"
2133             );
2134
2135             # split each word, query the DB and build the biblionumbers result
2136             foreach ( split / /, $string ) {
2137                 next if C4::Context->stopwords->{ uc($_) };   # skip if stopword
2138                 warn "search on all indexes on $_" if $DEBUG;
2139                 my $biblionumbers;
2140                 next unless $_;
2141                 $sth->execute( $server, $_ );
2142                 while ( my $line = $sth->fetchrow ) {
2143                     $biblionumbers .= $line;
2144                 }
2145
2146 # do a AND with existing list if there is one, otherwise, use the biblionumbers list as 1st result list
2147                 if ($results) {
2148                     $results = NZoperatorAND($biblionumbers,$results);
2149                 }
2150                 else {
2151                     warn "NEW RES for $_ = $biblionumbers" if $DEBUG;
2152                     $results = $biblionumbers;
2153                 }
2154             }
2155         }
2156         warn "return : $results for LEAF : $string" if $DEBUG;
2157         return $results;
2158     }
2159     warn "---------\nLeave NZanalyse\n---------" if $DEBUG;
2160 }
2161
2162 sub NZoperatorAND{
2163     my ($rightresult, $leftresult)=@_;
2164
2165     my @leftresult = split /;/, $leftresult;
2166     warn " @leftresult / $rightresult \n" if $DEBUG;
2167
2168     #             my @rightresult = split /;/,$leftresult;
2169     my $finalresult;
2170
2171 # parse the left results, and if the biblionumber exist in the right result, save it in finalresult
2172 # the result is stored twice, to have the same weight for AND than OR.
2173 # example : TWO : 61,61,64,121 (two is twice in the biblio #61) / TOWER : 61,64,130
2174 # result : 61,61,61,61,64,64 for two AND tower : 61 has more weight than 64
2175     foreach (@leftresult) {
2176         my $value = $_;
2177         my $countvalue;
2178         ( $value, $countvalue ) = ( $1, $2 ) if ($value=~/(.*)-(\d+)$/);
2179         if ( $rightresult =~ /\Q$value\E-(\d+);/ ) {
2180             $countvalue = ( $1 > $countvalue ? $countvalue : $1 );
2181             $finalresult .=
2182                 "$value-$countvalue;$value-$countvalue;";
2183         }
2184     }
2185     warn "NZAND DONE : $finalresult \n" if $DEBUG;
2186     return $finalresult;
2187 }
2188
2189 sub NZoperatorOR{
2190     my ($rightresult, $leftresult)=@_;
2191     return $rightresult.$leftresult;
2192 }
2193
2194 sub NZoperatorNOT{
2195     my ($leftresult, $rightresult)=@_;
2196
2197     my @leftresult = split /;/, $leftresult;
2198
2199     #             my @rightresult = split /;/,$leftresult;
2200     my $finalresult;
2201     foreach (@leftresult) {
2202         my $value=$_;
2203         $value=$1 if $value=~m/(.*)-\d+$/;
2204         unless ($rightresult =~ "$value-") {
2205             $finalresult .= "$_;";
2206         }
2207     }
2208     return $finalresult;
2209 }
2210
2211 =head2 NZorder
2212
2213   $finalresult = NZorder($biblionumbers, $ordering,$results_per_page,$offset);
2214
2215   TODO :: Description
2216
2217 =cut
2218
2219 sub NZorder {
2220     my ( $biblionumbers, $ordering, $results_per_page, $offset ) = @_;
2221     warn "biblionumbers = $biblionumbers and ordering = $ordering\n" if $DEBUG;
2222
2223     # order title asc by default
2224     #     $ordering = '1=36 <i' unless $ordering;
2225     $results_per_page = 20 unless $results_per_page;
2226     $offset           = 0  unless $offset;
2227     my $dbh = C4::Context->dbh;
2228
2229     #
2230     # order by POPULARITY
2231     #
2232     if ( $ordering =~ /popularity/ ) {
2233         my %result;
2234         my %popularity;
2235
2236         # popularity is not in MARC record, it's builded from a specific query
2237         my $sth =
2238           $dbh->prepare("select sum(issues) from items where biblionumber=?");
2239         foreach ( split /;/, $biblionumbers ) {
2240             my ( $biblionumber, $title ) = split /,/, $_;
2241             $result{$biblionumber} = GetMarcBiblio($biblionumber);
2242             $sth->execute($biblionumber);
2243             my $popularity = $sth->fetchrow || 0;
2244
2245 # hint : the key is popularity.title because we can have
2246 # many results with the same popularity. In this case, sub-ordering is done by title
2247 # we also have biblionumber to avoid bug for 2 biblios with the same title & popularity
2248 # (un-frequent, I agree, but we won't forget anything that way ;-)
2249             $popularity{ sprintf( "%10d", $popularity ) . $title
2250                   . $biblionumber } = $biblionumber;
2251         }
2252
2253     # sort the hash and return the same structure as GetRecords (Zebra querying)
2254         my $result_hash;
2255         my $numbers = 0;
2256         if ( $ordering eq 'popularity_dsc' ) {    # sort popularity DESC
2257             foreach my $key ( sort { $b cmp $a } ( keys %popularity ) ) {
2258                 $result_hash->{'RECORDS'}[ $numbers++ ] =
2259                   $result{ $popularity{$key} }->as_usmarc();
2260             }
2261         }
2262         else {                                    # sort popularity ASC
2263             foreach my $key ( sort ( keys %popularity ) ) {
2264                 $result_hash->{'RECORDS'}[ $numbers++ ] =
2265                   $result{ $popularity{$key} }->as_usmarc();
2266             }
2267         }
2268         my $finalresult = ();
2269         $result_hash->{'hits'}         = $numbers;
2270         $finalresult->{'biblioserver'} = $result_hash;
2271         return $finalresult;
2272
2273         #
2274         # ORDER BY author
2275         #
2276     }
2277     elsif ( $ordering =~ /author/ ) {
2278         my %result;
2279         foreach ( split /;/, $biblionumbers ) {
2280             my ( $biblionumber, $title ) = split /,/, $_;
2281             my $record = GetMarcBiblio($biblionumber);
2282             my $author;
2283             if ( C4::Context->preference('marcflavour') eq 'UNIMARC' ) {
2284                 $author = $record->subfield( '200', 'f' );
2285                 $author = $record->subfield( '700', 'a' ) unless $author;
2286             }
2287             else {
2288                 $author = $record->subfield( '100', 'a' );
2289             }
2290
2291 # hint : the result is sorted by title.biblionumber because we can have X biblios with the same title
2292 # and we don't want to get only 1 result for each of them !!!
2293             $result{ $author . $biblionumber } = $record;
2294         }
2295
2296     # sort the hash and return the same structure as GetRecords (Zebra querying)
2297         my $result_hash;
2298         my $numbers = 0;
2299         if ( $ordering eq 'author_za' || $ordering eq 'author_dsc' ) {    # sort by author desc
2300             foreach my $key ( sort { $b cmp $a } ( keys %result ) ) {
2301                 $result_hash->{'RECORDS'}[ $numbers++ ] =
2302                   $result{$key}->as_usmarc();
2303             }
2304         }
2305         else {                               # sort by author ASC
2306             foreach my $key ( sort ( keys %result ) ) {
2307                 $result_hash->{'RECORDS'}[ $numbers++ ] =
2308                   $result{$key}->as_usmarc();
2309             }
2310         }
2311         my $finalresult = ();
2312         $result_hash->{'hits'}         = $numbers;
2313         $finalresult->{'biblioserver'} = $result_hash;
2314         return $finalresult;
2315
2316         #
2317         # ORDER BY callnumber
2318         #
2319     }
2320     elsif ( $ordering =~ /callnumber/ ) {
2321         my %result;
2322         foreach ( split /;/, $biblionumbers ) {
2323             my ( $biblionumber, $title ) = split /,/, $_;
2324             my $record = GetMarcBiblio($biblionumber);
2325             my $callnumber;
2326             my $frameworkcode = GetFrameworkCode($biblionumber);
2327             my ( $callnumber_tag, $callnumber_subfield ) = GetMarcFromKohaField(  'items.itemcallnumber', $frameworkcode);
2328                ( $callnumber_tag, $callnumber_subfield ) = GetMarcFromKohaField('biblioitems.callnumber', $frameworkcode)
2329                 unless $callnumber_tag;
2330             if ( C4::Context->preference('marcflavour') eq 'UNIMARC' ) {
2331                 $callnumber = $record->subfield( '200', 'f' );
2332             } else {
2333                 $callnumber = $record->subfield( '100', 'a' );
2334             }
2335
2336 # hint : the result is sorted by title.biblionumber because we can have X biblios with the same title
2337 # and we don't want to get only 1 result for each of them !!!
2338             $result{ $callnumber . $biblionumber } = $record;
2339         }
2340
2341     # sort the hash and return the same structure as GetRecords (Zebra querying)
2342         my $result_hash;
2343         my $numbers = 0;
2344         if ( $ordering eq 'call_number_dsc' ) {    # sort by title desc
2345             foreach my $key ( sort { $b cmp $a } ( keys %result ) ) {
2346                 $result_hash->{'RECORDS'}[ $numbers++ ] =
2347                   $result{$key}->as_usmarc();
2348             }
2349         }
2350         else {                                     # sort by title ASC
2351             foreach my $key ( sort { $a cmp $b } ( keys %result ) ) {
2352                 $result_hash->{'RECORDS'}[ $numbers++ ] =
2353                   $result{$key}->as_usmarc();
2354             }
2355         }
2356         my $finalresult = ();
2357         $result_hash->{'hits'}         = $numbers;
2358         $finalresult->{'biblioserver'} = $result_hash;
2359         return $finalresult;
2360     }
2361     elsif ( $ordering =~ /pubdate/ ) {             #pub year
2362         my %result;
2363         foreach ( split /;/, $biblionumbers ) {
2364             my ( $biblionumber, $title ) = split /,/, $_;
2365             my $record = GetMarcBiblio($biblionumber);
2366             my ( $publicationyear_tag, $publicationyear_subfield ) =
2367               GetMarcFromKohaField( 'biblioitems.publicationyear', '' );
2368             my $publicationyear =
2369               $record->subfield( $publicationyear_tag,
2370                 $publicationyear_subfield );
2371
2372 # hint : the result is sorted by title.biblionumber because we can have X biblios with the same title
2373 # and we don't want to get only 1 result for each of them !!!
2374             $result{ $publicationyear . $biblionumber } = $record;
2375         }
2376
2377     # sort the hash and return the same structure as GetRecords (Zebra querying)
2378         my $result_hash;
2379         my $numbers = 0;
2380         if ( $ordering eq 'pubdate_dsc' ) {    # sort by pubyear desc
2381             foreach my $key ( sort { $b cmp $a } ( keys %result ) ) {
2382                 $result_hash->{'RECORDS'}[ $numbers++ ] =
2383                   $result{$key}->as_usmarc();
2384             }
2385         }
2386         else {                                 # sort by pub year ASC
2387             foreach my $key ( sort ( keys %result ) ) {
2388                 $result_hash->{'RECORDS'}[ $numbers++ ] =
2389                   $result{$key}->as_usmarc();
2390             }
2391         }
2392         my $finalresult = ();
2393         $result_hash->{'hits'}         = $numbers;
2394         $finalresult->{'biblioserver'} = $result_hash;
2395         return $finalresult;
2396
2397         #
2398         # ORDER BY title
2399         #
2400     }
2401     elsif ( $ordering =~ /title/ ) {
2402
2403 # the title is in the biblionumbers string, so we just need to build a hash, sort it and return
2404         my %result;
2405         foreach ( split /;/, $biblionumbers ) {
2406             my ( $biblionumber, $title ) = split /,/, $_;
2407
2408 # hint : the result is sorted by title.biblionumber because we can have X biblios with the same title
2409 # and we don't want to get only 1 result for each of them !!!
2410 # hint & speed improvement : we can order without reading the record
2411 # so order, and read records only for the requested page !
2412             $result{ $title . $biblionumber } = $biblionumber;
2413         }
2414
2415     # sort the hash and return the same structure as GetRecords (Zebra querying)
2416         my $result_hash;
2417         my $numbers = 0;
2418         if ( $ordering eq 'title_az' ) {    # sort by title desc
2419             foreach my $key ( sort ( keys %result ) ) {
2420                 $result_hash->{'RECORDS'}[ $numbers++ ] = $result{$key};
2421             }
2422         }
2423         else {                              # sort by title ASC
2424             foreach my $key ( sort { $b cmp $a } ( keys %result ) ) {
2425                 $result_hash->{'RECORDS'}[ $numbers++ ] = $result{$key};
2426             }
2427         }
2428
2429         # limit the $results_per_page to result size if it's more
2430         $results_per_page = $numbers - 1 if $numbers < $results_per_page;
2431
2432         # for the requested page, replace biblionumber by the complete record
2433         # speed improvement : avoid reading too much things
2434         for (
2435             my $counter = $offset ;
2436             $counter <= $offset + $results_per_page ;
2437             $counter++
2438           )
2439         {
2440             $result_hash->{'RECORDS'}[$counter] =
2441               GetMarcBiblio( $result_hash->{'RECORDS'}[$counter] )->as_usmarc;
2442         }
2443         my $finalresult = ();
2444         $result_hash->{'hits'}         = $numbers;
2445         $finalresult->{'biblioserver'} = $result_hash;
2446         return $finalresult;
2447     }
2448     else {
2449
2450 #
2451 # order by ranking
2452 #
2453 # we need 2 hashes to order by ranking : the 1st one to count the ranking, the 2nd to order by ranking
2454         my %result;
2455         my %count_ranking;
2456         foreach ( split /;/, $biblionumbers ) {
2457             my ( $biblionumber, $title ) = split /,/, $_;
2458             $title =~ /(.*)-(\d)/;
2459
2460             # get weight
2461             my $ranking = $2;
2462
2463 # note that we + the ranking because ranking is calculated on weight of EACH term requested.
2464 # if we ask for "two towers", and "two" has weight 2 in biblio N, and "towers" has weight 4 in biblio N
2465 # biblio N has ranking = 6
2466             $count_ranking{$biblionumber} += $ranking;
2467         }
2468
2469 # build the result by "inverting" the count_ranking hash
2470 # 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
2471 #         warn "counting";
2472         foreach ( keys %count_ranking ) {
2473             $result{ sprintf( "%10d", $count_ranking{$_} ) . '-' . $_ } = $_;
2474         }
2475
2476     # sort the hash and return the same structure as GetRecords (Zebra querying)
2477         my $result_hash;
2478         my $numbers = 0;
2479         foreach my $key ( sort { $b cmp $a } ( keys %result ) ) {
2480             $result_hash->{'RECORDS'}[ $numbers++ ] = $result{$key};
2481         }
2482
2483         # limit the $results_per_page to result size if it's more
2484         $results_per_page = $numbers - 1 if $numbers < $results_per_page;
2485
2486         # for the requested page, replace biblionumber by the complete record
2487         # speed improvement : avoid reading too much things
2488         for (
2489             my $counter = $offset ;
2490             $counter <= $offset + $results_per_page ;
2491             $counter++
2492           )
2493         {
2494             $result_hash->{'RECORDS'}[$counter] =
2495               GetMarcBiblio( $result_hash->{'RECORDS'}[$counter] )->as_usmarc
2496               if $result_hash->{'RECORDS'}[$counter];
2497         }
2498         my $finalresult = ();
2499         $result_hash->{'hits'}         = $numbers;
2500         $finalresult->{'biblioserver'} = $result_hash;
2501         return $finalresult;
2502     }
2503 }
2504
2505 =head2 enabled_staff_search_views
2506
2507 %hash = enabled_staff_search_views()
2508
2509 This function returns a hash that contains three flags obtained from the system
2510 preferences, used to determine whether a particular staff search results view
2511 is enabled.
2512
2513 =over 2
2514
2515 =item C<Output arg:>
2516
2517     * $hash{can_view_MARC} is true only if the MARC view is enabled
2518     * $hash{can_view_ISBD} is true only if the ISBD view is enabled
2519     * $hash{can_view_labeledMARC} is true only if the Labeled MARC view is enabled
2520
2521 =item C<usage in the script:>
2522
2523 =back
2524
2525 $template->param ( C4::Search::enabled_staff_search_views );
2526
2527 =cut
2528
2529 sub enabled_staff_search_views
2530 {
2531         return (
2532                 can_view_MARC                   => C4::Context->preference('viewMARC'),                 # 1 if the staff search allows the MARC view
2533                 can_view_ISBD                   => C4::Context->preference('viewISBD'),                 # 1 if the staff search allows the ISBD view
2534                 can_view_labeledMARC    => C4::Context->preference('viewLabeledMARC'),  # 1 if the staff search allows the Labeled MARC view
2535         );
2536 }
2537
2538 sub AddSearchHistory{
2539         my ($borrowernumber,$session,$query_desc,$query_cgi, $total)=@_;
2540     my $dbh = C4::Context->dbh;
2541
2542     # Add the request the user just made
2543     my $sql = "INSERT INTO search_history(userid, sessionid, query_desc, query_cgi, total, time) VALUES(?, ?, ?, ?, ?, NOW())";
2544     my $sth   = $dbh->prepare($sql);
2545     $sth->execute($borrowernumber, $session, $query_desc, $query_cgi, $total);
2546         return $dbh->last_insert_id(undef, 'search_history', undef,undef,undef);
2547 }
2548
2549 sub GetSearchHistory{
2550         my ($borrowernumber,$session)=@_;
2551     my $dbh = C4::Context->dbh;
2552
2553     # Add the request the user just made
2554     my $query = "SELECT FROM search_history WHERE (userid=? OR sessionid=?)";
2555     my $sth   = $dbh->prepare($query);
2556         $sth->execute($borrowernumber, $session);
2557     return  $sth->fetchall_hashref({});
2558 }
2559
2560 =head2 z3950_search_args
2561
2562 $arrayref = z3950_search_args($matchpoints)
2563
2564 This function returns an array reference that contains the search parameters to be
2565 passed to the Z39.50 search script (z3950_search.pl). The array elements
2566 are hash refs whose keys are name, value and encvalue, and whose values are the
2567 name of a search parameter, the value of that search parameter and the URL encoded
2568 value of that parameter.
2569
2570 The search parameter names are lccn, isbn, issn, title, author, dewey and subject.
2571
2572 The search parameter values are obtained from the bibliographic record whose
2573 data is in a hash reference in $matchpoints, as returned by Biblio::GetBiblioData().
2574
2575 If $matchpoints is a scalar, it is assumed to be an unnamed query descriptor, e.g.
2576 a general purpose search argument. In this case, the returned array contains only
2577 entry: the key is 'title' and the value and encvalue are derived from $matchpoints.
2578
2579 If a search parameter value is undefined or empty, it is not included in the returned
2580 array.
2581
2582 The returned array reference may be passed directly to the template parameters.
2583
2584 =over 2
2585
2586 =item C<Output arg:>
2587
2588     * $array containing hash refs as described above
2589
2590 =item C<usage in the script:>
2591
2592 =back
2593
2594 $data = Biblio::GetBiblioData($bibno);
2595 $template->param ( MYLOOP => C4::Search::z3950_search_args($data) )
2596
2597 *OR*
2598
2599 $template->param ( MYLOOP => C4::Search::z3950_search_args($searchscalar) )
2600
2601 =cut
2602
2603 sub z3950_search_args {
2604     my $bibrec = shift;
2605     $bibrec = { title => $bibrec } if !ref $bibrec;
2606     my $array = [];
2607     for my $field (qw/ lccn isbn issn title author dewey subject /)
2608     {
2609         my $encvalue = URI::Escape::uri_escape_utf8($bibrec->{$field});
2610         push @$array, { name=>$field, value=>$bibrec->{$field}, encvalue=>$encvalue } if defined $bibrec->{$field};
2611     }
2612     return $array;
2613 }
2614
2615 =head2 BiblioAddAuthorities
2616
2617 ( $countlinked, $countcreated ) = BiblioAddAuthorities($record, $frameworkcode);
2618
2619 this function finds the authorities linked to the biblio
2620     * search in the authority DB for the same authid (in $9 of the biblio)
2621     * search in the authority DB for the same 001 (in $3 of the biblio in UNIMARC)
2622     * search in the authority DB for the same values (exactly) (in all subfields of the biblio)
2623 OR adds a new authority record
2624
2625 =over 2
2626
2627 =item C<input arg:>
2628
2629     * $record is the MARC record in question (marc blob)
2630     * $frameworkcode is the bibliographic framework to use (if it is "" it uses the default framework)
2631
2632 =item C<Output arg:>
2633
2634     * $countlinked is the number of authorities records that are linked to this authority
2635     * $countcreated
2636
2637 =item C<BUGS>
2638     * 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)
2639
2640 =back
2641
2642 =cut
2643
2644
2645 sub BiblioAddAuthorities{
2646   my ( $record, $frameworkcode ) = @_;
2647   my $dbh=C4::Context->dbh;
2648   my $query=$dbh->prepare(qq|
2649 SELECT authtypecode,tagfield
2650 FROM marc_subfield_structure
2651 WHERE frameworkcode=?
2652 AND (authtypecode IS NOT NULL AND authtypecode<>\"\")|);
2653 # SELECT authtypecode,tagfield
2654 # FROM marc_subfield_structure
2655 # WHERE frameworkcode=?
2656 # AND (authtypecode IS NOT NULL OR authtypecode<>\"\")|);
2657   $query->execute($frameworkcode);
2658   my ($countcreated,$countlinked);
2659   while (my $data=$query->fetchrow_hashref){
2660     foreach my $field ($record->field($data->{tagfield})){
2661       next if ($field->subfield('3')||$field->subfield('9'));
2662       # No authorities id in the tag.
2663       # Search if there is any authorities to link to.
2664       my $query='at='.$data->{authtypecode}.' ';
2665       map {$query.= ' and he,ext="'.$_->[1].'"' if ($_->[0]=~/[A-z]/)}  $field->subfields();
2666       my ($error, $results, $total_hits)=SimpleSearch( $query, undef, undef, [ "authorityserver" ] );
2667     # there is only 1 result
2668           if ( $error ) {
2669         warn "BIBLIOADDSAUTHORITIES: $error";
2670             return (0,0) ;
2671           }
2672       if ( @{$results} == 1 ) {
2673         my $marcrecord = MARC::File::USMARC::decode($results->[0]);
2674         $field->add_subfields('9'=>$marcrecord->field('001')->data);
2675         $countlinked++;
2676       } elsif ( @{$results} > 1 ) {
2677    #More than One result
2678    #This can comes out of a lack of a subfield.
2679 #         my $marcrecord = MARC::File::USMARC::decode($results->[0]);
2680 #         $record->field($data->{tagfield})->add_subfields('9'=>$marcrecord->field('001')->data);
2681   $countlinked++;
2682       } else {
2683   #There are no results, build authority record, add it to Authorities, get authid and add it to 9
2684   ###NOTICE : This is only valid if a subfield is linked to one and only one authtypecode
2685   ###NOTICE : This can be a problem. We should also look into other types and rejected forms.
2686          my $authtypedata=C4::AuthoritiesMarc::GetAuthType($data->{authtypecode});
2687          next unless $authtypedata;
2688          my $marcrecordauth=MARC::Record->new();
2689          my $authfield=MARC::Field->new($authtypedata->{auth_tag_to_report},'','',"a"=>"".$field->subfield('a'));
2690          map { $authfield->add_subfields($_->[0]=>$_->[1]) if ($_->[0]=~/[A-z]/ && $_->[0] ne "a" )}  $field->subfields();
2691          $marcrecordauth->insert_fields_ordered($authfield);
2692
2693          # bug 2317: ensure new authority knows it's using UTF-8; currently
2694          # only need to do this for MARC21, as MARC::Record->as_xml_record() handles
2695          # automatically for UNIMARC (by not transcoding)
2696          # FIXME: AddAuthority() instead should simply explicitly require that the MARC::Record
2697          # use UTF-8, but as of 2008-08-05, did not want to introduce that kind
2698          # of change to a core API just before the 3.0 release.
2699          if (C4::Context->preference('marcflavour') eq 'MARC21') {
2700             SetMarcUnicodeFlag($marcrecordauth, 'MARC21');
2701          }
2702
2703 #          warn "AUTH RECORD ADDED : ".$marcrecordauth->as_formatted;
2704
2705          my $authid=AddAuthority($marcrecordauth,'',$data->{authtypecode});
2706          $countcreated++;
2707          $field->add_subfields('9'=>$authid);
2708       }
2709     }
2710   }
2711   return ($countlinked,$countcreated);
2712 }
2713
2714 =head2 GetDistinctValues($field);
2715
2716 C<$field> is a reference to the fields array
2717
2718 =cut
2719
2720 sub GetDistinctValues {
2721     my ($fieldname,$string)=@_;
2722     # returns a reference to a hash of references to branches...
2723     if ($fieldname=~/\./){
2724                         my ($table,$column)=split /\./, $fieldname;
2725                         my $dbh = C4::Context->dbh;
2726                         warn "select DISTINCT($column) as value, count(*) as cnt from $table group by lib order by $column " if $DEBUG;
2727                         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 ");
2728                         $sth->execute;
2729                         my $elements=$sth->fetchall_arrayref({});
2730                         return $elements;
2731    }
2732    else {
2733                 $string||= qq("");
2734                 my @servers=qw<biblioserver authorityserver>;
2735                 my (@zconns,@results);
2736         for ( my $i = 0 ; $i < @servers ; $i++ ) {
2737                 $zconns[$i] = C4::Context->Zconn( $servers[$i], 1 );
2738                         $results[$i] =
2739                       $zconns[$i]->scan(
2740                         ZOOM::Query::CCL2RPN->new( qq"$fieldname $string", $zconns[$i])
2741                       );
2742                 }
2743                 # The big moment: asynchronously retrieve results from all servers
2744                 my @elements;
2745                 while ( ( my $i = ZOOM::event( \@zconns ) ) != 0 ) {
2746                         my $ev = $zconns[ $i - 1 ]->last_event();
2747                         if ( $ev == ZOOM::Event::ZEND ) {
2748                                 next unless $results[ $i - 1 ];
2749                                 my $size = $results[ $i - 1 ]->size();
2750                                 if ( $size > 0 ) {
2751                       for (my $j=0;$j<$size;$j++){
2752                                                 my %hashscan;
2753                                                 @hashscan{qw(value cnt)}=$results[ $i - 1 ]->display_term($j);
2754                                                 push @elements, \%hashscan;
2755                                           }
2756                                 }
2757                         }
2758                 }
2759                 return \@elements;
2760    }
2761 }
2762
2763
2764 END { }    # module clean-up code here (global destructor)
2765
2766 1;
2767 __END__
2768
2769 =head1 AUTHOR
2770
2771 Koha Development Team <http://koha-community.org/>
2772
2773 =cut