C4/Search.pm

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