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