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