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                 # ISBN,ISSN,Standard Number, don't need special treatment
 971                 elsif ( $index eq 'nb' || $index eq 'ns' ) {
 972                     $indexes_set++;
 973                     (
 974                         $stemming,      $auto_truncation,
 975                         $weight_fields, $fuzzy_enabled,
 976                         $remove_stopwords
 977                     ) = ( 0, 0, 0, 0, 0 );
 978
 979                 }
 980                 # Set default structure attribute (word list)
 981                 my $struct_attr;
 982                 unless ( $indexes_set || !$index || $index =~ /(st-|phr|ext|wrdl)/ ) {
 983                     $struct_attr = ",wrdl";
 984                 }
 985
 986                 # Some helpful index variants
 987                 my $index_plus       = $index . $struct_attr . ":" if $index;
 988                 my $index_plus_comma = $index . $struct_attr . "," if $index;
 989
 990                 # Remove Stopwords
 991                 if ($remove_stopwords) {
 992                     ( $operand, $stopwords_removed ) =
 993                       _remove_stopwords( $operand, $index );
 994                     warn "OPERAND w/out STOPWORDS: >$operand<" if $DEBUG;
 995                     warn "REMOVED STOPWORDS: @$stopwords_removed"
 996                       if ( $stopwords_removed && $DEBUG );
 997                 }
 998
 999                 # Detect Truncation
