koha-dev.rot13.org Git - koha_fer/blob - C4/Search.pm

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