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