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             my $stemmed_operand;
 575             my $stemming      = C4::Context->parameters("Stemming")     || 0;
 576             my $weight_fields = C4::Context->parameters("WeightFields") || 0;
 577
 578             # We Have to do this more carefully.
 579             #Since Phrase Search Is Phrase search.
 580             #phrase "Physics In Collision" will not be found if we do it like that.
 581             my $index   = $indexes[$i];
 582             my (@nontruncated,@righttruncated,@lefttruncated,@rightlefttruncated,@regexpr);
 583             if (index($index,"phr")<0 && index($index,",")>0){
 584               #operand may be a wordlist deleting stopwords
 585               foreach (keys %{C4::Context->stopwords}) {
 586                   $operand=~ s/\P{IsAlpha}$_\P{IsAlpha}/ /i;
 587                   $operand=~ s/^$_\P{IsAlpha}/ /i;
 588                   $operand=~ s/\P{IsAlpha}$_$/ /i;
 589               }
 590               #now coping with words
 591               my @wordlist= split (/\s/,$operand);
 592               foreach my $word (@wordlist){
 593                 if (index($word,"*")==0 && index($word,"*",1)==length($word)-2){
 594                   $word=~s/\*//;
 595                   push @rightlefttruncated,$word;
 596                 } elsif(index($word,"*")==0 && index($word,"*",1)<0){
 597                   $word=~s/\*//;
 598                   push @lefttruncated,$word;
 599                 } elsif (index($word,"*")==length($word)-1){
 600                   $word=~s/\*//;
 601                   push @righttruncated,$word;
 602                 } elsif (index($word,"*")<0){
 603                   push @nontruncated,$word;
 604                 } else {
 605                   push @regexpr,$word;
 606                 }
 607               }
 608             }
 609
 610             if ( $operands[$i] ) {
 611                 $operand =~ s/^(and |or |not )//i;
 612
 613 # STEMMING FIXME: need to refine the field weighting so stemmed operands don't disrupt the query ranking
 614                 if ($stemming) {
 615                     my @words = split( / /, $operands[$i] );
 616                     my $stems = $stemmer->stem(@words);
 617                     foreach my $stem (@$stems) {
 618                         $stemmed_operand .= "$stem";
 619                         $stemmed_operand .= "?"
 620                           unless ( $stem =~ /(and$|or$|not$)/ )
 621                           || ( length($stem) < 3 );
 622                         $stemmed_operand .= " ";
 623
 624                         #warn "STEM: $stemmed_operand";
 625                     }
 626
 627                     #$operand = $stemmed_operand;
 628                 }
 629
 630 # FIELD WEIGHTING - This is largely experimental stuff. What I'm committing works
 631 # pretty well but will work much better when we have an actual query parser
 632                 my $weighted_query;
 633                 if ($weight_fields) {
 634                     $weighted_query .=
 635                       " rk=(";    # Specifies that we're applying rank
 636                                   # keyword has different weight properties
 637                     if ( ( $index =~ /kw/ ) || ( !$index ) )
 638                     { # FIXME: do I need to add right-truncation in the case of stemming?
 639                           # a simple way to find out if this query uses an index
 640                         if ( $operand =~ /(\=|\:)/ ) {
 641                             $weighted_query .= " $operand";
 642                         }
 643                         else {
 644                             $weighted_query .=
 645                               " Title-cover,ext,r1=\"$operand\""
 646                               ;    # index label as exact
 647                             $weighted_query .=
 648                               " or ti,ext,r2=$operand";    # index as exact
 649                              #$weighted_query .= " or ti,phr,r3=$operand";              # index as  phrase
 650                              #$weighted_query .= " or any,ext,r4=$operand";         # index as exact
 651                             $weighted_query .=
 652                               " or kw,wrdl,r5=$operand";    # index as exact
 653                             $weighted_query .= " or wrd,fuzzy,r9=$operand";
 654                             $weighted_query .= " or wrd=$stemmed_operand"
 655                               if $stemming;
 656                         }
 657                     }
 658                     elsif ( $index =~ /au/ ) {
 659                         $weighted_query .=
 660                           " $index,ext,r1=$operand";    # index label as exact
 661                          #$weighted_query .= " or (title-sort-az=0 or $index,startswithnt,st-word,r3=$operand #)";
 662                         $weighted_query .=
 663                           " or $index,phr,r3=$operand";    # index as phrase
 664                         $weighted_query .= " or $index,rt,wrd,r3=$operand";
 665                     }
 666                     elsif ( $index =~ /ti/ ) {
 667                         $weighted_query .=
 668                           " Title-cover,ext,r1=$operand"; # index label as exact
 669                         $weighted_query .= " or Title-series,ext,r2=$operand";
 670
 671                         #$weighted_query .= " or ti,ext,r2=$operand";
 672                         #$weighted_query .= " or ti,phr,r3=$operand";
 673                         #$weighted_query .= " or ti,wrd,r3=$operand";
 674                         $weighted_query .=
 675 " or (title-sort-az=0 or Title-cover,startswithnt,st-word,r3=$operand #)";
 676                         $weighted_query .=
 677 " or (title-sort-az=0 or Title-cover,phr,r6=$operand)";
 678
 679                         #$weighted_query .= " or Title-cover,wrd,r5=$operand";
 680                         #$weighted_query .= " or ti,ext,r6=$operand";
 681                         #$weighted_query .= " or ti,startswith,phr,r7=$operand";
 682                         #$weighted_query .= " or ti,phr,r8=$operand";
 683                         #$weighted_query .= " or ti,wrd,r9=$operand";
 684
 685    #$weighted_query .= " or ti,ext,r2=$operand";         # index as exact
 686    #$weighted_query .= " or ti,phr,r3=$operand";              # index as  phrase
 687    #$weighted_query .= " or any,ext,r4=$operand";         # index as exact
 688    #$weighted_query .= " or kw,wrd,r5=$operand";         # index as exact
 689                     }
 690                     else {
 691                         $weighted_query .=
 692                           " $index,ext,r1=$operand";    # index label as exact
 693                          #$weighted_query .= " or $index,ext,r2=$operand";            # index as exact
 694                         $weighted_query .=
 695                           " or $index,phr,r3=$operand";    # index as phrase
 696                         $weighted_query .= " or $index,rt,wrd,r3=$operand";
 697                         $weighted_query .=
 698                           " or $index,wrd,r5=$operand"
 699                           ;    # index as word right-truncated
 700                         $weighted_query .= " or $index,wrd,fuzzy,r8=$operand";
 701                     }
 702                     $weighted_query .= ")";    # close rank specification
 703                     $operand = $weighted_query;
 704                 }
 705
 706                 # only add an operator if there is a previous operand
 707                 if ($previous_operand) {
 708                     if ( $operators[ $i - 1 ] ) {
 709                         $query .= " $operators[$i-1] $index: $operand";
 710                         if ( !$index ) {
 711                             $human_search_desc .=
 712                               "  $operators[$i-1] $operands[$i]";
 713                         }
 714                         else {
 715                             $human_search_desc .=
 716                               "  $operators[$i-1] $index: $operands[$i]";
 717                         }
 718                     }
 719
 720                     # the default operator is and
 721                     else {
 722                         $query             .= " and $index: $operand";
 723                         $human_search_desc .= "  and $index: $operands[$i]";
 724                     }
 725                 }
 726                 else {
 727                     if ( !$index ) {
 728                         $query             .= " $operand";
 729                         $human_search_desc .= "  $operands[$i]";
 730                     }
 731                     else {
 732                       if (scalar(@righttruncated)+scalar(@lefttruncated)+scalar(@rightlefttruncated)>0){
 733                          $query.= "$index: @nontruncated " if (scalar(@nontruncated)>0);
 734                          if (scalar(@righttruncated)>0){
 735                           $query .= "and $index,rtrn:@righttruncated ";
 736                          }
 737                          if (scalar(@lefttruncated)>0){
 738                           $query .= "and $index,ltrn:@lefttruncated ";
 739                          }
 740                          if (scalar(@rightlefttruncated)>0){
 741                           $query .= "and $index,rltrn:@rightlefttruncated ";
 742                          }
 743                         $query=~s/^and//;
 744                         $human_search_desc .= $query;
 745                       } else {
 746                         $query             .= " $index: $operand";
 747                         $human_search_desc .= "  $index: $operands[$i]";
 748                       }
 749                     }
 750                     $previous_operand = 1;
 751                 }
 752             }    #/if $operands
 753         }    # /for
 754     }
 755
 756     # add limits
 757     my $limit_query;
 758     my $limit_search_desc;
 759     foreach my $limit (@limits) {
 760
 761         # FIXME: not quite right yet ... will work on this soon -- JF
 762         my $type = $1 if $limit =~ m/([^:]+):([^:]*)/;
 763         if ( $limit =~ /available/ ) {
 764             $limit_query .=
 765 " (($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))";
 766
 767             #$limit_search_desc.=" and available";
 768         }
 769         elsif ( ($limit_query) && ( index( $limit_query, $type, 0 ) > 0 ) ) {
 770             if ( $limit_query !~ /\(/ ) {
 771                 $limit_query =
 772                     substr( $limit_query, 0, index( $limit_query, $type, 0 ) )
 773                   . "("
 774                   . substr( $limit_query, index( $limit_query, $type, 0 ) )
 775                   . " or $limit )"
 776                   if $limit;
 777                 $limit_search_desc =
 778                   substr( $limit_search_desc, 0,
 779                     index( $limit_search_desc, $type, 0 ) )
 780                   . "("
 781                   . substr( $limit_search_desc,
 782                     index( $limit_search_desc, $type, 0 ) )
 783                   . " or $limit )"
 784                   if $limit;
 785             }
 786             else {
 787                 chop $limit_query;
 788                 chop $limit_search_desc;
 789                 $limit_query       .= " or $limit )" if $limit;
 790                 $limit_search_desc .= " or $limit )" if $limit;
 791             }
 792         }
 793         elsif ( ($limit_query) && ( $limit =~ /mc/ ) ) {
 794             $limit_query       .= " or $limit" if $limit;
 795             $limit_search_desc .= " or $limit" if $limit;
 796         }
 797
 798         # these are treated as AND
 799         elsif ($limit_query) {
 800            if ($limit =~ /branch/){
 801                         $limit_query       .= " ) and ( $limit" if $limit;
 802                         $limit_search_desc .= " ) and ( $limit" if $limit;
 803                 }else{
 804                         $limit_query       .= " or $limit" if $limit;
 805                         $limit_search_desc .= " or $limit" if $limit;
 806                 }
 807         }
 808
 809         # otherwise, there is nothing but the limit
 810         else {
 811             $limit_query       .= "$limit" if $limit;
 812             $limit_search_desc .= "$limit" if $limit;
 813         }
 814     }
 815
 816     # if there's also a query, we need to AND the limits to it
 817     if ( ($limit_query) && ($query) ) {
 818         $limit_query       = " and (" . $limit_query . ")";
 819         $limit_search_desc = " and ($limit_search_desc)" if $limit_search_desc;
 820
 821     }
 822     $query             .= $limit_query;
 823     $human_search_desc .= $limit_search_desc;
 824
 825     # now normalize the strings
 826     $query =~ s/  / /g;    # remove extra spaces
 827     $query =~ s/^ //g;     # remove any beginning spaces
 828     $query =~ s/:/=/g;     # causes probs for server
 829     $query =~ s/==/=/g;    # remove double == from query
 830
 831     my $federated_query = $human_search_desc;
 832     $federated_query =~ s/  / /g;
 833     $federated_query =~ s/^ //g;
 834     $federated_query =~ s/:/=/g;
 835     my $federated_query_opensearch = $federated_query;
 836
 837 #     my $federated_query_RPN = new ZOOM::Query::CCL2RPN( $query , C4::Context->ZConn('biblioserver'));
 838
 839     $human_search_desc =~ s/  / /g;
 840     $human_search_desc =~ s/^ //g;
 841     my $koha_query = $query;
 842
 843 #      warn "QUERY:".$koha_query;
 844 #      warn "SEARCHDESC:".$human_search_desc;
 845 #      warn "FEDERATED QUERY:".$federated_query;
 846     return ( undef, $human_search_desc, $koha_query, $federated_query );
 847 }
 848
 849 # IMO this subroutine is pretty messy still -- it's responsible for
 850 # building the HTML output for the template
 851 sub searchResults {
 852     my ( $searchdesc, $hits, $results_per_page, $offset, @marcresults ) = @_;
 853
 854     my $dbh = C4::Context->dbh;
 855     my $toggle;
 856     my $even = 1;
 857     my @newresults;
 858     my $span_terms_hashref;
 859     for my $span_term ( split( / /, $searchdesc ) ) {
 860         $span_term =~ s/(.*=|\)|\(|\+|\.)//g;
 861         $span_terms_hashref->{$span_term}++;
 862     }
 863
 864     #Build brancnames hash
 865     #find branchname
 866     #get branch information.....
 867     my %branches;
 868     my $bsth =
 869       $dbh->prepare("SELECT branchcode,branchname FROM branches")
 870       ;    # FIXME : use C4::Koha::GetBranches
 871     $bsth->execute();
 872     while ( my $bdata = $bsth->fetchrow_hashref ) {
 873         $branches{ $bdata->{'branchcode'} } = $bdata->{'branchname'};
 874     }
 875
 876     #Build itemtype hash
 877     #find itemtype & itemtype image
 878     my %itemtypes;
 879     $bsth =
 880       $dbh->prepare("SELECT itemtype,description,imageurl,summary,notforloan FROM itemtypes");
 881     $bsth->execute();
 882     while ( my $bdata = $bsth->fetchrow_hashref ) {
 883         $itemtypes{ $bdata->{'itemtype'} }->{description} =
 884           $bdata->{'description'};
 885         $itemtypes{ $bdata->{'itemtype'} }->{imageurl} = $bdata->{'imageurl'};
 886         $itemtypes{ $bdata->{'itemtype'} }->{summary} = $bdata->{'summary'};
 887         $itemtypes{ $bdata->{'itemtype'} }->{notforloan} = $bdata->{'notforloan'};
 888     }
 889
 890     #search item field code
 891     my $sth =
 892       $dbh->prepare(
 893 "select tagfield from marc_subfield_structure where kohafield like 'items.itemnumber'"
 894       );
 895     $sth->execute;
 896     my ($itemtag) = $sth->fetchrow;
 897
 898     ## find column names of items related to MARC
 899     my $sth2 = $dbh->prepare("SHOW COLUMNS from items");
 900     $sth2->execute;
 901     my %subfieldstosearch;
 902     while ( ( my $column ) = $sth2->fetchrow ) {
 903         my ( $tagfield, $tagsubfield ) =
 904           &GetMarcFromKohaField( "items." . $column, "" );
 905         $subfieldstosearch{$column} = $tagsubfield;
 906     }
 907     my $times;
 908
 909     if ( $hits && $offset + $results_per_page <= $hits ) {
 910         $times = $offset + $results_per_page;
 911     }
 912     else {
 913         $times = $hits;
 914     }
 915
 916     for ( my $i = $offset ; $i <= $times - 1 ; $i++ ) {
 917         my $marcrecord;
 918         $marcrecord = MARC::File::USMARC::decode( $marcresults[$i] );
 919         my $oldbiblio = TransformMarcToKoha( $dbh, $marcrecord, '' );
 920         # add image url if there is one
 921         if ( $itemtypes{ $oldbiblio->{itemtype} }->{imageurl} =~ /^http:/ ) {
 922             $oldbiblio->{imageurl} =
 923               $itemtypes{ $oldbiblio->{itemtype} }->{imageurl};
 924             $oldbiblio->{description} =
 925               $itemtypes{ $oldbiblio->{itemtype} }->{description};
 926         }
 927         else {
 928             $oldbiblio->{imageurl} =
 929               getitemtypeimagesrc() . "/"
 930               . $itemtypes{ $oldbiblio->{itemtype} }->{imageurl}
 931               if ( $itemtypes{ $oldbiblio->{itemtype} }->{imageurl} );
 932             $oldbiblio->{description} =
 933               $itemtypes{ $oldbiblio->{itemtype} }->{description};
 934         }
 935         #
 936         # build summary if there is one (the summary is defined in itemtypes table
 937         #
 938         if ($itemtypes{ $oldbiblio->{itemtype} }->{summary}) {
 939             my $summary = $itemtypes{ $oldbiblio->{itemtype} }->{summary};
 940             my @fields = $marcrecord->fields();
 941             foreach my $field (@fields) {
 942                 my $tag = $field->tag();
 943                 my $tagvalue = $field->as_string();
 944                 $summary =~ s/\[(.?.?.?.?)$tag\*(.*?)]/$1$tagvalue$2\[$1$tag$2]/g;
 945                 unless ($tag<10) {
 946                     my @subf = $field->subfields;
 947                     for my $i (0..$#subf) {
 948                         my $subfieldcode = $subf[$i][0];
 949                         my $subfieldvalue = $subf[$i][1];
 950                         my $tagsubf = $tag.$subfieldcode;
 951                         $summary =~ s/\[(.?.?.?.?)$tagsubf(.*?)]/$1$subfieldvalue$2\[$1$tagsubf$2]/g;
 952                     }
 953                 }
 954             }
 955             $summary =~ s/\[(.*?)]//g;
 956             $summary =~ s/\n/<br>/g;
 957             $oldbiblio->{summary} = $summary;
 958         }
 959         # add spans to search term in results
 960         foreach my $term ( keys %$span_terms_hashref ) {
 961
 962             #warn "term: $term";
 963             my $old_term = $term;
 964             if ( length($term) > 3 ) {
 965                 $term =~ s/(.*=|\)|\(|\+|\.|\?|\[|\])//g;
 966                                 $term =~ s/\\//g;
 967
 968                 #FIXME: is there a better way to do this?
 969                 $oldbiblio->{'title'} =~ s/$term/<span class=term>$&<\/span>/gi;
 970                 $oldbiblio->{'subtitle'} =~
 971                   s/$term/<span class=term>$&<\/span>/gi;
 972
 973                 $oldbiblio->{'author'} =~ s/$term/<span class=term>$&<\/span>/gi;
 974                 $oldbiblio->{'publishercode'} =~ s/$term/<span class=term>$&<\/span>/gi;
 975                 $oldbiblio->{'place'} =~ s/$term/<span class=term>$&<\/span>/gi;
 976                 $oldbiblio->{'pages'} =~ s/$term/<span class=term>$&<\/span>/gi;
 977                 $oldbiblio->{'notes'} =~ s/$term/<span class=term>$&<\/span>/gi;
 978                 $oldbiblio->{'size'}  =~ s/$term/<span class=term>$&<\/span>/gi;
 979             }
 980         }
 981
 982         if ( $i % 2 ) {
 983             $toggle = "#ffffcc";
 984         }
 985         else {
 986             $toggle = "white";
 987         }
 988         $oldbiblio->{'toggle'} = $toggle;
 989         my @fields = $marcrecord->field($itemtag);
 990         my @items_loop;
 991         my $items;
 992         my $ordered_count     = 0;
 993         my $onloan_count      = 0;
 994         my $wthdrawn_count    = 0;
 995         my $itemlost_count    = 0;
 996         my $norequests        = 1;
 997
 998         #
 999         # check the loan status of the item :
1000         # it is not stored in the MARC record, for pref (zebra reindexing)
1001         # reason. Thus, we have to get the status from a specific SQL query
1002         #
1003         my $sth_issue = $dbh->prepare("
1004             SELECT date_due,returndate
1005             FROM issues
1006             WHERE itemnumber=? AND returndate IS NULL");
1007         my $items_count=scalar(@fields);
1008         foreach my $field (@fields) {
1009             my $item;
1010             foreach my $code ( keys %subfieldstosearch ) {
1011                 $item->{$code} = $field->subfield( $subfieldstosearch{$code} );
1012             }
1013             $sth_issue->execute($item->{itemnumber});
1014             $item->{due_date} = format_date($sth_issue->fetchrow);
1015             $item->{onloan} = 1 if $item->{due_date};
1016             # at least one item can be reserved : suppose no
1017             $norequests = 1;
1018             if ( $item->{wthdrawn} ) {
1019                 $wthdrawn_count++;
1020                 $items->{ $item->{'homebranch'}.'--'.$item->{'itemcallnumber'} }->{unavailable}=1;
1021                 $items->{ $item->{'homebranch'}.'--'.$item->{'itemcallnumber'} }->{wthdrawn}=1;
1022             }
1023             elsif ( $item->{itemlost} ) {
1024                 $itemlost_count++;
1025                 $items->{ $item->{'homebranch'}.'--'.$item->{'itemcallnumber'} }->{unavailable}=1;
1026                 $items->{ $item->{'homebranch'}.'--'.$item->{'itemcallnumber'} }->{itemlost}=1;
1027             }
1028             unless ( $item->{notforloan}) {
1029                 # OK, this one can be issued, so at least one can be reserved
1030                 $norequests = 0;
1031             }
1032             if ( ( $item->{onloan} ) && ( $item->{onloan} != '0000-00-00' ) )
1033             {
1034                 $items->{ $item->{'homebranch'}.'--'.$item->{'itemcallnumber'} }->{unavailable}=1;
1035                 $items->{ $item->{'homebranch'}.'--'.$item->{'itemcallnumber'} }->{onloancount} = 1;
1036                 $items->{ $item->{'homebranch'}.'--'.$item->{'itemcallnumber'} }->{due_date} = $item->{due_date};
1037                 $onloan_count++;
1038             }
1039             if ( $item->{'homebranch'} ) {
1040                 $items->{ $item->{'homebranch'}.'--'.$item->{'itemcallnumber'} }->{count}++;
1041             }
1042
1043             # Last resort
1044             elsif ( $item->{'holdingbranch'} ) {
1045                 $items->{ $item->{'holdingbranch'} }->{count}++;
1046             }
1047             $items->{ $item->{'homebranch'}.'--'.$item->{'itemcallnumber'} }->{itemcallnumber} =                $item->{itemcallnumber};
1048             $items->{ $item->{'homebranch'}.'--'.$item->{'itemcallnumber'} }->{location} =                $item->{location};
1049             $items->{ $item->{'homebranch'}.'--'.$item->{'itemcallnumber'} }->{branchcode} =               $item->{homebranch};
1050         }    # notforloan, item level and biblioitem level
1051
1052         # last check for norequest : if itemtype is notforloan, it can't be reserved either, whatever the items
1053         $norequests = 1 if $itemtypes{$oldbiblio->{itemtype}}->{notforloan};
1054
1055         for my $key ( sort keys %$items ) {
1056             my $this_item = {
1057                 branchname     => $branches{$items->{$key}->{branchcode}},
1058                 branchcode     => $items->{$key}->{branchcode},
1059                 count          => $items->{$key}->{count}==1 ?"":$items->{$key}->{count},
1060                 itemcallnumber => $items->{$key}->{itemcallnumber},
1061                 location => $items->{$key}->{location},
1062                 onloancount      => $items->{$key}->{onloancount},
1063                 due_date         => $items->{$key}->{due_date},
1064                 wthdrawn      => $items->{$key}->{wthdrawn},
1065                 lost         => $items->{$key}->{itemlost},
1066             };
1067             push @items_loop, $this_item;
1068         }
1069         $oldbiblio->{norequests}    = $norequests;
1070         $oldbiblio->{items_count}    = $items_count;
1071         $oldbiblio->{items_loop}    = \@items_loop;
1072         $oldbiblio->{onloancount}   = $onloan_count;
1073         $oldbiblio->{wthdrawncount} = $wthdrawn_count;
1074         $oldbiblio->{itemlostcount} = $itemlost_count;
1075         $oldbiblio->{orderedcount}  = $ordered_count;
1076         $oldbiblio->{isbn}          =~ s/-//g; # deleting - in isbn to enable amazon content
1077         push( @newresults, $oldbiblio );
1078     }
1079     return @newresults;
1080 }
1081
1082
1083
1084 #----------------------------------------------------------------------
1085 #
1086 # Non-Zebra GetRecords#
1087 #----------------------------------------------------------------------
1088
1089 =head2 NZgetRecords
1090
1091   NZgetRecords has the same API as zera getRecords, even if some parameters are not managed
1092
1093 =cut
1094
1095 sub NZgetRecords {
1096     my (
1097         $koha_query,     $federated_query,  $sort_by_ref,
1098         $servers_ref,    $results_per_page, $offset,
1099         $expanded_facet, $branches,         $query_type,
1100         $scan
1101     ) = @_;
1102     my $result = NZanalyse($koha_query);
1103     return (undef,NZorder($result,@$sort_by_ref[0],$results_per_page,$offset),undef);
1104 }
1105
1106 =head2 NZanalyse
1107
1108   NZanalyse : get a CQL string as parameter, and returns a list of biblionumber;title,biblionumber;title,...
1109   the list is builded from inverted index in nozebra SQL table
1110   note that title is here only for convenience : the sorting will be very fast when requested on title
1111   if the sorting is requested on something else, we will have to reread all results, and that may be longer.
1112
1113 =cut
1114
1115 sub NZanalyse {
1116     my ($string,$server) = @_;
1117     # $server contains biblioserver or authorities, depending on what we search on.
1118     #warn "querying : $string on $server";
1119     $server='biblioserver' unless $server;
1120     # if we have a ", replace the content to discard temporarily any and/or/not inside
1121     my $commacontent;
1122     if ($string =~/"/) {
1123         $string =~ s/"(.*?)"/__X__/;
1124         $commacontent = $1;
1125 #         print "commacontent : $commacontent\n";
1126     }
1127     # split the query string in 3 parts : X AND Y means : $left="X", $operand="AND" and $right="Y"
1128     # then, call again NZanalyse with $left and $right
1129     # (recursive until we find a leaf (=> something without and/or/not)
1130     $string =~ /(.*)( and | or | not | AND | OR | NOT )(.*)/;
1131     my $left = $1;
1132     my $right = $3;
1133     my $operand = lc($2);
1134     # it's not a leaf, we have a and/or/not
1135     if ($operand) {
1136         # reintroduce comma content if needed
1137         $right =~ s/__X__/"$commacontent"/ if $commacontent;
1138         $left =~ s/__X__/"$commacontent"/ if $commacontent;
1139 #         warn "node : $left / $operand / $right\n";
1140         my $leftresult = NZanalyse($left,$server);
1141         my $rightresult = NZanalyse($right,$server);
1142         # OK, we have the results for right and left part of the query
1143         # depending of operand, intersect, union or exclude both lists
1144         # to get a result list
1145         if ($operand eq ' and ') {
1146             my @leftresult = split /;/, $leftresult;
1147 #             my @rightresult = split /;/,$leftresult;
1148             my $finalresult;
1149             # parse the left results, and if the biblionumber exist in the right result, save it in finalresult
1150             # the result is stored twice, to have the same weight for AND than OR.
1151             # example : TWO : 61,61,64,121 (two is twice in the biblio #61) / TOWER : 61,64,130
1152             # result : 61,61,61,61,64,64 for two AND tower : 61 has more weight than 64
1153             foreach (@leftresult) {
1154                 if ($rightresult =~ "$_;") {
1155                     $finalresult .= "$_;$_;";
1156                 }
1157             }
1158             return $finalresult;
1159         } elsif ($operand eq ' or ') {
1160             # just merge the 2 strings
1161             return $leftresult.$rightresult;
1162         } elsif ($operand eq ' not ') {
1163             my @leftresult = split /;/, $leftresult;
1164 #             my @rightresult = split /;/,$leftresult;
1165             my $finalresult;
1166             foreach (@leftresult) {
1167                 unless ($rightresult =~ "$_;") {
1168                     $finalresult .= "$_;";
1169                 }
1170             }
1171             return $finalresult;
1172         } else {
1173             # this error is impossible, because of the regexp that isolate the operand, but just in case...
1174             die "error : operand unknown : $operand for $string";
1175         }
1176     # it's a leaf, do the real SQL query and return the result
1177     } else {
1178         $string =~  s/__X__/"$commacontent"/ if $commacontent;
1179         $string =~ s/-|\.|\?|,|;|!|'|\(|\)|\[|\]|{|}|"|<|>|&|\+|\*|\// /g;
1180 #         warn "leaf : $string\n";
1181         # parse the string in in operator/operand/value again
1182         $string =~ /(.*)(=|>|>=|<|<=)(.*)/;
1183         my $left = $1;
1184         my $operator = $2;
1185         my $right = $3;
1186         my $results;
1187         # automatic replace for short operators
1188         $left='title' if $left eq 'ti';
1189         $left='author' if $left eq 'au';
1190         $left='publisher' if $left eq 'pb';
1191         $left='subject' if $left eq 'su';
1192         $left='koha-Auth-Number' if $left eq 'an';
1193         $left='keyword' if $left eq 'kw';
1194         if ($operator) {
1195             #do a specific search
1196             my $dbh = C4::Context->dbh;
1197             $operator='LIKE' if $operator eq '=' and $right=~ /%/;
1198             my $sth = $dbh->prepare("SELECT biblionumbers FROM nozebra WHERE server=? AND indexname=? AND value $operator ?");
1199             # warn "$left / $operator / $right\n";
1200             # split each word, query the DB and build the biblionumbers result
1201             foreach (split / /,$right) {
1202                 my $biblionumbers;
1203                 next unless $_;
1204 #                 warn "EXECUTE : $server, $left, $_";
1205                 $sth->execute($server, $left, $_);
1206                 while (my $line = $sth->fetchrow) {
1207                     $biblionumbers .= $line;
1208 #                     warn "result : $line";
1209                 }
1210                 # do a AND with existing list if there is one, otherwise, use the biblionumbers list as 1st result list
1211                 if ($results) {
1212                     my @leftresult = split /;/, $biblionumbers;
1213                     my $temp;
1214                     foreach (@leftresult) {
1215                         if ($results =~ "$_;") {
1216                             $temp .= "$_;$_;";
1217                         }
1218                     }
1219                     $results = $temp;
1220                 } else {
1221                     $results = $biblionumbers;
1222                 }
1223             }
1224         } else {
1225             #do a complete search (all indexes)
1226             my $dbh = C4::Context->dbh;
1227             my $sth = $dbh->prepare("SELECT biblionumbers FROM nozebra WHERE server=? AND value LIKE ?");
1228             # split each word, query the DB and build the biblionumbers result
1229             foreach (split / /,$string) {
1230                 next if C4::Context->stopwords->{uc($_)}; # skip if stopword
1231                 #warn "search on all indexes on $_";
1232                 my $biblionumbers;
1233                 next unless $_;
1234                 $sth->execute($server, $_);
1235                 while (my $line = $sth->fetchrow) {
1236                     $biblionumbers .= $line;
1237                 }
1238                 # do a AND with existing list if there is one, otherwise, use the biblionumbers list as 1st result list
1239                 if ($results) {
1240                     my @leftresult = split /;/, $biblionumbers;
1241                     my $temp;
1242                     foreach (@leftresult) {
1243                         if ($results =~ "$_;") {
1244                             $temp .= "$_;$_;";
1245                         }
1246                     }
1247                     $results = $temp;
1248                 } else {
1249                     $results = $biblionumbers;
1250                 }
1251             }
1252         }
1253 #         warn "return : $results for LEAF : $string";
1254         return $results;
1255     }
1256 }
1257
1258 =head2 NZorder
1259
1260   $finalresult = NZorder($biblionumbers, $ordering,$results_per_page,$offset);
1261
1262   TODO :: Description
1263
1264 =cut
1265
1266
1267 sub NZorder {
1268     my ($biblionumbers, $ordering,$results_per_page,$offset) = @_;
1269     # order title asc by default
1270 #     $ordering = '1=36 <i' unless $ordering;
1271     $results_per_page=20 unless $results_per_page;
1272     $offset = 0 unless $offset;
1273     my $dbh = C4::Context->dbh;
1274     #
1275     # order by POPULARITY
1276     #
1277     if ($ordering =~ /1=9523/) {
1278         my %result;
1279         my %popularity;
1280         # popularity is not in MARC record, it's builded from a specific query
1281         my $sth = $dbh->prepare("select sum(issues) from items where biblionumber=?");
1282         foreach (split /;/,$biblionumbers) {
1283             my ($biblionumber,$title) = split /,/,$_;
1284             $result{$biblionumber}=GetMarcBiblio($biblionumber);
1285             $sth->execute($biblionumber);
1286             my $popularity= $sth->fetchrow ||0;
1287             # hint : the key is popularity.title because we can have
1288             # many results with the same popularity. In this cas, sub-ordering is done by title
1289             # we also have biblionumber to avoid bug for 2 biblios with the same title & popularity
1290             # (un-frequent, I agree, but we won't forget anything that way ;-)
1291             $popularity{sprintf("%10d",$popularity).$title.$biblionumber} = $biblionumber;
1292         }
1293         # sort the hash and return the same structure as GetRecords (Zebra querying)
1294         my $result_hash;
1295         my $numbers=0;
1296         if ($ordering eq '1=9523 >i') { # sort popularity DESC
1297             foreach my $key (sort {$b cmp $a} (keys %popularity)) {
1298                 $result_hash->{'RECORDS'}[$numbers++] = $result{$popularity{$key}}->as_usmarc();
1299             }
1300         } else { # sort popularity ASC
1301             foreach my $key (sort (keys %popularity)) {
1302                 $result_hash->{'RECORDS'}[$numbers++] = $result{$popularity{$key}}->as_usmarc();
1303             }
1304         }
1305         my $finalresult=();
1306         $result_hash->{'hits'} = $numbers;
1307         $finalresult->{'biblioserver'} = $result_hash;
1308         return $finalresult;
1309     #
1310     # ORDER BY author
1311     #
1312     } elsif ($ordering eq '1=1003 <i'){
1313         my %result;
1314         foreach (split /;/,$biblionumbers) {
1315             my ($biblionumber,$title) = split /,/,$_;
1316             my $record=GetMarcBiblio($biblionumber);
1317             my $author;
1318             if (C4::Context->preference('marcflavour') eq 'UNIMARC') {
1319                 $author=$record->subfield('200','f');
1320                 $author=$record->subfield('700','a') unless $author;
1321             } else {
1322                 $author=$record->subfield('100','a');
1323             }
1324             # hint : the result is sorted by title.biblionumber because we can have X biblios with the same title
1325             # and we don't want to get only 1 result for each of them !!!
1326             $result{$author.$biblionumber}=$record;
1327         }
1328         # sort the hash and return the same structure as GetRecords (Zebra querying)
1329         my $result_hash;
1330         my $numbers=0;
1331         if ($ordering eq '1=1003 <i') { # sort by author desc
1332             foreach my $key (sort (keys %result)) {
1333                 $result_hash->{'RECORDS'}[$numbers++] = $result{$key}->as_usmarc();
1334             }
1335         } else { # sort by author ASC
1336             foreach my $key (sort { $a cmp $b } (keys %result)) {
1337                 $result_hash->{'RECORDS'}[$numbers++] = $result{$key}->as_usmarc();
1338             }
1339         }
1340         my $finalresult=();
1341         $result_hash->{'hits'} = $numbers;
1342         $finalresult->{'biblioserver'} = $result_hash;
1343         return $finalresult;
1344     #
1345     # ORDER BY callnumber
1346     #
1347     } elsif ($ordering eq '1=20 <i'){
1348         my %result;
1349         foreach (split /;/,$biblionumbers) {
1350             my ($biblionumber,$title) = split /,/,$_;
1351             my $record=GetMarcBiblio($biblionumber);
1352             my $callnumber;
1353             my ($callnumber_tag,$callnumber_subfield)=GetMarcFromKohaField($dbh,'items.itemcallnumber');
1354             ($callnumber_tag,$callnumber_subfield)= GetMarcFromKohaField('biblioitems.callnumber') unless $callnumber_tag;
1355             if (C4::Context->preference('marcflavour') eq 'UNIMARC') {
1356                 $callnumber=$record->subfield('200','f');
1357             } else {
1358                 $callnumber=$record->subfield('100','a');
1359             }
1360             # hint : the result is sorted by title.biblionumber because we can have X biblios with the same title
1361             # and we don't want to get only 1 result for each of them !!!
1362             $result{$callnumber.$biblionumber}=$record;
1363         }
1364         # sort the hash and return the same structure as GetRecords (Zebra querying)
1365         my $result_hash;
1366         my $numbers=0;
1367         if ($ordering eq '1=1003 <i') { # sort by title desc
1368             foreach my $key (sort (keys %result)) {
1369                 $result_hash->{'RECORDS'}[$numbers++] = $result{$key}->as_usmarc();
1370             }
1371         } else { # sort by title ASC
1372             foreach my $key (sort { $a cmp $b } (keys %result)) {
1373                 $result_hash->{'RECORDS'}[$numbers++] = $result{$key}->as_usmarc();
1374             }
1375         }
1376         my $finalresult=();
1377         $result_hash->{'hits'} = $numbers;
1378         $finalresult->{'biblioserver'} = $result_hash;
1379         return $finalresult;
1380     } elsif ($ordering =~ /1=31/){ #pub year
1381         my %result;
1382         foreach (split /;/,$biblionumbers) {
1383             my ($biblionumber,$title) = split /,/,$_;
1384             my $record=GetMarcBiblio($biblionumber);
1385             my ($publicationyear_tag,$publicationyear_subfield)=GetMarcFromKohaField($dbh,'biblioitems.publicationyear');
1386             my $publicationyear=$record->subfield($publicationyear_tag,$publicationyear_subfield);
1387             # hint : the result is sorted by title.biblionumber because we can have X biblios with the same title
1388             # and we don't want to get only 1 result for each of them !!!
1389             $result{$publicationyear.$biblionumber}=$record;
1390         }
1391         # sort the hash and return the same structure as GetRecords (Zebra querying)
1392         my $result_hash;
1393         my $numbers=0;
1394         if ($ordering eq '1=31 <i') { # sort by pubyear desc
1395             foreach my $key (sort (keys %result)) {
1396                 $result_hash->{'RECORDS'}[$numbers++] = $result{$key}->as_usmarc();
1397             }
1398         } else { # sort by pub year ASC
1399             foreach my $key (sort { $b cmp $a } (keys %result)) {
1400                 $result_hash->{'RECORDS'}[$numbers++] = $result{$key}->as_usmarc();
1401             }
1402         }
1403         my $finalresult=();
1404         $result_hash->{'hits'} = $numbers;
1405         $finalresult->{'biblioserver'} = $result_hash;
1406         return $finalresult;
1407     #
1408     # ORDER BY title
1409     #
1410     } elsif ($ordering =~ /1=4/) {
1411         # the title is in the biblionumbers string, so we just need to build a hash, sort it and return
1412         my %result;
1413         foreach (split /;/,$biblionumbers) {
1414             my ($biblionumber,$title) = split /,/,$_;
1415             # hint : the result is sorted by title.biblionumber because we can have X biblios with the same title
1416             # and we don't want to get only 1 result for each of them !!!
1417             # hint & speed improvement : we can order without reading the record
1418             # so order, and read records only for the requested page !
1419             $result{$title.$biblionumber}=$biblionumber;
1420         }
1421         # sort the hash and return the same structure as GetRecords (Zebra querying)
1422         my $result_hash;
1423         my $numbers=0;
1424         if ($ordering eq '1=4 <i') { # sort by title desc
1425             foreach my $key (sort (keys %result)) {
1426                 $result_hash->{'RECORDS'}[$numbers++] = $result{$key};
1427             }
1428         } else { # sort by title ASC
1429             foreach my $key (sort { $b cmp $a } (keys %result)) {
1430                 $result_hash->{'RECORDS'}[$numbers++] = $result{$key};
1431             }
1432         }
1433         # limit the $results_per_page to result size if it's more
1434         $results_per_page = $numbers-1 if $numbers < $results_per_page;
1435         # for the requested page, replace biblionumber by the complete record
1436         # speed improvement : avoid reading too much things
1437         for (my $counter=$offset;$counter<=$offset+$results_per_page;$counter++) {
1438             $result_hash->{'RECORDS'}[$counter] = GetMarcBiblio($result_hash->{'RECORDS'}[$counter])->as_usmarc;
1439         }
1440         my $finalresult=();
1441         $result_hash->{'hits'} = $numbers;
1442         $finalresult->{'biblioserver'} = $result_hash;
1443         return $finalresult;
1444     } else {
1445     #
1446     # order by ranking
1447     #
1448         # we need 2 hashes to order by ranking : the 1st one to count the ranking, the 2nd to order by ranking
1449         my %result;
1450         my %count_ranking;
1451         foreach (split /;/,$biblionumbers) {
1452             my ($biblionumber,$title) = split /,/,$_;
1453             $title =~ /(.*)-(\d)/;
1454             # get weight
1455             my $ranking =$2;
1456             # note that we + the ranking because ranking is calculated on weight of EACH term requested.
1457             # if we ask for "two towers", and "two" has weight 2 in biblio N, and "towers" has weight 4 in biblio N
1458             # biblio N has ranking = 6
1459             $count_ranking{$biblionumber} += $ranking;
1460         }
1461         # build the result by "inverting" the count_ranking hash
1462         # 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
1463 #         warn "counting";
1464         foreach (keys %count_ranking) {
1465             $result{sprintf("%10d",$count_ranking{$_}).'-'.$_} = $_;
1466         }
1467         # sort the hash and return the same structure as GetRecords (Zebra querying)
1468         my $result_hash;
1469         my $numbers=0;
1470             foreach my $key (sort {$b cmp $a} (keys %result)) {
1471                 $result_hash->{'RECORDS'}[$numbers++] = $result{$key};
1472             }
1473         # limit the $results_per_page to result size if it's more
1474         $results_per_page = $numbers-1 if $numbers < $results_per_page;
1475         # for the requested page, replace biblionumber by the complete record
1476         # speed improvement : avoid reading too much things
1477         for (my $counter=$offset;$counter<=$offset+$results_per_page;$counter++) {
1478             $result_hash->{'RECORDS'}[$counter] = GetMarcBiblio($result_hash->{'RECORDS'}[$counter])->as_usmarc;
1479         }
1480         my $finalresult=();
1481         $result_hash->{'hits'} = $numbers;
1482         $finalresult->{'biblioserver'} = $result_hash;
1483         return $finalresult;
1484     }
1485 }
1486 =head2 ModBiblios
1487
1488 ($countchanged,$listunchanged) = ModBiblios($listbiblios, $tagsubfield,$initvalue,$targetvalue,$test);
1489
1490 this function changes all the values $initvalue in subfield $tag$subfield in any record in $listbiblios
1491 test parameter if set donot perform change to records in database.
1492
1493 =over 2
1494
1495 =item C<input arg:>
1496
1497     * $listbiblios is an array ref to marcrecords to be changed
1498     * $tagsubfield is the reference of the subfield to change.
1499     * $initvalue is the value to search the record for
1500     * $targetvalue is the value to set the subfield to
1501     * $test is to be set only not to perform changes in database.
1502
1503 =item C<Output arg:>
1504     * $countchanged counts all the changes performed.
1505     * $listunchanged contains the list of all the biblionumbers of records unchanged.
1506
1507 =item C<usage in the script:>
1508
1509 =back
1510
1511 my ($countchanged, $listunchanged) = EditBiblios($results->{RECORD}, $tagsubfield,$initvalue,$targetvalue);;
1512 #If one wants to display unchanged records, you should get biblios foreach @$listunchanged
1513 $template->param(countchanged => $countchanged, loopunchanged=>$listunchanged);
1514
1515 =cut
1516
1517 sub ModBiblios{
1518   my ($listbiblios,$tagsubfield,$initvalue,$targetvalue,$test)=@_;
1519   my $countmatched;
1520   my @unmatched;
1521   my ($tag,$subfield)=($1,$2) if ($tagsubfield=~/^(\d{1,3})([a-z0-9A-Z@])?$/);
1522   if ((length($tag)<3)&& $subfield=~/0-9/){
1523     $tag=$tag.$subfield;
1524     undef $subfield;
1525   }
1526   my ($bntag,$bnsubf) = GetMarcFromKohaField('biblio.biblionumber');
1527   my ($itemtag,$itemsubf) = GetMarcFromKohaField('items.itemnumber');
1528   foreach my $usmarc (@$listbiblios){
1529     my $record;
1530     $record=eval{MARC::Record->new_from_usmarc($usmarc)};
1531     my $biblionumber;
1532     if ($@){
1533       # usmarc is not a valid usmarc May be a biblionumber
1534       if ($tag eq $itemtag){
1535         my $bib=GetBiblioFromItemNumber($usmarc);
1536         $record=GetMarcItem($bib->{'biblionumber'},$usmarc) ;
1537         $biblionumber=$bib->{'biblionumber'};
1538       } else {
1539         $record=GetMarcBiblio($usmarc);
1540         $biblionumber=$usmarc;
1541       }
1542     }  else {
1543       if ($bntag >= 010){
1544         $biblionumber = $record->subfield($bntag,$bnsubf);
1545       }else {
1546         $biblionumber=$record->field($bntag)->data;
1547       }
1548     }
1549     #GetBiblionumber is to be written.
1550     #Could be replaced by TransformMarcToKoha (But Would be longer)
1551     if ($record->field($tag)){
1552       my $modify=0;
1553       foreach my $field ($record->field($tag)){
1554         if ($subfield){
1555           if ($field->delete_subfield('code' =>$subfield,'match'=>qr($initvalue))){
1556             $countmatched++;
1557             $modify=1;
1558             $field->update($subfield,$targetvalue) if ($targetvalue);
1559           }
1560         } else {
1561           if ($tag >= 010){
1562             if ($field->delete_field($field)){
1563               $countmatched++;
1564               $modify=1;
1565             }
1566           } else {
1567             $field->data=$targetvalue if ($field->data=~qr($initvalue));
1568           }
1569         }
1570       }
1571 #       warn $record->as_formatted;
1572       if ($modify){
1573         ModBiblio($record,$biblionumber,GetFrameworkCode($biblionumber)) unless ($test);
1574       } else {
1575         push @unmatched, $biblionumber;
1576       }
1577     } else {
1578       push @unmatched, $biblionumber;
1579     }
1580   }
1581   return ($countmatched,\@unmatched);
1582 }
1583
1584 END { }    # module clean-up code here (global destructor)
1585
1586 1;
1587 __END__
1588
1589 =head1 AUTHOR
1590
1591 Koha Developement team <info@koha.org>
1592
1593 =cut