C4/Search.pm

   1 package C4::Search;
   2
   3 # This file is part of Koha.
   4 #
   5 # Koha is free software; you can redistribute it and/or modify it under the
   6 # terms of the GNU General Public License as published by the Free Software
   7 # Foundation; either version 2 of the License, or (at your option) any later
   8 # version.
   9 #
  10 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
  11 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
  12 # A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
  13 #
  14 # You should have received a copy of the GNU General Public License along with
  15 # Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
  16 # Suite 330, Boston, MA  02111-1307 USA
  17
  18 use strict;
  19 #use warnings; FIXME - Bug 2505
  20 require Exporter;
  21 use C4::Context;
  22 use C4::Biblio;    # GetMarcFromKohaField, GetBiblioData
  23 use C4::Koha;      # getFacets
  24 use Lingua::Stem;
  25 use C4::Search::PazPar2;
  26 use XML::Simple;
  27 use C4::Dates qw(format_date);
  28 use C4::XSLT;
  29 use C4::Branch;
  30 use C4::Reserves;    # CheckReserves
  31 use C4::Debug;
  32 use URI::Escape;
  33
  34 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $DEBUG);
  35
  36 # set the version for version checking
  37 BEGIN {
  38     $VERSION = 3.01;
  39     $DEBUG = ($ENV{DEBUG}) ? 1 : 0;
  40 }
  41
  42 =head1 NAME
  43
  44 C4::Search - Functions for searching the Koha catalog.
  45
  46 =head1 SYNOPSIS
  47
  48 See opac/opac-search.pl or catalogue/search.pl for example of usage
  49
  50 =head1 DESCRIPTION
  51
  52 This module provides searching functions for Koha's bibliographic databases
  53
  54 =head1 FUNCTIONS
  55
  56 =cut
  57
  58 @ISA    = qw(Exporter);
  59 @EXPORT = qw(
  60   &FindDuplicate
  61   &SimpleSearch
  62   &searchResults
  63   &getRecords
  64   &buildQuery
  65   &NZgetRecords
  66   &AddSearchHistory
  67   &GetDistinctValues
  68   &BiblioAddAuthorities
  69 );
  70 #FIXME: i had to add BiblioAddAuthorities here because in Biblios.pm it caused circular dependencies (C4::Search uses C4::Biblio, and BiblioAddAuthorities uses SimpleSearch from C4::Search)
  71
  72 # make all your functions, whether exported or not;
  73
  74 =head2 FindDuplicate
  75
  76 ($biblionumber,$biblionumber,$title) = FindDuplicate($record);
  77
  78 This function attempts to find duplicate records using a hard-coded, fairly simplistic algorithm
  79
  80 =cut
  81
  82 sub FindDuplicate {
  83     my ($record) = @_;
  84     my $dbh = C4::Context->dbh;
  85     my $result = TransformMarcToKoha( $dbh, $record, '' );
  86     my $sth;
  87     my $query;
  88     my $search;
  89     my $type;
  90     my ( $biblionumber, $title );
  91
  92     # search duplicate on ISBN, easy and fast..
  93     # ... normalize first
  94     if ( $result->{isbn} ) {
  95         $result->{isbn} =~ s/\(.*$//;
  96         $result->{isbn} =~ s/\s+$//;
  97         $query = "isbn=$result->{isbn}";
  98     }
  99     else {
 100         $result->{title} =~ s /\\//g;
 101         $result->{title} =~ s /\"//g;
 102         $result->{title} =~ s /\(//g;
 103         $result->{title} =~ s /\)//g;
 104
 105         # FIXME: instead of removing operators, could just do
 106         # quotes around the value
 107         $result->{title} =~ s/(and|or|not)//g;
 108         $query = "ti,ext=$result->{title}";
 109         $query .= " and itemtype=$result->{itemtype}"
 110           if ( $result->{itemtype} );
 111         if   ( $result->{author} ) {
 112             $result->{author} =~ s /\\//g;
 113             $result->{author} =~ s /\"//g;
 114             $result->{author} =~ s /\(//g;
 115             $result->{author} =~ s /\)//g;
 116
 117             # remove valid operators
 118             $result->{author} =~ s/(and|or|not)//g;
 119             $query .= " and au,ext=$result->{author}";
 120         }
 121     }
 122
 123     # FIXME: add error handling
 124     my ( $error, $searchresults ) = SimpleSearch($query); # FIXME :: hardcoded !
 125     my @results;
 126     foreach my $possible_duplicate_record (@$searchresults) {
 127         my $marcrecord =
 128           MARC::Record->new_from_usmarc($possible_duplicate_record);
 129         my $result = TransformMarcToKoha( $dbh, $marcrecord, '' );
 130
 131         # FIXME :: why 2 $biblionumber ?
 132         if ($result) {
 133             push @results, $result->{'biblionumber'};
 134             push @results, $result->{'title'};
 135         }
 136     }
 137     return @results;
 138 }
 139
 140 =head2 SimpleSearch
 141
 142 ( $error, $results, $total_hits ) = SimpleSearch( $query, $offset, $max_results, [@servers] );
 143
 144 This function provides a simple search API on the bibliographic catalog
 145
 146 =over 2
 147
 148 =item C<input arg:>
 149
 150     * $query can be a simple keyword or a complete CCL query
 151     * @servers is optional. Defaults to biblioserver as found in koha-conf.xml
 152     * $offset - If present, represents the number of records at the beggining to omit. Defaults to 0
 153     * $max_results - if present, determines the maximum number of records to fetch. undef is All. defaults to undef.
 154
 155
 156 =item C<Output:>
 157
 158     * $error is a empty unless an error is detected
 159     * \@results is an array of records.
 160     * $total_hits is the number of hits that would have been returned with no limit
 161
 162 =item C<usage in the script:>
 163
 164 =back
 165
 166 my ( $error, $marcresults, $total_hits ) = SimpleSearch($query);
 167
 168 if (defined $error) {
 169     $template->param(query_error => $error);
 170     warn "error: ".$error;
 171     output_html_with_http_headers $input, $cookie, $template->output;
 172     exit;
 173 }
 174
 175 my $hits = scalar @$marcresults;
 176 my @results;
 177
 178 for my $i (0..$hits) {
 179     my %resultsloop;
 180     my $marcrecord = MARC::File::USMARC::decode($marcresults->[$i]);
 181     my $biblio = TransformMarcToKoha(C4::Context->dbh,$marcrecord,'');
 182
 183     #build the hash for the template.
 184     $resultsloop{title}           = $biblio->{'title'};
 185     $resultsloop{subtitle}        = $biblio->{'subtitle'};
 186     $resultsloop{biblionumber}    = $biblio->{'biblionumber'};
 187     $resultsloop{author}          = $biblio->{'author'};
 188     $resultsloop{publishercode}   = $biblio->{'publishercode'};
 189     $resultsloop{publicationyear} = $biblio->{'publicationyear'};
 190
 191     push @results, \%resultsloop;
 192 }
 193
 194 $template->param(result=>\@results);
 195
 196 =cut
 197
 198 sub SimpleSearch {
 199     my ( $query, $offset, $max_results, $servers )  = @_;
 200
 201     if ( C4::Context->preference('NoZebra') ) {
 202         my $result = NZorder( NZanalyse($query) )->{'biblioserver'};
 203         my $search_result =
 204           (      $result->{hits}
 205               && $result->{hits} > 0 ? $result->{'RECORDS'} : [] );
 206         return ( undef, $search_result, scalar($result->{hits}) );
 207     }
 208     else {
 209         # FIXME hardcoded value. See catalog/search.pl & opac-search.pl too.
 210         my @servers = defined ( $servers ) ? @$servers : ( "biblioserver" );
 211         my @results;
 212         my @zoom_queries;
 213         my @tmpresults;
 214         my @zconns;
 215         my $total_hits;
 216         return ( "No query entered", undef, undef ) unless $query;
 217
 218         # Initialize & Search Zebra
 219         for ( my $i = 0 ; $i < @servers ; $i++ ) {
 220             eval {
 221                 $zconns[$i] = C4::Context->Zconn( $servers[$i], 1 );
 222                 $zoom_queries[$i] = new ZOOM::Query::CCL2RPN( $query, $zconns[$i]);
 223                 $tmpresults[$i] = $zconns[$i]->search( $zoom_queries[$i] );
 224
 225                 # error handling
 226                 my $error =
 227                     $zconns[$i]->errmsg() . " ("
 228                   . $zconns[$i]->errcode() . ") "
 229                   . $zconns[$i]->addinfo() . " "
 230                   . $zconns[$i]->diagset();
 231
 232                 return ( $error, undef, undef ) if $zconns[$i]->errcode();
 233             };
 234             if ($@) {
 235
 236                 # caught a ZOOM::Exception
 237                 my $error =
 238                     $@->message() . " ("
 239                   . $@->code() . ") "
 240                   . $@->addinfo() . " "
 241                   . $@->diagset();
 242                 warn $error;
 243                 return ( $error, undef, undef );
 244             }
 245         }
 246         while ( ( my $i = ZOOM::event( \@zconns ) ) != 0 ) {
 247             my $event = $zconns[ $i - 1 ]->last_event();
 248             if ( $event == ZOOM::Event::ZEND ) {
 249
 250                 my $first_record = defined( $offset ) ? $offset+1 : 1;
 251                 my $hits = $tmpresults[ $i - 1 ]->size();
 252                 $total_hits += $hits;
 253                 my $last_record = $hits;
 254                 if ( defined $max_results && $offset + $max_results < $hits ) {
 255                     $last_record  = $offset + $max_results;
 256                 }
 257
 258                 for my $j ( $first_record..$last_record ) {
 259                     my $record = $tmpresults[ $i - 1 ]->record( $j-1 )->raw(); # 0 indexed
 260                     push @results, $record;
 261                 }
 262             }
 263         }
 264
 265         foreach my $result (@tmpresults) {
 266             $result->destroy();
 267         }
 268         foreach my $zoom_query (@zoom_queries) {
 269             $zoom_query->destroy();
 270         }
 271
 272         return ( undef, \@results, $total_hits );
 273     }
 274 }
 275
 276 =head2 getRecords
 277
 278 ( undef, $results_hashref, \@facets_loop ) = getRecords (
 279
 280         $koha_query,       $simple_query, $sort_by_ref,    $servers_ref,
 281         $results_per_page, $offset,       $expanded_facet, $branches,
 282         $query_type,       $scan
 283     );
 284
 285 The all singing, all dancing, multi-server, asynchronous, scanning,
 286 searching, record nabbing, facet-building
 287
 288 See verbse embedded documentation.
 289
 290 =cut
 291
 292 sub getRecords {
 293     my (
 294         $koha_query,       $simple_query, $sort_by_ref,    $servers_ref,
 295         $results_per_page, $offset,       $expanded_facet, $branches,
 296         $query_type,       $scan
 297     ) = @_;
 298
 299     my @servers = @$servers_ref;
 300     my @sort_by = @$sort_by_ref;
 301
 302     # Initialize variables for the ZOOM connection and results object
 303     my $zconn;
 304     my @zconns;
 305     my @results;
 306     my $results_hashref = ();
 307
 308     # Initialize variables for the faceted results objects
 309     my $facets_counter = ();
 310     my $facets_info    = ();
 311     my $facets         = getFacets();
 312
 313     my @facets_loop;    # stores the ref to array of hashes for template facets loop
 314
 315     ### LOOP THROUGH THE SERVERS
 316     for ( my $i = 0 ; $i < @servers ; $i++ ) {
 317         $zconns[$i] = C4::Context->Zconn( $servers[$i], 1 );
 318
 319 # perform the search, create the results objects
 320 # if this is a local search, use the $koha-query, if it's a federated one, use the federated-query
 321         my $query_to_use = ($servers[$i] =~ /biblioserver/) ? $koha_query : $simple_query;
 322
 323         #$query_to_use = $simple_query if $scan;
 324         warn $simple_query if ( $scan and $DEBUG );
 325
 326         # Check if we've got a query_type defined, if so, use it
 327         eval {
 328             if ($query_type) {
 329                 if ($query_type =~ /^ccl/) {
 330                     $query_to_use =~ s/\:/\=/g;    # change : to = last minute (FIXME)
 331                     $results[$i] = $zconns[$i]->search(new ZOOM::Query::CCL2RPN($query_to_use, $zconns[$i]));
 332                 } elsif ($query_type =~ /^cql/) {
 333                     $results[$i] = $zconns[$i]->search(new ZOOM::Query::CQL($query_to_use, $zconns[$i]));
 334                 } elsif ($query_type =~ /^pqf/) {
 335                     $results[$i] = $zconns[$i]->search(new ZOOM::Query::PQF($query_to_use, $zconns[$i]));
 336                 } else {
 337                     warn "Unknown query_type '$query_type'.  Results undetermined.";
 338                 }
 339             } elsif ($scan) {
 340                     $results[$i] = $zconns[$i]->scan(  new ZOOM::Query::CCL2RPN($query_to_use, $zconns[$i]));
 341             } else {
 342                     $results[$i] = $zconns[$i]->search(new ZOOM::Query::CCL2RPN($query_to_use, $zconns[$i]));
 343             }
 344         };
 345         if ($@) {
 346             warn "WARNING: query problem with $query_to_use " . $@;
 347         }
 348
 349         # Concatenate the sort_by limits and pass them to the results object
 350         # Note: sort will override rank
 351         my $sort_by;
 352         foreach my $sort (@sort_by) {
 353             if ( $sort eq "author_az" ) {
 354                 $sort_by .= "1=1003 <i ";
 355             }
 356             elsif ( $sort eq "author_za" ) {
 357                 $sort_by .= "1=1003 >i ";
 358             }
 359             elsif ( $sort eq "popularity_asc" ) {
 360                 $sort_by .= "1=9003 <i ";
 361             }
 362             elsif ( $sort eq "popularity_dsc" ) {
 363                 $sort_by .= "1=9003 >i ";
 364             }
 365             elsif ( $sort eq "call_number_asc" ) {
 366                 $sort_by .= "1=20  <i ";
 367             }
 368             elsif ( $sort eq "call_number_dsc" ) {
 369                 $sort_by .= "1=20 >i ";
 370             }
 371             elsif ( $sort eq "pubdate_asc" ) {
 372                 $sort_by .= "1=31 <i ";
 373             }
 374             elsif ( $sort eq "pubdate_dsc" ) {
 375                 $sort_by .= "1=31 >i ";
 376             }
 377             elsif ( $sort eq "acqdate_asc" ) {
 378                 $sort_by .= "1=32 <i ";
 379             }
 380             elsif ( $sort eq "acqdate_dsc" ) {
 381                 $sort_by .= "1=32 >i ";
 382             }
 383             elsif ( $sort eq "title_az" ) {
 384                 $sort_by .= "1=4 <i ";
 385             }
 386             elsif ( $sort eq "title_za" ) {
 387                 $sort_by .= "1=4 >i ";
 388             }
 389             else {
 390                 warn "Ignoring unrecognized sort '$sort' requested" if $sort_by;
 391             }
 392         }
 393         if ($sort_by) {
 394             if ( $results[$i]->sort( "yaz", $sort_by ) < 0 ) {
 395                 warn "WARNING sort $sort_by failed";
 396             }
 397         }
 398     }    # finished looping through servers
 399
 400     # The big moment: asynchronously retrieve results from all servers
 401     while ( ( my $i = ZOOM::event( \@zconns ) ) != 0 ) {
 402         my $ev = $zconns[ $i - 1 ]->last_event();
 403         if ( $ev == ZOOM::Event::ZEND ) {
 404             next unless $results[ $i - 1 ];
 405             my $size = $results[ $i - 1 ]->size();
 406             if ( $size > 0 ) {
 407                 my $results_hash;
 408
 409                 # loop through the results
 410                 $results_hash->{'hits'} = $size;
 411                 my $times;
 412                 if ( $offset + $results_per_page <= $size ) {
 413                     $times = $offset + $results_per_page;
 414                 }
 415                 else {
 416                     $times = $size;
 417                 }
 418                 for ( my $j = $offset ; $j < $times ; $j++ ) {
 419                     my $records_hash;
 420                     my $record;
 421                     my $facet_record;
 422
 423                     ## Check if it's an index scan
 424                     if ($scan) {
 425                         my ( $term, $occ ) = $results[ $i - 1 ]->term($j);
 426
 427                  # here we create a minimal MARC record and hand it off to the
 428                  # template just like a normal result ... perhaps not ideal, but
 429                  # it works for now
 430                         my $tmprecord = MARC::Record->new();
 431                         $tmprecord->encoding('UTF-8');
 432                         my $tmptitle;
 433                         my $tmpauthor;
 434
 435                 # the minimal record in author/title (depending on MARC flavour)
 436                         if (C4::Context->preference("marcflavour") eq "UNIMARC") {
 437                             $tmptitle = MARC::Field->new('200',' ',' ', a => $term, f => $occ);
 438                             $tmprecord->append_fields($tmptitle);
 439                         } else {
 440                             $tmptitle  = MARC::Field->new('245',' ',' ', a => $term,);
 441                             $tmpauthor = MARC::Field->new('100',' ',' ', a => $occ,);
 442                             $tmprecord->append_fields($tmptitle);
 443                             $tmprecord->append_fields($tmpauthor);
 444                         }
 445                         $results_hash->{'RECORDS'}[$j] = $tmprecord->as_usmarc();
 446                     }
 447
 448                     # not an index scan
 449                     else {
 450                         $record = $results[ $i - 1 ]->record($j)->raw();
 451
 452                         # warn "RECORD $j:".$record;
 453                         $results_hash->{'RECORDS'}[$j] = $record;
 454
 455             # Fill the facets while we're looping, but only for the biblioserver
 456                         $facet_record = MARC::Record->new_from_usmarc($record)
 457                           if $servers[ $i - 1 ] =~ /biblioserver/;
 458
 459                     #warn $servers[$i-1]."\n".$record; #.$facet_record->title();
 460                         if ($facet_record) {
 461                             for ( my $k = 0 ; $k <= @$facets ; $k++ ) {
 462                                 ($facets->[$k]) or next;
 463                                 my @fields = map {$facet_record->field($_)} @{$facets->[$k]->{'tags'}} ;
 464                                 for my $field (@fields) {
 465                                     my @subfields = $field->subfields();
 466                                     for my $subfield (@subfields) {
 467                                         my ( $code, $data ) = @$subfield;
 468                                         ($code eq $facets->[$k]->{'subfield'}) or next;
 469                                         $facets_counter->{ $facets->[$k]->{'link_value'} }->{$data}++;
 470                                     }
 471                                 }
 472                                 $facets_info->{ $facets->[$k]->{'link_value'} }->{'label_value'} =
 473                                     $facets->[$k]->{'label_value'};
 474                                 $facets_info->{ $facets->[$k]->{'link_value'} }->{'expanded'} =
 475                                     $facets->[$k]->{'expanded'};
 476                             }
 477                         }
 478                     }
 479                 }
 480                 $results_hashref->{ $servers[ $i - 1 ] } = $results_hash;
 481             }
 482
 483             # warn "connection ", $i-1, ": $size hits";
 484             # warn $results[$i-1]->record(0)->render() if $size > 0;
 485
 486             # BUILD FACETS
 487             if ( $servers[ $i - 1 ] =~ /biblioserver/ ) {
 488                 for my $link_value (
 489                     sort { $facets_counter->{$b} <=> $facets_counter->{$a} }
 490                         keys %$facets_counter )
 491                 {
 492                     my $expandable;
 493                     my $number_of_facets;
 494                     my @this_facets_array;
 495                     for my $one_facet (
 496                         sort {
 497                              $facets_counter->{$link_value}->{$b}
 498                          <=> $facets_counter->{$link_value}->{$a}
 499                         } keys %{ $facets_counter->{$link_value} }
 500                       )
 501                     {
 502                         $number_of_facets++;
 503                         if (   ( $number_of_facets < 6 )
 504                             || ( $expanded_facet eq $link_value )
 505                             || ( $facets_info->{$link_value}->{'expanded'} ) )
 506                         {
 507
 508                       # Sanitize the link value ), ( will cause errors with CCL,
 509                             my $facet_link_value = $one_facet;
 510                             $facet_link_value =~ s/(\(|\))/ /g;
 511
 512                             # fix the length that will display in the label,
 513                             my $facet_label_value = $one_facet;
 514                             $facet_label_value =
 515                               substr( $one_facet, 0, 20 ) . "..."
 516                               unless length($facet_label_value) <= 20;
 517
 518                             # if it's a branch, label by the name, not the code,
 519                             if ( $link_value =~ /branch/ ) {
 520                                                                 if (defined $branches
 521                                                                         && ref($branches) eq "HASH"
 522                                                                         && defined $branches->{$one_facet}
 523                                                                         && ref ($branches->{$one_facet}) eq "HASH")
 524                                                                 {
 525                                         $facet_label_value =
 526                                                 $branches->{$one_facet}->{'branchname'};
 527                                                                 }
 528                                                                 else {
 529                                                                         $facet_label_value = "*";
 530                                                                 }
 531                             }
 532
 533                             # but we're down with the whole label being in the link's title.
 534                             push @this_facets_array, {
 535                                 facet_count       => $facets_counter->{$link_value}->{$one_facet},
 536                                 facet_label_value => $facet_label_value,
 537                                 facet_title_value => $one_facet,
 538                                 facet_link_value  => $facet_link_value,
 539                                 type_link_value   => $link_value,
 540                             };
 541                         }
 542                     }
 543
 544                     # handle expanded option
 545                     unless ( $facets_info->{$link_value}->{'expanded'} ) {
 546                         $expandable = 1
 547                           if ( ( $number_of_facets > 6 )
 548                             && ( $expanded_facet ne $link_value ) );
 549                     }
 550                     push @facets_loop, {
 551                         type_link_value => $link_value,
 552                         type_id         => $link_value . "_id",
 553                         "type_label_" . $facets_info->{$link_value}->{'label_value'} => 1,
 554                         facets     => \@this_facets_array,
 555                         expandable => $expandable,
 556                         expand     => $link_value,
 557                     } unless ( ($facets_info->{$link_value}->{'label_value'} =~ /Libraries/) and (C4::Context->preference('singleBranchMode')) );
 558                 }
 559             }
 560         }
 561     }
 562     return ( undef, $results_hashref, \@facets_loop );
 563 }
 564
 565 sub pazGetRecords {
 566     my (
 567         $koha_query,       $simple_query, $sort_by_ref,    $servers_ref,
 568         $results_per_page, $offset,       $expanded_facet, $branches,
 569         $query_type,       $scan
 570     ) = @_;
 571
 572     my $paz = C4::Search::PazPar2->new(C4::Context->config('pazpar2url'));
 573     $paz->init();
 574     $paz->search($simple_query);
 575     sleep 1;   # FIXME: WHY?
 576
 577     # do results
 578     my $results_hashref = {};
 579     my $stats = XMLin($paz->stat);
 580     my $results = XMLin($paz->show($offset, $results_per_page, 'work-title:1'), forcearray => 1);
 581
 582     # for a grouped search result, the number of hits
 583     # is the number of groups returned; 'bib_hits' will have
 584     # the total number of bibs.
 585     $results_hashref->{'biblioserver'}->{'hits'} = $results->{'merged'}->[0];
 586     $results_hashref->{'biblioserver'}->{'bib_hits'} = $stats->{'hits'};
 587
 588     HIT: foreach my $hit (@{ $results->{'hit'} }) {
 589         my $recid = $hit->{recid}->[0];
 590
 591         my $work_title = $hit->{'md-work-title'}->[0];
 592         my $work_author;
 593         if (exists $hit->{'md-work-author'}) {
 594             $work_author = $hit->{'md-work-author'}->[0];
 595         }
 596         my $group_label = (defined $work_author) ? "$work_title / $work_author" : $work_title;
 597
 598         my $result_group = {};
 599         $result_group->{'group_label'} = $group_label;
 600         $result_group->{'group_merge_key'} = $recid;
 601
 602         my $count = 1;
 603         if (exists $hit->{count}) {
 604             $count = $hit->{count}->[0];
 605         }
 606         $result_group->{'group_count'} = $count;
 607
 608         for (my $i = 0; $i < $count; $i++) {
 609             # FIXME -- may need to worry about diacritics here
 610             my $rec = $paz->record($recid, $i);
 611             push @{ $result_group->{'RECORDS'} }, $rec;
 612         }
 613
 614         push @{ $results_hashref->{'biblioserver'}->{'GROUPS'} }, $result_group;
 615     }
 616
 617     # pass through facets
 618     my $termlist_xml = $paz->termlist('author,subject');
 619     my $terms = XMLin($termlist_xml, forcearray => 1);
 620     my @facets_loop = ();
 621     #die Dumper($results);
 622 #    foreach my $list (sort keys %{ $terms->{'list'} }) {
 623 #        my @facets = ();
 624 #        foreach my $facet (sort @{ $terms->{'list'}->{$list}->{'term'} } ) {
 625 #            push @facets, {
 626 #                facet_label_value => $facet->{'name'}->[0],
 627 #            };
 628 #        }
 629 #        push @facets_loop, ( {
 630 #            type_label => $list,
 631 #            facets => \@facets,
 632 #        } );
 633 #    }
 634
 635     return ( undef, $results_hashref, \@facets_loop );
 636 }
 637
 638 # STOPWORDS
 639 sub _remove_stopwords {
 640     my ( $operand, $index ) = @_;
 641     my @stopwords_removed;
 642
 643     # phrase and exact-qualified indexes shouldn't have stopwords removed
 644     if ( $index !~ m/phr|ext/ ) {
 645
 646 # remove stopwords from operand : parse all stopwords & remove them (case insensitive)
 647 #       we use IsAlpha unicode definition, to deal correctly with diacritics.
 648 #       otherwise, a French word like "leçon" woudl be split into "le" "çon", "le"
 649 #       is a stopword, we'd get "çon" and wouldn't find anything...
 650 #
 651                 foreach ( keys %{ C4::Context->stopwords } ) {
 652                         next if ( $_ =~ /(and|or|not)/ );    # don't remove operators
 653                         if ( my ($matched) = ($operand =~
 654                                 /([^\X\p{isAlnum}]\Q$_\E[^\X\p{isAlnum}]|[^\X\p{isAlnum}]\Q$_\E$|^\Q$_\E[^\X\p{isAlnum}])/gi))
 655                         {
 656                                 $operand =~ s/\Q$matched\E/ /gi;
 657                                 push @stopwords_removed, $_;
 658                         }
 659                 }
 660         }
 661     return ( $operand, \@stopwords_removed );
 662 }
 663
 664 # TRUNCATION
 665 sub _detect_truncation {
 666     my ( $operand, $index ) = @_;
 667     my ( @nontruncated, @righttruncated, @lefttruncated, @rightlefttruncated,
 668         @regexpr );
 669     $operand =~ s/^ //g;
 670     my @wordlist = split( /\s/, $operand );
 671     foreach my $word (@wordlist) {
 672         if ( $word =~ s/^\*([^\*]+)\*$/$1/ ) {
 673             push @rightlefttruncated, $word;
 674         }
 675         elsif ( $word =~ s/^\*([^\*]+)$/$1/ ) {
 676             push @lefttruncated, $word;
 677         }
 678         elsif ( $word =~ s/^([^\*]+)\*$/$1/ ) {
 679             push @righttruncated, $word;
 680         }
 681         elsif ( index( $word, "*" ) < 0 ) {
 682             push @nontruncated, $word;
 683         }
 684         else {
 685             push @regexpr, $word;
 686         }
 687     }
 688     return (
 689         \@nontruncated,       \@righttruncated, \@lefttruncated,
 690         \@rightlefttruncated, \@regexpr
 691     );
 692 }
 693
 694 # STEMMING
 695 sub _build_stemmed_operand {
 696     my ($operand,$lang) = @_;
 697     require Lingua::Stem::Snowball ;
 698     my $stemmed_operand;
 699
 700     # If operand contains a digit, it is almost certainly an identifier, and should
 701     # not be stemmed.  This is particularly relevant for ISBNs and ISSNs, which
 702     # can contain the letter "X" - for example, _build_stemmend_operand would reduce
 703     # "014100018X" to "x ", which for a MARC21 database would bring up irrelevant
 704     # results (e.g., "23 x 29 cm." from the 300$c).  Bug 2098.
 705     return $operand if $operand =~ /\d/;
 706
 707 # FIXME: the locale should be set based on the user's language and/or search choice
 708     #warn "$lang";
 709     my $stemmer = Lingua::Stem::Snowball->new( lang => $lang,
 710                                                encoding => "UTF-8" );
 711
 712     my @words = split( / /, $operand );
 713     my @stems = $stemmer->stem(\@words);
 714     for my $stem (@stems) {
 715         $stemmed_operand .= "$stem";
 716         $stemmed_operand .= "?"
 717           unless ( $stem =~ /(and$|or$|not$)/ ) || ( length($stem) < 3 );
 718         $stemmed_operand .= " ";
 719     }
 720     warn "STEMMED OPERAND: $stemmed_operand" if $DEBUG;
 721     return $stemmed_operand;
 722 }
 723
 724 # FIELD WEIGHTING
 725 sub _build_weighted_query {
 726
 727 # FIELD WEIGHTING - This is largely experimental stuff. What I'm committing works
 728 # pretty well but could work much better if we had a smarter query parser
 729     my ( $operand, $stemmed_operand, $index ) = @_;
 730     my $stemming      = C4::Context->preference("QueryStemming")     || 0;
 731     my $weight_fields = C4::Context->preference("QueryWeightFields") || 0;
 732     my $fuzzy_enabled = C4::Context->preference("QueryFuzzy")        || 0;
 733
 734     my $weighted_query .= "(rk=(";    # Specifies that we're applying rank
 735
 736     # Keyword, or, no index specified
 737     if ( ( $index eq 'kw' ) || ( !$index ) ) {
 738         $weighted_query .=
 739           "Title-cover,ext,r1=\"$operand\"";    # exact title-cover
 740         $weighted_query .= " or ti,ext,r2=\"$operand\"";    # exact title
 741         $weighted_query .= " or ti,phr,r3=\"$operand\"";    # phrase title
 742           #$weighted_query .= " or any,ext,r4=$operand";               # exact any
 743           #$weighted_query .=" or kw,wrdl,r5=\"$operand\"";            # word list any
 744         $weighted_query .= " or wrdl,fuzzy,r8=\"$operand\""
 745           if $fuzzy_enabled;    # add fuzzy, word list
 746         $weighted_query .= " or wrdl,right-Truncation,r9=\"$stemmed_operand\""
 747           if ( $stemming and $stemmed_operand )
 748           ;                     # add stemming, right truncation
 749         $weighted_query .= " or wrdl,r9=\"$operand\"";
 750
 751         # embedded sorting: 0 a-z; 1 z-a
 752         # $weighted_query .= ") or (sort1,aut=1";
 753     }
 754
 755     # Barcode searches should skip this process
 756     elsif ( $index eq 'bc' ) {
 757         $weighted_query .= "bc=\"$operand\"";
 758     }
 759
 760     # Authority-number searches should skip this process
 761     elsif ( $index eq 'an' ) {
 762         $weighted_query .= "an=\"$operand\"";
 763     }
 764
 765     # If the index already has more than one qualifier, wrap the operand
 766     # in quotes and pass it back (assumption is that the user knows what they
 767     # are doing and won't appreciate us mucking up their query
 768     elsif ( $index =~ ',' ) {
 769         $weighted_query .= " $index=\"$operand\"";
 770     }
 771
 772     #TODO: build better cases based on specific search indexes
 773     else {
 774         $weighted_query .= " $index,ext,r1=\"$operand\"";    # exact index
 775           #$weighted_query .= " or (title-sort-az=0 or $index,startswithnt,st-word,r3=$operand #)";
 776         $weighted_query .= " or $index,phr,r3=\"$operand\"";    # phrase index
 777         $weighted_query .=
 778           " or $index,rt,wrdl,r3=\"$operand\"";    # word list index
 779     }
 780
 781     $weighted_query .= "))";                       # close rank specification
 782     return $weighted_query;
 783 }
 784
 785 =head2 getIndexes
 786
 787 Return an array with available indexes.
 788
 789 =cut
 790
 791 sub getIndexes{
 792     my @indexes = (
 793                     # biblio indexes
 794                     'ab',
 795                     'Abstract',
 796                     'acqdate',
 797                     'allrecords',
 798                     'an',
 799                     'Any',
 800                     'at',
 801                     'au',
 802                     'aub',
 803                     'aud',
 804                     'audience',
 805                     'auo',
 806                     'aut',
 807                     'Author',
 808                     'Author-in-order ',
 809                     'Author-personal-bibliography',
 810                     'Authority-Number',
 811                     'authtype',
 812                     'bc',
 813                     'biblionumber',
 814                     'bio',
 815                     'biography',
 816                     'callnum',
 817                     'cfn',
 818                     'Chronological-subdivision',
 819                     'cn-bib-source',
 820                     'cn-bib-sort',
 821                     'cn-class',
 822                     'cn-item',
 823                     'cn-prefix',
 824                     'cn-suffix',
 825                     'cpn',
 826                     'Code-institution',
 827                     'Conference-name',
 828                     'Conference-name-heading',
 829                     'Conference-name-see',
 830                     'Conference-name-seealso',
 831                     'Content-type',
 832                     'Control-number',
 833                     'copydate',
 834                     'Corporate-name',
 835                     'Corporate-name-heading',
 836                     'Corporate-name-see',
 837                     'Corporate-name-seealso',
 838                     'ctype',
 839                     'date-entered-on-file',
 840                     'Date-of-acquisition',
 841                     'Date-of-publication',
 842                     'Dewey-classification',
 843                     'extent',
 844                     'fic',
 845                     'fiction',
 846                     'Form-subdivision',
 847                     'format',
 848                     'Geographic-subdivision',
 849                     'he',
 850                     'Heading',
 851                     'Heading-use-main-or-added-entry',
 852                     'Heading-use-series-added-entry ',
 853                     'Heading-use-subject-added-entry',
 854                     'Host-item',
 855                     'id-other',
 856                     'Illustration-code',
 857                     'ISBN',
 858                     'ISSN',
 859                     'itemtype',
 860                     'kw',
 861                     'Koha-Auth-Number',
 862                     'l-format',
 863                     'language',
 864                     'lc-card',
 865                     'LC-card-number',
 866                     'lcn',
 867                     'llength',
 868                     'ln',
 869                     'Local-classification',
 870                     'Local-number',
 871                     'Match-heading',
 872                     'Match-heading-see-from',
 873                     'Material-type',
 874                     'mc-itemtype',
 875                     'mc-rtype',
 876                     'mus',
 877                     'Name-geographic',
 878                     'Name-geographic-heading',
 879                     'Name-geographic-see',
 880                     'Name-geographic-seealso',
 881                     'nb',
 882                     'Note',
 883                     'ns',
 884                     'nt',
 885                     'pb',
 886                     'Personal-name',
 887                     'Personal-name-heading',
 888                     'Personal-name-see',
 889                     'Personal-name-seealso',
 890                     'pl',
 891                     'Place-publication',
 892                     'pn',
 893                     'popularity',
 894                     'pubdate',
 895                     'Publisher',
 896                     'Record-control-number',
 897                     'rcn',
 898                     'Record-type',
 899                     'rtype',
 900                     'se',
 901                     'See',
 902                     'See-also',
 903                     'sn',
 904                     'Stock-number',
 905                     'su',
 906                     'Subject',
 907                     'Subject-heading-thesaurus',
 908                     'Subject-name-personal',
 909                     'Subject-subdivision',
 910                     'Summary',
 911                     'Suppress',
 912                     'su-geo',
 913                     'su-na',
 914                     'su-to',
 915                     'su-ut',
 916                     'ut',
 917                     'Term-genre-form',
 918                     'Term-genre-form-heading',
 919                     'Term-genre-form-see',
 920                     'Term-genre-form-seealso',
 921                     'ti',
 922                     'Title',
 923                     'Title-cover',
 924                     'Title-series',
 925                     'Title-uniform',
 926                     'Title-uniform-heading',
 927                     'Title-uniform-see',
 928                     'Title-uniform-seealso',
 929                     'totalissues',
 930                     'yr',
 931
 932                     # items indexes
 933                     'acqsource',
 934                     'barcode',
 935                     'bc',
 936                     'branch',
 937                     'ccode',
 938                     'classification-source',
 939                     'cn-sort',
 940                     'coded-location-qualifier',
 941                     'copynumber',
 942                     'damaged',
 943                     'datelastborrowed',
 944                     'datelastseen',
 945                     'holdingbranch',
 946                     'homebranch',
 947                     'issues',
 948                     'item',
 949                     'itemnumber',
 950                     'itype',
 951                     'Local-classification',
 952                     'location',
 953                     'lost',
 954                     'materials-specified',
 955                     'mc-ccode',
 956                     'mc-itype',
 957                     'mc-loc',
 958                     'notforloan',
 959                     'onloan',
 960                     'price',
 961                     'renewals',
 962                     'replacementprice',
 963                     'replacementpricedate',
 964                     'reserves',
 965                     'restricted',
 966                     'stack',
 967                     'uri',
 968                     'withdrawn',
 969
 970                     # subject related
 971                   );
 972
 973     return \@indexes;
 974 }
 975
 976 =head2 buildQuery
 977
 978 ( $error, $query,
 979 $simple_query, $query_cgi,
 980 $query_desc, $limit,
 981 $limit_cgi, $limit_desc,
 982 $stopwords_removed, $query_type ) = buildQuery ( $operators, $operands, $indexes, $limits, $sort_by, $scan, $lang);
 983
 984 Build queries and limits in CCL, CGI, Human,
 985 handle truncation, stemming, field weighting, stopwords, fuzziness, etc.
 986
 987 See verbose embedded documentation.
 988
 989
 990 =cut
 991
 992 sub buildQuery {
 993     my ( $operators, $operands, $indexes, $limits, $sort_by, $scan, $lang) = @_;
 994
 995     warn "---------\nEnter buildQuery\n---------" if $DEBUG;
 996
 997     # dereference
 998     my @operators = $operators ? @$operators : ();
 999     my @indexes   = $indexes   ? @$indexes   : ();
1000     my @operands  = $operands  ? @$operands  : ();
1001     my @limits    = $limits    ? @$limits    : ();
1002     my @sort_by   = $sort_by   ? @$sort_by   : ();
1003
1004     my $stemming         = C4::Context->preference("QueryStemming")        || 0;
1005     my $auto_truncation  = C4::Context->preference("QueryAutoTruncate")    || 0;
1006     my $weight_fields    = C4::Context->preference("QueryWeightFields")    || 0;
1007     my $fuzzy_enabled    = C4::Context->preference("QueryFuzzy")           || 0;
1008     my $remove_stopwords = C4::Context->preference("QueryRemoveStopwords") || 0;
1009
1010     # no stemming/weight/fuzzy in NoZebra
1011     if ( C4::Context->preference("NoZebra") ) {
1012         $stemming         = 0;
1013         $weight_fields    = 0;
1014         $fuzzy_enabled    = 0;
1015         $auto_truncation  = 0;
1016     }
1017
1018     my $query        = $operands[0];
1019     my $simple_query = $operands[0];
1020
1021     # initialize the variables we're passing back
1022     my $query_cgi;
1023     my $query_desc;
1024     my $query_type;
1025
1026     my $limit;
1027     my $limit_cgi;
1028     my $limit_desc;
1029
1030     my $stopwords_removed;    # flag to determine if stopwords have been removed
1031
1032     my $cclq;
1033     my $cclindexes = getIndexes();
1034     if( $query !~ /\s*ccl=/ ){
1035         for my $index (@$cclindexes){
1036             if($query =~ /($index)(,?\w)*[:=]/){
1037                 $cclq = 1;
1038             }
1039         }
1040         $query = "ccl=$query" if($cclq);
1041     }
1042
1043 # for handling ccl, cql, pqf queries in diagnostic mode, skip the rest of the steps
1044 # DIAGNOSTIC ONLY!!
1045     if ( $query =~ /^ccl=/ ) {
1046         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/(?<=(wrdl)):/=/g;
1314     $query =~ s/(?<=(trn|phr)):/=/g;
1315     $limit =~ s/:/=/g;
1316     for ( $query, $query_desc, $limit, $limit_desc ) {
1317         s/  +/ /g;    # remove extra spaces
1318         s/^ //g;     # remove any beginning spaces
1319         s/ $//g;     # remove any ending spaces
1320         s/==/=/g;    # remove double == from query
1321     }
1322     $query_cgi =~ s/^&//; # remove unnecessary & from beginning of the query cgi
1323
1324     for ($query_cgi,$simple_query) {
1325         s/"//g;
1326     }
1327     # append the limit to the query
1328     $query .= " " . $limit;
1329
1330     # Warnings if DEBUG
1331     if ($DEBUG) {
1332         warn "QUERY:" . $query;
1333         warn "QUERY CGI:" . $query_cgi;
1334         warn "QUERY DESC:" . $query_desc;
1335         warn "LIMIT:" . $limit;
1336         warn "LIMIT CGI:" . $limit_cgi;
1337         warn "LIMIT DESC:" . $limit_desc;
1338         warn "---------\nLeave buildQuery\n---------";
1339     }
1340     return (
1341         undef,              $query, $simple_query, $query_cgi,
1342         $query_desc,        $limit, $limit_cgi,    $limit_desc,
1343         $stopwords_removed, $query_type
1344     );
1345 }
1346
1347 =head2 searchResults
1348
1349   my @search_results = searchResults($search_context, $searchdesc, $hits,
1350                                      $results_per_page, $offset, $scan,
1351                                      @marcresults, $hidelostitems);
1352
1353 Format results in a form suitable for passing to the template
1354
1355 =cut
1356
1357 # IMO this subroutine is pretty messy still -- it's responsible for
1358 # building the HTML output for the template
1359 sub searchResults {
1360     my ( $search_context, $searchdesc, $hits, $results_per_page, $offset, $scan, @marcresults, $hidelostitems ) = @_;
1361     my $dbh = C4::Context->dbh;
1362     my @newresults;
1363
1364     $search_context = 'opac' unless $search_context eq 'opac' or $search_context eq 'intranet';
1365
1366     #Build branchnames hash
1367     #find branchname
1368     #get branch information.....
1369     my %branches;
1370     my $bsth =$dbh->prepare("SELECT branchcode,branchname FROM branches"); # FIXME : use C4::Branch::GetBranches
1371     $bsth->execute();
1372     while ( my $bdata = $bsth->fetchrow_hashref ) {
1373         $branches{ $bdata->{'branchcode'} } = $bdata->{'branchname'};
1374     }
1375 # FIXME - We build an authorised values hash here, using the default framework
1376 # though it is possible to have different authvals for different fws.
1377
1378     my $shelflocations =GetKohaAuthorisedValues('items.location','');
1379
1380     # get notforloan authorised value list (see $shelflocations  FIXME)
1381     my $notforloan_authorised_value = GetAuthValCode('items.notforloan','');
1382
1383     #Build itemtype hash
1384     #find itemtype & itemtype image
1385     my %itemtypes;
1386     $bsth =
1387       $dbh->prepare(
1388         "SELECT itemtype,description,imageurl,summary,notforloan FROM itemtypes"
1389       );
1390     $bsth->execute();
1391     while ( my $bdata = $bsth->fetchrow_hashref ) {
1392                 foreach (qw(description imageurl summary notforloan)) {
1393                 $itemtypes{ $bdata->{'itemtype'} }->{$_} = $bdata->{$_};
1394                 }
1395     }
1396
1397     #search item field code
1398     my $sth =
1399       $dbh->prepare(
1400 "SELECT tagfield FROM marc_subfield_structure WHERE kohafield LIKE 'items.itemnumber'"
1401       );
1402     $sth->execute;
1403     my ($itemtag) = $sth->fetchrow;
1404
1405     ## find column names of items related to MARC
1406     my $sth2 = $dbh->prepare("SHOW COLUMNS FROM items");
1407     $sth2->execute;
1408     my %subfieldstosearch;
1409     while ( ( my $column ) = $sth2->fetchrow ) {
1410         my ( $tagfield, $tagsubfield ) =
1411           &GetMarcFromKohaField( "items." . $column, "" );
1412         $subfieldstosearch{$column} = $tagsubfield;
1413     }
1414
1415     # handle which records to actually retrieve
1416     my $times;
1417     if ( $hits && $offset + $results_per_page <= $hits ) {
1418         $times = $offset + $results_per_page;
1419     }
1420     else {
1421         $times = $hits;  # FIXME: if $hits is undefined, why do we want to equal it?
1422     }
1423
1424         my $marcflavour = C4::Context->preference("marcflavour");
1425     # We get the biblionumber position in MARC
1426     my ($bibliotag,$bibliosubf)=GetMarcFromKohaField('biblio.biblionumber','');
1427     my $fw;
1428
1429     # loop through all of the records we've retrieved
1430     for ( my $i = $offset ; $i <= $times - 1 ; $i++ ) {
1431         my $marcrecord = MARC::File::USMARC::decode( $marcresults[$i] );
1432         $fw = $scan
1433              ? undef
1434              : $bibliotag < 10
1435                ? GetFrameworkCode($marcrecord->field($bibliotag)->data)
1436                : GetFrameworkCode($marcrecord->subfield($bibliotag,$bibliosubf));
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} > 0
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             return NZoperatorAND($leftresult,$rightresult);
1919         }
1920         elsif ( $operator eq ' or ' ) {
1921
1922             # just merge the 2 strings
1923             return $leftresult . $rightresult;
1924         }
1925         elsif ( $operator eq ' not ' ) {
1926             return NZoperatorNOT($leftresult,$rightresult);
1927         }
1928         else {
1929
1930 # this error is impossible, because of the regexp that isolate the operand, but just in case...
1931             die "error : operand unknown : $operator for $string";
1932         }
1933
1934         # it's a leaf, do the real SQL query and return the result
1935     }
1936     else {
1937         $string =~ s/__X__/"$commacontent"/ if $commacontent;
1938         $string =~ s/-|\.|\?|,|;|!|'|\(|\)|\[|\]|{|}|"|&|\+|\*|\// /g;
1939         #remove trailing blank at the beginning
1940         $string =~ s/^ //g;
1941         warn "leaf:$string" if $DEBUG;
1942
1943         # parse the string in in operator/operand/value again
1944         my $left = "";
1945         my $operator = "";
1946         my $right = "";
1947         if ($string =~ /(.*)(>=|<=)(.*)/) {
1948             $left     = $1;
1949             $operator = $2;
1950             $right    = $3;
1951         } else {
1952             $left = $string;
1953         }
1954 #         warn "handling leaf... left:$left operator:$operator right:$right"
1955 #           if $DEBUG;
1956         unless ($operator) {
1957             if ($string =~ /(.*)(>|<|=)(.*)/) {
1958                 $left     = $1;
1959                 $operator = $2;
1960                 $right    = $3;
1961                 warn
1962     "handling unless (operator)... left:$left operator:$operator right:$right"
1963                 if $DEBUG;
1964             } else {
1965                 $left = $string;
1966             }
1967         }
1968         my $results;
1969
1970 # strip adv, zebra keywords, currently not handled in nozebra: wrdl, ext, phr...
1971         $left =~ s/ .*$//;
1972
1973         # automatic replace for short operators
1974         $left = 'title'            if $left =~ '^ti$';
1975         $left = 'author'           if $left =~ '^au$';
1976         $left = 'publisher'        if $left =~ '^pb$';
1977         $left = 'subject'          if $left =~ '^su$';
1978         $left = 'koha-Auth-Number' if $left =~ '^an$';
1979         $left = 'keyword'          if $left =~ '^kw$';
1980         $left = 'itemtype'         if $left =~ '^mc$'; # Fix for Bug 2599 - Search limits not working for NoZebra
1981         warn "handling leaf... left:$left operator:$operator right:$right" if $DEBUG;
1982         my $dbh = C4::Context->dbh;
1983         if ( $operator && $left ne 'keyword' ) {
1984             #do a specific search
1985             $operator = 'LIKE' if $operator eq '=' and $right =~ /%/;
1986             my $sth = $dbh->prepare(
1987 "SELECT biblionumbers,value FROM nozebra WHERE server=? AND indexname=? AND value $operator ?"
1988             );
1989             warn "$left / $operator / $right\n" if $DEBUG;
1990
1991             # split each word, query the DB and build the biblionumbers result
1992             #sanitizing leftpart
1993             $left =~ s/^\s+|\s+$//;
1994             foreach ( split / /, $right ) {
1995                 my $biblionumbers;
1996                 $_ =~ s/^\s+|\s+$//;
1997                 next unless $_;
1998                 warn "EXECUTE : $server, $left, $_" if $DEBUG;
1999                 $sth->execute( $server, $left, $_ )
2000                   or warn "execute failed: $!";
2001                 while ( my ( $line, $value ) = $sth->fetchrow ) {
2002
2003 # if we are dealing with a numeric value, use only numeric results (in case of >=, <=, > or <)
2004 # otherwise, fill the result
2005                     $biblionumbers .= $line
2006                       unless ( $right =~ /^\d+$/ && $value =~ /\D/ );
2007                     warn "result : $value "
2008                       . ( $right  =~ /\d/ ) . "=="
2009                       . ( $value =~ /\D/?$line:"" ) if $DEBUG;         #= $line";
2010                 }
2011
2012 # do a AND with existing list if there is one, otherwise, use the biblionumbers list as 1st result list
2013                 if ($results) {
2014                     warn "NZAND" if $DEBUG;
2015                     $results = NZoperatorAND($biblionumbers,$results);
2016                 } else {
2017                     $results = $biblionumbers;
2018                 }
2019             }
2020         }
2021         else {
2022       #do a complete search (all indexes), if index='kw' do complete search too.
2023             my $sth = $dbh->prepare(
2024 "SELECT biblionumbers FROM nozebra WHERE server=? AND value LIKE ?"
2025             );
2026
2027             # split each word, query the DB and build the biblionumbers result
2028             foreach ( split / /, $string ) {
2029                 next if C4::Context->stopwords->{ uc($_) };   # skip if stopword
2030                 warn "search on all indexes on $_" if $DEBUG;
2031                 my $biblionumbers;
2032                 next unless $_;
2033                 $sth->execute( $server, $_ );
2034                 while ( my $line = $sth->fetchrow ) {
2035                     $biblionumbers .= $line;
2036                 }
2037
2038 # do a AND with existing list if there is one, otherwise, use the biblionumbers list as 1st result list
2039                 if ($results) {
2040                     $results = NZoperatorAND($biblionumbers,$results);
2041                 }
2042                 else {
2043                     warn "NEW RES for $_ = $biblionumbers" if $DEBUG;
2044                     $results = $biblionumbers;
2045                 }
2046             }
2047         }
2048         warn "return : $results for LEAF : $string" if $DEBUG;
2049         return $results;
2050     }
2051     warn "---------\nLeave NZanalyse\n---------" if $DEBUG;
2052 }
2053
2054 sub NZoperatorAND{
2055     my ($rightresult, $leftresult)=@_;
2056
2057     my @leftresult = split /;/, $leftresult;
2058     warn " @leftresult / $rightresult \n" if $DEBUG;
2059
2060     #             my @rightresult = split /;/,$leftresult;
2061     my $finalresult;
2062
2063 # parse the left results, and if the biblionumber exist in the right result, save it in finalresult
2064 # the result is stored twice, to have the same weight for AND than OR.
2065 # example : TWO : 61,61,64,121 (two is twice in the biblio #61) / TOWER : 61,64,130
2066 # result : 61,61,61,61,64,64 for two AND tower : 61 has more weight than 64
2067     foreach (@leftresult) {
2068         my $value = $_;
2069         my $countvalue;
2070         ( $value, $countvalue ) = ( $1, $2 ) if ($value=~/(.*)-(\d+)$/);
2071         if ( $rightresult =~ /\Q$value\E-(\d+);/ ) {
2072             $countvalue = ( $1 > $countvalue ? $countvalue : $1 );
2073             $finalresult .=
2074                 "$value-$countvalue;$value-$countvalue;";
2075         }
2076     }
2077     warn "NZAND DONE : $finalresult \n" if $DEBUG;
2078     return $finalresult;
2079 }
2080
2081 sub NZoperatorOR{
2082     my ($rightresult, $leftresult)=@_;
2083     return $rightresult.$leftresult;
2084 }
2085
2086 sub NZoperatorNOT{
2087     my ($leftresult, $rightresult)=@_;
2088
2089     my @leftresult = split /;/, $leftresult;
2090
2091     #             my @rightresult = split /;/,$leftresult;
2092     my $finalresult;
2093     foreach (@leftresult) {
2094         my $value=$_;
2095         $value=$1 if $value=~m/(.*)-\d+$/;
2096         unless ($rightresult =~ "$value-") {
2097             $finalresult .= "$_;";
2098         }
2099     }
2100     return $finalresult;
2101 }
2102
2103 =head2 NZorder
2104
2105   $finalresult = NZorder($biblionumbers, $ordering,$results_per_page,$offset);
2106
2107   TODO :: Description
2108
2109 =cut
2110
2111 sub NZorder {
2112     my ( $biblionumbers, $ordering, $results_per_page, $offset ) = @_;
2113     warn "biblionumbers = $biblionumbers and ordering = $ordering\n" if $DEBUG;
2114
2115     # order title asc by default
2116     #     $ordering = '1=36 <i' unless $ordering;
2117     $results_per_page = 20 unless $results_per_page;
2118     $offset           = 0  unless $offset;
2119     my $dbh = C4::Context->dbh;
2120
2121     #
2122     # order by POPULARITY
2123     #
2124     if ( $ordering =~ /popularity/ ) {
2125         my %result;
2126         my %popularity;
2127
2128         # popularity is not in MARC record, it's builded from a specific query
2129         my $sth =
2130           $dbh->prepare("select sum(issues) from items where biblionumber=?");
2131         foreach ( split /;/, $biblionumbers ) {
2132             my ( $biblionumber, $title ) = split /,/, $_;
2133             $result{$biblionumber} = GetMarcBiblio($biblionumber);
2134             $sth->execute($biblionumber);
2135             my $popularity = $sth->fetchrow || 0;
2136
2137 # hint : the key is popularity.title because we can have
2138 # many results with the same popularity. In this case, sub-ordering is done by title
2139 # we also have biblionumber to avoid bug for 2 biblios with the same title & popularity
2140 # (un-frequent, I agree, but we won't forget anything that way ;-)
2141             $popularity{ sprintf( "%10d", $popularity ) . $title
2142                   . $biblionumber } = $biblionumber;
2143         }
2144
2145     # sort the hash and return the same structure as GetRecords (Zebra querying)
2146         my $result_hash;
2147         my $numbers = 0;
2148         if ( $ordering eq 'popularity_dsc' ) {    # sort popularity DESC
2149             foreach my $key ( sort { $b cmp $a } ( keys %popularity ) ) {
2150                 $result_hash->{'RECORDS'}[ $numbers++ ] =
2151                   $result{ $popularity{$key} }->as_usmarc();
2152             }
2153         }
2154         else {                                    # sort popularity ASC
2155             foreach my $key ( sort ( keys %popularity ) ) {
2156                 $result_hash->{'RECORDS'}[ $numbers++ ] =
2157                   $result{ $popularity{$key} }->as_usmarc();
2158             }
2159         }
2160         my $finalresult = ();
2161         $result_hash->{'hits'}         = $numbers;
2162         $finalresult->{'biblioserver'} = $result_hash;
2163         return $finalresult;
2164
2165         #
2166         # ORDER BY author
2167         #
2168     }
2169     elsif ( $ordering =~ /author/ ) {
2170         my %result;
2171         foreach ( split /;/, $biblionumbers ) {
2172             my ( $biblionumber, $title ) = split /,/, $_;
2173             my $record = GetMarcBiblio($biblionumber);
2174             my $author;
2175             if ( C4::Context->preference('marcflavour') eq 'UNIMARC' ) {
2176                 $author = $record->subfield( '200', 'f' );
2177                 $author = $record->subfield( '700', 'a' ) unless $author;
2178             }
2179             else {
2180                 $author = $record->subfield( '100', 'a' );
2181             }
2182
2183 # hint : the result is sorted by title.biblionumber because we can have X biblios with the same title
2184 # and we don't want to get only 1 result for each of them !!!
2185             $result{ $author . $biblionumber } = $record;
2186         }
2187
2188     # sort the hash and return the same structure as GetRecords (Zebra querying)
2189         my $result_hash;
2190         my $numbers = 0;
2191         if ( $ordering eq 'author_za' ) {    # sort by author desc
2192             foreach my $key ( sort { $b cmp $a } ( keys %result ) ) {
2193                 $result_hash->{'RECORDS'}[ $numbers++ ] =
2194                   $result{$key}->as_usmarc();
2195             }
2196         }
2197         else {                               # sort by author ASC
2198             foreach my $key ( sort ( keys %result ) ) {
2199                 $result_hash->{'RECORDS'}[ $numbers++ ] =
2200                   $result{$key}->as_usmarc();
2201             }
2202         }
2203         my $finalresult = ();
2204         $result_hash->{'hits'}         = $numbers;
2205         $finalresult->{'biblioserver'} = $result_hash;
2206         return $finalresult;
2207
2208         #
2209         # ORDER BY callnumber
2210         #
2211     }
2212     elsif ( $ordering =~ /callnumber/ ) {
2213         my %result;
2214         foreach ( split /;/, $biblionumbers ) {
2215             my ( $biblionumber, $title ) = split /,/, $_;
2216             my $record = GetMarcBiblio($biblionumber);
2217             my $callnumber;
2218             my $frameworkcode = GetFrameworkCode($biblionumber);
2219             my ( $callnumber_tag, $callnumber_subfield ) = GetMarcFromKohaField(  'items.itemcallnumber', $frameworkcode);
2220                ( $callnumber_tag, $callnumber_subfield ) = GetMarcFromKohaField('biblioitems.callnumber', $frameworkcode)
2221                 unless $callnumber_tag;
2222             if ( C4::Context->preference('marcflavour') eq 'UNIMARC' ) {
2223                 $callnumber = $record->subfield( '200', 'f' );
2224             } else {
2225                 $callnumber = $record->subfield( '100', 'a' );
2226             }
2227
2228 # hint : the result is sorted by title.biblionumber because we can have X biblios with the same title
2229 # and we don't want to get only 1 result for each of them !!!
2230             $result{ $callnumber . $biblionumber } = $record;
2231         }
2232
2233     # sort the hash and return the same structure as GetRecords (Zebra querying)
2234         my $result_hash;
2235         my $numbers = 0;
2236         if ( $ordering eq 'call_number_dsc' ) {    # sort by title desc
2237             foreach my $key ( sort { $b cmp $a } ( keys %result ) ) {
2238                 $result_hash->{'RECORDS'}[ $numbers++ ] =
2239                   $result{$key}->as_usmarc();
2240             }
2241         }
2242         else {                                     # sort by title ASC
2243             foreach my $key ( sort { $a cmp $b } ( keys %result ) ) {
2244                 $result_hash->{'RECORDS'}[ $numbers++ ] =
2245                   $result{$key}->as_usmarc();
2246             }
2247         }
2248         my $finalresult = ();
2249         $result_hash->{'hits'}         = $numbers;
2250         $finalresult->{'biblioserver'} = $result_hash;
2251         return $finalresult;
2252     }
2253     elsif ( $ordering =~ /pubdate/ ) {             #pub year
2254         my %result;
2255         foreach ( split /;/, $biblionumbers ) {
2256             my ( $biblionumber, $title ) = split /,/, $_;
2257             my $record = GetMarcBiblio($biblionumber);
2258             my ( $publicationyear_tag, $publicationyear_subfield ) =
2259               GetMarcFromKohaField( 'biblioitems.publicationyear', '' );
2260             my $publicationyear =
2261               $record->subfield( $publicationyear_tag,
2262                 $publicationyear_subfield );
2263
2264 # hint : the result is sorted by title.biblionumber because we can have X biblios with the same title
2265 # and we don't want to get only 1 result for each of them !!!
2266             $result{ $publicationyear . $biblionumber } = $record;
2267         }
2268
2269     # sort the hash and return the same structure as GetRecords (Zebra querying)
2270         my $result_hash;
2271         my $numbers = 0;
2272         if ( $ordering eq 'pubdate_dsc' ) {    # sort by pubyear desc
2273             foreach my $key ( sort { $b cmp $a } ( keys %result ) ) {
2274                 $result_hash->{'RECORDS'}[ $numbers++ ] =
2275                   $result{$key}->as_usmarc();
2276             }
2277         }
2278         else {                                 # sort by pub year ASC
2279             foreach my $key ( sort ( keys %result ) ) {
2280                 $result_hash->{'RECORDS'}[ $numbers++ ] =
2281                   $result{$key}->as_usmarc();
2282             }
2283         }
2284         my $finalresult = ();
2285         $result_hash->{'hits'}         = $numbers;
2286         $finalresult->{'biblioserver'} = $result_hash;
2287         return $finalresult;
2288
2289         #
2290         # ORDER BY title
2291         #
2292     }
2293     elsif ( $ordering =~ /title/ ) {
2294
2295 # the title is in the biblionumbers string, so we just need to build a hash, sort it and return
2296         my %result;
2297         foreach ( split /;/, $biblionumbers ) {
2298             my ( $biblionumber, $title ) = split /,/, $_;
2299
2300 # hint : the result is sorted by title.biblionumber because we can have X biblios with the same title
2301 # and we don't want to get only 1 result for each of them !!!
2302 # hint & speed improvement : we can order without reading the record
2303 # so order, and read records only for the requested page !
2304             $result{ $title . $biblionumber } = $biblionumber;
2305         }
2306
2307     # sort the hash and return the same structure as GetRecords (Zebra querying)
2308         my $result_hash;
2309         my $numbers = 0;
2310         if ( $ordering eq 'title_az' ) {    # sort by title desc
2311             foreach my $key ( sort ( keys %result ) ) {
2312                 $result_hash->{'RECORDS'}[ $numbers++ ] = $result{$key};
2313             }
2314         }
2315         else {                              # sort by title ASC
2316             foreach my $key ( sort { $b cmp $a } ( keys %result ) ) {
2317                 $result_hash->{'RECORDS'}[ $numbers++ ] = $result{$key};
2318             }
2319         }
2320
2321         # limit the $results_per_page to result size if it's more
2322         $results_per_page = $numbers - 1 if $numbers < $results_per_page;
2323
2324         # for the requested page, replace biblionumber by the complete record
2325         # speed improvement : avoid reading too much things
2326         for (
2327             my $counter = $offset ;
2328             $counter <= $offset + $results_per_page ;
2329             $counter++
2330           )
2331         {
2332             $result_hash->{'RECORDS'}[$counter] =
2333               GetMarcBiblio( $result_hash->{'RECORDS'}[$counter] )->as_usmarc;
2334         }
2335         my $finalresult = ();
2336         $result_hash->{'hits'}         = $numbers;
2337         $finalresult->{'biblioserver'} = $result_hash;
2338         return $finalresult;
2339     }
2340     else {
2341
2342 #
2343 # order by ranking
2344 #
2345 # we need 2 hashes to order by ranking : the 1st one to count the ranking, the 2nd to order by ranking
2346         my %result;
2347         my %count_ranking;
2348         foreach ( split /;/, $biblionumbers ) {
2349             my ( $biblionumber, $title ) = split /,/, $_;
2350             $title =~ /(.*)-(\d)/;
2351
2352             # get weight
2353             my $ranking = $2;
2354
2355 # note that we + the ranking because ranking is calculated on weight of EACH term requested.
2356 # if we ask for "two towers", and "two" has weight 2 in biblio N, and "towers" has weight 4 in biblio N
2357 # biblio N has ranking = 6
2358             $count_ranking{$biblionumber} += $ranking;
2359         }
2360
2361 # build the result by "inverting" the count_ranking hash
2362 # 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
2363 #         warn "counting";
2364         foreach ( keys %count_ranking ) {
2365             $result{ sprintf( "%10d", $count_ranking{$_} ) . '-' . $_ } = $_;
2366         }
2367
2368     # sort the hash and return the same structure as GetRecords (Zebra querying)
2369         my $result_hash;
2370         my $numbers = 0;
2371         foreach my $key ( sort { $b cmp $a } ( keys %result ) ) {
2372             $result_hash->{'RECORDS'}[ $numbers++ ] = $result{$key};
2373         }
2374
2375         # limit the $results_per_page to result size if it's more
2376         $results_per_page = $numbers - 1 if $numbers < $results_per_page;
2377
2378         # for the requested page, replace biblionumber by the complete record
2379         # speed improvement : avoid reading too much things
2380         for (
2381             my $counter = $offset ;
2382             $counter <= $offset + $results_per_page ;
2383             $counter++
2384           )
2385         {
2386             $result_hash->{'RECORDS'}[$counter] =
2387               GetMarcBiblio( $result_hash->{'RECORDS'}[$counter] )->as_usmarc
2388               if $result_hash->{'RECORDS'}[$counter];
2389         }
2390         my $finalresult = ();
2391         $result_hash->{'hits'}         = $numbers;
2392         $finalresult->{'biblioserver'} = $result_hash;
2393         return $finalresult;
2394     }
2395 }
2396
2397 =head2 enabled_staff_search_views
2398
2399 %hash = enabled_staff_search_views()
2400
2401 This function returns a hash that contains three flags obtained from the system
2402 preferences, used to determine whether a particular staff search results view
2403 is enabled.
2404
2405 =over 2
2406
2407 =item C<Output arg:>
2408
2409     * $hash{can_view_MARC} is true only if the MARC view is enabled
2410     * $hash{can_view_ISBD} is true only if the ISBD view is enabled
2411     * $hash{can_view_labeledMARC} is true only if the Labeled MARC view is enabled
2412
2413 =item C<usage in the script:>
2414
2415 =back
2416
2417 $template->param ( C4::Search::enabled_staff_search_views );
2418
2419 =cut
2420
2421 sub enabled_staff_search_views
2422 {
2423         return (
2424                 can_view_MARC                   => C4::Context->preference('viewMARC'),                 # 1 if the staff search allows the MARC view
2425                 can_view_ISBD                   => C4::Context->preference('viewISBD'),                 # 1 if the staff search allows the ISBD view
2426                 can_view_labeledMARC    => C4::Context->preference('viewLabeledMARC'),  # 1 if the staff search allows the Labeled MARC view
2427         );
2428 }
2429
2430 sub AddSearchHistory{
2431         my ($borrowernumber,$session,$query_desc,$query_cgi, $total)=@_;
2432     my $dbh = C4::Context->dbh;
2433
2434     # Add the request the user just made
2435     my $sql = "INSERT INTO search_history(userid, sessionid, query_desc, query_cgi, total, time) VALUES(?, ?, ?, ?, ?, NOW())";
2436     my $sth   = $dbh->prepare($sql);
2437     $sth->execute($borrowernumber, $session, $query_desc, $query_cgi, $total);
2438         return $dbh->last_insert_id(undef, 'search_history', undef,undef,undef);
2439 }
2440
2441 sub GetSearchHistory{
2442         my ($borrowernumber,$session)=@_;
2443     my $dbh = C4::Context->dbh;
2444
2445     # Add the request the user just made
2446     my $query = "SELECT FROM search_history WHERE (userid=? OR sessionid=?)";
2447     my $sth   = $dbh->prepare($query);
2448         $sth->execute($borrowernumber, $session);
2449     return  $sth->fetchall_hashref({});
2450 }
2451
2452 =head2 z3950_search_args
2453
2454 $arrayref = z3950_search_args($matchpoints)
2455
2456 This function returns an array reference that contains the search parameters to be
2457 passed to the Z39.50 search script (z3950_search.pl). The array elements
2458 are hash refs whose keys are name, value and encvalue, and whose values are the
2459 name of a search parameter, the value of that search parameter and the URL encoded
2460 value of that parameter.
2461
2462 The search parameter names are lccn, isbn, issn, title, author, dewey and subject.
2463
2464 The search parameter values are obtained from the bibliographic record whose
2465 data is in a hash reference in $matchpoints, as returned by Biblio::GetBiblioData().
2466
2467 If $matchpoints is a scalar, it is assumed to be an unnamed query descriptor, e.g.
2468 a general purpose search argument. In this case, the returned array contains only
2469 entry: the key is 'title' and the value and encvalue are derived from $matchpoints.
2470
2471 If a search parameter value is undefined or empty, it is not included in the returned
2472 array.
2473
2474 The returned array reference may be passed directly to the template parameters.
2475
2476 =over 2
2477
2478 =item C<Output arg:>
2479
2480     * $array containing hash refs as described above
2481
2482 =item C<usage in the script:>
2483
2484 =back
2485
2486 $data = Biblio::GetBiblioData($bibno);
2487 $template->param ( MYLOOP => C4::Search::z3950_search_args($data) )
2488
2489 *OR*
2490
2491 $template->param ( MYLOOP => C4::Search::z3950_search_args($searchscalar) )
2492
2493 =cut
2494
2495 sub z3950_search_args {
2496     my $bibrec = shift;
2497     $bibrec = { title => $bibrec } if !ref $bibrec;
2498     my $array = [];
2499     for my $field (qw/ lccn isbn issn title author dewey subject /)
2500     {
2501         my $encvalue = URI::Escape::uri_escape_utf8($bibrec->{$field});
2502         push @$array, { name=>$field, value=>$bibrec->{$field}, encvalue=>$encvalue } if defined $bibrec->{$field};
2503     }
2504     return $array;
2505 }
2506
2507 =head2 BiblioAddAuthorities
2508
2509 ( $countlinked, $countcreated ) = BiblioAddAuthorities($record, $frameworkcode);
2510
2511 this function finds the authorities linked to the biblio
2512     * search in the authority DB for the same authid (in $9 of the biblio)
2513     * search in the authority DB for the same 001 (in $3 of the biblio in UNIMARC)
2514     * search in the authority DB for the same values (exactly) (in all subfields of the biblio)
2515 OR adds a new authority record
2516
2517 =over 2
2518
2519 =item C<input arg:>
2520
2521     * $record is the MARC record in question (marc blob)
2522     * $frameworkcode is the bibliographic framework to use (if it is "" it uses the default framework)
2523
2524 =item C<Output arg:>
2525
2526     * $countlinked is the number of authorities records that are linked to this authority
2527     * $countcreated
2528
2529 =item C<BUGS>
2530     * 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)
2531
2532 =back
2533
2534 =cut
2535
2536
2537 sub BiblioAddAuthorities{
2538   my ( $record, $frameworkcode ) = @_;
2539   my $dbh=C4::Context->dbh;
2540   my $query=$dbh->prepare(qq|
2541 SELECT authtypecode,tagfield
2542 FROM marc_subfield_structure
2543 WHERE frameworkcode=?
2544 AND (authtypecode IS NOT NULL AND authtypecode<>\"\")|);
2545 # SELECT authtypecode,tagfield
2546 # FROM marc_subfield_structure
2547 # WHERE frameworkcode=?
2548 # AND (authtypecode IS NOT NULL OR authtypecode<>\"\")|);
2549   $query->execute($frameworkcode);
2550   my ($countcreated,$countlinked);
2551   while (my $data=$query->fetchrow_hashref){
2552     foreach my $field ($record->field($data->{tagfield})){
2553       next if ($field->subfield('3')||$field->subfield('9'));
2554       # No authorities id in the tag.
2555       # Search if there is any authorities to link to.
2556       my $query='at='.$data->{authtypecode}.' ';
2557       map {$query.= ' and he,ext="'.$_->[1].'"' if ($_->[0]=~/[A-z]/)}  $field->subfields();
2558       my ($error, $results, $total_hits)=SimpleSearch( $query, undef, undef, [ "authorityserver" ] );
2559     # there is only 1 result
2560           if ( $error ) {
2561         warn "BIBLIOADDSAUTHORITIES: $error";
2562             return (0,0) ;
2563           }
2564       if ($results && scalar(@$results)==1) {
2565         my $marcrecord = MARC::File::USMARC::decode($results->[0]);
2566         $field->add_subfields('9'=>$marcrecord->field('001')->data);
2567         $countlinked++;
2568       } elsif (scalar(@$results)>1) {
2569    #More than One result
2570    #This can comes out of a lack of a subfield.
2571 #         my $marcrecord = MARC::File::USMARC::decode($results->[0]);
2572 #         $record->field($data->{tagfield})->add_subfields('9'=>$marcrecord->field('001')->data);
2573   $countlinked++;
2574       } else {
2575   #There are no results, build authority record, add it to Authorities, get authid and add it to 9
2576   ###NOTICE : This is only valid if a subfield is linked to one and only one authtypecode
2577   ###NOTICE : This can be a problem. We should also look into other types and rejected forms.
2578          my $authtypedata=C4::AuthoritiesMarc::GetAuthType($data->{authtypecode});
2579          next unless $authtypedata;
2580          my $marcrecordauth=MARC::Record->new();
2581          my $authfield=MARC::Field->new($authtypedata->{auth_tag_to_report},'','',"a"=>"".$field->subfield('a'));
2582          map { $authfield->add_subfields($_->[0]=>$_->[1]) if ($_->[0]=~/[A-z]/ && $_->[0] ne "a" )}  $field->subfields();
2583          $marcrecordauth->insert_fields_ordered($authfield);
2584
2585          # bug 2317: ensure new authority knows it's using UTF-8; currently
2586          # only need to do this for MARC21, as MARC::Record->as_xml_record() handles
2587          # automatically for UNIMARC (by not transcoding)
2588          # FIXME: AddAuthority() instead should simply explicitly require that the MARC::Record
2589          # use UTF-8, but as of 2008-08-05, did not want to introduce that kind
2590          # of change to a core API just before the 3.0 release.
2591          if (C4::Context->preference('marcflavour') eq 'MARC21') {
2592             SetMarcUnicodeFlag($marcrecordauth, 'MARC21');
2593          }
2594
2595 #          warn "AUTH RECORD ADDED : ".$marcrecordauth->as_formatted;
2596
2597          my $authid=AddAuthority($marcrecordauth,'',$data->{authtypecode});
2598          $countcreated++;
2599          $field->add_subfields('9'=>$authid);
2600       }
2601     }
2602   }
2603   return ($countlinked,$countcreated);
2604 }
2605
2606 =head2 GetDistinctValues($field);
2607
2608 C<$field> is a reference to the fields array
2609
2610 =cut
2611
2612 sub GetDistinctValues {
2613     my ($fieldname,$string)=@_;
2614     # returns a reference to a hash of references to branches...
2615     if ($fieldname=~/\./){
2616                         my ($table,$column)=split /\./, $fieldname;
2617                         my $dbh = C4::Context->dbh;
2618                         warn "select DISTINCT($column) as value, count(*) as cnt from $table group by lib order by $column " if $DEBUG;
2619                         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 ");
2620                         $sth->execute;
2621                         my $elements=$sth->fetchall_arrayref({});
2622                         return $elements;
2623    }
2624    else {
2625                 $string||= qq("");
2626                 my @servers=qw<biblioserver authorityserver>;
2627                 my (@zconns,@results);
2628         for ( my $i = 0 ; $i < @servers ; $i++ ) {
2629                 $zconns[$i] = C4::Context->Zconn( $servers[$i], 1 );
2630                         $results[$i] =
2631                       $zconns[$i]->scan(
2632                         ZOOM::Query::CCL2RPN->new( qq"$fieldname $string", $zconns[$i])
2633                       );
2634                 }
2635                 # The big moment: asynchronously retrieve results from all servers
2636                 my @elements;
2637                 while ( ( my $i = ZOOM::event( \@zconns ) ) != 0 ) {
2638                         my $ev = $zconns[ $i - 1 ]->last_event();
2639                         if ( $ev == ZOOM::Event::ZEND ) {
2640                                 next unless $results[ $i - 1 ];
2641                                 my $size = $results[ $i - 1 ]->size();
2642                                 if ( $size > 0 ) {
2643                       for (my $j=0;$j<$size;$j++){
2644                                                 my %hashscan;
2645                                                 @hashscan{qw(value cnt)}=$results[ $i - 1 ]->display_term($j);
2646                                                 push @elements, \%hashscan;
2647                                           }
2648                                 }
2649                         }
2650                 }
2651                 return \@elements;
2652    }
2653 }
2654
2655
2656 END { }    # module clean-up code here (global destructor)
2657
2658 1;
2659 __END__
2660
2661 =head1 AUTHOR
2662
2663 Koha Development Team <http://koha-community.org/>
2664
2665 =cut