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

   1 package C4::Search;
   2
   3 # This file is part of Koha.
   4 #
   5 # Koha is free software; you can redistribute it and/or modify it under the
   6 # terms of the GNU General Public License as published by the Free Software
   7 # Foundation; either version 2 of the License, or (at your option) any later
   8 # version.
   9 #
  10 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
  11 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
  12 # A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
  13 #
  14 # You should have received a copy of the GNU General Public License along with
  15 # Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
  16 # Suite 330, Boston, MA  02111-1307 USA
  17
  18 use strict;
  19 # use warnings; # FIXME
  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     $stemmer->add_exceptions(
 714         {
 715             'and' => 'and',
 716             'or'  => 'or',
 717             'not' => 'not',
 718         }
 719     );
 720     my @words = split( / /, $operand );
 721     my @stems = $stemmer->stem(\@words);
 722     for my $stem (@stems) {
 723         $stemmed_operand .= "$stem";
 724         $stemmed_operand .= "?"
 725           unless ( $stem =~ /(and$|or$|not$)/ ) || ( length($stem) < 3 );
 726         $stemmed_operand .= " ";
 727     }
 728     warn "STEMMED OPERAND: $stemmed_operand" if $DEBUG;
 729     return $stemmed_operand;
 730 }
 731
 732 # FIELD WEIGHTING
 733 sub _build_weighted_query {
 734
 735 # FIELD WEIGHTING - This is largely experimental stuff. What I'm committing works
 736 # pretty well but could work much better if we had a smarter query parser
 737     my ( $operand, $stemmed_operand, $index ) = @_;
 738     my $stemming      = C4::Context->preference("QueryStemming")     || 0;
 739     my $weight_fields = C4::Context->preference("QueryWeightFields") || 0;
 740     my $fuzzy_enabled = C4::Context->preference("QueryFuzzy")        || 0;
 741
 742     my $weighted_query .= "(rk=(";    # Specifies that we're applying rank
 743
 744     # Keyword, or, no index specified
 745     if ( ( $index eq 'kw' ) || ( !$index ) ) {
 746         $weighted_query .=
 747           "Title-cover,ext,r1=\"$operand\"";    # exact title-cover
 748         $weighted_query .= " or ti,ext,r2=\"$operand\"";    # exact title
 749         $weighted_query .= " or ti,phr,r3=\"$operand\"";    # phrase title
 750           #$weighted_query .= " or any,ext,r4=$operand";               # exact any
 751           #$weighted_query .=" or kw,wrdl,r5=\"$operand\"";            # word list any
 752         $weighted_query .= " or wrdl,fuzzy,r8=\"$operand\""
 753           if $fuzzy_enabled;    # add fuzzy, word list
 754         $weighted_query .= " or wrdl,right-Truncation,r9=\"$stemmed_operand\""
 755           if ( $stemming and $stemmed_operand )
 756           ;                     # add stemming, right truncation
 757         $weighted_query .= " or wrdl,r9=\"$operand\"";
 758
 759         # embedded sorting: 0 a-z; 1 z-a
 760         # $weighted_query .= ") or (sort1,aut=1";
 761     }
 762
 763     # Barcode searches should skip this process
 764     elsif ( $index eq 'bc' ) {
 765         $weighted_query .= "bc=\"$operand\"";
 766     }
 767
 768     # Authority-number searches should skip this process
 769     elsif ( $index eq 'an' ) {
 770         $weighted_query .= "an=\"$operand\"";
 771     }
 772
 773     # If the index already has more than one qualifier, wrap the operand
 774     # in quotes and pass it back (assumption is that the user knows what they
 775     # are doing and won't appreciate us mucking up their query
 776     elsif ( $index =~ ',' ) {
 777         $weighted_query .= " $index=\"$operand\"";
 778     }
 779
 780     #TODO: build better cases based on specific search indexes
 781     else {
 782         $weighted_query .= " $index,ext,r1=\"$operand\"";    # exact index
 783           #$weighted_query .= " or (title-sort-az=0 or $index,startswithnt,st-word,r3=$operand #)";
 784         $weighted_query .= " or $index,phr,r3=\"$operand\"";    # phrase index
 785         $weighted_query .=
 786           " or $index,rt,wrdl,r3=\"$operand\"";    # word list index
 787     }
 788
 789     $weighted_query .= "))";                       # close rank specification
 790     return $weighted_query;
 791 }
 792
 793 =head2 buildQuery
 794
 795 ( $error, $query,
 796 $simple_query, $query_cgi,
 797 $query_desc, $limit,
 798 $limit_cgi, $limit_desc,
 799 $stopwords_removed, $query_type ) = buildQuery ( $operators, $operands, $indexes, $limits, $sort_by, $scan, $lang);
 800
 801 Build queries and limits in CCL, CGI, Human,
 802 handle truncation, stemming, field weighting, stopwords, fuzziness, etc.
 803
 804 See verbose embedded documentation.
 805
 806
 807 =cut
 808
 809 sub buildQuery {
 810     my ( $operators, $operands, $indexes, $limits, $sort_by, $scan, $lang) = @_;
 811
 812     warn "---------\nEnter buildQuery\n---------" if $DEBUG;
 813
 814     # dereference
 815     my @operators = $operators ? @$operators : ();
 816     my @indexes   = $indexes   ? @$indexes   : ();
 817     my @operands  = $operands  ? @$operands  : ();
 818     my @limits    = $limits    ? @$limits    : ();
 819     my @sort_by   = $sort_by   ? @$sort_by   : ();
 820
 821     my $stemming         = C4::Context->preference("QueryStemming")        || 0;
 822     my $auto_truncation  = C4::Context->preference("QueryAutoTruncate")    || 0;
 823     my $weight_fields    = C4::Context->preference("QueryWeightFields")    || 0;
 824     my $fuzzy_enabled    = C4::Context->preference("QueryFuzzy")           || 0;
 825     my $remove_stopwords = C4::Context->preference("QueryRemoveStopwords") || 0;
 826
 827     # no stemming/weight/fuzzy in NoZebra
 828     if ( C4::Context->preference("NoZebra") ) {
 829         $stemming      = 0;
 830         $weight_fields = 0;
 831         $fuzzy_enabled = 0;
 832     }
 833
 834     my $query        = $operands[0];
 835     my $simple_query = $operands[0];
 836
 837     # initialize the variables we're passing back
 838     my $query_cgi;
 839     my $query_desc;
 840     my $query_type;
 841
 842     my $limit;
 843     my $limit_cgi;
 844     my $limit_desc;
 845
 846     my $stopwords_removed;    # flag to determine if stopwords have been removed
 847
 848 # for handling ccl, cql, pqf queries in diagnostic mode, skip the rest of the steps
 849 # DIAGNOSTIC ONLY!!
 850     if ( $query =~ /^ccl=/ ) {
 851         return ( undef, $', $', "q=ccl=$'", $', '', '', '', '', 'ccl' );
 852     }
 853     if ( $query =~ /^cql=/ ) {
 854         return ( undef, $', $', "q=cql=$'", $', '', '', '', '', 'cql' );
 855     }
 856     if ( $query =~ /^pqf=/ ) {
 857         return ( undef, $', $', "q=pqf=$'", $', '', '', '', '', 'pqf' );
 858     }
 859
 860     # pass nested queries directly
 861     # FIXME: need better handling of some of these variables in this case
 862     if ( $query =~ /(\(|\))/ ) {
 863         return (
 864             undef,              $query, $simple_query, $query_cgi,
 865             $query,             $limit, $limit_cgi,    $limit_desc,
 866             $stopwords_removed, 'ccl'
 867         );
 868     }
 869
 870 # Form-based queries are non-nested and fixed depth, so we can easily modify the incoming
 871 # query operands and indexes and add stemming, truncation, field weighting, etc.
 872 # Once we do so, we'll end up with a value in $query, just like if we had an
 873 # incoming $query from the user
 874     else {
 875         $query = ""
 876           ; # clear it out so we can populate properly with field-weighted, stemmed, etc. query
 877         my $previous_operand
 878           ;    # a flag used to keep track if there was a previous query
 879                # if there was, we can apply the current operator
 880                # for every operand
 881         for ( my $i = 0 ; $i <= @operands ; $i++ ) {
 882
 883             # COMBINE OPERANDS, INDEXES AND OPERATORS
 884             if ( $operands[$i] ) {
 885
 886               # A flag to determine whether or not to add the index to the query
 887                 my $indexes_set;
 888
 889 # If the user is sophisticated enough to specify an index, turn off field weighting, stemming, and stopword handling
 890                 if ( $operands[$i] =~ /(:|=)/ || $scan ) {
 891                     $weight_fields    = 0;
 892                     $stemming         = 0;
 893                     $remove_stopwords = 0;
 894                 }
 895                 my $operand = $operands[$i];
 896                 my $index   = $indexes[$i];
 897
 898                 # Add index-specific attributes
 899                 # Date of Publication
 900                 if ( $index eq 'yr' ) {
 901                     $index .= ",st-numeric";
 902                     $indexes_set++;
 903                                         $stemming = $auto_truncation = $weight_fields = $fuzzy_enabled = $remove_stopwords = 0;
 904                 }
 905
 906                 # Date of Acquisition
 907                 elsif ( $index eq 'acqdate' ) {
 908                     $index .= ",st-date-normalized";
 909                     $indexes_set++;
 910                                         $stemming = $auto_truncation = $weight_fields = $fuzzy_enabled = $remove_stopwords = 0;
 911                 }
 912                 # ISBN,ISSN,Standard Number, don't need special treatment
 913                 elsif ( $index eq 'nb' || $index eq 'ns' ) {
 914                     $indexes_set++;
 915                     (
 916                         $stemming,      $auto_truncation,
 917                         $weight_fields, $fuzzy_enabled,
 918                         $remove_stopwords
 919                     ) = ( 0, 0, 0, 0, 0 );
 920
 921                 }
 922                 # Set default structure attribute (word list)
 923                 my $struct_attr;
 924                 unless ( $indexes_set || !$index || $index =~ /(st-|phr|ext|wrdl)/ ) {
 925                     $struct_attr = ",wrdl";
 926                 }
 927
 928                 # Some helpful index variants
 929                 my $index_plus       = $index . $struct_attr . ":" if $index;
 930                 my $index_plus_comma = $index . $struct_attr . "," if $index;
 931
 932                 # Remove Stopwords
 933                 if ($remove_stopwords) {
 934                     ( $operand, $stopwords_removed ) =
 935                       _remove_stopwords( $operand, $index );
 936                     warn "OPERAND w/out STOPWORDS: >$operand<" if $DEBUG;
 937                     warn "REMOVED STOPWORDS: @$stopwords_removed"
 938                       if ( $stopwords_removed && $DEBUG );
 939                 }
 940
 941                 if ($auto_truncation){
 942                                         $operand=~join(" ",map{ "$_*" }split (/\s+/,$operand));
 943                                 }
 944
 945                 # Detect Truncation
 946                 my $truncated_operand;
 947                 my( $nontruncated, $righttruncated, $lefttruncated,
 948                     $rightlefttruncated, $regexpr
 949                 ) = _detect_truncation( $operand, $index );
 950                 warn
 951 "TRUNCATION: NON:>@$nontruncated< RIGHT:>@$righttruncated< LEFT:>@$lefttruncated< RIGHTLEFT:>@$rightlefttruncated< REGEX:>@$regexpr<"
 952                   if $DEBUG;
 953
 954                 # Apply Truncation
 955                 if (
 956                     scalar(@$righttruncated) + scalar(@$lefttruncated) +
 957                     scalar(@$rightlefttruncated) > 0 )
 958                 {
 959
 960                # Don't field weight or add the index to the query, we do it here
 961                     $indexes_set = 1;
 962                     undef $weight_fields;
 963                     my $previous_truncation_operand;
 964                     if (scalar @$nontruncated) {
 965                         $truncated_operand .= "$index_plus @$nontruncated ";
 966                         $previous_truncation_operand = 1;
 967                     }
 968                     if (scalar @$righttruncated) {
 969                         $truncated_operand .= "and " if $previous_truncation_operand;
 970                         $truncated_operand .= $index_plus_comma . "rtrn:@$righttruncated ";
 971                         $previous_truncation_operand = 1;
 972                     }
 973                     if (scalar @$lefttruncated) {
 974                         $truncated_operand .= "and " if $previous_truncation_operand;
 975                         $truncated_operand .= $index_plus_comma . "ltrn:@$lefttruncated ";
 976                         $previous_truncation_operand = 1;
 977                     }
 978                     if (scalar @$rightlefttruncated) {
 979                         $truncated_operand .= "and " if $previous_truncation_operand;
 980                         $truncated_operand .= $index_plus_comma . "rltrn:@$rightlefttruncated ";
 981                         $previous_truncation_operand = 1;
 982                     }
 983                 }
 984                 $operand = $truncated_operand if $truncated_operand;
 985                 warn "TRUNCATED OPERAND: >$truncated_operand<" if $DEBUG;
 986
 987                 # Handle Stemming
 988                 my $stemmed_operand;
 989                 $stemmed_operand = _build_stemmed_operand($operand, $lang)
 990                                                                                 if $stemming;
 991
 992                 warn "STEMMED OPERAND: >$stemmed_operand<" if $DEBUG;
 993
 994                 # Handle Field Weighting
 995                 my $weighted_operand;
 996                 if ($weight_fields) {
 997                     $weighted_operand = _build_weighted_query( $operand, $stemmed_operand, $index );
 998                     $operand = $weighted_operand;
 999                     $indexes_set = 1;
1000                 }
1001
1002                 warn "FIELD WEIGHTED OPERAND: >$weighted_operand<" if $DEBUG;
1003
1004                 # If there's a previous operand, we need to add an operator
1005                 if ($previous_operand) {
1006
1007                     # User-specified operator
1008                     if ( $operators[ $i - 1 ] ) {
1009                         $query     .= " $operators[$i-1] ";
1010                         $query     .= " $index_plus " unless $indexes_set;
1011                         $query     .= " $operand";
1012                         $query_cgi .= "&op=$operators[$i-1]";
1013                         $query_cgi .= "&idx=$index" if $index;
1014                         $query_cgi .= "&q=$operands[$i]" if $operands[$i];
1015                         $query_desc .=
1016                           " $operators[$i-1] $index_plus $operands[$i]";
1017                     }
1018
1019                     # Default operator is and
1020                     else {
1021                         $query      .= " and ";
1022                         $query      .= "$index_plus " unless $indexes_set;
1023                         $query      .= "$operand";
1024                         $query_cgi  .= "&op=and&idx=$index" if $index;
1025                         $query_cgi  .= "&q=$operands[$i]" if $operands[$i];
1026                         $query_desc .= " and $index_plus $operands[$i]";
1027                     }
1028                 }
1029
1030                 # There isn't a pervious operand, don't need an operator
1031                 else {
1032
1033                     # Field-weighted queries already have indexes set
1034                     $query .= " $index_plus " unless $indexes_set;
1035                     $query .= $operand;
1036                     $query_desc .= " $index_plus $operands[$i]";
1037                     $query_cgi  .= "&idx=$index" if $index;
1038                     $query_cgi  .= "&q=$operands[$i]" if $operands[$i];
1039                     $previous_operand = 1;
1040                 }
1041             }    #/if $operands
1042         }    # /for
1043     }
1044     warn "QUERY BEFORE LIMITS: >$query<" if $DEBUG;
1045
1046     # add limits
1047     my $group_OR_limits;
1048     my $availability_limit;
1049     foreach my $this_limit (@limits) {
1050         if ( $this_limit =~ /available/ ) {
1051
1052 # 'available' is defined as (items.onloan is NULL) and (items.itemlost = 0)
1053 # In English:
1054 # all records not indexed in the onloan register (zebra) and all records with a value of lost equal to 0
1055             $availability_limit .=
1056 "( ( allrecords,AlwaysMatches='' not onloan,AlwaysMatches='') and (lost,st-numeric=0) )"; #or ( allrecords,AlwaysMatches='' not lost,AlwaysMatches='')) )";
1057             $limit_cgi  .= "&limit=available";
1058             $limit_desc .= "";
1059         }
1060
1061         # group_OR_limits, prefixed by mc-
1062         # OR every member of the group
1063         elsif ( $this_limit =~ /mc/ ) {
1064             $group_OR_limits .= " or " if $group_OR_limits;
1065             $limit_desc      .= " or " if $group_OR_limits;
1066             $group_OR_limits .= "$this_limit";
1067             $limit_cgi       .= "&limit=$this_limit";
1068             $limit_desc      .= " $this_limit";
1069         }
1070
1071         # Regular old limits
1072         else {
1073             $limit .= " and " if $limit || $query;
1074             $limit      .= "$this_limit";
1075             $limit_cgi  .= "&limit=$this_limit";
1076             if ($this_limit =~ /^branch:(.+)/) {
1077                 my $branchcode = $1;
1078                 my $branchname = GetBranchName($branchcode);
1079                 if (defined $branchname) {
1080                     $limit_desc .= " branch:$branchname";
1081                 } else {
1082                     $limit_desc .= " $this_limit";
1083                 }
1084             } else {
1085                 $limit_desc .= " $this_limit";
1086             }
1087         }
1088     }
1089     if ($group_OR_limits) {
1090         $limit .= " and " if ( $query || $limit );
1091         $limit .= "($group_OR_limits)";
1092     }
1093     if ($availability_limit) {
1094         $limit .= " and " if ( $query || $limit );
1095         $limit .= "($availability_limit)";
1096     }
1097
1098     # Normalize the query and limit strings
1099     $query =~ s/:/=/g;
1100     $limit =~ s/:/=/g;
1101     for ( $query, $query_desc, $limit, $limit_desc ) {
1102         s/  / /g;    # remove extra spaces
1103         s/^ //g;     # remove any beginning spaces
1104         s/ $//g;     # remove any ending spaces
1105         s/==/=/g;    # remove double == from query
1106     }
1107     $query_cgi =~ s/^&//; # remove unnecessary & from beginning of the query cgi
1108
1109     for ($query_cgi,$simple_query) {
1110         s/"//g;
1111     }
1112     # append the limit to the query
1113     $query .= " " . $limit;
1114
1115     # Warnings if DEBUG
1116     if ($DEBUG) {
1117         warn "QUERY:" . $query;
1118         warn "QUERY CGI:" . $query_cgi;
1119         warn "QUERY DESC:" . $query_desc;
1120         warn "LIMIT:" . $limit;
1121         warn "LIMIT CGI:" . $limit_cgi;
1122         warn "LIMIT DESC:" . $limit_desc;
1123         warn "---------\nLeave buildQuery\n---------";
1124     }
1125     return (
1126         undef,              $query, $simple_query, $query_cgi,
1127         $query_desc,        $limit, $limit_cgi,    $limit_desc,
1128         $stopwords_removed, $query_type
1129     );
1130 }
1131
1132 =head2 searchResults
1133
1134 Format results in a form suitable for passing to the template
1135
1136 =cut
1137
1138 # IMO this subroutine is pretty messy still -- it's responsible for
1139 # building the HTML output for the template
1140 sub searchResults {
1141     my ( $searchdesc, $hits, $results_per_page, $offset, $scan, @marcresults ) = @_;
1142     my $dbh = C4::Context->dbh;
1143     my @newresults;
1144
1145     #Build branchnames hash
1146     #find branchname
1147     #get branch information.....
1148     my %branches;
1149     my $bsth =$dbh->prepare("SELECT branchcode,branchname FROM branches"); # FIXME : use C4::Branch::GetBranches
1150     $bsth->execute();
1151     while ( my $bdata = $bsth->fetchrow_hashref ) {
1152         $branches{ $bdata->{'branchcode'} } = $bdata->{'branchname'};
1153     }
1154 # FIXME - We build an authorised values hash here, using the default framework
1155 # though it is possible to have different authvals for different fws.
1156
1157     my $shelflocations =GetKohaAuthorisedValues('items.location','');
1158
1159     # get notforloan authorised value list (see $shelflocations  FIXME)
1160     my $notforloan_authorised_value = GetAuthValCode('items.notforloan','');
1161
1162     #Build itemtype hash
1163     #find itemtype & itemtype image
1164     my %itemtypes;
1165     $bsth =
1166       $dbh->prepare(
1167         "SELECT itemtype,description,imageurl,summary,notforloan FROM itemtypes"
1168       );
1169     $bsth->execute();
1170     while ( my $bdata = $bsth->fetchrow_hashref ) {
1171                 foreach (qw(description imageurl summary notforloan)) {
1172                 $itemtypes{ $bdata->{'itemtype'} }->{$_} = $bdata->{$_};
1173                 }
1174     }
1175
1176     #search item field code
1177     my $sth =
1178       $dbh->prepare(
1179 "SELECT tagfield FROM marc_subfield_structure WHERE kohafield LIKE 'items.itemnumber'"
1180       );
1181     $sth->execute;
1182     my ($itemtag) = $sth->fetchrow;
1183
1184     ## find column names of items related to MARC
1185     my $sth2 = $dbh->prepare("SHOW COLUMNS FROM items");
1186     $sth2->execute;
1187     my %subfieldstosearch;
1188     while ( ( my $column ) = $sth2->fetchrow ) {
1189         my ( $tagfield, $tagsubfield ) =
1190           &GetMarcFromKohaField( "items." . $column, "" );
1191         $subfieldstosearch{$column} = $tagsubfield;
1192     }
1193
1194     # handle which records to actually retrieve
1195     my $times;
1196     if ( $hits && $offset + $results_per_page <= $hits ) {
1197         $times = $offset + $results_per_page;
1198     }
1199     else {
1200         $times = $hits;  # FIXME: if $hits is undefined, why do we want to equal it?
1201     }
1202
1203         my $marcflavour = C4::Context->preference("marcflavour");
1204     # We get the biblionumber position in MARC
1205     my ($bibliotag,$bibliosubf)=GetMarcFromKohaField('biblio.biblionumber','');
1206     my $fw;
1207
1208     # loop through all of the records we've retrieved
1209     for ( my $i = $offset ; $i <= $times - 1 ; $i++ ) {
1210         my $marcrecord = MARC::File::USMARC::decode( $marcresults[$i] );
1211
1212         if ($bibliotag<10){
1213             $fw = GetFrameworkCode($marcrecord->field($bibliotag)->data);
1214         }else{
1215             $fw = GetFrameworkCode($marcrecord->subfield($bibliotag,$bibliosubf));
1216         }
1217
1218         my $oldbiblio = TransformMarcToKoha( $dbh, $marcrecord, $fw );
1219         $oldbiblio->{subtitle} = GetRecordValue('subtitle', $marcrecord, $fw);
1220         $oldbiblio->{result_number} = $i + 1;
1221
1222         # add imageurl to itemtype if there is one
1223         $oldbiblio->{imageurl} = getitemtypeimagelocation( 'opac', $itemtypes{ $oldbiblio->{itemtype} }->{imageurl} );
1224
1225         $oldbiblio->{'authorised_value_images'}  = C4::Items::get_authorised_value_images( C4::Biblio::get_biblio_authorised_values( $oldbiblio->{'biblionumber'}, $marcrecord ) );
1226                 $oldbiblio->{normalized_upc}  = GetNormalizedUPC(       $marcrecord,$marcflavour);
1227                 $oldbiblio->{normalized_ean}  = GetNormalizedEAN(       $marcrecord,$marcflavour);
1228                 $oldbiblio->{normalized_oclc} = GetNormalizedOCLCNumber($marcrecord,$marcflavour);
1229                 $oldbiblio->{normalized_isbn} = GetNormalizedISBN(undef,$marcrecord,$marcflavour);
1230                 $oldbiblio->{content_identifier_exists} = 1 if ($oldbiblio->{normalized_isbn} or $oldbiblio->{normalized_oclc} or $oldbiblio->{normalized_ean} or $oldbiblio->{normalized_upc});
1231
1232                 # edition information, if any
1233         $oldbiblio->{edition} = $oldbiblio->{editionstatement};
1234                 $oldbiblio->{description} = $itemtypes{ $oldbiblio->{itemtype} }->{description};
1235  # Build summary if there is one (the summary is defined in the itemtypes table)
1236  # FIXME: is this used anywhere, I think it can be commented out? -- JF
1237         if ( $itemtypes{ $oldbiblio->{itemtype} }->{summary} ) {
1238             my $summary = $itemtypes{ $oldbiblio->{itemtype} }->{summary};
1239             my @fields  = $marcrecord->fields();
1240
1241             my $newsummary;
1242             foreach my $line ( "$summary\n" =~ /(.*)\n/g ){
1243                 my $tags = {};
1244                 foreach my $tag ( $line =~ /\[(\d{3}[\w|\d])\]/ ) {
1245                     $tag =~ /(.{3})(.)/;
1246                     if($marcrecord->field($1)){
1247                         my @abc = $marcrecord->field($1)->subfield($2);
1248                         $tags->{$tag} = $#abc + 1 ;
1249                     }
1250                 }
1251
1252                 # We catch how many times to repeat this line
1253                 my $max = 0;
1254                 foreach my $tag (keys(%$tags)){
1255                     $max = $tags->{$tag} if($tags->{$tag} > $max);
1256                  }
1257
1258                 # we replace, and repeat each line
1259                 for (my $i = 0 ; $i < $max ; $i++){
1260                     my $newline = $line;
1261
1262                     foreach my $tag ( $newline =~ /\[(\d{3}[\w|\d])\]/g ) {
1263                         $tag =~ /(.{3})(.)/;
1264
1265                         if($marcrecord->field($1)){
1266                             my @repl = $marcrecord->field($1)->subfield($2);
1267                             my $subfieldvalue = $repl[$i];
1268
1269                             if (! utf8::is_utf8($subfieldvalue)) {
1270                                 utf8::decode($subfieldvalue);
1271                             }
1272
1273                              $newline =~ s/\[$tag\]/$subfieldvalue/g;
1274                         }
1275                     }
1276                     $newsummary .= "$newline\n";
1277                 }
1278             }
1279
1280             $newsummary =~ s/\[(.*?)]//g;
1281             $newsummary =~ s/\n/<br\/>/g;
1282             $oldbiblio->{summary} = $newsummary;
1283         }
1284
1285         # Pull out the items fields
1286         my @fields = $marcrecord->field($itemtag);
1287
1288         # Setting item statuses for display
1289         my @available_items_loop;
1290         my @onloan_items_loop;
1291         my @other_items_loop;
1292
1293         my $available_items;
1294         my $onloan_items;
1295         my $other_items;
1296
1297         my $ordered_count         = 0;
1298         my $available_count       = 0;
1299         my $onloan_count          = 0;
1300         my $longoverdue_count     = 0;
1301         my $other_count           = 0;
1302         my $wthdrawn_count        = 0;
1303         my $itemlost_count        = 0;
1304         my $itembinding_count     = 0;
1305         my $itemdamaged_count     = 0;
1306         my $item_in_transit_count = 0;
1307         my $can_place_holds       = 0;
1308         my $items_count           = scalar(@fields);
1309         my $maxitems =
1310           ( C4::Context->preference('maxItemsinSearchResults') )
1311           ? C4::Context->preference('maxItemsinSearchResults') - 1
1312           : 1;
1313
1314         # loop through every item
1315         foreach my $field (@fields) {
1316             my $item;
1317
1318             # populate the items hash
1319             foreach my $code ( keys %subfieldstosearch ) {
1320                 $item->{$code} = $field->subfield( $subfieldstosearch{$code} );
1321             }
1322                         my $hbranch     = C4::Context->preference('HomeOrHoldingBranch') eq 'homebranch' ? 'homebranch'    : 'holdingbranch';
1323                         my $otherbranch = C4::Context->preference('HomeOrHoldingBranch') eq 'homebranch' ? 'holdingbranch' : 'homebranch';
1324             # set item's branch name, use HomeOrHoldingBranch syspref first, fall back to the other one
1325             if ($item->{$hbranch}) {
1326                 $item->{'branchname'} = $branches{$item->{$hbranch}};
1327             }
1328             elsif ($item->{$otherbranch}) {     # Last resort
1329                 $item->{'branchname'} = $branches{$item->{$otherbranch}};
1330             }
1331
1332                         my $prefix = $item->{$hbranch} . '--' . $item->{location} . $item->{itype} . $item->{itemcallnumber};
1333 # For each grouping of items (onloan, available, unavailable), we build a key to store relevant info about that item
1334             if ( $item->{onloan} ) {
1335                 $onloan_count++;
1336                                 my $key = $prefix . $item->{onloan} . $item->{barcode};
1337                                 $onloan_items->{$key}->{due_date} = format_date($item->{onloan});
1338                                 $onloan_items->{$key}->{count}++ if $item->{$hbranch};
1339                                 $onloan_items->{$key}->{branchname} = $item->{branchname};
1340                                 $onloan_items->{$key}->{location} = $shelflocations->{ $item->{location} };
1341                                 $onloan_items->{$key}->{itemcallnumber} = $item->{itemcallnumber};
1342                                 $onloan_items->{$key}->{imageurl} = getitemtypeimagelocation( 'opac', $itemtypes{ $item->{itype} }->{imageurl} );
1343                 # if something's checked out and lost, mark it as 'long overdue'
1344                 if ( $item->{itemlost} ) {
1345                     $onloan_items->{$prefix}->{longoverdue}++;
1346                     $longoverdue_count++;
1347                 } else {        # can place holds as long as item isn't lost
1348                     $can_place_holds = 1;
1349                 }
1350             }
1351
1352          # items not on loan, but still unavailable ( lost, withdrawn, damaged )
1353             else {
1354
1355                 # item is on order
1356                 if ( $item->{notforloan} == -1 ) {
1357                     $ordered_count++;
1358                 }
1359
1360                 # is item in transit?
1361                 my $transfertwhen = '';
1362                 my ($transfertfrom, $transfertto);
1363
1364                 unless ($item->{wthdrawn}
1365                         || $item->{itemlost}
1366                         || $item->{damaged}
1367                         || $item->{notforloan}
1368                         || $items_count > 20) {
1369
1370                     # A couple heuristics to limit how many times
1371                     # we query the database for item transfer information, sacrificing
1372                     # accuracy in some cases for speed;
1373                     #
1374                     # 1. don't query if item has one of the other statuses
1375                     # 2. don't check transit status if the bib has
1376                     #    more than 20 items
1377                     #
1378                     # FIXME: to avoid having the query the database like this, and to make
1379                     #        the in transit status count as unavailable for search limiting,
1380                     #        should map transit status to record indexed in Zebra.
1381                     #
1382                     ($transfertwhen, $transfertfrom, $transfertto) = C4::Circulation::GetTransfers($item->{itemnumber});
1383                 }
1384
1385                 # item is withdrawn, lost or damaged
1386                 if (   $item->{wthdrawn}
1387                     || $item->{itemlost}
1388                     || $item->{damaged}
1389                     || $item->{notforloan}
1390                     || ($transfertwhen ne ''))
1391                 {
1392                     $wthdrawn_count++        if $item->{wthdrawn};
1393                     $itemlost_count++        if $item->{itemlost};
1394                     $itemdamaged_count++     if $item->{damaged};
1395                     $item_in_transit_count++ if $transfertwhen ne '';
1396                     $item->{status} = $item->{wthdrawn} . "-" . $item->{itemlost} . "-" . $item->{damaged} . "-" . $item->{notforloan};
1397                     $other_count++;
1398
1399                                         my $key = $prefix . $item->{status};
1400                                         foreach (qw(wthdrawn itemlost damaged branchname itemcallnumber)) {
1401                         $other_items->{$key}->{$_} = $item->{$_};
1402                                         }
1403                     $other_items->{$key}->{intransit} = ($transfertwhen ne '') ? 1 : 0;
1404                                         $other_items->{$key}->{notforloan} = GetAuthorisedValueDesc('','',$item->{notforloan},'','',$notforloan_authorised_value) if $notforloan_authorised_value;
1405                                         $other_items->{$key}->{count}++ if $item->{$hbranch};
1406                                         $other_items->{$key}->{location} = $shelflocations->{ $item->{location} };
1407                                         $other_items->{$key}->{imageurl} = getitemtypeimagelocation( 'opac', $itemtypes{ $item->{itype} }->{imageurl} );
1408                 }
1409                 # item is available
1410                 else {
1411                     $can_place_holds = 1;
1412                     $available_count++;
1413                                         $available_items->{$prefix}->{count}++ if $item->{$hbranch};
1414                                         foreach (qw(branchname itemcallnumber)) {
1415                         $available_items->{$prefix}->{$_} = $item->{$_};
1416                                         }
1417                                         $available_items->{$prefix}->{location} = $shelflocations->{ $item->{location} };
1418                                         $available_items->{$prefix}->{imageurl} = getitemtypeimagelocation( 'opac', $itemtypes{ $item->{itype} }->{imageurl} );
1419                 }
1420             }
1421         }    # notforloan, item level and biblioitem level
1422         my ( $availableitemscount, $onloanitemscount, $otheritemscount );
1423         $maxitems =
1424           ( C4::Context->preference('maxItemsinSearchResults') )
1425           ? C4::Context->preference('maxItemsinSearchResults') - 1
1426           : 1;
1427         for my $key ( sort keys %$onloan_items ) {
1428             (++$onloanitemscount > $maxitems) and last;
1429             push @onloan_items_loop, $onloan_items->{$key};
1430         }
1431         for my $key ( sort keys %$other_items ) {
1432             (++$otheritemscount > $maxitems) and last;
1433             push @other_items_loop, $other_items->{$key};
1434         }
1435         for my $key ( sort keys %$available_items ) {
1436             (++$availableitemscount > $maxitems) and last;
1437             push @available_items_loop, $available_items->{$key}
1438         }
1439
1440         # XSLT processing of some stuff
1441         if (C4::Context->preference("XSLTResultsDisplay") && !$scan) {
1442             $oldbiblio->{XSLTResultsRecord} = XSLTParse4Display(
1443                 $oldbiblio->{biblionumber}, $marcrecord, 'Results' );
1444         }
1445
1446         # last check for norequest : if itemtype is notforloan, it can't be reserved either, whatever the items
1447         $can_place_holds = 0
1448           if $itemtypes{ $oldbiblio->{itemtype} }->{notforloan};
1449         $oldbiblio->{norequests} = 1 unless $can_place_holds;
1450         $oldbiblio->{itemsplural}          = 1 if $items_count > 1;
1451         $oldbiblio->{items_count}          = $items_count;
1452         $oldbiblio->{available_items_loop} = \@available_items_loop;
1453         $oldbiblio->{onloan_items_loop}    = \@onloan_items_loop;
1454         $oldbiblio->{other_items_loop}     = \@other_items_loop;
1455         $oldbiblio->{availablecount}       = $available_count;
1456         $oldbiblio->{availableplural}      = 1 if $available_count > 1;
1457         $oldbiblio->{onloancount}          = $onloan_count;
1458         $oldbiblio->{onloanplural}         = 1 if $onloan_count > 1;
1459         $oldbiblio->{othercount}           = $other_count;
1460         $oldbiblio->{otherplural}          = 1 if $other_count > 1;
1461         $oldbiblio->{wthdrawncount}        = $wthdrawn_count;
1462         $oldbiblio->{itemlostcount}        = $itemlost_count;
1463         $oldbiblio->{damagedcount}         = $itemdamaged_count;
1464         $oldbiblio->{intransitcount}       = $item_in_transit_count;
1465         $oldbiblio->{orderedcount}         = $ordered_count;
1466         push( @newresults, $oldbiblio );
1467     }
1468     return @newresults;
1469 }
1470
1471 #----------------------------------------------------------------------
1472 #
1473 # Non-Zebra GetRecords#
1474 #----------------------------------------------------------------------
1475
1476 =head2 NZgetRecords
1477
1478   NZgetRecords has the same API as zera getRecords, even if some parameters are not managed
1479
1480 =cut
1481
1482 sub NZgetRecords {
1483     my (
1484         $query,            $simple_query, $sort_by_ref,    $servers_ref,
1485         $results_per_page, $offset,       $expanded_facet, $branches,
1486         $query_type,       $scan
1487     ) = @_;
1488     warn "query =$query" if $DEBUG;
1489     my $result = NZanalyse($query);
1490     warn "results =$result" if $DEBUG;
1491     return ( undef,
1492         NZorder( $result, @$sort_by_ref[0], $results_per_page, $offset ),
1493         undef );
1494 }
1495
1496 =head2 NZanalyse
1497
1498   NZanalyse : get a CQL string as parameter, and returns a list of biblionumber;title,biblionumber;title,...
1499   the list is built from an inverted index in the nozebra SQL table
1500   note that title is here only for convenience : the sorting will be very fast when requested on title
1501   if the sorting is requested on something else, we will have to reread all results, and that may be longer.
1502
1503 =cut
1504
1505 sub NZanalyse {
1506     my ( $string, $server ) = @_;
1507 #     warn "---------"       if $DEBUG;
1508     warn " NZanalyse" if $DEBUG;
1509 #     warn "---------"       if $DEBUG;
1510
1511  # $server contains biblioserver or authorities, depending on what we search on.
1512  #warn "querying : $string on $server";
1513     $server = 'biblioserver' unless $server;
1514
1515 # if we have a ", replace the content to discard temporarily any and/or/not inside
1516     my $commacontent;
1517     if ( $string =~ /"/ ) {
1518         $string =~ s/"(.*?)"/__X__/;
1519         $commacontent = $1;
1520         warn "commacontent : $commacontent" if $DEBUG;
1521     }
1522
1523 # split the query string in 3 parts : X AND Y means : $left="X", $operand="AND" and $right="Y"
1524 # then, call again NZanalyse with $left and $right
1525 # (recursive until we find a leaf (=> something without and/or/not)
1526 # delete repeated operator... Would then go in infinite loop
1527     while ( $string =~ s/( and| or| not| AND| OR| NOT)\1/$1/g ) {
1528     }
1529
1530     #process parenthesis before.
1531     if ( $string =~ /^\s*\((.*)\)(( and | or | not | AND | OR | NOT )(.*))?/ ) {
1532         my $left     = $1;
1533         my $right    = $4;
1534         my $operator = lc($3);   # FIXME: and/or/not are operators, not operands
1535         warn
1536 "dealing w/parenthesis before recursive sub call. left :$left operator:$operator right:$right"
1537           if $DEBUG;
1538         my $leftresult = NZanalyse( $left, $server );
1539         if ($operator) {
1540             my $rightresult = NZanalyse( $right, $server );
1541
1542             # OK, we have the results for right and left part of the query
1543             # depending of operand, intersect, union or exclude both lists
1544             # to get a result list
1545             if ( $operator eq ' and ' ) {
1546                 return NZoperatorAND($leftresult,$rightresult);
1547             }
1548             elsif ( $operator eq ' or ' ) {
1549
1550                 # just merge the 2 strings
1551                 return $leftresult . $rightresult;
1552             }
1553             elsif ( $operator eq ' not ' ) {
1554                 return NZoperatorNOT($leftresult,$rightresult);
1555             }
1556         }
1557         else {
1558 # this error is impossible, because of the regexp that isolate the operand, but just in case...
1559             return $leftresult;
1560         }
1561     }
1562     warn "string :" . $string if $DEBUG;
1563     my $left = "";
1564     my $right = "";
1565     my $operator = "";
1566     if ($string =~ /(.*?)( and | or | not | AND | OR | NOT )(.*)/) {
1567         $left     = $1;
1568         $right    = $3;
1569         $operator = lc($2);    # FIXME: and/or/not are operators, not operands
1570     }
1571     warn "no parenthesis. left : $left operator: $operator right: $right"
1572       if $DEBUG;
1573
1574     # it's not a leaf, we have a and/or/not
1575     if ($operator) {
1576
1577         # reintroduce comma content if needed
1578         $right =~ s/__X__/"$commacontent"/ if $commacontent;
1579         $left  =~ s/__X__/"$commacontent"/ if $commacontent;
1580         warn "node : $left / $operator / $right\n" if $DEBUG;
1581         my $leftresult  = NZanalyse( $left,  $server );
1582         my $rightresult = NZanalyse( $right, $server );
1583         warn " leftresult : $leftresult" if $DEBUG;
1584         warn " rightresult : $rightresult" if $DEBUG;
1585         # OK, we have the results for right and left part of the query
1586         # depending of operand, intersect, union or exclude both lists
1587         # to get a result list
1588         if ( $operator eq ' and ' ) {
1589             warn "NZAND";
1590             return NZoperatorAND($leftresult,$rightresult);
1591         }
1592         elsif ( $operator eq ' or ' ) {
1593
1594             # just merge the 2 strings
1595             return $leftresult . $rightresult;
1596         }
1597         elsif ( $operator eq ' not ' ) {
1598             return NZoperatorNOT($leftresult,$rightresult);
1599         }
1600         else {
1601
1602 # this error is impossible, because of the regexp that isolate the operand, but just in case...
1603             die "error : operand unknown : $operator for $string";
1604         }
1605
1606         # it's a leaf, do the real SQL query and return the result
1607     }
1608     else {
1609         $string =~ s/__X__/"$commacontent"/ if $commacontent;
1610         $string =~ s/-|\.|\?|,|;|!|'|\(|\)|\[|\]|{|}|"|&|\+|\*|\// /g;
1611         #remove trailing blank at the beginning
1612         $string =~ s/^ //g;
1613         warn "leaf:$string" if $DEBUG;
1614
1615         # parse the string in in operator/operand/value again
1616         my $left = "";
1617         my $operator = "";
1618         my $right = "";
1619         if ($string =~ /(.*)(>=|<=)(.*)/) {
1620             $left     = $1;
1621             $operator = $2;
1622             $right    = $3;
1623         } else {
1624             $left = $string;
1625         }
1626 #         warn "handling leaf... left:$left operator:$operator right:$right"
1627 #           if $DEBUG;
1628         unless ($operator) {
1629             if ($string =~ /(.*)(>|<|=)(.*)/) {
1630                 $left     = $1;
1631                 $operator = $2;
1632                 $right    = $3;
1633                 warn
1634     "handling unless (operator)... left:$left operator:$operator right:$right"
1635                 if $DEBUG;
1636             } else {
1637                 $left = $string;
1638             }
1639         }
1640         my $results;
1641
1642 # strip adv, zebra keywords, currently not handled in nozebra: wrdl, ext, phr...
1643         $left =~ s/ .*$//;
1644
1645         # automatic replace for short operators
1646         $left = 'title'            if $left =~ '^ti$';
1647         $left = 'author'           if $left =~ '^au$';
1648         $left = 'publisher'        if $left =~ '^pb$';
1649         $left = 'subject'          if $left =~ '^su$';
1650         $left = 'koha-Auth-Number' if $left =~ '^an$';
1651         $left = 'keyword'          if $left =~ '^kw$';
1652         $left = 'itemtype'         if $left =~ '^mc$'; # Fix for Bug 2599 - Search limits not working for NoZebra
1653         warn "handling leaf... left:$left operator:$operator right:$right" if $DEBUG;
1654         my $dbh = C4::Context->dbh;
1655         if ( $operator && $left ne 'keyword' ) {
1656             #do a specific search
1657             $operator = 'LIKE' if $operator eq '=' and $right =~ /%/;
1658             my $sth = $dbh->prepare(
1659 "SELECT biblionumbers,value FROM nozebra WHERE server=? AND indexname=? AND value $operator ?"
1660             );
1661             warn "$left / $operator / $right\n" if $DEBUG;
1662
1663             # split each word, query the DB and build the biblionumbers result
1664             #sanitizing leftpart
1665             $left =~ s/^\s+|\s+$//;
1666             foreach ( split / /, $right ) {
1667                 my $biblionumbers;
1668                 $_ =~ s/^\s+|\s+$//;
1669                 next unless $_;
1670                 warn "EXECUTE : $server, $left, $_" if $DEBUG;
1671                 $sth->execute( $server, $left, $_ )
1672                   or warn "execute failed: $!";
1673                 while ( my ( $line, $value ) = $sth->fetchrow ) {
1674
1675 # if we are dealing with a numeric value, use only numeric results (in case of >=, <=, > or <)
1676 # otherwise, fill the result
1677                     $biblionumbers .= $line
1678                       unless ( $right =~ /^\d+$/ && $value =~ /\D/ );
1679                     warn "result : $value "
1680                       . ( $right  =~ /\d/ ) . "=="
1681                       . ( $value =~ /\D/?$line:"" ) if $DEBUG;         #= $line";
1682                 }
1683
1684 # do a AND with existing list if there is one, otherwise, use the biblionumbers list as 1st result list
1685                 if ($results) {
1686                     warn "NZAND" if $DEBUG;
1687                     $results = NZoperatorAND($biblionumbers,$results);
1688                 } else {
1689                     $results = $biblionumbers;
1690                 }
1691             }
1692         }
1693         else {
1694       #do a complete search (all indexes), if index='kw' do complete search too.
1695             my $sth = $dbh->prepare(
1696 "SELECT biblionumbers FROM nozebra WHERE server=? AND value LIKE ?"
1697             );
1698
1699             # split each word, query the DB and build the biblionumbers result
1700             foreach ( split / /, $string ) {
1701                 next if C4::Context->stopwords->{ uc($_) };   # skip if stopword
1702                 warn "search on all indexes on $_" if $DEBUG;
1703                 my $biblionumbers;
1704                 next unless $_;
1705                 $sth->execute( $server, $_ );
1706                 while ( my $line = $sth->fetchrow ) {
1707                     $biblionumbers .= $line;
1708                 }
1709
1710 # do a AND with existing list if there is one, otherwise, use the biblionumbers list as 1st result list
1711                 if ($results) {
1712                     $results = NZoperatorAND($biblionumbers,$results);
1713                 }
1714                 else {
1715                     warn "NEW RES for $_ = $biblionumbers" if $DEBUG;
1716                     $results = $biblionumbers;
1717                 }
1718             }
1719         }
1720         warn "return : $results for LEAF : $string" if $DEBUG;
1721         return $results;
1722     }
1723     warn "---------\nLeave NZanalyse\n---------" if $DEBUG;
1724 }
1725
1726 sub NZoperatorAND{
1727     my ($rightresult, $leftresult)=@_;
1728
1729     my @leftresult = split /;/, $leftresult;
1730     warn " @leftresult / $rightresult \n" if $DEBUG;
1731
1732     #             my @rightresult = split /;/,$leftresult;
1733     my $finalresult;
1734
1735 # parse the left results, and if the biblionumber exist in the right result, save it in finalresult
1736 # the result is stored twice, to have the same weight for AND than OR.
1737 # example : TWO : 61,61,64,121 (two is twice in the biblio #61) / TOWER : 61,64,130
1738 # result : 61,61,61,61,64,64 for two AND tower : 61 has more weight than 64
1739     foreach (@leftresult) {
1740         my $value = $_;
1741         my $countvalue;
1742         ( $value, $countvalue ) = ( $1, $2 ) if ($value=~/(.*)-(\d+)$/);
1743         if ( $rightresult =~ /\Q$value\E-(\d+);/ ) {
1744             $countvalue = ( $1 > $countvalue ? $countvalue : $1 );
1745             $finalresult .=
1746                 "$value-$countvalue;$value-$countvalue;";
1747         }
1748     }
1749     warn "NZAND DONE : $finalresult \n" if $DEBUG;
1750     return $finalresult;
1751 }
1752
1753 sub NZoperatorOR{
1754     my ($rightresult, $leftresult)=@_;
1755     return $rightresult.$leftresult;
1756 }
1757
1758 sub NZoperatorNOT{
1759     my ($leftresult, $rightresult)=@_;
1760
1761     my @leftresult = split /;/, $leftresult;
1762
1763     #             my @rightresult = split /;/,$leftresult;
1764     my $finalresult;
1765     foreach (@leftresult) {
1766         my $value=$_;
1767         $value=$1 if $value=~m/(.*)-\d+$/;
1768         unless ($rightresult =~ "$value-") {
1769             $finalresult .= "$_;";
1770         }
1771     }
1772     return $finalresult;
1773 }
1774
1775 =head2 NZorder
1776
1777   $finalresult = NZorder($biblionumbers, $ordering,$results_per_page,$offset);
1778
1779   TODO :: Description
1780
1781 =cut
1782
1783 sub NZorder {
1784     my ( $biblionumbers, $ordering, $results_per_page, $offset ) = @_;
1785     warn "biblionumbers = $biblionumbers and ordering = $ordering\n" if $DEBUG;
1786
1787     # order title asc by default
1788     #     $ordering = '1=36 <i' unless $ordering;
1789     $results_per_page = 20 unless $results_per_page;
1790     $offset           = 0  unless $offset;
1791     my $dbh = C4::Context->dbh;
1792
1793     #
1794     # order by POPULARITY
1795     #
1796     if ( $ordering =~ /popularity/ ) {
1797         my %result;
1798         my %popularity;
1799
1800         # popularity is not in MARC record, it's builded from a specific query
1801         my $sth =
1802           $dbh->prepare("select sum(issues) from items where biblionumber=?");
1803         foreach ( split /;/, $biblionumbers ) {
1804             my ( $biblionumber, $title ) = split /,/, $_;
1805             $result{$biblionumber} = GetMarcBiblio($biblionumber);
1806             $sth->execute($biblionumber);
1807             my $popularity = $sth->fetchrow || 0;
1808
1809 # hint : the key is popularity.title because we can have
1810 # many results with the same popularity. In this case, sub-ordering is done by title
1811 # we also have biblionumber to avoid bug for 2 biblios with the same title & popularity
1812 # (un-frequent, I agree, but we won't forget anything that way ;-)
1813             $popularity{ sprintf( "%10d", $popularity ) . $title
1814                   . $biblionumber } = $biblionumber;
1815         }
1816
1817     # sort the hash and return the same structure as GetRecords (Zebra querying)
1818         my $result_hash;
1819         my $numbers = 0;
1820         if ( $ordering eq 'popularity_dsc' ) {    # sort popularity DESC
1821             foreach my $key ( sort { $b cmp $a } ( keys %popularity ) ) {
1822                 $result_hash->{'RECORDS'}[ $numbers++ ] =
1823                   $result{ $popularity{$key} }->as_usmarc();
1824             }
1825         }
1826         else {                                    # sort popularity ASC
1827             foreach my $key ( sort ( keys %popularity ) ) {
1828                 $result_hash->{'RECORDS'}[ $numbers++ ] =
1829                   $result{ $popularity{$key} }->as_usmarc();
1830             }
1831         }
1832         my $finalresult = ();
1833         $result_hash->{'hits'}         = $numbers;
1834         $finalresult->{'biblioserver'} = $result_hash;
1835         return $finalresult;
1836
1837         #
1838         # ORDER BY author
1839         #
1840     }
1841     elsif ( $ordering =~ /author/ ) {
1842         my %result;
1843         foreach ( split /;/, $biblionumbers ) {
1844             my ( $biblionumber, $title ) = split /,/, $_;
1845             my $record = GetMarcBiblio($biblionumber);
1846             my $author;
1847             if ( C4::Context->preference('marcflavour') eq 'UNIMARC' ) {
1848                 $author = $record->subfield( '200', 'f' );
1849                 $author = $record->subfield( '700', 'a' ) unless $author;
1850             }
1851             else {
1852                 $author = $record->subfield( '100', 'a' );
1853             }
1854
1855 # hint : the result is sorted by title.biblionumber because we can have X biblios with the same title
1856 # and we don't want to get only 1 result for each of them !!!
1857             $result{ $author . $biblionumber } = $record;
1858         }
1859
1860     # sort the hash and return the same structure as GetRecords (Zebra querying)
1861         my $result_hash;
1862         my $numbers = 0;
1863         if ( $ordering eq 'author_za' ) {    # sort by author desc
1864             foreach my $key ( sort { $b cmp $a } ( keys %result ) ) {
1865                 $result_hash->{'RECORDS'}[ $numbers++ ] =
1866                   $result{$key}->as_usmarc();
1867             }
1868         }
1869         else {                               # sort by author ASC
1870             foreach my $key ( sort ( keys %result ) ) {
1871                 $result_hash->{'RECORDS'}[ $numbers++ ] =
1872                   $result{$key}->as_usmarc();
1873             }
1874         }
1875         my $finalresult = ();
1876         $result_hash->{'hits'}         = $numbers;
1877         $finalresult->{'biblioserver'} = $result_hash;
1878         return $finalresult;
1879
1880         #
1881         # ORDER BY callnumber
1882         #
1883     }
1884     elsif ( $ordering =~ /callnumber/ ) {
1885         my %result;
1886         foreach ( split /;/, $biblionumbers ) {
1887             my ( $biblionumber, $title ) = split /,/, $_;
1888             my $record = GetMarcBiblio($biblionumber);
1889             my $callnumber;
1890             my $frameworkcode = GetFrameworkCode($biblionumber);
1891             my ( $callnumber_tag, $callnumber_subfield ) = GetMarcFromKohaField(  'items.itemcallnumber', $frameworkcode);
1892                ( $callnumber_tag, $callnumber_subfield ) = GetMarcFromKohaField('biblioitems.callnumber', $frameworkcode)
1893                 unless $callnumber_tag;
1894             if ( C4::Context->preference('marcflavour') eq 'UNIMARC' ) {
1895                 $callnumber = $record->subfield( '200', 'f' );
1896             } else {
1897                 $callnumber = $record->subfield( '100', 'a' );
1898             }
1899
1900 # hint : the result is sorted by title.biblionumber because we can have X biblios with the same title
1901 # and we don't want to get only 1 result for each of them !!!
1902             $result{ $callnumber . $biblionumber } = $record;
1903         }
1904
1905     # sort the hash and return the same structure as GetRecords (Zebra querying)
1906         my $result_hash;
1907         my $numbers = 0;
1908         if ( $ordering eq 'call_number_dsc' ) {    # sort by title desc
1909             foreach my $key ( sort { $b cmp $a } ( keys %result ) ) {
1910                 $result_hash->{'RECORDS'}[ $numbers++ ] =
1911                   $result{$key}->as_usmarc();
1912             }
1913         }
1914         else {                                     # sort by title ASC
1915             foreach my $key ( sort { $a cmp $b } ( keys %result ) ) {
1916                 $result_hash->{'RECORDS'}[ $numbers++ ] =
1917                   $result{$key}->as_usmarc();
1918             }
1919         }
1920         my $finalresult = ();
1921         $result_hash->{'hits'}         = $numbers;
1922         $finalresult->{'biblioserver'} = $result_hash;
1923         return $finalresult;
1924     }
1925     elsif ( $ordering =~ /pubdate/ ) {             #pub year
1926         my %result;
1927         foreach ( split /;/, $biblionumbers ) {
1928             my ( $biblionumber, $title ) = split /,/, $_;
1929             my $record = GetMarcBiblio($biblionumber);
1930             my ( $publicationyear_tag, $publicationyear_subfield ) =
1931               GetMarcFromKohaField( 'biblioitems.publicationyear', '' );
1932             my $publicationyear =
1933               $record->subfield( $publicationyear_tag,
1934                 $publicationyear_subfield );
1935
1936 # hint : the result is sorted by title.biblionumber because we can have X biblios with the same title
1937 # and we don't want to get only 1 result for each of them !!!
1938             $result{ $publicationyear . $biblionumber } = $record;
1939         }
1940
1941     # sort the hash and return the same structure as GetRecords (Zebra querying)
1942         my $result_hash;
1943         my $numbers = 0;
1944         if ( $ordering eq 'pubdate_dsc' ) {    # sort by pubyear desc
1945             foreach my $key ( sort { $b cmp $a } ( keys %result ) ) {
1946                 $result_hash->{'RECORDS'}[ $numbers++ ] =
1947                   $result{$key}->as_usmarc();
1948             }
1949         }
1950         else {                                 # sort by pub year ASC
1951             foreach my $key ( sort ( keys %result ) ) {
1952                 $result_hash->{'RECORDS'}[ $numbers++ ] =
1953                   $result{$key}->as_usmarc();
1954             }
1955         }
1956         my $finalresult = ();
1957         $result_hash->{'hits'}         = $numbers;
1958         $finalresult->{'biblioserver'} = $result_hash;
1959         return $finalresult;
1960
1961         #
1962         # ORDER BY title
1963         #
1964     }
1965     elsif ( $ordering =~ /title/ ) {
1966
1967 # the title is in the biblionumbers string, so we just need to build a hash, sort it and return
1968         my %result;
1969         foreach ( split /;/, $biblionumbers ) {
1970             my ( $biblionumber, $title ) = split /,/, $_;
1971
1972 # hint : the result is sorted by title.biblionumber because we can have X biblios with the same title
1973 # and we don't want to get only 1 result for each of them !!!
1974 # hint & speed improvement : we can order without reading the record
1975 # so order, and read records only for the requested page !
1976             $result{ $title . $biblionumber } = $biblionumber;
1977         }
1978
1979     # sort the hash and return the same structure as GetRecords (Zebra querying)
1980         my $result_hash;
1981         my $numbers = 0;
1982         if ( $ordering eq 'title_az' ) {    # sort by title desc
1983             foreach my $key ( sort ( keys %result ) ) {
1984                 $result_hash->{'RECORDS'}[ $numbers++ ] = $result{$key};
1985             }
1986         }
1987         else {                              # sort by title ASC
1988             foreach my $key ( sort { $b cmp $a } ( keys %result ) ) {
1989                 $result_hash->{'RECORDS'}[ $numbers++ ] = $result{$key};
1990             }
1991         }
1992
1993         # limit the $results_per_page to result size if it's more
1994         $results_per_page = $numbers - 1 if $numbers < $results_per_page;
1995
1996         # for the requested page, replace biblionumber by the complete record
1997         # speed improvement : avoid reading too much things
1998         for (
1999             my $counter = $offset ;
2000             $counter <= $offset + $results_per_page ;
2001             $counter++
2002           )
2003         {
2004             $result_hash->{'RECORDS'}[$counter] =
2005               GetMarcBiblio( $result_hash->{'RECORDS'}[$counter] )->as_usmarc;
2006         }
2007         my $finalresult = ();
2008         $result_hash->{'hits'}         = $numbers;
2009         $finalresult->{'biblioserver'} = $result_hash;
2010         return $finalresult;
2011     }
2012     else {
2013
2014 #
2015 # order by ranking
2016 #
2017 # we need 2 hashes to order by ranking : the 1st one to count the ranking, the 2nd to order by ranking
2018         my %result;
2019         my %count_ranking;
2020         foreach ( split /;/, $biblionumbers ) {
2021             my ( $biblionumber, $title ) = split /,/, $_;
2022             $title =~ /(.*)-(\d)/;
2023
2024             # get weight
2025             my $ranking = $2;
2026
2027 # note that we + the ranking because ranking is calculated on weight of EACH term requested.
2028 # if we ask for "two towers", and "two" has weight 2 in biblio N, and "towers" has weight 4 in biblio N
2029 # biblio N has ranking = 6
2030             $count_ranking{$biblionumber} += $ranking;
2031         }
2032
2033 # build the result by "inverting" the count_ranking hash
2034 # 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
2035 #         warn "counting";
2036         foreach ( keys %count_ranking ) {
2037             $result{ sprintf( "%10d", $count_ranking{$_} ) . '-' . $_ } = $_;
2038         }
2039
2040     # sort the hash and return the same structure as GetRecords (Zebra querying)
2041         my $result_hash;
2042         my $numbers = 0;
2043         foreach my $key ( sort { $b cmp $a } ( keys %result ) ) {
2044             $result_hash->{'RECORDS'}[ $numbers++ ] = $result{$key};
2045         }
2046
2047         # limit the $results_per_page to result size if it's more
2048         $results_per_page = $numbers - 1 if $numbers < $results_per_page;
2049
2050         # for the requested page, replace biblionumber by the complete record
2051         # speed improvement : avoid reading too much things
2052         for (
2053             my $counter = $offset ;
2054             $counter <= $offset + $results_per_page ;
2055             $counter++
2056           )
2057         {
2058             $result_hash->{'RECORDS'}[$counter] =
2059               GetMarcBiblio( $result_hash->{'RECORDS'}[$counter] )->as_usmarc
2060               if $result_hash->{'RECORDS'}[$counter];
2061         }
2062         my $finalresult = ();
2063         $result_hash->{'hits'}         = $numbers;
2064         $finalresult->{'biblioserver'} = $result_hash;
2065         return $finalresult;
2066     }
2067 }
2068
2069 =head2 enabled_staff_search_views
2070
2071 %hash = enabled_staff_search_views()
2072
2073 This function returns a hash that contains three flags obtained from the system
2074 preferences, used to determine whether a particular staff search results view
2075 is enabled.
2076
2077 =over 2
2078
2079 =item C<Output arg:>
2080
2081     * $hash{can_view_MARC} is true only if the MARC view is enabled
2082     * $hash{can_view_ISBD} is true only if the ISBD view is enabled
2083     * $hash{can_view_labeledMARC} is true only if the Labeled MARC view is enabled
2084
2085 =item C<usage in the script:>
2086
2087 =back
2088
2089 $template->param ( C4::Search::enabled_staff_search_views );
2090
2091 =cut
2092
2093 sub enabled_staff_search_views
2094 {
2095         return (
2096                 can_view_MARC                   => C4::Context->preference('viewMARC'),                 # 1 if the staff search allows the MARC view
2097                 can_view_ISBD                   => C4::Context->preference('viewISBD'),                 # 1 if the staff search allows the ISBD view
2098                 can_view_labeledMARC    => C4::Context->preference('viewLabeledMARC'),  # 1 if the staff search allows the Labeled MARC view
2099         );
2100 }
2101
2102 sub AddSearchHistory{
2103         my ($borrowernumber,$session,$query_desc,$query_cgi, $total)=@_;
2104     my $dbh = C4::Context->dbh;
2105
2106     # Add the request the user just made
2107     my $sql = "INSERT INTO search_history(userid, sessionid, query_desc, query_cgi, total, time) VALUES(?, ?, ?, ?, ?, NOW())";
2108     my $sth   = $dbh->prepare($sql);
2109     $sth->execute($borrowernumber, $session, $query_desc, $query_cgi, $total);
2110         return $dbh->last_insert_id(undef, 'search_history', undef,undef,undef);
2111 }
2112
2113 sub GetSearchHistory{
2114         my ($borrowernumber,$session)=@_;
2115     my $dbh = C4::Context->dbh;
2116
2117     # Add the request the user just made
2118     my $query = "SELECT FROM search_history WHERE (userid=? OR sessionid=?)";
2119     my $sth   = $dbh->prepare($query);
2120         $sth->execute($borrowernumber, $session);
2121     return  $sth->fetchall_hashref({});
2122 }
2123
2124 =head2 z3950_search_args
2125
2126 $arrayref = z3950_search_args($matchpoints)
2127
2128 This function returns an array reference that contains the search parameters to be
2129 passed to the Z39.50 search script (z3950_search.pl). The array elements
2130 are hash refs whose keys are name, value and encvalue, and whose values are the
2131 name of a search parameter, the value of that search parameter and the URL encoded
2132 value of that parameter.
2133
2134 The search parameter names are lccn, isbn, issn, title, author, dewey and subject.
2135
2136 The search parameter values are obtained from the bibliographic record whose
2137 data is in a hash reference in $matchpoints, as returned by Biblio::GetBiblioData().
2138
2139 If $matchpoints is a scalar, it is assumed to be an unnamed query descriptor, e.g.
2140 a general purpose search argument. In this case, the returned array contains only
2141 entry: the key is 'title' and the value and encvalue are derived from $matchpoints.
2142
2143 If a search parameter value is undefined or empty, it is not included in the returned
2144 array.
2145
2146 The returned array reference may be passed directly to the template parameters.
2147
2148 =over 2
2149
2150 =item C<Output arg:>
2151
2152     * $array containing hash refs as described above
2153
2154 =item C<usage in the script:>
2155
2156 =back
2157
2158 $data = Biblio::GetBiblioData($bibno);
2159 $template->param ( MYLOOP => C4::Search::z3950_search_args($data) )
2160
2161 *OR*
2162
2163 $template->param ( MYLOOP => C4::Search::z3950_search_args($searchscalar) )
2164
2165 =cut
2166
2167 sub z3950_search_args {
2168     my $bibrec = shift;
2169     $bibrec = { title => $bibrec } if !ref $bibrec;
2170     my $array = [];
2171     for my $field (qw/ lccn isbn issn title author dewey subject /)
2172     {
2173         my $encvalue = URI::Escape::uri_escape_utf8($bibrec->{$field});
2174         push @$array, { name=>$field, value=>$bibrec->{$field}, encvalue=>$encvalue } if defined $bibrec->{$field};
2175     }
2176     return $array;
2177 }
2178
2179 =head2 BiblioAddAuthorities
2180
2181 ( $countlinked, $countcreated ) = BiblioAddAuthorities($record, $frameworkcode);
2182
2183 this function finds the authorities linked to the biblio
2184     * search in the authority DB for the same authid (in $9 of the biblio)
2185     * search in the authority DB for the same 001 (in $3 of the biblio in UNIMARC)
2186     * search in the authority DB for the same values (exactly) (in all subfields of the biblio)
2187 OR adds a new authority record
2188
2189 =over 2
2190
2191 =item C<input arg:>
2192
2193     * $record is the MARC record in question (marc blob)
2194     * $frameworkcode is the bibliographic framework to use (if it is "" it uses the default framework)
2195
2196 =item C<Output arg:>
2197
2198     * $countlinked is the number of authorities records that are linked to this authority
2199     * $countcreated
2200
2201 =item C<BUGS>
2202     * 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)
2203 =back
2204
2205 =cut
2206
2207
2208 sub BiblioAddAuthorities{
2209   my ( $record, $frameworkcode ) = @_;
2210   my $dbh=C4::Context->dbh;
2211   my $query=$dbh->prepare(qq|
2212 SELECT authtypecode,tagfield
2213 FROM marc_subfield_structure
2214 WHERE frameworkcode=?
2215 AND (authtypecode IS NOT NULL AND authtypecode<>\"\")|);
2216 # SELECT authtypecode,tagfield
2217 # FROM marc_subfield_structure
2218 # WHERE frameworkcode=?
2219 # AND (authtypecode IS NOT NULL OR authtypecode<>\"\")|);
2220   $query->execute($frameworkcode);
2221   my ($countcreated,$countlinked);
2222   while (my $data=$query->fetchrow_hashref){
2223     foreach my $field ($record->field($data->{tagfield})){
2224       next if ($field->subfield('3')||$field->subfield('9'));
2225       # No authorities id in the tag.
2226       # Search if there is any authorities to link to.
2227       my $query='at='.$data->{authtypecode}.' ';
2228       map {$query.= ' and he,ext="'.$_->[1].'"' if ($_->[0]=~/[A-z]/)}  $field->subfields();
2229       my ($error, $results, $total_hits)=SimpleSearch( $query, undef, undef, [ "authorityserver" ] );
2230     # there is only 1 result
2231           if ( $error ) {
2232         warn "BIBLIOADDSAUTHORITIES: $error";
2233             return (0,0) ;
2234           }
2235       if ($results && scalar(@$results)==1) {
2236         my $marcrecord = MARC::File::USMARC::decode($results->[0]);
2237         $field->add_subfields('9'=>$marcrecord->field('001')->data);
2238         $countlinked++;
2239       } elsif (scalar(@$results)>1) {
2240    #More than One result
2241    #This can comes out of a lack of a subfield.
2242 #         my $marcrecord = MARC::File::USMARC::decode($results->[0]);
2243 #         $record->field($data->{tagfield})->add_subfields('9'=>$marcrecord->field('001')->data);
2244   $countlinked++;
2245       } else {
2246   #There are no results, build authority record, add it to Authorities, get authid and add it to 9
2247   ###NOTICE : This is only valid if a subfield is linked to one and only one authtypecode
2248   ###NOTICE : This can be a problem. We should also look into other types and rejected forms.
2249          my $authtypedata=C4::AuthoritiesMarc->GetAuthType($data->{authtypecode});
2250          next unless $authtypedata;
2251          my $marcrecordauth=MARC::Record->new();
2252          my $authfield=MARC::Field->new($authtypedata->{auth_tag_to_report},'','',"a"=>"".$field->subfield('a'));
2253          map { $authfield->add_subfields($_->[0]=>$_->[1]) if ($_->[0]=~/[A-z]/ && $_->[0] ne "a" )}  $field->subfields();
2254          $marcrecordauth->insert_fields_ordered($authfield);
2255
2256          # bug 2317: ensure new authority knows it's using UTF-8; currently
2257          # only need to do this for MARC21, as MARC::Record->as_xml_record() handles
2258          # automatically for UNIMARC (by not transcoding)
2259          # FIXME: AddAuthority() instead should simply explicitly require that the MARC::Record
2260          # use UTF-8, but as of 2008-08-05, did not want to introduce that kind
2261          # of change to a core API just before the 3.0 release.
2262          if (C4::Context->preference('marcflavour') eq 'MARC21') {
2263             SetMarcUnicodeFlag($marcrecordauth, 'MARC21');
2264          }
2265
2266 #          warn "AUTH RECORD ADDED : ".$marcrecordauth->as_formatted;
2267
2268          my $authid=AddAuthority($marcrecordauth,'',$data->{authtypecode});
2269          $countcreated++;
2270          $field->add_subfields('9'=>$authid);
2271       }
2272     }
2273   }
2274   return ($countlinked,$countcreated);
2275 }
2276
2277 =head2 GetDistinctValues($field);
2278
2279 C<$field> is a reference to the fields array
2280
2281 =cut
2282
2283 sub GetDistinctValues {
2284     my ($fieldname,$string)=@_;
2285     # returns a reference to a hash of references to branches...
2286     if ($fieldname=~/\./){
2287                         my ($table,$column)=split /\./, $fieldname;
2288                         my $dbh = C4::Context->dbh;
2289                         warn "select DISTINCT($column) as value, count(*) as cnt from $table group by lib order by $column ";
2290                         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 ");
2291                         $sth->execute;
2292                         my $elements=$sth->fetchall_arrayref({});
2293                         return $elements;
2294    }
2295    else {
2296                 $string||= qq("");
2297                 my @servers=qw<biblioserver authorityserver>;
2298                 my (@zconns,@results);
2299         for ( my $i = 0 ; $i < @servers ; $i++ ) {
2300                 $zconns[$i] = C4::Context->Zconn( $servers[$i], 1 );
2301                         $results[$i] =
2302                       $zconns[$i]->scan(
2303                         ZOOM::Query::CCL2RPN->new( qq"$fieldname $string", $zconns[$i])
2304                       );
2305                 }
2306                 # The big moment: asynchronously retrieve results from all servers
2307                 my @elements;
2308                 while ( ( my $i = ZOOM::event( \@zconns ) ) != 0 ) {
2309                         my $ev = $zconns[ $i - 1 ]->last_event();
2310                         if ( $ev == ZOOM::Event::ZEND ) {
2311                                 next unless $results[ $i - 1 ];
2312                                 my $size = $results[ $i - 1 ]->size();
2313                                 if ( $size > 0 ) {
2314                       for (my $j=0;$j<$size;$j++){
2315                                                 my %hashscan;
2316                                                 @hashscan{qw(value cnt)}=$results[ $i - 1 ]->display_term($j);
2317                                                 push @elements, \%hashscan;
2318                                           }
2319                                 }
2320                         }
2321                 }
2322                 return \@elements;
2323    }
2324 }
2325
2326 END { }    # module clean-up code here (global destructor)
2327
2328 1;
2329 __END__
2330
2331 =head1 AUTHOR
2332
2333 Koha Developement team <info@koha.org>
2334
2335 =cut