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

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