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 $biblio_authorised_value_images = C4::Items::get_authorised_value_images( C4::Biblio::get_biblio_authorised_values( $oldbiblio->{biblionumber} ) );
1258                 $oldbiblio->{authorised_value_images} = $biblio_authorised_value_images;
1259         my $aisbn = $oldbiblio->{'isbn'};
1260         $aisbn =~ /(\d*[X]*)/;
1261         $oldbiblio->{amazonisbn} = $1;
1262                 $oldbiblio->{description} = $itemtypes{ $oldbiblio->{itemtype} }->{description};
1263  # Build summary if there is one (the summary is defined in the itemtypes table)
1264  # FIXME: is this used anywhere, I think it can be commented out? -- JF
1265         if ( $itemtypes{ $oldbiblio->{itemtype} }->{summary} ) {
1266             my $summary = $itemtypes{ $oldbiblio->{itemtype} }->{summary};
1267             my @fields  = $marcrecord->fields();
1268             foreach my $field (@fields) {
1269                 my $tag      = $field->tag();
1270                 my $tagvalue = $field->as_string();
1271                 $summary =~
1272                   s/\[(.?.?.?.?)$tag\*(.*?)]/$1$tagvalue$2\[$1$tag$2]/g;
1273                 unless ( $tag < 10 ) {
1274                     my @subf = $field->subfields;
1275                     for my $i ( 0 .. $#subf ) {
1276                         my $subfieldcode  = $subf[$i][0];
1277                         my $subfieldvalue = $subf[$i][1];
1278                         my $tagsubf       = $tag . $subfieldcode;
1279                         $summary =~
1280 s/\[(.?.?.?.?)$tagsubf(.*?)]/$1$subfieldvalue$2\[$1$tagsubf$2]/g;
1281                     }
1282                 }
1283             }
1284             # FIXME: yuk
1285             $summary =~ s/\[(.*?)]//g;
1286             $summary =~ s/\n/<br\/>/g;
1287             $oldbiblio->{summary} = $summary;
1288         }
1289
1290         # save an author with no <span> tag, for the <a href=search.pl?q=<!--tmpl_var name="author"-->> link
1291         $oldbiblio->{'author_nospan'} = $oldbiblio->{'author'};
1292         $oldbiblio->{'title_nospan'} = $oldbiblio->{'title'};
1293         # Add search-term highlighting to the whole record where they match using <span>s
1294         if (C4::Context->preference("OpacHighlightedWords")){
1295             my $searchhighlightblob;
1296             for my $highlight_field ( $marcrecord->fields ) {
1297
1298     # FIXME: need to skip title, subtitle, author, etc., as they are handled below
1299                 next if $highlight_field->tag() =~ /(^00)/;    # skip fixed fields
1300                 for my $subfield ($highlight_field->subfields()) {
1301                     my $match;
1302                     next if $subfield->[0] eq '9';
1303                     my $field = $subfield->[1];
1304                     for my $term ( keys %$span_terms_hashref ) {
1305                         if ( ( $field =~ /$term/i ) && (( length($term) > 3 ) || ($field =~ / $term /i)) ) {
1306                             $field =~ s/$term/<span class=\"term\">$&<\/span>/gi;
1307                         $match++;
1308                         }
1309                     }
1310                     $searchhighlightblob .= $field . " ... " if $match;
1311                 }
1312
1313             }
1314             $searchhighlightblob = ' ... '.$searchhighlightblob if $searchhighlightblob;
1315             $oldbiblio->{'searchhighlightblob'} = $searchhighlightblob;
1316         }
1317
1318         # Add search-term highlighting to the title, subtitle, etc. fields
1319         for my $term ( keys %$span_terms_hashref ) {
1320             my $old_term = $term;
1321             if ( length($term) > 3 ) {
1322                 $term =~ s/(.*=|\)|\(|\+|\.|\?|\[|\]|\\|\*)//g;
1323                                 foreach(qw(title subtitle author publishercode place pages notes size)) {
1324                         $oldbiblio->{$_} =~ s/$term/<span class=\"term\">$&<\/span>/gi;
1325                                 }
1326             }
1327         }
1328
1329         ($i % 2) and $oldbiblio->{'toggle'} = 1;
1330
1331         # Pull out the items fields
1332         my @fields = $marcrecord->field($itemtag);
1333
1334         # Setting item statuses for display
1335         my @available_items_loop;
1336         my @onloan_items_loop;
1337         my @other_items_loop;
1338
1339         my $available_items;
1340         my $onloan_items;
1341         my $other_items;
1342
1343         my $ordered_count     = 0;
1344         my $available_count   = 0;
1345         my $onloan_count      = 0;
1346         my $longoverdue_count = 0;
1347         my $other_count       = 0;
1348         my $wthdrawn_count    = 0;
1349         my $itemlost_count    = 0;
1350         my $itembinding_count = 0;
1351         my $itemdamaged_count = 0;
1352         my $can_place_holds   = 0;
1353         my $items_count       = scalar(@fields);
1354         my $items_counter;
1355         my $maxitems =
1356           ( C4::Context->preference('maxItemsinSearchResults') )
1357           ? C4::Context->preference('maxItemsinSearchResults') - 1
1358           : 1;
1359
1360         # loop through every item
1361         foreach my $field (@fields) {
1362             my $item;
1363             $items_counter++;
1364
1365             # populate the items hash
1366             foreach my $code ( keys %subfieldstosearch ) {
1367                 $item->{$code} = $field->subfield( $subfieldstosearch{$code} );
1368             }
1369                         my $hbranch     = C4::Context->preference('HomeOrHoldingBranch') eq 'homebranch' ? 'homebranch'    : 'holdingbranch';
1370                         my $otherbranch = C4::Context->preference('HomeOrHoldingBranch') eq 'homebranch' ? 'holdingbranch' : 'homebranch';
1371             # set item's branch name, use HomeOrHoldingBranch syspref first, fall back to the other one
1372             if ($item->{$hbranch}) {
1373                 $item->{'branchname'} = $branches{$item->{$hbranch}};
1374             }
1375             elsif ($item->{$otherbranch}) {     # Last resort
1376                 $item->{'branchname'} = $branches{$item->{$otherbranch}};
1377             }
1378
1379                         my $prefix = $item->{$hbranch} . '--' . $item->{location} . $item->{itype} . $item->{itemcallnumber};
1380 # For each grouping of items (onloan, available, unavailable), we build a key to store relevant info about that item
1381             if ( $item->{onloan} ) {
1382                 $onloan_count++;
1383                                 my $key = $prefix . $item->{due_date};
1384                                 $onloan_items->{$key}->{due_date} = format_date($item->{onloan});
1385                                 $onloan_items->{$key}->{count}++ if $item->{homebranch};
1386                                 $onloan_items->{$key}->{branchname} = $item->{branchname};
1387                                 $onloan_items->{$key}->{location} = $shelflocations->{ $item->{location} };
1388                                 $onloan_items->{$key}->{itemcallnumber} = $item->{itemcallnumber};
1389                                 $onloan_items->{$key}->{imageurl} = getitemtypeimagesrc() . "/" . $itemtypes{ $item->{itype} }->{imageurl};
1390                 # if something's checked out and lost, mark it as 'long overdue'
1391                 if ( $item->{itemlost} ) {
1392                     $onloan_items->{$prefix}->{longoverdue}++;
1393                     $longoverdue_count++;
1394                 } else {        # can place holds as long as item isn't lost
1395                     $can_place_holds = 1;
1396                 }
1397             }
1398
1399          # items not on loan, but still unavailable ( lost, withdrawn, damaged )
1400             else {
1401
1402                 # item is on order
1403                 if ( $item->{notforloan} == -1 ) {
1404                     $ordered_count++;
1405                 }
1406
1407                 # item is withdrawn, lost or damaged
1408                 if (   $item->{wthdrawn}
1409                     || $item->{itemlost}
1410                     || $item->{damaged}
1411                     || $item->{notforloan} )
1412                 {
1413                     $wthdrawn_count++    if $item->{wthdrawn};
1414                     $itemlost_count++    if $item->{itemlost};
1415                     $itemdamaged_count++ if $item->{damaged};
1416                     $item->{status} = $item->{wthdrawn} . "-" . $item->{itemlost} . "-" . $item->{damaged} . "-" . $item->{notforloan};
1417                     $other_count++;
1418
1419                                         my $key = $prefix . $item->{status};
1420                                         foreach (qw(wthdrawn itemlost damaged branchname itemcallnumber)) {
1421                         $other_items->{$key}->{$_} = $item->{$_};
1422                                         }
1423                                         $other_items->{$key}->{notforloan} = GetAuthorisedValueDesc('','',$item->{notforloan},'','',$notforloan_authorised_value) if $notforloan_authorised_value;
1424                                         $other_items->{$key}->{count}++ if $item->{homebranch};
1425                                         $other_items->{$key}->{location} = $shelflocations->{ $item->{location} };
1426                                         $other_items->{$key}->{imageurl} = getitemtypeimagesrc() . "/" . $itemtypes{ $item->{itype} }->{imageurl};
1427                 }
1428                 # item is available
1429                 else {
1430                     $can_place_holds = 1;
1431                     $available_count++;
1432                                         $available_items->{$prefix}->{count}++ if $item->{homebranch};
1433                                         foreach (qw(branchname itemcallnumber)) {
1434                         $available_items->{$prefix}->{$_} = $item->{$_};
1435                                         }
1436                                         $available_items->{$prefix}->{location} = $shelflocations->{ $item->{location} };
1437                                         $available_items->{$prefix}->{imageurl} = getitemtypeimagesrc() . "/" . $itemtypes{ $item->{itype} }->{imageurl};
1438                 }
1439             }
1440         }    # notforloan, item level and biblioitem level
1441         my ( $availableitemscount, $onloanitemscount, $otheritemscount );
1442         $maxitems =
1443           ( C4::Context->preference('maxItemsinSearchResults') )
1444           ? C4::Context->preference('maxItemsinSearchResults') - 1
1445           : 1;
1446         for my $key ( sort keys %$onloan_items ) {
1447             (++$onloanitemscount > $maxitems) and last;
1448             push @onloan_items_loop, $onloan_items->{$key};
1449         }
1450         for my $key ( sort keys %$other_items ) {
1451             (++$otheritemscount > $maxitems) and last;
1452             push @other_items_loop, $other_items->{$key};
1453         }
1454         for my $key ( sort keys %$available_items ) {
1455             (++$availableitemscount > $maxitems) and last;
1456             push @available_items_loop, $available_items->{$key}
1457         }
1458
1459         # XSLT processing of some stuff
1460         if (C4::Context->preference("XSLTResultsDisplay") ) {
1461             my $newxmlrecord = XSLTParse4Display($oldbiblio->{biblionumber},C4::Context->config('opachtdocs')."/prog/en/xslt/MARC21slim2OPACResults.xsl");
1462             $oldbiblio->{XSLTResultsRecord} = $newxmlrecord;
1463         }
1464
1465         # last check for norequest : if itemtype is notforloan, it can't be reserved either, whatever the items
1466         $can_place_holds = 0
1467           if $itemtypes{ $oldbiblio->{itemtype} }->{notforloan};
1468         $oldbiblio->{norequests} = 1 unless $can_place_holds;
1469         $oldbiblio->{itemsplural}          = 1 if $items_count > 1;
1470         $oldbiblio->{items_count}          = $items_count;
1471         $oldbiblio->{available_items_loop} = \@available_items_loop;
1472         $oldbiblio->{onloan_items_loop}    = \@onloan_items_loop;
1473         $oldbiblio->{other_items_loop}     = \@other_items_loop;
1474         $oldbiblio->{availablecount}       = $available_count;
1475         $oldbiblio->{availableplural}      = 1 if $available_count > 1;
1476         $oldbiblio->{onloancount}          = $onloan_count;
1477         $oldbiblio->{onloanplural}         = 1 if $onloan_count > 1;
1478         $oldbiblio->{othercount}           = $other_count;
1479         $oldbiblio->{otherplural}          = 1 if $other_count > 1;
1480         $oldbiblio->{wthdrawncount}        = $wthdrawn_count;
1481         $oldbiblio->{itemlostcount}        = $itemlost_count;
1482         $oldbiblio->{damagedcount}         = $itemdamaged_count;
1483         $oldbiblio->{orderedcount}         = $ordered_count;
1484         $oldbiblio->{isbn} =~
1485           s/-//g;    # deleting - in isbn to enable amazon content
1486         $oldbiblio->{'authorised_value_images'}  = C4::Items::get_authorised_value_images( C4::Biblio::get_biblio_authorised_values( $oldbiblio->{'biblionumber'} ) );
1487         push( @newresults, $oldbiblio );
1488     }
1489     return @newresults;
1490 }
1491
1492 #----------------------------------------------------------------------
1493 #
1494 # Non-Zebra GetRecords#
1495 #----------------------------------------------------------------------
1496
1497 =head2 NZgetRecords
1498
1499   NZgetRecords has the same API as zera getRecords, even if some parameters are not managed
1500
1501 =cut
1502
1503 sub NZgetRecords {
1504     my (
1505         $query,            $simple_query, $sort_by_ref,    $servers_ref,
1506         $results_per_page, $offset,       $expanded_facet, $branches,
1507         $query_type,       $scan
1508     ) = @_;
1509     warn "query =$query" if $DEBUG;
1510     my $result = NZanalyse($query);
1511     warn "results =$result" if $DEBUG;
1512     return ( undef,
1513         NZorder( $result, @$sort_by_ref[0], $results_per_page, $offset ),
1514         undef );
1515 }
1516
1517 =head2 NZanalyse
1518
1519   NZanalyse : get a CQL string as parameter, and returns a list of biblionumber;title,biblionumber;title,...
1520   the list is built from an inverted index in the nozebra SQL table
1521   note that title is here only for convenience : the sorting will be very fast when requested on title
1522   if the sorting is requested on something else, we will have to reread all results, and that may be longer.
1523
1524 =cut
1525
1526 sub NZanalyse {
1527     my ( $string, $server ) = @_;
1528 #     warn "---------"       if $DEBUG;
1529     warn " NZanalyse" if $DEBUG;
1530 #     warn "---------"       if $DEBUG;
1531
1532  # $server contains biblioserver or authorities, depending on what we search on.
1533  #warn "querying : $string on $server";
1534     $server = 'biblioserver' unless $server;
1535
1536 # if we have a ", replace the content to discard temporarily any and/or/not inside
1537     my $commacontent;
1538     if ( $string =~ /"/ ) {
1539         $string =~ s/"(.*?)"/__X__/;
1540         $commacontent = $1;
1541         warn "commacontent : $commacontent" if $DEBUG;
1542     }
1543
1544 # split the query string in 3 parts : X AND Y means : $left="X", $operand="AND" and $right="Y"
1545 # then, call again NZanalyse with $left and $right
1546 # (recursive until we find a leaf (=> something without and/or/not)
1547 # delete repeated operator... Would then go in infinite loop
1548     while ( $string =~ s/( and| or| not| AND| OR| NOT)\1/$1/g ) {
1549     }
1550
1551     #process parenthesis before.
1552     if ( $string =~ /^\s*\((.*)\)(( and | or | not | AND | OR | NOT )(.*))?/ ) {
1553         my $left     = $1;
1554         my $right    = $4;
1555         my $operator = lc($3);   # FIXME: and/or/not are operators, not operands
1556         warn
1557 "dealing w/parenthesis before recursive sub call. left :$left operator:$operator right:$right"
1558           if $DEBUG;
1559         my $leftresult = NZanalyse( $left, $server );
1560         if ($operator) {
1561             my $rightresult = NZanalyse( $right, $server );
1562
1563             # OK, we have the results for right and left part of the query
1564             # depending of operand, intersect, union or exclude both lists
1565             # to get a result list
1566             if ( $operator eq ' and ' ) {
1567                 return NZoperatorAND($leftresult,$rightresult);
1568             }
1569             elsif ( $operator eq ' or ' ) {
1570
1571                 # just merge the 2 strings
1572                 return $leftresult . $rightresult;
1573             }
1574             elsif ( $operator eq ' not ' ) {
1575                 return NZoperatorNOT($leftresult,$rightresult);
1576             }
1577         }
1578         else {
1579 # this error is impossible, because of the regexp that isolate the operand, but just in case...
1580             return $leftresult;
1581         }
1582     }
1583     warn "string :" . $string if $DEBUG;
1584     $string =~ /(.*?)( and | or | not | AND | OR | NOT )(.*)/;
1585     my $left     = $1;
1586     my $right    = $3;
1587     my $operator = lc($2);    # FIXME: and/or/not are operators, not operands
1588     warn "no parenthesis. left : $left operator: $operator right: $right"
1589       if $DEBUG;
1590
1591     # it's not a leaf, we have a and/or/not
1592     if ($operator) {
1593
1594         # reintroduce comma content if needed
1595         $right =~ s/__X__/"$commacontent"/ if $commacontent;
1596         $left  =~ s/__X__/"$commacontent"/ if $commacontent;
1597         warn "node : $left / $operator / $right\n" if $DEBUG;
1598         my $leftresult  = NZanalyse( $left,  $server );
1599         my $rightresult = NZanalyse( $right, $server );
1600         warn " leftresult : $leftresult" if $DEBUG;
1601         warn " rightresult : $rightresult" if $DEBUG;
1602         # OK, we have the results for right and left part of the query
1603         # depending of operand, intersect, union or exclude both lists
1604         # to get a result list
1605         if ( $operator eq ' and ' ) {
1606             warn "NZAND";
1607             return NZoperatorAND($leftresult,$rightresult);
1608         }
1609         elsif ( $operator eq ' or ' ) {
1610
1611             # just merge the 2 strings
1612             return $leftresult . $rightresult;
1613         }
1614         elsif ( $operator eq ' not ' ) {
1615             return NZoperatorNOT($leftresult,$rightresult);
1616         }
1617         else {
1618
1619 # this error is impossible, because of the regexp that isolate the operand, but just in case...
1620             die "error : operand unknown : $operator for $string";
1621         }
1622
1623         # it's a leaf, do the real SQL query and return the result
1624     }
1625     else {
1626         $string =~ s/__X__/"$commacontent"/ if $commacontent;
1627         $string =~ s/-|\.|\?|,|;|!|'|\(|\)|\[|\]|{|}|"|&|\+|\*|\// /g;
1628         #remove trailing blank at the beginning
1629         $string =~ s/^ //g;
1630         warn "leaf:$string" if $DEBUG;
1631
1632         # parse the string in in operator/operand/value again
1633         $string =~ /(.*)(>=|<=)(.*)/;
1634         my $left     = $1;
1635         my $operator = $2;
1636         my $right    = $3;
1637 #         warn "handling leaf... left:$left operator:$operator right:$right"
1638 #           if $DEBUG;
1639         unless ($operator) {
1640             $string =~ /(.*)(>|<|=)(.*)/;
1641             $left     = $1;
1642             $operator = $2;
1643             $right    = $3;
1644             warn
1645 "handling unless (operator)... left:$left operator:$operator right:$right"
1646               if $DEBUG;
1647         }
1648         my $results;
1649
1650 # strip adv, zebra keywords, currently not handled in nozebra: wrdl, ext, phr...
1651         $left =~ s/ .*$//;
1652
1653         # automatic replace for short operators
1654         $left = 'title'            if $left =~ '^ti$';
1655         $left = 'author'           if $left =~ '^au$';
1656         $left = 'publisher'        if $left =~ '^pb$';
1657         $left = 'subject'          if $left =~ '^su$';
1658         $left = 'koha-Auth-Number' if $left =~ '^an$';
1659         $left = 'keyword'          if $left =~ '^kw$';
1660         warn "handling leaf... left:$left operator:$operator right:$right" if $DEBUG;
1661         if ( $operator && $left ne 'keyword' ) {
1662
1663             #do a specific search
1664             my $dbh = C4::Context->dbh;
1665             $operator = 'LIKE' if $operator eq '=' and $right =~ /%/;
1666             my $sth =
1667               $dbh->prepare(
1668 "SELECT biblionumbers,value FROM nozebra WHERE server=? AND indexname=? AND value $operator ?"
1669               );
1670             warn "$left / $operator / $right\n" if $DEBUG;
1671
1672             # split each word, query the DB and build the biblionumbers result
1673             #sanitizing leftpart
1674             $left =~ s/^\s+|\s+$//;
1675             foreach ( split / /, $right ) {
1676                 my $biblionumbers;
1677                 $_ =~ s/^\s+|\s+$//;
1678                 next unless $_;
1679                 warn "EXECUTE : $server, $left, $_" if $DEBUG;
1680                 $sth->execute( $server, $left, $_ )
1681                   or warn "execute failed: $!";
1682                 while ( my ( $line, $value ) = $sth->fetchrow ) {
1683
1684 # if we are dealing with a numeric value, use only numeric results (in case of >=, <=, > or <)
1685 # otherwise, fill the result
1686                     $biblionumbers .= $line
1687                       unless ( $right =~ /^\d+$/ && $value =~ /\D/ );
1688                     warn "result : $value "
1689                       . ( $right  =~ /\d/ ) . "=="
1690                       . ( $value =~ /\D/?$line:"" ) if $DEBUG;         #= $line";
1691                 }
1692
1693 # do a AND with existing list if there is one, otherwise, use the biblionumbers list as 1st result list
1694                 if ($results) {
1695                     warn "NZAND" if $DEBUG;
1696                     $results = NZoperatorAND($biblionumbers,$results);
1697                 }
1698                 else {
1699                     $results = $biblionumbers;
1700                 }
1701             }
1702         }
1703         else {
1704
1705       #do a complete search (all indexes), if index='kw' do complete search too.
1706             my $dbh = C4::Context->dbh;
1707             my $sth =
1708               $dbh->prepare(
1709 "SELECT biblionumbers FROM nozebra WHERE server=? AND value LIKE ?"
1710               );
1711
1712             # split each word, query the DB and build the biblionumbers result
1713             foreach ( split / /, $string ) {
1714                 next if C4::Context->stopwords->{ uc($_) };   # skip if stopword
1715                 warn "search on all indexes on $_" if $DEBUG;
1716                 my $biblionumbers;
1717                 next unless $_;
1718                 $sth->execute( $server, $_ );
1719                 while ( my $line = $sth->fetchrow ) {
1720                     $biblionumbers .= $line;
1721                 }
1722
1723 # do a AND with existing list if there is one, otherwise, use the biblionumbers list as 1st result list
1724                 if ($results) {
1725                     $results = NZoperatorAND($biblionumbers,$results);
1726                 }
1727                 else {
1728                     warn "NEW RES for $_ = $biblionumbers" if $DEBUG;
1729                     $results = $biblionumbers;
1730                 }
1731             }
1732         }
1733         warn "return : $results for LEAF : $string" if $DEBUG;
1734         return $results;
1735     }
1736     warn "---------\nLeave NZanalyse\n---------" if $DEBUG;
1737 }
1738
1739 sub NZoperatorAND{
1740     my ($rightresult, $leftresult)=@_;
1741
1742     my @leftresult = split /;/, $leftresult;
1743     warn " @leftresult / $rightresult \n" if $DEBUG;
1744
1745     #             my @rightresult = split /;/,$leftresult;
1746     my $finalresult;
1747
1748 # parse the left results, and if the biblionumber exist in the right result, save it in finalresult
1749 # the result is stored twice, to have the same weight for AND than OR.
1750 # example : TWO : 61,61,64,121 (two is twice in the biblio #61) / TOWER : 61,64,130
1751 # result : 61,61,61,61,64,64 for two AND tower : 61 has more weight than 64
1752     foreach (@leftresult) {
1753         my $value = $_;
1754         my $countvalue;
1755         ( $value, $countvalue ) = ( $1, $2 ) if ($value=~/(.*)-(\d+)$/);
1756         if ( $rightresult =~ /\Q$value\E-(\d+);/ ) {
1757             $countvalue = ( $1 > $countvalue ? $countvalue : $1 );
1758             $finalresult .=
1759                 "$value-$countvalue;$value-$countvalue;";
1760         }
1761     }
1762     warn "NZAND DONE : $finalresult \n" if $DEBUG;
1763     return $finalresult;
1764 }
1765
1766 sub NZoperatorOR{
1767     my ($rightresult, $leftresult)=@_;
1768     return $rightresult.$leftresult;
1769 }
1770
1771 sub NZoperatorNOT{
1772     my ($rightresult, $leftresult)=@_;
1773
1774     my @leftresult = split /;/, $leftresult;
1775
1776     #             my @rightresult = split /;/,$leftresult;
1777     my $finalresult;
1778     foreach (@leftresult) {
1779         my $value=$_;
1780         $value=$1 if $value=~m/(.*)-\d+$/;
1781         unless ($rightresult =~ "$value-") {
1782             $finalresult .= "$_;";
1783         }
1784     }
1785     return $finalresult;
1786 }
1787
1788 =head2 NZorder
1789
1790   $finalresult = NZorder($biblionumbers, $ordering,$results_per_page,$offset);
1791
1792   TODO :: Description
1793
1794 =cut
1795
1796 sub NZorder {
1797     my ( $biblionumbers, $ordering, $results_per_page, $offset ) = @_;
1798     warn "biblionumbers = $biblionumbers and ordering = $ordering\n" if $DEBUG;
1799
1800     # order title asc by default
1801     #     $ordering = '1=36 <i' unless $ordering;
1802     $results_per_page = 20 unless $results_per_page;
1803     $offset           = 0  unless $offset;
1804     my $dbh = C4::Context->dbh;
1805
1806     #
1807     # order by POPULARITY
1808     #
1809     if ( $ordering =~ /popularity/ ) {
1810         my %result;
1811         my %popularity;
1812
1813         # popularity is not in MARC record, it's builded from a specific query
1814         my $sth =
1815           $dbh->prepare("select sum(issues) from items where biblionumber=?");
1816         foreach ( split /;/, $biblionumbers ) {
1817             my ( $biblionumber, $title ) = split /,/, $_;
1818             $result{$biblionumber} = GetMarcBiblio($biblionumber);
1819             $sth->execute($biblionumber);
1820             my $popularity = $sth->fetchrow || 0;
1821
1822 # hint : the key is popularity.title because we can have
1823 # many results with the same popularity. In this cas, sub-ordering is done by title
1824 # we also have biblionumber to avoid bug for 2 biblios with the same title & popularity
1825 # (un-frequent, I agree, but we won't forget anything that way ;-)
1826             $popularity{ sprintf( "%10d", $popularity ) . $title
1827                   . $biblionumber } = $biblionumber;
1828         }
1829
1830     # sort the hash and return the same structure as GetRecords (Zebra querying)
1831         my $result_hash;
1832         my $numbers = 0;
1833         if ( $ordering eq 'popularity_dsc' ) {    # sort popularity DESC
1834             foreach my $key ( sort { $b cmp $a } ( keys %popularity ) ) {
1835                 $result_hash->{'RECORDS'}[ $numbers++ ] =
1836                   $result{ $popularity{$key} }->as_usmarc();
1837             }
1838         }
1839         else {                                    # sort popularity ASC
1840             foreach my $key ( sort ( keys %popularity ) ) {
1841                 $result_hash->{'RECORDS'}[ $numbers++ ] =
1842                   $result{ $popularity{$key} }->as_usmarc();
1843             }
1844         }
1845         my $finalresult = ();
1846         $result_hash->{'hits'}         = $numbers;
1847         $finalresult->{'biblioserver'} = $result_hash;
1848         return $finalresult;
1849
1850         #
1851         # ORDER BY author
1852         #
1853     }
1854     elsif ( $ordering =~ /author/ ) {
1855         my %result;
1856         foreach ( split /;/, $biblionumbers ) {
1857             my ( $biblionumber, $title ) = split /,/, $_;
1858             my $record = GetMarcBiblio($biblionumber);
1859             my $author;
1860             if ( C4::Context->preference('marcflavour') eq 'UNIMARC' ) {
1861                 $author = $record->subfield( '200', 'f' );
1862                 $author = $record->subfield( '700', 'a' ) unless $author;
1863             }
1864             else {
1865                 $author = $record->subfield( '100', 'a' );
1866             }
1867
1868 # hint : the result is sorted by title.biblionumber because we can have X biblios with the same title
1869 # and we don't want to get only 1 result for each of them !!!
1870             $result{ $author . $biblionumber } = $record;
1871         }
1872
1873     # sort the hash and return the same structure as GetRecords (Zebra querying)
1874         my $result_hash;
1875         my $numbers = 0;
1876         if ( $ordering eq 'author_za' ) {    # sort by author desc
1877             foreach my $key ( sort { $b cmp $a } ( keys %result ) ) {
1878                 $result_hash->{'RECORDS'}[ $numbers++ ] =
1879                   $result{$key}->as_usmarc();
1880             }
1881         }
1882         else {                               # sort by author ASC
1883             foreach my $key ( sort ( keys %result ) ) {
1884                 $result_hash->{'RECORDS'}[ $numbers++ ] =
1885                   $result{$key}->as_usmarc();
1886             }
1887         }
1888         my $finalresult = ();
1889         $result_hash->{'hits'}         = $numbers;
1890         $finalresult->{'biblioserver'} = $result_hash;
1891         return $finalresult;
1892
1893         #
1894         # ORDER BY callnumber
1895         #
1896     }
1897     elsif ( $ordering =~ /callnumber/ ) {
1898         my %result;
1899         foreach ( split /;/, $biblionumbers ) {
1900             my ( $biblionumber, $title ) = split /,/, $_;
1901             my $record = GetMarcBiblio($biblionumber);
1902             my $callnumber;
1903             my ( $callnumber_tag, $callnumber_subfield ) =
1904               GetMarcFromKohaField( $dbh, 'items.itemcallnumber' );
1905             ( $callnumber_tag, $callnumber_subfield ) =
1906               GetMarcFromKohaField('biblioitems.callnumber')
1907               unless $callnumber_tag;
1908             if ( C4::Context->preference('marcflavour') eq 'UNIMARC' ) {
1909                 $callnumber = $record->subfield( '200', 'f' );
1910             }
1911             else {
1912                 $callnumber = $record->subfield( '100', 'a' );
1913             }
1914
1915 # hint : the result is sorted by title.biblionumber because we can have X biblios with the same title
1916 # and we don't want to get only 1 result for each of them !!!
1917             $result{ $callnumber . $biblionumber } = $record;
1918         }
1919
1920     # sort the hash and return the same structure as GetRecords (Zebra querying)
1921         my $result_hash;
1922         my $numbers = 0;
1923         if ( $ordering eq 'call_number_dsc' ) {    # sort by title desc
1924             foreach my $key ( sort { $b cmp $a } ( keys %result ) ) {
1925                 $result_hash->{'RECORDS'}[ $numbers++ ] =
1926                   $result{$key}->as_usmarc();
1927             }
1928         }
1929         else {                                     # sort by title ASC
1930             foreach my $key ( sort { $a cmp $b } ( keys %result ) ) {
1931                 $result_hash->{'RECORDS'}[ $numbers++ ] =
1932                   $result{$key}->as_usmarc();
1933             }
1934         }
1935         my $finalresult = ();
1936         $result_hash->{'hits'}         = $numbers;
1937         $finalresult->{'biblioserver'} = $result_hash;
1938         return $finalresult;
1939     }
1940     elsif ( $ordering =~ /pubdate/ ) {             #pub year
1941         my %result;
1942         foreach ( split /;/, $biblionumbers ) {
1943             my ( $biblionumber, $title ) = split /,/, $_;
1944             my $record = GetMarcBiblio($biblionumber);
1945             my ( $publicationyear_tag, $publicationyear_subfield ) =
1946               GetMarcFromKohaField( 'biblioitems.publicationyear', '' );
1947             my $publicationyear =
1948               $record->subfield( $publicationyear_tag,
1949                 $publicationyear_subfield );
1950
1951 # hint : the result is sorted by title.biblionumber because we can have X biblios with the same title
1952 # and we don't want to get only 1 result for each of them !!!
1953             $result{ $publicationyear . $biblionumber } = $record;
1954         }
1955
1956     # sort the hash and return the same structure as GetRecords (Zebra querying)
1957         my $result_hash;
1958         my $numbers = 0;
1959         if ( $ordering eq 'pubdate_dsc' ) {    # sort by pubyear desc
1960             foreach my $key ( sort { $b cmp $a } ( keys %result ) ) {
1961                 $result_hash->{'RECORDS'}[ $numbers++ ] =
1962                   $result{$key}->as_usmarc();
1963             }
1964         }
1965         else {                                 # sort by pub year ASC
1966             foreach my $key ( sort ( keys %result ) ) {
1967                 $result_hash->{'RECORDS'}[ $numbers++ ] =
1968                   $result{$key}->as_usmarc();
1969             }
1970         }
1971         my $finalresult = ();
1972         $result_hash->{'hits'}         = $numbers;
1973         $finalresult->{'biblioserver'} = $result_hash;
1974         return $finalresult;
1975
1976         #
1977         # ORDER BY title
1978         #
1979     }
1980     elsif ( $ordering =~ /title/ ) {
1981
1982 # the title is in the biblionumbers string, so we just need to build a hash, sort it and return
1983         my %result;
1984         foreach ( split /;/, $biblionumbers ) {
1985             my ( $biblionumber, $title ) = split /,/, $_;
1986
1987 # hint : the result is sorted by title.biblionumber because we can have X biblios with the same title
1988 # and we don't want to get only 1 result for each of them !!!
1989 # hint & speed improvement : we can order without reading the record
1990 # so order, and read records only for the requested page !
1991             $result{ $title . $biblionumber } = $biblionumber;
1992         }
1993
1994     # sort the hash and return the same structure as GetRecords (Zebra querying)
1995         my $result_hash;
1996         my $numbers = 0;
1997         if ( $ordering eq 'title_az' ) {    # sort by title desc
1998             foreach my $key ( sort ( keys %result ) ) {
1999                 $result_hash->{'RECORDS'}[ $numbers++ ] = $result{$key};
2000             }
2001         }
2002         else {                              # sort by title ASC
2003             foreach my $key ( sort { $b cmp $a } ( keys %result ) ) {
2004                 $result_hash->{'RECORDS'}[ $numbers++ ] = $result{$key};
2005             }
2006         }
2007
2008         # limit the $results_per_page to result size if it's more
2009         $results_per_page = $numbers - 1 if $numbers < $results_per_page;
2010
2011         # for the requested page, replace biblionumber by the complete record
2012         # speed improvement : avoid reading too much things
2013         for (
2014             my $counter = $offset ;
2015             $counter <= $offset + $results_per_page ;
2016             $counter++
2017           )
2018         {
2019             $result_hash->{'RECORDS'}[$counter] =
2020               GetMarcBiblio( $result_hash->{'RECORDS'}[$counter] )->as_usmarc;
2021         }
2022         my $finalresult = ();
2023         $result_hash->{'hits'}         = $numbers;
2024         $finalresult->{'biblioserver'} = $result_hash;
2025         return $finalresult;
2026     }
2027     else {
2028
2029 #
2030 # order by ranking
2031 #
2032 # we need 2 hashes to order by ranking : the 1st one to count the ranking, the 2nd to order by ranking
2033         my %result;
2034         my %count_ranking;
2035         foreach ( split /;/, $biblionumbers ) {
2036             my ( $biblionumber, $title ) = split /,/, $_;
2037             $title =~ /(.*)-(\d)/;
2038
2039             # get weight
2040             my $ranking = $2;
2041
2042 # note that we + the ranking because ranking is calculated on weight of EACH term requested.
2043 # if we ask for "two towers", and "two" has weight 2 in biblio N, and "towers" has weight 4 in biblio N
2044 # biblio N has ranking = 6
2045             $count_ranking{$biblionumber} += $ranking;
2046         }
2047
2048 # build the result by "inverting" the count_ranking hash
2049 # 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
2050 #         warn "counting";
2051         foreach ( keys %count_ranking ) {
2052             $result{ sprintf( "%10d", $count_ranking{$_} ) . '-' . $_ } = $_;
2053         }
2054
2055     # sort the hash and return the same structure as GetRecords (Zebra querying)
2056         my $result_hash;
2057         my $numbers = 0;
2058         foreach my $key ( sort { $b cmp $a } ( keys %result ) ) {
2059             $result_hash->{'RECORDS'}[ $numbers++ ] = $result{$key};
2060         }
2061
2062         # limit the $results_per_page to result size if it's more
2063         $results_per_page = $numbers - 1 if $numbers < $results_per_page;
2064
2065         # for the requested page, replace biblionumber by the complete record
2066         # speed improvement : avoid reading too much things
2067         for (
2068             my $counter = $offset ;
2069             $counter <= $offset + $results_per_page ;
2070             $counter++
2071           )
2072         {
2073             $result_hash->{'RECORDS'}[$counter] =
2074               GetMarcBiblio( $result_hash->{'RECORDS'}[$counter] )->as_usmarc
2075               if $result_hash->{'RECORDS'}[$counter];
2076         }
2077         my $finalresult = ();
2078         $result_hash->{'hits'}         = $numbers;
2079         $finalresult->{'biblioserver'} = $result_hash;
2080         return $finalresult;
2081     }
2082 }
2083
2084 =head2 ModBiblios
2085
2086 ($countchanged,$listunchanged) = ModBiblios($listbiblios, $tagsubfield,$initvalue,$targetvalue,$test);
2087
2088 this function changes all the values $initvalue in subfield $tag$subfield in any record in $listbiblios
2089 test parameter if set donot perform change to records in database.
2090
2091 =over 2
2092
2093 =item C<input arg:>
2094
2095     * $listbiblios is an array ref to marcrecords to be changed
2096     * $tagsubfield is the reference of the subfield to change.
2097     * $initvalue is the value to search the record for
2098     * $targetvalue is the value to set the subfield to
2099     * $test is to be set only not to perform changes in database.
2100
2101 =item C<Output arg:>
2102     * $countchanged counts all the changes performed.
2103     * $listunchanged contains the list of all the biblionumbers of records unchanged.
2104
2105 =item C<usage in the script:>
2106
2107 =back
2108
2109 my ($countchanged, $listunchanged) = EditBiblios($results->{RECORD}, $tagsubfield,$initvalue,$targetvalue);;
2110 #If one wants to display unchanged records, you should get biblios foreach @$listunchanged
2111 $template->param(countchanged => $countchanged, loopunchanged=>$listunchanged);
2112
2113 =cut
2114
2115 sub ModBiblios {
2116     my ( $listbiblios, $tagsubfield, $initvalue, $targetvalue, $test ) = @_;
2117     my $countmatched;
2118     my @unmatched;
2119     my ( $tag, $subfield ) = ( $1, $2 )
2120       if ( $tagsubfield =~ /^(\d{1,3})([a-z0-9A-Z@])?$/ );
2121     if ( ( length($tag) < 3 ) && $subfield =~ /0-9/ ) {
2122         $tag = $tag . $subfield;
2123         undef $subfield;
2124     }
2125     my ( $bntag,   $bnsubf )   = GetMarcFromKohaField('biblio.biblionumber');
2126     my ( $itemtag, $itemsubf ) = GetMarcFromKohaField('items.itemnumber');
2127     if ($tag eq $itemtag) {
2128         # do not allow the embedded item tag to be
2129         # edited from here
2130         warn "Attempting to edit item tag via C4::Search::ModBiblios -- not allowed";
2131         return (0, []);
2132     }
2133     foreach my $usmarc (@$listbiblios) {
2134         my $record;
2135         $record = eval { MARC::Record->new_from_usmarc($usmarc) };
2136         my $biblionumber;
2137         if ($@) {
2138
2139             # usmarc is not a valid usmarc May be a biblionumber
2140             # FIXME - sorry, please let's figure out whether
2141             #         this function is to be passed a list of
2142             #         record numbers or a list of MARC::Record
2143             #         objects.  The former is probably better
2144             #         because the MARC records supplied by Zebra
2145             #         may be not current.
2146             $record       = GetMarcBiblio($usmarc);
2147             $biblionumber = $usmarc;
2148         }
2149         else {
2150             if ( $bntag >= 010 ) {
2151                 $biblionumber = $record->subfield( $bntag, $bnsubf );
2152             }
2153             else {
2154                 $biblionumber = $record->field($bntag)->data;
2155             }
2156         }
2157
2158         #GetBiblionumber is to be written.
2159         #Could be replaced by TransformMarcToKoha (But Would be longer)
2160         if ( $record->field($tag) ) {
2161             my $modify = 0;
2162             foreach my $field ( $record->field($tag) ) {
2163                 if ($subfield) {
2164                     if (
2165                         $field->delete_subfield(
2166                             'code'  => $subfield,
2167                             'match' => qr($initvalue)
2168                         )
2169                       )
2170                     {
2171                         $countmatched++;
2172                         $modify = 1;
2173                         $field->update( $subfield, $targetvalue )
2174                           if ($targetvalue);
2175                     }
2176                 }
2177                 else {
2178                     if ( $tag >= 010 ) {
2179                         if ( $field->delete_field($field) ) {
2180                             $countmatched++;
2181                             $modify = 1;
2182                         }
2183                     }
2184                     else {
2185                         $field->data = $targetvalue
2186                           if ( $field->data =~ qr($initvalue) );
2187                     }
2188                 }
2189             }
2190
2191             #       warn $record->as_formatted;
2192             if ($modify) {
2193                 ModBiblio( $record, $biblionumber,
2194                     GetFrameworkCode($biblionumber) )
2195                   unless ($test);
2196             }
2197             else {
2198                 push @unmatched, $biblionumber;
2199             }
2200         }
2201         else {
2202             push @unmatched, $biblionumber;
2203         }
2204     }
2205     return ( $countmatched, \@unmatched );
2206 }
2207
2208 END { }    # module clean-up code here (global destructor)
2209
2210 1;
2211 __END__
2212
2213 =head1 AUTHOR
2214
2215 Koha Developement team <info@koha.org>
2216
2217 =cut