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