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