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::Date;
  25
  26 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
  27
  28 # set the version for version checking
  29 $VERSION = 3.00;
  30
  31 =head1 NAME
  32
  33 C4::Search - Functions for searching the Koha catalog.
  34
  35 =head1 SYNOPSIS
  36
  37 see opac/opac-search.pl or catalogue/search.pl for example of usage
  38
  39 =head1 DESCRIPTION
  40
  41 This module provides the searching facilities for the Koha into a zebra catalog.
  42
  43 =head1 FUNCTIONS
  44
  45 =cut
  46
  47 @ISA    = qw(Exporter);
  48 @EXPORT = qw(
  49   &SimpleSearch
  50   &findseealso
  51   &FindDuplicate
  52   &searchResults
  53   &getRecords
  54   &buildQuery
  55   &NZgetRecords
  56   &ModBiblios
  57 );
  58
  59 # make all your functions, whether exported or not;
  60
  61 =head2 findseealso($dbh,$fields);
  62
  63 C<$dbh> is a link to the DB handler.
  64
  65 use C4::Context;
  66 my $dbh =C4::Context->dbh;
  67
  68 C<$fields> is a reference to the fields array
  69
  70 This function modify the @$fields array and add related fields to search on.
  71
  72 =cut
  73
  74 sub findseealso {
  75     my ( $dbh, $fields ) = @_;
  76     my $tagslib = GetMarcStructure( 1 );
  77     for ( my $i = 0 ; $i <= $#{$fields} ; $i++ ) {
  78         my ($tag)      = substr( @$fields[$i], 1, 3 );
  79         my ($subfield) = substr( @$fields[$i], 4, 1 );
  80         @$fields[$i] .= ',' . $tagslib->{$tag}->{$subfield}->{seealso}
  81           if ( $tagslib->{$tag}->{$subfield}->{seealso} );
  82     }
  83 }
  84
  85 =head2 FindDuplicate
  86
  87 ($biblionumber,$biblionumber,$title) = FindDuplicate($record);
  88
  89 =cut
  90
  91 sub FindDuplicate {
  92     my ($record) = @_;
  93     my $dbh = C4::Context->dbh;
  94     my $result = TransformMarcToKoha( $dbh, $record, '' );
  95     my $sth;
  96     my $query;
  97     my $search;
  98     my $type;
  99     my ( $biblionumber, $title );
 100
 101     # search duplicate on ISBN, easy and fast..
 102     # ... normalize first
 103     if ( $result->{isbn} ) {
 104         $result->{isbn} =~ s/\(.*$//;
 105         $result->{isbn} =~ s/\s+$//;
 106     }
 107     #$search->{'avoidquerylog'}=1;
 108     if ( $result->{isbn} ) {
 109         $query = "isbn=$result->{isbn}";
 110     }
 111     else {
 112         $result->{title} =~ s /\\//g;
 113         $result->{title} =~ s /\"//g;
 114         $result->{title} =~ s /\(//g;
 115         $result->{title} =~ s /\)//g;
 116                 # remove valid operators
 117                 $result->{title} =~ s/(and|or|not)//g;
 118         $query = "ti,ext=$result->{title}";
 119         $query .= " and mt=$result->{itemtype}" if ($result->{itemtype});
 120         if ($result->{author}){
 121           $result->{author} =~ s /\\//g;
 122           $result->{author} =~ s /\"//g;
 123           $result->{author} =~ s /\(//g;
 124           $result->{author} =~ s /\)//g;
 125                   # remove valid operators
 126                   $result->{author} =~ s/(and|or|not)//g;
 127           $query .= " and au,ext=$result->{author}";
 128         }
 129     }
 130     my ($error,$searchresults) =
 131       SimpleSearch($query); # FIXME :: hardcoded !
 132     my @results;
 133     foreach my $possible_duplicate_record (@$searchresults) {
 134         my $marcrecord =
 135           MARC::Record->new_from_usmarc($possible_duplicate_record);
 136         my $result = TransformMarcToKoha( $dbh, $marcrecord, '' );
 137
 138         # FIXME :: why 2 $biblionumber ?
 139         if ($result){
 140           push @results, $result->{'biblionumber'};
 141           push @results, $result->{'title'};
 142         }
 143     }
 144     return @results;
 145 }
 146
 147 =head2 SimpleSearch
 148
 149 ($error,$results) = SimpleSearch($query,@servers);
 150
 151 this function performs a simple search on the catalog using zoom.
 152
 153 =over 2
 154
 155 =item C<input arg:>
 156
 157     * $query could be a simple keyword or a complete CCL query wich is depending on your ccl file.
 158     * @servers is optionnal. default one is read on koha.xml
 159
 160 =item C<Output arg:>
 161     * $error is a string which containt the description error if there is one. Else it's empty.
 162     * \@results is an array of marc record.
 163
 164 =item C<usage in the script:>
 165
 166 =back
 167
 168 my ($error, $marcresults) = SimpleSearch($query);
 169
 170 if (defined $error) {
 171     $template->param(query_error => $error);
 172     warn "error: ".$error;
 173     output_html_with_http_headers $input, $cookie, $template->output;
 174     exit;
 175 }
 176
 177 my $hits = scalar @$marcresults;
 178 my @results;
 179
 180 for(my $i=0;$i<$hits;$i++) {
 181     my %resultsloop;
 182     my $marcrecord = MARC::File::USMARC::decode($marcresults->[$i]);
 183     my $biblio = TransformMarcToKoha(C4::Context->dbh,$marcrecord,'');
 184
 185     #build the hash for the template.
 186     $resultsloop{highlight}       = ($i % 2)?(1):(0);
 187     $resultsloop{title}           = $biblio->{'title'};
 188     $resultsloop{subtitle}        = $biblio->{'subtitle'};
 189     $resultsloop{biblionumber}    = $biblio->{'biblionumber'};
 190     $resultsloop{author}          = $biblio->{'author'};
 191     $resultsloop{publishercode}   = $biblio->{'publishercode'};
 192     $resultsloop{publicationyear} = $biblio->{'publicationyear'};
 193
 194     push @results, \%resultsloop;
 195 }
 196 $template->param(result=>\@results);
 197
 198 =cut
 199
 200 sub SimpleSearch {
 201     my $query   = shift;
 202     if (C4::Context->preference('NoZebra')) {
 203         my $result = NZorder(NZanalyse($query))->{'biblioserver'}->{'RECORDS'};
 204         return (undef,$result);
 205     } else {
 206         my @servers = @_;
 207         my @results;
 208         my @tmpresults;
 209         my @zconns;
 210         return ( "No query entered", undef ) unless $query;
 211
 212         #@servers = (C4::Context->config("biblioserver")) unless @servers;
 213         @servers =
 214         ("biblioserver") unless @servers
 215         ;    # FIXME hardcoded value. See catalog/search.pl & opac-search.pl too.
 216
 217         # Connect & Search
 218         for ( my $i = 0 ; $i < @servers ; $i++ ) {
 219             $zconns[$i] = C4::Context->Zconn( $servers[$i], 1 );
 220             $tmpresults[$i] =
 221             $zconns[$i]
 222             ->search( new ZOOM::Query::CCL2RPN( $query, $zconns[$i] ) );
 223
 224             # getting error message if one occured.
 225             my $error =
 226                 $zconns[$i]->errmsg() . " ("
 227             . $zconns[$i]->errcode() . ") "
 228             . $zconns[$i]->addinfo() . " "
 229             . $zconns[$i]->diagset();
 230
 231             return ( $error, undef ) if $zconns[$i]->errcode();
 232         }
 233         my $hits;
 234         my $ev;
 235         while ( ( my $i = ZOOM::event( \@zconns ) ) != 0 ) {
 236             $ev = $zconns[ $i - 1 ]->last_event();
 237             if ( $ev == ZOOM::Event::ZEND ) {
 238                 $hits = $tmpresults[ $i - 1 ]->size();
 239             }
 240             if ( $hits > 0 ) {
 241                 for ( my $j = 0 ; $j < $hits ; $j++ ) {
 242                     my $record = $tmpresults[ $i - 1 ]->record($j)->raw();
 243                     push @results, $record;
 244                 }
 245             }
 246         }
 247         return ( undef, \@results );
 248     }
 249 }
 250
 251 # performs the search
 252 sub getRecords {
 253     my (
 254         $koha_query,     $federated_query,  $sort_by_ref,
 255         $servers_ref,    $results_per_page, $offset,
 256         $expanded_facet, $branches,         $query_type,
 257         $scan
 258     ) = @_;
 259 #     warn "Query : $koha_query";
 260     my @servers = @$servers_ref;
 261     my @sort_by = @$sort_by_ref;
 262
 263     # create the zoom connection and query object
 264     my $zconn;
 265     my @zconns;
 266     my @results;
 267     my $results_hashref = ();
 268
 269     ### FACETED RESULTS
 270     my $facets_counter = ();
 271     my $facets_info    = ();
 272     my $facets         = getFacets();
 273
 274     #### INITIALIZE SOME VARS USED CREATE THE FACETED RESULTS
 275     my @facets_loop;    # stores the ref to array of hashes for template
 276     for ( my $i = 0 ; $i < @servers ; $i++ ) {
 277         $zconns[$i] = C4::Context->Zconn( $servers[$i], 1 );
 278
 279 # perform the search, create the results objects
 280 # if this is a local search, use the $koha-query, if it's a federated one, use the federated-query
 281         my $query_to_use;
 282         if ( $servers[$i] =~ /biblioserver/ ) {
 283             $query_to_use = $koha_query;
 284         }
 285         else {
 286             $query_to_use = $federated_query;
 287         }
 288
 289         # check if we've got a query_type defined
 290         eval {
 291             if ($query_type)
 292             {
 293                 if ( $query_type =~ /^ccl/ ) {
 294                     $query_to_use =~
 295                       s/\:/\=/g;    # change : to = last minute (FIXME)
 296
 297                     #                 warn "CCL : $query_to_use";
 298                     $results[$i] =
 299                       $zconns[$i]->search(
 300                         new ZOOM::Query::CCL2RPN( $query_to_use, $zconns[$i] )
 301                       );
 302                 }
 303                 elsif ( $query_type =~ /^cql/ ) {
 304
 305                     #                 warn "CQL : $query_to_use";
 306                     $results[$i] =
 307                       $zconns[$i]->search(
 308                         new ZOOM::Query::CQL( $query_to_use, $zconns[$i] ) );
 309                 }
 310                 elsif ( $query_type =~ /^pqf/ ) {
 311
 312                     #                 warn "PQF : $query_to_use";
 313                     $results[$i] =
 314                       $zconns[$i]->search(
 315                         new ZOOM::Query::PQF( $query_to_use, $zconns[$i] ) );
 316                 }
 317             }
 318             else {
 319                 if ($scan) {
 320
 321                     #                 warn "preparing to scan";
 322                     $results[$i] =
 323                       $zconns[$i]->scan(
 324                         new ZOOM::Query::CCL2RPN( $query_to_use, $zconns[$i] )
 325                       );
 326                 }
 327                 else {
 328
 329                     #             warn "LAST : $query_to_use";
 330                     $results[$i] =
 331                       $zconns[$i]->search(
 332                         new ZOOM::Query::CCL2RPN( $query_to_use, $zconns[$i] )
 333                       );
 334                 }
 335             }
 336         };
 337         if ($@) {
 338             warn "WARNING: query problem with $query_to_use " . $@;
 339         }
 340
 341         # concatenate the sort_by limits and pass them to the results object
 342         my $sort_by;
 343         foreach my $sort (@sort_by) {
 344             if ($sort eq "author_az") {
 345                 $sort_by.="1=1003 &lt;i ";
 346             }
 347             elsif ($sort eq "author_za") {
 348                 $sort_by.="1=1003 &gt;i ";
 349             }
 350
 351             #$sort_by .= $sort . " ";    # used to be $sort,
 352         }
 353                 warn "SORTING: $sort_by";
 354         $results[$i]->sort( "yaz", $sort_by ) if $sort_by;
 355     }
 356     while ( ( my $i = ZOOM::event( \@zconns ) ) != 0 ) {
 357         my $ev = $zconns[ $i - 1 ]->last_event();
 358         if ( $ev == ZOOM::Event::ZEND ) {
 359             my $size = $results[ $i - 1 ]->size();
 360             if ( $size > 0 ) {
 361                 my $results_hash;
 362                 #$results_hash->{'server'} = $servers[$i-1];
 363                 # loop through the results
 364                 $results_hash->{'hits'} = $size;
 365                 my $times;
 366                 if ( $offset + $results_per_page <= $size ) {
 367                     $times = $offset + $results_per_page;
 368                 }
 369                 else {
 370                     $times = $size;
 371                 }
 372                 for ( my $j = $offset ; $j < $times ; $j++ )
 373                 {   #(($offset+$count<=$size) ? ($offset+$count):$size) ; $j++){
 374                     my $records_hash;
 375                     my $record;
 376                     my $facet_record;
 377                     ## This is just an index scan
 378                     if ($scan) {
 379                         my ( $term, $occ ) = $results[ $i - 1 ]->term($j);
 380
 381                  # here we create a minimal MARC record and hand it off to the
 382                  # template just like a normal result ... perhaps not ideal, but
 383                  # it works for now
 384                         my $tmprecord = MARC::Record->new();
 385                         $tmprecord->encoding('UTF-8');
 386                         my $tmptitle;
 387
 388           # srote the minimal record in author/title (depending on MARC flavour)
 389                         if ( C4::Context->preference("marcflavour") eq
 390                             "UNIMARC" )
 391                         {
 392                             $tmptitle = MARC::Field->new(
 393                                 '200', ' ', ' ',
 394                                 a => $term,
 395                                 f => $occ
 396                             );
 397                         }
 398                         else {
 399                             $tmptitle = MARC::Field->new(
 400                                 '245', ' ', ' ',
 401                                 a => $term,
 402                                 b => $occ
 403                             );
 404                         }
 405                         $tmprecord->append_fields($tmptitle);
 406                         $results_hash->{'RECORDS'}[$j] =
 407                           $tmprecord->as_usmarc();
 408                     }
 409                     else {
 410                         $record = $results[ $i - 1 ]->record($j)->raw();
 411
 412                         #warn "RECORD $j:".$record;
 413                         $results_hash->{'RECORDS'}[$j] =
 414                           $record;    # making a reference to a hash
 415                                       # Fill the facets while we're looping
 416                         $facet_record = MARC::Record->new_from_usmarc($record);
 417
 418                         #warn $servers[$i-1].$facet_record->title();
 419                         for ( my $k = 0 ; $k <= @$facets ; $k++ ) {
 420                             if ( $facets->[$k] ) {
 421                                 my @fields;
 422                                 for my $tag ( @{ $facets->[$k]->{'tags'} } ) {
 423                                     push @fields, $facet_record->field($tag);
 424                                 }
 425                                 for my $field (@fields) {
 426                                     my @subfields = $field->subfields();
 427                                     for my $subfield (@subfields) {
 428                                         my ( $code, $data ) = @$subfield;
 429                                         if ( $code eq
 430                                             $facets->[$k]->{'subfield'} )
 431                                         {
 432                                             $facets_counter->{ $facets->[$k]
 433                                                   ->{'link_value'} }->{$data}++;
 434                                         }
 435                                     }
 436                                 }
 437                                 $facets_info->{ $facets->[$k]->{'link_value'} }
 438                                   ->{'label_value'} =
 439                                   $facets->[$k]->{'label_value'};
 440                                 $facets_info->{ $facets->[$k]->{'link_value'} }
 441                                   ->{'expanded'} = $facets->[$k]->{'expanded'};
 442                             }
 443                         }
 444                     }
 445                 }
 446                 $results_hashref->{ $servers[ $i - 1 ] } = $results_hash;
 447             }
 448
 449             #print "connection ", $i-1, ": $size hits";
 450             #print $results[$i-1]->record(0)->render() if $size > 0;
 451             # BUILD FACETS
 452             for my $link_value (
 453                 sort { $facets_counter->{$b} <=> $facets_counter->{$a} }
 454                 keys %$facets_counter
 455               )
 456             {
 457                 my $expandable;
 458                 my $number_of_facets;
 459                 my @this_facets_array;
 460                 for my $one_facet (
 461                     sort {
 462                         $facets_counter->{$link_value}
 463                           ->{$b} <=> $facets_counter->{$link_value}->{$a}
 464                     } keys %{ $facets_counter->{$link_value} }
 465                   )
 466                 {
 467                     $number_of_facets++;
 468                     if (   ( $number_of_facets < 6 )
 469                         || ( $expanded_facet eq $link_value )
 470                         || ( $facets_info->{$link_value}->{'expanded'} ) )
 471                     {
 472
 473                        # sanitize the link value ), ( will cause errors with CCL
 474                         my $facet_link_value = $one_facet;
 475                         $facet_link_value =~ s/(\(|\))/ /g;
 476
 477                         # fix the length that will display in the label
 478                         my $facet_label_value = $one_facet;
 479                         $facet_label_value = substr( $one_facet, 0, 20 ) . "..."
 480                           unless length($facet_label_value) <= 20;
 481
 482                        # well, if it's a branch, label by the name, not the code
 483                         if ( $link_value =~ /branch/ ) {
 484                             $facet_label_value =
 485                               $branches->{$one_facet}->{'branchname'};
 486                         }
 487
 488                  # but we're down with the whole label being in the link's title
 489                         my $facet_title_value = $one_facet;
 490
 491                         push @this_facets_array,
 492                           (
 493                             {
 494                                 facet_count =>
 495                                   $facets_counter->{$link_value}->{$one_facet},
 496                                 facet_label_value => $facet_label_value,
 497                                 facet_title_value => $facet_title_value,
 498                                 facet_link_value  => $facet_link_value,
 499                                 type_link_value   => $link_value,
 500                             },
 501                           );
 502                     }
 503                 }
 504                 unless ( $facets_info->{$link_value}->{'expanded'} ) {
 505                     $expandable = 1
 506                       if ( ( $number_of_facets > 6 )
 507                         && ( $expanded_facet ne $link_value ) );
 508                 }
 509                 push @facets_loop,
 510                   (
 511                     {
 512                         type_link_value => $link_value,
 513                         type_id         => $link_value . "_id",
 514                         type_label      =>
 515                           $facets_info->{$link_value}->{'label_value'},
 516                         facets     => \@this_facets_array,
 517                         expandable => $expandable,
 518                         expand     => $link_value,
 519                     }
 520                   );
 521             }
 522         }
 523     }
 524     return ( undef, $results_hashref, \@facets_loop );
 525 }
 526
 527 # build the query itself
 528 sub buildQuery {
 529     my ( $query, $operators, $operands, $indexes, $limits, $sort_by ) = @_;
 530
 531     my @operators = @$operators if $operators;
 532     my @indexes   = @$indexes   if $indexes;
 533     my @operands  = @$operands  if $operands;
 534     my @limits    = @$limits    if $limits;
 535     my @sort_by   = @$sort_by   if $sort_by;
 536
 537     my $human_search_desc;      # a human-readable query
 538     my $machine_search_desc;    #a machine-readable query
 539
 540 # STEP I: determine if this is a form-based / simple query or if it's complex (if complex,
 541 # we can't handle field weighting, stemming until a formal query parser is written
 542 # I'll work on this soon -- JF
 543 #if (!$query) { # form-based
 544 # check if this is a known query language query, if it is, return immediately:
 545     if ( $query =~ /^ccl=/ ) {
 546         return ( undef, $', $', $', 'ccl' );
 547     }
 548     if ( $query =~ /^cql=/ ) {
 549         return ( undef, $', $', $', 'cql' );
 550     }
 551     if ( $query =~ /^pqf=/ ) {
 552         return ( undef, $', $', $', 'pqf' );
 553     }
 554     if ( $query =~ /(\(|\))/ ) {    # sorry, too complex
 555         return ( undef, $query, $query, $query, 'ccl' );
 556     }
 557
 558 # form-based queries are limited to non-nested a specific depth, so we can easily
 559 # modify the incoming query operands and indexes to do stemming and field weighting
 560 # Once we do so, we'll end up with a value in $query, just like if we had an
 561 # incoming $query from the user
 562     else {
 563         $query = ""
 564           ; # clear it out so we can populate properly with field-weighted stemmed query
 565         my $previous_operand
 566           ;    # a flag used to keep track if there was a previous query
 567                # if there was, we can apply the current operator
 568         for ( my $i = 0 ; $i <= @operands ; $i++ ) {
 569             my $operand = $operands[$i];
 570             # remove stopwords from operand : parse all stopwords & remove them (case insensitive)
 571             # we use IsAlpha unicode definition, to deal correctly with diacritics.
 572             # otherwise, a french word like "leçon" is splitted in "le" "çon", le is an empty word, we get "çon"
 573             # and don't find anything...
 574             my $stemmed_operand;
 575             my $stemming      = C4::Context->preference("QueryStemming")     || 0;
 576             my $weight_fields = C4::Context->preference("QueryWeightFields") || 0;
 577                         my $fuzzy_enabled = C4::Context->preference("QueryFuzzy") || 0;
 578
 579             # We Have to do this more carefully.
 580             #Since Phrase Search Is Phrase search.
 581             #phrase "Physics In Collision" will not be found if we do it like that.
 582             my $index   = $indexes[$i];
 583             my (@nontruncated,@righttruncated,@lefttruncated,@rightlefttruncated,@regexpr);
 584
 585                         # if the operator contains more than one qualifier, but not phrase
 586             if (index($index,"phr")<0 && index($index,",")>0){
 587               #operand may be a wordlist deleting stopwords
 588               foreach (keys %{C4::Context->stopwords}) {
 589                   $operand=~ s/\P{IsAlpha}$_\P{IsAlpha}/ /i;
 590                   $operand=~ s/^$_\P{IsAlpha}/ /i;
 591                   $operand=~ s/\P{IsAlpha}$_$/ /i;
 592               }
 593               #now coping with words
 594               my @wordlist= split (/\s/,$operand);
 595               foreach my $word (@wordlist){
 596                 if (index($word,"*")==0 && index($word,"*",1)==length($word)-2){
 597                   $word=~s/\*//;
 598                   push @rightlefttruncated,$word;
 599                 } elsif(index($word,"*")==0 && index($word,"*",1)<0){
 600                   $word=~s/\*//;
 601                   push @lefttruncated,$word;
 602                 } elsif (index($word,"*")==length($word)-1){
 603                   $word=~s/\*//;
 604                   push @righttruncated,$word;
 605                 } elsif (index($word,"*")<0){
 606                   push @nontruncated,$word;
 607                 } else {
 608                   push @regexpr,$word;
 609                 }
 610               }
 611             }
 612
 613             if ( $operands[$i] ) {
 614                 $operand =~ s/^(and |or |not )//i;
 615
 616 # STEMMING FIXME: need to refine the field weighting so stemmed operands don't disrupt the query ranking
 617                 if ($stemming) {
 618                                 # FIXME: the locale should be set based on the user's language and/or search choice
 619                                 my $stemmer = Lingua::Stem->new( -locale => 'EN-US' );
 620                                 # FIXME: these should be stored in the db so the librarian can modify the behavior
 621                                 $stemmer->add_exceptions(
 622                                 {
 623                         'and' => 'and',
 624                         'or'  => 'or',
 625                         'not' => 'not',
 626                                 }
 627                                 );
 628
 629                     my @words = split( / /, $operands[$i] );
 630                     my $stems = $stemmer->stem(@words);
 631                     foreach my $stem (@$stems) {
 632                         $stemmed_operand .= "$stem";
 633                         $stemmed_operand .= "?"
 634                           unless ( $stem =~ /(and$|or$|not$)/ )
 635                           || ( length($stem) < 3 );
 636                         $stemmed_operand .= " ";
 637                                                 $stemmed_operand =~ s/(and|or|not)//g;
 638                         #warn "STEM: $stemmed_operand";
 639                     }
 640
 641                     #$operand = $stemmed_operand;
 642                 }
 643
 644 # FIELD WEIGHTING - This is largely experimental stuff. What I'm committing works
 645 # pretty well but will work much better when we have an actual query parser
 646                 my $weighted_query;
 647                 if ($weight_fields) {
 648                     $weighted_query .=
 649                       " rk=(";    # Specifies that we're applying rank
 650                                   # keyword has different weight properties
 651                     if ( ( $index =~ /kw/ ) || ( !$index ) )
 652                     { # FIXME: do I need to add right-truncation in the case of stemming?
 653                           # a simple way to find out if this query uses an index
 654                         if ( $operand =~ /(\=|\:)/ ) {
 655                             $weighted_query .= " $operand";
 656                         }
 657                         else {
 658                             $weighted_query .=" Title-cover,ext,r1=\"$operand\"";       # title cover as exact
 659                             $weighted_query .=" or ti,ext,r2=\"$operand\"";                     # exact title elsewhere
 660                             #$weighted_query .= " or ti,phr,r3=$operand";          # index as phrase
 661                             #$weighted_query .= " or any,ext,r4=$operand";         # index as exact
 662                             $weighted_query .=" or kw,wrdl,r5=\"$operand\"";            # all the words in the query (wordlist)
 663                             $weighted_query .= " or wrd,fuzzy,r9=$operand" if $fuzzy_enabled; # add fuzzy
 664                             $weighted_query .= " or wrd,right-Truncation=$stemmed_operand" if $stemming; # add stemming
 665                                                         # embedded sorting: 0 a-z; 1 z-a
 666                                                         #$weighted_query .= ") or (sort1,aut=1";
 667                         }
 668                     }
 669                     elsif ( $index =~ /au/ ) {
 670                         $weighted_query .=
 671                           " $index,ext,r1=$operand";    # index label as exact
 672                          #$weighted_query .= " or (title-sort-az=0 or $index,startswithnt,st-word,r3=$operand #)";
 673                         $weighted_query .=
 674                           " or $index,phr,r3=$operand";    # index as phrase
 675                         $weighted_query .= " or $index,rt,wrd,r3=$operand";
 676                     }
 677                     elsif ( $index =~ /ti/ ) {
 678                         $weighted_query .=
 679                           " Title-cover,ext,r1=$operand"; # index label as exact
 680                         $weighted_query .= " or Title-series,ext,r2=$operand";
 681
 682                         #$weighted_query .= " or ti,ext,r2=$operand";
 683                         #$weighted_query .= " or ti,phr,r3=$operand";
 684                         #$weighted_query .= " or ti,wrd,r3=$operand";
 685                         $weighted_query .=" or (title-sort-az=0 or Title-cover,startswithnt,st-word,r3=$operand #)";
 686                         $weighted_query .=" or (title-sort-az=0 or Title-cover,phr,r6=$operand)";
 687
 688                         #$weighted_query .= " or Title-cover,wrd,r5=$operand";
 689                         #$weighted_query .= " or ti,ext,r6=$operand";
 690                         #$weighted_query .= " or ti,startswith,phr,r7=$operand";
 691                         #$weighted_query .= " or ti,phr,r8=$operand";
 692                         #$weighted_query .= " or ti,wrd,r9=$operand";
 693
 694                                                 #$weighted_query .= " or ti,ext,r2=$operand";         # index as exact
 695                                                 #$weighted_query .= " or ti,phr,r3=$operand";              # index as  phrase
 696                                                 #$weighted_query .= " or any,ext,r4=$operand";         # index as exact
 697                                                 #$weighted_query .= " or kw,wrd,r5=$operand";         # index as exact
 698                     }
 699                     else {
 700                         $weighted_query .=
 701                           " $index,ext,r1=$operand";    # index label as exact
 702                          #$weighted_query .= " or $index,ext,r2=$operand";            # index as exact
 703                         $weighted_query .=
 704                           " or $index,phr,r3=$operand";    # index as phrase
 705                         $weighted_query .= " or $index,rt,wrd,r3=$operand";
 706                         $weighted_query .=
 707                           " or $index,wrd,r5=$operand"
 708                           ;    # index as word right-truncated
 709                         $weighted_query .= " or $index,wrd,fuzzy,r8=$operand";
 710                     }
 711                     $weighted_query .= ")";    # close rank specification
 712                     $operand = $weighted_query;
 713                 }
 714
 715                 # only add an operator if there is a previous operand
 716                 if ($previous_operand) {
 717                     if ( $operators[ $i - 1 ] ) {
 718                         $query .= " $operators[$i-1] $index: $operand";
 719                         if ( !$index ) {
 720                             $human_search_desc .=
 721                               "  $operators[$i-1] $operands[$i]";
 722                         }
 723                         else {
 724                             $human_search_desc .=
 725                               "  $operators[$i-1] $index: $operands[$i]";
 726                         }
 727                     }
 728
 729                     # the default operator is and
 730                     else {
 731                         $query             .= " and $index: $operand";
 732                         $human_search_desc .= "  and $index: $operands[$i]";
 733                     }
 734                 }
 735                 else {
 736                     if ( !$index ) {
 737                         $query             .= " $operand";
 738                         $human_search_desc .= "  $operands[$i]";
 739                     }
 740                     else {
 741                       if (scalar(@righttruncated)+scalar(@lefttruncated)+scalar(@rightlefttruncated)>0){
 742                          $query.= "$index: @nontruncated " if (scalar(@nontruncated)>0);
 743                          if (scalar(@righttruncated)>0){
 744                           $query .= "and $index,rtrn:@righttruncated ";
 745                          }
 746                          if (scalar(@lefttruncated)>0){
 747                           $query .= "and $index,ltrn:@lefttruncated ";
 748                          }
 749                          if (scalar(@rightlefttruncated)>0){
 750                           $query .= "and $index,rltrn:@rightlefttruncated ";
 751                          }
 752                         $query=~s/^and//;
 753                         $human_search_desc .= $query;
 754                       } else {
 755                         $query             .= " $index: $operand";
 756                         $human_search_desc .= "  $index: $operands[$i]";
 757                       }
 758                     }
 759                     $previous_operand = 1;
 760                 }
 761             }    #/if $operands
 762         }    # /for
 763     }
 764
 765     # add limits
 766     my $limit_query;
 767     my $limit_search_desc;
 768     foreach my $limit (@limits) {
 769
 770         # FIXME: not quite right yet ... will work on this soon -- JF
 771         my $type = $1 if $limit =~ m/([^:]+):([^:]*)/;
 772         if ( $limit =~ /available/ ) {
 773             $limit_query .= " (($query and datedue=0000-00-00) or ($query and datedue=0000-00-00 not lost=1) or ($query and datedue=0000-00-00 not lost=2))";
 774             #$limit_search_desc.=" and available";
 775         }
 776         elsif ( ($limit_query) && ( index( $limit_query, $type, 0 ) > 0 ) ) {
 777             if ( $limit_query !~ /\(/ ) {
 778                 $limit_query =
 779                     substr( $limit_query, 0, index( $limit_query, $type, 0 ) )
 780                   . "("
 781                   . substr( $limit_query, index( $limit_query, $type, 0 ) )
 782                   . " or $limit )"
 783                   if $limit;
 784                 $limit_search_desc =
 785                   substr( $limit_search_desc, 0,
 786                     index( $limit_search_desc, $type, 0 ) )
 787                   . "("
 788                   . substr( $limit_search_desc,
 789                     index( $limit_search_desc, $type, 0 ) )
 790                   . " or $limit )"
 791                   if $limit;
 792             }
 793             else {
 794                 chop $limit_query;
 795                 chop $limit_search_desc;
 796                 $limit_query       .= " or $limit )" if $limit;
 797                 $limit_search_desc .= " or $limit )" if $limit;
 798             }
 799         }
 800         elsif ( ($limit_query) && ( $limit =~ /mc/ ) ) {
 801             $limit_query       .= " or $limit" if $limit;
 802             $limit_search_desc .= " or $limit" if $limit;
 803         }
 804
 805         # these are treated as AND
 806         elsif ($limit_query) {
 807            if ($limit =~ /branch/){
 808                         $limit_query       .= " ) and ( $limit" if $limit;
 809                         $limit_search_desc .= " ) and ( $limit" if $limit;
 810                 }else{
 811                         $limit_query       .= " or $limit" if $limit;
 812                         $limit_search_desc .= " or $limit" if $limit;
 813                 }
 814         }
 815
 816         # otherwise, there is nothing but the limit
 817         else {
 818             $limit_query       .= "$limit" if $limit;
 819             $limit_search_desc .= "$limit" if $limit;
 820         }
 821     }
 822
 823     # if there's also a query, we need to AND the limits to it
 824     if ( ($limit_query) && ($query) ) {
 825         $limit_query       = " and (" . $limit_query . ")";
 826         $limit_search_desc = " and ($limit_search_desc)" if $limit_search_desc;
 827
 828     }
 829         warn "LIMIT: $limit_query";
 830     $query             .= $limit_query;
 831     $human_search_desc .= $limit_search_desc;
 832
 833     # now normalize the strings
 834     $query =~ s/  / /g;    # remove extra spaces
 835     $query =~ s/^ //g;     # remove any beginning spaces
 836     $query =~ s/:/=/g;     # causes probs for server
 837     $query =~ s/==/=/g;    # remove double == from query
 838
 839     my $federated_query = $human_search_desc;
 840     $federated_query =~ s/  / /g;
 841     $federated_query =~ s/^ //g;
 842     $federated_query =~ s/:/=/g;
 843     my $federated_query_opensearch = $federated_query;
 844
 845 #     my $federated_query_RPN = new ZOOM::Query::CCL2RPN( $query , C4::Context->ZConn('biblioserver'));
 846
 847     $human_search_desc =~ s/  / /g;
 848     $human_search_desc =~ s/^ //g;
 849     my $koha_query = $query;
 850
 851     #warn "QUERY:".$koha_query;
 852     #warn "SEARCHDESC:".$human_search_desc;
 853     #warn "FEDERATED QUERY:".$federated_query;
 854     return ( undef, $human_search_desc, $koha_query, $federated_query );
 855 }
 856
 857 # IMO this subroutine is pretty messy still -- it's responsible for
 858 # building the HTML output for the template
 859 sub searchResults {
 860     my ( $searchdesc, $hits, $results_per_page, $offset, @marcresults ) = @_;
 861
 862     my $dbh = C4::Context->dbh;
 863     my $toggle;
 864     my $even = 1;
 865     my @newresults;
 866     my $span_terms_hashref;
 867     for my $span_term ( split( / /, $searchdesc ) ) {
 868         $span_term =~ s/(.*=|\)|\(|\+|\.)//g;
 869         $span_terms_hashref->{$span_term}++;
 870     }
 871
 872     #Build brancnames hash
 873     #find branchname
 874     #get branch information.....
 875     my %branches;
 876     my $bsth =
 877       $dbh->prepare("SELECT branchcode,branchname FROM branches")
 878       ;    # FIXME : use C4::Koha::GetBranches
 879     $bsth->execute();
 880     while ( my $bdata = $bsth->fetchrow_hashref ) {
 881         $branches{ $bdata->{'branchcode'} } = $bdata->{'branchname'};
 882     }
 883
 884     #Build itemtype hash
 885     #find itemtype & itemtype image
 886     my %itemtypes;
 887     $bsth =
 888       $dbh->prepare("SELECT itemtype,description,imageurl,summary,notforloan FROM itemtypes");
 889     $bsth->execute();
 890     while ( my $bdata = $bsth->fetchrow_hashref ) {
 891         $itemtypes{ $bdata->{'itemtype'} }->{description} =
 892           $bdata->{'description'};
 893         $itemtypes{ $bdata->{'itemtype'} }->{imageurl} = $bdata->{'imageurl'};
 894         $itemtypes{ $bdata->{'itemtype'} }->{summary} = $bdata->{'summary'};
 895         $itemtypes{ $bdata->{'itemtype'} }->{notforloan} = $bdata->{'notforloan'};
 896     }
 897
 898     #search item field code
 899     my $sth =
 900       $dbh->prepare(
 901 "select tagfield from marc_subfield_structure where kohafield like 'items.itemnumber'"
 902       );
 903     $sth->execute;
 904     my ($itemtag) = $sth->fetchrow;
 905
 906     ## find column names of items related to MARC
 907     my $sth2 = $dbh->prepare("SHOW COLUMNS from items");
 908     $sth2->execute;
 909     my %subfieldstosearch;
 910     while ( ( my $column ) = $sth2->fetchrow ) {
 911         my ( $tagfield, $tagsubfield ) =
 912           &GetMarcFromKohaField( "items." . $column, "" );
 913         $subfieldstosearch{$column} = $tagsubfield;
 914     }
 915     my $times;
 916
 917     if ( $hits && $offset + $results_per_page <= $hits ) {
 918         $times = $offset + $results_per_page;
 919     }
 920     else {
 921         $times = $hits;
 922     }
 923
 924     for ( my $i = $offset ; $i <= $times - 1 ; $i++ ) {
 925         my $marcrecord;
 926         $marcrecord = MARC::File::USMARC::decode( $marcresults[$i] );
 927         my $oldbiblio = TransformMarcToKoha( $dbh, $marcrecord, '' );
 928         # add image url if there is one
 929         if ( $itemtypes{ $oldbiblio->{itemtype} }->{imageurl} =~ /^http:/ ) {
 930             $oldbiblio->{imageurl} =
 931               $itemtypes{ $oldbiblio->{itemtype} }->{imageurl};
 932             $oldbiblio->{description} =
 933               $itemtypes{ $oldbiblio->{itemtype} }->{description};
 934         }
 935         else {
 936             $oldbiblio->{imageurl} =
 937               getitemtypeimagesrc() . "/"
 938               . $itemtypes{ $oldbiblio->{itemtype} }->{imageurl}
 939               if ( $itemtypes{ $oldbiblio->{itemtype} }->{imageurl} );
 940             $oldbiblio->{description} =
 941               $itemtypes{ $oldbiblio->{itemtype} }->{description};
 942         }
 943         #
 944         # build summary if there is one (the summary is defined in itemtypes table
 945         #
 946         if ($itemtypes{ $oldbiblio->{itemtype} }->{summary}) {
 947             my $summary = $itemtypes{ $oldbiblio->{itemtype} }->{summary};
 948             my @fields = $marcrecord->fields();
 949             foreach my $field (@fields) {
 950                 my $tag = $field->tag();
 951                 my $tagvalue = $field->as_string();
 952                 $summary =~ s/\[(.?.?.?.?)$tag\*(.*?)]/$1$tagvalue$2\[$1$tag$2]/g;
 953                 unless ($tag<10) {
 954                     my @subf = $field->subfields;
 955                     for my $i (0..$#subf) {
 956                         my $subfieldcode = $subf[$i][0];
 957                         my $subfieldvalue = $subf[$i][1];
 958                         my $tagsubf = $tag.$subfieldcode;
 959                         $summary =~ s/\[(.?.?.?.?)$tagsubf(.*?)]/$1$subfieldvalue$2\[$1$tagsubf$2]/g;
 960                     }
 961                 }
 962             }
 963             $summary =~ s/\[(.*?)]//g;
 964             $summary =~ s/\n/<br>/g;
 965             $oldbiblio->{summary} = $summary;
 966         }
 967         # add spans to search term in results
 968         foreach my $term ( keys %$span_terms_hashref ) {
 969
 970             #warn "term: $term";
 971             my $old_term = $term;
 972             if ( length($term) > 3 ) {
 973                 $term =~ s/(.*=|\)|\(|\+|\.|\?|\[|\])//g;
 974                                 $term =~ s/\\//g;
 975
 976                 #FIXME: is there a better way to do this?
 977                 $oldbiblio->{'title'} =~ s/$term/<span class=term>$&<\/span>/gi;
 978                 $oldbiblio->{'subtitle'} =~
 979                   s/$term/<span class=term>$&<\/span>/gi;
 980
 981                 $oldbiblio->{'author'} =~ s/$term/<span class=term>$&<\/span>/gi;
 982                 $oldbiblio->{'publishercode'} =~ s/$term/<span class=term>$&<\/span>/gi;
 983                 $oldbiblio->{'place'} =~ s/$term/<span class=term>$&<\/span>/gi;
 984                 $oldbiblio->{'pages'} =~ s/$term/<span class=term>$&<\/span>/gi;
 985                 $oldbiblio->{'notes'} =~ s/$term/<span class=term>$&<\/span>/gi;
 986                 $oldbiblio->{'size'}  =~ s/$term/<span class=term>$&<\/span>/gi;
 987             }
 988         }
 989
 990         if ( $i % 2 ) {
 991             $toggle = "#ffffcc";
 992         }
 993         else {
 994             $toggle = "white";
 995         }
 996         $oldbiblio->{'toggle'} = $toggle;
 997         my @fields = $marcrecord->field($itemtag);
 998         my @items_loop;
 999         my $items;
1000         my $ordered_count     = 0;
1001         my $onloan_count      = 0;
1002         my $wthdrawn_count    = 0;
1003         my $itemlost_count    = 0;
1004         my $norequests        = 1;
1005
1006         #
1007         # check the loan status of the item :
1008         # it is not stored in the MARC record, for pref (zebra reindexing)
1009         # reason. Thus, we have to get the status from a specific SQL query
1010         #
1011         my $sth_issue = $dbh->prepare("
1012             SELECT date_due,returndate
1013             FROM issues
1014             WHERE itemnumber=? AND returndate IS NULL");
1015         my $items_count=scalar(@fields);
1016         foreach my $field (@fields) {
1017             my $item;
1018             foreach my $code ( keys %subfieldstosearch ) {
1019                 $item->{$code} = $field->subfield( $subfieldstosearch{$code} );
1020             }
1021             $sth_issue->execute($item->{itemnumber});
1022             $item->{due_date} = format_date($sth_issue->fetchrow);
1023             $item->{onloan} = 1 if $item->{due_date};
1024             # at least one item can be reserved : suppose no
1025             $norequests = 1;
1026             if ( $item->{wthdrawn} ) {
1027                 $wthdrawn_count++;
1028                 $items->{ $item->{'homebranch'}.'--'.$item->{'itemcallnumber'} }->{unavailable}=1;
1029                 $items->{ $item->{'homebranch'}.'--'.$item->{'itemcallnumber'} }->{wthdrawn}=1;
1030             }
1031             elsif ( $item->{itemlost} ) {
1032                 $itemlost_count++;
1033                 $items->{ $item->{'homebranch'}.'--'.$item->{'itemcallnumber'} }->{unavailable}=1;
1034                 $items->{ $item->{'homebranch'}.'--'.$item->{'itemcallnumber'} }->{itemlost}=1;
1035             }
1036             unless ( $item->{notforloan}) {
1037                 # OK, this one can be issued, so at least one can be reserved
1038                 $norequests = 0;
1039             }
1040             if ( ( $item->{onloan} ) && ( $item->{onloan} != '0000-00-00' ) )
1041             {
1042                 $items->{ $item->{'homebranch'}.'--'.$item->{'itemcallnumber'} }->{unavailable}=1;
1043                 $items->{ $item->{'homebranch'}.'--'.$item->{'itemcallnumber'} }->{onloancount} = 1;
1044                 $items->{ $item->{'homebranch'}.'--'.$item->{'itemcallnumber'} }->{due_date} = $item->{due_date};
1045                 $onloan_count++;
1046             }
1047             if ( $item->{'homebranch'} ) {
1048                 $items->{ $item->{'homebranch'}.'--'.$item->{'itemcallnumber'} }->{count}++;
1049             }
1050
1051             # Last resort
1052             elsif ( $item->{'holdingbranch'} ) {
1053                 $items->{ $item->{'holdingbranch'} }->{count}++;
1054             }
1055             $items->{ $item->{'homebranch'}.'--'.$item->{'itemcallnumber'} }->{itemcallnumber} =                $item->{itemcallnumber};
1056             $items->{ $item->{'homebranch'}.'--'.$item->{'itemcallnumber'} }->{location} =                $item->{location};
1057             $items->{ $item->{'homebranch'}.'--'.$item->{'itemcallnumber'} }->{branchcode} =               $item->{homebranch};
1058         }    # notforloan, item level and biblioitem level
1059
1060         # last check for norequest : if itemtype is notforloan, it can't be reserved either, whatever the items
1061         $norequests = 1 if $itemtypes{$oldbiblio->{itemtype}}->{notforloan};
1062
1063         for my $key ( sort keys %$items ) {
1064             my $this_item = {
1065                 branchname     => $branches{$items->{$key}->{branchcode}},
1066                 branchcode     => $items->{$key}->{branchcode},
1067                 count          => $items->{$key}->{count},
1068                 itemcallnumber => $items->{$key}->{itemcallnumber},
1069                 location => $items->{$key}->{location},
1070                 onloancount      => $items->{$key}->{onloancount},
1071                 due_date         => $items->{$key}->{due_date},
1072                 wthdrawn      => $items->{$key}->{wthdrawn},
1073                 lost         => $items->{$key}->{itemlost},
1074             };
1075             push @items_loop, $this_item;
1076         }
1077         $oldbiblio->{norequests}    = $norequests;
1078         $oldbiblio->{items_count}    = $items_count;
1079         $oldbiblio->{items_loop}    = \@items_loop;
1080         $oldbiblio->{onloancount}   = $onloan_count;
1081         $oldbiblio->{wthdrawncount} = $wthdrawn_count;
1082         $oldbiblio->{itemlostcount} = $itemlost_count;
1083         $oldbiblio->{orderedcount}  = $ordered_count;
1084         $oldbiblio->{isbn}          =~ s/-//g; # deleting - in isbn to enable amazon content
1085         push( @newresults, $oldbiblio );
1086     }
1087     return @newresults;
1088 }
1089
1090
1091
1092 #----------------------------------------------------------------------
1093 #
1094 # Non-Zebra GetRecords#
1095 #----------------------------------------------------------------------
1096
1097 =head2 NZgetRecords
1098
1099   NZgetRecords has the same API as zera getRecords, even if some parameters are not managed
1100
1101 =cut
1102
1103 sub NZgetRecords {
1104     my (
1105         $koha_query,     $federated_query,  $sort_by_ref,
1106         $servers_ref,    $results_per_page, $offset,
1107         $expanded_facet, $branches,         $query_type,
1108         $scan
1109     ) = @_;
1110     my $result = NZanalyse($koha_query);
1111     return (undef,NZorder($result,@$sort_by_ref[0],$results_per_page,$offset),undef);
1112 }
1113
1114 =head2 NZanalyse
1115
1116   NZanalyse : get a CQL string as parameter, and returns a list of biblionumber;title,biblionumber;title,...
1117   the list is builded from inverted index in nozebra SQL table
1118   note that title is here only for convenience : the sorting will be very fast when requested on title
1119   if the sorting is requested on something else, we will have to reread all results, and that may be longer.
1120
1121 =cut
1122
1123 sub NZanalyse {
1124     my ($string,$server) = @_;
1125     # $server contains biblioserver or authorities, depending on what we search on.
1126     #warn "querying : $string on $server";
1127     $server='biblioserver' unless $server;
1128     # if we have a ", replace the content to discard temporarily any and/or/not inside
1129     my $commacontent;
1130     if ($string =~/"/) {
1131         $string =~ s/"(.*?)"/__X__/;
1132         $commacontent = $1;
1133 #         print "commacontent : $commacontent\n";
1134     }
1135     # split the query string in 3 parts : X AND Y means : $left="X", $operand="AND" and $right="Y"
1136     # then, call again NZanalyse with $left and $right
1137     # (recursive until we find a leaf (=> something without and/or/not)
1138     $string =~ /(.*)( and | or | not | AND | OR | NOT )(.*)/;
1139     my $left = $1;
1140     my $right = $3;
1141     my $operand = lc($2);
1142     # it's not a leaf, we have a and/or/not
1143     if ($operand) {
1144         # reintroduce comma content if needed
1145         $right =~ s/__X__/"$commacontent"/ if $commacontent;
1146         $left =~ s/__X__/"$commacontent"/ if $commacontent;
1147 #         warn "node : $left / $operand / $right\n";
1148         my $leftresult = NZanalyse($left,$server);
1149         my $rightresult = NZanalyse($right,$server);
1150         # OK, we have the results for right and left part of the query
1151         # depending of operand, intersect, union or exclude both lists
1152         # to get a result list
1153         if ($operand eq ' and ') {
1154             my @leftresult = split /;/, $leftresult;
1155 #             my @rightresult = split /;/,$leftresult;
1156             my $finalresult;
1157             # parse the left results, and if the biblionumber exist in the right result, save it in finalresult
1158             # the result is stored twice, to have the same weight for AND than OR.
1159             # example : TWO : 61,61,64,121 (two is twice in the biblio #61) / TOWER : 61,64,130
1160             # result : 61,61,61,61,64,64 for two AND tower : 61 has more weight than 64
1161             foreach (@leftresult) {
1162                 if ($rightresult =~ "$_;") {
1163                     $finalresult .= "$_;$_;";
1164                 }
1165             }
1166             return $finalresult;
1167         } elsif ($operand eq ' or ') {
1168             # just merge the 2 strings
1169             return $leftresult.$rightresult;
1170         } elsif ($operand eq ' not ') {
1171             my @leftresult = split /;/, $leftresult;
1172 #             my @rightresult = split /;/,$leftresult;
1173             my $finalresult;
1174             foreach (@leftresult) {
1175                 unless ($rightresult =~ "$_;") {
1176                     $finalresult .= "$_;";
1177                 }
1178             }
1179             return $finalresult;
1180         } else {
1181             # this error is impossible, because of the regexp that isolate the operand, but just in case...
1182             die "error : operand unknown : $operand for $string";
1183         }
1184     # it's a leaf, do the real SQL query and return the result
1185     } else {
1186         $string =~  s/__X__/"$commacontent"/ if $commacontent;
1187         $string =~ s/-|\.|\?|,|;|!|'|\(|\)|\[|\]|{|}|"|<|>|&|\+|\*|\// /g;
1188 #         warn "leaf : $string\n";
1189         # parse the string in in operator/operand/value again
1190         $string =~ /(.*)(=|>|>=|<|<=)(.*)/;
1191         my $left = $1;
1192         my $operator = $2;
1193         my $right = $3;
1194         my $results;
1195         # automatic replace for short operators
1196         $left='title' if $left eq 'ti';
1197         $left='author' if $left eq 'au';
1198         $left='publisher' if $left eq 'pb';
1199         $left='subject' if $left eq 'su';
1200         $left='koha-Auth-Number' if $left eq 'an';
1201         $left='keyword' if $left eq 'kw';
1202         if ($operator) {
1203             #do a specific search
1204             my $dbh = C4::Context->dbh;
1205             $operator='LIKE' if $operator eq '=' and $right=~ /%/;
1206             my $sth = $dbh->prepare("SELECT biblionumbers FROM nozebra WHERE server=? AND indexname=? AND value $operator ?");
1207             # warn "$left / $operator / $right\n";
1208             # split each word, query the DB and build the biblionumbers result
1209             foreach (split / /,$right) {
1210                 my $biblionumbers;
1211                 next unless $_;
1212 #                 warn "EXECUTE : $server, $left, $_";
1213                 $sth->execute($server, $left, $_);
1214                 while (my $line = $sth->fetchrow) {
1215                     $biblionumbers .= $line;
1216 #                     warn "result : $line";
1217                 }
1218                 # do a AND with existing list if there is one, otherwise, use the biblionumbers list as 1st result list
1219                 if ($results) {
1220                     my @leftresult = split /;/, $biblionumbers;
1221                     my $temp;
1222                     foreach (@leftresult) {
1223                         if ($results =~ "$_;") {
1224                             $temp .= "$_;$_;";
1225                         }
1226                     }
1227                     $results = $temp;
1228                 } else {
1229                     $results = $biblionumbers;
1230                 }
1231             }
1232         } else {
1233             #do a complete search (all indexes)
1234             my $dbh = C4::Context->dbh;
1235             my $sth = $dbh->prepare("SELECT biblionumbers FROM nozebra WHERE server=? AND value LIKE ?");
1236             # split each word, query the DB and build the biblionumbers result
1237             foreach (split / /,$string) {
1238                 next if C4::Context->stopwords->{uc($_)}; # skip if stopword
1239                 #warn "search on all indexes on $_";
1240                 my $biblionumbers;
1241                 next unless $_;
1242                 $sth->execute($server, $_);
1243                 while (my $line = $sth->fetchrow) {
1244                     $biblionumbers .= $line;
1245                 }
1246                 # do a AND with existing list if there is one, otherwise, use the biblionumbers list as 1st result list
1247                 if ($results) {
1248                     my @leftresult = split /;/, $biblionumbers;
1249                     my $temp;
1250                     foreach (@leftresult) {
1251                         if ($results =~ "$_;") {
1252                             $temp .= "$_;$_;";
1253                         }
1254                     }
1255                     $results = $temp;
1256                 } else {
1257                     $results = $biblionumbers;
1258                 }
1259             }
1260         }
1261 #         warn "return : $results for LEAF : $string";
1262         return $results;
1263     }
1264 }
1265
1266 =head2 NZorder
1267
1268   $finalresult = NZorder($biblionumbers, $ordering,$results_per_page,$offset);
1269
1270   TODO :: Description
1271
1272 =cut
1273
1274
1275 sub NZorder {
1276     my ($biblionumbers, $ordering,$results_per_page,$offset) = @_;
1277     # order title asc by default
1278 #     $ordering = '1=36 <i' unless $ordering;
1279     $results_per_page=20 unless $results_per_page;
1280     $offset = 0 unless $offset;
1281     my $dbh = C4::Context->dbh;
1282     #
1283     # order by POPULARITY
1284     #
1285     if ($ordering =~ /1=9523/) {
1286         my %result;
1287         my %popularity;
1288         # popularity is not in MARC record, it's builded from a specific query
1289         my $sth = $dbh->prepare("select sum(issues) from items where biblionumber=?");
1290         foreach (split /;/,$biblionumbers) {
1291             my ($biblionumber,$title) = split /,/,$_;
1292             $result{$biblionumber}=GetMarcBiblio($biblionumber);
1293             $sth->execute($biblionumber);
1294             my $popularity= $sth->fetchrow ||0;
1295             # hint : the key is popularity.title because we can have
1296             # many results with the same popularity. In this cas, sub-ordering is done by title
1297             # we also have biblionumber to avoid bug for 2 biblios with the same title & popularity
1298             # (un-frequent, I agree, but we won't forget anything that way ;-)
1299             $popularity{sprintf("%10d",$popularity).$title.$biblionumber} = $biblionumber;
1300         }
1301         # sort the hash and return the same structure as GetRecords (Zebra querying)
1302         my $result_hash;
1303         my $numbers=0;
1304         if ($ordering eq '1=9523 >i') { # sort popularity DESC
1305             foreach my $key (sort {$b cmp $a} (keys %popularity)) {
1306                 $result_hash->{'RECORDS'}[$numbers++] = $result{$popularity{$key}}->as_usmarc();
1307             }
1308         } else { # sort popularity ASC
1309             foreach my $key (sort (keys %popularity)) {
1310                 $result_hash->{'RECORDS'}[$numbers++] = $result{$popularity{$key}}->as_usmarc();
1311             }
1312         }
1313         my $finalresult=();
1314         $result_hash->{'hits'} = $numbers;
1315         $finalresult->{'biblioserver'} = $result_hash;
1316         return $finalresult;
1317     #
1318     # ORDER BY author
1319     #
1320     } elsif ($ordering eq '1=1003 <i'){
1321         my %result;
1322         foreach (split /;/,$biblionumbers) {
1323             my ($biblionumber,$title) = split /,/,$_;
1324             my $record=GetMarcBiblio($biblionumber);
1325             my $author;
1326             if (C4::Context->preference('marcflavour') eq 'UNIMARC') {
1327                 $author=$record->subfield('200','f');
1328                 $author=$record->subfield('700','a') unless $author;
1329             } else {
1330                 $author=$record->subfield('100','a');
1331             }
1332             # hint : the result is sorted by title.biblionumber because we can have X biblios with the same title
1333             # and we don't want to get only 1 result for each of them !!!
1334             $result{$author.$biblionumber}=$record;
1335         }
1336         # sort the hash and return the same structure as GetRecords (Zebra querying)
1337         my $result_hash;
1338         my $numbers=0;
1339         if ($ordering eq '1=1003 <i') { # sort by author desc
1340             foreach my $key (sort (keys %result)) {
1341                 $result_hash->{'RECORDS'}[$numbers++] = $result{$key}->as_usmarc();
1342             }
1343         } else { # sort by author ASC
1344             foreach my $key (sort { $a cmp $b } (keys %result)) {
1345                 $result_hash->{'RECORDS'}[$numbers++] = $result{$key}->as_usmarc();
1346             }
1347         }
1348         my $finalresult=();
1349         $result_hash->{'hits'} = $numbers;
1350         $finalresult->{'biblioserver'} = $result_hash;
1351         return $finalresult;
1352     #
1353     # ORDER BY callnumber
1354     #
1355     } elsif ($ordering eq '1=20 <i'){
1356         my %result;
1357         foreach (split /;/,$biblionumbers) {
1358             my ($biblionumber,$title) = split /,/,$_;
1359             my $record=GetMarcBiblio($biblionumber);
1360             my $callnumber;
1361             my ($callnumber_tag,$callnumber_subfield)=GetMarcFromKohaField($dbh,'items.itemcallnumber');
1362             ($callnumber_tag,$callnumber_subfield)= GetMarcFromKohaField('biblioitems.callnumber') unless $callnumber_tag;
1363             if (C4::Context->preference('marcflavour') eq 'UNIMARC') {
1364                 $callnumber=$record->subfield('200','f');
1365             } else {
1366                 $callnumber=$record->subfield('100','a');
1367             }
1368             # hint : the result is sorted by title.biblionumber because we can have X biblios with the same title
1369             # and we don't want to get only 1 result for each of them !!!
1370             $result{$callnumber.$biblionumber}=$record;
1371         }
1372         # sort the hash and return the same structure as GetRecords (Zebra querying)
1373         my $result_hash;
1374         my $numbers=0;
1375         if ($ordering eq '1=1003 <i') { # sort by title desc
1376             foreach my $key (sort (keys %result)) {
1377                 $result_hash->{'RECORDS'}[$numbers++] = $result{$key}->as_usmarc();
1378             }
1379         } else { # sort by title ASC
1380             foreach my $key (sort { $a cmp $b } (keys %result)) {
1381                 $result_hash->{'RECORDS'}[$numbers++] = $result{$key}->as_usmarc();
1382             }
1383         }
1384         my $finalresult=();
1385         $result_hash->{'hits'} = $numbers;
1386         $finalresult->{'biblioserver'} = $result_hash;
1387         return $finalresult;
1388     } elsif ($ordering =~ /1=31/){ #pub year
1389         my %result;
1390         foreach (split /;/,$biblionumbers) {
1391             my ($biblionumber,$title) = split /,/,$_;
1392             my $record=GetMarcBiblio($biblionumber);
1393             my ($publicationyear_tag,$publicationyear_subfield)=GetMarcFromKohaField($dbh,'biblioitems.publicationyear');
1394             my $publicationyear=$record->subfield($publicationyear_tag,$publicationyear_subfield);
1395             # hint : the result is sorted by title.biblionumber because we can have X biblios with the same title
1396             # and we don't want to get only 1 result for each of them !!!
1397             $result{$publicationyear.$biblionumber}=$record;
1398         }
1399         # sort the hash and return the same structure as GetRecords (Zebra querying)
1400         my $result_hash;
1401         my $numbers=0;
1402         if ($ordering eq '1=31 <i') { # sort by pubyear desc
1403             foreach my $key (sort (keys %result)) {
1404                 $result_hash->{'RECORDS'}[$numbers++] = $result{$key}->as_usmarc();
1405             }
1406         } else { # sort by pub year ASC
1407             foreach my $key (sort { $b cmp $a } (keys %result)) {
1408                 $result_hash->{'RECORDS'}[$numbers++] = $result{$key}->as_usmarc();
1409             }
1410         }
1411         my $finalresult=();
1412         $result_hash->{'hits'} = $numbers;
1413         $finalresult->{'biblioserver'} = $result_hash;
1414         return $finalresult;
1415     #
1416     # ORDER BY title
1417     #
1418     } elsif ($ordering =~ /1=4/) {
1419         # the title is in the biblionumbers string, so we just need to build a hash, sort it and return
1420         my %result;
1421         foreach (split /;/,$biblionumbers) {
1422             my ($biblionumber,$title) = split /,/,$_;
1423             # hint : the result is sorted by title.biblionumber because we can have X biblios with the same title
1424             # and we don't want to get only 1 result for each of them !!!
1425             # hint & speed improvement : we can order without reading the record
1426             # so order, and read records only for the requested page !
1427             $result{$title.$biblionumber}=$biblionumber;
1428         }
1429         # sort the hash and return the same structure as GetRecords (Zebra querying)
1430         my $result_hash;
1431         my $numbers=0;
1432         if ($ordering eq '1=4 <i') { # sort by title desc
1433             foreach my $key (sort (keys %result)) {
1434                 $result_hash->{'RECORDS'}[$numbers++] = $result{$key};
1435             }
1436         } else { # sort by title ASC
1437             foreach my $key (sort { $b cmp $a } (keys %result)) {
1438                 $result_hash->{'RECORDS'}[$numbers++] = $result{$key};
1439             }
1440         }
1441         # limit the $results_per_page to result size if it's more
1442         $results_per_page = $numbers-1 if $numbers < $results_per_page;
1443         # for the requested page, replace biblionumber by the complete record
1444         # speed improvement : avoid reading too much things
1445         for (my $counter=$offset;$counter<=$offset+$results_per_page;$counter++) {
1446             $result_hash->{'RECORDS'}[$counter] = GetMarcBiblio($result_hash->{'RECORDS'}[$counter])->as_usmarc;
1447         }
1448         my $finalresult=();
1449         $result_hash->{'hits'} = $numbers;
1450         $finalresult->{'biblioserver'} = $result_hash;
1451         return $finalresult;
1452     } else {
1453     #
1454     # order by ranking
1455     #
1456         # we need 2 hashes to order by ranking : the 1st one to count the ranking, the 2nd to order by ranking
1457         my %result;
1458         my %count_ranking;
1459         foreach (split /;/,$biblionumbers) {
1460             my ($biblionumber,$title) = split /,/,$_;
1461             $title =~ /(.*)-(\d)/;
1462             # get weight
1463             my $ranking =$2;
1464             # note that we + the ranking because ranking is calculated on weight of EACH term requested.
1465             # if we ask for "two towers", and "two" has weight 2 in biblio N, and "towers" has weight 4 in biblio N
1466             # biblio N has ranking = 6
1467             $count_ranking{$biblionumber} += $ranking;
1468         }
1469         # build the result by "inverting" the count_ranking hash
1470         # 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
1471 #         warn "counting";
1472         foreach (keys %count_ranking) {
1473             $result{sprintf("%10d",$count_ranking{$_}).'-'.$_} = $_;
1474         }
1475         # sort the hash and return the same structure as GetRecords (Zebra querying)
1476         my $result_hash;
1477         my $numbers=0;
1478             foreach my $key (sort {$b cmp $a} (keys %result)) {
1479                 $result_hash->{'RECORDS'}[$numbers++] = $result{$key};
1480             }
1481         # limit the $results_per_page to result size if it's more
1482         $results_per_page = $numbers-1 if $numbers < $results_per_page;
1483         # for the requested page, replace biblionumber by the complete record
1484         # speed improvement : avoid reading too much things
1485         for (my $counter=$offset;$counter<=$offset+$results_per_page;$counter++) {
1486             $result_hash->{'RECORDS'}[$counter] = GetMarcBiblio($result_hash->{'RECORDS'}[$counter])->as_usmarc;
1487         }
1488         my $finalresult=();
1489         $result_hash->{'hits'} = $numbers;
1490         $finalresult->{'biblioserver'} = $result_hash;
1491         return $finalresult;
1492     }
1493 }
1494 =head2 ModBiblios
1495
1496 ($countchanged,$listunchanged) = ModBiblios($listbiblios, $tagsubfield,$initvalue,$targetvalue,$test);
1497
1498 this function changes all the values $initvalue in subfield $tag$subfield in any record in $listbiblios
1499 test parameter if set donot perform change to records in database.
1500
1501 =over 2
1502
1503 =item C<input arg:>
1504
1505     * $listbiblios is an array ref to marcrecords to be changed
1506     * $tagsubfield is the reference of the subfield to change.
1507     * $initvalue is the value to search the record for
1508     * $targetvalue is the value to set the subfield to
1509     * $test is to be set only not to perform changes in database.
1510
1511 =item C<Output arg:>
1512     * $countchanged counts all the changes performed.
1513     * $listunchanged contains the list of all the biblionumbers of records unchanged.
1514
1515 =item C<usage in the script:>
1516
1517 =back
1518
1519 my ($countchanged, $listunchanged) = EditBiblios($results->{RECORD}, $tagsubfield,$initvalue,$targetvalue);;
1520 #If one wants to display unchanged records, you should get biblios foreach @$listunchanged
1521 $template->param(countchanged => $countchanged, loopunchanged=>$listunchanged);
1522
1523 =cut
1524
1525 sub ModBiblios{
1526   my ($listbiblios,$tagsubfield,$initvalue,$targetvalue,$test)=@_;
1527   my $countmatched;
1528   my @unmatched;
1529   my ($tag,$subfield)=($1,$2) if ($tagsubfield=~/^(\d{1,3})([a-z0-9A-Z@])?$/);
1530   if ((length($tag)<3)&& $subfield=~/0-9/){
1531     $tag=$tag.$subfield;
1532     undef $subfield;
1533   }
1534   my ($bntag,$bnsubf) = GetMarcFromKohaField('biblio.biblionumber');
1535   my ($itemtag,$itemsubf) = GetMarcFromKohaField('items.itemnumber');
1536   foreach my $usmarc (@$listbiblios){
1537     my $record;
1538     $record=eval{MARC::Record->new_from_usmarc($usmarc)};
1539     my $biblionumber;
1540     if ($@){
1541       # usmarc is not a valid usmarc May be a biblionumber
1542       if ($tag eq $itemtag){
1543         my $bib=GetBiblioFromItemNumber($usmarc);
1544         $record=GetMarcItem($bib->{'biblionumber'},$usmarc) ;
1545         $biblionumber=$bib->{'biblionumber'};
1546       } else {
1547         $record=GetMarcBiblio($usmarc);
1548         $biblionumber=$usmarc;
1549       }
1550     }  else {
1551       if ($bntag >= 010){
1552         $biblionumber = $record->subfield($bntag,$bnsubf);
1553       }else {
1554         $biblionumber=$record->field($bntag)->data;
1555       }
1556     }
1557     #GetBiblionumber is to be written.
1558     #Could be replaced by TransformMarcToKoha (But Would be longer)
1559     if ($record->field($tag)){
1560       my $modify=0;
1561       foreach my $field ($record->field($tag)){
1562         if ($subfield){
1563           if ($field->delete_subfield('code' =>$subfield,'match'=>qr($initvalue))){
1564             $countmatched++;
1565             $modify=1;
1566             $field->update($subfield,$targetvalue) if ($targetvalue);
1567           }
1568         } else {
1569           if ($tag >= 010){
1570             if ($field->delete_field($field)){
1571               $countmatched++;
1572               $modify=1;
1573             }
1574           } else {
1575             $field->data=$targetvalue if ($field->data=~qr($initvalue));
1576           }
1577         }
1578       }
1579 #       warn $record->as_formatted;
1580       if ($modify){
1581         ModBiblio($record,$biblionumber,GetFrameworkCode($biblionumber)) unless ($test);
1582       } else {
1583         push @unmatched, $biblionumber;
1584       }
1585     } else {
1586       push @unmatched, $biblionumber;
1587     }
1588   }
1589   return ($countmatched,\@unmatched);
1590 }
1591
1592 END { }    # module clean-up code here (global destructor)
1593
1594 1;
1595 __END__
1596
1597 =head1 AUTHOR
1598
1599 Koha Developement team <info@koha.org>
1600
1601 =cut