C4/Search.pm

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