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