C4/Search.pm

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