C4/Search.pm

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