koha-dev.rot13.org Git - koha_gimpoz/blob - 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 =
1241           MARC::Record::new_from_xml( $marcresults[$i], "utf8", $marcflavour );
1242         my $oldbiblio = TransformMarcToKoha( $dbh, $marcrecord, '' );
1243         $oldbiblio->{subtitle} = C4::Biblio::get_koha_field_from_marc('bibliosubtitle', 'subtitle', $marcrecord, '');
1244         $oldbiblio->{result_number} = $i + 1;
1245
1246         # add imageurl to itemtype if there is one
1247         $oldbiblio->{imageurl} = getitemtypeimagelocation( 'opac', $itemtypes{ $oldbiblio->{itemtype} }->{imageurl} );
1248
1249         $oldbiblio->{'authorised_value_images'}  = C4::Items::get_authorised_value_images( C4::Biblio::get_biblio_authorised_values( $oldbiblio->{'biblionumber'}, $marcrecord ) );
1250                 $oldbiblio->{normalized_upc} = GetNormalizedUPC($marcrecord,$marcflavour);
1251                 $oldbiblio->{normalized_ean} = GetNormalizedEAN($marcrecord,$marcflavour);
1252                 $oldbiblio->{normalized_oclc} = GetNormalizedOCLCNumber($marcrecord,$marcflavour);
1253                 $oldbiblio->{normalized_isbn} = GetNormalizedISBN(undef,$marcrecord,$marcflavour);
1254                 $oldbiblio->{content_identifier_exists} = 1 if ($oldbiblio->{normalized_isbn} or $oldbiblio->{normalized_oclc} or $oldbiblio->{normalized_ean} or $oldbiblio->{normalized_upc});
1255
1256                 # edition information, if any
1257         $oldbiblio->{edition} = $oldbiblio->{editionstatement};
1258                 $oldbiblio->{description} = $itemtypes{ $oldbiblio->{itemtype} }->{description};
1259  # Build summary if there is one (the summary is defined in the itemtypes table)
1260  # FIXME: is this used anywhere, I think it can be commented out? -- JF
1261         if ( $itemtypes{ $oldbiblio->{itemtype} }->{summary} ) {
1262             my $summary = $itemtypes{ $oldbiblio->{itemtype} }->{summary};
1263             my @fields  = $marcrecord->fields();
1264             foreach my $field (@fields) {
1265                 my $tag      = $field->tag();
1266                 my $tagvalue = $field->as_string();
1267                 $summary =~
1268                   s/\[(.?.?.?.?)$tag\*(.*?)]/$1$tagvalue$2\[$1$tag$2]/g;
1269                 unless ( $tag < 10 ) {
1270                     my @subf = $field->subfields;
1271                     for my $i ( 0 .. $#subf ) {
1272                         my $subfieldcode  = $subf[$i][0];
1273                         my $subfieldvalue = $subf[$i][1];
1274                         my $tagsubf       = $tag . $subfieldcode;
1275                         $summary =~
1276 s/\[(.?.?.?.?)$tagsubf(.*?)]/$1$subfieldvalue$2\[$1$tagsubf$2]/g;
1277                     }
1278                 }
1279             }
1280             # FIXME: yuk
1281             $summary =~ s/\[(.*?)]//g;
1282             $summary =~ s/\n/<br\/>/g;
1283             $oldbiblio->{summary} = $summary;
1284         }
1285
1286         # save an author with no <span> tag, for the <a href=search.pl?q=<!--tmpl_var name="author"-->> link
1287         $oldbiblio->{'author_nospan'} = $oldbiblio->{'author'};
1288         $oldbiblio->{'title_nospan'} = $oldbiblio->{'title'};
1289         $oldbiblio->{'subtitle_nospan'} = $oldbiblio->{'subtitle'};
1290         # Add search-term highlighting to the whole record where they match using <span>s
1291         if (C4::Context->preference("OpacHighlightedWords")){
1292             my $searchhighlightblob;
1293             for my $highlight_field ( $marcrecord->fields ) {
1294
1295     # FIXME: need to skip title, subtitle, author, etc., as they are handled below
1296                 next if $highlight_field->tag() =~ /(^00)/;    # skip fixed fields
1297                 for my $subfield ($highlight_field->subfields()) {
1298                     my $match;
1299                     next if $subfield->[0] eq '9';
1300                     my $field = $subfield->[1];
1301                     for my $term ( keys %$span_terms_hashref ) {
1302                         if ( ( $field =~ /$term/i ) && (( length($term) > 3 ) || ($field =~ / $term /i)) ) {
1303                             $field =~ s/$term/<span class=\"term\">$&<\/span>/gi;
1304                         $match++;
1305                         }
1306                     }
1307                     $searchhighlightblob .= $field . " ... " if $match;
1308                 }
1309
1310             }
1311             $searchhighlightblob = ' ... '.$searchhighlightblob if $searchhighlightblob;
1312             $oldbiblio->{'searchhighlightblob'} = $searchhighlightblob;
1313         }
1314
1315         # Add search-term highlighting to the title, subtitle, etc. fields
1316         for my $term ( keys %$span_terms_hashref ) {
1317             my $old_term = $term;
1318             if ( length($term) > 3 ) {
1319                 $term =~ s/(.*=|\)|\(|\+|\.|\?|\[|\]|\\|\*)//g;
1320                                 foreach(qw(title subtitle author publishercode place pages notes size)) {
1321                         $oldbiblio->{$_} =~ s/$term/<span class=\"term\">$&<\/span>/gi;
1322                                 }
1323             }
1324         }
1325
1326         ($i % 2) and $oldbiblio->{'toggle'} = 1;
1327
1328         # Pull out the items fields
1329         my @fields = $marcrecord->field($itemtag);
1330
1331         # Setting item statuses for display
1332         my @available_items_loop;
1333         my @onloan_items_loop;
1334         my @other_items_loop;
1335
1336         my $available_items;
1337         my $onloan_items;
1338         my $other_items;
1339
1340         my $ordered_count         = 0;
1341         my $available_count       = 0;
1342         my $onloan_count          = 0;
1343         my $longoverdue_count     = 0;
1344         my $other_count           = 0;
1345         my $wthdrawn_count        = 0;
1346         my $itemlost_count        = 0;
1347         my $itembinding_count     = 0;
1348         my $itemdamaged_count     = 0;
1349         my $item_in_transit_count = 0;
1350         my $can_place_holds       = 0;
1351         my $items_count           = scalar(@fields);
1352         my $maxitems =
1353           ( C4::Context->preference('maxItemsinSearchResults') )
1354           ? C4::Context->preference('maxItemsinSearchResults') - 1
1355           : 1;
1356
1357         # loop through every item
1358         foreach my $field (@fields) {
1359             my $item;
1360
1361             # populate the items hash
1362             foreach my $code ( keys %subfieldstosearch ) {
1363                 $item->{$code} = $field->subfield( $subfieldstosearch{$code} );
1364             }
1365                         my $hbranch     = C4::Context->preference('HomeOrHoldingBranch') eq 'homebranch' ? 'homebranch'    : 'holdingbranch';
1366                         my $otherbranch = C4::Context->preference('HomeOrHoldingBranch') eq 'homebranch' ? 'holdingbranch' : 'homebranch';
1367             # set item's branch name, use HomeOrHoldingBranch syspref first, fall back to the other one
1368             if ($item->{$hbranch}) {
1369                 $item->{'branchname'} = $branches{$item->{$hbranch}};
1370             }
1371             elsif ($item->{$otherbranch}) {     # Last resort
1372                 $item->{'branchname'} = $branches{$item->{$otherbranch}};
1373             }
1374
1375                         my $prefix = $item->{$hbranch} . '--' . $item->{location} . $item->{itype} . $item->{itemcallnumber};
1376 # For each grouping of items (onloan, available, unavailable), we build a key to store relevant info about that item
1377             if ( $item->{onloan} ) {
1378                 $onloan_count++;
1379                                 my $key = $prefix . $item->{onloan} . $item->{barcode};
1380                                 $onloan_items->{$key}->{due_date} = format_date($item->{onloan});
1381                                 $onloan_items->{$key}->{count}++ if $item->{$hbranch};
1382                                 $onloan_items->{$key}->{branchname} = $item->{branchname};
1383                                 $onloan_items->{$key}->{location} = $shelflocations->{ $item->{location} };
1384                                 $onloan_items->{$key}->{itemcallnumber} = $item->{itemcallnumber};
1385                                 $onloan_items->{$key}->{imageurl} = getitemtypeimagelocation( 'opac', $itemtypes{ $item->{itype} }->{imageurl} );
1386                 # if something's checked out and lost, mark it as 'long overdue'
1387                 if ( $item->{itemlost} ) {
1388                     $onloan_items->{$prefix}->{longoverdue}++;
1389                     $longoverdue_count++;
1390                 } else {        # can place holds as long as item isn't lost
1391                     $can_place_holds = 1;
1392                 }
1393             }
1394
1395          # items not on loan, but still unavailable ( lost, withdrawn, damaged )
1396             else {
1397
1398                 # item is on order
1399                 if ( $item->{notforloan} == -1 ) {
1400                     $ordered_count++;
1401                 }
1402
1403                 # is item in transit?
1404                 my $transfertwhen = '';
1405                 my ($transfertfrom, $transfertto);
1406
1407                 unless ($item->{wthdrawn}
1408                         || $item->{itemlost}
1409                         || $item->{damaged}
1410                         || $item->{notforloan}
1411                         || $items_count > 20) {
1412
1413                     # A couple heuristics to limit how many times
1414                     # we query the database for item transfer information, sacrificing
1415                     # accuracy in some cases for speed;
1416                     #
1417                     # 1. don't query if item has one of the other statuses
1418                     # 2. don't check transit status if the bib has
1419                     #    more than 20 items
1420                     #
1421                     # FIXME: to avoid having the query the database like this, and to make
1422                     #        the in transit status count as unavailable for search limiting,
1423                     #        should map transit status to record indexed in Zebra.
1424                     #
1425                     ($transfertwhen, $transfertfrom, $transfertto) = C4::Circulation::GetTransfers($item->{itemnumber});
1426                 }
1427
1428                 # item is withdrawn, lost or damaged
1429                 if (   $item->{wthdrawn}
1430                     || $item->{itemlost}
1431                     || $item->{damaged}
1432                     || $item->{notforloan}
1433                     || ($transfertwhen ne ''))
1434                 {
1435                     $wthdrawn_count++        if $item->{wthdrawn};
1436                     $itemlost_count++        if $item->{itemlost};
1437                     $itemdamaged_count++     if $item->{damaged};
1438                     $item_in_transit_count++ if $transfertwhen ne '';
1439                     $item->{status} = $item->{wthdrawn} . "-" . $item->{itemlost} . "-" . $item->{damaged} . "-" . $item->{notforloan};
1440                     $other_count++;
1441
1442                                         my $key = $prefix . $item->{status};
1443                                         foreach (qw(wthdrawn itemlost damaged branchname itemcallnumber)) {
1444                         $other_items->{$key}->{$_} = $item->{$_};
1445                                         }
1446                     $other_items->{$key}->{intransit} = ($transfertwhen ne '') ? 1 : 0;
1447                                         $other_items->{$key}->{notforloan} = GetAuthorisedValueDesc('','',$item->{notforloan},'','',$notforloan_authorised_value) if $notforloan_authorised_value;
1448                                         $other_items->{$key}->{count}++ if $item->{$hbranch};
1449                                         $other_items->{$key}->{location} = $shelflocations->{ $item->{location} };
1450                                         $other_items->{$key}->{imageurl} = getitemtypeimagelocation( 'opac', $itemtypes{ $item->{itype} }->{imageurl} );
1451                 }
1452                 # item is available
1453                 else {
1454                     $can_place_holds = 1;
1455                     $available_count++;
1456                                         $available_items->{$prefix}->{count}++ if $item->{$hbranch};
1457                                         foreach (qw(branchname itemcallnumber)) {
1458                         $available_items->{$prefix}->{$_} = $item->{$_};
1459                                         }
1460                                         $available_items->{$prefix}->{location} = $shelflocations->{ $item->{location} };
1461                                         $available_items->{$prefix}->{imageurl} = getitemtypeimagelocation( 'opac', $itemtypes{ $item->{itype} }->{imageurl} );
1462                 }
1463             }
1464         }    # notforloan, item level and biblioitem level
1465         my ( $availableitemscount, $onloanitemscount, $otheritemscount );
1466         $maxitems =
1467           ( C4::Context->preference('maxItemsinSearchResults') )
1468           ? C4::Context->preference('maxItemsinSearchResults') - 1
1469           : 1;
1470         for my $key ( sort keys %$onloan_items ) {
1471             (++$onloanitemscount > $maxitems) and last;
1472             push @onloan_items_loop, $onloan_items->{$key};
1473         }
1474         for my $key ( sort keys %$other_items ) {
1475             (++$otheritemscount > $maxitems) and last;
1476             push @other_items_loop, $other_items->{$key};
1477         }
1478         for my $key ( sort keys %$available_items ) {
1479             (++$availableitemscount > $maxitems) and last;
1480             push @available_items_loop, $available_items->{$key}
1481         }
1482
1483         # XSLT processing of some stuff
1484         if (C4::Context->preference("XSLTResultsDisplay") && !$scan) {
1485             $oldbiblio->{XSLTResultsRecord} = XSLTParse4Display(
1486                 $oldbiblio->{biblionumber}, $marcrecord, 'Results' );
1487         }
1488
1489         # last check for norequest : if itemtype is notforloan, it can't be reserved either, whatever the items
1490         $can_place_holds = 0
1491           if $itemtypes{ $oldbiblio->{itemtype} }->{notforloan};
1492         $oldbiblio->{norequests} = 1 unless $can_place_holds;
1493         $oldbiblio->{itemsplural}          = 1 if $items_count > 1;
1494         $oldbiblio->{items_count}          = $items_count;
1495         $oldbiblio->{available_items_loop} = \@available_items_loop;
1496         $oldbiblio->{onloan_items_loop}    = \@onloan_items_loop;
1497         $oldbiblio->{other_items_loop}     = \@other_items_loop;
1498         $oldbiblio->{availablecount}       = $available_count;
1499         $oldbiblio->{availableplural}      = 1 if $available_count > 1;
1500         $oldbiblio->{onloancount}          = $onloan_count;
1501         $oldbiblio->{onloanplural}         = 1 if $onloan_count > 1;
1502         $oldbiblio->{othercount}           = $other_count;
1503         $oldbiblio->{otherplural}          = 1 if $other_count > 1;
1504         $oldbiblio->{wthdrawncount}        = $wthdrawn_count;
1505         $oldbiblio->{itemlostcount}        = $itemlost_count;
1506         $oldbiblio->{damagedcount}         = $itemdamaged_count;
1507         $oldbiblio->{intransitcount}       = $item_in_transit_count;
1508         $oldbiblio->{orderedcount}         = $ordered_count;
1509         push( @newresults, $oldbiblio );
1510     }
1511     return @newresults;
1512 }
1513
1514 #----------------------------------------------------------------------
1515 #
1516 # Non-Zebra GetRecords#
1517 #----------------------------------------------------------------------
1518
1519 =head2 NZgetRecords
1520
1521   NZgetRecords has the same API as zera getRecords, even if some parameters are not managed
1522
1523 =cut
1524
1525 sub NZgetRecords {
1526     my (
1527         $query,            $simple_query, $sort_by_ref,    $servers_ref,
1528         $results_per_page, $offset,       $expanded_facet, $branches,
1529         $query_type,       $scan
1530     ) = @_;
1531     warn "query =$query" if $DEBUG;
1532     my $result = NZanalyse($query);
1533     warn "results =$result" if $DEBUG;
1534     return ( undef,
1535         NZorder( $result, @$sort_by_ref[0], $results_per_page, $offset ),
1536         undef );
1537 }
1538
1539 =head2 NZanalyse
1540
1541   NZanalyse : get a CQL string as parameter, and returns a list of biblionumber;title,biblionumber;title,...
1542   the list is built from an inverted index in the nozebra SQL table
1543   note that title is here only for convenience : the sorting will be very fast when requested on title
1544   if the sorting is requested on something else, we will have to reread all results, and that may be longer.
1545
1546 =cut
1547
1548 sub NZanalyse {
1549     my ( $string, $server ) = @_;
1550 #     warn "---------"       if $DEBUG;
1551     warn " NZanalyse" if $DEBUG;
1552 #     warn "---------"       if $DEBUG;
1553
1554  # $server contains biblioserver or authorities, depending on what we search on.
1555  #warn "querying : $string on $server";
1556     $server = 'biblioserver' unless $server;
1557
1558 # if we have a ", replace the content to discard temporarily any and/or/not inside
1559     my $commacontent;
1560     if ( $string =~ /"/ ) {
1561         $string =~ s/"(.*?)"/__X__/;
1562         $commacontent = $1;
1563         warn "commacontent : $commacontent" if $DEBUG;
1564     }
1565
1566 # split the query string in 3 parts : X AND Y means : $left="X", $operand="AND" and $right="Y"
1567 # then, call again NZanalyse with $left and $right
1568 # (recursive until we find a leaf (=> something without and/or/not)
1569 # delete repeated operator... Would then go in infinite loop
1570     while ( $string =~ s/( and| or| not| AND| OR| NOT)\1/$1/g ) {
1571     }
1572
1573     #process parenthesis before.
1574     if ( $string =~ /^\s*\((.*)\)(( and | or | not | AND | OR | NOT )(.*))?/ ) {
1575         my $left     = $1;
1576         my $right    = $4;
1577         my $operator = lc($3);   # FIXME: and/or/not are operators, not operands
1578         warn
1579 "dealing w/parenthesis before recursive sub call. left :$left operator:$operator right:$right"
1580           if $DEBUG;
1581         my $leftresult = NZanalyse( $left, $server );
1582         if ($operator) {
1583             my $rightresult = NZanalyse( $right, $server );
1584
1585             # OK, we have the results for right and left part of the query
1586             # depending of operand, intersect, union or exclude both lists
1587             # to get a result list
1588             if ( $operator eq ' and ' ) {
1589                 return NZoperatorAND($leftresult,$rightresult);
1590             }
1591             elsif ( $operator eq ' or ' ) {
1592
1593                 # just merge the 2 strings
1594                 return $leftresult . $rightresult;
1595             }
1596             elsif ( $operator eq ' not ' ) {
1597                 return NZoperatorNOT($leftresult,$rightresult);
1598             }
1599         }
1600         else {
1601 # this error is impossible, because of the regexp that isolate the operand, but just in case...
1602             return $leftresult;
1603         }
1604     }
1605     warn "string :" . $string if $DEBUG;
1606     my $left = "";
1607     my $right = "";
1608     my $operator = "";
1609     if ($string =~ /(.*?)( and | or | not | AND | OR | NOT )(.*)/) {
1610         $left     = $1;
1611         $right    = $3;
1612         $operator = lc($2);    # FIXME: and/or/not are operators, not operands
1613     }
1614     warn "no parenthesis. left : $left operator: $operator right: $right"
1615       if $DEBUG;
1616
1617     # it's not a leaf, we have a and/or/not
1618     if ($operator) {
1619
1620         # reintroduce comma content if needed
1621         $right =~ s/__X__/"$commacontent"/ if $commacontent;
1622         $left  =~ s/__X__/"$commacontent"/ if $commacontent;
1623         warn "node : $left / $operator / $right\n" if $DEBUG;
1624         my $leftresult  = NZanalyse( $left,  $server );
1625         my $rightresult = NZanalyse( $right, $server );
1626         warn " leftresult : $leftresult" if $DEBUG;
1627         warn " rightresult : $rightresult" if $DEBUG;
1628         # OK, we have the results for right and left part of the query
1629         # depending of operand, intersect, union or exclude both lists
1630         # to get a result list
1631         if ( $operator eq ' and ' ) {
1632             warn "NZAND";
1633             return NZoperatorAND($leftresult,$rightresult);
1634         }
1635         elsif ( $operator eq ' or ' ) {
1636
1637             # just merge the 2 strings
1638             return $leftresult . $rightresult;
1639         }
1640         elsif ( $operator eq ' not ' ) {
1641             return NZoperatorNOT($leftresult,$rightresult);
1642         }
1643         else {
1644
1645 # this error is impossible, because of the regexp that isolate the operand, but just in case...
1646             die "error : operand unknown : $operator for $string";
1647         }
1648
1649         # it's a leaf, do the real SQL query and return the result
1650     }
1651     else {
1652         $string =~ s/__X__/"$commacontent"/ if $commacontent;
1653         $string =~ s/-|\.|\?|,|;|!|'|\(|\)|\[|\]|{|}|"|&|\+|\*|\// /g;
1654         #remove trailing blank at the beginning
1655         $string =~ s/^ //g;
1656         warn "leaf:$string" if $DEBUG;
1657
1658         # parse the string in in operator/operand/value again
1659         my $left = "";
1660         my $operator = "";
1661         my $right = "";
1662         if ($string =~ /(.*)(>=|<=)(.*)/) {
1663             $left     = $1;
1664             $operator = $2;
1665             $right    = $3;
1666         } else {
1667             $left = $string;
1668         }
1669 #         warn "handling leaf... left:$left operator:$operator right:$right"
1670 #           if $DEBUG;
1671         unless ($operator) {
1672             if ($string =~ /(.*)(>|<|=)(.*)/) {
1673                 $left     = $1;
1674                 $operator = $2;
1675                 $right    = $3;
1676                 warn
1677     "handling unless (operator)... left:$left operator:$operator right:$right"
1678                 if $DEBUG;
1679             } else {
1680                 $left = $string;
1681             }
1682         }
1683         my $results;
1684
1685 # strip adv, zebra keywords, currently not handled in nozebra: wrdl, ext, phr...
1686         $left =~ s/ .*$//;
1687
1688         # automatic replace for short operators
1689         $left = 'title'            if $left =~ '^ti$';
1690         $left = 'author'           if $left =~ '^au$';
1691         $left = 'publisher'        if $left =~ '^pb$';
1692         $left = 'subject'          if $left =~ '^su$';
1693         $left = 'koha-Auth-Number' if $left =~ '^an$';
1694         $left = 'keyword'          if $left =~ '^kw$';
1695         $left = 'itemtype'         if $left =~ '^mc$'; # Fix for Bug 2599 - Search limits not working for NoZebra
1696         warn "handling leaf... left:$left operator:$operator right:$right" if $DEBUG;
1697         if ( $operator && $left ne 'keyword' ) {
1698
1699             #do a specific search
1700             my $dbh = C4::Context->dbh;
1701             $operator = 'LIKE' if $operator eq '=' and $right =~ /%/;
1702             my $sth =
1703               $dbh->prepare(
1704 "SELECT biblionumbers,value FROM nozebra WHERE server=? AND indexname=? AND value $operator ?"
1705               );
1706             warn "$left / $operator / $right\n" if $DEBUG;
1707
1708             # split each word, query the DB and build the biblionumbers result
1709             #sanitizing leftpart
1710             $left =~ s/^\s+|\s+$//;
1711             foreach ( split / /, $right ) {
1712                 my $biblionumbers;
1713                 $_ =~ s/^\s+|\s+$//;
1714                 next unless $_;
1715                 warn "EXECUTE : $server, $left, $_" if $DEBUG;
1716                 $sth->execute( $server, $left, $_ )
1717                   or warn "execute failed: $!";
1718                 while ( my ( $line, $value ) = $sth->fetchrow ) {
1719
1720 # if we are dealing with a numeric value, use only numeric results (in case of >=, <=, > or <)
1721 # otherwise, fill the result
1722                     $biblionumbers .= $line
1723                       unless ( $right =~ /^\d+$/ && $value =~ /\D/ );
1724                     warn "result : $value "
1725                       . ( $right  =~ /\d/ ) . "=="
1726                       . ( $value =~ /\D/?$line:"" ) if $DEBUG;         #= $line";
1727                 }
1728
1729 # do a AND with existing list if there is one, otherwise, use the biblionumbers list as 1st result list
1730                 if ($results) {
1731                     warn "NZAND" if $DEBUG;
1732                     $results = NZoperatorAND($biblionumbers,$results);
1733                 }
1734                 else {
1735                     $results = $biblionumbers;
1736                 }
1737             }
1738         }
1739         else {
1740
1741       #do a complete search (all indexes), if index='kw' do complete search too.
1742             my $dbh = C4::Context->dbh;
1743             my $sth =
1744               $dbh->prepare(
1745 "SELECT biblionumbers FROM nozebra WHERE server=? AND value LIKE ?"
1746               );
1747
1748             # split each word, query the DB and build the biblionumbers result
1749             foreach ( split / /, $string ) {
1750                 next if C4::Context->stopwords->{ uc($_) };   # skip if stopword
1751                 warn "search on all indexes on $_" if $DEBUG;
1752                 my $biblionumbers;
1753                 next unless $_;
1754                 $sth->execute( $server, $_ );
1755                 while ( my $line = $sth->fetchrow ) {
1756                     $biblionumbers .= $line;
1757                 }
1758
1759 # do a AND with existing list if there is one, otherwise, use the biblionumbers list as 1st result list
1760                 if ($results) {
1761                     $results = NZoperatorAND($biblionumbers,$results);
1762                 }
1763                 else {
1764                     warn "NEW RES for $_ = $biblionumbers" if $DEBUG;
1765                     $results = $biblionumbers;
1766                 }
1767             }
1768         }
1769         warn "return : $results for LEAF : $string" if $DEBUG;
1770         return $results;
1771     }
1772     warn "---------\nLeave NZanalyse\n---------" if $DEBUG;
1773 }
1774
1775 sub NZoperatorAND{
1776     my ($rightresult, $leftresult)=@_;
1777
1778     my @leftresult = split /;/, $leftresult;
1779     warn " @leftresult / $rightresult \n" if $DEBUG;
1780
1781     #             my @rightresult = split /;/,$leftresult;
1782     my $finalresult;
1783
1784 # parse the left results, and if the biblionumber exist in the right result, save it in finalresult
1785 # the result is stored twice, to have the same weight for AND than OR.
1786 # example : TWO : 61,61,64,121 (two is twice in the biblio #61) / TOWER : 61,64,130
1787 # result : 61,61,61,61,64,64 for two AND tower : 61 has more weight than 64
1788     foreach (@leftresult) {
1789         my $value = $_;
1790         my $countvalue;
1791         ( $value, $countvalue ) = ( $1, $2 ) if ($value=~/(.*)-(\d+)$/);
1792         if ( $rightresult =~ /\Q$value\E-(\d+);/ ) {
1793             $countvalue = ( $1 > $countvalue ? $countvalue : $1 );
1794             $finalresult .=
1795                 "$value-$countvalue;$value-$countvalue;";
1796         }
1797     }
1798     warn "NZAND DONE : $finalresult \n" if $DEBUG;
1799     return $finalresult;
1800 }
1801
1802 sub NZoperatorOR{
1803     my ($rightresult, $leftresult)=@_;
1804     return $rightresult.$leftresult;
1805 }
1806
1807 sub NZoperatorNOT{
1808     my ($leftresult, $rightresult)=@_;
1809
1810     my @leftresult = split /;/, $leftresult;
1811
1812     #             my @rightresult = split /;/,$leftresult;
1813     my $finalresult;
1814     foreach (@leftresult) {
1815         my $value=$_;
1816         $value=$1 if $value=~m/(.*)-\d+$/;
1817         unless ($rightresult =~ "$value-") {
1818             $finalresult .= "$_;";
1819         }
1820     }
1821     return $finalresult;
1822 }
1823
1824 =head2 NZorder
1825
1826   $finalresult = NZorder($biblionumbers, $ordering,$results_per_page,$offset);
1827
1828   TODO :: Description
1829
1830 =cut
1831
1832 sub NZorder {
1833     my ( $biblionumbers, $ordering, $results_per_page, $offset ) = @_;
1834     warn "biblionumbers = $biblionumbers and ordering = $ordering\n" if $DEBUG;
1835
1836     # order title asc by default
1837     #     $ordering = '1=36 <i' unless $ordering;
1838     $results_per_page = 20 unless $results_per_page;
1839     $offset           = 0  unless $offset;
1840     my $dbh = C4::Context->dbh;
1841
1842     #
1843     # order by POPULARITY
1844     #
1845     if ( $ordering =~ /popularity/ ) {
1846         my %result;
1847         my %popularity;
1848
1849         # popularity is not in MARC record, it's builded from a specific query
1850         my $sth =
1851           $dbh->prepare("select sum(issues) from items where biblionumber=?");
1852         foreach ( split /;/, $biblionumbers ) {
1853             my ( $biblionumber, $title ) = split /,/, $_;
1854             $result{$biblionumber} = GetMarcBiblio($biblionumber);
1855             $sth->execute($biblionumber);
1856             my $popularity = $sth->fetchrow || 0;
1857
1858 # hint : the key is popularity.title because we can have
1859 # many results with the same popularity. In this cas, sub-ordering is done by title
1860 # we also have biblionumber to avoid bug for 2 biblios with the same title & popularity
1861 # (un-frequent, I agree, but we won't forget anything that way ;-)
1862             $popularity{ sprintf( "%10d", $popularity ) . $title
1863                   . $biblionumber } = $biblionumber;
1864         }
1865
1866     # sort the hash and return the same structure as GetRecords (Zebra querying)
1867         my $result_hash;
1868         my $numbers = 0;
1869         if ( $ordering eq 'popularity_dsc' ) {    # sort popularity DESC
1870             foreach my $key ( sort { $b cmp $a } ( keys %popularity ) ) {
1871                 $result_hash->{'RECORDS'}[ $numbers++ ] =
1872                   $result{ $popularity{$key} }->as_usmarc();
1873             }
1874         }
1875         else {                                    # sort popularity ASC
1876             foreach my $key ( sort ( keys %popularity ) ) {
1877                 $result_hash->{'RECORDS'}[ $numbers++ ] =
1878                   $result{ $popularity{$key} }->as_usmarc();
1879             }
1880         }
1881         my $finalresult = ();
1882         $result_hash->{'hits'}         = $numbers;
1883         $finalresult->{'biblioserver'} = $result_hash;
1884         return $finalresult;
1885
1886         #
1887         # ORDER BY author
1888         #
1889     }
1890     elsif ( $ordering =~ /author/ ) {
1891         my %result;
1892         foreach ( split /;/, $biblionumbers ) {
1893             my ( $biblionumber, $title ) = split /,/, $_;
1894             my $record = GetMarcBiblio($biblionumber);
1895             my $author;
1896             if ( C4::Context->preference('marcflavour') eq 'UNIMARC' ) {
1897                 $author = $record->subfield( '200', 'f' );
1898                 $author = $record->subfield( '700', 'a' ) unless $author;
1899             }
1900             else {
1901                 $author = $record->subfield( '100', 'a' );
1902             }
1903
1904 # hint : the result is sorted by title.biblionumber because we can have X biblios with the same title
1905 # and we don't want to get only 1 result for each of them !!!
1906             $result{ $author . $biblionumber } = $record;
1907         }
1908
1909     # sort the hash and return the same structure as GetRecords (Zebra querying)
1910         my $result_hash;
1911         my $numbers = 0;
1912         if ( $ordering eq 'author_za' ) {    # sort by author desc
1913             foreach my $key ( sort { $b cmp $a } ( keys %result ) ) {
1914                 $result_hash->{'RECORDS'}[ $numbers++ ] =
1915                   $result{$key}->as_usmarc();
1916             }
1917         }
1918         else {                               # sort by author ASC
1919             foreach my $key ( sort ( keys %result ) ) {
1920                 $result_hash->{'RECORDS'}[ $numbers++ ] =
1921                   $result{$key}->as_usmarc();
1922             }
1923         }
1924         my $finalresult = ();
1925         $result_hash->{'hits'}         = $numbers;
1926         $finalresult->{'biblioserver'} = $result_hash;
1927         return $finalresult;
1928
1929         #
1930         # ORDER BY callnumber
1931         #
1932     }
1933     elsif ( $ordering =~ /callnumber/ ) {
1934         my %result;
1935         foreach ( split /;/, $biblionumbers ) {
1936             my ( $biblionumber, $title ) = split /,/, $_;
1937             my $record = GetMarcBiblio($biblionumber);
1938             my $callnumber;
1939             my $frameworkcode = GetFrameworkCode($biblionumber);
1940             my ( $callnumber_tag, $callnumber_subfield ) = GetMarcFromKohaField(  'items.itemcallnumber', $frameworkcode);
1941                ( $callnumber_tag, $callnumber_subfield ) = GetMarcFromKohaField('biblioitems.callnumber', $frameworkcode)
1942                 unless $callnumber_tag;
1943             if ( C4::Context->preference('marcflavour') eq 'UNIMARC' ) {
1944                 $callnumber = $record->subfield( '200', 'f' );
1945             } else {
1946                 $callnumber = $record->subfield( '100', 'a' );
1947             }
1948
1949 # hint : the result is sorted by title.biblionumber because we can have X biblios with the same title
1950 # and we don't want to get only 1 result for each of them !!!
1951             $result{ $callnumber . $biblionumber } = $record;
1952         }
1953
1954     # sort the hash and return the same structure as GetRecords (Zebra querying)
1955         my $result_hash;
1956         my $numbers = 0;
1957         if ( $ordering eq 'call_number_dsc' ) {    # sort by title desc
1958             foreach my $key ( sort { $b cmp $a } ( keys %result ) ) {
1959                 $result_hash->{'RECORDS'}[ $numbers++ ] =
1960                   $result{$key}->as_usmarc();
1961             }
1962         }
1963         else {                                     # sort by title ASC
1964             foreach my $key ( sort { $a cmp $b } ( keys %result ) ) {
1965                 $result_hash->{'RECORDS'}[ $numbers++ ] =
1966                   $result{$key}->as_usmarc();
1967             }
1968         }
1969         my $finalresult = ();
1970         $result_hash->{'hits'}         = $numbers;
1971         $finalresult->{'biblioserver'} = $result_hash;
1972         return $finalresult;
1973     }
1974     elsif ( $ordering =~ /pubdate/ ) {             #pub year
1975         my %result;
1976         foreach ( split /;/, $biblionumbers ) {
1977             my ( $biblionumber, $title ) = split /,/, $_;
1978             my $record = GetMarcBiblio($biblionumber);
1979             my ( $publicationyear_tag, $publicationyear_subfield ) =
1980               GetMarcFromKohaField( 'biblioitems.publicationyear', '' );
1981             my $publicationyear =
1982               $record->subfield( $publicationyear_tag,
1983                 $publicationyear_subfield );
1984
1985 # hint : the result is sorted by title.biblionumber because we can have X biblios with the same title
1986 # and we don't want to get only 1 result for each of them !!!
1987             $result{ $publicationyear . $biblionumber } = $record;
1988         }
1989
1990     # sort the hash and return the same structure as GetRecords (Zebra querying)
1991         my $result_hash;
1992         my $numbers = 0;
1993         if ( $ordering eq 'pubdate_dsc' ) {    # sort by pubyear desc
1994             foreach my $key ( sort { $b cmp $a } ( keys %result ) ) {
1995                 $result_hash->{'RECORDS'}[ $numbers++ ] =
1996                   $result{$key}->as_usmarc();
1997             }
1998         }
1999         else {                                 # sort by pub year ASC
2000             foreach my $key ( sort ( keys %result ) ) {
2001                 $result_hash->{'RECORDS'}[ $numbers++ ] =
2002                   $result{$key}->as_usmarc();
2003             }
2004         }
2005         my $finalresult = ();
2006         $result_hash->{'hits'}         = $numbers;
2007         $finalresult->{'biblioserver'} = $result_hash;
2008         return $finalresult;
2009
2010         #
2011         # ORDER BY title
2012         #
2013     }
2014     elsif ( $ordering =~ /title/ ) {
2015
2016 # the title is in the biblionumbers string, so we just need to build a hash, sort it and return
2017         my %result;
2018         foreach ( split /;/, $biblionumbers ) {
2019             my ( $biblionumber, $title ) = split /,/, $_;
2020
2021 # hint : the result is sorted by title.biblionumber because we can have X biblios with the same title
2022 # and we don't want to get only 1 result for each of them !!!
2023 # hint & speed improvement : we can order without reading the record
2024 # so order, and read records only for the requested page !
2025             $result{ $title . $biblionumber } = $biblionumber;
2026         }
2027
2028     # sort the hash and return the same structure as GetRecords (Zebra querying)
2029         my $result_hash;
2030         my $numbers = 0;
2031         if ( $ordering eq 'title_az' ) {    # sort by title desc
2032             foreach my $key ( sort ( keys %result ) ) {
2033                 $result_hash->{'RECORDS'}[ $numbers++ ] = $result{$key};
2034             }
2035         }
2036         else {                              # sort by title ASC
2037             foreach my $key ( sort { $b cmp $a } ( keys %result ) ) {
2038                 $result_hash->{'RECORDS'}[ $numbers++ ] = $result{$key};
2039             }
2040         }
2041
2042         # limit the $results_per_page to result size if it's more
2043         $results_per_page = $numbers - 1 if $numbers < $results_per_page;
2044
2045         # for the requested page, replace biblionumber by the complete record
2046         # speed improvement : avoid reading too much things
2047         for (
2048             my $counter = $offset ;
2049             $counter <= $offset + $results_per_page ;
2050             $counter++
2051           )
2052         {
2053             $result_hash->{'RECORDS'}[$counter] =
2054               GetMarcBiblio( $result_hash->{'RECORDS'}[$counter] )->as_usmarc;
2055         }
2056         my $finalresult = ();
2057         $result_hash->{'hits'}         = $numbers;
2058         $finalresult->{'biblioserver'} = $result_hash;
2059         return $finalresult;
2060     }
2061     else {
2062
2063 #
2064 # order by ranking
2065 #
2066 # we need 2 hashes to order by ranking : the 1st one to count the ranking, the 2nd to order by ranking
2067         my %result;
2068         my %count_ranking;
2069         foreach ( split /;/, $biblionumbers ) {
2070             my ( $biblionumber, $title ) = split /,/, $_;
2071             $title =~ /(.*)-(\d)/;
2072
2073             # get weight
2074             my $ranking = $2;
2075
2076 # note that we + the ranking because ranking is calculated on weight of EACH term requested.
2077 # if we ask for "two towers", and "two" has weight 2 in biblio N, and "towers" has weight 4 in biblio N
2078 # biblio N has ranking = 6
2079             $count_ranking{$biblionumber} += $ranking;
2080         }
2081
2082 # build the result by "inverting" the count_ranking hash
2083 # 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
2084 #         warn "counting";
2085         foreach ( keys %count_ranking ) {
2086             $result{ sprintf( "%10d", $count_ranking{$_} ) . '-' . $_ } = $_;
2087         }
2088
2089     # sort the hash and return the same structure as GetRecords (Zebra querying)
2090         my $result_hash;
2091         my $numbers = 0;
2092         foreach my $key ( sort { $b cmp $a } ( keys %result ) ) {
2093             $result_hash->{'RECORDS'}[ $numbers++ ] = $result{$key};
2094         }
2095
2096         # limit the $results_per_page to result size if it's more
2097         $results_per_page = $numbers - 1 if $numbers < $results_per_page;
2098
2099         # for the requested page, replace biblionumber by the complete record
2100         # speed improvement : avoid reading too much things
2101         for (
2102             my $counter = $offset ;
2103             $counter <= $offset + $results_per_page ;
2104             $counter++
2105           )
2106         {
2107             $result_hash->{'RECORDS'}[$counter] =
2108               GetMarcBiblio( $result_hash->{'RECORDS'}[$counter] )->as_usmarc
2109               if $result_hash->{'RECORDS'}[$counter];
2110         }
2111         my $finalresult = ();
2112         $result_hash->{'hits'}         = $numbers;
2113         $finalresult->{'biblioserver'} = $result_hash;
2114         return $finalresult;
2115     }
2116 }
2117
2118 =head2 enabled_staff_search_views
2119
2120 %hash = enabled_staff_search_views()
2121
2122 This function returns a hash that contains three flags obtained from the system
2123 preferences, used to determine whether a particular staff search results view
2124 is enabled.
2125
2126 =over 2
2127
2128 =item C<Output arg:>
2129
2130     * $hash{can_view_MARC} is true only if the MARC view is enabled
2131     * $hash{can_view_ISBD} is true only if the ISBD view is enabled
2132     * $hash{can_view_labeledMARC} is true only if the Labeled MARC view is enabled
2133
2134 =item C<usage in the script:>
2135
2136 =back
2137
2138 $template->param ( C4::Search::enabled_staff_search_views );
2139
2140 =cut
2141
2142 sub enabled_staff_search_views
2143 {
2144         return (
2145                 can_view_MARC                   => C4::Context->preference('viewMARC'),                 # 1 if the staff search allows the MARC view
2146                 can_view_ISBD                   => C4::Context->preference('viewISBD'),                 # 1 if the staff search allows the ISBD view
2147                 can_view_labeledMARC    => C4::Context->preference('viewLabeledMARC'),  # 1 if the staff search allows the Labeled MARC view
2148         );
2149 }
2150
2151
2152 =head2 z3950_search_args
2153
2154 $arrayref = z3950_search_args($matchpoints)
2155
2156 This function returns an array reference that contains the search parameters to be
2157 passed to the Z39.50 search script (z3950_search.pl). The array elements
2158 are hash refs whose keys are name, value and encvalue, and whose values are the
2159 name of a search parameter, the value of that search parameter and the URL encoded
2160 value of that parameter.
2161
2162 The search parameter names are lccn, isbn, issn, title, author, dewey and subject.
2163
2164 The search parameter values are obtained from the bibliographic record whose
2165 data is in a hash reference in $matchpoints, as returned by Biblio::GetBiblioData().
2166
2167 If $matchpoints is a scalar, it is assumed to be an unnamed query descriptor, e.g.
2168 a general purpose search argument. In this case, the returned array contains only
2169 entry: the key is 'title' and the value and encvalue are derived from $matchpoints.
2170
2171 If a search parameter value is undefined or empty, it is not included in the returned
2172 array.
2173
2174 The returned array reference may be passed directly to the template parameters.
2175
2176 =over 2
2177
2178 =item C<Output arg:>
2179
2180     * $array containing hash refs as described above
2181
2182 =item C<usage in the script:>
2183
2184 =back
2185
2186 $data = Biblio::GetBiblioData($bibno);
2187 $template->param ( MYLOOP => C4::Search::z3950_search_args($data) )
2188
2189 *OR*
2190
2191 $template->param ( MYLOOP => C4::Search::z3950_search_args($searchscalar) )
2192
2193 =cut
2194
2195 sub z3950_search_args {
2196     my $bibrec = shift;
2197     $bibrec = { title => $bibrec } if !ref $bibrec;
2198     my $array = [];
2199     for my $field (qw/ lccn isbn issn title author dewey subject /)
2200     {
2201         my $encvalue = URI::Escape::uri_escape_utf8($bibrec->{$field});
2202         push @$array, { name=>$field, value=>$bibrec->{$field}, encvalue=>$encvalue } if defined $bibrec->{$field};
2203     }
2204     return $array;
2205 }
2206
2207
2208 END { }    # module clean-up code here (global destructor)
2209
2210 1;
2211 __END__
2212
2213 =head1 AUTHOR
2214
2215 Koha Developement team <info@koha.org>
2216
2217 =cut