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