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                                                                 if (defined $branches
 535                                                                         && ref($branches) eq "HASH"
 536                                                                         && defined $branches->{$one_facet}
 537                                                                         && ref ($branches->{$one_facet}) eq "HASH")
 538                                                                 {
 539                                         $facet_label_value =
 540                                                 $branches->{$one_facet}->{'branchname'};
 541                                                                 }
 542                                                                 else {
 543                                                                         $facet_label_value = "*";
 544                                                                 }
 545                             }
 546
 547                 # but we're down with the whole label being in the link's title.
 548                             my $facet_title_value = $one_facet;
 549
 550                             push @this_facets_array,
 551                               (
 552                                 {
 553                                     facet_count =>
 554                                       $facets_counter->{$link_value}
 555                                       ->{$one_facet},
 556                                     facet_label_value => $facet_label_value,
 557                                     facet_title_value => $facet_title_value,
 558                                     facet_link_value  => $facet_link_value,
 559                                     type_link_value   => $link_value,
 560                                 },
 561                               );
 562                         }
 563                     }
 564
 565                     # handle expanded option
 566                     unless ( $facets_info->{$link_value}->{'expanded'} ) {
 567                         $expandable = 1
 568                           if ( ( $number_of_facets > 6 )
 569                             && ( $expanded_facet ne $link_value ) );
 570                     }
 571                     push @facets_loop,
 572                       (
 573                         {
 574                             type_link_value => $link_value,
 575                             type_id         => $link_value . "_id",
 576                             "type_label_" . $facets_info->{$link_value}->{'label_value'} => 1,
 577                             facets     => \@this_facets_array,
 578                             expandable => $expandable,
 579                             expand     => $link_value,
 580                         }
 581                       ) unless ( ($facets_info->{$link_value}->{'label_value'} =~ /Libraries/) and (C4::Context->preference('singleBranchMode')) );
 582                 }
 583             }
 584         }
 585     }
 586     return ( undef, $results_hashref, \@facets_loop );
 587 }
 588
 589 sub pazGetRecords {
 590     my (
 591         $koha_query,       $simple_query, $sort_by_ref,    $servers_ref,
 592         $results_per_page, $offset,       $expanded_facet, $branches,
 593         $query_type,       $scan
 594     ) = @_;
 595
 596     my $paz = C4::Search::PazPar2->new(C4::Context->config('pazpar2url'));
 597     $paz->init();
 598     $paz->search($simple_query);
 599     sleep 1;   # FIXME: WHY?
 600
 601     # do results
 602     my $results_hashref = {};
 603     my $stats = XMLin($paz->stat);
 604     my $results = XMLin($paz->show($offset, $results_per_page, 'work-title:1'), forcearray => 1);
 605
 606     # for a grouped search result, the number of hits
 607     # is the number of groups returned; 'bib_hits' will have
 608     # the total number of bibs.
 609     $results_hashref->{'biblioserver'}->{'hits'} = $results->{'merged'}->[0];
 610     $results_hashref->{'biblioserver'}->{'bib_hits'} = $stats->{'hits'};
 611
 612     HIT: foreach my $hit (@{ $results->{'hit'} }) {
 613         my $recid = $hit->{recid}->[0];
 614
 615         my $work_title = $hit->{'md-work-title'}->[0];
 616         my $work_author;
 617         if (exists $hit->{'md-work-author'}) {
 618             $work_author = $hit->{'md-work-author'}->[0];
 619         }
 620         my $group_label = (defined $work_author) ? "$work_title / $work_author" : $work_title;
 621
 622         my $result_group = {};
 623         $result_group->{'group_label'} = $group_label;
 624         $result_group->{'group_merge_key'} = $recid;
 625
 626         my $count = 1;
 627         if (exists $hit->{count}) {
 628             $count = $hit->{count}->[0];
 629         }
 630         $result_group->{'group_count'} = $count;
 631
 632         for (my $i = 0; $i < $count; $i++) {
 633             # FIXME -- may need to worry about diacritics here
 634             my $rec = $paz->record($recid, $i);
 635             push @{ $result_group->{'RECORDS'} }, $rec;
 636         }
 637
 638         push @{ $results_hashref->{'biblioserver'}->{'GROUPS'} }, $result_group;
 639     }
 640
 641     # pass through facets
 642     my $termlist_xml = $paz->termlist('author,subject');
 643     my $terms = XMLin($termlist_xml, forcearray => 1);
 644     my @facets_loop = ();
 645     #die Dumper($results);
 646 #    foreach my $list (sort keys %{ $terms->{'list'} }) {
 647 #        my @facets = ();
 648 #        foreach my $facet (sort @{ $terms->{'list'}->{$list}->{'term'} } ) {
 649 #            push @facets, {
 650 #                facet_label_value => $facet->{'name'}->[0],
 651 #            };
 652 #        }
 653 #        push @facets_loop, ( {
 654 #            type_label => $list,
 655 #            facets => \@facets,
 656 #        } );
 657 #    }
 658
 659     return ( undef, $results_hashref, \@facets_loop );
 660 }
 661
 662 # STOPWORDS
 663 sub _remove_stopwords {
 664     my ( $operand, $index ) = @_;
 665     my @stopwords_removed;
 666
 667     # phrase and exact-qualified indexes shouldn't have stopwords removed
 668     if ( $index !~ m/phr|ext/ ) {
 669
 670 # remove stopwords from operand : parse all stopwords & remove them (case insensitive)
 671 #       we use IsAlpha unicode definition, to deal correctly with diacritics.
 672 #       otherwise, a French word like "leçon" woudl be split into "le" "çon", "le"
 673 #       is a stopword, we'd get "çon" and wouldn't find anything...
 674         foreach ( keys %{ C4::Context->stopwords } ) {
 675             next if ( $_ =~ /(and|or|not)/ );    # don't remove operators
 676             if ( $operand =~
 677                 /(\P{IsAlpha}$_\P{IsAlpha}|^$_\P{IsAlpha}|\P{IsAlpha}$_$|^$_$)/ )
 678             {
 679                 $operand =~ s/\P{IsAlpha}$_\P{IsAlpha}/ /gi;
 680                 $operand =~ s/^$_\P{IsAlpha}/ /gi;
 681                 $operand =~ s/\P{IsAlpha}$_$/ /gi;
 682                                 $operand =~ s/$1//gi;
 683                 push @stopwords_removed, $_;
 684             }
 685         }
 686     }
 687     return ( $operand, \@stopwords_removed );
 688 }
 689
 690 # TRUNCATION
 691 sub _detect_truncation {
 692     my ( $operand, $index ) = @_;
 693     my ( @nontruncated, @righttruncated, @lefttruncated, @rightlefttruncated,
 694         @regexpr );
 695     $operand =~ s/^ //g;
 696     my @wordlist = split( /\s/, $operand );
 697     foreach my $word (@wordlist) {
 698         if ( $word =~ s/^\*([^\*]+)\*$/$1/ ) {
 699             push @rightlefttruncated, $word;
 700         }
 701         elsif ( $word =~ s/^\*([^\*]+)$/$1/ ) {
 702             push @lefttruncated, $word;
 703         }
 704         elsif ( $word =~ s/^([^\*]+)\*$/$1/ ) {
 705             push @righttruncated, $word;
 706         }
 707         elsif ( index( $word, "*" ) < 0 ) {
 708             push @nontruncated, $word;
 709         }
 710         else {
 711             push @regexpr, $word;
 712         }
 713     }
 714     return (
 715         \@nontruncated,       \@righttruncated, \@lefttruncated,
 716         \@rightlefttruncated, \@regexpr
 717     );
 718 }
 719
 720 # STEMMING
 721 sub _build_stemmed_operand {
 722     my ($operand) = @_;
 723     my $stemmed_operand;
 724
 725     # If operand contains a digit, it is almost certainly an identifier, and should
 726     # not be stemmed.  This is particularly relevant for ISBNs and ISSNs, which
 727     # can contain the letter "X" - for example, _build_stemmend_operand would reduce
 728     # "014100018X" to "x ", which for a MARC21 database would bring up irrelevant
 729     # results (e.g., "23 x 29 cm." from the 300$c).  Bug 2098.
 730     return $operand if $operand =~ /\d/;
 731
 732 # FIXME: the locale should be set based on the user's language and/or search choice
 733     my $stemmer = Lingua::Stem->new( -locale => 'EN-US' );
 734
 735 # FIXME: these should be stored in the db so the librarian can modify the behavior
 736     $stemmer->add_exceptions(
 737         {
 738             'and' => 'and',
 739             'or'  => 'or',
 740             'not' => 'not',
 741         }
 742     );
 743     my @words = split( / /, $operand );
 744     my $stems = $stemmer->stem(@words);
 745     for my $stem (@$stems) {
 746         $stemmed_operand .= "$stem";
 747         $stemmed_operand .= "?"
 748           unless ( $stem =~ /(and$|or$|not$)/ ) || ( length($stem) < 3 );
 749         $stemmed_operand .= " ";
 750     }
 751     warn "STEMMED OPERAND: $stemmed_operand" if $DEBUG;
 752     return $stemmed_operand;
 753 }
 754
 755 # FIELD WEIGHTING
 756 sub _build_weighted_query {
 757
 758 # FIELD WEIGHTING - This is largely experimental stuff. What I'm committing works
 759 # pretty well but could work much better if we had a smarter query parser
 760     my ( $operand, $stemmed_operand, $index ) = @_;
 761     my $stemming      = C4::Context->preference("QueryStemming")     || 0;
 762     my $weight_fields = C4::Context->preference("QueryWeightFields") || 0;
 763     my $fuzzy_enabled = C4::Context->preference("QueryFuzzy")        || 0;
 764
 765     my $weighted_query .= "(rk=(";    # Specifies that we're applying rank
 766
 767     # Keyword, or, no index specified
 768     if ( ( $index eq 'kw' ) || ( !$index ) ) {
 769         $weighted_query .=
 770           "Title-cover,ext,r1=\"$operand\"";    # exact title-cover
 771         $weighted_query .= " or ti,ext,r2=\"$operand\"";    # exact title
 772         $weighted_query .= " or ti,phr,r3=\"$operand\"";    # phrase title
 773           #$weighted_query .= " or any,ext,r4=$operand";               # exact any
 774           #$weighted_query .=" or kw,wrdl,r5=\"$operand\"";            # word list any
 775         $weighted_query .= " or wrdl,fuzzy,r8=\"$operand\""
 776           if $fuzzy_enabled;    # add fuzzy, word list
 777         $weighted_query .= " or wrdl,right-Truncation,r9=\"$stemmed_operand\""
 778           if ( $stemming and $stemmed_operand )
 779           ;                     # add stemming, right truncation
 780         $weighted_query .= " or wrdl,r9=\"$operand\"";
 781
 782         # embedded sorting: 0 a-z; 1 z-a
 783         # $weighted_query .= ") or (sort1,aut=1";
 784     }
 785
 786     # Barcode searches should skip this process
 787     elsif ( $index eq 'bc' ) {
 788         $weighted_query .= "bc=\"$operand\"";
 789     }
 790
 791     # Authority-number searches should skip this process
 792     elsif ( $index eq 'an' ) {
 793         $weighted_query .= "an=\"$operand\"";
 794     }
 795
 796     # If the index already has more than one qualifier, wrap the operand
 797     # in quotes and pass it back (assumption is that the user knows what they
 798     # are doing and won't appreciate us mucking up their query
 799     elsif ( $index =~ ',' ) {
 800         $weighted_query .= " $index=\"$operand\"";
 801     }
 802
 803     #TODO: build better cases based on specific search indexes
 804     else {
 805         $weighted_query .= " $index,ext,r1=\"$operand\"";    # exact index
 806           #$weighted_query .= " or (title-sort-az=0 or $index,startswithnt,st-word,r3=$operand #)";
 807         $weighted_query .= " or $index,phr,r3=\"$operand\"";    # phrase index
 808         $weighted_query .=
 809           " or $index,rt,wrdl,r3=\"$operand\"";    # word list index
 810     }
 811
 812     $weighted_query .= "))";                       # close rank specification
 813     return $weighted_query;
 814 }
 815
 816 =head2 buildQuery
 817
 818 ( $error, $query,
 819 $simple_query, $query_cgi,
 820 $query_desc, $limit,
 821 $limit_cgi, $limit_desc,
 822 $stopwords_removed, $query_type ) = getRecords ( $operators, $operands, $indexes, $limits, $sort_by, $scan);
 823
 824 Build queries and limits in CCL, CGI, Human,
 825 handle truncation, stemming, field weighting, stopwords, fuzziness, etc.
 826
 827 See verbose embedded documentation.
 828
 829
 830 =cut
 831
 832 sub buildQuery {
 833     my ( $operators, $operands, $indexes, $limits, $sort_by, $scan ) = @_;
 834
 835     warn "---------\nEnter buildQuery\n---------" if $DEBUG;
 836
 837     # dereference
 838     my @operators = @$operators if $operators;
 839     my @indexes   = @$indexes   if $indexes;
 840     my @operands  = @$operands  if $operands;
 841     my @limits    = @$limits    if $limits;
 842     my @sort_by   = @$sort_by   if $sort_by;
 843
 844     my $stemming         = C4::Context->preference("QueryStemming")        || 0;
 845     my $auto_truncation  = C4::Context->preference("QueryAutoTruncate")    || 0;
 846     my $weight_fields    = C4::Context->preference("QueryWeightFields")    || 0;
 847     my $fuzzy_enabled    = C4::Context->preference("QueryFuzzy")           || 0;
 848     my $remove_stopwords = C4::Context->preference("QueryRemoveStopwords") || 0;
 849
 850     # no stemming/weight/fuzzy in NoZebra
 851     if ( C4::Context->preference("NoZebra") ) {
 852         $stemming      = 0;
 853         $weight_fields = 0;
 854         $fuzzy_enabled = 0;
 855     }
 856
 857     my $query        = $operands[0];
 858     my $simple_query = $operands[0];
 859
 860     # initialize the variables we're passing back
 861     my $query_cgi;
 862     my $query_desc;
 863     my $query_type;
 864
 865     my $limit;
 866     my $limit_cgi;
 867     my $limit_desc;
 868
 869     my $stopwords_removed;    # flag to determine if stopwords have been removed
 870
 871 # for handling ccl, cql, pqf queries in diagnostic mode, skip the rest of the steps
 872 # DIAGNOSTIC ONLY!!
 873     if ( $query =~ /^ccl=/ ) {
 874         return ( undef, $', $', "q=ccl=$'", $', '', '', '', '', 'ccl' );
 875     }
 876     if ( $query =~ /^cql=/ ) {
 877         return ( undef, $', $', "q=cql=$'", $', '', '', '', '', 'cql' );
 878     }
 879     if ( $query =~ /^pqf=/ ) {
 880         return ( undef, $', $', "q=pqf=$'", $', '', '', '', '', 'pqf' );
 881     }
 882
 883     # pass nested queries directly
 884     # FIXME: need better handling of some of these variables in this case
 885     if ( $query =~ /(\(|\))/ ) {
 886         return (
 887             undef,              $query, $simple_query, $query_cgi,
 888             $query,             $limit, $limit_cgi,    $limit_desc,
 889             $stopwords_removed, 'ccl'
 890         );
 891     }
 892
 893 # Form-based queries are non-nested and fixed depth, so we can easily modify the incoming
 894 # query operands and indexes and add stemming, truncation, field weighting, etc.
 895 # Once we do so, we'll end up with a value in $query, just like if we had an
 896 # incoming $query from the user
 897     else {
 898         $query = ""
 899           ; # clear it out so we can populate properly with field-weighted, stemmed, etc. query
 900         my $previous_operand
 901           ;    # a flag used to keep track if there was a previous query
 902                # if there was, we can apply the current operator
 903                # for every operand
 904         for ( my $i = 0 ; $i <= @operands ; $i++ ) {
 905
 906             # COMBINE OPERANDS, INDEXES AND OPERATORS
 907             if ( $operands[$i] ) {
 908
 909               # A flag to determine whether or not to add the index to the query
 910                 my $indexes_set;
 911
 912 # If the user is sophisticated enough to specify an index, turn off field weighting, stemming, and stopword handling
 913                 if ( $operands[$i] =~ /(:|=)/ || $scan ) {
 914                     $weight_fields    = 0;
 915                     $stemming         = 0;
 916                     $remove_stopwords = 0;
 917                 }
 918                 my $operand = $operands[$i];
 919                 my $index   = $indexes[$i];
 920
 921                 # Add index-specific attributes
 922                 # Date of Publication
 923                 if ( $index eq 'yr' ) {
 924                     $index .= ",st-numeric";
 925 #                     $indexes_set++;
 926                                         $stemming = $auto_truncation = $weight_fields = $fuzzy_enabled = $remove_stopwords = 0;
 927                 }
 928
 929                 # Date of Acquisition
 930                 elsif ( $index eq 'acqdate' ) {
 931                     $index .= ",st-date-normalized";
 932 #                     $indexes_set++;
 933                                         $stemming = $auto_truncation = $weight_fields = $fuzzy_enabled = $remove_stopwords = 0;
 934                 }
 935                 # ISBN,ISSN,Standard Number, don't need special treatment
 936                 elsif ( $index eq 'nb' || $index eq 'ns' ) {
 937 #                     $indexes_set++;
 938                     (
 939                         $stemming,      $auto_truncation,
 940                         $weight_fields, $fuzzy_enabled,
 941                         $remove_stopwords
 942                     ) = ( 0, 0, 0, 0, 0 );
 943
 944                 }
 945                 # Set default structure attribute (word list)
 946                 my $struct_attr;
 947                 unless ( $indexes_set || !$index || $index =~ /(st-|phr|ext|wrdl)/ ) {
 948                     $struct_attr = ",wrdl";
 949                 }
 950
 951                 # Some helpful index variants
 952                 my $index_plus       = $index . $struct_attr . ":" if $index;
 953                 my $index_plus_comma = $index . $struct_attr . "," if $index;
 954                 if ($auto_truncation){
 955 #                                       FIXME Auto Truncation is only valid for LTR languages
 956 #                                       use C4::Output;
 957 #                                       use C4::Languages qw(regex_lang_subtags get_bidi);
 958 #                               $lang = $query->cookie('KohaOpacLanguage') if (defined $query && $query->cookie('KohaOpacLanguage'));
 959 #                                   my $current_lang = regex_lang_subtags($lang);
 960 #                                   my $bidi;
 961 #                                   $bidi = get_bidi($current_lang->{script}) if $current_lang->{script};
 962                                         $index_plus_comma .= "rtrn:";
 963                                 }
 964
 965                 # Remove Stopwords
 966                 if ($remove_stopwords) {
 967                     ( $operand, $stopwords_removed ) =
 968                       _remove_stopwords( $operand, $index );
 969                     warn "OPERAND w/out STOPWORDS: >$operand<" if $DEBUG;
 970                     warn "REMOVED STOPWORDS: @$stopwords_removed"
 971                       if ( $stopwords_removed && $DEBUG );
 972                 }
 973
 974                 # Detect Truncation
 975                 my $truncated_operand;
 976                 my( $nontruncated, $righttruncated, $lefttruncated,
 977                     $rightlefttruncated, $regexpr
 978                 ) = _detect_truncation( $operand, $index );
 979                 warn
 980 "TRUNCATION: NON:>@$nontruncated< RIGHT:>@$righttruncated< LEFT:>@$lefttruncated< RIGHTLEFT:>@$rightlefttruncated< REGEX:>@$regexpr<"
 981                   if $DEBUG;
 982
 983                 # Apply Truncation
 984                 if (
 985                     scalar(@$righttruncated) + scalar(@$lefttruncated) +
 986                     scalar(@$rightlefttruncated) > 0 )
 987                 {
 988
 989                # Don't field weight or add the index to the query, we do it here
 990                     $indexes_set = 1;
 991                     undef $weight_fields;
 992                     my $previous_truncation_operand;
 993                     if ( scalar(@$nontruncated) > 0 ) {
 994                         $truncated_operand .= "$index_plus @$nontruncated ";
 995                         $previous_truncation_operand = 1;
 996                     }
 997                     if ( scalar(@$righttruncated) > 0 ) {
 998                         $truncated_operand .= "and "
 999                           if $previous_truncation_operand;
1000                         $truncated_operand .=
1001                           "$index_plus_comma" . "rtrn:@$righttruncated ";
1002                         $previous_truncation_operand = 1;
1003                     }
1004                     if ( scalar(@$lefttruncated) > 0 ) {
1005                         $truncated_operand .= "and "
1006                           if $previous_truncation_operand;
1007                         $truncated_operand .=
1008                           "$index_plus_comma" . "ltrn:@$lefttruncated ";
1009                         $previous_truncation_operand = 1;
1010                     }
1011                     if ( scalar(@$rightlefttruncated) > 0 ) {
1012                         $truncated_operand .= "and "
1013                           if $previous_truncation_operand;
1014                         $truncated_operand .=
1015                           "$index_plus_comma" . "rltrn:@$rightlefttruncated ";
1016                         $previous_truncation_operand = 1;
1017                     }
1018                 }
1019                 $operand = $truncated_operand if $truncated_operand;
1020                 warn "TRUNCATED OPERAND: >$truncated_operand<" if $DEBUG;
1021
1022                 # Handle Stemming
1023                 my $stemmed_operand;
1024                 $stemmed_operand = _build_stemmed_operand($operand)
1025                   if $stemming;
1026                 warn "STEMMED OPERAND: >$stemmed_operand<" if $DEBUG;
1027
1028                 # Handle Field Weighting
1029                 my $weighted_operand;
1030                 $weighted_operand =
1031                   _build_weighted_query( $operand, $stemmed_operand, $index )
1032                   if $weight_fields;
1033                 warn "FIELD WEIGHTED OPERAND: >$weighted_operand<" if $DEBUG;
1034                 $operand = $weighted_operand if $weight_fields;
1035                 $indexes_set = 1 if $weight_fields;
1036
1037                 # If there's a previous operand, we need to add an operator
1038                 if ($previous_operand) {
1039
1040                     # User-specified operator
1041                     if ( $operators[ $i - 1 ] ) {
1042                         $query     .= " $operators[$i-1] ";
1043                         $query     .= " $index_plus " unless $indexes_set;
1044                         $query     .= " $operand";
1045                         $query_cgi .= "&op=$operators[$i-1]";
1046                         $query_cgi .= "&idx=$index" if $index;
1047                         $query_cgi .= "&q=$operands[$i]" if $operands[$i];
1048                         $query_desc .=
1049                           " $operators[$i-1] $index_plus $operands[$i]";
1050                     }
1051
1052                     # Default operator is and
1053                     else {
1054                         $query      .= " and ";
1055                         $query      .= "$index_plus " unless $indexes_set;
1056                         $query      .= "$operand";
1057                         $query_cgi  .= "&op=and&idx=$index" if $index;
1058                         $query_cgi  .= "&q=$operands[$i]" if $operands[$i];
1059                         $query_desc .= " and $index_plus $operands[$i]";
1060                     }
1061                 }
1062
1063                 # There isn't a pervious operand, don't need an operator
1064                 else {
1065
1066                     # Field-weighted queries already have indexes set
1067                     $query .= " $index_plus " unless $indexes_set;
1068                     $query .= $operand;
1069                     $query_desc .= " $index_plus $operands[$i]";
1070                     $query_cgi  .= "&idx=$index" if $index;
1071                     $query_cgi  .= "&q=$operands[$i]" if $operands[$i];
1072                     $previous_operand = 1;
1073                 }
1074             }    #/if $operands
1075         }    # /for
1076     }
1077     warn "QUERY BEFORE LIMITS: >$query<" if $DEBUG;
1078
1079     # add limits
1080     my $group_OR_limits;
1081     my $availability_limit;
1082     foreach my $this_limit (@limits) {
1083         if ( $this_limit =~ /available/ ) {
1084
1085 # 'available' is defined as (items.onloan is NULL) and (items.itemlost = 0)
1086 # In English:
1087 # all records not indexed in the onloan register (zebra) and all records with a value of lost equal to 0
1088             $availability_limit .=
1089 "( ( allrecords,AlwaysMatches='' not onloan,AlwaysMatches='') and (lost,st-numeric=0) )"; #or ( allrecords,AlwaysMatches='' not lost,AlwaysMatches='')) )";
1090             $limit_cgi  .= "&limit=available";
1091             $limit_desc .= "";
1092         }
1093
1094         # group_OR_limits, prefixed by mc-
1095         # OR every member of the group
1096         elsif ( $this_limit =~ /mc/ ) {
1097             $group_OR_limits .= " or " if $group_OR_limits;
1098             $limit_desc      .= " or " if $group_OR_limits;
1099             $group_OR_limits .= "$this_limit";
1100             $limit_cgi       .= "&limit=$this_limit";
1101             $limit_desc      .= " $this_limit";
1102         }
1103
1104         # Regular old limits
1105         else {
1106             if ($this_limit){
1107                 $limit .= " and " if $limit || $query;
1108                 $limit      .= "$this_limit";
1109                 $limit_cgi  .= "&limit=$this_limit";
1110                 $limit_desc .= " $this_limit";
1111                 if ($this_limit =~ /^branch:(.+)/) {
1112                     my $branchcode = $1;
1113                     my $branchname = GetBranchName($branchcode);
1114                     if (defined $branchname) {
1115                         $limit_desc .= " branch:$branchname";
1116                     } else {
1117                         $limit_desc .= " $this_limit";
1118                     }
1119                 } else {
1120                    $limit_desc .= " $this_limit";
1121                 }
1122
1123             }
1124         }
1125     }
1126     if ($group_OR_limits) {
1127         $limit .= " and " if ( $query || $limit );
1128         $limit .= "($group_OR_limits)";
1129     }
1130     if ($availability_limit) {
1131         $limit .= " and " if ( $query || $limit );
1132         $limit .= "($availability_limit)";
1133     }
1134
1135     # Normalize the query and limit strings
1136     $query =~ s/:/=/g;
1137     $limit =~ s/:/=/g;
1138     for ( $query, $query_desc, $limit, $limit_desc ) {
1139         $_ =~ s/  / /g;    # remove extra spaces
1140         $_ =~ s/^ //g;     # remove any beginning spaces
1141         $_ =~ s/ $//g;     # remove any ending spaces
1142         $_ =~ s/==/=/g;    # remove double == from query
1143     }
1144     $query_cgi =~ s/^&//; # remove unnecessary & from beginning of the query cgi
1145
1146     for ($query_cgi,$simple_query) {
1147         $_ =~ s/"//g;
1148     }
1149     # append the limit to the query
1150     $query .= " " . $limit;
1151
1152     # Warnings if DEBUG
1153     if ($DEBUG) {
1154         warn "QUERY:" . $query;
1155         warn "QUERY CGI:" . $query_cgi;
1156         warn "QUERY DESC:" . $query_desc;
1157         warn "LIMIT:" . $limit;
1158         warn "LIMIT CGI:" . $limit_cgi;
1159         warn "LIMIT DESC:" . $limit_desc;
1160         warn "---------\nLeave buildQuery\n---------";
1161     }
1162     return (
1163         undef,              $query, $simple_query, $query_cgi,
1164         $query_desc,        $limit, $limit_cgi,    $limit_desc,
1165         $stopwords_removed, $query_type
1166     );
1167 }
1168
1169 =head2 searchResults
1170
1171 Format results in a form suitable for passing to the template
1172
1173 =cut
1174
1175 # IMO this subroutine is pretty messy still -- it's responsible for
1176 # building the HTML output for the template
1177 sub searchResults {
1178     my ( $searchdesc, $hits, $results_per_page, $offset, $scan, @marcresults ) = @_;
1179     my $dbh = C4::Context->dbh;
1180     my $even = 1;
1181     my @newresults;
1182
1183     # add search-term highlighting via <span>s on the search terms
1184     my $span_terms_hashref;
1185     for my $span_term ( split( / /, $searchdesc ) ) {
1186         $span_term =~ s/(.*=|\)|\(|\+|\.|\*)//g;
1187         $span_terms_hashref->{$span_term}++;
1188     }
1189
1190     #Build branchnames hash
1191     #find branchname
1192     #get branch information.....
1193     my %branches;
1194     my $bsth =
1195       $dbh->prepare("SELECT branchcode,branchname FROM branches")
1196       ;    # FIXME : use C4::Koha::GetBranches
1197     $bsth->execute();
1198     while ( my $bdata = $bsth->fetchrow_hashref ) {
1199         $branches{ $bdata->{'branchcode'} } = $bdata->{'branchname'};
1200     }
1201 # FIXME - We build an authorised values hash here, using the default framework
1202 # though it is possible to have different authvals for different fws.
1203
1204     my $shelflocations =GetKohaAuthorisedValues('items.location','');
1205
1206     # get notforloan authorised value list (see $shelflocations  FIXME)
1207     my $notforloan_authorised_value = GetAuthValCode('items.notforloan','');
1208
1209     #Build itemtype hash
1210     #find itemtype & itemtype image
1211     my %itemtypes;
1212     $bsth =
1213       $dbh->prepare(
1214         "SELECT itemtype,description,imageurl,summary,notforloan FROM itemtypes"
1215       );
1216     $bsth->execute();
1217     while ( my $bdata = $bsth->fetchrow_hashref ) {
1218                 foreach (qw(description imageurl summary notforloan)) {
1219                 $itemtypes{ $bdata->{'itemtype'} }->{$_} = $bdata->{$_};
1220                 }
1221     }
1222
1223     #search item field code
1224     my $sth =
1225       $dbh->prepare(
1226 "SELECT tagfield FROM marc_subfield_structure WHERE kohafield LIKE 'items.itemnumber'"
1227       );
1228     $sth->execute;
1229     my ($itemtag) = $sth->fetchrow;
1230
1231     ## find column names of items related to MARC
1232     my $sth2 = $dbh->prepare("SHOW COLUMNS FROM items");
1233     $sth2->execute;
1234     my %subfieldstosearch;
1235     while ( ( my $column ) = $sth2->fetchrow ) {
1236         my ( $tagfield, $tagsubfield ) =
1237           &GetMarcFromKohaField( "items." . $column, "" );
1238         $subfieldstosearch{$column} = $tagsubfield;
1239     }
1240
1241     # handle which records to actually retrieve
1242     my $times;
1243     if ( $hits && $offset + $results_per_page <= $hits ) {
1244         $times = $offset + $results_per_page;
1245     }
1246     else {
1247         $times = $hits;  # FIXME: if $hits is undefined, why do we want to equal it?
1248     }
1249
1250         my $marcflavour = C4::Context->preference("marcflavour");
1251     # loop through all of the records we've retrieved
1252     for ( my $i = $offset ; $i <= $times - 1 ; $i++ ) {
1253         my $marcrecord = MARC::File::USMARC::decode( $marcresults[$i] );
1254         my $oldbiblio = TransformMarcToKoha( $dbh, $marcrecord, '' );
1255         $oldbiblio->{subtitle} = C4::Biblio::get_koha_field_from_marc('bibliosubtitle', 'subtitle', $marcrecord, '');
1256         $oldbiblio->{result_number} = $i + 1;
1257
1258         # add imageurl to itemtype if there is one
1259         $oldbiblio->{imageurl} = getitemtypeimagelocation( 'opac', $itemtypes{ $oldbiblio->{itemtype} }->{imageurl} );
1260
1261         $oldbiblio->{'authorised_value_images'}  = C4::Items::get_authorised_value_images( C4::Biblio::get_biblio_authorised_values( $oldbiblio->{'biblionumber'}, $marcrecord ) );
1262                 $oldbiblio->{normalized_upc} = GetNormalizedUPC($marcrecord,$marcflavour);
1263                 $oldbiblio->{normalized_ean} = GetNormalizedEAN($marcrecord,$marcflavour);
1264                 $oldbiblio->{normalized_oclc} = GetNormalizedOCLCNumber($marcrecord,$marcflavour);
1265                 $oldbiblio->{normalized_isbn} = GetNormalizedISBN(undef,$marcrecord,$marcflavour);
1266                 $oldbiblio->{content_identifier_exists} = 1 if ($oldbiblio->{normalized_isbn} or $oldbiblio->{normalized_oclc} or $oldbiblio->{normalized_ean} or $oldbiblio->{normalized_upc});
1267
1268                 # edition information, if any
1269         $oldbiblio->{edition} = $oldbiblio->{editionstatement};
1270                 $oldbiblio->{description} = $itemtypes{ $oldbiblio->{itemtype} }->{description};
1271  # Build summary if there is one (the summary is defined in the itemtypes table)
1272  # FIXME: is this used anywhere, I think it can be commented out? -- JF
1273         if ( $itemtypes{ $oldbiblio->{itemtype} }->{summary} ) {
1274             my $summary = $itemtypes{ $oldbiblio->{itemtype} }->{summary};
1275             my @fields  = $marcrecord->fields();
1276             foreach my $field (@fields) {
1277                 my $tag      = $field->tag();
1278                 my $tagvalue = $field->as_string();
1279                 if (! utf8::is_utf8($tagvalue)) {
1280                     utf8::decode($tagvalue);
1281                 }
1282
1283                 $summary =~
1284                   s/\[(.?.?.?.?)$tag\*(.*?)]/$1$tagvalue$2\[$1$tag$2]/g;
1285                 unless ( $tag < 10 ) {
1286                     my @subf = $field->subfields;
1287                     for my $i ( 0 .. $#subf ) {
1288                         my $subfieldcode  = $subf[$i][0];
1289                         my $subfieldvalue = $subf[$i][1];
1290                         if (! utf8::is_utf8($subfieldvalue)) {
1291                             utf8::decode($subfieldvalue);
1292                         }
1293                         my $tagsubf       = $tag . $subfieldcode;
1294                         $summary =~
1295 s/\[(.?.?.?.?)$tagsubf(.*?)]/$1$subfieldvalue$2\[$1$tagsubf$2]/g;
1296                     }
1297                 }
1298             }
1299             # FIXME: yuk
1300             $summary =~ s/\[(.*?)]//g;
1301             $summary =~ s/\n/<br\/>/g;
1302             $oldbiblio->{summary} = $summary;
1303         }
1304
1305         # save an author with no <span> tag, for the <a href=search.pl?q=<!--tmpl_var name="author"-->> link
1306         $oldbiblio->{'author_nospan'} = $oldbiblio->{'author'};
1307         $oldbiblio->{'title_nospan'} = $oldbiblio->{'title'};
1308         $oldbiblio->{'subtitle_nospan'} = $oldbiblio->{'subtitle'};
1309         # Add search-term highlighting to the whole record where they match using <span>s
1310         if (C4::Context->preference("OpacHighlightedWords")){
1311             my $searchhighlightblob;
1312             for my $highlight_field ( $marcrecord->fields ) {
1313
1314     # FIXME: need to skip title, subtitle, author, etc., as they are handled below
1315                 next if $highlight_field->tag() =~ /(^00)/;    # skip fixed fields
1316                 for my $subfield ($highlight_field->subfields()) {
1317                     my $match;
1318                     next if $subfield->[0] eq '9';
1319                     my $field = $subfield->[1];
1320                     for my $term ( keys %$span_terms_hashref ) {
1321                         if ( ( $field =~ /$term/i ) && (( length($term) > 3 ) || ($field =~ / $term /i)) ) {
1322                             $field =~ s/$term/<span class=\"term\">$&<\/span>/gi;
1323                         $match++;
1324                         }
1325                     }
1326                     $searchhighlightblob .= $field . " ... " if $match;
1327                 }
1328
1329             }
1330             $searchhighlightblob = ' ... '.$searchhighlightblob if $searchhighlightblob;
1331             $oldbiblio->{'searchhighlightblob'} = $searchhighlightblob;
1332         }
1333
1334         # Add search-term highlighting to the title, subtitle, etc. fields
1335         for my $term ( keys %$span_terms_hashref ) {
1336             my $old_term = $term;
1337             if ( length($term) > 3 ) {
1338                 $term =~ s/(.*=|\)|\(|\+|\.|\?|\[|\]|\\|\*)//g;
1339                                 foreach(qw(title subtitle author publishercode place pages notes size)) {
1340                         $oldbiblio->{$_} =~ s/$term/<span class=\"term\">$&<\/span>/gi;
1341                                 }
1342             }
1343         }
1344
1345         ($i % 2) and $oldbiblio->{'toggle'} = 1;
1346
1347         # Pull out the items fields
1348         my @fields = $marcrecord->field($itemtag);
1349
1350         # Setting item statuses for display
1351         my @available_items_loop;
1352         my @onloan_items_loop;
1353         my @notforloan_items_loop;
1354         my @other_items_loop;
1355
1356         my $available_items;
1357         my $onloan_items;
1358         my $notforloan_items;
1359         my $other_items;
1360
1361         my $ordered_count         = 0;
1362         my $available_count       = 0;
1363         my $onloan_count          = 0;
1364         my $notforloan_count      = 0;
1365         my $longoverdue_count     = 0;
1366         my $other_count           = 0;
1367         my $wthdrawn_count        = 0;
1368         my $itemlost_count        = 0;
1369         my $itembinding_count     = 0;
1370         my $itemdamaged_count     = 0;
1371         my $item_in_transit_count = 0;
1372         my $can_place_holds       = 0;
1373         my $items_count           = scalar(@fields);
1374         my $maxitems =
1375           ( C4::Context->preference('maxItemsinSearchResults') )
1376           ? C4::Context->preference('maxItemsinSearchResults') - 1
1377           : 1;
1378
1379         # loop through every item
1380         foreach my $field (@fields) {
1381             my $item;
1382
1383             # populate the items hash
1384             foreach my $code ( keys %subfieldstosearch ) {
1385                 $item->{$code} = $field->subfield( $subfieldstosearch{$code} );
1386             }
1387                         my $hbranch     = C4::Context->preference('HomeOrHoldingBranch') eq 'homebranch' ? 'homebranch'    : 'holdingbranch';
1388                         my $otherbranch = C4::Context->preference('HomeOrHoldingBranch') eq 'homebranch' ? 'holdingbranch' : 'homebranch';
1389             # set item's branch name, use HomeOrHoldingBranch syspref first, fall back to the other one
1390             if ($item->{$hbranch}) {
1391                 $item->{'branchname'} = $branches{$item->{$hbranch}};
1392             }
1393             elsif ($item->{$otherbranch}) {     # Last resort
1394                 $item->{'branchname'} = $branches{$item->{$otherbranch}};
1395             }
1396
1397                         my $prefix = $item->{$hbranch} . '--' . $item->{location} . $item->{itype} . $item->{itemcallnumber};
1398 # For each grouping of items (onloan, available, unavailable), we build a key to store relevant info about that item
1399             if ( $item->{onloan} ) {
1400                 $onloan_count++;
1401                                 my $key = $prefix . $item->{due_date};
1402                                 $onloan_items->{$key}->{due_date} = format_date($item->{onloan});
1403                                 $onloan_items->{$key}->{count}++ if $item->{$hbranch};
1404                                 $onloan_items->{$key}->{branchname} = $item->{branchname};
1405                                 $onloan_items->{$key}->{location} = $shelflocations->{ $item->{location} };
1406                                 $onloan_items->{$key}->{itemcallnumber} = $item->{itemcallnumber};
1407                                 $onloan_items->{$key}->{imageurl} = getitemtypeimagelocation( 'opac', $itemtypes{ $item->{itype} }->{imageurl} );
1408                                 $onloan_items->{$key}->{barcode} = $item->{barcode};
1409                 # if something's checked out and lost, mark it as 'long overdue'
1410                 if ( $item->{itemlost} ) {
1411                     $onloan_items->{$prefix}->{longoverdue}++;
1412                     $longoverdue_count++;
1413                 } else {        # can place holds as long as item isn't lost
1414                     $can_place_holds = 1;
1415                 }
1416             }
1417
1418          # items not on loan, but still unavailable ( lost, withdrawn, damaged )
1419             else {
1420
1421                 # item is on order
1422                 if ( $item->{notforloan} == -1 ) {
1423                     $ordered_count++;
1424                 }
1425
1426                 # is item in transit?
1427                 my $transfertwhen = '';
1428                 my ($transfertfrom, $transfertto);
1429
1430                 unless ($item->{wthdrawn}
1431                         || $item->{itemlost}
1432                         || $item->{damaged}
1433                         || $item->{notforloan}
1434                         || $items_count > 20) {
1435
1436                     # A couple heuristics to limit how many times
1437                     # we query the database for item transfer information, sacrificing
1438                     # accuracy in some cases for speed;
1439                     #
1440                     # 1. don't query if item has one of the other statuses
1441                     # 2. don't check transit status if the bib has
1442                     #    more than 20 items
1443                     #
1444                     # FIXME: to avoid having the query the database like this, and to make
1445                     #        the in transit status count as unavailable for search limiting,
1446                     #        should map transit status to record indexed in Zebra.
1447                     #
1448                     ($transfertwhen, $transfertfrom, $transfertto) = C4::Circulation::GetTransfers($item->{itemnumber});
1449                 }
1450
1451                 # item is withdrawn, lost or damaged
1452                 if (   $item->{wthdrawn}
1453                     || $item->{itemlost}
1454                     || $item->{damaged}
1455                     || $item->{notforloan}
1456                     || ($transfertwhen ne ''))
1457                 {
1458                     $wthdrawn_count++        if $item->{wthdrawn};
1459                     $itemlost_count++        if $item->{itemlost};
1460                     $itemdamaged_count++     if $item->{damaged};
1461                     $item_in_transit_count++ if $transfertwhen ne '';
1462                     $item->{status} = $item->{wthdrawn} . "-" . $item->{itemlost} . "-" . $item->{damaged} . "-" . $item->{notforloan};
1463                     $other_count++;
1464
1465                                         my $key = $prefix . $item->{status};
1466
1467                                         foreach (qw(wthdrawn itemlost damaged branchname itemcallnumber)) {
1468                         $other_items->{$key}->{$_} = $item->{$_};
1469                                         }
1470                     $other_items->{$key}->{intransit} = ($transfertwhen ne '') ? 1 : 0;
1471                                         $other_items->{$key}->{notforloan} = GetAuthorisedValueDesc('','',$item->{notforloan},'','',$notforloan_authorised_value) if $notforloan_authorised_value;
1472                                         $other_items->{$key}->{count}++ if $item->{$hbranch};
1473                                         $other_items->{$key}->{location} = $shelflocations->{ $item->{location} };
1474                                         $other_items->{$key}->{imageurl} = getitemtypeimagelocation( 'opac', $itemtypes{ $item->{itype} }->{imageurl} );
1475                 }
1476                 # item is available
1477                 else {
1478                     $can_place_holds = 1;
1479                     $available_count++;
1480                                         $available_items->{$prefix}->{count}++ if $item->{$hbranch};
1481                                         foreach (qw(branchname itemcallnumber barcode)) {
1482                         $available_items->{$prefix}->{$_} = $item->{$_};
1483                                         }
1484                                         $available_items->{$prefix}->{location} = $shelflocations->{ $item->{location} };
1485                                         $available_items->{$prefix}->{imageurl} = getitemtypeimagelocation( 'opac', $itemtypes{ $item->{itype} }->{imageurl} );
1486                 }
1487             }
1488         }    # notforloan, item level and biblioitem level
1489         my ( $availableitemscount, $onloanitemscount, $notforloanitemscount,$otheritemscount );
1490         $maxitems =
1491           ( C4::Context->preference('maxItemsinSearchResults') )
1492           ? C4::Context->preference('maxItemsinSearchResults') - 1
1493           : 1;
1494         for my $key ( sort keys %$onloan_items ) {
1495             (++$onloanitemscount > $maxitems) and last;
1496             push @onloan_items_loop, $onloan_items->{$key};
1497         }
1498         for my $key ( sort keys %$other_items ) {
1499             (++$otheritemscount > $maxitems) and last;
1500             push @other_items_loop, $other_items->{$key};
1501         }
1502         for my $key ( sort keys %$notforloan_items ) {
1503             (++$notforloanitemscount > $maxitems) and last;
1504             push @notforloan_items_loop, $notforloan_items->{$key};
1505         }
1506         for my $key ( sort keys %$available_items ) {
1507             (++$availableitemscount > $maxitems) and last;
1508             push @available_items_loop, $available_items->{$key}
1509         }
1510
1511         # XSLT processing of some stuff
1512         if (C4::Context->preference("XSLTResultsDisplay") && !$scan) {
1513             $oldbiblio->{XSLTResultsRecord} = XSLTParse4Display(
1514                 $oldbiblio->{biblionumber}, $marcrecord, 'Results' );
1515         }
1516
1517         # last check for norequest : if itemtype is notforloan, it can't be reserved either, whatever the items
1518         $can_place_holds = 0 if $itemtypes{ $oldbiblio->{itemtype} }->{notforloan};
1519         $oldbiblio->{norequests} = 1 unless $can_place_holds;
1520         $oldbiblio->{itemsplural}          = 1 if $items_count > 1;
1521         $oldbiblio->{items_count}          = $items_count;
1522         $oldbiblio->{available_items_loop} = \@available_items_loop;
1523         $oldbiblio->{notforloan_items_loop}= \@notforloan_items_loop;
1524         $oldbiblio->{onloan_items_loop}    = \@onloan_items_loop;
1525         $oldbiblio->{other_items_loop}     = \@other_items_loop;
1526         $oldbiblio->{availablecount}       = $available_count;
1527         $oldbiblio->{availableplural}      = 1 if $available_count > 1;
1528         $oldbiblio->{onloancount}          = $onloan_count;
1529         $oldbiblio->{onloanplural}         = 1 if $onloan_count > 1;
1530         $oldbiblio->{notforloancount}      = $notforloan_count;
1531         $oldbiblio->{othercount}           = $other_count;
1532         $oldbiblio->{otherplural}          = 1 if $other_count > 1;
1533         $oldbiblio->{wthdrawncount}        = $wthdrawn_count;
1534         $oldbiblio->{itemlostcount}        = $itemlost_count;
1535         $oldbiblio->{damagedcount}         = $itemdamaged_count;
1536         $oldbiblio->{intransitcount}       = $item_in_transit_count;
1537         $oldbiblio->{orderedcount}         = $ordered_count;
1538         push( @newresults, $oldbiblio );
1539     }
1540     return @newresults;
1541 }
1542
1543 #----------------------------------------------------------------------
1544 #
1545 # Non-Zebra GetRecords#
1546 #----------------------------------------------------------------------
1547
1548 =head2 NZgetRecords
1549
1550   NZgetRecords has the same API as zera getRecords, even if some parameters are not managed
1551
1552 =cut
1553
1554 sub NZgetRecords {
1555     my (
1556         $query,            $simple_query, $sort_by_ref,    $servers_ref,
1557         $results_per_page, $offset,       $expanded_facet, $branches,
1558         $query_type,       $scan
1559     ) = @_;
1560     warn "query =$query" if $DEBUG;
1561     my $result = NZanalyse($query);
1562     warn "results =$result" if $DEBUG;
1563     return ( undef,
1564         NZorder( $result, @$sort_by_ref[0], $results_per_page, $offset ),
1565         undef );
1566 }
1567
1568 =head2 NZanalyse
1569
1570   NZanalyse : get a CQL string as parameter, and returns a list of biblionumber;title,biblionumber;title,...
1571   the list is built from an inverted index in the nozebra SQL table
1572   note that title is here only for convenience : the sorting will be very fast when requested on title
1573   if the sorting is requested on something else, we will have to reread all results, and that may be longer.
1574
1575 =cut
1576
1577 sub NZanalyse {
1578     my ( $string, $server ) = @_;
1579 #     warn "---------"       if $DEBUG;
1580     warn " NZanalyse" if $DEBUG;
1581 #     warn "---------"       if $DEBUG;
1582
1583  # $server contains biblioserver or authorities, depending on what we search on.
1584  #warn "querying : $string on $server";
1585     $server = 'biblioserver' unless $server;
1586
1587 # if we have a ", replace the content to discard temporarily any and/or/not inside
1588     my $commacontent;
1589     if ( $string =~ /"/ ) {
1590         $string =~ s/"(.*?)"/__X__/;
1591         $commacontent = $1;
1592         warn "commacontent : $commacontent" if $DEBUG;
1593     }
1594
1595 # split the query string in 3 parts : X AND Y means : $left="X", $operand="AND" and $right="Y"
1596 # then, call again NZanalyse with $left and $right
1597 # (recursive until we find a leaf (=> something without and/or/not)
1598 # delete repeated operator... Would then go in infinite loop
1599     while ( $string =~ s/( and| or| not| AND| OR| NOT)\1/$1/g ) {
1600     }
1601
1602     #process parenthesis before.
1603     if ( $string =~ /^\s*\((.*)\)(( and | or | not | AND | OR | NOT )(.*))?/ ) {
1604         my $left     = $1;
1605         my $right    = $4;
1606         my $operator = lc($3);   # FIXME: and/or/not are operators, not operands
1607         warn
1608 "dealing w/parenthesis before recursive sub call. left :$left operator:$operator right:$right"
1609           if $DEBUG;
1610         my $leftresult = NZanalyse( $left, $server );
1611         if ($operator) {
1612             my $rightresult = NZanalyse( $right, $server );
1613
1614             # OK, we have the results for right and left part of the query
1615             # depending of operand, intersect, union or exclude both lists
1616             # to get a result list
1617             if ( $operator eq ' and ' ) {
1618                 return NZoperatorAND($leftresult,$rightresult);
1619             }
1620             elsif ( $operator eq ' or ' ) {
1621
1622                 # just merge the 2 strings
1623                 return $leftresult . $rightresult;
1624             }
1625             elsif ( $operator eq ' not ' ) {
1626                 return NZoperatorNOT($leftresult,$rightresult);
1627             }
1628         }
1629         else {
1630 # this error is impossible, because of the regexp that isolate the operand, but just in case...
1631             return $leftresult;
1632         }
1633     }
1634     warn "string :" . $string if $DEBUG;
1635     my $left = "";
1636     my $right = "";
1637     my $operator = "";
1638     if ($string =~ /(.*?)( and | or | not | AND | OR | NOT )(.*)/) {
1639         $left     = $1;
1640         $right    = $3;
1641         $operator = lc($2);    # FIXME: and/or/not are operators, not operands
1642     }
1643     warn "no parenthesis. left : $left operator: $operator right: $right"
1644       if $DEBUG;
1645
1646     # it's not a leaf, we have a and/or/not
1647     if ($operator) {
1648
1649         # reintroduce comma content if needed
1650         $right =~ s/__X__/"$commacontent"/ if $commacontent;
1651         $left  =~ s/__X__/"$commacontent"/ if $commacontent;
1652         warn "node : $left / $operator / $right\n" if $DEBUG;
1653         my $leftresult  = NZanalyse( $left,  $server );
1654         my $rightresult = NZanalyse( $right, $server );
1655         warn " leftresult : $leftresult" if $DEBUG;
1656         warn " rightresult : $rightresult" if $DEBUG;
1657         # OK, we have the results for right and left part of the query
1658         # depending of operand, intersect, union or exclude both lists
1659         # to get a result list
1660         if ( $operator eq ' and ' ) {
1661             warn "NZAND";
1662             return NZoperatorAND($leftresult,$rightresult);
1663         }
1664         elsif ( $operator eq ' or ' ) {
1665
1666             # just merge the 2 strings
1667             return $leftresult . $rightresult;
1668         }
1669         elsif ( $operator eq ' not ' ) {
1670             return NZoperatorNOT($leftresult,$rightresult);
1671         }
1672         else {
1673
1674 # this error is impossible, because of the regexp that isolate the operand, but just in case...
1675             die "error : operand unknown : $operator for $string";
1676         }
1677
1678         # it's a leaf, do the real SQL query and return the result
1679     }
1680     else {
1681         $string =~ s/__X__/"$commacontent"/ if $commacontent;
1682         $string =~ s/-|\.|\?|,|;|!|'|\(|\)|\[|\]|{|}|"|&|\+|\*|\// /g;
1683         #remove trailing blank at the beginning
1684         $string =~ s/^ //g;
1685         warn "leaf:$string" if $DEBUG;
1686
1687         # parse the string in in operator/operand/value again
1688         my $left = "";
1689         my $operator = "";
1690         my $right = "";
1691         if ($string =~ /(.*)(>=|<=)(.*)/) {
1692             $left     = $1;
1693             $operator = $2;
1694             $right    = $3;
1695         } else {
1696             $left = $string;
1697         }
1698 #         warn "handling leaf... left:$left operator:$operator right:$right"
1699 #           if $DEBUG;
1700         unless ($operator) {
1701             if ($string =~ /(.*)(>|<|=)(.*)/) {
1702                 $left     = $1;
1703                 $operator = $2;
1704                 $right    = $3;
1705                 warn
1706     "handling unless (operator)... left:$left operator:$operator right:$right"
1707                 if $DEBUG;
1708             } else {
1709                 $left = $string;
1710             }
1711         }
1712         my $results;
1713
1714 # strip adv, zebra keywords, currently not handled in nozebra: wrdl, ext, phr...
1715         $left =~ s/ .*$//;
1716
1717         # automatic replace for short operators
1718         $left = 'title'            if $left =~ '^ti$';
1719         $left = 'author'           if $left =~ '^au$';
1720         $left = 'publisher'        if $left =~ '^pb$';
1721         $left = 'subject'          if $left =~ '^su$';
1722         $left = 'koha-Auth-Number' if $left =~ '^an$';
1723         $left = 'keyword'          if $left =~ '^kw$';
1724         warn "handling leaf... left:$left operator:$operator right:$right" if $DEBUG;
1725         if ( $operator && $left ne 'keyword' ) {
1726
1727             #do a specific search
1728             my $dbh = C4::Context->dbh;
1729             $operator = 'LIKE' if $operator eq '=' and $right =~ /%/;
1730             my $sth =
1731               $dbh->prepare(
1732 "SELECT biblionumbers,value FROM nozebra WHERE server=? AND indexname=? AND value $operator ?"
1733               );
1734             warn "$left / $operator / $right\n" if $DEBUG;
1735
1736             # split each word, query the DB and build the biblionumbers result
1737             #sanitizing leftpart
1738             $left =~ s/^\s+|\s+$//;
1739             foreach ( split / /, $right ) {
1740                 my $biblionumbers;
1741                 $_ =~ s/^\s+|\s+$//;
1742                 next unless $_;
1743                 warn "EXECUTE : $server, $left, $_" if $DEBUG;
1744                 $sth->execute( $server, $left, $_ )
1745                   or warn "execute failed: $!";
1746                 while ( my ( $line, $value ) = $sth->fetchrow ) {
1747
1748 # if we are dealing with a numeric value, use only numeric results (in case of >=, <=, > or <)
1749 # otherwise, fill the result
1750                     $biblionumbers .= $line
1751                       unless ( $right =~ /^\d+$/ && $value =~ /\D/ );
1752                     warn "result : $value "
1753                       . ( $right  =~ /\d/ ) . "=="
1754                       . ( $value =~ /\D/?$line:"" ) if $DEBUG;         #= $line";
1755                 }
1756
1757 # do a AND with existing list if there is one, otherwise, use the biblionumbers list as 1st result list
1758                 if ($results) {
1759                     warn "NZAND" if $DEBUG;
1760                     $results = NZoperatorAND($biblionumbers,$results);
1761                 }
1762                 else {
1763                     $results = $biblionumbers;
1764                 }
1765             }
1766         }
1767         else {
1768
1769       #do a complete search (all indexes), if index='kw' do complete search too.
1770             my $dbh = C4::Context->dbh;
1771             my $sth =
1772               $dbh->prepare(
1773 "SELECT biblionumbers FROM nozebra WHERE server=? AND value LIKE ?"
1774               );
1775
1776             # split each word, query the DB and build the biblionumbers result
1777             foreach ( split / /, $string ) {
1778                 next if C4::Context->stopwords->{ uc($_) };   # skip if stopword
1779                 warn "search on all indexes on $_" if $DEBUG;
1780                 my $biblionumbers;
1781                 next unless $_;
1782                 $sth->execute( $server, $_ );
1783                 while ( my $line = $sth->fetchrow ) {
1784                     $biblionumbers .= $line;
1785                 }
1786
1787 # do a AND with existing list if there is one, otherwise, use the biblionumbers list as 1st result list
1788                 if ($results) {
1789                     $results = NZoperatorAND($biblionumbers,$results);
1790                 }
1791                 else {
1792                     warn "NEW RES for $_ = $biblionumbers" if $DEBUG;
1793                     $results = $biblionumbers;
1794                 }
1795             }
1796         }
1797         warn "return : $results for LEAF : $string" if $DEBUG;
1798         return $results;
1799     }
1800     warn "---------\nLeave NZanalyse\n---------" if $DEBUG;
1801 }
1802
1803 sub NZoperatorAND{
1804     my ($rightresult, $leftresult)=@_;
1805
1806     my @leftresult = split /;/, $leftresult;
1807     warn " @leftresult / $rightresult \n" if $DEBUG;
1808
1809     #             my @rightresult = split /;/,$leftresult;
1810     my $finalresult;
1811
1812 # parse the left results, and if the biblionumber exist in the right result, save it in finalresult
1813 # the result is stored twice, to have the same weight for AND than OR.
1814 # example : TWO : 61,61,64,121 (two is twice in the biblio #61) / TOWER : 61,64,130
1815 # result : 61,61,61,61,64,64 for two AND tower : 61 has more weight than 64
1816     foreach (@leftresult) {
1817         my $value = $_;
1818         my $countvalue;
1819         ( $value, $countvalue ) = ( $1, $2 ) if ($value=~/(.*)-(\d+)$/);
1820         if ( $rightresult =~ /\Q$value\E-(\d+);/ ) {
1821             $countvalue = ( $1 > $countvalue ? $countvalue : $1 );
1822             $finalresult .=
1823                 "$value-$countvalue;$value-$countvalue;";
1824         }
1825     }
1826     warn "NZAND DONE : $finalresult \n" if $DEBUG;
1827     return $finalresult;
1828 }
1829
1830 sub NZoperatorOR{
1831     my ($rightresult, $leftresult)=@_;
1832     return $rightresult.$leftresult;
1833 }
1834
1835 sub NZoperatorNOT{
1836     my ($leftresult, $rightresult)=@_;
1837
1838     my @leftresult = split /;/, $leftresult;
1839
1840     #             my @rightresult = split /;/,$leftresult;
1841     my $finalresult;
1842     foreach (@leftresult) {
1843         my $value=$_;
1844         $value=$1 if $value=~m/(.*)-\d+$/;
1845         unless ($rightresult =~ "$value-") {
1846             $finalresult .= "$_;";
1847         }
1848     }
1849     return $finalresult;
1850 }
1851
1852 =head2 NZorder
1853
1854   $finalresult = NZorder($biblionumbers, $ordering,$results_per_page,$offset);
1855
1856   TODO :: Description
1857
1858 =cut
1859
1860 sub NZorder {
1861     my ( $biblionumbers, $ordering, $results_per_page, $offset ) = @_;
1862     warn "biblionumbers = $biblionumbers and ordering = $ordering\n" if $DEBUG;
1863
1864     # order title asc by default
1865     #     $ordering = '1=36 <i' unless $ordering;
1866     $results_per_page = 20 unless $results_per_page;
1867     $offset           = 0  unless $offset;
1868     my $dbh = C4::Context->dbh;
1869
1870     #
1871     # order by POPULARITY
1872     #
1873     if ( $ordering =~ /popularity/ ) {
1874         my %result;
1875         my %popularity;
1876
1877         # popularity is not in MARC record, it's builded from a specific query
1878         my $sth =
1879           $dbh->prepare("select sum(issues) from items where biblionumber=?");
1880         foreach ( split /;/, $biblionumbers ) {
1881             my ( $biblionumber, $title ) = split /,/, $_;
1882             $result{$biblionumber} = GetMarcBiblio($biblionumber);
1883             $sth->execute($biblionumber);
1884             my $popularity = $sth->fetchrow || 0;
1885
1886 # hint : the key is popularity.title because we can have
1887 # many results with the same popularity. In this cas, sub-ordering is done by title
1888 # we also have biblionumber to avoid bug for 2 biblios with the same title & popularity
1889 # (un-frequent, I agree, but we won't forget anything that way ;-)
1890             $popularity{ sprintf( "%10d", $popularity ) . $title
1891                   . $biblionumber } = $biblionumber;
1892         }
1893
1894     # sort the hash and return the same structure as GetRecords (Zebra querying)
1895         my $result_hash;
1896         my $numbers = 0;
1897         if ( $ordering eq 'popularity_dsc' ) {    # sort popularity DESC
1898             foreach my $key ( sort { $b cmp $a } ( keys %popularity ) ) {
1899                 $result_hash->{'RECORDS'}[ $numbers++ ] =
1900                   $result{ $popularity{$key} }->as_usmarc();
1901             }
1902         }
1903         else {                                    # sort popularity ASC
1904             foreach my $key ( sort ( keys %popularity ) ) {
1905                 $result_hash->{'RECORDS'}[ $numbers++ ] =
1906                   $result{ $popularity{$key} }->as_usmarc();
1907             }
1908         }
1909         my $finalresult = ();
1910         $result_hash->{'hits'}         = $numbers;
1911         $finalresult->{'biblioserver'} = $result_hash;
1912         return $finalresult;
1913
1914         #
1915         # ORDER BY author
1916         #
1917     }
1918     elsif ( $ordering =~ /author/ ) {
1919         my %result;
1920         foreach ( split /;/, $biblionumbers ) {
1921             my ( $biblionumber, $title ) = split /,/, $_;
1922             my $record = GetMarcBiblio($biblionumber);
1923             my $author;
1924             if ( C4::Context->preference('marcflavour') eq 'UNIMARC' ) {
1925                 $author = $record->subfield( '200', 'f' );
1926                 $author = $record->subfield( '700', 'a' ) unless $author;
1927             }
1928             else {
1929                 $author = $record->subfield( '100', 'a' );
1930             }
1931
1932 # hint : the result is sorted by title.biblionumber because we can have X biblios with the same title
1933 # and we don't want to get only 1 result for each of them !!!
1934             $result{ $author . $biblionumber } = $record;
1935         }
1936
1937     # sort the hash and return the same structure as GetRecords (Zebra querying)
1938         my $result_hash;
1939         my $numbers = 0;
1940         if ( $ordering eq 'author_za' ) {    # sort by author desc
1941             foreach my $key ( sort { $b cmp $a } ( keys %result ) ) {
1942                 $result_hash->{'RECORDS'}[ $numbers++ ] =
1943                   $result{$key}->as_usmarc();
1944             }
1945         }
1946         else {                               # sort by author ASC
1947             foreach my $key ( sort ( keys %result ) ) {
1948                 $result_hash->{'RECORDS'}[ $numbers++ ] =
1949                   $result{$key}->as_usmarc();
1950             }
1951         }
1952         my $finalresult = ();
1953         $result_hash->{'hits'}         = $numbers;
1954         $finalresult->{'biblioserver'} = $result_hash;
1955         return $finalresult;
1956
1957         #
1958         # ORDER BY callnumber
1959         #
1960     }
1961     elsif ( $ordering =~ /callnumber/ ) {
1962         my %result;
1963         foreach ( split /;/, $biblionumbers ) {
1964             my ( $biblionumber, $title ) = split /,/, $_;
1965             my $record = GetMarcBiblio($biblionumber);
1966             my $callnumber;
1967             my $frameworkcode = GetFrameworkCode($biblionumber);
1968             my ( $callnumber_tag, $callnumber_subfield ) = GetMarcFromKohaField(  'items.itemcallnumber', $frameworkcode);
1969                ( $callnumber_tag, $callnumber_subfield ) = GetMarcFromKohaField('biblioitems.callnumber', $frameworkcode)
1970                 unless $callnumber_tag;
1971             if ( C4::Context->preference('marcflavour') eq 'UNIMARC' ) {
1972                 $callnumber = $record->subfield( '200', 'f' );
1973             }
1974             else {
1975                 $callnumber = $record->subfield( '100', 'a' );
1976             }
1977
1978 # hint : the result is sorted by title.biblionumber because we can have X biblios with the same title
1979 # and we don't want to get only 1 result for each of them !!!
1980             $result{ $callnumber . $biblionumber } = $record;
1981         }
1982
1983     # sort the hash and return the same structure as GetRecords (Zebra querying)
1984         my $result_hash;
1985         my $numbers = 0;
1986         if ( $ordering eq 'call_number_dsc' ) {    # sort by title desc
1987             foreach my $key ( sort { $b cmp $a } ( keys %result ) ) {
1988                 $result_hash->{'RECORDS'}[ $numbers++ ] =
1989                   $result{$key}->as_usmarc();
1990             }
1991         }
1992         else {                                     # sort by title ASC
1993             foreach my $key ( sort { $a cmp $b } ( keys %result ) ) {
1994                 $result_hash->{'RECORDS'}[ $numbers++ ] =
1995                   $result{$key}->as_usmarc();
1996             }
1997         }
1998         my $finalresult = ();
1999         $result_hash->{'hits'}         = $numbers;
2000         $finalresult->{'biblioserver'} = $result_hash;
2001         return $finalresult;
2002     }
2003     elsif ( $ordering =~ /pubdate/ ) {             #pub year
2004         my %result;
2005         foreach ( split /;/, $biblionumbers ) {
2006             my ( $biblionumber, $title ) = split /,/, $_;
2007             my $record = GetMarcBiblio($biblionumber);
2008             my ( $publicationyear_tag, $publicationyear_subfield ) =
2009               GetMarcFromKohaField( 'biblioitems.publicationyear', '' );
2010             my $publicationyear =
2011               $record->subfield( $publicationyear_tag,
2012                 $publicationyear_subfield );
2013
2014 # hint : the result is sorted by title.biblionumber because we can have X biblios with the same title
2015 # and we don't want to get only 1 result for each of them !!!
2016             $result{ $publicationyear . $biblionumber } = $record;
2017         }
2018
2019     # sort the hash and return the same structure as GetRecords (Zebra querying)
2020         my $result_hash;
2021         my $numbers = 0;
2022         if ( $ordering eq 'pubdate_dsc' ) {    # sort by pubyear desc
2023             foreach my $key ( sort { $b cmp $a } ( keys %result ) ) {
2024                 $result_hash->{'RECORDS'}[ $numbers++ ] =
2025                   $result{$key}->as_usmarc();
2026             }
2027         }
2028         else {                                 # sort by pub year ASC
2029             foreach my $key ( sort ( keys %result ) ) {
2030                 $result_hash->{'RECORDS'}[ $numbers++ ] =
2031                   $result{$key}->as_usmarc();
2032             }
2033         }
2034         my $finalresult = ();
2035         $result_hash->{'hits'}         = $numbers;
2036         $finalresult->{'biblioserver'} = $result_hash;
2037         return $finalresult;
2038
2039         #
2040         # ORDER BY title
2041         #
2042     }
2043     elsif ( $ordering =~ /title/ ) {
2044
2045 # the title is in the biblionumbers string, so we just need to build a hash, sort it and return
2046         my %result;
2047         foreach ( split /;/, $biblionumbers ) {
2048             my ( $biblionumber, $title ) = split /,/, $_;
2049
2050 # hint : the result is sorted by title.biblionumber because we can have X biblios with the same title
2051 # and we don't want to get only 1 result for each of them !!!
2052 # hint & speed improvement : we can order without reading the record
2053 # so order, and read records only for the requested page !
2054             $result{ $title . $biblionumber } = $biblionumber;
2055         }
2056
2057     # sort the hash and return the same structure as GetRecords (Zebra querying)
2058         my $result_hash;
2059         my $numbers = 0;
2060         if ( $ordering eq 'title_az' ) {    # sort by title desc
2061             foreach my $key ( sort ( keys %result ) ) {
2062                 $result_hash->{'RECORDS'}[ $numbers++ ] = $result{$key};
2063             }
2064         }
2065         else {                              # sort by title ASC
2066             foreach my $key ( sort { $b cmp $a } ( keys %result ) ) {
2067                 $result_hash->{'RECORDS'}[ $numbers++ ] = $result{$key};
2068             }
2069         }
2070
2071         # limit the $results_per_page to result size if it's more
2072         $results_per_page = $numbers - 1 if $numbers < $results_per_page;
2073
2074         # for the requested page, replace biblionumber by the complete record
2075         # speed improvement : avoid reading too much things
2076         for (
2077             my $counter = $offset ;
2078             $counter <= $offset + $results_per_page ;
2079             $counter++
2080           )
2081         {
2082             $result_hash->{'RECORDS'}[$counter] =
2083               GetMarcBiblio( $result_hash->{'RECORDS'}[$counter] )->as_usmarc;
2084         }
2085         my $finalresult = ();
2086         $result_hash->{'hits'}         = $numbers;
2087         $finalresult->{'biblioserver'} = $result_hash;
2088         return $finalresult;
2089     }
2090     else {
2091
2092 #
2093 # order by ranking
2094 #
2095 # we need 2 hashes to order by ranking : the 1st one to count the ranking, the 2nd to order by ranking
2096         my %result;
2097         my %count_ranking;
2098         foreach ( split /;/, $biblionumbers ) {
2099             my ( $biblionumber, $title ) = split /,/, $_;
2100             $title =~ /(.*)-(\d)/;
2101
2102             # get weight
2103             my $ranking = $2;
2104
2105 # note that we + the ranking because ranking is calculated on weight of EACH term requested.
2106 # if we ask for "two towers", and "two" has weight 2 in biblio N, and "towers" has weight 4 in biblio N
2107 # biblio N has ranking = 6
2108             $count_ranking{$biblionumber} += $ranking;
2109         }
2110
2111 # build the result by "inverting" the count_ranking hash
2112 # 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
2113 #         warn "counting";
2114         foreach ( keys %count_ranking ) {
2115             $result{ sprintf( "%10d", $count_ranking{$_} ) . '-' . $_ } = $_;
2116         }
2117
2118     # sort the hash and return the same structure as GetRecords (Zebra querying)
2119         my $result_hash;
2120         my $numbers = 0;
2121         foreach my $key ( sort { $b cmp $a } ( keys %result ) ) {
2122             $result_hash->{'RECORDS'}[ $numbers++ ] = $result{$key};
2123         }
2124
2125         # limit the $results_per_page to result size if it's more
2126         $results_per_page = $numbers - 1 if $numbers < $results_per_page;
2127
2128         # for the requested page, replace biblionumber by the complete record
2129         # speed improvement : avoid reading too much things
2130         for (
2131             my $counter = $offset ;
2132             $counter <= $offset + $results_per_page ;
2133             $counter++
2134           )
2135         {
2136             $result_hash->{'RECORDS'}[$counter] =
2137               GetMarcBiblio( $result_hash->{'RECORDS'}[$counter] )->as_usmarc
2138               if $result_hash->{'RECORDS'}[$counter];
2139         }
2140         my $finalresult = ();
2141         $result_hash->{'hits'}         = $numbers;
2142         $finalresult->{'biblioserver'} = $result_hash;
2143         return $finalresult;
2144     }
2145 }
2146
2147 =head2 enabled_staff_search_views
2148
2149 %hash = enabled_staff_search_views()
2150
2151 This function returns a hash that contains three flags obtained from the system
2152 preferences, used to determine whether a particular staff search results view
2153 is enabled.
2154
2155 =over 2
2156
2157 =item C<Output arg:>
2158
2159     * $hash{can_view_MARC} is true only if the MARC view is enabled
2160     * $hash{can_view_ISBD} is true only if the ISBD view is enabled
2161     * $hash{can_view_labeledMARC} is true only if the Labeled MARC view is enabled
2162
2163 =item C<usage in the script:>
2164
2165 =back
2166
2167 $template->param ( C4::Search::enabled_staff_search_views );
2168
2169 =cut
2170
2171 sub enabled_staff_search_views
2172 {
2173         return (
2174                 can_view_MARC                   => C4::Context->preference('viewMARC'),                 # 1 if the staff search allows the MARC view
2175                 can_view_ISBD                   => C4::Context->preference('viewISBD'),                 # 1 if the staff search allows the ISBD view
2176                 can_view_labeledMARC    => C4::Context->preference('viewLabeledMARC'),  # 1 if the staff search allows the Labeled MARC view
2177         );
2178 }
2179
2180
2181 =head2 z3950_search_args
2182
2183 $arrayref = z3950_search_args($matchpoints)
2184
2185 This function returns an array reference that contains the search parameters to be
2186 passed to the Z39.50 search script (z3950_search.pl). The array elements
2187 are hash refs whose keys are name, value and encvalue, and whose values are the
2188 name of a search parameter, the value of that search parameter and the URL encoded
2189 value of that parameter.
2190
2191 The search parameter names are lccn, isbn, issn, title, author, dewey and subject.
2192
2193 The search parameter values are obtained from the bibliographic record whose
2194 data is in a hash reference in $matchpoints, as returned by Biblio::GetBiblioData().
2195
2196 If $matchpoints is a scalar, it is assumed to be an unnamed query descriptor, e.g.
2197 a general purpose search argument. In this case, the returned array contains only
2198 entry: the key is 'title' and the value and encvalue are derived from $matchpoints.
2199
2200 If a search parameter value is undefined or empty, it is not included in the returned
2201 array.
2202
2203 The returned array reference may be passed directly to the template parameters.
2204
2205 =over 2
2206
2207 =item C<Output arg:>
2208
2209     * $array containing hash refs as described above
2210
2211 =item C<usage in the script:>
2212
2213 =back
2214
2215 $data = Biblio::GetBiblioData($bibno);
2216 $template->param ( MYLOOP => C4::Search::z3950_search_args($data) )
2217
2218 *OR*
2219
2220 $template->param ( MYLOOP => C4::Search::z3950_search_args($searchscalar) )
2221
2222 =cut
2223
2224 sub z3950_search_args {
2225     my $bibrec = shift;
2226     $bibrec = { title => $bibrec } if !ref $bibrec;
2227     my $array = [];
2228     for my $field (qw/ lccn isbn issn title author dewey subject /)
2229     {
2230         my $encvalue = URI::Escape::uri_escape_utf8($bibrec->{$field});
2231         push @$array, { name=>$field, value=>$bibrec->{$field}, encvalue=>$encvalue } if defined $bibrec->{$field};
2232     }
2233     return $array;
2234 }
2235
2236
2237 END { }    # module clean-up code here (global destructor)
2238
2239 1;
2240 __END__
2241
2242 =head1 AUTHOR
2243
2244 Koha Developement team <info@koha.org>
2245
2246 =cut