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
 926                 # Remove Stopwords
 927                 if ($remove_stopwords) {
 928                     ( $operand, $stopwords_removed ) =
 929                       _remove_stopwords( $operand, $index );
 930                     warn "OPERAND w/out STOPWORDS: >$operand<" if $DEBUG;
 931                     warn "REMOVED STOPWORDS: @$stopwords_removed"
 932                       if ( $stopwords_removed && $DEBUG );
 933                 }
 934
 935                 if ($auto_truncation){
 936                                         $operand=~join(" ",map{ "$_*" }split (/\s+/,$operand));
 937                                 }
 938
 939                 # Detect Truncation
 940                 my $truncated_operand;
 941                 my( $nontruncated, $righttruncated, $lefttruncated,
 942                     $rightlefttruncated, $regexpr
 943                 ) = _detect_truncation( $operand, $index );
 944                 warn
 945 "TRUNCATION: NON:>@$nontruncated< RIGHT:>@$righttruncated< LEFT:>@$lefttruncated< RIGHTLEFT:>@$rightlefttruncated< REGEX:>@$regexpr<"
 946                   if $DEBUG;
 947
 948                 # Apply Truncation
 949                 if (
 950                     scalar(@$righttruncated) + scalar(@$lefttruncated) +
 951                     scalar(@$rightlefttruncated) > 0 )
 952                 {
 953
 954                # Don't field weight or add the index to the query, we do it here
 955                     $indexes_set = 1;
 956                     undef $weight_fields;
 957                     my $previous_truncation_operand;
 958                     if (scalar @$nontruncated) {
 959                         $truncated_operand .= "$index_plus @$nontruncated ";
 960                         $previous_truncation_operand = 1;
 961                     }
 962                     if (scalar @$righttruncated) {
 963                         $truncated_operand .= "and " if $previous_truncation_operand;
 964                         $truncated_operand .= $index_plus_comma . "rtrn:@$righttruncated ";
 965                         $previous_truncation_operand = 1;
 966                     }
 967                     if (scalar @$lefttruncated) {
 968                         $truncated_operand .= "and " if $previous_truncation_operand;
 969                         $truncated_operand .= $index_plus_comma . "ltrn:@$lefttruncated ";
 970                         $previous_truncation_operand = 1;
 971                     }
 972                     if (scalar @$rightlefttruncated) {
 973                         $truncated_operand .= "and " if $previous_truncation_operand;
 974                         $truncated_operand .= $index_plus_comma . "rltrn:@$rightlefttruncated ";
 975                         $previous_truncation_operand = 1;
 976                     }
 977                 }
 978                 $operand = $truncated_operand if $truncated_operand;
 979                 warn "TRUNCATED OPERAND: >$truncated_operand<" if $DEBUG;
 980
 981                 # Handle Stemming
 982                 my $stemmed_operand;
 983                 $stemmed_operand = _build_stemmed_operand($operand, $lang)
 984                                                                                 if $stemming;
 985
 986                 warn "STEMMED OPERAND: >$stemmed_operand<" if $DEBUG;
 987
 988                 # Handle Field Weighting
 989                 my $weighted_operand;
 990                 if ($weight_fields) {
 991                     $weighted_operand = _build_weighted_query( $operand, $stemmed_operand, $index );
 992                     $operand = $weighted_operand;
 993                     $indexes_set = 1;
 994                 }
 995
 996                 warn "FIELD WEIGHTED OPERAND: >$weighted_operand<" if $DEBUG;
 997
 998                 # If there's a previous operand, we need to add an operator
 999                 if ($previous_operand) {
1000
1001                     # User-specified operator
1002                     if ( $operators[ $i - 1 ] ) {
1003                         $query     .= " $operators[$i-1] ";
1004                         $query     .= " $index_plus " unless $indexes_set;
1005                         $query     .= " $operand";
1006                         $query_cgi .= "&op=$operators[$i-1]";
1007                         $query_cgi .= "&idx=$index" if $index;
1008                         $query_cgi .= "&q=$operands[$i]" if $operands[$i];
1009                         $query_desc .=
1010                           " $operators[$i-1] $index_plus $operands[$i]";
1011                     }
1012
1013                     # Default operator is and
1014                     else {
1015                         $query      .= " and ";
1016                         $query      .= "$index_plus " unless $indexes_set;
1017                         $query      .= "$operand";
1018                         $query_cgi  .= "&op=and&idx=$index" if $index;
1019                         $query_cgi  .= "&q=$operands[$i]" if $operands[$i];
1020                         $query_desc .= " and $index_plus $operands[$i]";
1021                     }
1022                 }
1023
1024                 # There isn't a pervious operand, don't need an operator
1025                 else {
1026
1027                     # Field-weighted queries already have indexes set
1028                     $query .= " $index_plus " unless $indexes_set;
1029                     $query .= $operand;
1030                     $query_desc .= " $index_plus $operands[$i]";
1031                     $query_cgi  .= "&idx=$index" if $index;
1032                     $query_cgi  .= "&q=$operands[$i]" if $operands[$i];
1033                     $previous_operand = 1;
1034                 }
1035             }    #/if $operands
1036         }    # /for
1037     }
1038     warn "QUERY BEFORE LIMITS: >$query<" if $DEBUG;
1039
1040     # add limits
1041     my $group_OR_limits;
1042     my $availability_limit;
1043     foreach my $this_limit (@limits) {
1044         if ( $this_limit =~ /available/ ) {
1045
1046 # 'available' is defined as (items.onloan is NULL) and (items.itemlost = 0)
1047 # In English:
1048 # all records not indexed in the onloan register (zebra) and all records with a value of lost equal to 0
1049             $availability_limit .=
1050 "( ( allrecords,AlwaysMatches='' not onloan,AlwaysMatches='') and (lost,st-numeric=0) )"; #or ( allrecords,AlwaysMatches='' not lost,AlwaysMatches='')) )";
1051             $limit_cgi  .= "&limit=available";
1052             $limit_desc .= "";
1053         }
1054
1055         # group_OR_limits, prefixed by mc-
1056         # OR every member of the group
1057         elsif ( $this_limit =~ /mc/ ) {
1058             $group_OR_limits .= " or " if $group_OR_limits;
1059             $limit_desc      .= " or " if $group_OR_limits;
1060             $group_OR_limits .= "$this_limit";
1061             $limit_cgi       .= "&limit=$this_limit";
1062             $limit_desc      .= " $this_limit";
1063         }
1064
1065         # Regular old limits
1066         else {
1067             $limit .= " and " if $limit || $query;
1068             $limit      .= "$this_limit";
1069             $limit_cgi  .= "&limit=$this_limit";
1070             if ($this_limit =~ /^branch:(.+)/) {
1071                 my $branchcode = $1;
1072                 my $branchname = GetBranchName($branchcode);
1073                 if (defined $branchname) {
1074                     $limit_desc .= " branch:$branchname";
1075                 } else {
1076                     $limit_desc .= " $this_limit";
1077                 }
1078             } else {
1079                 $limit_desc .= " $this_limit";
1080             }
1081         }
1082     }
1083     if ($group_OR_limits) {
1084         $limit .= " and " if ( $query || $limit );
1085         $limit .= "($group_OR_limits)";
1086     }
1087     if ($availability_limit) {
1088         $limit .= " and " if ( $query || $limit );
1089         $limit .= "($availability_limit)";
1090     }
1091
1092     # Normalize the query and limit strings
1093     $query =~ s/:/=/g;
1094     $limit =~ s/:/=/g;
1095     for ( $query, $query_desc, $limit, $limit_desc ) {
1096         s/  / /g;    # remove extra spaces
1097         s/^ //g;     # remove any beginning spaces
1098         s/ $//g;     # remove any ending spaces
1099         s/==/=/g;    # remove double == from query
1100     }
1101     $query_cgi =~ s/^&//; # remove unnecessary & from beginning of the query cgi
1102
1103     for ($query_cgi,$simple_query) {
1104         s/"//g;
1105     }
1106     # append the limit to the query
1107     $query .= " " . $limit;
1108
1109     # Warnings if DEBUG
1110     if ($DEBUG) {
1111         warn "QUERY:" . $query;
1112         warn "QUERY CGI:" . $query_cgi;
1113         warn "QUERY DESC:" . $query_desc;
1114         warn "LIMIT:" . $limit;
1115         warn "LIMIT CGI:" . $limit_cgi;
1116         warn "LIMIT DESC:" . $limit_desc;
1117         warn "---------\nLeave buildQuery\n---------";
1118     }
1119     return (
1120         undef,              $query, $simple_query, $query_cgi,
1121         $query_desc,        $limit, $limit_cgi,    $limit_desc,
1122         $stopwords_removed, $query_type
1123     );
1124 }
1125
1126 =head2 searchResults
1127
1128 Format results in a form suitable for passing to the template
1129
1130 =cut
1131
1132 # IMO this subroutine is pretty messy still -- it's responsible for
1133 # building the HTML output for the template
1134 sub searchResults {
1135     my ( $searchdesc, $hits, $results_per_page, $offset, $scan, @marcresults ) = @_;
1136     my $dbh = C4::Context->dbh;
1137     my @newresults;
1138
1139     #Build branchnames hash
1140     #find branchname
1141     #get branch information.....
1142     my %branches;
1143     my $bsth =$dbh->prepare("SELECT branchcode,branchname FROM branches"); # FIXME : use C4::Branch::GetBranches
1144     $bsth->execute();
1145     while ( my $bdata = $bsth->fetchrow_hashref ) {
1146         $branches{ $bdata->{'branchcode'} } = $bdata->{'branchname'};
1147     }
1148 # FIXME - We build an authorised values hash here, using the default framework
1149 # though it is possible to have different authvals for different fws.
1150
1151     my $shelflocations =GetKohaAuthorisedValues('items.location','');
1152
1153     # get notforloan authorised value list (see $shelflocations  FIXME)
1154     my $notforloan_authorised_value = GetAuthValCode('items.notforloan','');
1155
1156     #Build itemtype hash
1157     #find itemtype & itemtype image
1158     my %itemtypes;
1159     $bsth =
1160       $dbh->prepare(
1161         "SELECT itemtype,description,imageurl,summary,notforloan FROM itemtypes"
1162       );
1163     $bsth->execute();
1164     while ( my $bdata = $bsth->fetchrow_hashref ) {
1165                 foreach (qw(description imageurl summary notforloan)) {
1166                 $itemtypes{ $bdata->{'itemtype'} }->{$_} = $bdata->{$_};
1167                 }
1168     }
1169
1170     #search item field code
1171     my $sth =
1172       $dbh->prepare(
1173 "SELECT tagfield FROM marc_subfield_structure WHERE kohafield LIKE 'items.itemnumber'"
1174       );
1175     $sth->execute;
1176     my ($itemtag) = $sth->fetchrow;
1177
1178     ## find column names of items related to MARC
1179     my $sth2 = $dbh->prepare("SHOW COLUMNS FROM items");
1180     $sth2->execute;
1181     my %subfieldstosearch;
1182     while ( ( my $column ) = $sth2->fetchrow ) {
1183         my ( $tagfield, $tagsubfield ) =
1184           &GetMarcFromKohaField( "items." . $column, "" );
1185         $subfieldstosearch{$column} = $tagsubfield;
1186     }
1187
1188     # handle which records to actually retrieve
1189     my $times;
1190     if ( $hits && $offset + $results_per_page <= $hits ) {
1191         $times = $offset + $results_per_page;
1192     }
1193     else {
1194         $times = $hits;  # FIXME: if $hits is undefined, why do we want to equal it?
1195     }
1196
1197         my $marcflavour = C4::Context->preference("marcflavour");
1198     # We get the biblionumber position in MARC
1199     my ($bibliotag,$bibliosubf)=GetMarcFromKohaField('biblio.biblionumber','');
1200     my $fw;
1201
1202     # loop through all of the records we've retrieved
1203     for ( my $i = $offset ; $i <= $times - 1 ; $i++ ) {
1204         my $marcrecord = MARC::File::USMARC::decode( $marcresults[$i] );
1205
1206         if ($bibliotag<10){
1207             $fw = GetFrameworkCode($marcrecord->field($bibliotag)->data);
1208         }else{
1209             $fw = GetFrameworkCode($marcrecord->subfield($bibliotag,$bibliosubf));
1210         }
1211
1212         my $oldbiblio = TransformMarcToKoha( $dbh, $marcrecord, $fw );
1213         $oldbiblio->{subtitle} = GetRecordValue('subtitle', $marcrecord, $fw);
1214         $oldbiblio->{result_number} = $i + 1;
1215
1216         # add imageurl to itemtype if there is one
1217         $oldbiblio->{imageurl} = getitemtypeimagelocation( 'opac', $itemtypes{ $oldbiblio->{itemtype} }->{imageurl} );
1218
1219         $oldbiblio->{'authorised_value_images'}  = C4::Items::get_authorised_value_images( C4::Biblio::get_biblio_authorised_values( $oldbiblio->{'biblionumber'}, $marcrecord ) );
1220                 $oldbiblio->{normalized_upc}  = GetNormalizedUPC(       $marcrecord,$marcflavour);
1221                 $oldbiblio->{normalized_ean}  = GetNormalizedEAN(       $marcrecord,$marcflavour);
1222                 $oldbiblio->{normalized_oclc} = GetNormalizedOCLCNumber($marcrecord,$marcflavour);
1223                 $oldbiblio->{normalized_isbn} = GetNormalizedISBN(undef,$marcrecord,$marcflavour);
1224                 $oldbiblio->{content_identifier_exists} = 1 if ($oldbiblio->{normalized_isbn} or $oldbiblio->{normalized_oclc} or $oldbiblio->{normalized_ean} or $oldbiblio->{normalized_upc});
1225
1226                 # edition information, if any
1227         $oldbiblio->{edition} = $oldbiblio->{editionstatement};
1228                 $oldbiblio->{description} = $itemtypes{ $oldbiblio->{itemtype} }->{description};
1229  # Build summary if there is one (the summary is defined in the itemtypes table)
1230  # FIXME: is this used anywhere, I think it can be commented out? -- JF
1231         if ( $itemtypes{ $oldbiblio->{itemtype} }->{summary} ) {
1232             my $summary = $itemtypes{ $oldbiblio->{itemtype} }->{summary};
1233             my @fields  = $marcrecord->fields();
1234             foreach my $field (@fields) {
1235                 my $tag      = $field->tag();
1236                 my $tagvalue = $field->as_string();
1237                 $summary =~
1238                   s/\[(.?.?.?.?)$tag\*(.*?)]/$1$tagvalue$2\[$1$tag$2]/g;
1239                 unless ( $tag < 10 ) {
1240                     my @subf = $field->subfields;
1241                     for my $i ( 0 .. $#subf ) {
1242                         my $subfieldcode  = $subf[$i][0];
1243                         my $subfieldvalue = $subf[$i][1];
1244                         my $tagsubf       = $tag . $subfieldcode;
1245                         $summary =~
1246 s/\[(.?.?.?.?)$tagsubf(.*?)]/$1$subfieldvalue$2\[$1$tagsubf$2]/g;
1247                     }
1248                 }
1249             }
1250             # FIXME: yuk
1251             $summary =~ s/\[(.*?)]//g;
1252             $summary =~ s/\n/<br\/>/g;
1253             $oldbiblio->{summary} = $summary;
1254         }
1255
1256         # Pull out the items fields
1257         my @fields = $marcrecord->field($itemtag);
1258
1259         # Setting item statuses for display
1260         my @available_items_loop;
1261         my @onloan_items_loop;
1262         my @other_items_loop;
1263
1264         my $available_items;
1265         my $onloan_items;
1266         my $other_items;
1267
1268         my $ordered_count         = 0;
1269         my $available_count       = 0;
1270         my $onloan_count          = 0;
1271         my $longoverdue_count     = 0;
1272         my $other_count           = 0;
1273         my $wthdrawn_count        = 0;
1274         my $itemlost_count        = 0;
1275         my $itembinding_count     = 0;
1276         my $itemdamaged_count     = 0;
1277         my $item_in_transit_count = 0;
1278         my $can_place_holds       = 0;
1279         my $items_count           = scalar(@fields);
1280         my $maxitems =
1281           ( C4::Context->preference('maxItemsinSearchResults') )
1282           ? C4::Context->preference('maxItemsinSearchResults') - 1
1283           : 1;
1284
1285         # loop through every item
1286         foreach my $field (@fields) {
1287             my $item;
1288
1289             # populate the items hash
1290             foreach my $code ( keys %subfieldstosearch ) {
1291                 $item->{$code} = $field->subfield( $subfieldstosearch{$code} );
1292             }
1293                         my $hbranch     = C4::Context->preference('HomeOrHoldingBranch') eq 'homebranch' ? 'homebranch'    : 'holdingbranch';
1294                         my $otherbranch = C4::Context->preference('HomeOrHoldingBranch') eq 'homebranch' ? 'holdingbranch' : 'homebranch';
1295             # set item's branch name, use HomeOrHoldingBranch syspref first, fall back to the other one
1296             if ($item->{$hbranch}) {
1297                 $item->{'branchname'} = $branches{$item->{$hbranch}};
1298             }
1299             elsif ($item->{$otherbranch}) {     # Last resort
1300                 $item->{'branchname'} = $branches{$item->{$otherbranch}};
1301             }
1302
1303                         my $prefix = $item->{$hbranch} . '--' . $item->{location} . $item->{itype} . $item->{itemcallnumber};
1304 # For each grouping of items (onloan, available, unavailable), we build a key to store relevant info about that item
1305             if ( $item->{onloan} ) {
1306                 $onloan_count++;
1307                                 my $key = $prefix . $item->{onloan} . $item->{barcode};
1308                                 $onloan_items->{$key}->{due_date} = format_date($item->{onloan});
1309                                 $onloan_items->{$key}->{count}++ if $item->{$hbranch};
1310                                 $onloan_items->{$key}->{branchname} = $item->{branchname};
1311                                 $onloan_items->{$key}->{location} = $shelflocations->{ $item->{location} };
1312                                 $onloan_items->{$key}->{itemcallnumber} = $item->{itemcallnumber};
1313                                 $onloan_items->{$key}->{imageurl} = getitemtypeimagelocation( 'opac', $itemtypes{ $item->{itype} }->{imageurl} );
1314                 # if something's checked out and lost, mark it as 'long overdue'
1315                 if ( $item->{itemlost} ) {
1316                     $onloan_items->{$prefix}->{longoverdue}++;
1317                     $longoverdue_count++;
1318                 } else {        # can place holds as long as item isn't lost
1319                     $can_place_holds = 1;
1320                 }
1321             }
1322
1323          # items not on loan, but still unavailable ( lost, withdrawn, damaged )
1324             else {
1325
1326                 # item is on order
1327                 if ( $item->{notforloan} == -1 ) {
1328                     $ordered_count++;
1329                 }
1330
1331                 # is item in transit?
1332                 my $transfertwhen = '';
1333                 my ($transfertfrom, $transfertto);
1334
1335                 unless ($item->{wthdrawn}
1336                         || $item->{itemlost}
1337                         || $item->{damaged}
1338                         || $item->{notforloan}
1339                         || $items_count > 20) {
1340
1341                     # A couple heuristics to limit how many times
1342                     # we query the database for item transfer information, sacrificing
1343                     # accuracy in some cases for speed;
1344                     #
1345                     # 1. don't query if item has one of the other statuses
1346                     # 2. don't check transit status if the bib has
1347                     #    more than 20 items
1348                     #
1349                     # FIXME: to avoid having the query the database like this, and to make
1350                     #        the in transit status count as unavailable for search limiting,
1351                     #        should map transit status to record indexed in Zebra.
1352                     #
1353                     ($transfertwhen, $transfertfrom, $transfertto) = C4::Circulation::GetTransfers($item->{itemnumber});
1354                 }
1355
1356                 # item is withdrawn, lost or damaged
1357                 if (   $item->{wthdrawn}
1358                     || $item->{itemlost}
1359                     || $item->{damaged}
1360                     || $item->{notforloan}
1361                     || ($transfertwhen ne ''))
1362                 {
1363                     $wthdrawn_count++        if $item->{wthdrawn};
1364                     $itemlost_count++        if $item->{itemlost};
1365                     $itemdamaged_count++     if $item->{damaged};
1366                     $item_in_transit_count++ if $transfertwhen ne '';
1367                     $item->{status} = $item->{wthdrawn} . "-" . $item->{itemlost} . "-" . $item->{damaged} . "-" . $item->{notforloan};
1368                     $other_count++;
1369
1370                                         my $key = $prefix . $item->{status};
1371                                         foreach (qw(wthdrawn itemlost damaged branchname itemcallnumber)) {
1372                         $other_items->{$key}->{$_} = $item->{$_};
1373                                         }
1374                     $other_items->{$key}->{intransit} = ($transfertwhen ne '') ? 1 : 0;
1375                                         $other_items->{$key}->{notforloan} = GetAuthorisedValueDesc('','',$item->{notforloan},'','',$notforloan_authorised_value) if $notforloan_authorised_value;
1376                                         $other_items->{$key}->{count}++ if $item->{$hbranch};
1377                                         $other_items->{$key}->{location} = $shelflocations->{ $item->{location} };
1378                                         $other_items->{$key}->{imageurl} = getitemtypeimagelocation( 'opac', $itemtypes{ $item->{itype} }->{imageurl} );
1379                 }
1380                 # item is available
1381                 else {
1382                     $can_place_holds = 1;
1383                     $available_count++;
1384                                         $available_items->{$prefix}->{count}++ if $item->{$hbranch};
1385                                         foreach (qw(branchname itemcallnumber)) {
1386                         $available_items->{$prefix}->{$_} = $item->{$_};
1387                                         }
1388                                         $available_items->{$prefix}->{location} = $shelflocations->{ $item->{location} };
1389                                         $available_items->{$prefix}->{imageurl} = getitemtypeimagelocation( 'opac', $itemtypes{ $item->{itype} }->{imageurl} );
1390                 }
1391             }
1392         }    # notforloan, item level and biblioitem level
1393         my ( $availableitemscount, $onloanitemscount, $otheritemscount );
1394         $maxitems =
1395           ( C4::Context->preference('maxItemsinSearchResults') )
1396           ? C4::Context->preference('maxItemsinSearchResults') - 1
1397           : 1;
1398         for my $key ( sort keys %$onloan_items ) {
1399             (++$onloanitemscount > $maxitems) and last;
1400             push @onloan_items_loop, $onloan_items->{$key};
1401         }
1402         for my $key ( sort keys %$other_items ) {
1403             (++$otheritemscount > $maxitems) and last;
1404             push @other_items_loop, $other_items->{$key};
1405         }
1406         for my $key ( sort keys %$available_items ) {
1407             (++$availableitemscount > $maxitems) and last;
1408             push @available_items_loop, $available_items->{$key}
1409         }
1410
1411         # XSLT processing of some stuff
1412         if (C4::Context->preference("XSLTResultsDisplay") && !$scan) {
1413             $oldbiblio->{XSLTResultsRecord} = XSLTParse4Display(
1414                 $oldbiblio->{biblionumber}, $marcrecord, 'Results' );
1415         }
1416
1417         # last check for norequest : if itemtype is notforloan, it can't be reserved either, whatever the items
1418         $can_place_holds = 0
1419           if $itemtypes{ $oldbiblio->{itemtype} }->{notforloan};
1420         $oldbiblio->{norequests} = 1 unless $can_place_holds;
1421         $oldbiblio->{itemsplural}          = 1 if $items_count > 1;
1422         $oldbiblio->{items_count}          = $items_count;
1423         $oldbiblio->{available_items_loop} = \@available_items_loop;
1424         $oldbiblio->{onloan_items_loop}    = \@onloan_items_loop;
1425         $oldbiblio->{other_items_loop}     = \@other_items_loop;
1426         $oldbiblio->{availablecount}       = $available_count;
1427         $oldbiblio->{availableplural}      = 1 if $available_count > 1;
1428         $oldbiblio->{onloancount}          = $onloan_count;
1429         $oldbiblio->{onloanplural}         = 1 if $onloan_count > 1;
1430         $oldbiblio->{othercount}           = $other_count;
1431         $oldbiblio->{otherplural}          = 1 if $other_count > 1;
1432         $oldbiblio->{wthdrawncount}        = $wthdrawn_count;
1433         $oldbiblio->{itemlostcount}        = $itemlost_count;
1434         $oldbiblio->{damagedcount}         = $itemdamaged_count;
1435         $oldbiblio->{intransitcount}       = $item_in_transit_count;
1436         $oldbiblio->{orderedcount}         = $ordered_count;
1437         push( @newresults, $oldbiblio );
1438     }
1439     return @newresults;
1440 }
1441
1442 #----------------------------------------------------------------------
1443 #
1444 # Non-Zebra GetRecords#
1445 #----------------------------------------------------------------------
1446
1447 =head2 NZgetRecords
1448
1449   NZgetRecords has the same API as zera getRecords, even if some parameters are not managed
1450
1451 =cut
1452
1453 sub NZgetRecords {
1454     my (
1455         $query,            $simple_query, $sort_by_ref,    $servers_ref,
1456         $results_per_page, $offset,       $expanded_facet, $branches,
1457         $query_type,       $scan
1458     ) = @_;
1459     warn "query =$query" if $DEBUG;
1460     my $result = NZanalyse($query);
1461     warn "results =$result" if $DEBUG;
1462     return ( undef,
1463         NZorder( $result, @$sort_by_ref[0], $results_per_page, $offset ),
1464         undef );
1465 }
1466
1467 =head2 NZanalyse
1468
1469   NZanalyse : get a CQL string as parameter, and returns a list of biblionumber;title,biblionumber;title,...
1470   the list is built from an inverted index in the nozebra SQL table
1471   note that title is here only for convenience : the sorting will be very fast when requested on title
1472   if the sorting is requested on something else, we will have to reread all results, and that may be longer.
1473
1474 =cut
1475
1476 sub NZanalyse {
1477     my ( $string, $server ) = @_;
1478 #     warn "---------"       if $DEBUG;
1479     warn " NZanalyse" if $DEBUG;
1480 #     warn "---------"       if $DEBUG;
1481
1482  # $server contains biblioserver or authorities, depending on what we search on.
1483  #warn "querying : $string on $server";
1484     $server = 'biblioserver' unless $server;
1485
1486 # if we have a ", replace the content to discard temporarily any and/or/not inside
1487     my $commacontent;
1488     if ( $string =~ /"/ ) {
1489         $string =~ s/"(.*?)"/__X__/;
1490         $commacontent = $1;
1491         warn "commacontent : $commacontent" if $DEBUG;
1492     }
1493
1494 # split the query string in 3 parts : X AND Y means : $left="X", $operand="AND" and $right="Y"
1495 # then, call again NZanalyse with $left and $right
1496 # (recursive until we find a leaf (=> something without and/or/not)
1497 # delete repeated operator... Would then go in infinite loop
1498     while ( $string =~ s/( and| or| not| AND| OR| NOT)\1/$1/g ) {
1499     }
1500
1501     #process parenthesis before.
1502     if ( $string =~ /^\s*\((.*)\)(( and | or | not | AND | OR | NOT )(.*))?/ ) {
1503         my $left     = $1;
1504         my $right    = $4;
1505         my $operator = lc($3);   # FIXME: and/or/not are operators, not operands
1506         warn
1507 "dealing w/parenthesis before recursive sub call. left :$left operator:$operator right:$right"
1508           if $DEBUG;
1509         my $leftresult = NZanalyse( $left, $server );
1510         if ($operator) {
1511             my $rightresult = NZanalyse( $right, $server );
1512
1513             # OK, we have the results for right and left part of the query
1514             # depending of operand, intersect, union or exclude both lists
1515             # to get a result list
1516             if ( $operator eq ' and ' ) {
1517                 return NZoperatorAND($leftresult,$rightresult);
1518             }
1519             elsif ( $operator eq ' or ' ) {
1520
1521                 # just merge the 2 strings
1522                 return $leftresult . $rightresult;
1523             }
1524             elsif ( $operator eq ' not ' ) {
1525                 return NZoperatorNOT($leftresult,$rightresult);
1526             }
1527         }
1528         else {
1529 # this error is impossible, because of the regexp that isolate the operand, but just in case...
1530             return $leftresult;
1531         }
1532     }
1533     warn "string :" . $string if $DEBUG;
1534     my $left = "";
1535     my $right = "";
1536     my $operator = "";
1537     if ($string =~ /(.*?)( and | or | not | AND | OR | NOT )(.*)/) {
1538         $left     = $1;
1539         $right    = $3;
1540         $operator = lc($2);    # FIXME: and/or/not are operators, not operands
1541     }
1542     warn "no parenthesis. left : $left operator: $operator right: $right"
1543       if $DEBUG;
1544
1545     # it's not a leaf, we have a and/or/not
1546     if ($operator) {
1547
1548         # reintroduce comma content if needed
1549         $right =~ s/__X__/"$commacontent"/ if $commacontent;
1550         $left  =~ s/__X__/"$commacontent"/ if $commacontent;
1551         warn "node : $left / $operator / $right\n" if $DEBUG;
1552         my $leftresult  = NZanalyse( $left,  $server );
1553         my $rightresult = NZanalyse( $right, $server );
1554         warn " leftresult : $leftresult" if $DEBUG;
1555         warn " rightresult : $rightresult" if $DEBUG;
1556         # OK, we have the results for right and left part of the query
1557         # depending of operand, intersect, union or exclude both lists
1558         # to get a result list
1559         if ( $operator eq ' and ' ) {
1560             warn "NZAND";
1561             return NZoperatorAND($leftresult,$rightresult);
1562         }
1563         elsif ( $operator eq ' or ' ) {
1564
1565             # just merge the 2 strings
1566             return $leftresult . $rightresult;
1567         }
1568         elsif ( $operator eq ' not ' ) {
1569             return NZoperatorNOT($leftresult,$rightresult);
1570         }
1571         else {
1572
1573 # this error is impossible, because of the regexp that isolate the operand, but just in case...
1574             die "error : operand unknown : $operator for $string";
1575         }
1576
1577         # it's a leaf, do the real SQL query and return the result
1578     }
1579     else {
1580         $string =~ s/__X__/"$commacontent"/ if $commacontent;
1581         $string =~ s/-|\.|\?|,|;|!|'|\(|\)|\[|\]|{|}|"|&|\+|\*|\// /g;
1582         #remove trailing blank at the beginning
1583         $string =~ s/^ //g;
1584         warn "leaf:$string" if $DEBUG;
1585
1586         # parse the string in in operator/operand/value again
1587         my $left = "";
1588         my $operator = "";
1589         my $right = "";
1590         if ($string =~ /(.*)(>=|<=)(.*)/) {
1591             $left     = $1;
1592             $operator = $2;
1593             $right    = $3;
1594         } else {
1595             $left = $string;
1596         }
1597 #         warn "handling leaf... left:$left operator:$operator right:$right"
1598 #           if $DEBUG;
1599         unless ($operator) {
1600             if ($string =~ /(.*)(>|<|=)(.*)/) {
1601                 $left     = $1;
1602                 $operator = $2;
1603                 $right    = $3;
1604                 warn
1605     "handling unless (operator)... left:$left operator:$operator right:$right"
1606                 if $DEBUG;
1607             } else {
1608                 $left = $string;
1609             }
1610         }
1611         my $results;
1612
1613 # strip adv, zebra keywords, currently not handled in nozebra: wrdl, ext, phr...
1614         $left =~ s/ .*$//;
1615
1616         # automatic replace for short operators
1617         $left = 'title'            if $left =~ '^ti$';
1618         $left = 'author'           if $left =~ '^au$';
1619         $left = 'publisher'        if $left =~ '^pb$';
1620         $left = 'subject'          if $left =~ '^su$';
1621         $left = 'koha-Auth-Number' if $left =~ '^an$';
1622         $left = 'keyword'          if $left =~ '^kw$';
1623         $left = 'itemtype'         if $left =~ '^mc$'; # Fix for Bug 2599 - Search limits not working for NoZebra
1624         warn "handling leaf... left:$left operator:$operator right:$right" if $DEBUG;
1625         my $dbh = C4::Context->dbh;
1626         if ( $operator && $left ne 'keyword' ) {
1627             #do a specific search
1628             $operator = 'LIKE' if $operator eq '=' and $right =~ /%/;
1629             my $sth = $dbh->prepare(
1630 "SELECT biblionumbers,value FROM nozebra WHERE server=? AND indexname=? AND value $operator ?"
1631             );
1632             warn "$left / $operator / $right\n" if $DEBUG;
1633
1634             # split each word, query the DB and build the biblionumbers result
1635             #sanitizing leftpart
1636             $left =~ s/^\s+|\s+$//;
1637             foreach ( split / /, $right ) {
1638                 my $biblionumbers;
1639                 $_ =~ s/^\s+|\s+$//;
1640                 next unless $_;
1641                 warn "EXECUTE : $server, $left, $_" if $DEBUG;
1642                 $sth->execute( $server, $left, $_ )
1643                   or warn "execute failed: $!";
1644                 while ( my ( $line, $value ) = $sth->fetchrow ) {
1645
1646 # if we are dealing with a numeric value, use only numeric results (in case of >=, <=, > or <)
1647 # otherwise, fill the result
1648                     $biblionumbers .= $line
1649                       unless ( $right =~ /^\d+$/ && $value =~ /\D/ );
1650                     warn "result : $value "
1651                       . ( $right  =~ /\d/ ) . "=="
1652                       . ( $value =~ /\D/?$line:"" ) if $DEBUG;         #= $line";
1653                 }
1654
1655 # do a AND with existing list if there is one, otherwise, use the biblionumbers list as 1st result list
1656                 if ($results) {
1657                     warn "NZAND" if $DEBUG;
1658                     $results = NZoperatorAND($biblionumbers,$results);
1659                 } else {
1660                     $results = $biblionumbers;
1661                 }
1662             }
1663         }
1664         else {
1665       #do a complete search (all indexes), if index='kw' do complete search too.
1666             my $sth = $dbh->prepare(
1667 "SELECT biblionumbers FROM nozebra WHERE server=? AND value LIKE ?"
1668             );
1669
1670             # split each word, query the DB and build the biblionumbers result
1671             foreach ( split / /, $string ) {
1672                 next if C4::Context->stopwords->{ uc($_) };   # skip if stopword
1673                 warn "search on all indexes on $_" if $DEBUG;
1674                 my $biblionumbers;
1675                 next unless $_;
1676                 $sth->execute( $server, $_ );
1677                 while ( my $line = $sth->fetchrow ) {
1678                     $biblionumbers .= $line;
1679                 }
1680
1681 # do a AND with existing list if there is one, otherwise, use the biblionumbers list as 1st result list
1682                 if ($results) {
1683                     $results = NZoperatorAND($biblionumbers,$results);
1684                 }
1685                 else {
1686                     warn "NEW RES for $_ = $biblionumbers" if $DEBUG;
1687                     $results = $biblionumbers;
1688                 }
1689             }
1690         }
1691         warn "return : $results for LEAF : $string" if $DEBUG;
1692         return $results;
1693     }
1694     warn "---------\nLeave NZanalyse\n---------" if $DEBUG;
1695 }
1696
1697 sub NZoperatorAND{
1698     my ($rightresult, $leftresult)=@_;
1699
1700     my @leftresult = split /;/, $leftresult;
1701     warn " @leftresult / $rightresult \n" if $DEBUG;
1702
1703     #             my @rightresult = split /;/,$leftresult;
1704     my $finalresult;
1705
1706 # parse the left results, and if the biblionumber exist in the right result, save it in finalresult
1707 # the result is stored twice, to have the same weight for AND than OR.
1708 # example : TWO : 61,61,64,121 (two is twice in the biblio #61) / TOWER : 61,64,130
1709 # result : 61,61,61,61,64,64 for two AND tower : 61 has more weight than 64
1710     foreach (@leftresult) {
1711         my $value = $_;
1712         my $countvalue;
1713         ( $value, $countvalue ) = ( $1, $2 ) if ($value=~/(.*)-(\d+)$/);
1714         if ( $rightresult =~ /\Q$value\E-(\d+);/ ) {
1715             $countvalue = ( $1 > $countvalue ? $countvalue : $1 );
1716             $finalresult .=
1717                 "$value-$countvalue;$value-$countvalue;";
1718         }
1719     }
1720     warn "NZAND DONE : $finalresult \n" if $DEBUG;
1721     return $finalresult;
1722 }
1723
1724 sub NZoperatorOR{
1725     my ($rightresult, $leftresult)=@_;
1726     return $rightresult.$leftresult;
1727 }
1728
1729 sub NZoperatorNOT{
1730     my ($leftresult, $rightresult)=@_;
1731
1732     my @leftresult = split /;/, $leftresult;
1733
1734     #             my @rightresult = split /;/,$leftresult;
1735     my $finalresult;
1736     foreach (@leftresult) {
1737         my $value=$_;
1738         $value=$1 if $value=~m/(.*)-\d+$/;
1739         unless ($rightresult =~ "$value-") {
1740             $finalresult .= "$_;";
1741         }
1742     }
1743     return $finalresult;
1744 }
1745
1746 =head2 NZorder
1747
1748   $finalresult = NZorder($biblionumbers, $ordering,$results_per_page,$offset);
1749
1750   TODO :: Description
1751
1752 =cut
1753
1754 sub NZorder {
1755     my ( $biblionumbers, $ordering, $results_per_page, $offset ) = @_;
1756     warn "biblionumbers = $biblionumbers and ordering = $ordering\n" if $DEBUG;
1757
1758     # order title asc by default
1759     #     $ordering = '1=36 <i' unless $ordering;
1760     $results_per_page = 20 unless $results_per_page;
1761     $offset           = 0  unless $offset;
1762     my $dbh = C4::Context->dbh;
1763
1764     #
1765     # order by POPULARITY
1766     #
1767     if ( $ordering =~ /popularity/ ) {
1768         my %result;
1769         my %popularity;
1770
1771         # popularity is not in MARC record, it's builded from a specific query
1772         my $sth =
1773           $dbh->prepare("select sum(issues) from items where biblionumber=?");
1774         foreach ( split /;/, $biblionumbers ) {
1775             my ( $biblionumber, $title ) = split /,/, $_;
1776             $result{$biblionumber} = GetMarcBiblio($biblionumber);
1777             $sth->execute($biblionumber);
1778             my $popularity = $sth->fetchrow || 0;
1779
1780 # hint : the key is popularity.title because we can have
1781 # many results with the same popularity. In this case, sub-ordering is done by title
1782 # we also have biblionumber to avoid bug for 2 biblios with the same title & popularity
1783 # (un-frequent, I agree, but we won't forget anything that way ;-)
1784             $popularity{ sprintf( "%10d", $popularity ) . $title
1785                   . $biblionumber } = $biblionumber;
1786         }
1787
1788     # sort the hash and return the same structure as GetRecords (Zebra querying)
1789         my $result_hash;
1790         my $numbers = 0;
1791         if ( $ordering eq 'popularity_dsc' ) {    # sort popularity DESC
1792             foreach my $key ( sort { $b cmp $a } ( keys %popularity ) ) {
1793                 $result_hash->{'RECORDS'}[ $numbers++ ] =
1794                   $result{ $popularity{$key} }->as_usmarc();
1795             }
1796         }
1797         else {                                    # sort popularity ASC
1798             foreach my $key ( sort ( keys %popularity ) ) {
1799                 $result_hash->{'RECORDS'}[ $numbers++ ] =
1800                   $result{ $popularity{$key} }->as_usmarc();
1801             }
1802         }
1803         my $finalresult = ();
1804         $result_hash->{'hits'}         = $numbers;
1805         $finalresult->{'biblioserver'} = $result_hash;
1806         return $finalresult;
1807
1808         #
1809         # ORDER BY author
1810         #
1811     }
1812     elsif ( $ordering =~ /author/ ) {
1813         my %result;
1814         foreach ( split /;/, $biblionumbers ) {
1815             my ( $biblionumber, $title ) = split /,/, $_;
1816             my $record = GetMarcBiblio($biblionumber);
1817             my $author;
1818             if ( C4::Context->preference('marcflavour') eq 'UNIMARC' ) {
1819                 $author = $record->subfield( '200', 'f' );
1820                 $author = $record->subfield( '700', 'a' ) unless $author;
1821             }
1822             else {
1823                 $author = $record->subfield( '100', 'a' );
1824             }
1825
1826 # hint : the result is sorted by title.biblionumber because we can have X biblios with the same title
1827 # and we don't want to get only 1 result for each of them !!!
1828             $result{ $author . $biblionumber } = $record;
1829         }
1830
1831     # sort the hash and return the same structure as GetRecords (Zebra querying)
1832         my $result_hash;
1833         my $numbers = 0;
1834         if ( $ordering eq 'author_za' ) {    # sort by author desc
1835             foreach my $key ( sort { $b cmp $a } ( keys %result ) ) {
1836                 $result_hash->{'RECORDS'}[ $numbers++ ] =
1837                   $result{$key}->as_usmarc();
1838             }
1839         }
1840         else {                               # sort by author ASC
1841             foreach my $key ( sort ( keys %result ) ) {
1842                 $result_hash->{'RECORDS'}[ $numbers++ ] =
1843                   $result{$key}->as_usmarc();
1844             }
1845         }
1846         my $finalresult = ();
1847         $result_hash->{'hits'}         = $numbers;
1848         $finalresult->{'biblioserver'} = $result_hash;
1849         return $finalresult;
1850
1851         #
1852         # ORDER BY callnumber
1853         #
1854     }
1855     elsif ( $ordering =~ /callnumber/ ) {
1856         my %result;
1857         foreach ( split /;/, $biblionumbers ) {
1858             my ( $biblionumber, $title ) = split /,/, $_;
1859             my $record = GetMarcBiblio($biblionumber);
1860             my $callnumber;
1861             my $frameworkcode = GetFrameworkCode($biblionumber);
1862             my ( $callnumber_tag, $callnumber_subfield ) = GetMarcFromKohaField(  'items.itemcallnumber', $frameworkcode);
1863                ( $callnumber_tag, $callnumber_subfield ) = GetMarcFromKohaField('biblioitems.callnumber', $frameworkcode)
1864                 unless $callnumber_tag;
1865             if ( C4::Context->preference('marcflavour') eq 'UNIMARC' ) {
1866                 $callnumber = $record->subfield( '200', 'f' );
1867             } else {
1868                 $callnumber = $record->subfield( '100', 'a' );
1869             }
1870
1871 # hint : the result is sorted by title.biblionumber because we can have X biblios with the same title
1872 # and we don't want to get only 1 result for each of them !!!
1873             $result{ $callnumber . $biblionumber } = $record;
1874         }
1875
1876     # sort the hash and return the same structure as GetRecords (Zebra querying)
1877         my $result_hash;
1878         my $numbers = 0;
1879         if ( $ordering eq 'call_number_dsc' ) {    # sort by title desc
1880             foreach my $key ( sort { $b cmp $a } ( keys %result ) ) {
1881                 $result_hash->{'RECORDS'}[ $numbers++ ] =
1882                   $result{$key}->as_usmarc();
1883             }
1884         }
1885         else {                                     # sort by title ASC
1886             foreach my $key ( sort { $a cmp $b } ( keys %result ) ) {
1887                 $result_hash->{'RECORDS'}[ $numbers++ ] =
1888                   $result{$key}->as_usmarc();
1889             }
1890         }
1891         my $finalresult = ();
1892         $result_hash->{'hits'}         = $numbers;
1893         $finalresult->{'biblioserver'} = $result_hash;
1894         return $finalresult;
1895     }
1896     elsif ( $ordering =~ /pubdate/ ) {             #pub year
1897         my %result;
1898         foreach ( split /;/, $biblionumbers ) {
1899             my ( $biblionumber, $title ) = split /,/, $_;
1900             my $record = GetMarcBiblio($biblionumber);
1901             my ( $publicationyear_tag, $publicationyear_subfield ) =
1902               GetMarcFromKohaField( 'biblioitems.publicationyear', '' );
1903             my $publicationyear =
1904               $record->subfield( $publicationyear_tag,
1905                 $publicationyear_subfield );
1906
1907 # hint : the result is sorted by title.biblionumber because we can have X biblios with the same title
1908 # and we don't want to get only 1 result for each of them !!!
1909             $result{ $publicationyear . $biblionumber } = $record;
1910         }
1911
1912     # sort the hash and return the same structure as GetRecords (Zebra querying)
1913         my $result_hash;
1914         my $numbers = 0;
1915         if ( $ordering eq 'pubdate_dsc' ) {    # sort by pubyear desc
1916             foreach my $key ( sort { $b cmp $a } ( keys %result ) ) {
1917                 $result_hash->{'RECORDS'}[ $numbers++ ] =
1918                   $result{$key}->as_usmarc();
1919             }
1920         }
1921         else {                                 # sort by pub year ASC
1922             foreach my $key ( sort ( keys %result ) ) {
1923                 $result_hash->{'RECORDS'}[ $numbers++ ] =
1924                   $result{$key}->as_usmarc();
1925             }
1926         }
1927         my $finalresult = ();
1928         $result_hash->{'hits'}         = $numbers;
1929         $finalresult->{'biblioserver'} = $result_hash;
1930         return $finalresult;
1931
1932         #
1933         # ORDER BY title
1934         #
1935     }
1936     elsif ( $ordering =~ /title/ ) {
1937
1938 # the title is in the biblionumbers string, so we just need to build a hash, sort it and return
1939         my %result;
1940         foreach ( split /;/, $biblionumbers ) {
1941             my ( $biblionumber, $title ) = split /,/, $_;
1942
1943 # hint : the result is sorted by title.biblionumber because we can have X biblios with the same title
1944 # and we don't want to get only 1 result for each of them !!!
1945 # hint & speed improvement : we can order without reading the record
1946 # so order, and read records only for the requested page !
1947             $result{ $title . $biblionumber } = $biblionumber;
1948         }
1949
1950     # sort the hash and return the same structure as GetRecords (Zebra querying)
1951         my $result_hash;
1952         my $numbers = 0;
1953         if ( $ordering eq 'title_az' ) {    # sort by title desc
1954             foreach my $key ( sort ( keys %result ) ) {
1955                 $result_hash->{'RECORDS'}[ $numbers++ ] = $result{$key};
1956             }
1957         }
1958         else {                              # sort by title ASC
1959             foreach my $key ( sort { $b cmp $a } ( keys %result ) ) {
1960                 $result_hash->{'RECORDS'}[ $numbers++ ] = $result{$key};
1961             }
1962         }
1963
1964         # limit the $results_per_page to result size if it's more
1965         $results_per_page = $numbers - 1 if $numbers < $results_per_page;
1966
1967         # for the requested page, replace biblionumber by the complete record
1968         # speed improvement : avoid reading too much things
1969         for (
1970             my $counter = $offset ;
1971             $counter <= $offset + $results_per_page ;
1972             $counter++
1973           )
1974         {
1975             $result_hash->{'RECORDS'}[$counter] =
1976               GetMarcBiblio( $result_hash->{'RECORDS'}[$counter] )->as_usmarc;
1977         }
1978         my $finalresult = ();
1979         $result_hash->{'hits'}         = $numbers;
1980         $finalresult->{'biblioserver'} = $result_hash;
1981         return $finalresult;
1982     }
1983     else {
1984
1985 #
1986 # order by ranking
1987 #
1988 # we need 2 hashes to order by ranking : the 1st one to count the ranking, the 2nd to order by ranking
1989         my %result;
1990         my %count_ranking;
1991         foreach ( split /;/, $biblionumbers ) {
1992             my ( $biblionumber, $title ) = split /,/, $_;
1993             $title =~ /(.*)-(\d)/;
1994
1995             # get weight
1996             my $ranking = $2;
1997
1998 # note that we + the ranking because ranking is calculated on weight of EACH term requested.
1999 # if we ask for "two towers", and "two" has weight 2 in biblio N, and "towers" has weight 4 in biblio N
2000 # biblio N has ranking = 6
2001             $count_ranking{$biblionumber} += $ranking;
2002         }
2003
2004 # build the result by "inverting" the count_ranking hash
2005 # 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
2006 #         warn "counting";
2007         foreach ( keys %count_ranking ) {
2008             $result{ sprintf( "%10d", $count_ranking{$_} ) . '-' . $_ } = $_;
2009         }
2010
2011     # sort the hash and return the same structure as GetRecords (Zebra querying)
2012         my $result_hash;
2013         my $numbers = 0;
2014         foreach my $key ( sort { $b cmp $a } ( keys %result ) ) {
2015             $result_hash->{'RECORDS'}[ $numbers++ ] = $result{$key};
2016         }
2017
2018         # limit the $results_per_page to result size if it's more
2019         $results_per_page = $numbers - 1 if $numbers < $results_per_page;
2020
2021         # for the requested page, replace biblionumber by the complete record
2022         # speed improvement : avoid reading too much things
2023         for (
2024             my $counter = $offset ;
2025             $counter <= $offset + $results_per_page ;
2026             $counter++
2027           )
2028         {
2029             $result_hash->{'RECORDS'}[$counter] =
2030               GetMarcBiblio( $result_hash->{'RECORDS'}[$counter] )->as_usmarc
2031               if $result_hash->{'RECORDS'}[$counter];
2032         }
2033         my $finalresult = ();
2034         $result_hash->{'hits'}         = $numbers;
2035         $finalresult->{'biblioserver'} = $result_hash;
2036         return $finalresult;
2037     }
2038 }
2039
2040 =head2 enabled_staff_search_views
2041
2042 %hash = enabled_staff_search_views()
2043
2044 This function returns a hash that contains three flags obtained from the system
2045 preferences, used to determine whether a particular staff search results view
2046 is enabled.
2047
2048 =over 2
2049
2050 =item C<Output arg:>
2051
2052     * $hash{can_view_MARC} is true only if the MARC view is enabled
2053     * $hash{can_view_ISBD} is true only if the ISBD view is enabled
2054     * $hash{can_view_labeledMARC} is true only if the Labeled MARC view is enabled
2055
2056 =item C<usage in the script:>
2057
2058 =back
2059
2060 $template->param ( C4::Search::enabled_staff_search_views );
2061
2062 =cut
2063
2064 sub enabled_staff_search_views
2065 {
2066         return (
2067                 can_view_MARC                   => C4::Context->preference('viewMARC'),                 # 1 if the staff search allows the MARC view
2068                 can_view_ISBD                   => C4::Context->preference('viewISBD'),                 # 1 if the staff search allows the ISBD view
2069                 can_view_labeledMARC    => C4::Context->preference('viewLabeledMARC'),  # 1 if the staff search allows the Labeled MARC view
2070         );
2071 }
2072
2073 sub AddSearchHistory{
2074         my ($borrowernumber,$session,$query_desc,$query_cgi, $total)=@_;
2075     my $dbh = C4::Context->dbh;
2076
2077     # Add the request the user just made
2078     my $sql = "INSERT INTO search_history(userid, sessionid, query_desc, query_cgi, total, time) VALUES(?, ?, ?, ?, ?, NOW())";
2079     my $sth   = $dbh->prepare($sql);
2080     $sth->execute($borrowernumber, $session, $query_desc, $query_cgi, $total);
2081         return $dbh->last_insert_id(undef, 'search_history', undef,undef,undef);
2082 }
2083
2084 sub GetSearchHistory{
2085         my ($borrowernumber,$session)=@_;
2086     my $dbh = C4::Context->dbh;
2087
2088     # Add the request the user just made
2089     my $query = "SELECT FROM search_history WHERE (userid=? OR sessionid=?)";
2090     my $sth   = $dbh->prepare($query);
2091         $sth->execute($borrowernumber, $session);
2092     return  $sth->fetchall_hashref({});
2093 }
2094
2095 =head2 z3950_search_args
2096
2097 $arrayref = z3950_search_args($matchpoints)
2098
2099 This function returns an array reference that contains the search parameters to be
2100 passed to the Z39.50 search script (z3950_search.pl). The array elements
2101 are hash refs whose keys are name, value and encvalue, and whose values are the
2102 name of a search parameter, the value of that search parameter and the URL encoded
2103 value of that parameter.
2104
2105 The search parameter names are lccn, isbn, issn, title, author, dewey and subject.
2106
2107 The search parameter values are obtained from the bibliographic record whose
2108 data is in a hash reference in $matchpoints, as returned by Biblio::GetBiblioData().
2109
2110 If $matchpoints is a scalar, it is assumed to be an unnamed query descriptor, e.g.
2111 a general purpose search argument. In this case, the returned array contains only
2112 entry: the key is 'title' and the value and encvalue are derived from $matchpoints.
2113
2114 If a search parameter value is undefined or empty, it is not included in the returned
2115 array.
2116
2117 The returned array reference may be passed directly to the template parameters.
2118
2119 =over 2
2120
2121 =item C<Output arg:>
2122
2123     * $array containing hash refs as described above
2124
2125 =item C<usage in the script:>
2126
2127 =back
2128
2129 $data = Biblio::GetBiblioData($bibno);
2130 $template->param ( MYLOOP => C4::Search::z3950_search_args($data) )
2131
2132 *OR*
2133
2134 $template->param ( MYLOOP => C4::Search::z3950_search_args($searchscalar) )
2135
2136 =cut
2137
2138 sub z3950_search_args {
2139     my $bibrec = shift;
2140     $bibrec = { title => $bibrec } if !ref $bibrec;
2141     my $array = [];
2142     for my $field (qw/ lccn isbn issn title author dewey subject /)
2143     {
2144         my $encvalue = URI::Escape::uri_escape_utf8($bibrec->{$field});
2145         push @$array, { name=>$field, value=>$bibrec->{$field}, encvalue=>$encvalue } if defined $bibrec->{$field};
2146     }
2147     return $array;
2148 }
2149
2150 =head2 GetDistinctValues($field);
2151
2152 C<$field> is a reference to the fields array
2153
2154 =cut
2155
2156 sub GetDistinctValues {
2157     my ($fieldname,$string)=@_;
2158     # returns a reference to a hash of references to branches...
2159     if ($fieldname=~/\./){
2160                         my ($table,$column)=split /\./, $fieldname;
2161                         my $dbh = C4::Context->dbh;
2162                         warn "select DISTINCT($column) as value, count(*) as cnt from $table group by lib order by $column ";
2163                         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 ");
2164                         $sth->execute;
2165                         my $elements=$sth->fetchall_arrayref({});
2166                         return $elements;
2167    }
2168    else {
2169                 $string||= qq("");
2170                 my @servers=qw<biblioserver authorityserver>;
2171                 my (@zconns,@results);
2172         for ( my $i = 0 ; $i < @servers ; $i++ ) {
2173                 $zconns[$i] = C4::Context->Zconn( $servers[$i], 1 );
2174                         $results[$i] =
2175                       $zconns[$i]->scan(
2176                         ZOOM::Query::CCL2RPN->new( qq"$fieldname $string", $zconns[$i])
2177                       );
2178                 }
2179                 # The big moment: asynchronously retrieve results from all servers
2180                 my @elements;
2181                 while ( ( my $i = ZOOM::event( \@zconns ) ) != 0 ) {
2182                         my $ev = $zconns[ $i - 1 ]->last_event();
2183                         if ( $ev == ZOOM::Event::ZEND ) {
2184                                 next unless $results[ $i - 1 ];
2185                                 my $size = $results[ $i - 1 ]->size();
2186                                 if ( $size > 0 ) {
2187                       for (my $j=0;$j<$size;$j++){
2188                                                 my %hashscan;
2189                                                 @hashscan{qw(value cnt)}=$results[ $i - 1 ]->display_term($j);
2190                                                 push @elements, \%hashscan;
2191                                           }
2192                                 }
2193                         }
2194                 }
2195                 return \@elements;
2196    }
2197 }
2198
2199 END { }    # module clean-up code here (global destructor)
2200
2201 1;
2202 __END__
2203
2204 =head1 AUTHOR
2205
2206 Koha Developement team <info@koha.org>
2207
2208 =cut