C4/Search.pm

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