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