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