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