C4/Search.pm

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