C4/Search.pm

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