C4/Search.pm

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