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

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