koha-dev.rot13.org Git - koha_fer/blob - C4/Search.pm

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