1000                 my ( $nontruncated, $righttruncated, $lefttruncated,
1001                     $rightlefttruncated, $regexpr );
1002                 my $truncated_operand;
1003                 (
1004                     $nontruncated, $righttruncated, $lefttruncated,
1005                     $rightlefttruncated, $regexpr
1006                 ) = _detect_truncation( $operand, $index );
1007                 warn
1008 "TRUNCATION: NON:>@$nontruncated< RIGHT:>@$righttruncated< LEFT:>@$lefttruncated< RIGHTLEFT:>@$rightlefttruncated< REGEX:>@$regexpr<"
1009                   if $DEBUG;
1010
1011                 # Apply Truncation
1012                 if (
1013                     scalar(@$righttruncated) + scalar(@$lefttruncated) +
1014                     scalar(@$rightlefttruncated) > 0 )
1015                 {
1016
1017                # Don't field weight or add the index to the query, we do it here
1018                     $indexes_set = 1;
1019                     undef $weight_fields;
1020                     my $previous_truncation_operand;
1021                     if ( scalar(@$nontruncated) > 0 ) {
1022                         $truncated_operand .= "$index_plus @$nontruncated ";
1023                         $previous_truncation_operand = 1;
1024                     }
1025                     if ( scalar(@$righttruncated) > 0 ) {
1026                         $truncated_operand .= "and "
1027                           if $previous_truncation_operand;
1028                         $truncated_operand .=
1029                           "$index_plus_comma" . "rtrn:@$righttruncated ";
1030                         $previous_truncation_operand = 1;
1031                     }
1032                     if ( scalar(@$lefttruncated) > 0 ) {
1033                         $truncated_operand .= "and "
1034                           if $previous_truncation_operand;
1035                         $truncated_operand .=
1036                           "$index_plus_comma" . "ltrn:@$lefttruncated ";
1037                         $previous_truncation_operand = 1;
1038                     }
1039                     if ( scalar(@$rightlefttruncated) > 0 ) {
1040                         $truncated_operand .= "and "
1041                           if $previous_truncation_operand;
1042                         $truncated_operand .=
1043                           "$index_plus_comma" . "rltrn:@$rightlefttruncated ";
1044                         $previous_truncation_operand = 1;
1045                     }
1046                 }
1047                 $operand = $truncated_operand if $truncated_operand;
1048                 warn "TRUNCATED OPERAND: >$truncated_operand<" if $DEBUG;
1049
1050                 # Handle Stemming
1051                 my $stemmed_operand;
1052                 $stemmed_operand = _build_stemmed_operand($operand)
1053                   if $stemming;
1054                 warn "STEMMED OPERAND: >$stemmed_operand<" if $DEBUG;
1055
1056                 # Handle Field Weighting
1057                 my $weighted_operand;
1058                 $weighted_operand =
1059                   _build_weighted_query( $operand, $stemmed_operand, $index )
1060                   if $weight_fields;
1061                 warn "FIELD WEIGHTED OPERAND: >$weighted_operand<" if $DEBUG;
1062                 $operand = $weighted_operand if $weight_fields;
1063                 $indexes_set = 1 if $weight_fields;
1064
1065                 # If there's a previous operand, we need to add an operator
1066                 if ($previous_operand) {
1067
1068                     # User-specified operator
1069                     if ( $operators[ $i - 1 ] ) {
1070                         $query     .= " $operators[$i-1] ";
1071                         $query     .= " $index_plus " unless $indexes_set;
1072                         $query     .= " $operand";
1073                         $query_cgi .= "&op=$operators[$i-1]";
1074                         $query_cgi .= "&idx=$index" if $index;
1075                         $query_cgi .= "&q=$operands[$i]" if $operands[$i];
1076                         $query_desc .=
1077                           " $operators[$i-1] $index_plus $operands[$i]";
1078                     }
1079
1080                     # Default operator is and
1081                     else {
1082                         $query      .= " and ";
1083                         $query      .= "$index_plus " unless $indexes_set;
1084                         $query      .= "$operand";
1085                         $query_cgi  .= "&op=and&idx=$index" if $index;
1086                         $query_cgi  .= "&q=$operands[$i]" if $operands[$i];
1087                         $query_desc .= " and $index_plus $operands[$i]";
1088                     }
1089                 }
1090
1091                 # There isn't a pervious operand, don't need an operator
1092                 else {
1093
1094                     # Field-weighted queries already have indexes set
1095                     $query .= " $index_plus " unless $indexes_set;
1096                     $query .= $operand;
1097                     $query_desc .= " $index_plus $operands[$i]";
1098                     $query_cgi  .= "&idx=$index" if $index;
1099                     $query_cgi  .= "&q=$operands[$i]" if $operands[$i];
1100                     $previous_operand = 1;
1101                 }
1102             }    #/if $operands
1103         }    # /for
1104     }
1105     warn "QUERY BEFORE LIMITS: >$query<" if $DEBUG;
1106
1107     # add limits
1108     my $group_OR_limits;
1109     my $availability_limit;
1110     foreach my $this_limit (@limits) {
1111         if ( $this_limit =~ /available/ ) {
1112
1113 # 'available' is defined as (items.onloan is NULL) and (items.itemlost = 0)
1114 # In English:
1115 # all records not indexed in the onloan register (zebra) and all records with a value of lost equal to 0
1116             $availability_limit .=
1117 "( ( allrecords,AlwaysMatches='' not onloan,AlwaysMatches='') and (lost,st-numeric=0) )"; #or ( allrecords,AlwaysMatches='' not lost,AlwaysMatches='')) )";
1118             $limit_cgi  .= "&limit=available";
1119             $limit_desc .= "";
1120         }
1121
1122         # group_OR_limits, prefixed by mc-
1123         # OR every member of the group
1124         elsif ( $this_limit =~ /mc/ ) {
1125             $group_OR_limits .= " or " if $group_OR_limits;
1126             $limit_desc      .= " or " if $group_OR_limits;
1127             $group_OR_limits .= "$this_limit";
1128             $limit_cgi       .= "&limit=$this_limit";
1129             $limit_desc      .= " $this_limit";
1130         }
1131
1132         # Regular old limits
1133         else {
1134             $limit .= " and " if $limit || $query;
1135             $limit      .= "$this_limit";
1136             $limit_cgi  .= "&limit=$this_limit";
1137             $limit_desc .= " $this_limit";
1138         }
1139     }
1140     if ($group_OR_limits) {
1141         $limit .= " and " if ( $query || $limit );
1142         $limit .= "($group_OR_limits)";
1143     }
1144     if ($availability_limit) {
1145         $limit .= " and " if ( $query || $limit );
1146         $limit .= "($availability_limit)";
1147     }
1148
1149     # Normalize the query and limit strings
1150     $query =~ s/:/=/g;
1151     $limit =~ s/:/=/g;
1152     for ( $query, $query_desc, $limit, $limit_desc ) {
1153         $_ =~ s/  / /g;    # remove extra spaces
1154         $_ =~ s/^ //g;     # remove any beginning spaces
1155         $_ =~ s/ $//g;     # remove any ending spaces
1156         $_ =~ s/==/=/g;    # remove double == from query
1157     }
1158     $query_cgi =~ s/^&//; # remove unnecessary & from beginning of the query cgi
1159
1160     for ($query_cgi,$simple_query) {
1161         $_ =~ s/"//g;
1162     }
1163     # append the limit to the query
1164     $query .= " " . $limit;
1165
1166     # Warnings if DEBUG
1167     if ($DEBUG) {
1168         warn "QUERY:" . $query;
1169         warn "QUERY CGI:" . $query_cgi;
1170         warn "QUERY DESC:" . $query_desc;
1171         warn "LIMIT:" . $limit;
1172         warn "LIMIT CGI:" . $limit_cgi;
1173         warn "LIMIT DESC:" . $limit_desc;
1174         warn "---------\nLeave buildQuery\n---------";
1175     }
1176     return (
1177         undef,              $query, $simple_query, $query_cgi,
1178         $query_desc,        $limit, $limit_cgi,    $limit_desc,
1179         $stopwords_removed, $query_type
1180     );
1181 }
1182
1183 =head2 searchResults
1184
1185 Format results in a form suitable for passing to the template
1186
1187 =cut
1188
1189 # IMO this subroutine is pretty messy still -- it's responsible for
1190 # building the HTML output for the template
1191 sub searchResults {
1192     my ( $searchdesc, $hits, $results_per_page, $offset, @marcresults ) = @_;
1193     my $dbh = C4::Context->dbh;
1194     my $even = 1;
1195     my @newresults;
1196
1197     # add search-term highlighting via <span>s on the search terms
1198     my $span_terms_hashref;
1199     for my $span_term ( split( / /, $searchdesc ) ) {
1200         $span_term =~ s/(.*=|\)|\(|\+|\.|\*)//g;
1201         $span_terms_hashref->{$span_term}++;
1202     }
1203
1204     #Build branchnames hash
1205     #find branchname
1206     #get branch information.....
1207     my %branches;
1208     my $bsth =
1209       $dbh->prepare("SELECT branchcode,branchname FROM branches")
1210       ;    # FIXME : use C4::Koha::GetBranches
1211     $bsth->execute();
1212     while ( my $bdata = $bsth->fetchrow_hashref ) {
1213         $branches{ $bdata->{'branchcode'} } = $bdata->{'branchname'};
1214     }
1215 # FIXME - We build an authorised values hash here, using the default framework
1216 # though it is possible to have different authvals for different fws.
1217
1218     my $shelflocations =GetKohaAuthorisedValues('items.location','');
1219
1220     # get notforloan authorised value list (see $shelflocations  FIXME)
1221     my $notforloan_authorised_value = GetAuthValCode('items.notforloan','');
1222
1223     #Build itemtype hash
1224     #find itemtype & itemtype image
1225     my %itemtypes;
1226     $bsth =
1227       $dbh->prepare(
1228         "SELECT itemtype,description,imageurl,summary,notforloan FROM itemtypes"
1229       );
1230     $bsth->execute();
1231     while ( my $bdata = $bsth->fetchrow_hashref ) {
1232         $itemtypes{ $bdata->{'itemtype'} }->{description} =
1233           $bdata->{'description'};
1234         $itemtypes{ $bdata->{'itemtype'} }->{imageurl} = $bdata->{'imageurl'};
1235         $itemtypes{ $bdata->{'itemtype'} }->{summary}  = $bdata->{'summary'};
1236         $itemtypes{ $bdata->{'itemtype'} }->{notforloan} =
1237           $bdata->{'notforloan'};
1238     }
1239
1240     #search item field code
1241     my $sth =
1242       $dbh->prepare(
1243 "SELECT tagfield FROM marc_subfield_structure WHERE kohafield LIKE 'items.itemnumber'"
1244       );
1245     $sth->execute;
1246     my ($itemtag) = $sth->fetchrow;
1247
1248     ## find column names of items related to MARC
1249     my $sth2 = $dbh->prepare("SHOW COLUMNS FROM items");
1250     $sth2->execute;
1251     my %subfieldstosearch;
1252     while ( ( my $column ) = $sth2->fetchrow ) {
1253         my ( $tagfield, $tagsubfield ) =
1254           &GetMarcFromKohaField( "items." . $column, "" );
1255         $subfieldstosearch{$column} = $tagsubfield;
1256     }
1257
1258     # handle which records to actually retrieve
1259     my $times;
1260     if ( $hits && $offset + $results_per_page <= $hits ) {
1261         $times = $offset + $results_per_page;
1262     }
1263     else {
1264         $times = $hits;
1265     }
1266
1267     # loop through all of the records we've retrieved
1268     for ( my $i = $offset ; $i <= $times - 1 ; $i++ ) {
1269         my $marcrecord;
1270         $marcrecord = MARC::File::USMARC::decode( $marcresults[$i] );
1271         my $oldbiblio = TransformMarcToKoha( $dbh, $marcrecord, '' );
1272         $oldbiblio->{result_number} = $i + 1;
1273
1274         # add imageurl to itemtype if there is one
1275         if ( $itemtypes{ $oldbiblio->{itemtype} }->{imageurl} =~ /^http:/ ) {
1276             $oldbiblio->{imageurl} =
1277               $itemtypes{ $oldbiblio->{itemtype} }->{imageurl};
1278             $oldbiblio->{description} =
1279               $itemtypes{ $oldbiblio->{itemtype} }->{description};
1280         }
1281         else {
1282             $oldbiblio->{imageurl} =
1283               getitemtypeimagesrc() . "/"
1284               . $itemtypes{ $oldbiblio->{itemtype} }->{imageurl}
1285               if ( $itemtypes{ $oldbiblio->{itemtype} }->{imageurl} );
1286             $oldbiblio->{description} =
1287               $itemtypes{ $oldbiblio->{itemtype} }->{description};
1288         }
1289         my $aisbn=$oldbiblio->{'isbn'};
1290         $aisbn =~ /(\d*[X]*)/;
1291         $oldbiblio->{'amazonisbn'} = $1;
1292  # Build summary if there is one (the summary is defined in the itemtypes table)
1293  # FIXME: is this used anywhere, I think it can be commented out? -- JF
1294         if ( $itemtypes{ $oldbiblio->{itemtype} }->{summary} ) {
1295             my $summary = $itemtypes{ $oldbiblio->{itemtype} }->{summary};
1296             my @fields  = $marcrecord->fields();
1297             foreach my $field (@fields) {
1298                 my $tag      = $field->tag();
1299                 my $tagvalue = $field->as_string();
1300                 $summary =~
1301                   s/\[(.?.?.?.?)$tag\*(.*?)]/$1$tagvalue$2\[$1$tag$2]/g;
1302                 unless ( $tag < 10 ) {
1303                     my @subf = $field->subfields;
1304                     for my $i ( 0 .. $#subf ) {
1305                         my $subfieldcode  = $subf[$i][0];
1306                         my $subfieldvalue = $subf[$i][1];
1307                         my $tagsubf       = $tag . $subfieldcode;
1308                         $summary =~
1309 s/\[(.?.?.?.?)$tagsubf(.*?)]/$1$subfieldvalue$2\[$1$tagsubf$2]/g;
1310                     }
1311                 }
1312             }
1313             # FIXME: yuk
1314             $summary =~ s/\[(.*?)]//g;
1315             $summary =~ s/\n/<br\/>/g;
1316             $oldbiblio->{summary} = $summary;
1317         }
1318
1319 # Add search-term highlighting to the whole record where they match using <span>s
1320         if (C4::Context->preference("OpacHighlightedWords")){
1321             my $searchhighlightblob;
1322             for my $highlight_field ( $marcrecord->fields ) {
1323
1324     # FIXME: need to skip title, subtitle, author, etc., as they are handled below
1325                 next if $highlight_field->tag() =~ /(^00)/;    # skip fixed fields
1326                 for my $subfield ($highlight_field->subfields()) {
1327                     my $match;
1328                     next if $subfield->[0] eq '9';
1329                     my $field = $subfield->[1];
1330                     for my $term ( keys %$span_terms_hashref ) {
1331                         if ( ( $field =~ /$term/i ) && (( length($term) > 3 ) || ($field =~ / $term /i)) ) {
1332                             $field =~ s/$term/<span class=\"term\">$&<\/span>/gi;
1333                         $match++;
1334                         }
1335                     }
1336                     $searchhighlightblob .= $field . " ... " if $match;
1337                 }
1338
1339             }
1340             $searchhighlightblob = ' ... '.$searchhighlightblob if $searchhighlightblob;
1341             $oldbiblio->{'searchhighlightblob'} = $searchhighlightblob;
1342         }
1343 # save an author with no <span> tag, for the <a href=search.pl?q=<!--tmpl_var name="author"-->> link
1344         $oldbiblio->{'author_nospan'} = $oldbiblio->{'author'};
1345
1346         # Add search-term highlighting to the title, subtitle, etc. fields
1347         for my $term ( keys %$span_terms_hashref ) {
1348             my $old_term = $term;
1349             if ( length($term) > 3 ) {
1350                 $term =~ s/(.*=|\)|\(|\+|\.|\?|\[|\]|\\|\*)//g;
1351                 $oldbiblio->{'title'} =~
1352                   s/$term/<span class=\"term\">$&<\/span>/gi;
1353                 $oldbiblio->{'subtitle'} =~
1354                   s/$term/<span class=\"term\">$&<\/span>/gi;
1355                 $oldbiblio->{'author'} =~
1356                   s/$term/<span class=\"term\">$&<\/span>/gi;
1357                 $oldbiblio->{'publishercode'} =~
1358                   s/$term/<span class=\"term\">$&<\/span>/gi;
1359                 $oldbiblio->{'place'} =~
1360                   s/$term/<span class=\"term\">$&<\/span>/gi;
1361                 $oldbiblio->{'pages'} =~
1362                   s/$term/<span class=\"term\">$&<\/span>/gi;
1363                 $oldbiblio->{'notes'} =~
1364                   s/$term/<span class=\"term\">$&<\/span>/gi;
1365                 $oldbiblio->{'size'} =~
1366                   s/$term/<span class=\"term\">$&<\/span>/gi;
1367             }
1368         }
1369
1370         ($i % 2) and $oldbiblio->{'toggle'} = 1;
1371
1372         # Pull out the items fields
1373         my @fields = $marcrecord->field($itemtag);
1374
1375         # Setting item statuses for display
1376         my @available_items_loop;
1377         my @onloan_items_loop;
1378         my @other_items_loop;
1379
1380         my $available_items;
1381         my $onloan_items;
1382         my $other_items;
1383
1384         my $ordered_count     = 0;
1385         my $available_count   = 0;
1386         my $onloan_count      = 0;
1387         my $longoverdue_count = 0;
1388         my $other_count       = 0;
1389         my $wthdrawn_count    = 0;
1390         my $itemlost_count    = 0;
1391         my $itembinding_count = 0;
1392         my $itemdamaged_count = 0;
1393         my $can_place_holds   = 0;
1394         my $items_count       = scalar(@fields);
1395         my $items_counter;
1396         my $maxitems =
1397           ( C4::Context->preference('maxItemsinSearchResults') )
1398           ? C4::Context->preference('maxItemsinSearchResults') - 1
1399           : 1;
1400
1401         # loop through every item
1402         foreach my $field (@fields) {
1403             my $item;
1404             $items_counter++;
1405
1406             # populate the items hash
1407             foreach my $code ( keys %subfieldstosearch ) {
1408                 $item->{$code} = $field->subfield( $subfieldstosearch{$code} );
1409             }
1410                         my $hbranch     = C4::Context->preference('HomeOrHoldingBranch') eq 'homebranch' ? 'homebranch'    : 'holdingbranch';
1411                         my $otherbranch = C4::Context->preference('HomeOrHoldingBranch') eq 'homebranch' ? 'holdingbranch' : 'homebranch';
1412             # set item's branch name, use HomeOrHoldingBranch syspref first, fall back to the other one
1413             if ($item->{$hbranch}) {
1414                 $item->{'branchname'} = $branches{$item->{$hbranch}};
1415             }
1416             elsif ($item->{$otherbranch}) {     # Last resort
1417                 $item->{'branchname'} = $branches{$item->{$otherbranch}};
1418             }
1419
1420                         my $prefix = $item->{$hbranch} . '--' . $item->{location} . $item->{itype} . $item->{itemcallnumber};
1421 # For each grouping of items (onloan, available, unavailable), we build a key to store relevant info about that item
1422             if ( $item->{onloan} ) {
1423                 $onloan_count++;
1424                                 my $key = $prefix . $item->{due_date};
1425                                 $onloan_items->{$key}->{due_date} = format_date($item->{onloan});
1426                                 $onloan_items->{$key}->{count}++ if $item->{homebranch};
1427                                 $onloan_items->{$key}->{branchname} = $item->{branchname};
1428                                 $onloan_items->{$key}->{location} = $shelflocations->{ $item->{location} };
1429                                 $onloan_items->{$key}->{itemcallnumber} = $item->{itemcallnumber};
1430                                 $onloan_items->{$key}->{imageurl} = getitemtypeimagesrc() . "/" . $itemtypes{ $item->{itype} }->{imageurl};
1431                 # if something's checked out and lost, mark it as 'long overdue'
1432                 if ( $item->{itemlost} ) {
1433                     $onloan_items->{$prefix}->{longoverdue}++;
1434                     $longoverdue_count++;
1435                 } else {        # can place holds as long as item isn't lost
1436                     $can_place_holds = 1;
1437                 }
1438             }
1439
1440          # items not on loan, but still unavailable ( lost, withdrawn, damaged )
1441             else {
1442
1443                 # item is on order
1444                 if ( $item->{notforloan} == -1 ) {
1445                     $ordered_count++;
1446                 }
1447
1448                 # item is withdrawn, lost or damaged
1449                 if (   $item->{wthdrawn}
1450                     || $item->{itemlost}
1451                     || $item->{damaged}
1452                     || $item->{notforloan} )
1453                 {
1454                     $wthdrawn_count++    if $item->{wthdrawn};
1455                     $itemlost_count++    if $item->{itemlost};
1456                     $itemdamaged_count++ if $item->{damaged};
1457                     $item->{status} = $item->{wthdrawn} . "-" . $item->{itemlost} . "-" . $item->{damaged} . "-" . $item->{notforloan};
1458                     $other_count++;
1459
1460                                         my $key = $prefix . $item->{status};
1461                                         foreach (qw(wthdrawn itemlost damaged branchname itemcallnumber)) {
1462                         $other_items->{$key}->{$_} = $item->{$_};
1463                                         }
1464                                         $other_items->{$key}->{notforloan} = GetAuthorisedValueDesc('','',$item->{notforloan},'','',$notforloan_authorised_value) if $notforloan_authorised_value;
1465                                         $other_items->{$key}->{count}++ if $item->{homebranch};
1466                                         $other_items->{$key}->{location} = $shelflocations->{ $item->{location} };
1467                                         $other_items->{$key}->{imageurl} = getitemtypeimagesrc() . "/" . $itemtypes{ $item->{itype} }->{imageurl};
1468                 }
1469                 # item is available
1470                 else {
1471                     $can_place_holds = 1;
1472                     $available_count++;
1473                                         $available_items->{$prefix}->{count}++ if $item->{homebranch};
1474                                         foreach (qw(branchname itemcallnumber)) {
1475                         $available_items->{$prefix}->{$_} = $item->{$_};
1476                                         }
1477                                         $available_items->{$prefix}->{location} = $shelflocations->{ $item->{location} };
1478                                         $available_items->{$prefix}->{imageurl} = getitemtypeimagesrc() . "/" . $itemtypes{ $item->{itype} }->{imageurl};
1479                 }
1480             }
1481         }    # notforloan, item level and biblioitem level
1482         my ( $availableitemscount, $onloanitemscount, $otheritemscount );
1483         $maxitems =
1484           ( C4::Context->preference('maxItemsinSearchResults') )
1485           ? C4::Context->preference('maxItemsinSearchResults') - 1
1486           : 1;
1487         for my $key ( sort keys %$onloan_items ) {
1488             (++$onloanitemscount > $maxitems) and last;
1489             push @onloan_items_loop, $onloan_items->{$key};
1490         }
1491         for my $key ( sort keys %$other_items ) {
1492             (++$otheritemscount > $maxitems) and last;
1493             push @other_items_loop, $other_items->{$key};
1494         }
1495         for my $key ( sort keys %$available_items ) {
1496             (++$availableitemscount > $maxitems) and last;
1497             push @available_items_loop, $available_items->{$key}
1498         }
1499
1500         # XSLT processing of some stuff
1501         if (C4::Context->preference("XSLTResultsDisplay") ) {
1502             my $newxmlrecord = XSLTParse4Display($oldbiblio->{biblionumber},C4::Context->config('opachtdocs')."/prog/en/xslt/MARC21slim2OPACResults.xsl");
1503             $oldbiblio->{XSLTResultsRecord} = $newxmlrecord;
1504         }
1505
1506         # last check for norequest : if itemtype is notforloan, it can't be reserved either, whatever the items
1507         $can_place_holds = 0
1508           if $itemtypes{ $oldbiblio->{itemtype} }->{notforloan};
1509         $oldbiblio->{norequests} = 1 unless $can_place_holds;
1510         $oldbiblio->{itemsplural}          = 1 if $items_count > 1;
1511         $oldbiblio->{items_count}          = $items_count;
1512         $oldbiblio->{available_items_loop} = \@available_items_loop;
1513         $oldbiblio->{onloan_items_loop}    = \@onloan_items_loop;
1514         $oldbiblio->{other_items_loop}     = \@other_items_loop;
1515         $oldbiblio->{availablecount}       = $available_count;
1516         $oldbiblio->{availableplural}      = 1 if $available_count > 1;
1517         $oldbiblio->{onloancount}          = $onloan_count;
1518         $oldbiblio->{onloanplural}         = 1 if $onloan_count > 1;
1519         $oldbiblio->{othercount}           = $other_count;
1520         $oldbiblio->{otherplural}          = 1 if $other_count > 1;
1521         $oldbiblio->{wthdrawncount}        = $wthdrawn_count;
1522         $oldbiblio->{itemlostcount}        = $itemlost_count;
1523         $oldbiblio->{damagedcount}         = $itemdamaged_count;
1524         $oldbiblio->{orderedcount}         = $ordered_count;
1525         $oldbiblio->{isbn} =~
1526           s/-//g;    # deleting - in isbn to enable amazon content
1527         push( @newresults, $oldbiblio );
1528     }
1529     return @newresults;
1530 }
1531
1532 #----------------------------------------------------------------------
1533 #
1534 # Non-Zebra GetRecords#
1535 #----------------------------------------------------------------------
1536
1537 =head2 NZgetRecords
1538
1539   NZgetRecords has the same API as zera getRecords, even if some parameters are not managed
1540
1541 =cut
1542
1543 sub NZgetRecords {
1544     my (
1545         $query,            $simple_query, $sort_by_ref,    $servers_ref,
1546         $results_per_page, $offset,       $expanded_facet, $branches,
1547         $query_type,       $scan
1548     ) = @_;
1549     warn "query =$query" if $DEBUG;
1550     my $result = NZanalyse($query);
1551     warn "results =$result" if $DEBUG;
1552     return ( undef,
1553         NZorder( $result, @$sort_by_ref[0], $results_per_page, $offset ),
1554         undef );
1555 }
1556
1557 =head2 NZanalyse
1558
1559   NZanalyse : get a CQL string as parameter, and returns a list of biblionumber;title,biblionumber;title,...
1560   the list is built from an inverted index in the nozebra SQL table
1561   note that title is here only for convenience : the sorting will be very fast when requested on title
1562   if the sorting is requested on something else, we will have to reread all results, and that may be longer.
1563
1564 =cut
1565
1566 sub NZanalyse {
1567     my ( $string, $server ) = @_;
1568 #     warn "---------"       if $DEBUG;
1569     warn " NZanalyse" if $DEBUG;
1570 #     warn "---------"       if $DEBUG;
1571
1572  # $server contains biblioserver or authorities, depending on what we search on.
1573  #warn "querying : $string on $server";
1574     $server = 'biblioserver' unless $server;
1575
1576 # if we have a ", replace the content to discard temporarily any and/or/not inside
1577     my $commacontent;
1578     if ( $string =~ /"/ ) {
1579         $string =~ s/"(.*?)"/__X__/;
1580         $commacontent = $1;
1581         warn "commacontent : $commacontent" if $DEBUG;
1582     }
1583
1584 # split the query string in 3 parts : X AND Y means : $left="X", $operand="AND" and $right="Y"
1585 # then, call again NZanalyse with $left and $right
1586 # (recursive until we find a leaf (=> something without and/or/not)
1587 # delete repeated operator... Would then go in infinite loop
1588     while ( $string =~ s/( and| or| not| AND| OR| NOT)\1/$1/g ) {
1589     }
1590
1591     #process parenthesis before.
1592     if ( $string =~ /^\s*\((.*)\)(( and | or | not | AND | OR | NOT )(.*))?/ ) {
1593         my $left     = $1;
1594         my $right    = $4;
1595         my $operator = lc($3);   # FIXME: and/or/not are operators, not operands
1596         warn
1597 "dealing w/parenthesis before recursive sub call. left :$left operator:$operator right:$right"
1598           if $DEBUG;
1599         my $leftresult = NZanalyse( $left, $server );
1600         if ($operator) {
1601             my $rightresult = NZanalyse( $right, $server );
1602
1603             # OK, we have the results for right and left part of the query
1604             # depending of operand, intersect, union or exclude both lists
1605             # to get a result list
1606             if ( $operator eq ' and ' ) {
1607                 return NZoperatorAND($leftresult,$rightresult);
1608             }
1609             elsif ( $operator eq ' or ' ) {
1610
1611                 # just merge the 2 strings
1612                 return $leftresult . $rightresult;
1613             }
1614             elsif ( $operator eq ' not ' ) {
1615                 return NZoperatorNOT($leftresult,$rightresult);
1616             }
1617         }
1618         else {
1619 # this error is impossible, because of the regexp that isolate the operand, but just in case...
1620             return $leftresult;
1621         }
1622     }
1623     warn "string :" . $string if $DEBUG;
1624     $string =~ /(.*?)( and | or | not | AND | OR | NOT )(.*)/;
1625     my $left     = $1;
1626     my $right    = $3;
1627     my $operator = lc($2);    # FIXME: and/or/not are operators, not operands
1628     warn "no parenthesis. left : $left operator: $operator right: $right"
1629       if $DEBUG;
1630
1631     # it's not a leaf, we have a and/or/not
1632     if ($operator) {
1633
1634         # reintroduce comma content if needed
1635         $right =~ s/__X__/"$commacontent"/ if $commacontent;
1636         $left  =~ s/__X__/"$commacontent"/ if $commacontent;
1637         warn "node : $left / $operator / $right\n" if $DEBUG;
1638         my $leftresult  = NZanalyse( $left,  $server );
1639         my $rightresult = NZanalyse( $right, $server );
1640         warn " leftresult : $leftresult" if $DEBUG;
1641         warn " rightresult : $rightresult" if $DEBUG;
1642         # OK, we have the results for right and left part of the query
1643         # depending of operand, intersect, union or exclude both lists
1644         # to get a result list
1645         if ( $operator eq ' and ' ) {
1646             warn "NZAND";
1647             return NZoperatorAND($leftresult,$rightresult);
1648         }
1649         elsif ( $operator eq ' or ' ) {
1650
1651             # just merge the 2 strings
1652             return $leftresult . $rightresult;
1653         }
1654         elsif ( $operator eq ' not ' ) {
1655             return NZoperatorNOT($leftresult,$rightresult);
1656         }
1657         else {
1658
1659 # this error is impossible, because of the regexp that isolate the operand, but just in case...
1660             die "error : operand unknown : $operator for $string";
1661         }
1662
1663         # it's a leaf, do the real SQL query and return the result
1664     }
1665     else {
1666         $string =~ s/__X__/"$commacontent"/ if $commacontent;
1667         $string =~ s/-|\.|\?|,|;|!|'|\(|\)|\[|\]|{|}|"|&|\+|\*|\// /g;
1668         #remove trailing blank at the beginning
1669         $string =~ s/^ //g;
1670         warn "leaf:$string" if $DEBUG;
1671
1672         # parse the string in in operator/operand/value again
1673         $string =~ /(.*)(>=|<=)(.*)/;
1674         my $left     = $1;
1675         my $operator = $2;
1676         my $right    = $3;
1677 #         warn "handling leaf... left:$left operator:$operator right:$right"
1678 #           if $DEBUG;
1679         unless ($operator) {
1680             $string =~ /(.*)(>|<|=)(.*)/;
1681             $left     = $1;
1682             $operator = $2;
1683             $right    = $3;
1684             warn
1685 "handling unless (operator)... left:$left operator:$operator right:$right"
1686               if $DEBUG;
1687         }
1688         my $results;
1689
1690 # strip adv, zebra keywords, currently not handled in nozebra: wrdl, ext, phr...
1691         $left =~ s/ .*$//;
1692
1693         # automatic replace for short operators
1694         $left = 'title'            if $left =~ '^ti$';
1695         $left = 'author'           if $left =~ '^au$';
1696         $left = 'publisher'        if $left =~ '^pb$';
1697         $left = 'subject'          if $left =~ '^su$';
1698         $left = 'koha-Auth-Number' if $left =~ '^an$';
1699         $left = 'keyword'          if $left =~ '^kw$';
1700         warn "handling leaf... left:$left operator:$operator right:$right" if $DEBUG;
1701         if ( $operator && $left ne 'keyword' ) {
1702
1703             #do a specific search
1704             my $dbh = C4::Context->dbh;
1705             $operator = 'LIKE' if $operator eq '=' and $right =~ /%/;
1706             my $sth =
1707               $dbh->prepare(
1708 "SELECT biblionumbers,value FROM nozebra WHERE server=? AND indexname=? AND value $operator ?"
1709               );
1710             warn "$left / $operator / $right\n" if $DEBUG;
1711
1712             # split each word, query the DB and build the biblionumbers result
1713             #sanitizing leftpart
1714             $left =~ s/^\s+|\s+$//;
1715             foreach ( split / /, $right ) {
1716                 my $biblionumbers;
1717                 $_ =~ s/^\s+|\s+$//;
1718                 next unless $_;
1719                 warn "EXECUTE : $server, $left, $_" if $DEBUG;
1720                 $sth->execute( $server, $left, $_ )
1721                   or warn "execute failed: $!";
1722                 while ( my ( $line, $value ) = $sth->fetchrow ) {
1723
1724 # if we are dealing with a numeric value, use only numeric results (in case of >=, <=, > or <)
1725 # otherwise, fill the result
1726                     $biblionumbers .= $line
1727                       unless ( $right =~ /^\d+$/ && $value =~ /\D/ );
1728                     warn "result : $value "
1729                       . ( $right  =~ /\d/ ) . "=="
1730                       . ( $value =~ /\D/?$line:"" ) if $DEBUG;         #= $line";
1731                 }
1732
1733 # do a AND with existing list if there is one, otherwise, use the biblionumbers list as 1st result list
1734                 if ($results) {
1735                     warn "NZAND" if $DEBUG;
1736                     $results = NZoperatorAND($biblionumbers,$results);
1737                 }
1738                 else {
1739                     $results = $biblionumbers;
1740                 }
1741             }
1742         }
1743         else {
1744
1745       #do a complete search (all indexes), if index='kw' do complete search too.
1746             my $dbh = C4::Context->dbh;
1747             my $sth =
1748               $dbh->prepare(
1749 "SELECT biblionumbers FROM nozebra WHERE server=? AND value LIKE ?"
1750               );
1751
1752             # split each word, query the DB and build the biblionumbers result
1753             foreach ( split / /, $string ) {
1754                 next if C4::Context->stopwords->{ uc($_) };   # skip if stopword
1755                 warn "search on all indexes on $_" if $DEBUG;
1756                 my $biblionumbers;
1757                 next unless $_;
1758                 $sth->execute( $server, $_ );
1759                 while ( my $line = $sth->fetchrow ) {
1760                     $biblionumbers .= $line;
1761                 }
1762
1763 # do a AND with existing list if there is one, otherwise, use the biblionumbers list as 1st result list
1764                 if ($results) {
1765                     $results = NZoperatorAND($biblionumbers,$results);
1766                 }
1767                 else {
1768                     warn "NEW RES for $_ = $biblionumbers" if $DEBUG;
1769                     $results = $biblionumbers;
1770                 }
1771             }
1772         }
1773         warn "return : $results for LEAF : $string" if $DEBUG;
1774         return $results;
1775     }
1776     warn "---------\nLeave NZanalyse\n---------" if $DEBUG;
1777 }
1778
1779 sub NZoperatorAND{
1780     my ($rightresult, $leftresult)=@_;
1781
1782     my @leftresult = split /;/, $leftresult;
1783     warn " @leftresult / $rightresult \n" if $DEBUG;
1784
1785     #             my @rightresult = split /;/,$leftresult;
1786     my $finalresult;
1787
1788 # parse the left results, and if the biblionumber exist in the right result, save it in finalresult
1789 # the result is stored twice, to have the same weight for AND than OR.
1790 # example : TWO : 61,61,64,121 (two is twice in the biblio #61) / TOWER : 61,64,130
1791 # result : 61,61,61,61,64,64 for two AND tower : 61 has more weight than 64
1792     foreach (@leftresult) {
1793         my $value = $_;
1794         my $countvalue;
1795         ( $value, $countvalue ) = ( $1, $2 ) if ($value=~/(.*)-(\d+)$/);
1796         if ( $rightresult =~ /\Q$value\E-(\d+);/ ) {
1797             $countvalue = ( $1 > $countvalue ? $countvalue : $1 );
1798             $finalresult .=
1799                 "$value-$countvalue;$value-$countvalue;";
1800         }
1801     }
1802     warn "NZAND DONE : $finalresult \n" if $DEBUG;
1803     return $finalresult;
1804 }
1805
1806 sub NZoperatorOR{
1807     my ($rightresult, $leftresult)=@_;
1808     return $rightresult.$leftresult;
1809 }
1810
1811 sub NZoperatorNOT{
1812     my ($rightresult, $leftresult)=@_;
1813
1814     my @leftresult = split /;/, $leftresult;
1815
1816     #             my @rightresult = split /;/,$leftresult;
1817     my $finalresult;
1818     foreach (@leftresult) {
1819         my $value=$_;
1820         $value=$1 if $value=~m/(.*)-\d+$/;
1821         unless ($rightresult =~ "$value-") {
1822             $finalresult .= "$_;";
1823         }
1824     }
1825     return $finalresult;
1826 }
1827
1828 =head2 NZorder
1829
1830   $finalresult = NZorder($biblionumbers, $ordering,$results_per_page,$offset);
1831
1832   TODO :: Description
1833
1834 =cut
1835
1836 sub NZorder {
1837     my ( $biblionumbers, $ordering, $results_per_page, $offset ) = @_;
1838     warn "biblionumbers = $biblionumbers and ordering = $ordering\n" if $DEBUG;
1839
1840     # order title asc by default
1841     #     $ordering = '1=36 <i' unless $ordering;
1842     $results_per_page = 20 unless $results_per_page;
1843     $offset           = 0  unless $offset;
1844     my $dbh = C4::Context->dbh;
1845
1846     #
1847     # order by POPULARITY
1848     #
1849     if ( $ordering =~ /popularity/ ) {
1850         my %result;
1851         my %popularity;
1852
1853         # popularity is not in MARC record, it's builded from a specific query
1854         my $sth =
1855           $dbh->prepare("select sum(issues) from items where biblionumber=?");
1856         foreach ( split /;/, $biblionumbers ) {
1857             my ( $biblionumber, $title ) = split /,/, $_;
1858             $result{$biblionumber} = GetMarcBiblio($biblionumber);
1859             $sth->execute($biblionumber);
1860             my $popularity = $sth->fetchrow || 0;
1861
1862 # hint : the key is popularity.title because we can have
1863 # many results with the same popularity. In this cas, sub-ordering is done by title
1864 # we also have biblionumber to avoid bug for 2 biblios with the same title & popularity
1865 # (un-frequent, I agree, but we won't forget anything that way ;-)
1866             $popularity{ sprintf( "%10d", $popularity ) . $title
1867                   . $biblionumber } = $biblionumber;
1868         }
1869
1870     # sort the hash and return the same structure as GetRecords (Zebra querying)
1871         my $result_hash;
1872         my $numbers = 0;
1873         if ( $ordering eq 'popularity_dsc' ) {    # sort popularity DESC
1874             foreach my $key ( sort { $b cmp $a } ( keys %popularity ) ) {
1875                 $result_hash->{'RECORDS'}[ $numbers++ ] =
1876                   $result{ $popularity{$key} }->as_usmarc();
1877             }
1878         }
1879         else {                                    # sort popularity ASC
1880             foreach my $key ( sort ( keys %popularity ) ) {
1881                 $result_hash->{'RECORDS'}[ $numbers++ ] =
1882                   $result{ $popularity{$key} }->as_usmarc();
1883             }
1884         }
1885         my $finalresult = ();
1886         $result_hash->{'hits'}         = $numbers;
1887         $finalresult->{'biblioserver'} = $result_hash;
1888         return $finalresult;
1889
1890         #
1891         # ORDER BY author
1892         #
1893     }
1894     elsif ( $ordering =~ /author/ ) {
1895         my %result;
1896         foreach ( split /;/, $biblionumbers ) {
1897             my ( $biblionumber, $title ) = split /,/, $_;
1898             my $record = GetMarcBiblio($biblionumber);
1899             my $author;
1900             if ( C4::Context->preference('marcflavour') eq 'UNIMARC' ) {
1901                 $author = $record->subfield( '200', 'f' );
1902                 $author = $record->subfield( '700', 'a' ) unless $author;
1903             }
1904             else {
1905                 $author = $record->subfield( '100', 'a' );
1906             }
1907
1908 # hint : the result is sorted by title.biblionumber because we can have X biblios with the same title
1909 # and we don't want to get only 1 result for each of them !!!
1910             $result{ $author . $biblionumber } = $record;
1911         }
1912
1913     # sort the hash and return the same structure as GetRecords (Zebra querying)
1914         my $result_hash;
1915         my $numbers = 0;
1916         if ( $ordering eq 'author_za' ) {    # sort by author desc
1917             foreach my $key ( sort { $b cmp $a } ( keys %result ) ) {
1918                 $result_hash->{'RECORDS'}[ $numbers++ ] =
1919                   $result{$key}->as_usmarc();
1920             }
1921         }
1922         else {                               # sort by author ASC
1923             foreach my $key ( sort ( keys %result ) ) {
1924                 $result_hash->{'RECORDS'}[ $numbers++ ] =
1925                   $result{$key}->as_usmarc();
1926             }
1927         }
1928         my $finalresult = ();
1929         $result_hash->{'hits'}         = $numbers;
1930         $finalresult->{'biblioserver'} = $result_hash;
1931         return $finalresult;
1932
1933         #
1934         # ORDER BY callnumber
1935         #
1936     }
1937     elsif ( $ordering =~ /callnumber/ ) {
1938         my %result;
1939         foreach ( split /;/, $biblionumbers ) {
1940             my ( $biblionumber, $title ) = split /,/, $_;
1941             my $record = GetMarcBiblio($biblionumber);
1942             my $callnumber;
1943             my ( $callnumber_tag, $callnumber_subfield ) =
1944               GetMarcFromKohaField( $dbh, 'items.itemcallnumber' );
1945             ( $callnumber_tag, $callnumber_subfield ) =
1946               GetMarcFromKohaField('biblioitems.callnumber')
1947               unless $callnumber_tag;
1948             if ( C4::Context->preference('marcflavour') eq 'UNIMARC' ) {
1949                 $callnumber = $record->subfield( '200', 'f' );
1950             }
1951             else {
1952                 $callnumber = $record->subfield( '100', 'a' );
1953             }
1954
1955 # hint : the result is sorted by title.biblionumber because we can have X biblios with the same title
1956 # and we don't want to get only 1 result for each of them !!!
1957             $result{ $callnumber . $biblionumber } = $record;
1958         }
1959
1960     # sort the hash and return the same structure as GetRecords (Zebra querying)
1961         my $result_hash;
1962         my $numbers = 0;
1963         if ( $ordering eq 'call_number_dsc' ) {    # sort by title desc
1964             foreach my $key ( sort { $b cmp $a } ( keys %result ) ) {
1965                 $result_hash->{'RECORDS'}[ $numbers++ ] =
1966                   $result{$key}->as_usmarc();
1967             }
1968         }
1969         else {                                     # sort by title ASC
1970             foreach my $key ( sort { $a cmp $b } ( keys %result ) ) {
1971                 $result_hash->{'RECORDS'}[ $numbers++ ] =
1972                   $result{$key}->as_usmarc();
1973             }
1974         }
1975         my $finalresult = ();
1976         $result_hash->{'hits'}         = $numbers;
1977         $finalresult->{'biblioserver'} = $result_hash;
1978         return $finalresult;
1979     }
1980     elsif ( $ordering =~ /pubdate/ ) {             #pub year
1981         my %result;
1982         foreach ( split /;/, $biblionumbers ) {
1983             my ( $biblionumber, $title ) = split /,/, $_;
1984             my $record = GetMarcBiblio($biblionumber);
1985             my ( $publicationyear_tag, $publicationyear_subfield ) =
1986               GetMarcFromKohaField( 'biblioitems.publicationyear', '' );
1987             my $publicationyear =
1988               $record->subfield( $publicationyear_tag,
1989                 $publicationyear_subfield );
1990
1991 # hint : the result is sorted by title.biblionumber because we can have X biblios with the same title
1992 # and we don't want to get only 1 result for each of them !!!
1993             $result{ $publicationyear . $biblionumber } = $record;
1994         }
1995
1996     # sort the hash and return the same structure as GetRecords (Zebra querying)
1997         my $result_hash;
1998         my $numbers = 0;
1999         if ( $ordering eq 'pubdate_dsc' ) {    # sort by pubyear desc
2000             foreach my $key ( sort { $b cmp $a } ( keys %result ) ) {
2001                 $result_hash->{'RECORDS'}[ $numbers++ ] =
2002                   $result{$key}->as_usmarc();
2003             }
2004         }
2005         else {                                 # sort by pub year ASC
2006             foreach my $key ( sort ( keys %result ) ) {
2007                 $result_hash->{'RECORDS'}[ $numbers++ ] =
2008                   $result{$key}->as_usmarc();
2009             }
2010         }
2011         my $finalresult = ();
2012         $result_hash->{'hits'}         = $numbers;
2013         $finalresult->{'biblioserver'} = $result_hash;
2014         return $finalresult;
2015
2016         #
2017         # ORDER BY title
2018         #
2019     }
2020     elsif ( $ordering =~ /title/ ) {
2021
2022 # the title is in the biblionumbers string, so we just need to build a hash, sort it and return
2023         my %result;
2024         foreach ( split /;/, $biblionumbers ) {
2025             my ( $biblionumber, $title ) = split /,/, $_;
2026
2027 # hint : the result is sorted by title.biblionumber because we can have X biblios with the same title
2028 # and we don't want to get only 1 result for each of them !!!
2029 # hint & speed improvement : we can order without reading the record
2030 # so order, and read records only for the requested page !
2031             $result{ $title . $biblionumber } = $biblionumber;
2032         }
2033
2034     # sort the hash and return the same structure as GetRecords (Zebra querying)
2035         my $result_hash;
2036         my $numbers = 0;
2037         if ( $ordering eq 'title_az' ) {    # sort by title desc
2038             foreach my $key ( sort ( keys %result ) ) {
2039                 $result_hash->{'RECORDS'}[ $numbers++ ] = $result{$key};
2040             }
2041         }
2042         else {                              # sort by title ASC
2043             foreach my $key ( sort { $b cmp $a } ( keys %result ) ) {
2044                 $result_hash->{'RECORDS'}[ $numbers++ ] = $result{$key};
2045             }
2046         }
2047
2048         # limit the $results_per_page to result size if it's more
2049         $results_per_page = $numbers - 1 if $numbers < $results_per_page;
2050
2051         # for the requested page, replace biblionumber by the complete record
2052         # speed improvement : avoid reading too much things
2053         for (
2054             my $counter = $offset ;
2055             $counter <= $offset + $results_per_page ;
2056             $counter++
2057           )
2058         {
2059             $result_hash->{'RECORDS'}[$counter] =
2060               GetMarcBiblio( $result_hash->{'RECORDS'}[$counter] )->as_usmarc;
2061         }
2062         my $finalresult = ();
2063         $result_hash->{'hits'}         = $numbers;
2064         $finalresult->{'biblioserver'} = $result_hash;
2065         return $finalresult;
2066     }
2067     else {
2068
2069 #
2070 # order by ranking
2071 #
2072 # we need 2 hashes to order by ranking : the 1st one to count the ranking, the 2nd to order by ranking
2073         my %result;
2074         my %count_ranking;
2075         foreach ( split /;/, $biblionumbers ) {
2076             my ( $biblionumber, $title ) = split /,/, $_;
2077             $title =~ /(.*)-(\d)/;
2078
2079             # get weight
2080             my $ranking = $2;
2081
2082 # note that we + the ranking because ranking is calculated on weight of EACH term requested.
2083 # if we ask for "two towers", and "two" has weight 2 in biblio N, and "towers" has weight 4 in biblio N
2084 # biblio N has ranking = 6
2085             $count_ranking{$biblionumber} += $ranking;
2086         }
2087
2088 # build the result by "inverting" the count_ranking hash
2089 # 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
2090 #         warn "counting";
2091         foreach ( keys %count_ranking ) {
2092             $result{ sprintf( "%10d", $count_ranking{$_} ) . '-' . $_ } = $_;
2093         }
2094
2095     # sort the hash and return the same structure as GetRecords (Zebra querying)
2096         my $result_hash;
2097         my $numbers = 0;
2098         foreach my $key ( sort { $b cmp $a } ( keys %result ) ) {
2099             $result_hash->{'RECORDS'}[ $numbers++ ] = $result{$key};
2100         }
2101
2102         # limit the $results_per_page to result size if it's more
2103         $results_per_page = $numbers - 1 if $numbers < $results_per_page;
2104
2105         # for the requested page, replace biblionumber by the complete record
2106         # speed improvement : avoid reading too much things
2107         for (
2108             my $counter = $offset ;
2109             $counter <= $offset + $results_per_page ;
2110             $counter++
2111           )
2112         {
2113             $result_hash->{'RECORDS'}[$counter] =
2114               GetMarcBiblio( $result_hash->{'RECORDS'}[$counter] )->as_usmarc
2115               if $result_hash->{'RECORDS'}[$counter];
2116         }
2117         my $finalresult = ();
2118         $result_hash->{'hits'}         = $numbers;
2119         $finalresult->{'biblioserver'} = $result_hash;
2120         return $finalresult;
2121     }
2122 }
2123
2124 =head2 ModBiblios
2125
2126 ($countchanged,$listunchanged) = ModBiblios($listbiblios, $tagsubfield,$initvalue,$targetvalue,$test);
2127
2128 this function changes all the values $initvalue in subfield $tag$subfield in any record in $listbiblios
2129 test parameter if set donot perform change to records in database.
2130
2131 =over 2
2132
2133 =item C<input arg:>
2134
2135     * $listbiblios is an array ref to marcrecords to be changed
2136     * $tagsubfield is the reference of the subfield to change.
2137     * $initvalue is the value to search the record for
2138     * $targetvalue is the value to set the subfield to
2139     * $test is to be set only not to perform changes in database.
2140
2141 =item C<Output arg:>
2142     * $countchanged counts all the changes performed.
2143     * $listunchanged contains the list of all the biblionumbers of records unchanged.
2144
2145 =item C<usage in the script:>
2146
2147 =back
2148
2149 my ($countchanged, $listunchanged) = EditBiblios($results->{RECORD}, $tagsubfield,$initvalue,$targetvalue);;
2150 #If one wants to display unchanged records, you should get biblios foreach @$listunchanged
2151 $template->param(countchanged => $countchanged, loopunchanged=>$listunchanged);
2152
2153 =cut
2154
2155 sub ModBiblios {
2156     my ( $listbiblios, $tagsubfield, $initvalue, $targetvalue, $test ) = @_;
2157     my $countmatched;
2158     my @unmatched;
2159     my ( $tag, $subfield ) = ( $1, $2 )
2160       if ( $tagsubfield =~ /^(\d{1,3})([a-z0-9A-Z@])?$/ );
2161     if ( ( length($tag) < 3 ) && $subfield =~ /0-9/ ) {
2162         $tag = $tag . $subfield;
2163         undef $subfield;
2164     }
2165     my ( $bntag,   $bnsubf )   = GetMarcFromKohaField('biblio.biblionumber');
2166     my ( $itemtag, $itemsubf ) = GetMarcFromKohaField('items.itemnumber');
2167     if ($tag eq $itemtag) {
2168         # do not allow the embedded item tag to be
2169         # edited from here
2170         warn "Attempting to edit item tag via C4::Search::ModBiblios -- not allowed";
2171         return (0, []);
2172     }
2173     foreach my $usmarc (@$listbiblios) {
2174         my $record;
2175         $record = eval { MARC::Record->new_from_usmarc($usmarc) };
2176         my $biblionumber;
2177         if ($@) {
2178
2179             # usmarc is not a valid usmarc May be a biblionumber
2180             # FIXME - sorry, please let's figure out whether
2181             #         this function is to be passed a list of
2182             #         record numbers or a list of MARC::Record
2183             #         objects.  The former is probably better
2184             #         because the MARC records supplied by Zebra
2185             #         may be not current.
2186             $record       = GetMarcBiblio($usmarc);
2187             $biblionumber = $usmarc;
2188         }
2189         else {
2190             if ( $bntag >= 010 ) {
2191                 $biblionumber = $record->subfield( $bntag, $bnsubf );
2192             }
2193             else {
2194                 $biblionumber = $record->field($bntag)->data;
2195             }
2196         }
2197
2198         #GetBiblionumber is to be written.
2199         #Could be replaced by TransformMarcToKoha (But Would be longer)
2200         if ( $record->field($tag) ) {
2201             my $modify = 0;
2202             foreach my $field ( $record->field($tag) ) {
2203                 if ($subfield) {
2204                     if (
2205                         $field->delete_subfield(
2206                             'code'  => $subfield,
2207                             'match' => qr($initvalue)
2208                         )
2209                       )
2210                     {
2211                         $countmatched++;
2212                         $modify = 1;
2213                         $field->update( $subfield, $targetvalue )
2214                           if ($targetvalue);
2215                     }
2216                 }
2217                 else {
2218                     if ( $tag >= 010 ) {
2219                         if ( $field->delete_field($field) ) {
2220                             $countmatched++;
2221                             $modify = 1;
2222                         }
2223                     }
2224                     else {
2225                         $field->data = $targetvalue
2226                           if ( $field->data =~ qr($initvalue) );
2227                     }
2228                 }
2229             }
2230
2231             #       warn $record->as_formatted;
2232             if ($modify) {
2233                 ModBiblio( $record, $biblionumber,
2234                     GetFrameworkCode($biblionumber) )
2235                   unless ($test);
2236             }
2237             else {
2238                 push @unmatched, $biblionumber;
2239             }
2240         }
2241         else {
2242             push @unmatched, $biblionumber;
2243         }
2244     }
2245     return ( $countmatched, \@unmatched );
2246 }
2247
2248 END { }    # module clean-up code here (global destructor)
2249
2250 1;
2251 __END__
2252
2253 =head1 AUTHOR
2254
2255 Koha Developement team <info@koha.org>
2256
2257 =cut