C4/Search.pm

   1 package C4::Search;
   2
   3 # This file is part of Koha.
   4 #
   5 # Koha is free software; you can redistribute it and/or modify it under the
   6 # terms of the GNU General Public License as published by the Free Software
   7 # Foundation; either version 2 of the License, or (at your option) any later
   8 # version.
   9 #
  10 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
  11 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
  12 # A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
  13 #
  14 # You should have received a copy of the GNU General Public License along with
  15 # Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
  16 # Suite 330, Boston, MA  02111-1307 USA
  17
  18 use strict;
  19 require Exporter;
  20 use C4::Context;
  21 use C4::Biblio;    # GetMarcFromKohaField
  22 use C4::Koha;      # getFacets
  23 use Lingua::Stem;
  24 use C4::Search::PazPar2;
  25 use XML::Simple;
  26 use C4::Dates qw(format_date);
  27 use C4::XSLT;
  28
  29 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $DEBUG);
  30
  31 # set the version for version checking
  32 BEGIN {
  33     $VERSION = 3.01;
  34     $DEBUG = ($ENV{DEBUG}) ? 1 : 0;
  35 }
  36
  37 =head1 NAME
  38
  39 C4::Search - Functions for searching the Koha catalog.
  40
  41 =head1 SYNOPSIS
  42
  43 See opac/opac-search.pl or catalogue/search.pl for example of usage
  44
  45 =head1 DESCRIPTION
  46
  47 This module provides searching functions for Koha's bibliographic databases
  48
  49 =head1 FUNCTIONS
  50
  51 =cut
  52
  53 @ISA    = qw(Exporter);
  54 @EXPORT = qw(
  55   &findseealso
  56   &FindDuplicate
  57   &SimpleSearch
  58   &searchResults
  59   &getRecords
  60   &buildQuery
  61   &NZgetRecords
  62   &ModBiblios
  63 );
  64
  65 # make all your functions, whether exported or not;
  66
  67 =head2 findseealso($dbh,$fields);
  68
  69 C<$dbh> is a link to the DB handler.
  70
  71 use C4::Context;
  72 my $dbh =C4::Context->dbh;
  73
  74 C<$fields> is a reference to the fields array
  75
  76 This function modifies the @$fields array and adds related fields to search on.
  77
  78 FIXME: this function is probably deprecated in Koha 3
  79
  80 =cut
  81
  82 sub findseealso {
  83     my ( $dbh, $fields ) = @_;
  84     my $tagslib = GetMarcStructure(1);
  85     for ( my $i = 0 ; $i <= $#{$fields} ; $i++ ) {
  86         my ($tag)      = substr( @$fields[$i], 1, 3 );
  87         my ($subfield) = substr( @$fields[$i], 4, 1 );
  88         @$fields[$i] .= ',' . $tagslib->{$tag}->{$subfield}->{seealso}
  89           if ( $tagslib->{$tag}->{$subfield}->{seealso} );
  90     }
  91 }
  92
  93 =head2 FindDuplicate
  94
  95 ($biblionumber,$biblionumber,$title) = FindDuplicate($record);
  96
  97 This function attempts to find duplicate records using a hard-coded, fairly simplistic algorithm
  98
  99 =cut
 100
 101 sub FindDuplicate {
 102     my ($record) = @_;
 103     my $dbh = C4::Context->dbh;
 104     my $result = TransformMarcToKoha( $dbh, $record, '' );
 105     my $sth;
 106     my $query;
 107     my $search;
 108     my $type;
 109     my ( $biblionumber, $title );
 110
 111     # search duplicate on ISBN, easy and fast..
 112     # ... normalize first
 113     if ( $result->{isbn} ) {
 114         $result->{isbn} =~ s/\(.*$//;
 115         $result->{isbn} =~ s/\s+$//;
 116         $query = "isbn=$result->{isbn}";
 117     }
 118     else {
 119         $result->{title} =~ s /\\//g;
 120         $result->{title} =~ s /\"//g;
 121         $result->{title} =~ s /\(//g;
 122         $result->{title} =~ s /\)//g;
 123
 124         # FIXME: instead of removing operators, could just do
 125         # quotes around the value
 126         $result->{title} =~ s/(and|or|not)//g;
 127         $query = "ti,ext=$result->{title}";
 128         $query .= " and itemtype=$result->{itemtype}"
 129           if ( $result->{itemtype} );
 130         if   ( $result->{author} ) {
 131             $result->{author} =~ s /\\//g;
 132             $result->{author} =~ s /\"//g;
 133             $result->{author} =~ s /\(//g;
 134             $result->{author} =~ s /\)//g;
 135
 136             # remove valid operators
 137             $result->{author} =~ s/(and|or|not)//g;
 138             $query .= " and au,ext=$result->{author}";
 139         }
 140     }
 141
 142     # FIXME: add error handling
 143     my ( $error, $searchresults ) = SimpleSearch($query); # FIXME :: hardcoded !
 144     my @results;
 145     foreach my $possible_duplicate_record (@$searchresults) {
 146         my $marcrecord =
 147           MARC::Record->new_from_usmarc($possible_duplicate_record);
 148         my $result = TransformMarcToKoha( $dbh, $marcrecord, '' );
 149
 150         # FIXME :: why 2 $biblionumber ?
 151         if ($result) {
 152             push @results, $result->{'biblionumber'};
 153             push @results, $result->{'title'};
 154         }
 155     }
 156     return @results;
 157 }
 158
 159 =head2 SimpleSearch
 160
 161 ($error,$results) = SimpleSearch( $query, $offset, $max_results, [ @servers ] );
 162
 163 This function provides a simple search API on the bibliographic catalog
 164
 165 =over 2
 166
 167 =item C<input arg:>
 168
 169     * $query can be a simple keyword or a complete CCL query
 170     * @servers is optional. Defaults to biblioserver as found in koha-conf.xml
 171     * $offset - If present, represents the number of records at the beggining to omit. Defaults to 0
 172     * $max_results - if present, determines the maximum number of records to fetch. undef is All. defaults to undef.
 173
 174
 175 =item C<Output arg:>
 176     * $error is a empty unless an error is detected
 177     * \@results is an array of records.
 178
 179 =item C<usage in the script:>
 180
 181 =back
 182
 183 my ($error, $marcresults) = SimpleSearch($query);
 184
 185 if (defined $error) {
 186     $template->param(query_error => $error);
 187     warn "error: ".$error;
 188     output_html_with_http_headers $input, $cookie, $template->output;
 189     exit;
 190 }
 191
 192 my $hits = scalar @$marcresults;
 193 my @results;
 194
 195 for(my $i=0;$i<$hits;$i++) {
 196     my %resultsloop;
 197     my $marcrecord = MARC::File::USMARC::decode($marcresults->[$i]);
 198     my $biblio = TransformMarcToKoha(C4::Context->dbh,$marcrecord,'');
 199
 200     #build the hash for the template.
 201     $resultsloop{highlight}       = ($i % 2)?(1):(0);
 202     $resultsloop{title}           = $biblio->{'title'};
 203     $resultsloop{subtitle}        = $biblio->{'subtitle'};
 204     $resultsloop{biblionumber}    = $biblio->{'biblionumber'};
 205     $resultsloop{author}          = $biblio->{'author'};
 206     $resultsloop{publishercode}   = $biblio->{'publishercode'};
 207     $resultsloop{publicationyear} = $biblio->{'publicationyear'};
 208
 209     push @results, \%resultsloop;
 210 }
 211
 212 $template->param(result=>\@results);
 213
 214 =cut
 215
 216 sub SimpleSearch {
 217     my ( $query, $offset, $max_results, $servers )  = @_;
 218
 219     if ( C4::Context->preference('NoZebra') ) {
 220         my $result = NZorder( NZanalyse($query) )->{'biblioserver'};
 221         my $search_result =
 222           (      $result->{hits}
 223               && $result->{hits} > 0 ? $result->{'RECORDS'} : [] );
 224         return ( undef, $search_result );
 225     }
 226     else {
 227         # FIXME hardcoded value. See catalog/search.pl & opac-search.pl too.
 228         my @servers = defined ( $servers ) ? @$servers : ( "biblioserver" );
 229         my @results;
 230         my @tmpresults;
 231         my @zconns;
 232         return ( "No query entered", undef ) unless $query;
 233
 234         # Initialize & Search Zebra
 235         for ( my $i = 0 ; $i < @servers ; $i++ ) {
 236             eval {
 237                 $zconns[$i] = C4::Context->Zconn( $servers[$i], 1 );
 238                 $tmpresults[$i] =
 239                   $zconns[$i]
 240                   ->search( new ZOOM::Query::CCL2RPN( $query, $zconns[$i] ) );
 241
 242                 # error handling
 243                 my $error =
 244                     $zconns[$i]->errmsg() . " ("
 245                   . $zconns[$i]->errcode() . ") "
 246                   . $zconns[$i]->addinfo() . " "
 247                   . $zconns[$i]->diagset();
 248
 249                 return ( $error, undef ) if $zconns[$i]->errcode();
 250             };
 251             if ($@) {
 252
 253                 # caught a ZOOM::Exception
 254                 my $error =
 255                     $@->message() . " ("
 256                   . $@->code() . ") "
 257                   . $@->addinfo() . " "
 258                   . $@->diagset();
 259                 warn $error;
 260                 return ( $error, undef );
 261             }
 262         }
 263
 264         while ( ( my $i = ZOOM::event( \@zconns ) ) != 0 ) {
 265             my $event = $zconns[ $i - 1 ]->last_event();
 266             if ( $event == ZOOM::Event::ZEND ) {
 267
 268                 my $first_record = defined( $offset ) ? $offset+1 : 1;
 269                 my $hits = $tmpresults[ $i - 1 ]->size();
 270                 my $last_record = $hits;
 271                 if ( defined $max_results && $offset + $max_results < $hits ) {
 272                     $last_record  = $offset + $max_results;
 273                 }
 274
 275                 for my $j ( $first_record..$last_record ) {
 276                     my $record = $tmpresults[ $i - 1 ]->record( $j-1 )->raw(); # 0 indexed
 277                     push @results, $record;
 278                 }
 279             }
 280         }
 281
 282         return ( undef, \@results );
 283     }
 284 }
 285
 286 =head2 getRecords
 287
 288 ( undef, $results_hashref, \@facets_loop ) = getRecords (
 289
 290         $koha_query,       $simple_query, $sort_by_ref,    $servers_ref,
 291         $results_per_page, $offset,       $expanded_facet, $branches,
 292         $query_type,       $scan
 293     );
 294
 295 The all singing, all dancing, multi-server, asynchronous, scanning,
 296 searching, record nabbing, facet-building
 297
 298 See verbse embedded documentation.
 299
 300 =cut
 301
 302 sub getRecords {
 303     my (
 304         $koha_query,       $simple_query, $sort_by_ref,    $servers_ref,
 305         $results_per_page, $offset,       $expanded_facet, $branches,
 306         $query_type,       $scan
 307     ) = @_;
 308
 309     my @servers = @$servers_ref;
 310     my @sort_by = @$sort_by_ref;
 311
 312     # Initialize variables for the ZOOM connection and results object
 313     my $zconn;
 314     my @zconns;
 315     my @results;
 316     my $results_hashref = ();
 317
 318     # Initialize variables for the faceted results objects
 319     my $facets_counter = ();
 320     my $facets_info    = ();
 321     my $facets         = getFacets();
 322
 323     my @facets_loop
 324       ;    # stores the ref to array of hashes for template facets loop
 325
 326     ### LOOP THROUGH THE SERVERS
 327     for ( my $i = 0 ; $i < @servers ; $i++ ) {
 328         $zconns[$i] = C4::Context->Zconn( $servers[$i], 1 );
 329
 330 # perform the search, create the results objects
 331 # if this is a local search, use the $koha-query, if it's a federated one, use the federated-query
 332         my $query_to_use;
 333         if ( $servers[$i] =~ /biblioserver/ ) {
 334             $query_to_use = $koha_query;
 335         }
 336         else {
 337             $query_to_use = $simple_query;
 338         }
 339
 340         #$query_to_use = $simple_query if $scan;
 341         warn $simple_query if ( $scan and $DEBUG );
 342
 343         # Check if we've got a query_type defined, if so, use it
 344         eval {
 345             if ($query_type)
 346             {
 347                 if ( $query_type =~ /^ccl/ ) {
 348                     $query_to_use =~
 349                       s/\:/\=/g;    # change : to = last minute (FIXME)
 350                     $results[$i] =
 351                       $zconns[$i]->search(
 352                         new ZOOM::Query::CCL2RPN( $query_to_use, $zconns[$i] )
 353                       );
 354                 }
 355                 elsif ( $query_type =~ /^cql/ ) {
 356                     $results[$i] =
 357                       $zconns[$i]->search(
 358                         new ZOOM::Query::CQL( $query_to_use, $zconns[$i] ) );
 359                 }
 360                 elsif ( $query_type =~ /^pqf/ ) {
 361                     $results[$i] =
 362                       $zconns[$i]->search(
 363                         new ZOOM::Query::PQF( $query_to_use, $zconns[$i] ) );
 364                 }
 365             }
 366             else {
 367                 if ($scan) {
 368                     $results[$i] =
 369                       $zconns[$i]->scan(
 370                         new ZOOM::Query::CCL2RPN( $query_to_use, $zconns[$i] )
 371                       );
 372                 }
 373                 else {
 374                     $results[$i] =
 375                       $zconns[$i]->search(
 376                         new ZOOM::Query::CCL2RPN( $query_to_use, $zconns[$i] )
 377                       );
 378                 }
 379             }
 380         };
 381         if ($@) {
 382             warn "WARNING: query problem with $query_to_use " . $@;
 383         }
 384
 385         # Concatenate the sort_by limits and pass them to the results object
 386         # Note: sort will override rank
 387         my $sort_by;
 388         foreach my $sort (@sort_by) {
 389             if ( $sort eq "author_az" ) {
 390                 $sort_by .= "1=1003 <i ";
 391             }
 392             elsif ( $sort eq "author_za" ) {
 393                 $sort_by .= "1=1003 >i ";
 394             }
 395             elsif ( $sort eq "popularity_asc" ) {
 396                 $sort_by .= "1=9003 <i ";
 397             }
 398             elsif ( $sort eq "popularity_dsc" ) {
 399                 $sort_by .= "1=9003 >i ";
 400             }
 401             elsif ( $sort eq "call_number_asc" ) {
 402                 $sort_by .= "1=20  <i ";
 403             }
 404             elsif ( $sort eq "call_number_dsc" ) {
 405                 $sort_by .= "1=20 >i ";
 406             }
 407             elsif ( $sort eq "pubdate_asc" ) {
 408                 $sort_by .= "1=31 <i ";
 409             }
 410             elsif ( $sort eq "pubdate_dsc" ) {
 411                 $sort_by .= "1=31 >i ";
 412             }
 413             elsif ( $sort eq "acqdate_asc" ) {
 414                 $sort_by .= "1=32 <i ";
 415             }
 416             elsif ( $sort eq "acqdate_dsc" ) {
 417                 $sort_by .= "1=32 >i ";
 418             }
 419             elsif ( $sort eq "title_az" ) {
 420                 $sort_by .= "1=4 <i ";
 421             }
 422             elsif ( $sort eq "title_za" ) {
 423                 $sort_by .= "1=4 >i ";
 424             }
 425         }
 426         if ($sort_by) {
 427             if ( $results[$i]->sort( "yaz", $sort_by ) < 0 ) {
 428                 warn "WARNING sort $sort_by failed";
 429             }
 430         }
 431     }    # finished looping through servers
 432
 433     # The big moment: asynchronously retrieve results from all servers
 434     while ( ( my $i = ZOOM::event( \@zconns ) ) != 0 ) {
 435         my $ev = $zconns[ $i - 1 ]->last_event();
 436         if ( $ev == ZOOM::Event::ZEND ) {
 437             next unless $results[ $i - 1 ];
 438             my $size = $results[ $i - 1 ]->size();
 439             if ( $size > 0 ) {
 440                 my $results_hash;
 441
 442                 # loop through the results
 443                 $results_hash->{'hits'} = $size;
 444                 my $times;
 445                 if ( $offset + $results_per_page <= $size ) {
 446                     $times = $offset + $results_per_page;
 447                 }
 448                 else {
 449                     $times = $size;
 450                 }
 451                 for ( my $j = $offset ; $j < $times ; $j++ ) {
 452                     my $records_hash;
 453                     my $record;
 454                     my $facet_record;
 455
 456                     ## Check if it's an index scan
 457                     if ($scan) {
 458                         my ( $term, $occ ) = $results[ $i - 1 ]->term($j);
 459
 460                  # here we create a minimal MARC record and hand it off to the
 461                  # template just like a normal result ... perhaps not ideal, but
 462                  # it works for now
 463                         my $tmprecord = MARC::Record->new();
 464                         $tmprecord->encoding('UTF-8');
 465                         my $tmptitle;
 466                         my $tmpauthor;
 467
 468                 # the minimal record in author/title (depending on MARC flavour)
 469                         if ( C4::Context->preference("marcflavour") eq
 470                             "UNIMARC" )
 471                         {
 472                             $tmptitle = MARC::Field->new(
 473                                 '200', ' ', ' ',
 474                                 a => $term,
 475                                 f => $occ
 476                             );
 477                             $tmprecord->append_fields($tmptitle);
 478                         }
 479                         else {
 480                             $tmptitle =
 481                               MARC::Field->new( '245', ' ', ' ', a => $term, );
 482                             $tmpauthor =
 483                               MARC::Field->new( '100', ' ', ' ', a => $occ, );
 484                             $tmprecord->append_fields($tmptitle);
 485                             $tmprecord->append_fields($tmpauthor);
 486                         }
 487                         $results_hash->{'RECORDS'}[$j] =
 488                           $tmprecord->as_usmarc();
 489                     }
 490
 491                     # not an index scan
 492                     else {
 493                         $record = $results[ $i - 1 ]->record($j)->raw();
 494
 495                         # warn "RECORD $j:".$record;
 496                         $results_hash->{'RECORDS'}[$j] = $record;
 497
 498             # Fill the facets while we're looping, but only for the biblioserver
 499                         $facet_record = MARC::Record->new_from_usmarc($record)
 500                           if $servers[ $i - 1 ] =~ /biblioserver/;
 501
 502                     #warn $servers[$i-1]."\n".$record; #.$facet_record->title();
 503                         if ($facet_record) {
 504                             for ( my $k = 0 ; $k <= @$facets ; $k++ ) {
 505
 506                                 if ( $facets->[$k] ) {
 507                                     my @fields;
 508                                     for my $tag ( @{ $facets->[$k]->{'tags'} } )
 509                                     {
 510                                         push @fields,
 511                                           $facet_record->field($tag);
 512                                     }
 513                                     for my $field (@fields) {
 514                                         my @subfields = $field->subfields();
 515                                         for my $subfield (@subfields) {
 516                                             my ( $code, $data ) = @$subfield;
 517                                             if ( $code eq
 518                                                 $facets->[$k]->{'subfield'} )
 519                                             {
 520                                                 $facets_counter->{ $facets->[$k]
 521                                                       ->{'link_value'} }
 522                                                   ->{$data}++;
 523                                             }
 524                                         }
 525                                     }
 526                                     $facets_info->{ $facets->[$k]
 527                                           ->{'link_value'} }->{'label_value'} =
 528                                       $facets->[$k]->{'label_value'};
 529                                     $facets_info->{ $facets->[$k]
 530                                           ->{'link_value'} }->{'expanded'} =
 531                                       $facets->[$k]->{'expanded'};
 532                                 }
 533                             }
 534                         }
 535                     }
 536                 }
 537                 $results_hashref->{ $servers[ $i - 1 ] } = $results_hash;
 538             }
 539
 540             # warn "connection ", $i-1, ": $size hits";
 541             # warn $results[$i-1]->record(0)->render() if $size > 0;
 542
 543             # BUILD FACETS
 544             if ( $servers[ $i - 1 ] =~ /biblioserver/ ) {
 545                 for my $link_value (
 546                     sort { $facets_counter->{$b} <=> $facets_counter->{$a} }
 547                     keys %$facets_counter )
 548                 {
 549                     my $expandable;
 550                     my $number_of_facets;
 551                     my @this_facets_array;
 552                     for my $one_facet (
 553                         sort {
 554                             $facets_counter->{$link_value}
 555                               ->{$b} <=> $facets_counter->{$link_value}->{$a}
 556                         } keys %{ $facets_counter->{$link_value} }
 557                       )
 558                     {
 559                         $number_of_facets++;
 560                         if (   ( $number_of_facets < 6 )
 561                             || ( $expanded_facet eq $link_value )
 562                             || ( $facets_info->{$link_value}->{'expanded'} ) )
 563                         {
 564
 565                       # Sanitize the link value ), ( will cause errors with CCL,
 566                             my $facet_link_value = $one_facet;
 567                             $facet_link_value =~ s/(\(|\))/ /g;
 568
 569                             # fix the length that will display in the label,
 570                             my $facet_label_value = $one_facet;
 571                             $facet_label_value =
 572                               substr( $one_facet, 0, 20 ) . "..."
 573                               unless length($facet_label_value) <= 20;
 574
 575                             # if it's a branch, label by the name, not the code,
 576                             if ( $link_value =~ /branch/ ) {
 577                                 $facet_label_value =
 578                                   $branches->{$one_facet}->{'branchname'};
 579                             }
 580
 581                 # but we're down with the whole label being in the link's title.
 582                             my $facet_title_value = $one_facet;
 583
 584                             push @this_facets_array,
 585                               (
 586                                 {
 587                                     facet_count =>
 588                                       $facets_counter->{$link_value}
 589                                       ->{$one_facet},
 590                                     facet_label_value => $facet_label_value,
 591                                     facet_title_value => $facet_title_value,
 592                                     facet_link_value  => $facet_link_value,
 593                                     type_link_value   => $link_value,
 594                                 },
 595                               );
 596                         }
 597                     }
 598
 599                     # handle expanded option
 600                     unless ( $facets_info->{$link_value}->{'expanded'} ) {
 601                         $expandable = 1
 602                           if ( ( $number_of_facets > 6 )
 603                             && ( $expanded_facet ne $link_value ) );
 604                     }
 605                     push @facets_loop,
 606                       (
 607                         {
 608                             type_link_value => $link_value,
 609                             type_id         => $link_value . "_id",
 610                             type_label =>
 611                               $facets_info->{$link_value}->{'label_value'},
 612                             facets     => \@this_facets_array,
 613                             expandable => $expandable,
 614                             expand     => $link_value,
 615                         }
 616                       );
 617                 }
 618             }
 619         }
 620     }
 621     return ( undef, $results_hashref, \@facets_loop );
 622 }
 623
 624 sub pazGetRecords {
 625     my (
 626         $koha_query,       $simple_query, $sort_by_ref,    $servers_ref,
 627         $results_per_page, $offset,       $expanded_facet, $branches,
 628         $query_type,       $scan
 629     ) = @_;
 630
 631     my $paz = C4::Search::PazPar2->new(C4::Context->config('pazpar2url'));
 632     $paz->init();
 633     $paz->search($simple_query);
 634     sleep 1;
 635
 636     # do results
 637     my $results_hashref = {};
 638     my $stats = XMLin($paz->stat);
 639     my $results = XMLin($paz->show($offset, $results_per_page, 'work-title:1'), forcearray => 1);
 640
 641     # for a grouped search result, the number of hits
 642     # is the number of groups returned; 'bib_hits' will have
 643     # the total number of bibs.
 644     $results_hashref->{'biblioserver'}->{'hits'} = $results->{'merged'}->[0];
 645     $results_hashref->{'biblioserver'}->{'bib_hits'} = $stats->{'hits'};
 646
 647     HIT: foreach my $hit (@{ $results->{'hit'} }) {
 648         my $recid = $hit->{recid}->[0];
 649
 650         my $work_title = $hit->{'md-work-title'}->[0];
 651         my $work_author;
 652         if (exists $hit->{'md-work-author'}) {
 653             $work_author = $hit->{'md-work-author'}->[0];
 654         }
 655         my $group_label = (defined $work_author) ? "$work_title / $work_author" : $work_title;
 656
 657         my $result_group = {};
 658         $result_group->{'group_label'} = $group_label;
 659         $result_group->{'group_merge_key'} = $recid;
 660
 661         my $count = 1;
 662         if (exists $hit->{count}) {
 663             $count = $hit->{count}->[0];
 664         }
 665         $result_group->{'group_count'} = $count;
 666
 667         for (my $i = 0; $i < $count; $i++) {
 668             # FIXME -- may need to worry about diacritics here
 669             my $rec = $paz->record($recid, $i);
 670             push @{ $result_group->{'RECORDS'} }, $rec;
 671         }
 672
 673         push @{ $results_hashref->{'biblioserver'}->{'GROUPS'} }, $result_group;
 674     }
 675
 676     # pass through facets
 677     my $termlist_xml = $paz->termlist('author,subject');
 678     my $terms = XMLin($termlist_xml, forcearray => 1);
 679     my @facets_loop = ();
 680     #die Dumper($results);
 681 #    foreach my $list (sort keys %{ $terms->{'list'} }) {
 682 #        my @facets = ();
 683 #        foreach my $facet (sort @{ $terms->{'list'}->{$list}->{'term'} } ) {
 684 #            push @facets, {
 685 #                facet_label_value => $facet->{'name'}->[0],
 686 #            };
 687 #        }
 688 #        push @facets_loop, ( {
 689 #            type_label => $list,
 690 #            facets => \@facets,
 691 #        } );
 692 #    }
 693
 694     return ( undef, $results_hashref, \@facets_loop );
 695 }
 696
 697 # STOPWORDS
 698 sub _remove_stopwords {
 699     my ( $operand, $index ) = @_;
 700     my @stopwords_removed;
 701
 702     # phrase and exact-qualified indexes shouldn't have stopwords removed
 703     if ( $index !~ m/phr|ext/ ) {
 704
 705 # remove stopwords from operand : parse all stopwords & remove them (case insensitive)
 706 #       we use IsAlpha unicode definition, to deal correctly with diacritics.
 707 #       otherwise, a French word like "leçon" woudl be split into "le" "çon", "le"
 708 #       is a stopword, we'd get "çon" and wouldn't find anything...
 709         foreach ( keys %{ C4::Context->stopwords } ) {
 710             next if ( $_ =~ /(and|or|not)/ );    # don't remove operators
 711             if ( $operand =~
 712                 /(\P{IsAlpha}$_\P{IsAlpha}|^$_\P{IsAlpha}|\P{IsAlpha}$_$)/ )
 713             {
 714                 $operand =~ s/\P{IsAlpha}$_\P{IsAlpha}/ /gi;
 715                 $operand =~ s/^$_\P{IsAlpha}/ /gi;
 716                 $operand =~ s/\P{IsAlpha}$_$/ /gi;
 717                 push @stopwords_removed, $_;
 718             }
 719         }
 720     }
 721     return ( $operand, \@stopwords_removed );
 722 }
 723
 724 # TRUNCATION
 725 sub _detect_truncation {
 726     my ( $operand, $index ) = @_;
 727     my ( @nontruncated, @righttruncated, @lefttruncated, @rightlefttruncated,
 728         @regexpr );
 729     $operand =~ s/^ //g;
 730     my @wordlist = split( /\s/, $operand );
 731     foreach my $word (@wordlist) {
 732         if ( $word =~ s/^\*([^\*]+)\*$/$1/ ) {
 733             push @rightlefttruncated, $word;
 734         }
 735         elsif ( $word =~ s/^\*([^\*]+)$/$1/ ) {
 736             push @lefttruncated, $word;
 737         }
 738         elsif ( $word =~ s/^([^\*]+)\*$/$1/ ) {
 739             push @righttruncated, $word;
 740         }
 741         elsif ( index( $word, "*" ) < 0 ) {
 742             push @nontruncated, $word;
 743         }
 744         else {
 745             push @regexpr, $word;
 746         }
 747     }
 748     return (
 749         \@nontruncated,       \@righttruncated, \@lefttruncated,
 750         \@rightlefttruncated, \@regexpr
 751     );
 752 }
 753
 754 # STEMMING
 755 sub _build_stemmed_operand {
 756     my ($operand) = @_;
 757     my $stemmed_operand;
 758
 759 # FIXME: the locale should be set based on the user's language and/or search choice
 760     my $stemmer = Lingua::Stem->new( -locale => 'EN-US' );
 761
 762 # FIXME: these should be stored in the db so the librarian can modify the behavior
 763     $stemmer->add_exceptions(
 764         {
 765             'and' => 'and',
 766             'or'  => 'or',
 767             'not' => 'not',
 768         }
 769     );
 770     my @words = split( / /, $operand );
 771     my $stems = $stemmer->stem(@words);
 772     for my $stem (@$stems) {
 773         $stemmed_operand .= "$stem";
 774         $stemmed_operand .= "?"
 775           unless ( $stem =~ /(and$|or$|not$)/ ) || ( length($stem) < 3 );
 776         $stemmed_operand .= " ";
 777     }
 778     warn "STEMMED OPERAND: $stemmed_operand" if $DEBUG;
 779     return $stemmed_operand;
 780 }
 781
 782 # FIELD WEIGHTING
 783 sub _build_weighted_query {
 784
 785 # FIELD WEIGHTING - This is largely experimental stuff. What I'm committing works
 786 # pretty well but could work much better if we had a smarter query parser
 787     my ( $operand, $stemmed_operand, $index ) = @_;
 788     my $stemming      = C4::Context->preference("QueryStemming")     || 0;
 789     my $weight_fields = C4::Context->preference("QueryWeightFields") || 0;
 790     my $fuzzy_enabled = C4::Context->preference("QueryFuzzy")        || 0;
 791
 792     my $weighted_query .= "(rk=(";    # Specifies that we're applying rank
 793
 794     # Keyword, or, no index specified
 795     if ( ( $index eq 'kw' ) || ( !$index ) ) {
 796         $weighted_query .=
 797           "Title-cover,ext,r1=\"$operand\"";    # exact title-cover
 798         $weighted_query .= " or ti,ext,r2=\"$operand\"";    # exact title
 799         $weighted_query .= " or ti,phr,r3=\"$operand\"";    # phrase title
 800           #$weighted_query .= " or any,ext,r4=$operand";               # exact any
 801           #$weighted_query .=" or kw,wrdl,r5=\"$operand\"";            # word list any
 802         $weighted_query .= " or wrdl,fuzzy,r8=\"$operand\""
 803           if $fuzzy_enabled;    # add fuzzy, word list
 804         $weighted_query .= " or wrdl,right-Truncation,r9=\"$stemmed_operand\""
 805           if ( $stemming and $stemmed_operand )
 806           ;                     # add stemming, right truncation
 807         $weighted_query .= " or wrdl,r9=\"$operand\"";
 808
 809         # embedded sorting: 0 a-z; 1 z-a
 810         # $weighted_query .= ") or (sort1,aut=1";
 811     }
 812
 813     # Barcode searches should skip this process
 814     elsif ( $index eq 'bc' ) {
 815         $weighted_query .= "bc=\"$operand\"";
 816     }
 817
 818     # Authority-number searches should skip this process
 819     elsif ( $index eq 'an' ) {
 820         $weighted_query .= "an=\"$operand\"";
 821     }
 822
 823     # If the index already has more than one qualifier, wrap the operand
 824     # in quotes and pass it back (assumption is that the user knows what they
 825     # are doing and won't appreciate us mucking up their query
 826     elsif ( $index =~ ',' ) {
 827         $weighted_query .= " $index=\"$operand\"";
 828     }
 829
 830     #TODO: build better cases based on specific search indexes
 831     else {
 832         $weighted_query .= " $index,ext,r1=\"$operand\"";    # exact index
 833           #$weighted_query .= " or (title-sort-az=0 or $index,startswithnt,st-word,r3=$operand #)";
 834         $weighted_query .= " or $index,phr,r3=\"$operand\"";    # phrase index
 835         $weighted_query .=
 836           " or $index,rt,wrdl,r3=\"$operand\"";    # word list index
 837     }
 838
 839     $weighted_query .= "))";                       # close rank specification
 840     return $weighted_query;
 841 }
 842
 843 =head2 buildQuery
 844
 845 ( $error, $query,
 846 $simple_query, $query_cgi,
 847 $query_desc, $limit,
 848 $limit_cgi, $limit_desc,
 849 $stopwords_removed, $query_type ) = getRecords ( $operators, $operands, $indexes, $limits, $sort_by, $scan);
 850
 851 Build queries and limits in CCL, CGI, Human,
 852 handle truncation, stemming, field weighting, stopwords, fuzziness, etc.
 853
 854 See verbose embedded documentation.
 855
 856
 857 =cut
 858
 859 sub buildQuery {
 860     my ( $operators, $operands, $indexes, $limits, $sort_by, $scan ) = @_;
 861
 862     warn "---------\nEnter buildQuery\n---------" if $DEBUG;
 863
 864     # dereference
 865     my @operators = @$operators if $operators;
 866     my @indexes   = @$indexes   if $indexes;
 867     my @operands  = @$operands  if $operands;
 868     my @limits    = @$limits    if $limits;
 869     my @sort_by   = @$sort_by   if $sort_by;
 870
 871     my $stemming         = C4::Context->preference("QueryStemming")        || 0;
 872     my $auto_truncation  = C4::Context->preference("QueryAutoTruncate")    || 0;
 873     my $weight_fields    = C4::Context->preference("QueryWeightFields")    || 0;
 874     my $fuzzy_enabled    = C4::Context->preference("QueryFuzzy")           || 0;
 875     my $remove_stopwords = C4::Context->preference("QueryRemoveStopwords") || 0;
 876
 877     # no stemming/weight/fuzzy in NoZebra
 878     if ( C4::Context->preference("NoZebra") ) {
 879         $stemming      = 0;
 880         $weight_fields = 0;
 881         $fuzzy_enabled = 0;
 882     }
 883
 884     my $query        = $operands[0];
 885     my $simple_query = $operands[0];
 886
 887     # initialize the variables we're passing back
 888     my $query_cgi;
 889     my $query_desc;
 890     my $query_type;
 891
 892     my $limit;
 893     my $limit_cgi;
 894     my $limit_desc;
 895
 896     my $stopwords_removed;    # flag to determine if stopwords have been removed
 897
 898 # for handling ccl, cql, pqf queries in diagnostic mode, skip the rest of the steps
 899 # DIAGNOSTIC ONLY!!
 900     if ( $query =~ /^ccl=/ ) {
 901         return ( undef, $', $', $', $', '', '', '', '', 'ccl' );
 902     }
 903     if ( $query =~ /^cql=/ ) {
 904         return ( undef, $', $', $', $', '', '', '', '', 'cql' );
 905     }
 906     if ( $query =~ /^pqf=/ ) {
 907         return ( undef, $', $', $', $', '', '', '', '', 'pqf' );
 908     }
 909
 910     # pass nested queries directly
 911     # FIXME: need better handling of some of these variables in this case
 912     if ( $query =~ /(\(|\))/ ) {
 913         return (
 914             undef,              $query, $simple_query, $query_cgi,
 915             $query,             $limit, $limit_cgi,    $limit_desc,
 916             $stopwords_removed, 'ccl'
 917         );
 918     }
 919
 920 # Form-based queries are non-nested and fixed depth, so we can easily modify the incoming
 921 # query operands and indexes and add stemming, truncation, field weighting, etc.
 922 # Once we do so, we'll end up with a value in $query, just like if we had an
 923 # incoming $query from the user
 924     else {
 925         $query = ""
 926           ; # clear it out so we can populate properly with field-weighted, stemmed, etc. query
 927         my $previous_operand
 928           ;    # a flag used to keep track if there was a previous query
 929                # if there was, we can apply the current operator
 930                # for every operand
 931         for ( my $i = 0 ; $i <= @operands ; $i++ ) {
 932
 933             # COMBINE OPERANDS, INDEXES AND OPERATORS
 934             if ( $operands[$i] ) {
 935
 936               # A flag to determine whether or not to add the index to the query
 937                 my $indexes_set;
 938
 939 # If the user is sophisticated enough to specify an index, turn off field weighting, stemming, and stopword handling
 940                 if ( $operands[$i] =~ /(:|=)/ || $scan ) {
 941                     $weight_fields    = 0;
 942                     $stemming         = 0;
 943                     $remove_stopwords = 0;
 944                 }
 945                 my $operand = $operands[$i];
 946                 my $index   = $indexes[$i];
 947
 948                 # Add index-specific attributes
 949                 # Date of Publication
 950                 if ( $index eq 'yr' ) {
 951                     $index .= ",st-numeric";
 952                     $indexes_set++;
 953                     (
 954                         $stemming,      $auto_truncation,
 955                         $weight_fields, $fuzzy_enabled,
 956                         $remove_stopwords
 957                     ) = ( 0, 0, 0, 0, 0 );
 958                 }
 959
 960                 # Date of Acquisition
 961                 elsif ( $index eq 'acqdate' ) {
 962                     $index .= ",st-date-normalized";
 963                     $indexes_set++;
 964                     (
 965                         $stemming,      $auto_truncation,
 966                         $weight_fields, $fuzzy_enabled,
 967                         $remove_stopwords
 968                     ) = ( 0, 0, 0, 0, 0 );
 969                 }
 970
 971                 # Set default structure attribute (word list)
 972                 my $struct_attr;
 973                 unless ( !$index || $index =~ /(st-|phr|ext|wrdl)/ ) {
 974                     $struct_attr = ",wrdl";
 975                 }
 976
 977                 # Some helpful index variants
 978                 my $index_plus       = $index . $struct_attr . ":" if $index;
 979                 my $index_plus_comma = $index . $struct_attr . "," if $index;
 980
 981                 # Remove Stopwords
 982                 if ($remove_stopwords) {
 983                     ( $operand, $stopwords_removed ) =
 984                       _remove_stopwords( $operand, $index );
 985                     warn "OPERAND w/out STOPWORDS: >$operand<" if $DEBUG;
 986                     warn "REMOVED STOPWORDS: @$stopwords_removed"
 987                       if ( $stopwords_removed && $DEBUG );
 988                 }
 989
 990                 # Detect Truncation
 991                 my ( $nontruncated, $righttruncated, $lefttruncated,
 992                     $rightlefttruncated, $regexpr );
 993                 my $truncated_operand;
 994                 (
 995                     $nontruncated, $righttruncated, $lefttruncated,
 996                     $rightlefttruncated, $regexpr
 997                 ) = _detect_truncation( $operand, $index );
 998                 warn
 999 "TRUNCATION: NON:>@$nontruncated< RIGHT:>@$righttruncated< LEFT:>@$lefttruncated< RIGHTLEFT:>@$rightlefttruncated< REGEX:>@$regexpr<"
1000                   if $DEBUG;
1001
1002                 # Apply Truncation
1003                 if (
1004                     scalar(@$righttruncated) + scalar(@$lefttruncated) +
1005                     scalar(@$rightlefttruncated) > 0 )
1006                 {
1007
1008                # Don't field weight or add the index to the query, we do it here
1009                     $indexes_set = 1;
1010                     undef $weight_fields;
1011                     my $previous_truncation_operand;
1012                     if ( scalar(@$nontruncated) > 0 ) {
1013                         $truncated_operand .= "$index_plus @$nontruncated ";
1014                         $previous_truncation_operand = 1;
1015                     }
1016                     if ( scalar(@$righttruncated) > 0 ) {
1017                         $truncated_operand .= "and "
1018                           if $previous_truncation_operand;
1019                         $truncated_operand .=
1020                           "$index_plus_comma" . "rtrn:@$righttruncated ";
1021                         $previous_truncation_operand = 1;
1022                     }
1023                     if ( scalar(@$lefttruncated) > 0 ) {
1024                         $truncated_operand .= "and "
1025                           if $previous_truncation_operand;
1026                         $truncated_operand .=
1027                           "$index_plus_comma" . "ltrn:@$lefttruncated ";
1028                         $previous_truncation_operand = 1;
1029                     }
1030                     if ( scalar(@$rightlefttruncated) > 0 ) {
1031                         $truncated_operand .= "and "
1032                           if $previous_truncation_operand;
1033                         $truncated_operand .=
1034                           "$index_plus_comma" . "rltrn:@$rightlefttruncated ";
1035                         $previous_truncation_operand = 1;
1036                     }
1037                 }
1038                 $operand = $truncated_operand if $truncated_operand;
1039                 warn "TRUNCATED OPERAND: >$truncated_operand<" if $DEBUG;
1040
1041                 # Handle Stemming
1042                 my $stemmed_operand;
1043                 $stemmed_operand = _build_stemmed_operand($operand)
1044                   if $stemming;
1045                 warn "STEMMED OPERAND: >$stemmed_operand<" if $DEBUG;
1046
1047                 # Handle Field Weighting
1048                 my $weighted_operand;
1049                 $weighted_operand =
1050                   _build_weighted_query( $operand, $stemmed_operand, $index )
1051                   if $weight_fields;
1052                 warn "FIELD WEIGHTED OPERAND: >$weighted_operand<" if $DEBUG;
1053                 $operand = $weighted_operand if $weight_fields;
1054                 $indexes_set = 1 if $weight_fields;
1055
1056                 # If there's a previous operand, we need to add an operator
1057                 if ($previous_operand) {
1058
1059                     # User-specified operator
1060                     if ( $operators[ $i - 1 ] ) {
1061                         $query     .= " $operators[$i-1] ";
1062                         $query     .= " $index_plus " unless $indexes_set;
1063                         $query     .= " $operand";
1064                         $query_cgi .= "&op=$operators[$i-1]";
1065                         $query_cgi .= "&idx=$index" if $index;
1066                         $query_cgi .= "&q=$operands[$i]" if $operands[$i];
1067                         $query_desc .=
1068                           " $operators[$i-1] $index_plus $operands[$i]";
1069                     }
1070
1071                     # Default operator is and
1072                     else {
1073                         $query      .= " and ";
1074                         $query      .= "$index_plus " unless $indexes_set;
1075                         $query      .= "$operand";
1076                         $query_cgi  .= "&op=and&idx=$index" if $index;
1077                         $query_cgi  .= "&q=$operands[$i]" if $operands[$i];
1078                         $query_desc .= " and $index_plus $operands[$i]";
1079                     }
1080                 }
1081
1082                 # There isn't a pervious operand, don't need an operator
1083                 else {
1084
1085                     # Field-weighted queries already have indexes set
1086                     $query .= " $index_plus " unless $indexes_set;
1087                     $query .= $operand;
1088                     $query_desc .= " $index_plus $operands[$i]";
1089                     $query_cgi  .= "&idx=$index" if $index;
1090                     $query_cgi  .= "&q=$operands[$i]" if $operands[$i];
1091                     $previous_operand = 1;
1092                 }
1093             }    #/if $operands
1094         }    # /for
1095     }
1096     warn "QUERY BEFORE LIMITS: >$query<" if $DEBUG;
1097
1098     # add limits
1099     my $group_OR_limits;
1100     my $availability_limit;
1101     foreach my $this_limit (@limits) {
1102         if ( $this_limit =~ /available/ ) {
1103
1104 # 'available' is defined as (items.onloan is NULL) and (items.itemlost = 0)
1105 # In English:
1106 # all records not indexed in the onloan register (zebra) and all records with a value of lost equal to 0
1107             $availability_limit .=
1108 "( ( allrecords,AlwaysMatches='' not onloan,AlwaysMatches='') and (lost,st-numeric=0) )"; #or ( allrecords,AlwaysMatches='' not lost,AlwaysMatches='')) )";
1109             $limit_cgi  .= "&limit=available";
1110             $limit_desc .= "";
1111         }
1112
1113         # group_OR_limits, prefixed by mc-
1114         # OR every member of the group
1115         elsif ( $this_limit =~ /mc/ ) {
1116             $group_OR_limits .= " or " if $group_OR_limits;
1117             $limit_desc      .= " or " if $group_OR_limits;
1118             $group_OR_limits .= "$this_limit";
1119             $limit_cgi       .= "&limit=$this_limit";
1120             $limit_desc      .= " $this_limit";
1121         }
1122
1123         # Regular old limits
1124         else {
1125             $limit .= " and " if $limit || $query;
1126             $limit      .= "$this_limit";
1127             $limit_cgi  .= "&limit=$this_limit";
1128             $limit_desc .= " $this_limit";
1129         }
1130     }
1131     if ($group_OR_limits) {
1132         $limit .= " and " if ( $query || $limit );
1133         $limit .= "($group_OR_limits)";
1134     }
1135     if ($availability_limit) {
1136         $limit .= " and " if ( $query || $limit );
1137         $limit .= "($availability_limit)";
1138     }
1139
1140     # Normalize the query and limit strings
1141     $query =~ s/:/=/g;
1142     $limit =~ s/:/=/g;
1143     for ( $query, $query_desc, $limit, $limit_desc ) {
1144         $_ =~ s/  / /g;    # remove extra spaces
1145         $_ =~ s/^ //g;     # remove any beginning spaces
1146         $_ =~ s/ $//g;     # remove any ending spaces
1147         $_ =~ s/==/=/g;    # remove double == from query
1148     }
1149     $query_cgi =~ s/^&//; # remove unnecessary & from beginning of the query cgi
1150
1151     for ($query_cgi,$simple_query) {
1152         $_ =~ s/"//g;
1153     }
1154     # append the limit to the query
1155     $query .= " " . $limit;
1156
1157     # Warnings if DEBUG
1158     if ($DEBUG) {
1159         warn "QUERY:" . $query;
1160         warn "QUERY CGI:" . $query_cgi;
1161         warn "QUERY DESC:" . $query_desc;
1162         warn "LIMIT:" . $limit;
1163         warn "LIMIT CGI:" . $limit_cgi;
1164         warn "LIMIT DESC:" . $limit_desc;
1165         warn "---------\nLeave buildQuery\n---------";
1166     }
1167     return (
1168         undef,              $query, $simple_query, $query_cgi,
1169         $query_desc,        $limit, $limit_cgi,    $limit_desc,
1170         $stopwords_removed, $query_type
1171     );
1172 }
1173
1174 =head2 searchResults
1175
1176 Format results in a form suitable for passing to the template
1177
1178 =cut
1179
1180 # IMO this subroutine is pretty messy still -- it's responsible for
1181 # building the HTML output for the template
1182 sub searchResults {
1183     my ( $searchdesc, $hits, $results_per_page, $offset, @marcresults ) = @_;
1184     my $dbh = C4::Context->dbh;
1185     my $even = 1;
1186     my @newresults;
1187
1188     # add search-term highlighting via <span>s on the search terms
1189     my $span_terms_hashref;
1190     for my $span_term ( split( / /, $searchdesc ) ) {
1191         $span_term =~ s/(.*=|\)|\(|\+|\.|\*)//g;
1192         $span_terms_hashref->{$span_term}++;
1193     }
1194
1195     #Build branchnames hash
1196     #find branchname
1197     #get branch information.....
1198     my %branches;
1199     my $bsth =
1200       $dbh->prepare("SELECT branchcode,branchname FROM branches")
1201       ;    # FIXME : use C4::Koha::GetBranches
1202     $bsth->execute();
1203     while ( my $bdata = $bsth->fetchrow_hashref ) {
1204         $branches{ $bdata->{'branchcode'} } = $bdata->{'branchname'};
1205     }
1206     my %locations;
1207     my $lsch =
1208       $dbh->prepare(
1209 "SELECT authorised_value,lib FROM authorised_values WHERE category = 'LOC'"
1210       );
1211     $lsch->execute();
1212     while ( my $ldata = $lsch->fetchrow_hashref ) {
1213         $locations{ $ldata->{'authorised_value'} } = $ldata->{'lib'};
1214     }
1215
1216     #Build itemtype hash
1217     #find itemtype & itemtype image
1218     my %itemtypes;
1219     $bsth =
1220       $dbh->prepare(
1221         "SELECT itemtype,description,imageurl,summary,notforloan FROM itemtypes"
1222       );
1223     $bsth->execute();
1224     while ( my $bdata = $bsth->fetchrow_hashref ) {
1225         $itemtypes{ $bdata->{'itemtype'} }->{description} =
1226           $bdata->{'description'};
1227         $itemtypes{ $bdata->{'itemtype'} }->{imageurl} = $bdata->{'imageurl'};
1228         $itemtypes{ $bdata->{'itemtype'} }->{summary}  = $bdata->{'summary'};
1229         $itemtypes{ $bdata->{'itemtype'} }->{notforloan} =
1230           $bdata->{'notforloan'};
1231     }
1232
1233     #search item field code
1234     my $sth =
1235       $dbh->prepare(
1236 "SELECT tagfield FROM marc_subfield_structure WHERE kohafield LIKE 'items.itemnumber'"
1237       );
1238     $sth->execute;
1239     my ($itemtag) = $sth->fetchrow;
1240
1241     # get notforloan authorised value list
1242     $sth =
1243       $dbh->prepare(
1244 "SELECT authorised_value FROM `marc_subfield_structure` WHERE kohafield = 'items.notforloan' AND frameworkcode=''"
1245       );
1246     $sth->execute;
1247     my ($notforloan_authorised_value) = $sth->fetchrow;
1248
1249     ## find column names of items related to MARC
1250     my $sth2 = $dbh->prepare("SHOW COLUMNS FROM items");
1251     $sth2->execute;
1252     my %subfieldstosearch;
1253     while ( ( my $column ) = $sth2->fetchrow ) {
1254         my ( $tagfield, $tagsubfield ) =
1255           &GetMarcFromKohaField( "items." . $column, "" );
1256         $subfieldstosearch{$column} = $tagsubfield;
1257     }
1258
1259     # handle which records to actually retrieve
1260     my $times;
1261     if ( $hits && $offset + $results_per_page <= $hits ) {
1262         $times = $offset + $results_per_page;
1263     }
1264     else {
1265         $times = $hits;
1266     }
1267
1268     # loop through all of the records we've retrieved
1269     for ( my $i = $offset ; $i <= $times - 1 ; $i++ ) {
1270         my $marcrecord;
1271         $marcrecord = MARC::File::USMARC::decode( $marcresults[$i] );
1272         my $oldbiblio = TransformMarcToKoha( $dbh, $marcrecord, '' );
1273         $oldbiblio->{result_number} = $i + 1;
1274
1275         # add imageurl to itemtype if there is one
1276         if ( $itemtypes{ $oldbiblio->{itemtype} }->{imageurl} =~ /^http:/ ) {
1277             $oldbiblio->{imageurl} =
1278               $itemtypes{ $oldbiblio->{itemtype} }->{imageurl};
1279             $oldbiblio->{description} =
1280               $itemtypes{ $oldbiblio->{itemtype} }->{description};
1281         }
1282         else {
1283             $oldbiblio->{imageurl} =
1284               getitemtypeimagesrc() . "/"
1285               . $itemtypes{ $oldbiblio->{itemtype} }->{imageurl}
1286               if ( $itemtypes{ $oldbiblio->{itemtype} }->{imageurl} );
1287             $oldbiblio->{description} =
1288               $itemtypes{ $oldbiblio->{itemtype} }->{description};
1289         }
1290
1291  # Build summary if there is one (the summary is defined in the itemtypes table)
1292  # FIXME: is this used anywhere, I think it can be commented out? -- JF
1293         if ( $itemtypes{ $oldbiblio->{itemtype} }->{summary} ) {
1294             my $summary = $itemtypes{ $oldbiblio->{itemtype} }->{summary};
1295             my @fields  = $marcrecord->fields();
1296             foreach my $field (@fields) {
1297                 my $tag      = $field->tag();
1298                 my $tagvalue = $field->as_string();
1299                 $summary =~
1300                   s/\[(.?.?.?.?)$tag\*(.*?)]/$1$tagvalue$2\[$1$tag$2]/g;
1301                 unless ( $tag < 10 ) {
1302                     my @subf = $field->subfields;
1303                     for my $i ( 0 .. $#subf ) {
1304                         my $subfieldcode  = $subf[$i][0];
1305                         my $subfieldvalue = $subf[$i][1];
1306                         my $tagsubf       = $tag . $subfieldcode;
1307                         $summary =~
1308 s/\[(.?.?.?.?)$tagsubf(.*?)]/$1$subfieldvalue$2\[$1$tagsubf$2]/g;
1309                     }
1310                 }
1311             }
1312             # FIXME: yuk
1313             $summary =~ s/\[(.*?)]//g;
1314             $summary =~ s/\n/<br\/>/g;
1315             $oldbiblio->{summary} = $summary;
1316         }
1317
1318 # Add search-term highlighting to the whole record where they match using <span>s
1319         if (C4::Context->preference("OpacHighlightedWords")){
1320             my $searchhighlightblob;
1321             for my $highlight_field ( $marcrecord->fields ) {
1322
1323     # FIXME: need to skip title, subtitle, author, etc., as they are handled below
1324                 next if $highlight_field->tag() =~ /(^00)/;    # skip fixed fields
1325                 for my $subfield ($highlight_field->subfields()) {
1326                     my $match;
1327                     next if $subfield->[0] eq '9';
1328                     my $field = $subfield->[1];
1329                     for my $term ( keys %$span_terms_hashref ) {
1330                         if ( ( $field =~ /$term/i ) && (( length($term) > 3 ) || ($field =~ / $term /i)) ) {
1331                             $field =~ s/$term/<span class=\"term\">$&<\/span>/gi;
1332                         $match++;
1333                         }
1334                     }
1335                     $searchhighlightblob .= $field . " ... " if $match;
1336                 }
1337
1338             }
1339             $searchhighlightblob = ' ... '.$searchhighlightblob if $searchhighlightblob;
1340             $oldbiblio->{'searchhighlightblob'} = $searchhighlightblob;
1341         }
1342 # save an author with no <span> tag, for the <a href=search.pl?q=<!--tmpl_var name="author"-->> link
1343         $oldbiblio->{'author_nospan'} = $oldbiblio->{'author'};
1344
1345         # Add search-term highlighting to the title, subtitle, etc. fields
1346         for my $term ( keys %$span_terms_hashref ) {
1347             my $old_term = $term;
1348             if ( length($term) > 3 ) {
1349                 $term =~ s/(.*=|\)|\(|\+|\.|\?|\[|\]|\\|\*)//g;
1350                 $oldbiblio->{'title'} =~
1351                   s/$term/<span class=\"term\">$&<\/span>/gi;
1352                 $oldbiblio->{'subtitle'} =~
1353                   s/$term/<span class=\"term\">$&<\/span>/gi;
1354                 $oldbiblio->{'author'} =~
1355                   s/$term/<span class=\"term\">$&<\/span>/gi;
1356                 $oldbiblio->{'publishercode'} =~
1357                   s/$term/<span class=\"term\">$&<\/span>/gi;
1358                 $oldbiblio->{'place'} =~
1359                   s/$term/<span class=\"term\">$&<\/span>/gi;
1360                 $oldbiblio->{'pages'} =~
1361                   s/$term/<span class=\"term\">$&<\/span>/gi;
1362                 $oldbiblio->{'notes'} =~
1363                   s/$term/<span class=\"term\">$&<\/span>/gi;
1364                 $oldbiblio->{'size'} =~
1365                   s/$term/<span class=\"term\">$&<\/span>/gi;
1366             }
1367         }
1368
1369         ($i % 2) and $oldbiblio->{'toggle'} = 1;
1370
1371         # Pull out the items fields
1372         my @fields = $marcrecord->field($itemtag);
1373
1374         # Setting item statuses for display
1375         my @available_items_loop;
1376         my @onloan_items_loop;
1377         my @other_items_loop;
1378
1379         my $available_items;
1380         my $onloan_items;
1381         my $other_items;
1382
1383         my $ordered_count     = 0;
1384         my $available_count   = 0;
1385         my $onloan_count      = 0;
1386         my $longoverdue_count = 0;
1387         my $other_count       = 0;
1388         my $wthdrawn_count    = 0;
1389         my $itemlost_count    = 0;
1390         my $itembinding_count = 0;
1391         my $itemdamaged_count = 0;
1392         my $can_place_holds   = 0;
1393         my $items_count       = scalar(@fields);
1394         my $items_counter;
1395         my $maxitems =
1396           ( C4::Context->preference('maxItemsinSearchResults') )
1397           ? C4::Context->preference('maxItemsinSearchResults') - 1
1398           : 1;
1399
1400         # loop through every item
1401         foreach my $field (@fields) {
1402             my $item;
1403             $items_counter++;
1404
1405             # populate the items hash
1406             foreach my $code ( keys %subfieldstosearch ) {
1407                 $item->{$code} = $field->subfield( $subfieldstosearch{$code} );
1408             }
1409                         my $hbranch     = C4::Context->preference('HomeOrHoldingBranch') eq 'homebranch' ? 'homebranch'    : 'holdingbranch';
1410                         my $otherbranch = C4::Context->preference('HomeOrHoldingBranch') eq 'homebranch' ? 'holdingbranch' : 'homebranch';
1411             # set item's branch name, use HomeOrHoldingBranch syspref first, fall back to the other one
1412             if ($item->{$hbranch}) {
1413                 $item->{'branchname'} = $branches{$item->{$hbranch}};
1414             }
1415             elsif ($item->{$otherbranch}) {     # Last resort
1416                 $item->{'branchname'} = $branches{$item->{$otherbranch}};
1417             }
1418
1419                         my $prefix = $item->{$hbranch} . '--' . $item->{location} . $item->{itype} . $item->{itemcallnumber};
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                                 my $key = $prefix . $item->{due_date};
1424                                 $onloan_items->{$key}->{due_date} = format_date($item->{onloan});
1425                                 $onloan_items->{$key}->{count}++ if $item->{homebranch};
1426                                 $onloan_items->{$key}->{branchname} = $item->{branchname};
1427                                 $onloan_items->{$key}->{location} = $locations{ $item->{location} };
1428                                 $onloan_items->{$key}->{itemcallnumber} = $item->{itemcallnumber};
1429                                 $onloan_items->{$key}->{imageurl} = getitemtypeimagesrc() . "/" . $itemtypes{ $item->{itype} }->{imageurl};
1430                 # if something's checked out and lost, mark it as 'long overdue'
1431                 if ( $item->{itemlost} ) {
1432                     $onloan_items->{$prefix}->{longoverdue}++;
1433                     $longoverdue_count++;
1434                 } else {        # can place holds as long as item isn't lost
1435                     $can_place_holds = 1;
1436                 }
1437             }
1438
1439          # items not on loan, but still unavailable ( lost, withdrawn, damaged )
1440             else {
1441
1442                 # item is on order
1443                 if ( $item->{notforloan} == -1 ) {
1444                     $ordered_count++;
1445                 }
1446
1447                 # item is withdrawn, lost or damaged
1448                 if (   $item->{wthdrawn}
1449                     || $item->{itemlost}
1450                     || $item->{damaged}
1451                     || $item->{notforloan} )
1452                 {
1453                     $wthdrawn_count++    if $item->{wthdrawn};
1454                     $itemlost_count++    if $item->{itemlost};
1455                     $itemdamaged_count++ if $item->{damaged};
1456                     $item->{status} = $item->{wthdrawn} . "-" . $item->{itemlost} . "-" . $item->{damaged} . "-" . $item->{notforloan};
1457                     $other_count++;
1458
1459                                         my $key = $prefix . $item->{status};
1460                                         foreach (qw(wthdrawn itemlost damaged branchname itemcallnumber)) {
1461                         $other_items->{$key}->{$_} = $item->{$_};
1462                                         }
1463                                         $other_items->{$key}->{notforloan} = GetAuthorisedValueDesc('','',$item->{notforloan},'','',$notforloan_authorised_value) if $notforloan_authorised_value;
1464                                         $other_items->{$key}->{count}++ if $item->{homebranch};
1465                                         $other_items->{$key}->{location} = $locations{ $item->{location} };
1466                                         $other_items->{$key}->{imageurl} = getitemtypeimagesrc() . "/" . $itemtypes{ $item->{itype} }->{imageurl};
1467                 }
1468                 # item is available
1469                 else {
1470                     $can_place_holds = 1;
1471                     $available_count++;
1472                                         $available_items->{$prefix}->{count}++ if $item->{homebranch};
1473                                         foreach (qw(branchname itemcallnumber)) {
1474                         $available_items->{$prefix}->{$_} = $item->{$_};
1475                                         }
1476                                         $available_items->{$prefix}->{location} = $locations{ $item->{location} };
1477                                         $available_items->{$prefix}->{imageurl} = getitemtypeimagesrc() . "/" . $itemtypes{ $item->{itype} }->{imageurl};
1478                 }
1479             }
1480         }    # notforloan, item level and biblioitem level
1481         my ( $availableitemscount, $onloanitemscount, $otheritemscount );
1482         $maxitems =
1483           ( C4::Context->preference('maxItemsinSearchResults') )
1484           ? C4::Context->preference('maxItemsinSearchResults') - 1
1485           : 1;
1486         for my $key ( sort keys %$onloan_items ) {
1487             (++$onloanitemscount > $maxitems) and last;
1488             push @onloan_items_loop, $onloan_items->{$key};
1489         }
1490         for my $key ( sort keys %$other_items ) {
1491             (++$otheritemscount > $maxitems) and last;
1492             push @other_items_loop, $other_items->{$key};
1493         }
1494         for my $key ( sort keys %$available_items ) {
1495             (++$availableitemscount > $maxitems) and last;
1496             push @available_items_loop, $available_items->{$key}
1497         }
1498
1499         # XSLT processing of some stuff
1500         if (C4::Context->preference("XSLTResultsDisplay") ) {
1501             my $newxmlrecord = XSLTParse4Display($oldbiblio->{biblionumber},'Results');
1502             $oldbiblio->{XSLTResultsRecord} = $newxmlrecord;
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         #remove trailing blank at the beginning
1668         $string =~ s/^ //g;
1669         warn "leaf:$string" if $DEBUG;
1670
1671         # parse the string in in operator/operand/value again
1672         $string =~ /(.*)(>=|<=)(.*)/;
1673         my $left     = $1;
1674         my $operator = $2;
1675         my $right    = $3;
1676 #         warn "handling leaf... left:$left operator:$operator right:$right"
1677 #           if $DEBUG;
1678         unless ($operator) {
1679             $string =~ /(.*)(>|<|=)(.*)/;
1680             $left     = $1;
1681             $operator = $2;
1682             $right    = $3;
1683             warn
1684 "handling unless (operator)... left:$left operator:$operator right:$right"
1685               if $DEBUG;
1686         }
1687         my $results;
1688
1689 # strip adv, zebra keywords, currently not handled in nozebra: wrdl, ext, phr...
1690         $left =~ s/ .*$//;
1691
1692         # automatic replace for short operators
1693         $left = 'title'            if $left =~ '^ti$';
1694         $left = 'author'           if $left =~ '^au$';
1695         $left = 'publisher'        if $left =~ '^pb$';
1696         $left = 'subject'          if $left =~ '^su$';
1697         $left = 'koha-Auth-Number' if $left =~ '^an$';
1698         $left = 'keyword'          if $left =~ '^kw$';
1699         warn "handling leaf... left:$left operator:$operator right:$right" if $DEBUG;
1700         if ( $operator && $left ne 'keyword' ) {
1701
1702             #do a specific search
1703             my $dbh = C4::Context->dbh;
1704             $operator = 'LIKE' if $operator eq '=' and $right =~ /%/;
1705             my $sth =
1706               $dbh->prepare(
1707 "SELECT biblionumbers,value FROM nozebra WHERE server=? AND indexname=? AND value $operator ?"
1708               );
1709             warn "$left / $operator / $right\n" if $DEBUG;
1710
1711             # split each word, query the DB and build the biblionumbers result
1712             #sanitizing leftpart
1713             $left =~ s/^\s+|\s+$//;
1714             foreach ( split / /, $right ) {
1715                 my $biblionumbers;
1716                 $_ =~ s/^\s+|\s+$//;
1717                 next unless $_;
1718                 warn "EXECUTE : $server, $left, $_" if $DEBUG;
1719                 $sth->execute( $server, $left, $_ )
1720                   or warn "execute failed: $!";
1721                 while ( my ( $line, $value ) = $sth->fetchrow ) {
1722
1723 # if we are dealing with a numeric value, use only numeric results (in case of >=, <=, > or <)
1724 # otherwise, fill the result
1725                     $biblionumbers .= $line
1726                       unless ( $right =~ /^\d+$/ && $value =~ /\D/ );
1727                     warn "result : $value "
1728                       . ( $right  =~ /\d/ ) . "=="
1729                       . ( $value =~ /\D/?$line:"" ) if $DEBUG;         #= $line";
1730                 }
1731
1732 # do a AND with existing list if there is one, otherwise, use the biblionumbers list as 1st result list
1733                 if ($results) {
1734                     warn "NZAND" if $DEBUG;
1735                     $results = NZoperatorAND($biblionumbers,$results);
1736                 }
1737                 else {
1738                     $results = $biblionumbers;
1739                 }
1740             }
1741         }
1742         else {
1743
1744       #do a complete search (all indexes), if index='kw' do complete search too.
1745             my $dbh = C4::Context->dbh;
1746             my $sth =
1747               $dbh->prepare(
1748 "SELECT biblionumbers FROM nozebra WHERE server=? AND value LIKE ?"
1749               );
1750
1751             # split each word, query the DB and build the biblionumbers result
1752             foreach ( split / /, $string ) {
1753                 next if C4::Context->stopwords->{ uc($_) };   # skip if stopword
1754                 warn "search on all indexes on $_" if $DEBUG;
1755                 my $biblionumbers;
1756                 next unless $_;
1757                 $sth->execute( $server, $_ );
1758                 while ( my $line = $sth->fetchrow ) {
1759                     $biblionumbers .= $line;
1760                 }
1761
1762 # do a AND with existing list if there is one, otherwise, use the biblionumbers list as 1st result list
1763                 if ($results) {
1764                     $results = NZoperatorAND($biblionumbers,$results);
1765                 }
1766                 else {
1767                     warn "NEW RES for $_ = $biblionumbers" if $DEBUG;
1768                     $results = $biblionumbers;
1769                 }
1770             }
1771         }
1772         warn "return : $results for LEAF : $string" if $DEBUG;
1773         return $results;
1774     }
1775     warn "---------\nLeave NZanalyse\n---------" 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 =~ /\Q$value\E-(\d+);/ ) {
1796             $countvalue = ( $1 > $countvalue ? $countvalue : $1 );
1797             $finalresult .=
1798                 "$value-$countvalue;$value-$countvalue;";
1799         }
1800     }
1801     warn "NZAND DONE : $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