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