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->{damaged} || C4::Context->preference('AllowHoldsOnDamagedItems'))
1853                       && !$item->{itemlost}
1854                       && !$item->{withdrawn}
1855                     ) {
1856                         $can_place_holds = 1;
1857                     }
1858
1859                     $other_count++;
1860
1861                     my $key = $prefix . $item->{status};
1862                     foreach (qw(wthdrawn itemlost damaged branchname itemcallnumber)) {
1863                         $other_items->{$key}->{$_} = $item->{$_};
1864                     }
1865                     $other_items->{$key}->{intransit} = ( $transfertwhen ne '' ) ? 1 : 0;
1866                     $other_items->{$key}->{onhold} = ($reservestatus) ? 1 : 0;
1867                     $other_items->{$key}->{notforloan} = GetAuthorisedValueDesc('','',$item->{notforloan},'','',$notforloan_authorised_value) if $notforloan_authorised_value and $item->{notforloan};
1868                                         $other_items->{$key}->{count}++ if $item->{$hbranch};
1869                                         $other_items->{$key}->{location} = $shelflocations->{ $item->{location} };
1870                                         $other_items->{$key}->{description} = $item->{description};
1871                                         $other_items->{$key}->{imageurl} = getitemtypeimagelocation( $search_context, $itemtypes{ $item->{itype} }->{imageurl} );
1872                 }
1873                 # item is available
1874                 else {
1875                     $can_place_holds = 1;
1876                     $available_count++;
1877                                         $available_items->{$prefix}->{count}++ if $item->{$hbranch};
1878                                         foreach (qw(branchname itemcallnumber description)) {
1879                         $available_items->{$prefix}->{$_} = $item->{$_};
1880                                         }
1881                                         $available_items->{$prefix}->{location} = $shelflocations->{ $item->{location} };
1882                                         $available_items->{$prefix}->{imageurl} = getitemtypeimagelocation( $search_context, $itemtypes{ $item->{itype} }->{imageurl} );
1883                 }
1884             }
1885         }    # notforloan, item level and biblioitem level
1886
1887         # if all items are hidden, do not show the record
1888         if ($items_count > 0 && $hideatopac_count == $items_count) {
1889             next;
1890         }
1891
1892         my ( $availableitemscount, $onloanitemscount, $otheritemscount );
1893         for my $key ( sort keys %$onloan_items ) {
1894             (++$onloanitemscount > $maxitems) and last;
1895             push @onloan_items_loop, $onloan_items->{$key};
1896         }
1897         for my $key ( sort keys %$other_items ) {
1898             (++$otheritemscount > $maxitems) and last;
1899             push @other_items_loop, $other_items->{$key};
1900         }
1901         for my $key ( sort keys %$available_items ) {
1902             (++$availableitemscount > $maxitems) and last;
1903             push @available_items_loop, $available_items->{$key}
1904         }
1905
1906         # XSLT processing of some stuff
1907         use C4::Charset;
1908         SetUTF8Flag($marcrecord);
1909         warn $marcrecord->as_formatted if $DEBUG;
1910         my $interface = $search_context eq 'opac' ? 'OPAC' : '';
1911         if (!$scan && C4::Context->preference($interface . "XSLTResultsDisplay")) {
1912             $oldbiblio->{XSLTResultsRecord} = XSLTParse4Display($oldbiblio->{biblionumber}, $marcrecord, $interface."XSLTResultsDisplay", 1, \@hiddenitems);
1913             # the last parameter tells Koha to clean up the problematic ampersand entities that Zebra outputs
1914         }
1915
1916         # if biblio level itypes are used and itemtype is notforloan, it can't be reserved either
1917         if (!C4::Context->preference("item-level_itypes")) {
1918             if ($itemtypes{ $oldbiblio->{itemtype} }->{notforloan}) {
1919                 $can_place_holds = 0;
1920             }
1921         }
1922         $oldbiblio->{norequests} = 1 unless $can_place_holds;
1923         $oldbiblio->{itemsplural}          = 1 if $items_count > 1;
1924         $oldbiblio->{items_count}          = $items_count;
1925         $oldbiblio->{available_items_loop} = \@available_items_loop;
1926         $oldbiblio->{onloan_items_loop}    = \@onloan_items_loop;
1927         $oldbiblio->{other_items_loop}     = \@other_items_loop;
1928         $oldbiblio->{availablecount}       = $available_count;
1929         $oldbiblio->{availableplural}      = 1 if $available_count > 1;
1930         $oldbiblio->{onloancount}          = $onloan_count;
1931         $oldbiblio->{onloanplural}         = 1 if $onloan_count > 1;
1932         $oldbiblio->{othercount}           = $other_count;
1933         $oldbiblio->{otherplural}          = 1 if $other_count > 1;
1934         $oldbiblio->{wthdrawncount}        = $wthdrawn_count;
1935         $oldbiblio->{itemlostcount}        = $itemlost_count;
1936         $oldbiblio->{damagedcount}         = $itemdamaged_count;
1937         $oldbiblio->{intransitcount}       = $item_in_transit_count;
1938         $oldbiblio->{onholdcount}          = $item_onhold_count;
1939         $oldbiblio->{orderedcount}         = $ordered_count;
1940
1941         if (C4::Context->preference("AlternateHoldingsField") && $items_count == 0) {
1942             my $fieldspec = C4::Context->preference("AlternateHoldingsField");
1943             my $subfields = substr $fieldspec, 3;
1944             my $holdingsep = C4::Context->preference("AlternateHoldingsSeparator") || ' ';
1945             my @alternateholdingsinfo = ();
1946             my @holdingsfields = $marcrecord->field(substr $fieldspec, 0, 3);
1947             my $alternateholdingscount = 0;
1948
1949             for my $field (@holdingsfields) {
1950                 my %holding = ( holding => '' );
1951                 my $havesubfield = 0;
1952                 for my $subfield ($field->subfields()) {
1953                     if ((index $subfields, $$subfield[0]) >= 0) {
1954                         $holding{'holding'} .= $holdingsep if (length $holding{'holding'} > 0);
1955                         $holding{'holding'} .= $$subfield[1];
1956                         $havesubfield++;
1957                     }
1958                 }
1959                 if ($havesubfield) {
1960                     push(@alternateholdingsinfo, \%holding);
1961                     $alternateholdingscount++;
1962                 }
1963             }
1964
1965             $oldbiblio->{'ALTERNATEHOLDINGS'} = \@alternateholdingsinfo;
1966             $oldbiblio->{'alternateholdings_count'} = $alternateholdingscount;
1967         }
1968
1969         push( @newresults, $oldbiblio );
1970     }
1971
1972     return @newresults;
1973 }
1974
1975 =head2 SearchAcquisitions
1976     Search for acquisitions
1977 =cut
1978
1979 sub SearchAcquisitions{
1980     my ($datebegin, $dateend, $itemtypes,$criteria, $orderby) = @_;
1981
1982     my $dbh=C4::Context->dbh;
1983     # Variable initialization
1984     my $str=qq|
1985     SELECT marcxml
1986     FROM biblio
1987     LEFT JOIN biblioitems ON biblioitems.biblionumber=biblio.biblionumber
1988     LEFT JOIN items ON items.biblionumber=biblio.biblionumber
1989     WHERE dateaccessioned BETWEEN ? AND ?
1990     |;
1991
1992     my (@params,@loopcriteria);
1993
1994     push @params, $datebegin->output("iso");
1995     push @params, $dateend->output("iso");
1996
1997     if (scalar(@$itemtypes)>0 and $criteria ne "itemtype" ){
1998         if(C4::Context->preference("item-level_itypes")){
1999             $str .= "AND items.itype IN (?".( ',?' x scalar @$itemtypes - 1 ).") ";
2000         }else{
2001             $str .= "AND biblioitems.itemtype IN (?".( ',?' x scalar @$itemtypes - 1 ).") ";
2002         }
2003         push @params, @$itemtypes;
2004     }
2005
2006     if ($criteria =~/itemtype/){
2007         if(C4::Context->preference("item-level_itypes")){
2008             $str .= "AND items.itype=? ";
2009         }else{
2010             $str .= "AND biblioitems.itemtype=? ";
2011         }
2012
2013         if(scalar(@$itemtypes) == 0){
2014             my $itypes = GetItemTypes();
2015             for my $key (keys %$itypes){
2016                 push @$itemtypes, $key;
2017             }
2018         }
2019
2020         @loopcriteria= @$itemtypes;
2021     }elsif ($criteria=~/itemcallnumber/){
2022         $str .= "AND (items.itemcallnumber LIKE CONCAT(?,'%')
2023                  OR items.itemcallnumber is NULL
2024                  OR items.itemcallnumber = '')";
2025
2026         @loopcriteria = ("AA".."ZZ", "") unless (scalar(@loopcriteria)>0);
2027     }else {
2028         $str .= "AND biblio.title LIKE CONCAT(?,'%') ";
2029         @loopcriteria = ("A".."z") unless (scalar(@loopcriteria)>0);
2030     }
2031
2032     if ($orderby =~ /date_desc/){
2033         $str.=" ORDER BY dateaccessioned DESC";
2034     } else {
2035         $str.=" ORDER BY title";
2036     }
2037
2038     my $qdataacquisitions=$dbh->prepare($str);
2039
2040     my @loopacquisitions;
2041     foreach my $value(@loopcriteria){
2042         push @params,$value;
2043         my %cell;
2044         $cell{"title"}=$value;
2045         $cell{"titlecode"}=$value;
2046
2047         eval{$qdataacquisitions->execute(@params);};
2048
2049         if ($@){ warn "recentacquisitions Error :$@";}
2050         else {
2051             my @loopdata;
2052             while (my $data=$qdataacquisitions->fetchrow_hashref){
2053                 push @loopdata, {"summary"=>GetBiblioSummary( $data->{'marcxml'} ) };
2054             }
2055             $cell{"loopdata"}=\@loopdata;
2056         }
2057         push @loopacquisitions,\%cell if (scalar(@{$cell{loopdata}})>0);
2058         pop @params;
2059     }
2060     $qdataacquisitions->finish;
2061     return \@loopacquisitions;
2062 }
2063 #----------------------------------------------------------------------
2064 #
2065 # Non-Zebra GetRecords#
2066 #----------------------------------------------------------------------
2067
2068 =head2 NZgetRecords
2069
2070   NZgetRecords has the same API as zera getRecords, even if some parameters are not managed
2071
2072 =cut
2073
2074 sub NZgetRecords {
2075     my (
2076         $query,            $simple_query, $sort_by_ref,    $servers_ref,
2077         $results_per_page, $offset,       $expanded_facet, $branches,
2078         $query_type,       $scan
2079     ) = @_;
2080     warn "query =$query" if $DEBUG;
2081     my $result = NZanalyse($query);
2082     warn "results =$result" if $DEBUG;
2083     return ( undef,
2084         NZorder( $result, @$sort_by_ref[0], $results_per_page, $offset ),
2085         undef );
2086 }
2087
2088 =head2 NZanalyse
2089
2090   NZanalyse : get a CQL string as parameter, and returns a list of biblionumber;title,biblionumber;title,...
2091   the list is built from an inverted index in the nozebra SQL table
2092   note that title is here only for convenience : the sorting will be very fast when requested on title
2093   if the sorting is requested on something else, we will have to reread all results, and that may be longer.
2094
2095 =cut
2096
2097 sub NZanalyse {
2098     my ( $string, $server ) = @_;
2099 #     warn "---------"       if $DEBUG;
2100     warn " NZanalyse" if $DEBUG;
2101 #     warn "---------"       if $DEBUG;
2102
2103  # $server contains biblioserver or authorities, depending on what we search on.
2104  #warn "querying : $string on $server";
2105     $server = 'biblioserver' unless $server;
2106
2107 # if we have a ", replace the content to discard temporarily any and/or/not inside
2108     my $commacontent;
2109     if ( $string =~ /"/ ) {
2110         $string =~ s/"(.*?)"/__X__/;
2111         $commacontent = $1;
2112         warn "commacontent : $commacontent" if $DEBUG;
2113     }
2114
2115 # split the query string in 3 parts : X AND Y means : $left="X", $operand="AND" and $right="Y"
2116 # then, call again NZanalyse with $left and $right
2117 # (recursive until we find a leaf (=> something without and/or/not)
2118 # delete repeated operator... Would then go in infinite loop
2119     while ( $string =~ s/( and| or| not| AND| OR| NOT)\1/$1/g ) {
2120     }
2121
2122     #process parenthesis before.
2123     if ( $string =~ /^\s*\((.*)\)(( and | or | not | AND | OR | NOT )(.*))?/ ) {
2124         my $left     = $1;
2125         my $right    = $4;
2126         my $operator = lc($3);   # FIXME: and/or/not are operators, not operands
2127         warn
2128 "dealing w/parenthesis before recursive sub call. left :$left operator:$operator right:$right"
2129           if $DEBUG;
2130         my $leftresult = NZanalyse( $left, $server );
2131         if ($operator) {
2132             my $rightresult = NZanalyse( $right, $server );
2133
2134             # OK, we have the results for right and left part of the query
2135             # depending of operand, intersect, union or exclude both lists
2136             # to get a result list
2137             if ( $operator eq ' and ' ) {
2138                 return NZoperatorAND($leftresult,$rightresult);
2139             }
2140             elsif ( $operator eq ' or ' ) {
2141
2142                 # just merge the 2 strings
2143                 return $leftresult . $rightresult;
2144             }
2145             elsif ( $operator eq ' not ' ) {
2146                 return NZoperatorNOT($leftresult,$rightresult);
2147             }
2148         }
2149         else {
2150 # this error is impossible, because of the regexp that isolate the operand, but just in case...
2151             return $leftresult;
2152         }
2153     }
2154     warn "string :" . $string if $DEBUG;
2155     my $left = "";
2156     my $right = "";
2157     my $operator = "";
2158     if ($string =~ /(.*?)( and | or | not | AND | OR | NOT )(.*)/) {
2159         $left     = $1;
2160         $right    = $3;
2161         $operator = lc($2);    # FIXME: and/or/not are operators, not operands
2162     }
2163     warn "no parenthesis. left : $left operator: $operator right: $right"
2164       if $DEBUG;
2165
2166     # it's not a leaf, we have a and/or/not
2167     if ($operator) {
2168
2169         # reintroduce comma content if needed
2170         $right =~ s/__X__/"$commacontent"/ if $commacontent;
2171         $left  =~ s/__X__/"$commacontent"/ if $commacontent;
2172         warn "node : $left / $operator / $right\n" if $DEBUG;
2173         my $leftresult  = NZanalyse( $left,  $server );
2174         my $rightresult = NZanalyse( $right, $server );
2175         warn " leftresult : $leftresult" if $DEBUG;
2176         warn " rightresult : $rightresult" if $DEBUG;
2177         # OK, we have the results for right and left part of the query
2178         # depending of operand, intersect, union or exclude both lists
2179         # to get a result list
2180         if ( $operator eq ' and ' ) {
2181             return NZoperatorAND($leftresult,$rightresult);
2182         }
2183         elsif ( $operator eq ' or ' ) {
2184
2185             # just merge the 2 strings
2186             return $leftresult . $rightresult;
2187         }
2188         elsif ( $operator eq ' not ' ) {
2189             return NZoperatorNOT($leftresult,$rightresult);
2190         }
2191         else {
2192
2193 # this error is impossible, because of the regexp that isolate the operand, but just in case...
2194             die "error : operand unknown : $operator for $string";
2195         }
2196
2197         # it's a leaf, do the real SQL query and return the result
2198     }
2199     else {
2200         $string =~ s/__X__/"$commacontent"/ if $commacontent;
2201         $string =~ s/-|\.|\?|,|;|!|'|\(|\)|\[|\]|{|}|"|&|\+|\*|\// /g;
2202         #remove trailing blank at the beginning
2203         $string =~ s/^ //g;
2204         warn "leaf:$string" if $DEBUG;
2205
2206         # parse the string in in operator/operand/value again
2207         my $left = "";
2208         my $operator = "";
2209         my $right = "";
2210         if ($string =~ /(.*)(>=|<=)(.*)/) {
2211             $left     = $1;
2212             $operator = $2;
2213             $right    = $3;
2214         } else {
2215             $left = $string;
2216         }
2217 #         warn "handling leaf... left:$left operator:$operator right:$right"
2218 #           if $DEBUG;
2219         unless ($operator) {
2220             if ($string =~ /(.*)(>|<|=)(.*)/) {
2221                 $left     = $1;
2222                 $operator = $2;
2223                 $right    = $3;
2224                 warn
2225     "handling unless (operator)... left:$left operator:$operator right:$right"
2226                 if $DEBUG;
2227             } else {
2228                 $left = $string;
2229             }
2230         }
2231         my $results;
2232
2233 # strip adv, zebra keywords, currently not handled in nozebra: wrdl, ext, phr...
2234         $left =~ s/ .*$//;
2235
2236         # automatic replace for short operators
2237         $left = 'title'            if $left =~ '^ti$';
2238         $left = 'author'           if $left =~ '^au$';
2239         $left = 'publisher'        if $left =~ '^pb$';
2240         $left = 'subject'          if $left =~ '^su$';
2241         $left = 'koha-Auth-Number' if $left =~ '^an$';
2242         $left = 'keyword'          if $left =~ '^kw$';
2243         $left = 'itemtype'         if $left =~ '^mc$'; # Fix for Bug 2599 - Search limits not working for NoZebra
2244         warn "handling leaf... left:$left operator:$operator right:$right" if $DEBUG;
2245         my $dbh = C4::Context->dbh;
2246         if ( $operator && $left ne 'keyword' ) {
2247             #do a specific search
2248             $operator = 'LIKE' if $operator eq '=' and $right =~ /%/;
2249             my $sth = $dbh->prepare(
2250 "SELECT biblionumbers,value FROM nozebra WHERE server=? AND indexname=? AND value $operator ?"
2251             );
2252             warn "$left / $operator / $right\n" if $DEBUG;
2253
2254             # split each word, query the DB and build the biblionumbers result
2255             #sanitizing leftpart
2256             $left =~ s/^\s+|\s+$//;
2257             foreach ( split / /, $right ) {
2258                 my $biblionumbers;
2259                 $_ =~ s/^\s+|\s+$//;
2260                 next unless $_;
2261                 warn "EXECUTE : $server, $left, $_" if $DEBUG;
2262                 $sth->execute( $server, $left, $_ )
2263                   or warn "execute failed: $!";
2264                 while ( my ( $line, $value ) = $sth->fetchrow ) {
2265
2266 # if we are dealing with a numeric value, use only numeric results (in case of >=, <=, > or <)
2267 # otherwise, fill the result
2268                     $biblionumbers .= $line
2269                       unless ( $right =~ /^\d+$/ && $value =~ /\D/ );
2270                     warn "result : $value "
2271                       . ( $right  =~ /\d/ ) . "=="
2272                       . ( $value =~ /\D/?$line:"" ) if $DEBUG;         #= $line";
2273                 }
2274
2275 # do a AND with existing list if there is one, otherwise, use the biblionumbers list as 1st result list
2276                 if ($results) {
2277                     warn "NZAND" if $DEBUG;
2278                     $results = NZoperatorAND($biblionumbers,$results);
2279                 } else {
2280                     $results = $biblionumbers;
2281                 }
2282             }
2283         }
2284         else {
2285       #do a complete search (all indexes), if index='kw' do complete search too.
2286             my $sth = $dbh->prepare(
2287 "SELECT biblionumbers FROM nozebra WHERE server=? AND value LIKE ?"
2288             );
2289
2290             # split each word, query the DB and build the biblionumbers result
2291             foreach ( split / /, $string ) {
2292                 next if C4::Context->stopwords->{ uc($_) };   # skip if stopword
2293                 warn "search on all indexes on $_" if $DEBUG;
2294                 my $biblionumbers;
2295                 next unless $_;
2296                 $sth->execute( $server, $_ );
2297                 while ( my $line = $sth->fetchrow ) {
2298                     $biblionumbers .= $line;
2299                 }
2300
2301 # do a AND with existing list if there is one, otherwise, use the biblionumbers list as 1st result list
2302                 if ($results) {
2303                     $results = NZoperatorAND($biblionumbers,$results);
2304                 }
2305                 else {
2306                     warn "NEW RES for $_ = $biblionumbers" if $DEBUG;
2307                     $results = $biblionumbers;
2308                 }
2309             }
2310         }
2311         warn "return : $results for LEAF : $string" if $DEBUG;
2312         return $results;
2313     }
2314     warn "---------\nLeave NZanalyse\n---------" if $DEBUG;
2315 }
2316
2317 sub NZoperatorAND{
2318     my ($rightresult, $leftresult)=@_;
2319
2320     my @leftresult = split /;/, $leftresult;
2321     warn " @leftresult / $rightresult \n" if $DEBUG;
2322
2323     #             my @rightresult = split /;/,$leftresult;
2324     my $finalresult;
2325
2326 # parse the left results, and if the biblionumber exist in the right result, save it in finalresult
2327 # the result is stored twice, to have the same weight for AND than OR.
2328 # example : TWO : 61,61,64,121 (two is twice in the biblio #61) / TOWER : 61,64,130
2329 # result : 61,61,61,61,64,64 for two AND tower : 61 has more weight than 64
2330     foreach (@leftresult) {
2331         my $value = $_;
2332         my $countvalue;
2333         ( $value, $countvalue ) = ( $1, $2 ) if ($value=~/(.*)-(\d+)$/);
2334         if ( $rightresult =~ /\Q$value\E-(\d+);/ ) {
2335             $countvalue = ( $1 > $countvalue ? $countvalue : $1 );
2336             $finalresult .=
2337                 "$value-$countvalue;$value-$countvalue;";
2338         }
2339     }
2340     warn "NZAND DONE : $finalresult \n" if $DEBUG;
2341     return $finalresult;
2342 }
2343
2344 sub NZoperatorOR{
2345     my ($rightresult, $leftresult)=@_;
2346     return $rightresult.$leftresult;
2347 }
2348
2349 sub NZoperatorNOT{
2350     my ($leftresult, $rightresult)=@_;
2351
2352     my @leftresult = split /;/, $leftresult;
2353
2354     #             my @rightresult = split /;/,$leftresult;
2355     my $finalresult;
2356     foreach (@leftresult) {
2357         my $value=$_;
2358         $value=$1 if $value=~m/(.*)-\d+$/;
2359         unless ($rightresult =~ "$value-") {
2360             $finalresult .= "$_;";
2361         }
2362     }
2363     return $finalresult;
2364 }
2365
2366 =head2 NZorder
2367
2368   $finalresult = NZorder($biblionumbers, $ordering,$results_per_page,$offset);
2369
2370   TODO :: Description
2371
2372 =cut
2373
2374 sub NZorder {
2375     my ( $biblionumbers, $ordering, $results_per_page, $offset ) = @_;
2376     warn "biblionumbers = $biblionumbers and ordering = $ordering\n" if $DEBUG;
2377
2378     # order title asc by default
2379     #     $ordering = '1=36 <i' unless $ordering;
2380     $results_per_page = 20 unless $results_per_page;
2381     $offset           = 0  unless $offset;
2382     my $dbh = C4::Context->dbh;
2383
2384     #
2385     # order by POPULARITY
2386     #
2387     if ( $ordering =~ /popularity/ ) {
2388         my %result;
2389         my %popularity;
2390
2391         # popularity is not in MARC record, it's builded from a specific query
2392         my $sth =
2393           $dbh->prepare("select sum(issues) from items where biblionumber=?");
2394         foreach ( split /;/, $biblionumbers ) {
2395             my ( $biblionumber, $title ) = split /,/, $_;
2396             $result{$biblionumber} = GetMarcBiblio($biblionumber);
2397             $sth->execute($biblionumber);
2398             my $popularity = $sth->fetchrow || 0;
2399
2400 # hint : the key is popularity.title because we can have
2401 # many results with the same popularity. In this case, sub-ordering is done by title
2402 # we also have biblionumber to avoid bug for 2 biblios with the same title & popularity
2403 # (un-frequent, I agree, but we won't forget anything that way ;-)
2404             $popularity{ sprintf( "%10d", $popularity ) . $title
2405                   . $biblionumber } = $biblionumber;
2406         }
2407
2408     # sort the hash and return the same structure as GetRecords (Zebra querying)
2409         my $result_hash;
2410         my $numbers = 0;
2411         if ( $ordering eq 'popularity_dsc' ) {    # sort popularity DESC
2412             foreach my $key ( sort { $b cmp $a } ( keys %popularity ) ) {
2413                 $result_hash->{'RECORDS'}[ $numbers++ ] =
2414                   $result{ $popularity{$key} }->as_usmarc();
2415             }
2416         }
2417         else {                                    # sort popularity ASC
2418             foreach my $key ( sort ( keys %popularity ) ) {
2419                 $result_hash->{'RECORDS'}[ $numbers++ ] =
2420                   $result{ $popularity{$key} }->as_usmarc();
2421             }
2422         }
2423         my $finalresult = ();
2424         $result_hash->{'hits'}         = $numbers;
2425         $finalresult->{'biblioserver'} = $result_hash;
2426         return $finalresult;
2427
2428         #
2429         # ORDER BY author
2430         #
2431     }
2432     elsif ( $ordering =~ /author/ ) {
2433         my %result;
2434         foreach ( split /;/, $biblionumbers ) {
2435             my ( $biblionumber, $title ) = split /,/, $_;
2436             my $record = GetMarcBiblio($biblionumber);
2437             my $author;
2438             if ( C4::Context->preference('marcflavour') eq 'UNIMARC' ) {
2439                 $author = $record->subfield( '200', 'f' );
2440                 $author = $record->subfield( '700', 'a' ) unless $author;
2441             }
2442             else {
2443                 $author = $record->subfield( '100', 'a' );
2444             }
2445
2446 # hint : the result is sorted by title.biblionumber because we can have X biblios with the same title
2447 # and we don't want to get only 1 result for each of them !!!
2448             $result{ $author . $biblionumber } = $record;
2449         }
2450
2451     # sort the hash and return the same structure as GetRecords (Zebra querying)
2452         my $result_hash;
2453         my $numbers = 0;
2454         if ( $ordering eq 'author_za' || $ordering eq 'author_dsc' ) {    # sort by author desc
2455             foreach my $key ( sort { $b cmp $a } ( keys %result ) ) {
2456                 $result_hash->{'RECORDS'}[ $numbers++ ] =
2457                   $result{$key}->as_usmarc();
2458             }
2459         }
2460         else {                               # sort by author ASC
2461             foreach my $key ( sort ( keys %result ) ) {
2462                 $result_hash->{'RECORDS'}[ $numbers++ ] =
2463                   $result{$key}->as_usmarc();
2464             }
2465         }
2466         my $finalresult = ();
2467         $result_hash->{'hits'}         = $numbers;
2468         $finalresult->{'biblioserver'} = $result_hash;
2469         return $finalresult;
2470
2471         #
2472         # ORDER BY callnumber
2473         #
2474     }
2475     elsif ( $ordering =~ /callnumber/ ) {
2476         my %result;
2477         foreach ( split /;/, $biblionumbers ) {
2478             my ( $biblionumber, $title ) = split /,/, $_;
2479             my $record = GetMarcBiblio($biblionumber);
2480             my $callnumber;
2481             my $frameworkcode = GetFrameworkCode($biblionumber);
2482             my ( $callnumber_tag, $callnumber_subfield ) = GetMarcFromKohaField(  'items.itemcallnumber', $frameworkcode);
2483                ( $callnumber_tag, $callnumber_subfield ) = GetMarcFromKohaField('biblioitems.callnumber', $frameworkcode)
2484                 unless $callnumber_tag;
2485             if ( C4::Context->preference('marcflavour') eq 'UNIMARC' ) {
2486                 $callnumber = $record->subfield( '200', 'f' );
2487             } else {
2488                 $callnumber = $record->subfield( '100', 'a' );
2489             }
2490
2491 # hint : the result is sorted by title.biblionumber because we can have X biblios with the same title
2492 # and we don't want to get only 1 result for each of them !!!
2493             $result{ $callnumber . $biblionumber } = $record;
2494         }
2495
2496     # sort the hash and return the same structure as GetRecords (Zebra querying)
2497         my $result_hash;
2498         my $numbers = 0;
2499         if ( $ordering eq 'call_number_dsc' ) {    # sort by title desc
2500             foreach my $key ( sort { $b cmp $a } ( keys %result ) ) {
2501                 $result_hash->{'RECORDS'}[ $numbers++ ] =
2502                   $result{$key}->as_usmarc();
2503             }
2504         }
2505         else {                                     # sort by title ASC
2506             foreach my $key ( sort { $a cmp $b } ( keys %result ) ) {
2507                 $result_hash->{'RECORDS'}[ $numbers++ ] =
2508                   $result{$key}->as_usmarc();
2509             }
2510         }
2511         my $finalresult = ();
2512         $result_hash->{'hits'}         = $numbers;
2513         $finalresult->{'biblioserver'} = $result_hash;
2514         return $finalresult;
2515     }
2516     elsif ( $ordering =~ /pubdate/ ) {             #pub year
2517         my %result;
2518         foreach ( split /;/, $biblionumbers ) {
2519             my ( $biblionumber, $title ) = split /,/, $_;
2520             my $record = GetMarcBiblio($biblionumber);
2521             my ( $publicationyear_tag, $publicationyear_subfield ) =
2522               GetMarcFromKohaField( 'biblioitems.publicationyear', '' );
2523             my $publicationyear =
2524               $record->subfield( $publicationyear_tag,
2525                 $publicationyear_subfield );
2526
2527 # hint : the result is sorted by title.biblionumber because we can have X biblios with the same title
2528 # and we don't want to get only 1 result for each of them !!!
2529             $result{ $publicationyear . $biblionumber } = $record;
2530         }
2531
2532     # sort the hash and return the same structure as GetRecords (Zebra querying)
2533         my $result_hash;
2534         my $numbers = 0;
2535         if ( $ordering eq 'pubdate_dsc' ) {    # sort by pubyear desc
2536             foreach my $key ( sort { $b cmp $a } ( keys %result ) ) {
2537                 $result_hash->{'RECORDS'}[ $numbers++ ] =
2538                   $result{$key}->as_usmarc();
2539             }
2540         }
2541         else {                                 # sort by pub year ASC
2542             foreach my $key ( sort ( keys %result ) ) {
2543                 $result_hash->{'RECORDS'}[ $numbers++ ] =
2544                   $result{$key}->as_usmarc();
2545             }
2546         }
2547         my $finalresult = ();
2548         $result_hash->{'hits'}         = $numbers;
2549         $finalresult->{'biblioserver'} = $result_hash;
2550         return $finalresult;
2551
2552         #
2553         # ORDER BY title
2554         #
2555     }
2556     elsif ( $ordering =~ /title/ ) {
2557
2558 # the title is in the biblionumbers string, so we just need to build a hash, sort it and return
2559         my %result;
2560         foreach ( split /;/, $biblionumbers ) {
2561             my ( $biblionumber, $title ) = split /,/, $_;
2562
2563 # hint : the result is sorted by title.biblionumber because we can have X biblios with the same title
2564 # and we don't want to get only 1 result for each of them !!!
2565 # hint & speed improvement : we can order without reading the record
2566 # so order, and read records only for the requested page !
2567             $result{ $title . $biblionumber } = $biblionumber;
2568         }
2569
2570     # sort the hash and return the same structure as GetRecords (Zebra querying)
2571         my $result_hash;
2572         my $numbers = 0;
2573         if ( $ordering eq 'title_az' ) {    # sort by title desc
2574             foreach my $key ( sort ( keys %result ) ) {
2575                 $result_hash->{'RECORDS'}[ $numbers++ ] = $result{$key};
2576             }
2577         }
2578         else {                              # sort by title ASC
2579             foreach my $key ( sort { $b cmp $a } ( keys %result ) ) {
2580                 $result_hash->{'RECORDS'}[ $numbers++ ] = $result{$key};
2581             }
2582         }
2583
2584         # limit the $results_per_page to result size if it's more
2585         $results_per_page = $numbers - 1 if $numbers < $results_per_page;
2586
2587         # for the requested page, replace biblionumber by the complete record
2588         # speed improvement : avoid reading too much things
2589         for (
2590             my $counter = $offset ;
2591             $counter <= $offset + $results_per_page ;
2592             $counter++
2593           )
2594         {
2595             $result_hash->{'RECORDS'}[$counter] =
2596               GetMarcBiblio( $result_hash->{'RECORDS'}[$counter] )->as_usmarc;
2597         }
2598         my $finalresult = ();
2599         $result_hash->{'hits'}         = $numbers;
2600         $finalresult->{'biblioserver'} = $result_hash;
2601         return $finalresult;
2602     }
2603     else {
2604
2605 #
2606 # order by ranking
2607 #
2608 # we need 2 hashes to order by ranking : the 1st one to count the ranking, the 2nd to order by ranking
2609         my %result;
2610         my %count_ranking;
2611         foreach ( split /;/, $biblionumbers ) {
2612             my ( $biblionumber, $title ) = split /,/, $_;
2613             $title =~ /(.*)-(\d)/;
2614
2615             # get weight
2616             my $ranking = $2;
2617
2618 # note that we + the ranking because ranking is calculated on weight of EACH term requested.
2619 # if we ask for "two towers", and "two" has weight 2 in biblio N, and "towers" has weight 4 in biblio N
2620 # biblio N has ranking = 6
2621             $count_ranking{$biblionumber} += $ranking;
2622         }
2623
2624 # build the result by "inverting" the count_ranking hash
2625 # 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
2626 #         warn "counting";
2627         foreach ( keys %count_ranking ) {
2628             $result{ sprintf( "%10d", $count_ranking{$_} ) . '-' . $_ } = $_;
2629         }
2630
2631     # sort the hash and return the same structure as GetRecords (Zebra querying)
2632         my $result_hash;
2633         my $numbers = 0;
2634         foreach my $key ( sort { $b cmp $a } ( keys %result ) ) {
2635             $result_hash->{'RECORDS'}[ $numbers++ ] = $result{$key};
2636         }
2637
2638         # limit the $results_per_page to result size if it's more
2639         $results_per_page = $numbers - 1 if $numbers < $results_per_page;
2640
2641         # for the requested page, replace biblionumber by the complete record
2642         # speed improvement : avoid reading too much things
2643         for (
2644             my $counter = $offset ;
2645             $counter <= $offset + $results_per_page ;
2646             $counter++
2647           )
2648         {
2649             $result_hash->{'RECORDS'}[$counter] =
2650               GetMarcBiblio( $result_hash->{'RECORDS'}[$counter] )->as_usmarc
2651               if $result_hash->{'RECORDS'}[$counter];
2652         }
2653         my $finalresult = ();
2654         $result_hash->{'hits'}         = $numbers;
2655         $finalresult->{'biblioserver'} = $result_hash;
2656         return $finalresult;
2657     }
2658 }
2659
2660 =head2 enabled_staff_search_views
2661
2662 %hash = enabled_staff_search_views()
2663
2664 This function returns a hash that contains three flags obtained from the system
2665 preferences, used to determine whether a particular staff search results view
2666 is enabled.
2667
2668 =over 2
2669
2670 =item C<Output arg:>
2671
2672     * $hash{can_view_MARC} is true only if the MARC view is enabled
2673     * $hash{can_view_ISBD} is true only if the ISBD view is enabled
2674     * $hash{can_view_labeledMARC} is true only if the Labeled MARC view is enabled
2675
2676 =item C<usage in the script:>
2677
2678 =back
2679
2680 $template->param ( C4::Search::enabled_staff_search_views );
2681
2682 =cut
2683
2684 sub enabled_staff_search_views
2685 {
2686         return (
2687                 can_view_MARC                   => C4::Context->preference('viewMARC'),                 # 1 if the staff search allows the MARC view
2688                 can_view_ISBD                   => C4::Context->preference('viewISBD'),                 # 1 if the staff search allows the ISBD view
2689                 can_view_labeledMARC    => C4::Context->preference('viewLabeledMARC'),  # 1 if the staff search allows the Labeled MARC view
2690         );
2691 }
2692
2693 sub AddSearchHistory{
2694         my ($borrowernumber,$session,$query_desc,$query_cgi, $total)=@_;
2695     my $dbh = C4::Context->dbh;
2696
2697     # Add the request the user just made
2698     my $sql = "INSERT INTO search_history(userid, sessionid, query_desc, query_cgi, total, time) VALUES(?, ?, ?, ?, ?, NOW())";
2699     my $sth   = $dbh->prepare($sql);
2700     $sth->execute($borrowernumber, $session, $query_desc, $query_cgi, $total);
2701         return $dbh->last_insert_id(undef, 'search_history', undef,undef,undef);
2702 }
2703
2704 sub GetSearchHistory{
2705         my ($borrowernumber,$session)=@_;
2706     my $dbh = C4::Context->dbh;
2707
2708     # Add the request the user just made
2709     my $query = "SELECT FROM search_history WHERE (userid=? OR sessionid=?)";
2710     my $sth   = $dbh->prepare($query);
2711         $sth->execute($borrowernumber, $session);
2712     return  $sth->fetchall_hashref({});
2713 }
2714
2715 =head2 z3950_search_args
2716
2717 $arrayref = z3950_search_args($matchpoints)
2718
2719 This function returns an array reference that contains the search parameters to be
2720 passed to the Z39.50 search script (z3950_search.pl). The array elements
2721 are hash refs whose keys are name, value and encvalue, and whose values are the
2722 name of a search parameter, the value of that search parameter and the URL encoded
2723 value of that parameter.
2724
2725 The search parameter names are lccn, isbn, issn, title, author, dewey and subject.
2726
2727 The search parameter values are obtained from the bibliographic record whose
2728 data is in a hash reference in $matchpoints, as returned by Biblio::GetBiblioData().
2729
2730 If $matchpoints is a scalar, it is assumed to be an unnamed query descriptor, e.g.
2731 a general purpose search argument. In this case, the returned array contains only
2732 entry: the key is 'title' and the value and encvalue are derived from $matchpoints.
2733
2734 If a search parameter value is undefined or empty, it is not included in the returned
2735 array.
2736
2737 The returned array reference may be passed directly to the template parameters.
2738
2739 =over 2
2740
2741 =item C<Output arg:>
2742
2743     * $array containing hash refs as described above
2744
2745 =item C<usage in the script:>
2746
2747 =back
2748
2749 $data = Biblio::GetBiblioData($bibno);
2750 $template->param ( MYLOOP => C4::Search::z3950_search_args($data) )
2751
2752 *OR*
2753
2754 $template->param ( MYLOOP => C4::Search::z3950_search_args($searchscalar) )
2755
2756 =cut
2757
2758 sub z3950_search_args {
2759     my $bibrec = shift;
2760     my $isbn = Business::ISBN->new($bibrec);
2761
2762     if (defined $isbn && $isbn->is_valid)
2763     {
2764         $bibrec = { isbn => $bibrec } if !ref $bibrec;
2765     }
2766     else {
2767         $bibrec = { title => $bibrec } if !ref $bibrec;
2768     }
2769     my $array = [];
2770     for my $field (qw/ lccn isbn issn title author dewey subject /)
2771     {
2772         my $encvalue = URI::Escape::uri_escape_utf8($bibrec->{$field});
2773         push @$array, { name=>$field, value=>$bibrec->{$field}, encvalue=>$encvalue } if defined $bibrec->{$field};
2774     }
2775     return $array;
2776 }
2777
2778 =head2 GetDistinctValues($field);
2779
2780 C<$field> is a reference to the fields array
2781
2782 =cut
2783
2784 sub GetDistinctValues {
2785     my ($fieldname,$string)=@_;
2786     # returns a reference to a hash of references to branches...
2787     if ($fieldname=~/\./){
2788                         my ($table,$column)=split /\./, $fieldname;
2789                         my $dbh = C4::Context->dbh;
2790                         warn "select DISTINCT($column) as value, count(*) as cnt from $table group by lib order by $column " if $DEBUG;
2791                         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 ");
2792                         $sth->execute;
2793                         my $elements=$sth->fetchall_arrayref({});
2794                         return $elements;
2795    }
2796    else {
2797                 $string||= qq("");
2798                 my @servers=qw<biblioserver authorityserver>;
2799                 my (@zconns,@results);
2800         for ( my $i = 0 ; $i < @servers ; $i++ ) {
2801                 $zconns[$i] = C4::Context->Zconn( $servers[$i], 1 );
2802                         $results[$i] =
2803                       $zconns[$i]->scan(
2804                         ZOOM::Query::CCL2RPN->new( qq"$fieldname $string", $zconns[$i])
2805                       );
2806                 }
2807                 # The big moment: asynchronously retrieve results from all servers
2808                 my @elements;
2809                 while ( ( my $i = ZOOM::event( \@zconns ) ) != 0 ) {
2810                         my $ev = $zconns[ $i - 1 ]->last_event();
2811                         if ( $ev == ZOOM::Event::ZEND ) {
2812                                 next unless $results[ $i - 1 ];
2813                                 my $size = $results[ $i - 1 ]->size();
2814                                 if ( $size > 0 ) {
2815                       for (my $j=0;$j<$size;$j++){
2816                                                 my %hashscan;
2817                                                 @hashscan{qw(value cnt)}=$results[ $i - 1 ]->display_term($j);
2818                                                 push @elements, \%hashscan;
2819                                           }
2820                                 }
2821                         }
2822                 }
2823                 return \@elements;
2824    }
2825 }
2826
2827
2828 END { }    # module clean-up code here (global destructor)
2829
2830 1;
2831 __END__
2832
2833 =head1 AUTHOR
2834
2835 Koha Development Team <http://koha-community.org/>
2836
2837 =cut