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