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