C4/Search.pm

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