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 - Bug 2505
  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::Members qw(GetHideLostItemsPreference);
  29 use C4::XSLT;
  30 use C4::Branch;
  31 use C4::Reserves;    # CheckReserves
  32 use C4::Debug;
  33 use C4::Charset;
  34 use YAML;
  35 use URI::Escape;
  36 use Business::ISBN;
  37 use MARC::Record;
  38 use MARC::Field;
  39
  40 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $DEBUG);
  41
  42 # set the version for version checking
  43 BEGIN {
  44     $VERSION = 3.07.00.049;
  45     $DEBUG = ($ENV{DEBUG}) ? 1 : 0;
  46 }
  47
  48 =head1 NAME
  49
  50 C4::Search - Functions for searching the Koha catalog.
  51
  52 =head1 SYNOPSIS
  53
  54 See opac/opac-search.pl or catalogue/search.pl for example of usage
  55
  56 =head1 DESCRIPTION
  57
  58 This module provides searching functions for Koha's bibliographic databases
  59
  60 =head1 FUNCTIONS
  61
  62 =cut
  63
  64 @ISA    = qw(Exporter);
  65 @EXPORT = qw(
  66   &FindDuplicate
  67   &SimpleSearch
  68   &searchResults
  69   &getRecords
  70   &buildQuery
  71   &NZgetRecords
  72   &AddSearchHistory
  73   &GetDistinctValues
  74   &enabled_staff_search_views
  75   &SimpleSearch
  76 );
  77
  78 # make all your functions, whether exported or not;
  79
  80 =head2 FindDuplicate
  81
  82 ($biblionumber,$biblionumber,$title) = FindDuplicate($record);
  83
  84 This function attempts to find duplicate records using a hard-coded, fairly simplistic algorithm
  85
  86 =cut
  87
  88 sub FindDuplicate {
  89     my ($record) = @_;
  90     my $dbh = C4::Context->dbh;
  91     my $result = TransformMarcToKoha( $dbh, $record, '' );
  92     my $sth;
  93     my $query;
  94     my $search;
  95     my $type;
  96     my ( $biblionumber, $title );
  97
  98     # search duplicate on ISBN, easy and fast..
  99     # ... normalize first
 100     if ( $result->{isbn} ) {
 101         $result->{isbn} =~ s/\(.*$//;
 102         $result->{isbn} =~ s/\s+$//;
 103         $query = "isbn=$result->{isbn}";
 104     }
 105     else {
 106         $result->{title} =~ s /\\//g;
 107         $result->{title} =~ s /\"//g;
 108         $result->{title} =~ s /\(//g;
 109         $result->{title} =~ s /\)//g;
 110
 111         # FIXME: instead of removing operators, could just do
 112         # quotes around the value
 113         $result->{title} =~ s/(and|or|not)//g;
 114         $query = "ti,ext=$result->{title}";
 115         $query .= " and itemtype=$result->{itemtype}"
 116           if ( $result->{itemtype} );
 117         if   ( $result->{author} ) {
 118             $result->{author} =~ s /\\//g;
 119             $result->{author} =~ s /\"//g;
 120             $result->{author} =~ s /\(//g;
 121             $result->{author} =~ s /\)//g;
 122
 123             # remove valid operators
 124             $result->{author} =~ s/(and|or|not)//g;
 125             $query .= " and au,ext=$result->{author}";
 126         }
 127     }
 128
 129     my ( $error, $searchresults, undef ) = SimpleSearch($query); # FIXME :: hardcoded !
 130     my @results;
 131     if (!defined $error) {
 132         foreach my $possible_duplicate_record (@{$searchresults}) {
 133             my $marcrecord =
 134             MARC::Record->new_from_usmarc($possible_duplicate_record);
 135             my $result = TransformMarcToKoha( $dbh, $marcrecord, '' );
 136
 137             # FIXME :: why 2 $biblionumber ?
 138             if ($result) {
 139                 push @results, $result->{'biblionumber'};
 140                 push @results, $result->{'title'};
 141             }
 142         }
 143     }
 144     return @results;
 145 }
 146
 147 =head2 SimpleSearch
 148
 149 ( $error, $results, $total_hits ) = SimpleSearch( $query, $offset, $max_results, [@servers] );
 150
 151 This function provides a simple search API on the bibliographic catalog
 152
 153 =over 2
 154
 155 =item C<input arg:>
 156
 157     * $query can be a simple keyword or a complete CCL query
 158     * @servers is optional. Defaults to biblioserver as found in koha-conf.xml
 159     * $offset - If present, represents the number of records at the beggining to omit. Defaults to 0
 160     * $max_results - if present, determines the maximum number of records to fetch. undef is All. defaults to undef.
 161
 162
 163 =item C<Return:>
 164
 165     Returns an array consisting of three elements
 166     * $error is undefined unless an error is detected
 167     * $results is a reference to an array of records.
 168     * $total_hits is the number of hits that would have been returned with no limit
 169
 170     If an error is returned the two other return elements are undefined. If error itself is undefined
 171     the other two elements are always defined
 172
 173 =item C<usage in the script:>
 174
 175 =back
 176
 177 my ( $error, $marcresults, $total_hits ) = SimpleSearch($query);
 178
 179 if (defined $error) {
 180     $template->param(query_error => $error);
 181     warn "error: ".$error;
 182     output_html_with_http_headers $input, $cookie, $template->output;
 183     exit;
 184 }
 185
 186 my $hits = @{$marcresults};
 187 my @results;
 188
 189 for my $r ( @{$marcresults} ) {
 190     my $marcrecord = MARC::File::USMARC::decode($r);
 191     my $biblio = TransformMarcToKoha(C4::Context->dbh,$marcrecord,q{});
 192
 193     #build the iarray of hashs for the template.
 194     push @results, {
 195         title           => $biblio->{'title'},
 196         subtitle        => $biblio->{'subtitle'},
 197         biblionumber    => $biblio->{'biblionumber'},
 198         author          => $biblio->{'author'},
 199         publishercode   => $biblio->{'publishercode'},
 200         publicationyear => $biblio->{'publicationyear'},
 201         };
 202
 203 }
 204
 205 $template->param(result=>\@results);
 206
 207 =cut
 208
 209 sub SimpleSearch {
 210     my ( $query, $offset, $max_results, $servers )  = @_;
 211
 212     if ( C4::Context->preference('NoZebra') ) {
 213         my $result = NZorder( NZanalyse($query) )->{'biblioserver'};
 214         my $search_result =
 215           (      $result->{hits}
 216               && $result->{hits} > 0 ? $result->{'RECORDS'} : [] );
 217         return ( undef, $search_result, scalar($result->{hits}) );
 218     }
 219     else {
 220         return ( 'No query entered', undef, undef ) unless $query;
 221         # FIXME hardcoded value. See catalog/search.pl & opac-search.pl too.
 222         my @servers = defined ( $servers ) ? @$servers : ( 'biblioserver' );
 223         my @zoom_queries;
 224         my @tmpresults;
 225         my @zconns;
 226         my $results = [];
 227         my $total_hits = 0;
 228
 229         # Initialize & Search Zebra
 230         for ( my $i = 0 ; $i < @servers ; $i++ ) {
 231             eval {
 232                 $zconns[$i] = C4::Context->Zconn( $servers[$i], 1 );
 233                 $zoom_queries[$i] = new ZOOM::Query::CCL2RPN( $query, $zconns[$i]);
 234                 $tmpresults[$i] = $zconns[$i]->search( $zoom_queries[$i] );
 235
 236                 # error handling
 237                 my $error =
 238                     $zconns[$i]->errmsg() . " ("
 239                   . $zconns[$i]->errcode() . ") "
 240                   . $zconns[$i]->addinfo() . " "
 241                   . $zconns[$i]->diagset();
 242
 243                 return ( $error, undef, undef ) if $zconns[$i]->errcode();
 244             };
 245             if ($@) {
 246
 247                 # caught a ZOOM::Exception
 248                 my $error =
 249                     $@->message() . " ("
 250                   . $@->code() . ") "
 251                   . $@->addinfo() . " "
 252                   . $@->diagset();
 253                 warn $error." for query: $query";
 254                 return ( $error, undef, undef );
 255             }
 256         }
 257
 258         _ZOOM_event_loop(
 259             \@zconns,
 260             \@tmpresults,
 261             sub {
 262                 my ($i, $size) = @_;
 263                 my $first_record = defined($offset) ? $offset + 1 : 1;
 264                 my $hits = $tmpresults[ $i - 1 ]->size();
 265                 $total_hits += $hits;
 266                 my $last_record = $hits;
 267                 if ( defined $max_results && $offset + $max_results < $hits ) {
 268                     $last_record = $offset + $max_results;
 269                 }
 270
 271                 for my $j ( $first_record .. $last_record ) {
 272                     my $record =
 273                       $tmpresults[ $i - 1 ]->record( $j - 1 )->raw()
 274                       ;    # 0 indexed
 275                     push @{$results}, $record;
 276                 }
 277             }
 278         );
 279
 280         foreach my $zoom_query (@zoom_queries) {
 281             $zoom_query->destroy();
 282         }
 283
 284         return ( undef, $results, $total_hits );
 285     }
 286 }
 287
 288 =head2 getRecords
 289
 290 ( undef, $results_hashref, \@facets_loop ) = getRecords (
 291
 292         $koha_query,       $simple_query, $sort_by_ref,    $servers_ref,
 293         $results_per_page, $offset,       $expanded_facet, $branches,$itemtypes,
 294         $query_type,       $scan
 295     );
 296
 297 The all singing, all dancing, multi-server, asynchronous, scanning,
 298 searching, record nabbing, facet-building
 299
 300 See verbse embedded documentation.
 301
 302 =cut
 303
 304 sub getRecords {
 305     my (
 306         $koha_query,       $simple_query, $sort_by_ref,    $servers_ref,
 307         $results_per_page, $offset,       $expanded_facet, $branches,
 308         $itemtypes,        $query_type,   $scan,           $opac
 309     ) = @_;
 310
 311     my @servers = @$servers_ref;
 312     my @sort_by = @$sort_by_ref;
 313
 314     # Initialize variables for the ZOOM connection and results object
 315     my $zconn;
 316     my @zconns;
 317     my @results;
 318     my $results_hashref = ();
 319
 320     # Initialize variables for the faceted results objects
 321     my $facets_counter = ();
 322     my $facets_info    = ();
 323     my $facets         = getFacets();
 324     my $facets_maxrecs = C4::Context->preference('maxRecordsForFacets')||20;
 325
 326     my @facets_loop;    # stores the ref to array of hashes for template facets loop
 327
 328     ### LOOP THROUGH THE SERVERS
 329     for ( my $i = 0 ; $i < @servers ; $i++ ) {
 330         $zconns[$i] = C4::Context->Zconn( $servers[$i], 1 );
 331
 332 # perform the search, create the results objects
 333 # if this is a local search, use the $koha-query, if it's a federated one, use the federated-query
 334         my $query_to_use = ($servers[$i] =~ /biblioserver/) ? $koha_query : $simple_query;
 335
 336         #$query_to_use = $simple_query if $scan;
 337         warn $simple_query if ( $scan and $DEBUG );
 338
 339         # Check if we've got a query_type defined, if so, use it
 340         eval {
 341             if ($query_type) {
 342                 if ($query_type =~ /^ccl/) {
 343                     $query_to_use =~ s/\:/\=/g;    # change : to = last minute (FIXME)
 344                     $results[$i] = $zconns[$i]->search(new ZOOM::Query::CCL2RPN($query_to_use, $zconns[$i]));
 345                 } elsif ($query_type =~ /^cql/) {
 346                     $results[$i] = $zconns[$i]->search(new ZOOM::Query::CQL($query_to_use, $zconns[$i]));
 347                 } elsif ($query_type =~ /^pqf/) {
 348                     $results[$i] = $zconns[$i]->search(new ZOOM::Query::PQF($query_to_use, $zconns[$i]));
 349                 } else {
 350                     warn "Unknown query_type '$query_type'.  Results undetermined.";
 351                 }
 352             } elsif ($scan) {
 353                     $results[$i] = $zconns[$i]->scan(  new ZOOM::Query::CCL2RPN($query_to_use, $zconns[$i]));
 354             } else {
 355                     $results[$i] = $zconns[$i]->search(new ZOOM::Query::CCL2RPN($query_to_use, $zconns[$i]));
 356             }
 357         };
 358         if ($@) {
 359             warn "WARNING: query problem with $query_to_use " . $@;
 360         }
 361
 362         # Concatenate the sort_by limits and pass them to the results object
 363         # Note: sort will override rank
 364         my $sort_by;
 365         foreach my $sort (@sort_by) {
 366             if ( $sort eq "author_az" || $sort eq "author_asc" ) {
 367                 $sort_by .= "1=1003 <i ";
 368             }
 369             elsif ( $sort eq "author_za" || $sort eq "author_dsc" ) {
 370                 $sort_by .= "1=1003 >i ";
 371             }
 372             elsif ( $sort eq "popularity_asc" ) {
 373                 $sort_by .= "1=9003 <i ";
 374             }
 375             elsif ( $sort eq "popularity_dsc" ) {
 376                 $sort_by .= "1=9003 >i ";
 377             }
 378             elsif ( $sort eq "call_number_asc" ) {
 379                 $sort_by .= "1=8007  <i ";
 380             }
 381             elsif ( $sort eq "call_number_dsc" ) {
 382                 $sort_by .= "1=8007 >i ";
 383             }
 384             elsif ( $sort eq "pubdate_asc" ) {
 385                 $sort_by .= "1=31 <i ";
 386             }
 387             elsif ( $sort eq "pubdate_dsc" ) {
 388                 $sort_by .= "1=31 >i ";
 389             }
 390             elsif ( $sort eq "acqdate_asc" ) {
 391                 $sort_by .= "1=32 <i ";
 392             }
 393             elsif ( $sort eq "acqdate_dsc" ) {
 394                 $sort_by .= "1=32 >i ";
 395             }
 396             elsif ( $sort eq "title_az" || $sort eq "title_asc" ) {
 397                 $sort_by .= "1=4 <i ";
 398             }
 399             elsif ( $sort eq "title_za" || $sort eq "title_dsc" ) {
 400                 $sort_by .= "1=4 >i ";
 401             }
 402             else {
 403                 warn "Ignoring unrecognized sort '$sort' requested" if $sort_by;
 404             }
 405         }
 406         if ($sort_by && !$scan) {
 407             if ( $results[$i]->sort( "yaz", $sort_by ) < 0 ) {
 408                 warn "WARNING sort $sort_by failed";
 409             }
 410         }
 411     }    # finished looping through servers
 412
 413     # The big moment: asynchronously retrieve results from all servers
 414         _ZOOM_event_loop(
 415             \@zconns,
 416             \@results,
 417             sub {
 418                 my ( $i, $size ) = @_;
 419                 my $results_hash;
 420
 421                 # loop through the results
 422                 $results_hash->{'hits'} = $size;
 423                 my $times;
 424                 if ( $offset + $results_per_page <= $size ) {
 425                     $times = $offset + $results_per_page;
 426                 }
 427                 else {
 428                     $times = $size;
 429                 }
 430                 for ( my $j = $offset ; $j < $times ; $j++ ) {
 431                     my $records_hash;
 432                     my $record;
 433
 434                     ## Check if it's an index scan
 435                     if ($scan) {
 436                         my ( $term, $occ ) = $results[ $i - 1 ]->term($j);
 437
 438                  # here we create a minimal MARC record and hand it off to the
 439                  # template just like a normal result ... perhaps not ideal, but
 440                  # it works for now
 441                         my $tmprecord = MARC::Record->new();
 442                         $tmprecord->encoding('UTF-8');
 443                         my $tmptitle;
 444                         my $tmpauthor;
 445
 446                 # the minimal record in author/title (depending on MARC flavour)
 447                         if ( C4::Context->preference("marcflavour") eq
 448                             "UNIMARC" )
 449                         {
 450                             $tmptitle = MARC::Field->new(
 451                                 '200', ' ', ' ',
 452                                 a => $term,
 453                                 f => $occ
 454                             );
 455                             $tmprecord->append_fields($tmptitle);
 456                         }
 457                         else {
 458                             $tmptitle =
 459                               MARC::Field->new( '245', ' ', ' ', a => $term, );
 460                             $tmpauthor =
 461                               MARC::Field->new( '100', ' ', ' ', a => $occ, );
 462                             $tmprecord->append_fields($tmptitle);
 463                             $tmprecord->append_fields($tmpauthor);
 464                         }
 465                         $results_hash->{'RECORDS'}[$j] =
 466                           $tmprecord->as_usmarc();
 467                     }
 468
 469                     # not an index scan
 470                     else {
 471                         $record = $results[ $i - 1 ]->record($j)->raw();
 472
 473                         # warn "RECORD $j:".$record;
 474                         $results_hash->{'RECORDS'}[$j] = $record;
 475                     }
 476
 477                 }
 478                 $results_hashref->{ $servers[ $i - 1 ] } = $results_hash;
 479
 480 # Fill the facets while we're looping, but only for the biblioserver and not for a scan
 481                 if ( !$scan && $servers[ $i - 1 ] =~ /biblioserver/ ) {
 482
 483                     my $jmax =
 484                       $size > $facets_maxrecs ? $facets_maxrecs : $size;
 485                     for my $facet (@$facets) {
 486                         for ( my $j = 0 ; $j < $jmax ; $j++ ) {
 487                             my $render_record =
 488                               $results[ $i - 1 ]->record($j)->render();
 489                             my @used_datas = ();
 490                             foreach my $tag ( @{ $facet->{tags} } ) {
 491
 492                                 # avoid first line
 493                                 my $tag_num = substr( $tag, 0, 3 );
 494                                 my $letters = substr( $tag, 3 );
 495                                 my $field_pattern =
 496                                   '\n' . $tag_num . ' ([^z][^\n]+)';
 497                                 $field_pattern = '\n' . $tag_num . ' ([^\n]+)'
 498                                   if ( int($tag_num) < 10 );
 499                                 my @field_tokens =
 500                                   ( $render_record =~ /$field_pattern/g );
 501                                 foreach my $field_token (@field_tokens) {
 502                                     my @subf = ( $field_token =~
 503                                           /\$([a-zA-Z0-9]) ([^\$]+)/g );
 504                                     my @values;
 505                                     for ( my $i = 0 ; $i < @subf ; $i += 2 ) {
 506                                         if ( $letters =~ $subf[$i] ) {
 507                                             my $value = $subf[ $i + 1 ];
 508                                             $value =~ s/^ *//;
 509                                             $value =~ s/ *$//;
 510                                             push @values, $value;
 511                                         }
 512                                     }
 513                                     my $data = join( $facet->{sep}, @values );
 514                                     unless ( $data ~~ @used_datas ) {
 515                                         $facets_counter->{ $facet->{idx} }
 516                                           ->{$data}++;
 517                                         push @used_datas, $data;
 518                                     }
 519                                 }    # fields
 520                             }    # field codes
 521                         }    # records
 522                         $facets_info->{ $facet->{idx} }->{label_value} =
 523                           $facet->{label};
 524                         $facets_info->{ $facet->{idx} }->{expanded} =
 525                           $facet->{expanded};
 526                     }    # facets
 527                 }
 528
 529                 # warn "connection ", $i-1, ": $size hits";
 530                 # warn $results[$i-1]->record(0)->render() if $size > 0;
 531
 532                 # BUILD FACETS
 533                 if ( $servers[ $i - 1 ] =~ /biblioserver/ ) {
 534                     for my $link_value (
 535                         sort { $facets_counter->{$b} <=> $facets_counter->{$a} }
 536                         keys %$facets_counter
 537                       )
 538                     {
 539                         my $expandable;
 540                         my $number_of_facets;
 541                         my @this_facets_array;
 542                         for my $one_facet (
 543                             sort {
 544                                 $facets_counter->{$link_value}
 545                                   ->{$b} <=> $facets_counter->{$link_value}
 546                                   ->{$a}
 547                             } keys %{ $facets_counter->{$link_value} }
 548                           )
 549                         {
 550                             $number_of_facets++;
 551                             if (   ( $number_of_facets < 6 )
 552                                 || ( $expanded_facet eq $link_value )
 553                                 || ( $facets_info->{$link_value}->{'expanded'} )
 554                               )
 555                             {
 556
 557 # Sanitize the link value : parenthesis, question and exclamation mark will cause errors with CCL
 558                                 my $facet_link_value = $one_facet;
 559                                 $facet_link_value =~ s/[()!?¡¿؟]/ /g;
 560
 561                                 # fix the length that will display in the label,
 562                                 my $facet_label_value = $one_facet;
 563                                 my $facet_max_length  = C4::Context->preference(
 564                                     'FacetLabelTruncationLength')
 565                                   || 20;
 566                                 $facet_label_value =
 567                                   substr( $one_facet, 0, $facet_max_length )
 568                                   . "..."
 569                                   if length($facet_label_value) >
 570                                       $facet_max_length;
 571
 572                             # if it's a branch, label by the name, not the code,
 573                                 if ( $link_value =~ /branch/ ) {
 574                                     if (   defined $branches
 575                                         && ref($branches) eq "HASH"
 576                                         && defined $branches->{$one_facet}
 577                                         && ref( $branches->{$one_facet} ) eq
 578                                         "HASH" )
 579                                     {
 580                                         $facet_label_value =
 581                                           $branches->{$one_facet}
 582                                           ->{'branchname'};
 583                                     }
 584                                     else {
 585                                         $facet_label_value = "*";
 586                                     }
 587                                 }
 588
 589                           # if it's a itemtype, label by the name, not the code,
 590                                 if ( $link_value =~ /itype/ ) {
 591                                     if (   defined $itemtypes
 592                                         && ref($itemtypes) eq "HASH"
 593                                         && defined $itemtypes->{$one_facet}
 594                                         && ref( $itemtypes->{$one_facet} ) eq
 595                                         "HASH" )
 596                                     {
 597                                         $facet_label_value =
 598                                           $itemtypes->{$one_facet}
 599                                           ->{'description'};
 600                                     }
 601                                 }
 602
 603                # also, if it's a location code, use the name instead of the code
 604                                 if ( $link_value =~ /location/ ) {
 605                                     $facet_label_value =
 606                                       GetKohaAuthorisedValueLib( 'LOC',
 607                                         $one_facet, $opac );
 608                                 }
 609
 610                 # but we're down with the whole label being in the link's title.
 611                                 push @this_facets_array,
 612                                   {
 613                                     facet_count =>
 614                                       $facets_counter->{$link_value}
 615                                       ->{$one_facet},
 616                                     facet_label_value => $facet_label_value,
 617                                     facet_title_value => $one_facet,
 618                                     facet_link_value  => $facet_link_value,
 619                                     type_link_value   => $link_value,
 620                                   }
 621                                   if ($facet_label_value);
 622                             }
 623                         }
 624
 625                         # handle expanded option
 626                         unless ( $facets_info->{$link_value}->{'expanded'} ) {
 627                             $expandable = 1
 628                               if ( ( $number_of_facets > 6 )
 629                                 && ( $expanded_facet ne $link_value ) );
 630                         }
 631                         push @facets_loop,
 632                           {
 633                             type_link_value => $link_value,
 634                             type_id         => $link_value . "_id",
 635                             "type_label_"
 636                               . $facets_info->{$link_value}->{'label_value'} =>
 637                               1,
 638                             facets     => \@this_facets_array,
 639                             expandable => $expandable,
 640                             expand     => $link_value,
 641                           }
 642                           unless (
 643                             (
 644                                 $facets_info->{$link_value}->{'label_value'} =~
 645                                 /Libraries/
 646                             )
 647                             and ( C4::Context->preference('singleBranchMode') )
 648                           );
 649                     }
 650                 }
 651             }
 652         );
 653     return ( undef, $results_hashref, \@facets_loop );
 654 }
 655
 656 sub pazGetRecords {
 657     my (
 658         $koha_query,       $simple_query, $sort_by_ref,    $servers_ref,
 659         $results_per_page, $offset,       $expanded_facet, $branches,
 660         $query_type,       $scan
 661     ) = @_;
 662
 663     my $paz = C4::Search::PazPar2->new(C4::Context->config('pazpar2url'));
 664     $paz->init();
 665     $paz->search($simple_query);
 666     sleep 1;   # FIXME: WHY?
 667
 668     # do results
 669     my $results_hashref = {};
 670     my $stats = XMLin($paz->stat);
 671     my $results = XMLin($paz->show($offset, $results_per_page, 'work-title:1'), forcearray => 1);
 672
 673     # for a grouped search result, the number of hits
 674     # is the number of groups returned; 'bib_hits' will have
 675     # the total number of bibs.
 676     $results_hashref->{'biblioserver'}->{'hits'} = $results->{'merged'}->[0];
 677     $results_hashref->{'biblioserver'}->{'bib_hits'} = $stats->{'hits'};
 678
 679     HIT: foreach my $hit (@{ $results->{'hit'} }) {
 680         my $recid = $hit->{recid}->[0];
 681
 682         my $work_title = $hit->{'md-work-title'}->[0];
 683         my $work_author;
 684         if (exists $hit->{'md-work-author'}) {
 685             $work_author = $hit->{'md-work-author'}->[0];
 686         }
 687         my $group_label = (defined $work_author) ? "$work_title / $work_author" : $work_title;
 688
 689         my $result_group = {};
 690         $result_group->{'group_label'} = $group_label;
 691         $result_group->{'group_merge_key'} = $recid;
 692
 693         my $count = 1;
 694         if (exists $hit->{count}) {
 695             $count = $hit->{count}->[0];
 696         }
 697         $result_group->{'group_count'} = $count;
 698
 699         for (my $i = 0; $i < $count; $i++) {
 700             # FIXME -- may need to worry about diacritics here
 701             my $rec = $paz->record($recid, $i);
 702             push @{ $result_group->{'RECORDS'} }, $rec;
 703         }
 704
 705         push @{ $results_hashref->{'biblioserver'}->{'GROUPS'} }, $result_group;
 706     }
 707
 708     # pass through facets
 709     my $termlist_xml = $paz->termlist('author,subject');
 710     my $terms = XMLin($termlist_xml, forcearray => 1);
 711     my @facets_loop = ();
 712     #die Dumper($results);
 713 #    foreach my $list (sort keys %{ $terms->{'list'} }) {
 714 #        my @facets = ();
 715 #        foreach my $facet (sort @{ $terms->{'list'}->{$list}->{'term'} } ) {
 716 #            push @facets, {
 717 #                facet_label_value => $facet->{'name'}->[0],
 718 #            };
 719 #        }
 720 #        push @facets_loop, ( {
 721 #            type_label => $list,
 722 #            facets => \@facets,
 723 #        } );
 724 #    }
 725
 726     return ( undef, $results_hashref, \@facets_loop );
 727 }
 728
 729 # STOPWORDS
 730 sub _remove_stopwords {
 731     my ( $operand, $index ) = @_;
 732     my @stopwords_removed;
 733
 734     # phrase and exact-qualified indexes shouldn't have stopwords removed
 735     if ( $index !~ m/phr|ext/ ) {
 736
 737 # remove stopwords from operand : parse all stopwords & remove them (case insensitive)
 738 #       we use IsAlpha unicode definition, to deal correctly with diacritics.
 739 #       otherwise, a French word like "leçon" woudl be split into "le" "çon", "le"
 740 #       is a stopword, we'd get "çon" and wouldn't find anything...
 741 #
 742                 foreach ( keys %{ C4::Context->stopwords } ) {
 743                         next if ( $_ =~ /(and|or|not)/ );    # don't remove operators
 744                         if ( my ($matched) = ($operand =~
 745                                 /([^\X\p{isAlnum}]\Q$_\E[^\X\p{isAlnum}]|[^\X\p{isAlnum}]\Q$_\E$|^\Q$_\E[^\X\p{isAlnum}])/gi))
 746                         {
 747                                 $operand =~ s/\Q$matched\E/ /gi;
 748                                 push @stopwords_removed, $_;
 749                         }
 750                 }
 751         }
 752     return ( $operand, \@stopwords_removed );
 753 }
 754
 755 # TRUNCATION
 756 sub _detect_truncation {
 757     my ( $operand, $index ) = @_;
 758     my ( @nontruncated, @righttruncated, @lefttruncated, @rightlefttruncated,
 759         @regexpr );
 760     $operand =~ s/^ //g;
 761     my @wordlist = split( /\s/, $operand );
 762     foreach my $word (@wordlist) {
 763         if ( $word =~ s/^\*([^\*]+)\*$/$1/ ) {
 764             push @rightlefttruncated, $word;
 765         }
 766         elsif ( $word =~ s/^\*([^\*]+)$/$1/ ) {
 767             push @lefttruncated, $word;
 768         }
 769         elsif ( $word =~ s/^([^\*]+)\*$/$1/ ) {
 770             push @righttruncated, $word;
 771         }
 772         elsif ( index( $word, "*" ) < 0 ) {
 773             push @nontruncated, $word;
 774         }
 775         else {
 776             push @regexpr, $word;
 777         }
 778     }
 779     return (
 780         \@nontruncated,       \@righttruncated, \@lefttruncated,
 781         \@rightlefttruncated, \@regexpr
 782     );
 783 }
 784
 785 # STEMMING
 786 sub _build_stemmed_operand {
 787     my ($operand,$lang) = @_;
 788     require Lingua::Stem::Snowball ;
 789     my $stemmed_operand=q{};
 790
 791     # If operand contains a digit, it is almost certainly an identifier, and should
 792     # not be stemmed.  This is particularly relevant for ISBNs and ISSNs, which
 793     # can contain the letter "X" - for example, _build_stemmend_operand would reduce
 794     # "014100018X" to "x ", which for a MARC21 database would bring up irrelevant
 795     # results (e.g., "23 x 29 cm." from the 300$c).  Bug 2098.
 796     return $operand if $operand =~ /\d/;
 797
 798 # FIXME: the locale should be set based on the user's language and/or search choice
 799     #warn "$lang";
 800     # Make sure we only use the first two letters from the language code
 801     $lang = lc(substr($lang, 0, 2));
 802     # The language codes for the two variants of Norwegian will now be "nb" and "nn",
 803     # none of which Lingua::Stem::Snowball can use, so we need to "translate" them
 804     if ($lang eq 'nb' || $lang eq 'nn') {
 805       $lang = 'no';
 806     }
 807     my $stemmer = Lingua::Stem::Snowball->new( lang => $lang,
 808                                                encoding => "UTF-8" );
 809
 810     my @words = split( / /, $operand );
 811     my @stems = $stemmer->stem(\@words);
 812     for my $stem (@stems) {
 813         $stemmed_operand .= "$stem";
 814         $stemmed_operand .= "?"
 815           unless ( $stem =~ /(and$|or$|not$)/ ) || ( length($stem) < 3 );
 816         $stemmed_operand .= " ";
 817     }
 818     warn "STEMMED OPERAND: $stemmed_operand" if $DEBUG;
 819     return $stemmed_operand;
 820 }
 821
 822 # FIELD WEIGHTING
 823 sub _build_weighted_query {
 824
 825 # FIELD WEIGHTING - This is largely experimental stuff. What I'm committing works
 826 # pretty well but could work much better if we had a smarter query parser
 827     my ( $operand, $stemmed_operand, $index ) = @_;
 828     my $stemming      = C4::Context->preference("QueryStemming")     || 0;
 829     my $weight_fields = C4::Context->preference("QueryWeightFields") || 0;
 830     my $fuzzy_enabled = C4::Context->preference("QueryFuzzy")        || 0;
 831
 832     my $weighted_query .= "(rk=(";    # Specifies that we're applying rank
 833
 834     # Keyword, or, no index specified
 835     if ( ( $index eq 'kw' ) || ( !$index ) ) {
 836         $weighted_query .=
 837           "Title-cover,ext,r1=\"$operand\"";    # exact title-cover
 838         $weighted_query .= " or ti,ext,r2=\"$operand\"";    # exact title
 839         $weighted_query .= " or Title-cover,phr,r3=\"$operand\"";    # phrase title
 840           #$weighted_query .= " or any,ext,r4=$operand";               # exact any
 841           #$weighted_query .=" or kw,wrdl,r5=\"$operand\"";            # word list any
 842         $weighted_query .= " or wrdl,fuzzy,r8=\"$operand\""
 843           if $fuzzy_enabled;    # add fuzzy, word list
 844         $weighted_query .= " or wrdl,right-Truncation,r9=\"$stemmed_operand\""
 845           if ( $stemming and $stemmed_operand )
 846           ;                     # add stemming, right truncation
 847         $weighted_query .= " or wrdl,r9=\"$operand\"";
 848
 849         # embedded sorting: 0 a-z; 1 z-a
 850         # $weighted_query .= ") or (sort1,aut=1";
 851     }
 852
 853     # Barcode searches should skip this process
 854     elsif ( $index eq 'bc' ) {
 855         $weighted_query .= "bc=\"$operand\"";
 856     }
 857
 858     # Authority-number searches should skip this process
 859     elsif ( $index eq 'an' ) {
 860         $weighted_query .= "an=\"$operand\"";
 861     }
 862
 863     # If the index already has more than one qualifier, wrap the operand
 864     # in quotes and pass it back (assumption is that the user knows what they
 865     # are doing and won't appreciate us mucking up their query
 866     elsif ( $index =~ ',' ) {
 867         $weighted_query .= " $index=\"$operand\"";
 868     }
 869
 870     #TODO: build better cases based on specific search indexes
 871     else {
 872         $weighted_query .= " $index,ext,r1=\"$operand\"";    # exact index
 873           #$weighted_query .= " or (title-sort-az=0 or $index,startswithnt,st-word,r3=$operand #)";
 874         $weighted_query .= " or $index,phr,r3=\"$operand\"";    # phrase index
 875         $weighted_query .=
 876           " or $index,rt,wrdl,r3=\"$operand\"";    # word list index
 877     }
 878
 879     $weighted_query .= "))";                       # close rank specification
 880     return $weighted_query;
 881 }
 882
 883 =head2 getIndexes
 884
 885 Return an array with available indexes.
 886
 887 =cut
 888
 889 sub getIndexes{
 890     my @indexes = (
 891                     # biblio indexes
 892                     'ab',
 893                     'Abstract',
 894                     'acqdate',
 895                     'allrecords',
 896                     'an',
 897                     'Any',
 898                     'at',
 899                     'au',
 900                     'aub',
 901                     'aud',
 902                     'audience',
 903                     'auo',
 904                     'aut',
 905                     'Author',
 906                     'Author-in-order ',
 907                     'Author-personal-bibliography',
 908                     'Authority-Number',
 909                     'authtype',
 910                     'bc',
 911                     'Bib-level',
 912                     'biblionumber',
 913                     'bio',
 914                     'biography',
 915                     'callnum',
 916                     'cfn',
 917                     'Chronological-subdivision',
 918                     'cn-bib-source',
 919                     'cn-bib-sort',
 920                     'cn-class',
 921                     'cn-item',
 922                     'cn-prefix',
 923                     'cn-suffix',
 924                     'cpn',
 925                     'Code-institution',
 926                     'Conference-name',
 927                     'Conference-name-heading',
 928                     'Conference-name-see',
 929                     'Conference-name-seealso',
 930                     'Content-type',
 931                     'Control-number',
 932                     'copydate',
 933                     'Corporate-name',
 934                     'Corporate-name-heading',
 935                     'Corporate-name-see',
 936                     'Corporate-name-seealso',
 937                     'ctype',
 938                     'date-entered-on-file',
 939                     'Date-of-acquisition',
 940                     'Date-of-publication',
 941                     'Dewey-classification',
 942                     'EAN',
 943                     'extent',
 944                     'fic',
 945                     'fiction',
 946                     'Form-subdivision',
 947                     'format',
 948                     'Geographic-subdivision',
 949                     'he',
 950                     'Heading',
 951                     'Heading-use-main-or-added-entry',
 952                     'Heading-use-series-added-entry ',
 953                     'Heading-use-subject-added-entry',
 954                     'Host-item',
 955                     'id-other',
 956                     'Illustration-code',
 957                     'ISBN',
 958                     'isbn',
 959                     'ISSN',
 960                     'issn',
 961                     'itemtype',
 962                     'kw',
 963                     'Koha-Auth-Number',
 964                     'l-format',
 965                     'language',
 966                     'lc-card',
 967                     'LC-card-number',
 968                     'lcn',
 969                     'llength',
 970                     'ln',
 971                     'Local-classification',
 972                     'Local-number',
 973                     'Match-heading',
 974                     'Match-heading-see-from',
 975                     'Material-type',
 976                     'mc-itemtype',
 977                     'mc-rtype',
 978                     'mus',
 979                     'name',
 980                     'Music-number',
 981                     'Name-geographic',
 982                     'Name-geographic-heading',
 983                     'Name-geographic-see',
 984                     'Name-geographic-seealso',
 985                     'nb',
 986                     'Note',
 987                     'notes',
 988                     'ns',
 989                     'nt',
 990                     'pb',
 991                     'Personal-name',
 992                     'Personal-name-heading',
 993                     'Personal-name-see',
 994                     'Personal-name-seealso',
 995                     'pl',
 996                     'Place-publication',
 997                     'pn',
 998                     'popularity',
 999                     'pubdate',
1000                     'Publisher',
1001                     'Record-control-number',
1002                     'rcn',
1003                     'Record-type',
1004                     'rtype',
1005                     'se',
1006                     'See',
1007                     'See-also',
1008                     'sn',
1009                     'Stock-number',
1010                     'su',
1011                     'Subject',
1012                     'Subject-heading-thesaurus',
1013                     'Subject-name-personal',
1014                     'Subject-subdivision',
1015                     'Summary',
1016                     'Suppress',
1017                     'su-geo',
1018                     'su-na',
1019                     'su-to',
1020                     'su-ut',
1021                     'ut',
1022                     'UPC',
1023                     'Term-genre-form',
1024                     'Term-genre-form-heading',
1025                     'Term-genre-form-see',
1026                     'Term-genre-form-seealso',
1027                     'ti',
1028                     'Title',
1029                     'Title-cover',
1030                     'Title-series',
1031                     'Title-host',
1032                     'Title-uniform',
1033                     'Title-uniform-heading',
1034                     'Title-uniform-see',
1035                     'Title-uniform-seealso',
1036                     'totalissues',
1037                     'yr',
1038
1039                     # items indexes
1040                     'acqsource',
1041                     'barcode',
1042                     'bc',
1043                     'branch',
1044                     'ccode',
1045                     'classification-source',
1046                     'cn-sort',
1047                     'coded-location-qualifier',
1048                     'copynumber',
1049                     'damaged',
1050                     'datelastborrowed',
1051                     'datelastseen',
1052                     'holdingbranch',
1053                     'homebranch',
1054                     'issues',
1055                     'item',
1056                     'itemnumber',
1057                     'itype',
1058                     'Local-classification',
1059                     'location',
1060                     'lost',
1061                     'materials-specified',
1062                     'mc-ccode',
1063                     'mc-itype',
1064                     'mc-loc',
1065                     'notforloan',
1066                     'onloan',
1067                     'price',
1068                     'renewals',
1069                     'replacementprice',
1070                     'replacementpricedate',
1071                     'reserves',
1072                     'restricted',
1073                     'stack',
1074                     'stocknumber',
1075                     'inv',
1076                     'uri',
1077                     'withdrawn',
1078
1079                     # subject related
1080                   );
1081
1082     return \@indexes;
1083 }
1084
1085 =head2 _handle_exploding_index
1086
1087     my $query = _handle_exploding_index($index, $term)
1088
1089 Callback routine to generate the search for "exploding" indexes (i.e.
1090 those indexes which are turned into multiple or-connected searches based
1091 on authority data).
1092
1093 =cut
1094
1095 sub _handle_exploding_index {
1096     my ( $index, $term ) = @_;
1097
1098     return unless ($index =~ m/(su-br|su-na|su-rl)/ && $term);
1099
1100     my $marcflavour = C4::Context->preference('marcflavour');
1101
1102     my $codesubfield = $marcflavour eq 'UNIMARC' ? '5' : 'w';
1103     my $wantedcodes = '';
1104     my @subqueries = ( "(su=\"$term\")");
1105     my ($error, $results, $total_hits) = SimpleSearch( "Heading,wrdl=$term", undef, undef, [ "authorityserver" ] );
1106     foreach my $auth (@$results) {
1107         my $record = MARC::Record->new_from_usmarc($auth);
1108         my @references = $record->field('5..');
1109         if (@references) {
1110             if ($index eq 'su-br') {
1111                 $wantedcodes = 'g';
1112             } elsif ($index eq 'su-na') {
1113                 $wantedcodes = 'h';
1114             } elsif ($index eq 'su-rl') {
1115                 $wantedcodes = '';
1116             }
1117             foreach my $reference (@references) {
1118                 my $codes = $reference->subfield($codesubfield);
1119                 push @subqueries, '(su="' . $reference->as_string('abcdefghijlmnopqrstuvxyz') . '")' if (($codes && $codes eq $wantedcodes) || !$wantedcodes);
1120             }
1121         }
1122     }
1123     return join(' or ', @subqueries);
1124 }
1125
1126 =head2 parseQuery
1127
1128     ( $operators, $operands, $indexes, $limits,
1129       $sort_by, $scan, $lang ) =
1130             buildQuery ( $operators, $operands, $indexes, $limits, $sort_by, $scan, $lang);
1131
1132 Shim function to ease the transition from buildQuery to a new QueryParser.
1133 This function is called at the beginning of buildQuery, and modifies
1134 buildQuery's input. If it can handle the input, it returns a query that
1135 buildQuery will not try to parse.
1136 =cut
1137
1138 sub parseQuery {
1139     my ( $operators, $operands, $indexes, $limits, $sort_by, $scan, $lang) = @_;
1140
1141     my @operators = $operators ? @$operators : ();
1142     my @indexes   = $indexes   ? @$indexes   : ();
1143     my @operands  = $operands  ? @$operands  : ();
1144     my @limits    = $limits    ? @$limits    : ();
1145     my @sort_by   = $sort_by   ? @$sort_by   : ();
1146
1147     my $query = $operands[0];
1148     my $index;
1149     my $term;
1150
1151 # TODO: once we are using QueryParser, all this special case code for
1152 #       exploded search indexes will be replaced by a callback to
1153 #       _handle_exploding_index
1154     if ( $query =~ m/^(.*)\b(su-br|su-na|su-rl)[:=](\w.*)$/ ) {
1155         $query = $1;
1156         $index = $2;
1157         $term  = $3;
1158     } else {
1159         $query = '';
1160         for ( my $i = 0 ; $i <= @operands ; $i++ ) {
1161             if ($operands[$i] && $indexes[$i] =~ m/(su-br|su-na|su-rl)/) {
1162                 $index = $indexes[$i];
1163                 $term = $operands[$i];
1164             } elsif ($operands[$i]) {
1165                 $query .= $operators[$i] eq 'or' ? ' or ' : ' and ' if ($query);
1166                 $query .= "($indexes[$i]:$operands[$i])";
1167             }
1168         }
1169     }
1170
1171     if ($index) {
1172         my $queryPart = _handle_exploding_index($index, $term);
1173         if ($queryPart) {
1174             $query .= "($queryPart)";
1175         }
1176         $operators = ();
1177         $operands[0] = "ccl=$query";
1178     }
1179
1180     return ( $operators, \@operands, $indexes, $limits, $sort_by, $scan, $lang);
1181 }
1182
1183 =head2 buildQuery
1184
1185 ( $error, $query,
1186 $simple_query, $query_cgi,
1187 $query_desc, $limit,
1188 $limit_cgi, $limit_desc,
1189 $stopwords_removed, $query_type ) = buildQuery ( $operators, $operands, $indexes, $limits, $sort_by, $scan, $lang);
1190
1191 Build queries and limits in CCL, CGI, Human,
1192 handle truncation, stemming, field weighting, stopwords, fuzziness, etc.
1193
1194 See verbose embedded documentation.
1195
1196
1197 =cut
1198
1199 sub buildQuery {
1200     my ( $operators, $operands, $indexes, $limits, $sort_by, $scan, $lang) = @_;
1201
1202     warn "---------\nEnter buildQuery\n---------" if $DEBUG;
1203
1204     ( $operators, $operands, $indexes, $limits, $sort_by, $scan, $lang) = parseQuery($operators, $operands, $indexes, $limits, $sort_by, $scan, $lang);
1205
1206     # dereference
1207     my @operators = $operators ? @$operators : ();
1208     my @indexes   = $indexes   ? @$indexes   : ();
1209     my @operands  = $operands  ? @$operands  : ();
1210     my @limits    = $limits    ? @$limits    : ();
1211     my @sort_by   = $sort_by   ? @$sort_by   : ();
1212
1213     my $stemming         = C4::Context->preference("QueryStemming")        || 0;
1214     my $auto_truncation  = C4::Context->preference("QueryAutoTruncate")    || 0;
1215     my $weight_fields    = C4::Context->preference("QueryWeightFields")    || 0;
1216     my $fuzzy_enabled    = C4::Context->preference("QueryFuzzy")           || 0;
1217     my $remove_stopwords = C4::Context->preference("QueryRemoveStopwords") || 0;
1218
1219     # no stemming/weight/fuzzy in NoZebra
1220     if ( C4::Context->preference("NoZebra") ) {
1221         $stemming         = 0;
1222         $weight_fields    = 0;
1223         $fuzzy_enabled    = 0;
1224         $auto_truncation  = 0;
1225     }
1226
1227     my $query        = $operands[0];
1228     my $simple_query = $operands[0];
1229
1230     # initialize the variables we're passing back
1231     my $query_cgi;
1232     my $query_desc;
1233     my $query_type;
1234
1235     my $limit;
1236     my $limit_cgi;
1237     my $limit_desc;
1238
1239     my $stopwords_removed;    # flag to determine if stopwords have been removed
1240
1241     my $cclq       = 0;
1242     my $cclindexes = getIndexes();
1243     if ( $query !~ /\s*ccl=/ ) {
1244         while ( !$cclq && $query =~ /(?:^|\W)([\w-]+)(,[\w-]+)*[:=]/g ) {
1245             my $dx = lc($1);
1246             $cclq = grep { lc($_) eq $dx } @$cclindexes;
1247         }
1248         $query = "ccl=$query" if $cclq;
1249     }
1250
1251 # for handling ccl, cql, pqf queries in diagnostic mode, skip the rest of the steps
1252 # DIAGNOSTIC ONLY!!
1253     if ( $query =~ /^ccl=/ ) {
1254         my $q=$';
1255         # This is needed otherwise ccl= and &limit won't work together, and
1256         # this happens when selecting a subject on the opac-detail page
1257         @limits = grep {!/^$/} @limits;
1258         if ( @limits ) {
1259             $q .= ' and '.join(' and ', @limits);
1260         }
1261         return ( undef, $q, $q, "q=ccl=$q", $q, '', '', '', '', 'ccl' );
1262     }
1263     if ( $query =~ /^cql=/ ) {
1264         return ( undef, $', $', "q=cql=$'", $', '', '', '', '', 'cql' );
1265     }
1266     if ( $query =~ /^pqf=/ ) {
1267         return ( undef, $', $', "q=pqf=$'", $', '', '', '', '', 'pqf' );
1268     }
1269
1270     # pass nested queries directly
1271     # FIXME: need better handling of some of these variables in this case
1272     # Nested queries aren't handled well and this implementation is flawed and causes users to be
1273     # unable to search for anything containing () commenting out, will be rewritten for 3.4.0
1274 #    if ( $query =~ /(\(|\))/ ) {
1275 #        return (
1276 #            undef,              $query, $simple_query, $query_cgi,
1277 #            $query,             $limit, $limit_cgi,    $limit_desc,
1278 #            $stopwords_removed, 'ccl'
1279 #        );
1280 #    }
1281
1282 # Form-based queries are non-nested and fixed depth, so we can easily modify the incoming
1283 # query operands and indexes and add stemming, truncation, field weighting, etc.
1284 # Once we do so, we'll end up with a value in $query, just like if we had an
1285 # incoming $query from the user
1286     else {
1287         $query = ""
1288           ; # clear it out so we can populate properly with field-weighted, stemmed, etc. query
1289         my $previous_operand
1290           ;    # a flag used to keep track if there was a previous query
1291                # if there was, we can apply the current operator
1292                # for every operand
1293         for ( my $i = 0 ; $i <= @operands ; $i++ ) {
1294
1295             # COMBINE OPERANDS, INDEXES AND OPERATORS
1296             if ( $operands[$i] ) {
1297                 $operands[$i]=~s/^\s+//;
1298
1299               # A flag to determine whether or not to add the index to the query
1300                 my $indexes_set;
1301
1302 # If the user is sophisticated enough to specify an index, turn off field weighting, stemming, and stopword handling
1303                 if ( $operands[$i] =~ /\w(:|=)/ || $scan ) {
1304                     $weight_fields    = 0;
1305                     $stemming         = 0;
1306                     $remove_stopwords = 0;
1307                 } else {
1308                     $operands[$i] =~ s/\?/{?}/g; # need to escape question marks
1309                 }
1310                 my $operand = $operands[$i];
1311                 my $index   = $indexes[$i];
1312
1313                 # Add index-specific attributes
1314                 # Date of Publication
1315                 if ( $index eq 'yr' ) {
1316                     $index .= ",st-numeric";
1317                     $indexes_set++;
1318                                         $stemming = $auto_truncation = $weight_fields = $fuzzy_enabled = $remove_stopwords = 0;
1319                 }
1320
1321                 # Date of Acquisition
1322                 elsif ( $index eq 'acqdate' ) {
1323                     $index .= ",st-date-normalized";
1324                     $indexes_set++;
1325                                         $stemming = $auto_truncation = $weight_fields = $fuzzy_enabled = $remove_stopwords = 0;
1326                 }
1327                 # ISBN,ISSN,Standard Number, don't need special treatment
1328                 elsif ( $index eq 'nb' || $index eq 'ns' ) {
1329                     (
1330                         $stemming,      $auto_truncation,
1331                         $weight_fields, $fuzzy_enabled,
1332                         $remove_stopwords
1333                     ) = ( 0, 0, 0, 0, 0 );
1334
1335                 }
1336
1337                 if(not $index){
1338                     $index = 'kw';
1339                 }
1340
1341                 # Set default structure attribute (word list)
1342                 my $struct_attr = q{};
1343                 unless ( $indexes_set || !$index || $index =~ /(st-|phr|ext|wrdl|nb|ns)/ ) {
1344                     $struct_attr = ",wrdl";
1345                 }
1346
1347                 # Some helpful index variants
1348                 my $index_plus       = $index . $struct_attr . ':';
1349                 my $index_plus_comma = $index . $struct_attr . ',';
1350
1351                 # Remove Stopwords
1352                 if ($remove_stopwords) {
1353                     ( $operand, $stopwords_removed ) =
1354                       _remove_stopwords( $operand, $index );
1355                     warn "OPERAND w/out STOPWORDS: >$operand<" if $DEBUG;
1356                     warn "REMOVED STOPWORDS: @$stopwords_removed"
1357                       if ( $stopwords_removed && $DEBUG );
1358                 }
1359
1360                 if ($auto_truncation){
1361                                         unless ( $index =~ /(st-|phr|ext)/ ) {
1362                                                 #FIXME only valid with LTR scripts
1363                                                 $operand=join(" ",map{
1364                                                                                         (index($_,"*")>0?"$_":"$_*")
1365                                                                                          }split (/\s+/,$operand));
1366                                                 warn $operand if $DEBUG;
1367                                         }
1368                                 }
1369
1370                 # Detect Truncation
1371                 my $truncated_operand;
1372                 my( $nontruncated, $righttruncated, $lefttruncated,
1373                     $rightlefttruncated, $regexpr
1374                 ) = _detect_truncation( $operand, $index );
1375                 warn
1376 "TRUNCATION: NON:>@$nontruncated< RIGHT:>@$righttruncated< LEFT:>@$lefttruncated< RIGHTLEFT:>@$rightlefttruncated< REGEX:>@$regexpr<"
1377                   if $DEBUG;
1378
1379                 # Apply Truncation
1380                 if (
1381                     scalar(@$righttruncated) + scalar(@$lefttruncated) +
1382                     scalar(@$rightlefttruncated) > 0 )
1383                 {
1384
1385                # Don't field weight or add the index to the query, we do it here
1386                     $indexes_set = 1;
1387                     undef $weight_fields;
1388                     my $previous_truncation_operand;
1389                     if (scalar @$nontruncated) {
1390                         $truncated_operand .= "$index_plus @$nontruncated ";
1391                         $previous_truncation_operand = 1;
1392                     }
1393                     if (scalar @$righttruncated) {
1394                         $truncated_operand .= "and " if $previous_truncation_operand;
1395                         $truncated_operand .= $index_plus_comma . "rtrn:@$righttruncated ";
1396                         $previous_truncation_operand = 1;
1397                     }
1398                     if (scalar @$lefttruncated) {
1399                         $truncated_operand .= "and " if $previous_truncation_operand;
1400                         $truncated_operand .= $index_plus_comma . "ltrn:@$lefttruncated ";
1401                         $previous_truncation_operand = 1;
1402                     }
1403                     if (scalar @$rightlefttruncated) {
1404                         $truncated_operand .= "and " if $previous_truncation_operand;
1405                         $truncated_operand .= $index_plus_comma . "rltrn:@$rightlefttruncated ";
1406                         $previous_truncation_operand = 1;
1407                     }
1408                 }
1409                 $operand = $truncated_operand if $truncated_operand;
1410                 warn "TRUNCATED OPERAND: >$truncated_operand<" if $DEBUG;
1411
1412                 # Handle Stemming
1413                 my $stemmed_operand;
1414                 $stemmed_operand = _build_stemmed_operand($operand, $lang)
1415                                                                                 if $stemming;
1416
1417                 warn "STEMMED OPERAND: >$stemmed_operand<" if $DEBUG;
1418
1419                 # Handle Field Weighting
1420                 my $weighted_operand;
1421                 if ($weight_fields) {
1422                     $weighted_operand = _build_weighted_query( $operand, $stemmed_operand, $index );
1423                     $operand = $weighted_operand;
1424                     $indexes_set = 1;
1425                 }
1426
1427                 warn "FIELD WEIGHTED OPERAND: >$weighted_operand<" if $DEBUG;
1428
1429                 # If there's a previous operand, we need to add an operator
1430                 if ($previous_operand) {
1431
1432                     # User-specified operator
1433                     if ( $operators[ $i - 1 ] ) {
1434                         $query     .= " $operators[$i-1] ";
1435                         $query     .= " $index_plus " unless $indexes_set;
1436                         $query     .= " $operand";
1437                         $query_cgi .= "&op=$operators[$i-1]";
1438                         $query_cgi .= "&idx=$index" if $index;
1439                         $query_cgi .= "&q=$operands[$i]" if $operands[$i];
1440                         $query_desc .=
1441                           " $operators[$i-1] $index_plus $operands[$i]";
1442                     }
1443
1444                     # Default operator is and
1445                     else {
1446                         $query      .= " and ";
1447                         $query      .= "$index_plus " unless $indexes_set;
1448                         $query      .= "$operand";
1449                         $query_cgi  .= "&op=and&idx=$index" if $index;
1450                         $query_cgi  .= "&q=$operands[$i]" if $operands[$i];
1451                         $query_desc .= " and $index_plus $operands[$i]";
1452                     }
1453                 }
1454
1455                 # There isn't a pervious operand, don't need an operator
1456                 else {
1457
1458                     # Field-weighted queries already have indexes set
1459                     $query .= " $index_plus " unless $indexes_set;
1460                     $query .= $operand;
1461                     $query_desc .= " $index_plus $operands[$i]";
1462                     $query_cgi  .= "&idx=$index" if $index;
1463                     $query_cgi  .= "&q=$operands[$i]" if $operands[$i];
1464                     $previous_operand = 1;
1465                 }
1466             }    #/if $operands
1467         }    # /for
1468     }
1469     warn "QUERY BEFORE LIMITS: >$query<" if $DEBUG;
1470
1471     # add limits
1472     my %group_OR_limits;
1473     my $availability_limit;
1474     foreach my $this_limit (@limits) {
1475         next unless $this_limit;
1476         if ( $this_limit =~ /available/ ) {
1477 #
1478 ## 'available' is defined as (items.onloan is NULL) and (items.itemlost = 0)
1479 ## In English:
1480 ## all records not indexed in the onloan register (zebra) and all records with a value of lost equal to 0
1481             $availability_limit .=
1482 "( ( allrecords,AlwaysMatches='' not onloan,AlwaysMatches='') and (lost,st-numeric=0) )"; #or ( allrecords,AlwaysMatches='' not lost,AlwaysMatches='')) )";
1483             $limit_cgi  .= "&limit=available";
1484             $limit_desc .= "";
1485         }
1486
1487         # group_OR_limits, prefixed by mc-
1488         # OR every member of the group
1489         elsif ( $this_limit =~ /mc/ ) {
1490             my ($k,$v) = split(/:/, $this_limit,2);
1491             if ( $k !~ /mc-i(tem)?type/ ) {
1492                 # in case the mc-ccode value has complicating chars like ()'s inside it we wrap in quotes
1493                 $this_limit =~ tr/"//d;
1494                 $this_limit = $k.":\"".$v."\"";
1495             }
1496
1497             $group_OR_limits{$k} .= " or " if $group_OR_limits{$k};
1498             $limit_desc      .= " or " if $group_OR_limits{$k};
1499             $group_OR_limits{$k} .= "$this_limit";
1500             $limit_cgi       .= "&limit=$this_limit";
1501             $limit_desc      .= " $this_limit";
1502         }
1503
1504         # Regular old limits
1505         else {
1506             $limit .= " and " if $limit || $query;
1507             $limit      .= "$this_limit";
1508             $limit_cgi  .= "&limit=$this_limit";
1509             if ($this_limit =~ /^branch:(.+)/) {
1510                 my $branchcode = $1;
1511                 my $branchname = GetBranchName($branchcode);
1512                 if (defined $branchname) {
1513                     $limit_desc .= " branch:$branchname";
1514                 } else {
1515                     $limit_desc .= " $this_limit";
1516                 }
1517             } else {
1518                 $limit_desc .= " $this_limit";
1519             }
1520         }
1521     }
1522     foreach my $k (keys (%group_OR_limits)) {
1523         $limit .= " and " if ( $query || $limit );
1524         $limit .= "($group_OR_limits{$k})";
1525     }
1526     if ($availability_limit) {
1527         $limit .= " and " if ( $query || $limit );
1528         $limit .= "($availability_limit)";
1529     }
1530
1531     # Normalize the query and limit strings
1532     # This is flawed , means we can't search anything with : in it
1533     # if user wants to do ccl or cql, start the query with that
1534 #    $query =~ s/:/=/g;
1535     $query =~ s/(?<=(ti|au|pb|su|an|kw|mc|nb|ns)):/=/g;
1536     $query =~ s/(?<=(wrdl)):/=/g;
1537     $query =~ s/(?<=(trn|phr)):/=/g;
1538     $limit =~ s/:/=/g;
1539     for ( $query, $query_desc, $limit, $limit_desc ) {
1540         s/  +/ /g;    # remove extra spaces
1541         s/^ //g;     # remove any beginning spaces
1542         s/ $//g;     # remove any ending spaces
1543         s/==/=/g;    # remove double == from query
1544     }
1545     $query_cgi =~ s/^&//; # remove unnecessary & from beginning of the query cgi
1546
1547     for ($query_cgi,$simple_query) {
1548         s/"//g;
1549     }
1550     # append the limit to the query
1551     $query .= " " . $limit;
1552
1553     # Warnings if DEBUG
1554     if ($DEBUG) {
1555         warn "QUERY:" . $query;
1556         warn "QUERY CGI:" . $query_cgi;
1557         warn "QUERY DESC:" . $query_desc;
1558         warn "LIMIT:" . $limit;
1559         warn "LIMIT CGI:" . $limit_cgi;
1560         warn "LIMIT DESC:" . $limit_desc;
1561         warn "---------\nLeave buildQuery\n---------";
1562     }
1563     return (
1564         undef,              $query, $simple_query, $query_cgi,
1565         $query_desc,        $limit, $limit_cgi,    $limit_desc,
1566         $stopwords_removed, $query_type
1567     );
1568 }
1569
1570 =head2 searchResults
1571
1572   my @search_results = searchResults($search_context, $searchdesc, $hits,
1573                                      $results_per_page, $offset, $scan,
1574                                      @marcresults);
1575
1576 Format results in a form suitable for passing to the template
1577
1578 =cut
1579
1580 # IMO this subroutine is pretty messy still -- it's responsible for
1581 # building the HTML output for the template
1582 sub searchResults {
1583     my ( $search_context, $searchdesc, $hits, $results_per_page, $offset, $scan, $marcresults ) = @_;
1584     my $dbh = C4::Context->dbh;
1585     my @newresults;
1586
1587     require C4::Items;
1588
1589     $search_context = 'opac' if !$search_context || $search_context ne 'intranet';
1590     my ($is_opac, $hidelostitems);
1591     if ($search_context eq 'opac') {
1592         $hidelostitems = C4::Context->preference('hidelostitems');
1593         $is_opac       = 1;
1594     }
1595
1596     #Build branchnames hash
1597     #find branchname
1598     #get branch information.....
1599     my %branches;
1600     my $bsth =$dbh->prepare("SELECT branchcode,branchname FROM branches"); # FIXME : use C4::Branch::GetBranches
1601     $bsth->execute();
1602     while ( my $bdata = $bsth->fetchrow_hashref ) {
1603         $branches{ $bdata->{'branchcode'} } = $bdata->{'branchname'};
1604     }
1605 # FIXME - We build an authorised values hash here, using the default framework
1606 # though it is possible to have different authvals for different fws.
1607
1608     my $shelflocations =GetKohaAuthorisedValues('items.location','');
1609
1610     # get notforloan authorised value list (see $shelflocations  FIXME)
1611     my $notforloan_authorised_value = GetAuthValCode('items.notforloan','');
1612
1613     #Build itemtype hash
1614     #find itemtype & itemtype image
1615     my %itemtypes;
1616     $bsth =
1617       $dbh->prepare(
1618         "SELECT itemtype,description,imageurl,summary,notforloan FROM itemtypes"
1619       );
1620     $bsth->execute();
1621     while ( my $bdata = $bsth->fetchrow_hashref ) {
1622                 foreach (qw(description imageurl summary notforloan)) {
1623                 $itemtypes{ $bdata->{'itemtype'} }->{$_} = $bdata->{$_};
1624                 }
1625     }
1626
1627     #search item field code
1628     my ($itemtag, undef) = &GetMarcFromKohaField( "items.itemnumber", "" );
1629
1630     ## find column names of items related to MARC
1631     my $sth2 = $dbh->prepare("SHOW COLUMNS FROM items");
1632     $sth2->execute;
1633     my %subfieldstosearch;
1634     while ( ( my $column ) = $sth2->fetchrow ) {
1635         my ( $tagfield, $tagsubfield ) =
1636           &GetMarcFromKohaField( "items." . $column, "" );
1637         $subfieldstosearch{$column} = $tagsubfield;
1638     }
1639
1640     # handle which records to actually retrieve
1641     my $times;
1642     if ( $hits && $offset + $results_per_page <= $hits ) {
1643         $times = $offset + $results_per_page;
1644     }
1645     else {
1646         $times = $hits;  # FIXME: if $hits is undefined, why do we want to equal it?
1647     }
1648
1649         my $marcflavour = C4::Context->preference("marcflavour");
1650     # We get the biblionumber position in MARC
1651     my ($bibliotag,$bibliosubf)=GetMarcFromKohaField('biblio.biblionumber','');
1652
1653     # loop through all of the records we've retrieved
1654     for ( my $i = $offset ; $i <= $times - 1 ; $i++ ) {
1655         my $marcrecord = MARC::File::USMARC::decode( $marcresults->[$i] );
1656         my $fw = $scan
1657              ? undef
1658              : $bibliotag < 10
1659                ? GetFrameworkCode($marcrecord->field($bibliotag)->data)
1660                : GetFrameworkCode($marcrecord->subfield($bibliotag,$bibliosubf));
1661         my $oldbiblio = TransformMarcToKoha( $dbh, $marcrecord, $fw );
1662         $oldbiblio->{subtitle} = GetRecordValue('subtitle', $marcrecord, $fw);
1663         $oldbiblio->{result_number} = $i + 1;
1664
1665         # add imageurl to itemtype if there is one
1666         $oldbiblio->{imageurl} = getitemtypeimagelocation( $search_context, $itemtypes{ $oldbiblio->{itemtype} }->{imageurl} );
1667
1668         $oldbiblio->{'authorised_value_images'}  = ($search_context eq 'opac' && C4::Context->preference('AuthorisedValueImages')) || ($search_context eq 'intranet' && C4::Context->preference('StaffAuthorisedValueImages')) ? C4::Items::get_authorised_value_images( C4::Biblio::get_biblio_authorised_values( $oldbiblio->{'biblionumber'}, $marcrecord ) ) : [];
1669                 $oldbiblio->{normalized_upc}  = GetNormalizedUPC(       $marcrecord,$marcflavour);
1670                 $oldbiblio->{normalized_ean}  = GetNormalizedEAN(       $marcrecord,$marcflavour);
1671                 $oldbiblio->{normalized_oclc} = GetNormalizedOCLCNumber($marcrecord,$marcflavour);
1672                 $oldbiblio->{normalized_isbn} = GetNormalizedISBN(undef,$marcrecord,$marcflavour);
1673                 $oldbiblio->{content_identifier_exists} = 1 if ($oldbiblio->{normalized_isbn} or $oldbiblio->{normalized_oclc} or $oldbiblio->{normalized_ean} or $oldbiblio->{normalized_upc});
1674
1675                 # edition information, if any
1676         $oldbiblio->{edition} = $oldbiblio->{editionstatement};
1677                 $oldbiblio->{description} = $itemtypes{ $oldbiblio->{itemtype} }->{description};
1678  # Build summary if there is one (the summary is defined in the itemtypes table)
1679  # FIXME: is this used anywhere, I think it can be commented out? -- JF
1680         if ( $itemtypes{ $oldbiblio->{itemtype} }->{summary} ) {
1681             my $summary = $itemtypes{ $oldbiblio->{itemtype} }->{summary};
1682             my @fields  = $marcrecord->fields();
1683
1684             my $newsummary;
1685             foreach my $line ( "$summary\n" =~ /(.*)\n/g ){
1686                 my $tags = {};
1687                 foreach my $tag ( $line =~ /\[(\d{3}[\w|\d])\]/ ) {
1688                     $tag =~ /(.{3})(.)/;
1689                     if($marcrecord->field($1)){
1690                         my @abc = $marcrecord->field($1)->subfield($2);
1691                         $tags->{$tag} = $#abc + 1 ;
1692                     }
1693                 }
1694
1695                 # We catch how many times to repeat this line
1696                 my $max = 0;
1697                 foreach my $tag (keys(%$tags)){
1698                     $max = $tags->{$tag} if($tags->{$tag} > $max);
1699                  }
1700
1701                 # we replace, and repeat each line
1702                 for (my $i = 0 ; $i < $max ; $i++){
1703                     my $newline = $line;
1704
1705                     foreach my $tag ( $newline =~ /\[(\d{3}[\w|\d])\]/g ) {
1706                         $tag =~ /(.{3})(.)/;
1707
1708                         if($marcrecord->field($1)){
1709                             my @repl = $marcrecord->field($1)->subfield($2);
1710                             my $subfieldvalue = $repl[$i];
1711
1712                             if (! utf8::is_utf8($subfieldvalue)) {
1713                                 utf8::decode($subfieldvalue);
1714                             }
1715
1716                              $newline =~ s/\[$tag\]/$subfieldvalue/g;
1717                         }
1718                     }
1719                     $newsummary .= "$newline\n";
1720                 }
1721             }
1722
1723             $newsummary =~ s/\[(.*?)]//g;
1724             $newsummary =~ s/\n/<br\/>/g;
1725             $oldbiblio->{summary} = $newsummary;
1726         }
1727
1728         # Pull out the items fields
1729         my @fields = $marcrecord->field($itemtag);
1730         my $marcflavor = C4::Context->preference("marcflavour");
1731         # adding linked items that belong to host records
1732         my $analyticsfield = '773';
1733         if ($marcflavor eq 'MARC21' || $marcflavor eq 'NORMARC') {
1734             $analyticsfield = '773';
1735         } elsif ($marcflavor eq 'UNIMARC') {
1736             $analyticsfield = '461';
1737         }
1738         foreach my $hostfield ( $marcrecord->field($analyticsfield)) {
1739             my $hostbiblionumber = $hostfield->subfield("0");
1740             my $linkeditemnumber = $hostfield->subfield("9");
1741             if(!$hostbiblionumber eq undef){
1742                 my $hostbiblio = GetMarcBiblio($hostbiblionumber, 1);
1743                 my ($itemfield, undef) = GetMarcFromKohaField( 'items.itemnumber', GetFrameworkCode($hostbiblionumber) );
1744                 if(!$hostbiblio eq undef){
1745                     my @hostitems = $hostbiblio->field($itemfield);
1746                     foreach my $hostitem (@hostitems){
1747                         if ($hostitem->subfield("9") eq $linkeditemnumber){
1748                             my $linkeditem =$hostitem;
1749                             # append linked items if they exist
1750                             if (!$linkeditem eq undef){
1751                                 push (@fields, $linkeditem);}
1752                         }
1753                     }
1754                 }
1755             }
1756         }
1757
1758         # Setting item statuses for display
1759         my @available_items_loop;
1760         my @onloan_items_loop;
1761         my @other_items_loop;
1762
1763         my $available_items;
1764         my $onloan_items;
1765         my $other_items;
1766
1767         my $ordered_count         = 0;
1768         my $available_count       = 0;
1769         my $onloan_count          = 0;
1770         my $longoverdue_count     = 0;
1771         my $other_count           = 0;
1772         my $wthdrawn_count        = 0;
1773         my $itemlost_count        = 0;
1774         my $hideatopac_count      = 0;
1775         my $itembinding_count     = 0;
1776         my $itemdamaged_count     = 0;
1777         my $item_in_transit_count = 0;
1778         my $can_place_holds       = 0;
1779         my $item_onhold_count     = 0;
1780         my $items_count           = scalar(@fields);
1781         my $maxitems_pref = C4::Context->preference('maxItemsinSearchResults');
1782         my $maxitems = $maxitems_pref ? $maxitems_pref - 1 : 1;
1783         my @hiddenitems; # hidden itemnumbers based on OpacHiddenItems syspref
1784
1785         # loop through every item
1786         foreach my $field (@fields) {
1787             my $item;
1788
1789             # populate the items hash
1790             foreach my $code ( keys %subfieldstosearch ) {
1791                 $item->{$code} = $field->subfield( $subfieldstosearch{$code} );
1792             }
1793             $item->{description} = $itemtypes{ $item->{itype} }{description};
1794
1795                 # OPAC hidden items
1796             if ($is_opac) {
1797                 # hidden because lost
1798                 if ($hidelostitems && $item->{itemlost}) {
1799                     $hideatopac_count++;
1800                     next;
1801                 }
1802                 # hidden based on OpacHiddenItems syspref
1803                 my @hi = C4::Items::GetHiddenItemnumbers($item);
1804                 if (scalar @hi) {
1805                     push @hiddenitems, @hi;
1806                     $hideatopac_count++;
1807                     next;
1808                 }
1809             }
1810
1811             my $hbranch     = C4::Context->preference('HomeOrHoldingBranch') eq 'homebranch' ? 'homebranch'    : 'holdingbranch';
1812             my $otherbranch = C4::Context->preference('HomeOrHoldingBranch') eq 'homebranch' ? 'holdingbranch' : 'homebranch';
1813
1814             # set item's branch name, use HomeOrHoldingBranch syspref first, fall back to the other one
1815             if ($item->{$hbranch}) {
1816                 $item->{'branchname'} = $branches{$item->{$hbranch}};
1817             }
1818             elsif ($item->{$otherbranch}) {     # Last resort
1819                 $item->{'branchname'} = $branches{$item->{$otherbranch}};
1820             }
1821
1822                         my $prefix = $item->{$hbranch} . '--' . $item->{location} . $item->{itype} . $item->{itemcallnumber};
1823 # For each grouping of items (onloan, available, unavailable), we build a key to store relevant info about that item
1824             my $userenv = C4::Context->userenv;
1825             if ( $item->{onloan} && !(C4::Members::GetHideLostItemsPreference($userenv->{'number'}) && $item->{itemlost}) ) {
1826                 $onloan_count++;
1827                                 my $key = $prefix . $item->{onloan} . $item->{barcode};
1828                                 $onloan_items->{$key}->{due_date} = format_date($item->{onloan});
1829                                 $onloan_items->{$key}->{count}++ if $item->{$hbranch};
1830                                 $onloan_items->{$key}->{branchname} = $item->{branchname};
1831                                 $onloan_items->{$key}->{location} = $shelflocations->{ $item->{location} };
1832                                 $onloan_items->{$key}->{itemcallnumber} = $item->{itemcallnumber};
1833                                 $onloan_items->{$key}->{description} = $item->{description};
1834                                 $onloan_items->{$key}->{imageurl} = getitemtypeimagelocation( $search_context, $itemtypes{ $item->{itype} }->{imageurl} );
1835                 # if something's checked out and lost, mark it as 'long overdue'
1836                 if ( $item->{itemlost} ) {
1837                     $onloan_items->{$prefix}->{longoverdue}++;
1838                     $longoverdue_count++;
1839                 } else {        # can place holds as long as item isn't lost
1840                     $can_place_holds = 1;
1841                 }
1842             }
1843
1844          # items not on loan, but still unavailable ( lost, withdrawn, damaged )
1845             else {
1846
1847                 # item is on order
1848                 if ( $item->{notforloan} < 0 ) {
1849                     $ordered_count++;
1850                 }
1851
1852                 # is item in transit?
1853                 my $transfertwhen = '';
1854                 my ($transfertfrom, $transfertto);
1855
1856                 # is item on the reserve shelf?
1857                 my $reservestatus = '';
1858                 my $reserveitem;
1859
1860                 unless ($item->{wthdrawn}
1861                         || $item->{itemlost}
1862                         || $item->{damaged}
1863                         || $item->{notforloan}
1864                         || $items_count > 20) {
1865
1866                     # A couple heuristics to limit how many times
1867                     # we query the database for item transfer information, sacrificing
1868                     # accuracy in some cases for speed;
1869                     #
1870                     # 1. don't query if item has one of the other statuses
1871                     # 2. don't check transit status if the bib has
1872                     #    more than 20 items
1873                     #
1874                     # FIXME: to avoid having the query the database like this, and to make
1875                     #        the in transit status count as unavailable for search limiting,
1876                     #        should map transit status to record indexed in Zebra.
1877                     #
1878                     ($transfertwhen, $transfertfrom, $transfertto) = C4::Circulation::GetTransfers($item->{itemnumber});
1879                     ($reservestatus, $reserveitem, undef) = C4::Reserves::CheckReserves($item->{itemnumber});
1880                 }
1881
1882                 # item is withdrawn, lost, damaged, not for loan, reserved or in transit
1883                 if (   $item->{wthdrawn}
1884                     || $item->{itemlost}
1885                     || $item->{damaged}
1886                     || $item->{notforloan}
1887                     || $reservestatus eq 'Waiting'
1888                     || ($transfertwhen ne ''))
1889                 {
1890                     $wthdrawn_count++        if $item->{wthdrawn};
1891                     $itemlost_count++        if $item->{itemlost};
1892                     $itemdamaged_count++     if $item->{damaged};
1893                     $item_in_transit_count++ if $transfertwhen ne '';
1894                     $item_onhold_count++     if $reservestatus eq 'Waiting';
1895                     $item->{status} = $item->{wthdrawn} . "-" . $item->{itemlost} . "-" . $item->{damaged} . "-" . $item->{notforloan};
1896
1897                     # can place hold on item ?
1898                     if ( !$item->{itemlost} ) {
1899                         if ( !$item->{wthdrawn} ){
1900                             if ( $item->{damaged} ){
1901                                 if ( C4::Context->preference('AllowHoldsOnDamagedItems') ){
1902                                     # can place a hold on a damaged item if AllowHoldsOnDamagedItems is true
1903                                     if ( ( !$item->{notforloan} || $item->{notforloan} < 0 ) ){
1904                                         # item is either for loan or has notforloan < 0
1905                                         $can_place_holds = 1;
1906                                     }
1907                                 }
1908                             } elsif ( $item->{notforloan} < 0 ) {
1909                                 # item is not damaged and notforloan is < 0
1910                                 $can_place_holds = 1;
1911                             }
1912                         }
1913                     }
1914
1915                     $other_count++;
1916
1917                     my $key = $prefix . $item->{status};
1918                     foreach (qw(wthdrawn itemlost damaged branchname itemcallnumber)) {
1919                         $other_items->{$key}->{$_} = $item->{$_};
1920                     }
1921                     $other_items->{$key}->{intransit} = ( $transfertwhen ne '' ) ? 1 : 0;
1922                     $other_items->{$key}->{onhold} = ($reservestatus) ? 1 : 0;
1923                     $other_items->{$key}->{notforloan} = GetAuthorisedValueDesc('','',$item->{notforloan},'','',$notforloan_authorised_value) if $notforloan_authorised_value and $item->{notforloan};
1924                                         $other_items->{$key}->{count}++ if $item->{$hbranch};
1925                                         $other_items->{$key}->{location} = $shelflocations->{ $item->{location} };
1926                                         $other_items->{$key}->{description} = $item->{description};
1927                                         $other_items->{$key}->{imageurl} = getitemtypeimagelocation( $search_context, $itemtypes{ $item->{itype} }->{imageurl} );
1928                 }
1929                 # item is available
1930                 else {
1931                     $can_place_holds = 1;
1932                     $available_count++;
1933                                         $available_items->{$prefix}->{count}++ if $item->{$hbranch};
1934                                         foreach (qw(branchname itemcallnumber description)) {
1935                         $available_items->{$prefix}->{$_} = $item->{$_};
1936                                         }
1937                                         $available_items->{$prefix}->{location} = $shelflocations->{ $item->{location} };
1938                                         $available_items->{$prefix}->{imageurl} = getitemtypeimagelocation( $search_context, $itemtypes{ $item->{itype} }->{imageurl} );
1939                 }
1940             }
1941         }    # notforloan, item level and biblioitem level
1942
1943         # if all items are hidden, do not show the record
1944         if ($items_count > 0 && $hideatopac_count == $items_count) {
1945             next;
1946         }
1947
1948         my ( $availableitemscount, $onloanitemscount, $otheritemscount );
1949         for my $key ( sort keys %$onloan_items ) {
1950             (++$onloanitemscount > $maxitems) and last;
1951             push @onloan_items_loop, $onloan_items->{$key};
1952         }
1953         for my $key ( sort keys %$other_items ) {
1954             (++$otheritemscount > $maxitems) and last;
1955             push @other_items_loop, $other_items->{$key};
1956         }
1957         for my $key ( sort keys %$available_items ) {
1958             (++$availableitemscount > $maxitems) and last;
1959             push @available_items_loop, $available_items->{$key}
1960         }
1961
1962         # XSLT processing of some stuff
1963         use C4::Charset;
1964         SetUTF8Flag($marcrecord);
1965         warn $marcrecord->as_formatted if $DEBUG;
1966         my $interface = $search_context eq 'opac' ? 'OPAC' : '';
1967         if (!$scan && C4::Context->preference($interface . "XSLTResultsDisplay")) {
1968             $oldbiblio->{XSLTResultsRecord} = XSLTParse4Display($oldbiblio->{biblionumber}, $marcrecord, $interface."XSLTResultsDisplay", 1, \@hiddenitems);
1969             # the last parameter tells Koha to clean up the problematic ampersand entities that Zebra outputs
1970         }
1971
1972         # if biblio level itypes are used and itemtype is notforloan, it can't be reserved either
1973         if (!C4::Context->preference("item-level_itypes")) {
1974             if ($itemtypes{ $oldbiblio->{itemtype} }->{notforloan}) {
1975                 $can_place_holds = 0;
1976             }
1977         }
1978         $oldbiblio->{norequests} = 1 unless $can_place_holds;
1979         $oldbiblio->{itemsplural}          = 1 if $items_count > 1;
1980         $oldbiblio->{items_count}          = $items_count;
1981         $oldbiblio->{available_items_loop} = \@available_items_loop;
1982         $oldbiblio->{onloan_items_loop}    = \@onloan_items_loop;
1983         $oldbiblio->{other_items_loop}     = \@other_items_loop;
1984         $oldbiblio->{availablecount}       = $available_count;
1985         $oldbiblio->{availableplural}      = 1 if $available_count > 1;
1986         $oldbiblio->{onloancount}          = $onloan_count;
1987         $oldbiblio->{onloanplural}         = 1 if $onloan_count > 1;
1988         $oldbiblio->{othercount}           = $other_count;
1989         $oldbiblio->{otherplural}          = 1 if $other_count > 1;
1990         $oldbiblio->{wthdrawncount}        = $wthdrawn_count;
1991         $oldbiblio->{itemlostcount}        = $itemlost_count;
1992         $oldbiblio->{damagedcount}         = $itemdamaged_count;
1993         $oldbiblio->{intransitcount}       = $item_in_transit_count;
1994         $oldbiblio->{onholdcount}          = $item_onhold_count;
1995         $oldbiblio->{orderedcount}         = $ordered_count;
1996
1997         if (C4::Context->preference("AlternateHoldingsField") && $items_count == 0) {
1998             my $fieldspec = C4::Context->preference("AlternateHoldingsField");
1999             my $subfields = substr $fieldspec, 3;
2000             my $holdingsep = C4::Context->preference("AlternateHoldingsSeparator") || ' ';
2001             my @alternateholdingsinfo = ();
2002             my @holdingsfields = $marcrecord->field(substr $fieldspec, 0, 3);
2003             my $alternateholdingscount = 0;
2004
2005             for my $field (@holdingsfields) {
2006                 my %holding = ( holding => '' );
2007                 my $havesubfield = 0;
2008                 for my $subfield ($field->subfields()) {
2009                     if ((index $subfields, $$subfield[0]) >= 0) {
2010                         $holding{'holding'} .= $holdingsep if (length $holding{'holding'} > 0);
2011                         $holding{'holding'} .= $$subfield[1];
2012                         $havesubfield++;
2013                     }
2014                 }
2015                 if ($havesubfield) {
2016                     push(@alternateholdingsinfo, \%holding);
2017                     $alternateholdingscount++;
2018                 }
2019             }
2020
2021             $oldbiblio->{'ALTERNATEHOLDINGS'} = \@alternateholdingsinfo;
2022             $oldbiblio->{'alternateholdings_count'} = $alternateholdingscount;
2023         }
2024
2025         push( @newresults, $oldbiblio );
2026     }
2027
2028     return @newresults;
2029 }
2030
2031 =head2 SearchAcquisitions
2032     Search for acquisitions
2033 =cut
2034
2035 sub SearchAcquisitions{
2036     my ($datebegin, $dateend, $itemtypes,$criteria, $orderby) = @_;
2037
2038     my $dbh=C4::Context->dbh;
2039     # Variable initialization
2040     my $str=qq|
2041     SELECT marcxml
2042     FROM biblio
2043     LEFT JOIN biblioitems ON biblioitems.biblionumber=biblio.biblionumber
2044     LEFT JOIN items ON items.biblionumber=biblio.biblionumber
2045     WHERE dateaccessioned BETWEEN ? AND ?
2046     |;
2047
2048     my (@params,@loopcriteria);
2049
2050     push @params, $datebegin->output("iso");
2051     push @params, $dateend->output("iso");
2052
2053     if (scalar(@$itemtypes)>0 and $criteria ne "itemtype" ){
2054         if(C4::Context->preference("item-level_itypes")){
2055             $str .= "AND items.itype IN (?".( ',?' x scalar @$itemtypes - 1 ).") ";
2056         }else{
2057             $str .= "AND biblioitems.itemtype IN (?".( ',?' x scalar @$itemtypes - 1 ).") ";
2058         }
2059         push @params, @$itemtypes;
2060     }
2061
2062     if ($criteria =~/itemtype/){
2063         if(C4::Context->preference("item-level_itypes")){
2064             $str .= "AND items.itype=? ";
2065         }else{
2066             $str .= "AND biblioitems.itemtype=? ";
2067         }
2068
2069         if(scalar(@$itemtypes) == 0){
2070             my $itypes = GetItemTypes();
2071             for my $key (keys %$itypes){
2072                 push @$itemtypes, $key;
2073             }
2074         }
2075
2076         @loopcriteria= @$itemtypes;
2077     }elsif ($criteria=~/itemcallnumber/){
2078         $str .= "AND (items.itemcallnumber LIKE CONCAT(?,'%')
2079                  OR items.itemcallnumber is NULL
2080                  OR items.itemcallnumber = '')";
2081
2082         @loopcriteria = ("AA".."ZZ", "") unless (scalar(@loopcriteria)>0);
2083     }else {
2084         $str .= "AND biblio.title LIKE CONCAT(?,'%') ";
2085         @loopcriteria = ("A".."z") unless (scalar(@loopcriteria)>0);
2086     }
2087
2088     if ($orderby =~ /date_desc/){
2089         $str.=" ORDER BY dateaccessioned DESC";
2090     } else {
2091         $str.=" ORDER BY title";
2092     }
2093
2094     my $qdataacquisitions=$dbh->prepare($str);
2095
2096     my @loopacquisitions;
2097     foreach my $value(@loopcriteria){
2098         push @params,$value;
2099         my %cell;
2100         $cell{"title"}=$value;
2101         $cell{"titlecode"}=$value;
2102
2103         eval{$qdataacquisitions->execute(@params);};
2104
2105         if ($@){ warn "recentacquisitions Error :$@";}
2106         else {
2107             my @loopdata;
2108             while (my $data=$qdataacquisitions->fetchrow_hashref){
2109                 push @loopdata, {"summary"=>GetBiblioSummary( $data->{'marcxml'} ) };
2110             }
2111             $cell{"loopdata"}=\@loopdata;
2112         }
2113         push @loopacquisitions,\%cell if (scalar(@{$cell{loopdata}})>0);
2114         pop @params;
2115     }
2116     $qdataacquisitions->finish;
2117     return \@loopacquisitions;
2118 }
2119 #----------------------------------------------------------------------
2120 #
2121 # Non-Zebra GetRecords#
2122 #----------------------------------------------------------------------
2123
2124 =head2 NZgetRecords
2125
2126   NZgetRecords has the same API as zera getRecords, even if some parameters are not managed
2127
2128 =cut
2129
2130 sub NZgetRecords {
2131     my (
2132         $query,            $simple_query, $sort_by_ref,    $servers_ref,
2133         $results_per_page, $offset,       $expanded_facet, $branches,
2134         $query_type,       $scan
2135     ) = @_;
2136     warn "query =$query" if $DEBUG;
2137     my $result = NZanalyse($query);
2138     warn "results =$result" if $DEBUG;
2139     return ( undef,
2140         NZorder( $result, @$sort_by_ref[0], $results_per_page, $offset ),
2141         undef );
2142 }
2143
2144 =head2 NZanalyse
2145
2146   NZanalyse : get a CQL string as parameter, and returns a list of biblionumber;title,biblionumber;title,...
2147   the list is built from an inverted index in the nozebra SQL table
2148   note that title is here only for convenience : the sorting will be very fast when requested on title
2149   if the sorting is requested on something else, we will have to reread all results, and that may be longer.
2150
2151 =cut
2152
2153 sub NZanalyse {
2154     my ( $string, $server ) = @_;
2155 #     warn "---------"       if $DEBUG;
2156     warn " NZanalyse" if $DEBUG;
2157 #     warn "---------"       if $DEBUG;
2158
2159  # $server contains biblioserver or authorities, depending on what we search on.
2160  #warn "querying : $string on $server";
2161     $server = 'biblioserver' unless $server;
2162
2163 # if we have a ", replace the content to discard temporarily any and/or/not inside
2164     my $commacontent;
2165     if ( $string =~ /"/ ) {
2166         $string =~ s/"(.*?)"/__X__/;
2167         $commacontent = $1;
2168         warn "commacontent : $commacontent" if $DEBUG;
2169     }
2170
2171 # split the query string in 3 parts : X AND Y means : $left="X", $operand="AND" and $right="Y"
2172 # then, call again NZanalyse with $left and $right
2173 # (recursive until we find a leaf (=> something without and/or/not)
2174 # delete repeated operator... Would then go in infinite loop
2175     while ( $string =~ s/( and| or| not| AND| OR| NOT)\1/$1/g ) {
2176     }
2177
2178     #process parenthesis before.
2179     if ( $string =~ /^\s*\((.*)\)(( and | or | not | AND | OR | NOT )(.*))?/ ) {
2180         my $left     = $1;
2181         my $right    = $4;
2182         my $operator = lc($3);   # FIXME: and/or/not are operators, not operands
2183         warn
2184 "dealing w/parenthesis before recursive sub call. left :$left operator:$operator right:$right"
2185           if $DEBUG;
2186         my $leftresult = NZanalyse( $left, $server );
2187         if ($operator) {
2188             my $rightresult = NZanalyse( $right, $server );
2189
2190             # OK, we have the results for right and left part of the query
2191             # depending of operand, intersect, union or exclude both lists
2192             # to get a result list
2193             if ( $operator eq ' and ' ) {
2194                 return NZoperatorAND($leftresult,$rightresult);
2195             }
2196             elsif ( $operator eq ' or ' ) {
2197
2198                 # just merge the 2 strings
2199                 return $leftresult . $rightresult;
2200             }
2201             elsif ( $operator eq ' not ' ) {
2202                 return NZoperatorNOT($leftresult,$rightresult);
2203             }
2204         }
2205         else {
2206 # this error is impossible, because of the regexp that isolate the operand, but just in case...
2207             return $leftresult;
2208         }
2209     }
2210     warn "string :" . $string if $DEBUG;
2211     my $left = "";
2212     my $right = "";
2213     my $operator = "";
2214     if ($string =~ /(.*?)( and | or | not | AND | OR | NOT )(.*)/) {
2215         $left     = $1;
2216         $right    = $3;
2217         $operator = lc($2);    # FIXME: and/or/not are operators, not operands
2218     }
2219     warn "no parenthesis. left : $left operator: $operator right: $right"
2220       if $DEBUG;
2221
2222     # it's not a leaf, we have a and/or/not
2223     if ($operator) {
2224
2225         # reintroduce comma content if needed
2226         $right =~ s/__X__/"$commacontent"/ if $commacontent;
2227         $left  =~ s/__X__/"$commacontent"/ if $commacontent;
2228         warn "node : $left / $operator / $right\n" if $DEBUG;
2229         my $leftresult  = NZanalyse( $left,  $server );
2230         my $rightresult = NZanalyse( $right, $server );
2231         warn " leftresult : $leftresult" if $DEBUG;
2232         warn " rightresult : $rightresult" if $DEBUG;
2233         # OK, we have the results for right and left part of the query
2234         # depending of operand, intersect, union or exclude both lists
2235         # to get a result list
2236         if ( $operator eq ' and ' ) {
2237             return NZoperatorAND($leftresult,$rightresult);
2238         }
2239         elsif ( $operator eq ' or ' ) {
2240
2241             # just merge the 2 strings
2242             return $leftresult . $rightresult;
2243         }
2244         elsif ( $operator eq ' not ' ) {
2245             return NZoperatorNOT($leftresult,$rightresult);
2246         }
2247         else {
2248
2249 # this error is impossible, because of the regexp that isolate the operand, but just in case...
2250             die "error : operand unknown : $operator for $string";
2251         }
2252
2253         # it's a leaf, do the real SQL query and return the result
2254     }
2255     else {
2256         $string =~ s/__X__/"$commacontent"/ if $commacontent;
2257         $string =~ s/-|\.|\?|,|;|!|'|\(|\)|\[|\]|{|}|"|&|\+|\*|\// /g;
2258         #remove trailing blank at the beginning
2259         $string =~ s/^ //g;
2260         warn "leaf:$string" if $DEBUG;
2261
2262         # parse the string in in operator/operand/value again
2263         my $left = "";
2264         my $operator = "";
2265         my $right = "";
2266         if ($string =~ /(.*)(>=|<=)(.*)/) {
2267             $left     = $1;
2268             $operator = $2;
2269             $right    = $3;
2270         } else {
2271             $left = $string;
2272         }
2273 #         warn "handling leaf... left:$left operator:$operator right:$right"
2274 #           if $DEBUG;
2275         unless ($operator) {
2276             if ($string =~ /(.*)(>|<|=)(.*)/) {
2277                 $left     = $1;
2278                 $operator = $2;
2279                 $right    = $3;
2280                 warn
2281     "handling unless (operator)... left:$left operator:$operator right:$right"
2282                 if $DEBUG;
2283             } else {
2284                 $left = $string;
2285             }
2286         }
2287         my $results;
2288
2289 # strip adv, zebra keywords, currently not handled in nozebra: wrdl, ext, phr...
2290         $left =~ s/ .*$//;
2291
2292         # automatic replace for short operators
2293         $left = 'title'            if $left =~ '^ti$';
2294         $left = 'author'           if $left =~ '^au$';
2295         $left = 'publisher'        if $left =~ '^pb$';
2296         $left = 'subject'          if $left =~ '^su$';
2297         $left = 'koha-Auth-Number' if $left =~ '^an$';
2298         $left = 'keyword'          if $left =~ '^kw$';
2299         $left = 'itemtype'         if $left =~ '^mc$'; # Fix for Bug 2599 - Search limits not working for NoZebra
2300         warn "handling leaf... left:$left operator:$operator right:$right" if $DEBUG;
2301         my $dbh = C4::Context->dbh;
2302         if ( $operator && $left ne 'keyword' ) {
2303             #do a specific search
2304             $operator = 'LIKE' if $operator eq '=' and $right =~ /%/;
2305             my $sth = $dbh->prepare(
2306 "SELECT biblionumbers,value FROM nozebra WHERE server=? AND indexname=? AND value $operator ?"
2307             );
2308             warn "$left / $operator / $right\n" if $DEBUG;
2309
2310             # split each word, query the DB and build the biblionumbers result
2311             #sanitizing leftpart
2312             $left =~ s/^\s+|\s+$//;
2313             foreach ( split / /, $right ) {
2314                 my $biblionumbers;
2315                 $_ =~ s/^\s+|\s+$//;
2316                 next unless $_;
2317                 warn "EXECUTE : $server, $left, $_" if $DEBUG;
2318                 $sth->execute( $server, $left, $_ )
2319                   or warn "execute failed: $!";
2320                 while ( my ( $line, $value ) = $sth->fetchrow ) {
2321
2322 # if we are dealing with a numeric value, use only numeric results (in case of >=, <=, > or <)
2323 # otherwise, fill the result
2324                     $biblionumbers .= $line
2325                       unless ( $right =~ /^\d+$/ && $value =~ /\D/ );
2326                     warn "result : $value "
2327                       . ( $right  =~ /\d/ ) . "=="
2328                       . ( $value =~ /\D/?$line:"" ) if $DEBUG;         #= $line";
2329                 }
2330
2331 # do a AND with existing list if there is one, otherwise, use the biblionumbers list as 1st result list
2332                 if ($results) {
2333                     warn "NZAND" if $DEBUG;
2334                     $results = NZoperatorAND($biblionumbers,$results);
2335                 } else {
2336                     $results = $biblionumbers;
2337                 }
2338             }
2339         }
2340         else {
2341       #do a complete search (all indexes), if index='kw' do complete search too.
2342             my $sth = $dbh->prepare(
2343 "SELECT biblionumbers FROM nozebra WHERE server=? AND value LIKE ?"
2344             );
2345
2346             # split each word, query the DB and build the biblionumbers result
2347             foreach ( split / /, $string ) {
2348                 next if C4::Context->stopwords->{ uc($_) };   # skip if stopword
2349                 warn "search on all indexes on $_" if $DEBUG;
2350                 my $biblionumbers;
2351                 next unless $_;
2352                 $sth->execute( $server, $_ );
2353                 while ( my $line = $sth->fetchrow ) {
2354                     $biblionumbers .= $line;
2355                 }
2356
2357 # do a AND with existing list if there is one, otherwise, use the biblionumbers list as 1st result list
2358                 if ($results) {
2359                     $results = NZoperatorAND($biblionumbers,$results);
2360                 }
2361                 else {
2362                     warn "NEW RES for $_ = $biblionumbers" if $DEBUG;
2363                     $results = $biblionumbers;
2364                 }
2365             }
2366         }
2367         warn "return : $results for LEAF : $string" if $DEBUG;
2368         return $results;
2369     }
2370     warn "---------\nLeave NZanalyse\n---------" if $DEBUG;
2371 }
2372
2373 sub NZoperatorAND{
2374     my ($rightresult, $leftresult)=@_;
2375
2376     my @leftresult = split /;/, $leftresult;
2377     warn " @leftresult / $rightresult \n" if $DEBUG;
2378
2379     #             my @rightresult = split /;/,$leftresult;
2380     my $finalresult;
2381
2382 # parse the left results, and if the biblionumber exist in the right result, save it in finalresult
2383 # the result is stored twice, to have the same weight for AND than OR.
2384 # example : TWO : 61,61,64,121 (two is twice in the biblio #61) / TOWER : 61,64,130
2385 # result : 61,61,61,61,64,64 for two AND tower : 61 has more weight than 64
2386     foreach (@leftresult) {
2387         my $value = $_;
2388         my $countvalue;
2389         ( $value, $countvalue ) = ( $1, $2 ) if ($value=~/(.*)-(\d+)$/);
2390         if ( $rightresult =~ /\Q$value\E-(\d+);/ ) {
2391             $countvalue = ( $1 > $countvalue ? $countvalue : $1 );
2392             $finalresult .=
2393                 "$value-$countvalue;$value-$countvalue;";
2394         }
2395     }
2396     warn "NZAND DONE : $finalresult \n" if $DEBUG;
2397     return $finalresult;
2398 }
2399
2400 sub NZoperatorOR{
2401     my ($rightresult, $leftresult)=@_;
2402     return $rightresult.$leftresult;
2403 }
2404
2405 sub NZoperatorNOT{
2406     my ($leftresult, $rightresult)=@_;
2407
2408     my @leftresult = split /;/, $leftresult;
2409
2410     #             my @rightresult = split /;/,$leftresult;
2411     my $finalresult;
2412     foreach (@leftresult) {
2413         my $value=$_;
2414         $value=$1 if $value=~m/(.*)-\d+$/;
2415         unless ($rightresult =~ "$value-") {
2416             $finalresult .= "$_;";
2417         }
2418     }
2419     return $finalresult;
2420 }
2421
2422 =head2 NZorder
2423
2424   $finalresult = NZorder($biblionumbers, $ordering,$results_per_page,$offset);
2425
2426   TODO :: Description
2427
2428 =cut
2429
2430 sub NZorder {
2431     my ( $biblionumbers, $ordering, $results_per_page, $offset ) = @_;
2432     warn "biblionumbers = $biblionumbers and ordering = $ordering\n" if $DEBUG;
2433
2434     # order title asc by default
2435     #     $ordering = '1=36 <i' unless $ordering;
2436     $results_per_page = 20 unless $results_per_page;
2437     $offset           = 0  unless $offset;
2438     my $dbh = C4::Context->dbh;
2439
2440     #
2441     # order by POPULARITY
2442     #
2443     if ( $ordering =~ /popularity/ ) {
2444         my %result;
2445         my %popularity;
2446
2447         # popularity is not in MARC record, it's builded from a specific query
2448         my $sth =
2449           $dbh->prepare("select sum(issues) from items where biblionumber=?");
2450         foreach ( split /;/, $biblionumbers ) {
2451             my ( $biblionumber, $title ) = split /,/, $_;
2452             $result{$biblionumber} = GetMarcBiblio($biblionumber);
2453             $sth->execute($biblionumber);
2454             my $popularity = $sth->fetchrow || 0;
2455
2456 # hint : the key is popularity.title because we can have
2457 # many results with the same popularity. In this case, sub-ordering is done by title
2458 # we also have biblionumber to avoid bug for 2 biblios with the same title & popularity
2459 # (un-frequent, I agree, but we won't forget anything that way ;-)
2460             $popularity{ sprintf( "%10d", $popularity ) . $title
2461                   . $biblionumber } = $biblionumber;
2462         }
2463
2464     # sort the hash and return the same structure as GetRecords (Zebra querying)
2465         my $result_hash;
2466         my $numbers = 0;
2467         if ( $ordering eq 'popularity_dsc' ) {    # sort popularity DESC
2468             foreach my $key ( sort { $b cmp $a } ( keys %popularity ) ) {
2469                 $result_hash->{'RECORDS'}[ $numbers++ ] =
2470                   $result{ $popularity{$key} }->as_usmarc();
2471             }
2472         }
2473         else {                                    # sort popularity ASC
2474             foreach my $key ( sort ( keys %popularity ) ) {
2475                 $result_hash->{'RECORDS'}[ $numbers++ ] =
2476                   $result{ $popularity{$key} }->as_usmarc();
2477             }
2478         }
2479         my $finalresult = ();
2480         $result_hash->{'hits'}         = $numbers;
2481         $finalresult->{'biblioserver'} = $result_hash;
2482         return $finalresult;
2483
2484         #
2485         # ORDER BY author
2486         #
2487     }
2488     elsif ( $ordering =~ /author/ ) {
2489         my %result;
2490         foreach ( split /;/, $biblionumbers ) {
2491             my ( $biblionumber, $title ) = split /,/, $_;
2492             my $record = GetMarcBiblio($biblionumber);
2493             my $author;
2494             if ( C4::Context->preference('marcflavour') eq 'UNIMARC' ) {
2495                 $author = $record->subfield( '200', 'f' );
2496                 $author = $record->subfield( '700', 'a' ) unless $author;
2497             }
2498             else {
2499                 $author = $record->subfield( '100', 'a' );
2500             }
2501
2502 # hint : the result is sorted by title.biblionumber because we can have X biblios with the same title
2503 # and we don't want to get only 1 result for each of them !!!
2504             $result{ $author . $biblionumber } = $record;
2505         }
2506
2507     # sort the hash and return the same structure as GetRecords (Zebra querying)
2508         my $result_hash;
2509         my $numbers = 0;
2510         if ( $ordering eq 'author_za' || $ordering eq 'author_dsc' ) {    # sort by author desc
2511             foreach my $key ( sort { $b cmp $a } ( keys %result ) ) {
2512                 $result_hash->{'RECORDS'}[ $numbers++ ] =
2513                   $result{$key}->as_usmarc();
2514             }
2515         }
2516         else {                               # sort by author ASC
2517             foreach my $key ( sort ( keys %result ) ) {
2518                 $result_hash->{'RECORDS'}[ $numbers++ ] =
2519                   $result{$key}->as_usmarc();
2520             }
2521         }
2522         my $finalresult = ();
2523         $result_hash->{'hits'}         = $numbers;
2524         $finalresult->{'biblioserver'} = $result_hash;
2525         return $finalresult;
2526
2527         #
2528         # ORDER BY callnumber
2529         #
2530     }
2531     elsif ( $ordering =~ /callnumber/ ) {
2532         my %result;
2533         foreach ( split /;/, $biblionumbers ) {
2534             my ( $biblionumber, $title ) = split /,/, $_;
2535             my $record = GetMarcBiblio($biblionumber);
2536             my $callnumber;
2537             my $frameworkcode = GetFrameworkCode($biblionumber);
2538             my ( $callnumber_tag, $callnumber_subfield ) = GetMarcFromKohaField(  'items.itemcallnumber', $frameworkcode);
2539                ( $callnumber_tag, $callnumber_subfield ) = GetMarcFromKohaField('biblioitems.callnumber', $frameworkcode)
2540                 unless $callnumber_tag;
2541             if ( C4::Context->preference('marcflavour') eq 'UNIMARC' ) {
2542                 $callnumber = $record->subfield( '200', 'f' );
2543             } else {
2544                 $callnumber = $record->subfield( '100', 'a' );
2545             }
2546
2547 # hint : the result is sorted by title.biblionumber because we can have X biblios with the same title
2548 # and we don't want to get only 1 result for each of them !!!
2549             $result{ $callnumber . $biblionumber } = $record;
2550         }
2551
2552     # sort the hash and return the same structure as GetRecords (Zebra querying)
2553         my $result_hash;
2554         my $numbers = 0;
2555         if ( $ordering eq 'call_number_dsc' ) {    # sort by title desc
2556             foreach my $key ( sort { $b cmp $a } ( keys %result ) ) {
2557                 $result_hash->{'RECORDS'}[ $numbers++ ] =
2558                   $result{$key}->as_usmarc();
2559             }
2560         }
2561         else {                                     # sort by title ASC
2562             foreach my $key ( sort { $a cmp $b } ( keys %result ) ) {
2563                 $result_hash->{'RECORDS'}[ $numbers++ ] =
2564                   $result{$key}->as_usmarc();
2565             }
2566         }
2567         my $finalresult = ();
2568         $result_hash->{'hits'}         = $numbers;
2569         $finalresult->{'biblioserver'} = $result_hash;
2570         return $finalresult;
2571     }
2572     elsif ( $ordering =~ /pubdate/ ) {             #pub year
2573         my %result;
2574         foreach ( split /;/, $biblionumbers ) {
2575             my ( $biblionumber, $title ) = split /,/, $_;
2576             my $record = GetMarcBiblio($biblionumber);
2577             my ( $publicationyear_tag, $publicationyear_subfield ) =
2578               GetMarcFromKohaField( 'biblioitems.publicationyear', '' );
2579             my $publicationyear =
2580               $record->subfield( $publicationyear_tag,
2581                 $publicationyear_subfield );
2582
2583 # hint : the result is sorted by title.biblionumber because we can have X biblios with the same title
2584 # and we don't want to get only 1 result for each of them !!!
2585             $result{ $publicationyear . $biblionumber } = $record;
2586         }
2587
2588     # sort the hash and return the same structure as GetRecords (Zebra querying)
2589         my $result_hash;
2590         my $numbers = 0;
2591         if ( $ordering eq 'pubdate_dsc' ) {    # sort by pubyear desc
2592             foreach my $key ( sort { $b cmp $a } ( keys %result ) ) {
2593                 $result_hash->{'RECORDS'}[ $numbers++ ] =
2594                   $result{$key}->as_usmarc();
2595             }
2596         }
2597         else {                                 # sort by pub year ASC
2598             foreach my $key ( sort ( keys %result ) ) {
2599                 $result_hash->{'RECORDS'}[ $numbers++ ] =
2600                   $result{$key}->as_usmarc();
2601             }
2602         }
2603         my $finalresult = ();
2604         $result_hash->{'hits'}         = $numbers;
2605         $finalresult->{'biblioserver'} = $result_hash;
2606         return $finalresult;
2607
2608         #
2609         # ORDER BY title
2610         #
2611     }
2612     elsif ( $ordering =~ /title/ ) {
2613
2614 # the title is in the biblionumbers string, so we just need to build a hash, sort it and return
2615         my %result;
2616         foreach ( split /;/, $biblionumbers ) {
2617             my ( $biblionumber, $title ) = split /,/, $_;
2618
2619 # hint : the result is sorted by title.biblionumber because we can have X biblios with the same title
2620 # and we don't want to get only 1 result for each of them !!!
2621 # hint & speed improvement : we can order without reading the record
2622 # so order, and read records only for the requested page !
2623             $result{ $title . $biblionumber } = $biblionumber;
2624         }
2625
2626     # sort the hash and return the same structure as GetRecords (Zebra querying)
2627         my $result_hash;
2628         my $numbers = 0;
2629         if ( $ordering eq 'title_az' ) {    # sort by title desc
2630             foreach my $key ( sort ( keys %result ) ) {
2631                 $result_hash->{'RECORDS'}[ $numbers++ ] = $result{$key};
2632             }
2633         }
2634         else {                              # sort by title ASC
2635             foreach my $key ( sort { $b cmp $a } ( keys %result ) ) {
2636                 $result_hash->{'RECORDS'}[ $numbers++ ] = $result{$key};
2637             }
2638         }
2639
2640         # limit the $results_per_page to result size if it's more
2641         $results_per_page = $numbers - 1 if $numbers < $results_per_page;
2642
2643         # for the requested page, replace biblionumber by the complete record
2644         # speed improvement : avoid reading too much things
2645         for (
2646             my $counter = $offset ;
2647             $counter <= $offset + $results_per_page ;
2648             $counter++
2649           )
2650         {
2651             $result_hash->{'RECORDS'}[$counter] =
2652               GetMarcBiblio( $result_hash->{'RECORDS'}[$counter] )->as_usmarc;
2653         }
2654         my $finalresult = ();
2655         $result_hash->{'hits'}         = $numbers;
2656         $finalresult->{'biblioserver'} = $result_hash;
2657         return $finalresult;
2658     }
2659     else {
2660
2661 #
2662 # order by ranking
2663 #
2664 # we need 2 hashes to order by ranking : the 1st one to count the ranking, the 2nd to order by ranking
2665         my %result;
2666         my %count_ranking;
2667         foreach ( split /;/, $biblionumbers ) {
2668             my ( $biblionumber, $title ) = split /,/, $_;
2669             $title =~ /(.*)-(\d)/;
2670
2671             # get weight
2672             my $ranking = $2;
2673
2674 # note that we + the ranking because ranking is calculated on weight of EACH term requested.
2675 # if we ask for "two towers", and "two" has weight 2 in biblio N, and "towers" has weight 4 in biblio N
2676 # biblio N has ranking = 6
2677             $count_ranking{$biblionumber} += $ranking;
2678         }
2679
2680 # build the result by "inverting" the count_ranking hash
2681 # 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
2682 #         warn "counting";
2683         foreach ( keys %count_ranking ) {
2684             $result{ sprintf( "%10d", $count_ranking{$_} ) . '-' . $_ } = $_;
2685         }
2686
2687     # sort the hash and return the same structure as GetRecords (Zebra querying)
2688         my $result_hash;
2689         my $numbers = 0;
2690         foreach my $key ( sort { $b cmp $a } ( keys %result ) ) {
2691             $result_hash->{'RECORDS'}[ $numbers++ ] = $result{$key};
2692         }
2693
2694         # limit the $results_per_page to result size if it's more
2695         $results_per_page = $numbers - 1 if $numbers < $results_per_page;
2696
2697         # for the requested page, replace biblionumber by the complete record
2698         # speed improvement : avoid reading too much things
2699         for (
2700             my $counter = $offset ;
2701             $counter <= $offset + $results_per_page ;
2702             $counter++
2703           )
2704         {
2705             $result_hash->{'RECORDS'}[$counter] =
2706               GetMarcBiblio( $result_hash->{'RECORDS'}[$counter] )->as_usmarc
2707               if $result_hash->{'RECORDS'}[$counter];
2708         }
2709         my $finalresult = ();
2710         $result_hash->{'hits'}         = $numbers;
2711         $finalresult->{'biblioserver'} = $result_hash;
2712         return $finalresult;
2713     }
2714 }
2715
2716 =head2 enabled_staff_search_views
2717
2718 %hash = enabled_staff_search_views()
2719
2720 This function returns a hash that contains three flags obtained from the system
2721 preferences, used to determine whether a particular staff search results view
2722 is enabled.
2723
2724 =over 2
2725
2726 =item C<Output arg:>
2727
2728     * $hash{can_view_MARC} is true only if the MARC view is enabled
2729     * $hash{can_view_ISBD} is true only if the ISBD view is enabled
2730     * $hash{can_view_labeledMARC} is true only if the Labeled MARC view is enabled
2731
2732 =item C<usage in the script:>
2733
2734 =back
2735
2736 $template->param ( C4::Search::enabled_staff_search_views );
2737
2738 =cut
2739
2740 sub enabled_staff_search_views
2741 {
2742         return (
2743                 can_view_MARC                   => C4::Context->preference('viewMARC'),                 # 1 if the staff search allows the MARC view
2744                 can_view_ISBD                   => C4::Context->preference('viewISBD'),                 # 1 if the staff search allows the ISBD view
2745                 can_view_labeledMARC    => C4::Context->preference('viewLabeledMARC'),  # 1 if the staff search allows the Labeled MARC view
2746         );
2747 }
2748
2749 sub AddSearchHistory{
2750         my ($borrowernumber,$session,$query_desc,$query_cgi, $total)=@_;
2751     my $dbh = C4::Context->dbh;
2752
2753     # Add the request the user just made
2754     my $sql = "INSERT INTO search_history(userid, sessionid, query_desc, query_cgi, total, time) VALUES(?, ?, ?, ?, ?, NOW())";
2755     my $sth   = $dbh->prepare($sql);
2756     $sth->execute($borrowernumber, $session, $query_desc, $query_cgi, $total);
2757         return $dbh->last_insert_id(undef, 'search_history', undef,undef,undef);
2758 }
2759
2760 sub GetSearchHistory{
2761         my ($borrowernumber,$session)=@_;
2762     my $dbh = C4::Context->dbh;
2763
2764     # Add the request the user just made
2765     my $query = "SELECT FROM search_history WHERE (userid=? OR sessionid=?)";
2766     my $sth   = $dbh->prepare($query);
2767         $sth->execute($borrowernumber, $session);
2768     return  $sth->fetchall_hashref({});
2769 }
2770
2771 =head2 z3950_search_args
2772
2773 $arrayref = z3950_search_args($matchpoints)
2774
2775 This function returns an array reference that contains the search parameters to be
2776 passed to the Z39.50 search script (z3950_search.pl). The array elements
2777 are hash refs whose keys are name, value and encvalue, and whose values are the
2778 name of a search parameter, the value of that search parameter and the URL encoded
2779 value of that parameter.
2780
2781 The search parameter names are lccn, isbn, issn, title, author, dewey and subject.
2782
2783 The search parameter values are obtained from the bibliographic record whose
2784 data is in a hash reference in $matchpoints, as returned by Biblio::GetBiblioData().
2785
2786 If $matchpoints is a scalar, it is assumed to be an unnamed query descriptor, e.g.
2787 a general purpose search argument. In this case, the returned array contains only
2788 entry: the key is 'title' and the value and encvalue are derived from $matchpoints.
2789
2790 If a search parameter value is undefined or empty, it is not included in the returned
2791 array.
2792
2793 The returned array reference may be passed directly to the template parameters.
2794
2795 =over 2
2796
2797 =item C<Output arg:>
2798
2799     * $array containing hash refs as described above
2800
2801 =item C<usage in the script:>
2802
2803 =back
2804
2805 $data = Biblio::GetBiblioData($bibno);
2806 $template->param ( MYLOOP => C4::Search::z3950_search_args($data) )
2807
2808 *OR*
2809
2810 $template->param ( MYLOOP => C4::Search::z3950_search_args($searchscalar) )
2811
2812 =cut
2813
2814 sub z3950_search_args {
2815     my $bibrec = shift;
2816     my $isbn = Business::ISBN->new($bibrec);
2817
2818     if (defined $isbn && $isbn->is_valid)
2819     {
2820         $bibrec = { isbn => $bibrec } if !ref $bibrec;
2821     }
2822     else {
2823         $bibrec = { title => $bibrec } if !ref $bibrec;
2824     }
2825     my $array = [];
2826     for my $field (qw/ lccn isbn issn title author dewey subject /)
2827     {
2828         my $encvalue = URI::Escape::uri_escape_utf8($bibrec->{$field});
2829         push @$array, { name=>$field, value=>$bibrec->{$field}, encvalue=>$encvalue } if defined $bibrec->{$field};
2830     }
2831     return $array;
2832 }
2833
2834 =head2 GetDistinctValues($field);
2835
2836 C<$field> is a reference to the fields array
2837
2838 =cut
2839
2840 sub GetDistinctValues {
2841     my ($fieldname,$string)=@_;
2842     # returns a reference to a hash of references to branches...
2843     if ($fieldname=~/\./){
2844                         my ($table,$column)=split /\./, $fieldname;
2845                         my $dbh = C4::Context->dbh;
2846                         warn "select DISTINCT($column) as value, count(*) as cnt from $table group by lib order by $column " if $DEBUG;
2847                         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 ");
2848                         $sth->execute;
2849                         my $elements=$sth->fetchall_arrayref({});
2850                         return $elements;
2851    }
2852    else {
2853                 $string||= qq("");
2854                 my @servers=qw<biblioserver authorityserver>;
2855                 my (@zconns,@results);
2856         for ( my $i = 0 ; $i < @servers ; $i++ ) {
2857                 $zconns[$i] = C4::Context->Zconn( $servers[$i], 1 );
2858                         $results[$i] =
2859                       $zconns[$i]->scan(
2860                         ZOOM::Query::CCL2RPN->new( qq"$fieldname $string", $zconns[$i])
2861                       );
2862                 }
2863                 # The big moment: asynchronously retrieve results from all servers
2864                 my @elements;
2865         _ZOOM_event_loop(
2866             \@zconns,
2867             \@results,
2868             sub {
2869                 my ( $i, $size ) = @_;
2870                 for ( my $j = 0 ; $j < $size ; $j++ ) {
2871                     my %hashscan;
2872                     @hashscan{qw(value cnt)} =
2873                       $results[ $i - 1 ]->display_term($j);
2874                     push @elements, \%hashscan;
2875                 }
2876             }
2877         );
2878                 return \@elements;
2879    }
2880 }
2881
2882 =head2 _ZOOM_event_loop
2883
2884     _ZOOM_event_loop(\@zconns, \@results, sub {
2885         my ( $i, $size ) = @_;
2886         ....
2887     } );
2888
2889 Processes a ZOOM event loop and passes control to a closure for
2890 processing the results, and destroying the resultsets.
2891
2892 =cut
2893
2894 sub _ZOOM_event_loop {
2895     my ($zconns, $results, $callback) = @_;
2896     while ( ( my $i = ZOOM::event( $zconns ) ) != 0 ) {
2897         my $ev = $zconns->[ $i - 1 ]->last_event();
2898         if ( $ev == ZOOM::Event::ZEND ) {
2899             next unless $results->[ $i - 1 ];
2900             my $size = $results->[ $i - 1 ]->size();
2901             if ( $size > 0 ) {
2902                 $callback->($i, $size);
2903             }
2904         }
2905     }
2906
2907     foreach my $result (@$results) {
2908         $result->destroy();
2909     }
2910 }
2911
2912
2913 END { }    # module clean-up code here (global destructor)
2914
2915 1;
2916 __END__
2917
2918 =head1 AUTHOR
2919
2920 Koha Development Team <http://koha-community.org/>
2921
2922 =cut