C4/Search.pm

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