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