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