C4/Search.pm

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