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
 967                 #FIXME: is there a better way to do this?
 968                 $oldbiblio->{'title'} =~ s/$term/<span class=term>$&<\/span>/gi;
 969                 $oldbiblio->{'subtitle'} =~
 970                   s/$term/<span class=term>$&<\/span>/gi;
 971
 972                 $oldbiblio->{'author'} =~ s/$term/<span class=term>$&<\/span>/gi;
 973                 $oldbiblio->{'publishercode'} =~ s/$term/<span class=term>$&<\/span>/gi;
 974                 $oldbiblio->{'place'} =~ s/$term/<span class=term>$&<\/span>/gi;
 975                 $oldbiblio->{'pages'} =~ s/$term/<span class=term>$&<\/span>/gi;
 976                 $oldbiblio->{'notes'} =~ s/$term/<span class=term>$&<\/span>/gi;
 977                 $oldbiblio->{'size'}  =~ s/$term/<span class=term>$&<\/span>/gi;
 978             }
 979         }
 980
 981         if ( $i % 2 ) {
 982             $toggle = "#ffffcc";
 983         }
 984         else {
 985             $toggle = "white";
 986         }
 987         $oldbiblio->{'toggle'} = $toggle;
 988         my @fields = $marcrecord->field($itemtag);
 989         my @items_loop;
 990         my $items;
 991         my $ordered_count     = 0;
 992         my $onloan_count      = 0;
 993         my $wthdrawn_count    = 0;
 994         my $itemlost_count    = 0;
 995         my $norequests        = 1;
 996
 997         #
 998         # check the loan status of the item :
 999         # it is not stored in the MARC record, for pref (zebra reindexing)
1000         # reason. Thus, we have to get the status from a specific SQL query
1001         #
1002         my $sth_issue = $dbh->prepare("
1003             SELECT date_due,returndate
1004             FROM issues
1005             WHERE itemnumber=? AND returndate IS NULL");
1006         my $items_count=scalar(@fields);
1007         foreach my $field (@fields) {
1008             my $item;
1009             foreach my $code ( keys %subfieldstosearch ) {
1010                 $item->{$code} = $field->subfield( $subfieldstosearch{$code} );
1011             }
1012             $sth_issue->execute($item->{itemnumber});
1013             $item->{due_date} = format_date($sth_issue->fetchrow);
1014             $item->{onloan} = 1 if $item->{due_date};
1015             # at least one item can be reserved : suppose no
1016             $norequests = 1;
1017             if ( $item->{wthdrawn} ) {
1018                 $wthdrawn_count++;
1019                 $items->{ $item->{'homebranch'}.'--'.$item->{'itemcallnumber'} }->{unavailable}=1;
1020                 $items->{ $item->{'homebranch'}.'--'.$item->{'itemcallnumber'} }->{wthdrawn}=1;
1021             }
1022             elsif ( $item->{itemlost} ) {
1023                 $itemlost_count++;
1024                 $items->{ $item->{'homebranch'}.'--'.$item->{'itemcallnumber'} }->{unavailable}=1;
1025                 $items->{ $item->{'homebranch'}.'--'.$item->{'itemcallnumber'} }->{itemlost}=1;
1026             }
1027             unless ( $item->{notforloan}) {
1028                 # OK, this one can be issued, so at least one can be reserved
1029                 $norequests = 0;
1030             }
1031             if ( ( $item->{onloan} ) && ( $item->{onloan} != '0000-00-00' ) )
1032             {
1033                 $items->{ $item->{'homebranch'}.'--'.$item->{'itemcallnumber'} }->{unavailable}=1;
1034                 $items->{ $item->{'homebranch'}.'--'.$item->{'itemcallnumber'} }->{onloancount} = 1;
1035                 $items->{ $item->{'homebranch'}.'--'.$item->{'itemcallnumber'} }->{due_date} = $item->{due_date};
1036                 $onloan_count++;
1037             }
1038             if ( $item->{'homebranch'} ) {
1039                 $items->{ $item->{'homebranch'}.'--'.$item->{'itemcallnumber'} }->{count}++;
1040             }
1041
1042             # Last resort
1043             elsif ( $item->{'holdingbranch'} ) {
1044                 $items->{ $item->{'holdingbranch'} }->{count}++;
1045             }
1046             $items->{ $item->{'homebranch'}.'--'.$item->{'itemcallnumber'} }->{itemcallnumber} =                $item->{itemcallnumber};
1047             $items->{ $item->{'homebranch'}.'--'.$item->{'itemcallnumber'} }->{location} =                $item->{location};
1048             $items->{ $item->{'homebranch'}.'--'.$item->{'itemcallnumber'} }->{branchcode} =               $item->{homebranch};
1049         }    # notforloan, item level and biblioitem level
1050
1051         # last check for norequest : if itemtype is notforloan, it can't be reserved either, whatever the items
1052         $norequests = 1 if $itemtypes{$oldbiblio->{itemtype}}->{notforloan};
1053
1054         for my $key ( sort keys %$items ) {
1055             my $this_item = {
1056                 branchname     => $branches{$items->{$key}->{branchcode}},
1057                 branchcode     => $items->{$key}->{branchcode},
1058                 count          => $items->{$key}->{count}==1 ?"":$items->{$key}->{count},
1059                 itemcallnumber => $items->{$key}->{itemcallnumber},
1060                 location => $items->{$key}->{location},
1061                 onloancount      => $items->{$key}->{onloancount},
1062                 due_date         => $items->{$key}->{due_date},
1063                 wthdrawn      => $items->{$key}->{wthdrawn},
1064                 lost         => $items->{$key}->{itemlost},
1065             };
1066             push @items_loop, $this_item;
1067         }
1068         $oldbiblio->{norequests}    = $norequests;
1069         $oldbiblio->{items_count}    = $items_count;
1070         $oldbiblio->{items_loop}    = \@items_loop;
1071         $oldbiblio->{onloancount}   = $onloan_count;
1072         $oldbiblio->{wthdrawncount} = $wthdrawn_count;
1073         $oldbiblio->{itemlostcount} = $itemlost_count;
1074         $oldbiblio->{orderedcount}  = $ordered_count;
1075         $oldbiblio->{isbn}          =~ s/-//g; # deleting - in isbn to enable amazon content
1076         push( @newresults, $oldbiblio );
1077     }
1078     return @newresults;
1079 }
1080
1081
1082
1083 #----------------------------------------------------------------------
1084 #
1085 # Non-Zebra GetRecords#
1086 #----------------------------------------------------------------------
1087
1088 =head2 NZgetRecords
1089
1090   NZgetRecords has the same API as zera getRecords, even if some parameters are not managed
1091
1092 =cut
1093
1094 sub NZgetRecords {
1095     my (
1096         $koha_query,     $federated_query,  $sort_by_ref,
1097         $servers_ref,    $results_per_page, $offset,
1098         $expanded_facet, $branches,         $query_type,
1099         $scan
1100     ) = @_;
1101     my $result = NZanalyse($koha_query);
1102     return (undef,NZorder($result,@$sort_by_ref[0],$results_per_page,$offset),undef);
1103 }
1104
1105 =head2 NZanalyse
1106
1107   NZanalyse : get a CQL string as parameter, and returns a list of biblionumber;title,biblionumber;title,...
1108   the list is builded from inverted index in nozebra SQL table
1109   note that title is here only for convenience : the sorting will be very fast when requested on title
1110   if the sorting is requested on something else, we will have to reread all results, and that may be longer.
1111
1112 =cut
1113
1114 sub NZanalyse {
1115     my ($string,$server) = @_;
1116     # $server contains biblioserver or authorities, depending on what we search on.
1117     #warn "querying : $string on $server";
1118     $server='biblioserver' unless $server;
1119     # if we have a ", replace the content to discard temporarily any and/or/not inside
1120     my $commacontent;
1121     if ($string =~/"/) {
1122         $string =~ s/"(.*?)"/__X__/;
1123         $commacontent = $1;
1124 #         print "commacontent : $commacontent\n";
1125     }
1126     # split the query string in 3 parts : X AND Y means : $left="X", $operand="AND" and $right="Y"
1127     # then, call again NZanalyse with $left and $right
1128     # (recursive until we find a leaf (=> something without and/or/not)
1129     $string =~ /(.*)( and | or | not | AND | OR | NOT )(.*)/;
1130     my $left = $1;
1131     my $right = $3;
1132     my $operand = lc($2);
1133     # it's not a leaf, we have a and/or/not
1134     if ($operand) {
1135         # reintroduce comma content if needed
1136         $right =~ s/__X__/"$commacontent"/ if $commacontent;
1137         $left =~ s/__X__/"$commacontent"/ if $commacontent;
1138 #         warn "node : $left / $operand / $right\n";
1139         my $leftresult = NZanalyse($left,$server);
1140         my $rightresult = NZanalyse($right,$server);
1141         # OK, we have the results for right and left part of the query
1142         # depending of operand, intersect, union or exclude both lists
1143         # to get a result list
1144         if ($operand eq ' and ') {
1145             my @leftresult = split /;/, $leftresult;
1146 #             my @rightresult = split /;/,$leftresult;
1147             my $finalresult;
1148             # parse the left results, and if the biblionumber exist in the right result, save it in finalresult
1149             # the result is stored twice, to have the same weight for AND than OR.
1150             # example : TWO : 61,61,64,121 (two is twice in the biblio #61) / TOWER : 61,64,130
1151             # result : 61,61,61,61,64,64 for two AND tower : 61 has more weight than 64
1152             foreach (@leftresult) {
1153                 if ($rightresult =~ "$_;") {
1154                     $finalresult .= "$_;$_;";
1155                 }
1156             }
1157             return $finalresult;
1158         } elsif ($operand eq ' or ') {
1159             # just merge the 2 strings
1160             return $leftresult.$rightresult;
1161         } elsif ($operand eq ' not ') {
1162             my @leftresult = split /;/, $leftresult;
1163 #             my @rightresult = split /;/,$leftresult;
1164             my $finalresult;
1165             foreach (@leftresult) {
1166                 unless ($rightresult =~ "$_;") {
1167                     $finalresult .= "$_;";
1168                 }
1169             }
1170             return $finalresult;
1171         } else {
1172             # this error is impossible, because of the regexp that isolate the operand, but just in case...
1173             die "error : operand unknown : $operand for $string";
1174         }
1175     # it's a leaf, do the real SQL query and return the result
1176     } else {
1177         $string =~  s/__X__/"$commacontent"/ if $commacontent;
1178         $string =~ s/-|\.|\?|,|;|!|'|\(|\)|\[|\]|{|}|"|<|>|&|\+|\*|\// /g;
1179 #         warn "leaf : $string\n";
1180         # parse the string in in operator/operand/value again
1181         $string =~ /(.*)(=|>|>=|<|<=)(.*)/;
1182         my $left = $1;
1183         my $operator = $2;
1184         my $right = $3;
1185         my $results;
1186         # automatic replace for short operators
1187         $left='title' if $left eq 'ti';
1188         $left='author' if $left eq 'au';
1189         $left='publisher' if $left eq 'pb';
1190         $left='subject' if $left eq 'su';
1191         $left='koha-Auth-Number' if $left eq 'an';
1192         $left='keyword' if $left eq 'kw';
1193         if ($operator) {
1194             #do a specific search
1195             my $dbh = C4::Context->dbh;
1196             $operator='LIKE' if $operator eq '=' and $right=~ /%/;
1197             my $sth = $dbh->prepare("SELECT biblionumbers FROM nozebra WHERE server=? AND indexname=? AND value $operator ?");
1198             # warn "$left / $operator / $right\n";
1199             # split each word, query the DB and build the biblionumbers result
1200             foreach (split / /,$right) {
1201                 my $biblionumbers;
1202                 next unless $_;
1203 #                 warn "EXECUTE : $server, $left, $_";
1204                 $sth->execute($server, $left, $_);
1205                 while (my $line = $sth->fetchrow) {
1206                     $biblionumbers .= $line;
1207 #                     warn "result : $line";
1208                 }
1209                 # do a AND with existing list if there is one, otherwise, use the biblionumbers list as 1st result list
1210                 if ($results) {
1211                     my @leftresult = split /;/, $biblionumbers;
1212                     my $temp;
1213                     foreach (@leftresult) {
1214                         if ($results =~ "$_;") {
1215                             $temp .= "$_;$_;";
1216                         }
1217                     }
1218                     $results = $temp;
1219                 } else {
1220                     $results = $biblionumbers;
1221                 }
1222             }
1223         } else {
1224             #do a complete search (all indexes)
1225             my $dbh = C4::Context->dbh;
1226             my $sth = $dbh->prepare("SELECT biblionumbers FROM nozebra WHERE server=? AND value LIKE ?");
1227             # split each word, query the DB and build the biblionumbers result
1228             foreach (split / /,$string) {
1229                 next if C4::Context->stopwords->{uc($_)}; # skip if stopword
1230                 #warn "search on all indexes on $_";
1231                 my $biblionumbers;
1232                 next unless $_;
1233                 $sth->execute($server, $_);
1234                 while (my $line = $sth->fetchrow) {
1235                     $biblionumbers .= $line;
1236                 }
1237                 # do a AND with existing list if there is one, otherwise, use the biblionumbers list as 1st result list
1238                 if ($results) {
1239                     my @leftresult = split /;/, $biblionumbers;
1240                     my $temp;
1241                     foreach (@leftresult) {
1242                         if ($results =~ "$_;") {
1243                             $temp .= "$_;$_;";
1244                         }
1245                     }
1246                     $results = $temp;
1247                 } else {
1248                     $results = $biblionumbers;
1249                 }
1250             }
1251         }
1252 #         warn "return : $results for LEAF : $string";
1253         return $results;
1254     }
1255 }
1256
1257 =head2 NZorder
1258
1259   $finalresult = NZorder($biblionumbers, $ordering,$results_per_page,$offset);
1260
1261   TODO :: Description
1262
1263 =cut
1264
1265
1266 sub NZorder {
1267     my ($biblionumbers, $ordering,$results_per_page,$offset) = @_;
1268     # order title asc by default
1269 #     $ordering = '1=36 <i' unless $ordering;
1270     $results_per_page=20 unless $results_per_page;
1271     $offset = 0 unless $offset;
1272     my $dbh = C4::Context->dbh;
1273     #
1274     # order by POPULARITY
1275     #
1276     if ($ordering =~ /1=9523/) {
1277         my %result;
1278         my %popularity;
1279         # popularity is not in MARC record, it's builded from a specific query
1280         my $sth = $dbh->prepare("select sum(issues) from items where biblionumber=?");
1281         foreach (split /;/,$biblionumbers) {
1282             my ($biblionumber,$title) = split /,/,$_;
1283             $result{$biblionumber}=GetMarcBiblio($biblionumber);
1284             $sth->execute($biblionumber);
1285             my $popularity= $sth->fetchrow ||0;
1286             # hint : the key is popularity.title because we can have
1287             # many results with the same popularity. In this cas, sub-ordering is done by title
1288             # we also have biblionumber to avoid bug for 2 biblios with the same title & popularity
1289             # (un-frequent, I agree, but we won't forget anything that way ;-)
1290             $popularity{sprintf("%10d",$popularity).$title.$biblionumber} = $biblionumber;
1291         }
1292         # sort the hash and return the same structure as GetRecords (Zebra querying)
1293         my $result_hash;
1294         my $numbers=0;
1295         if ($ordering eq '1=9523 >i') { # sort popularity DESC
1296             foreach my $key (sort {$b cmp $a} (keys %popularity)) {
1297                 $result_hash->{'RECORDS'}[$numbers++] = $result{$popularity{$key}}->as_usmarc();
1298             }
1299         } else { # sort popularity ASC
1300             foreach my $key (sort (keys %popularity)) {
1301                 $result_hash->{'RECORDS'}[$numbers++] = $result{$popularity{$key}}->as_usmarc();
1302             }
1303         }
1304         my $finalresult=();
1305         $result_hash->{'hits'} = $numbers;
1306         $finalresult->{'biblioserver'} = $result_hash;
1307         return $finalresult;
1308     #
1309     # ORDER BY author
1310     #
1311     } elsif ($ordering eq '1=1003 <i'){
1312         my %result;
1313         foreach (split /;/,$biblionumbers) {
1314             my ($biblionumber,$title) = split /,/,$_;
1315             my $record=GetMarcBiblio($biblionumber);
1316             my $author;
1317             if (C4::Context->preference('marcflavour') eq 'UNIMARC') {
1318                 $author=$record->subfield('200','f');
1319                 $author=$record->subfield('700','a') unless $author;
1320             } else {
1321                 $author=$record->subfield('100','a');
1322             }
1323             # hint : the result is sorted by title.biblionumber because we can have X biblios with the same title
1324             # and we don't want to get only 1 result for each of them !!!
1325             $result{$author.$biblionumber}=$record;
1326         }
1327         # sort the hash and return the same structure as GetRecords (Zebra querying)
1328         my $result_hash;
1329         my $numbers=0;
1330         if ($ordering eq '1=1003 <i') { # sort by author desc
1331             foreach my $key (sort (keys %result)) {
1332                 $result_hash->{'RECORDS'}[$numbers++] = $result{$key}->as_usmarc();
1333             }
1334         } else { # sort by author ASC
1335             foreach my $key (sort { $a cmp $b } (keys %result)) {
1336                 $result_hash->{'RECORDS'}[$numbers++] = $result{$key}->as_usmarc();
1337             }
1338         }
1339         my $finalresult=();
1340         $result_hash->{'hits'} = $numbers;
1341         $finalresult->{'biblioserver'} = $result_hash;
1342         return $finalresult;
1343     #
1344     # ORDER BY callnumber
1345     #
1346     } elsif ($ordering eq '1=20 <i'){
1347         my %result;
1348         foreach (split /;/,$biblionumbers) {
1349             my ($biblionumber,$title) = split /,/,$_;
1350             my $record=GetMarcBiblio($biblionumber);
1351             my $callnumber;
1352             my ($callnumber_tag,$callnumber_subfield)=GetMarcFromKohaField($dbh,'items.itemcallnumber');
1353             ($callnumber_tag,$callnumber_subfield)= GetMarcFromKohaField('biblioitems.callnumber') unless $callnumber_tag;
1354             if (C4::Context->preference('marcflavour') eq 'UNIMARC') {
1355                 $callnumber=$record->subfield('200','f');
1356             } else {
1357                 $callnumber=$record->subfield('100','a');
1358             }
1359             # hint : the result is sorted by title.biblionumber because we can have X biblios with the same title
1360             # and we don't want to get only 1 result for each of them !!!
1361             $result{$callnumber.$biblionumber}=$record;
1362         }
1363         # sort the hash and return the same structure as GetRecords (Zebra querying)
1364         my $result_hash;
1365         my $numbers=0;
1366         if ($ordering eq '1=1003 <i') { # sort by title desc
1367             foreach my $key (sort (keys %result)) {
1368                 $result_hash->{'RECORDS'}[$numbers++] = $result{$key}->as_usmarc();
1369             }
1370         } else { # sort by title ASC
1371             foreach my $key (sort { $a cmp $b } (keys %result)) {
1372                 $result_hash->{'RECORDS'}[$numbers++] = $result{$key}->as_usmarc();
1373             }
1374         }
1375         my $finalresult=();
1376         $result_hash->{'hits'} = $numbers;
1377         $finalresult->{'biblioserver'} = $result_hash;
1378         return $finalresult;
1379     } elsif ($ordering =~ /1=31/){ #pub year
1380         my %result;
1381         foreach (split /;/,$biblionumbers) {
1382             my ($biblionumber,$title) = split /,/,$_;
1383             my $record=GetMarcBiblio($biblionumber);
1384             my ($publicationyear_tag,$publicationyear_subfield)=GetMarcFromKohaField($dbh,'biblioitems.publicationyear');
1385             my $publicationyear=$record->subfield($publicationyear_tag,$publicationyear_subfield);
1386             # hint : the result is sorted by title.biblionumber because we can have X biblios with the same title
1387             # and we don't want to get only 1 result for each of them !!!
1388             $result{$publicationyear.$biblionumber}=$record;
1389         }
1390         # sort the hash and return the same structure as GetRecords (Zebra querying)
1391         my $result_hash;
1392         my $numbers=0;
1393         if ($ordering eq '1=31 <i') { # sort by pubyear desc
1394             foreach my $key (sort (keys %result)) {
1395                 $result_hash->{'RECORDS'}[$numbers++] = $result{$key}->as_usmarc();
1396             }
1397         } else { # sort by pub year ASC
1398             foreach my $key (sort { $b cmp $a } (keys %result)) {
1399                 $result_hash->{'RECORDS'}[$numbers++] = $result{$key}->as_usmarc();
1400             }
1401         }
1402         my $finalresult=();
1403         $result_hash->{'hits'} = $numbers;
1404         $finalresult->{'biblioserver'} = $result_hash;
1405         return $finalresult;
1406     #
1407     # ORDER BY title
1408     #
1409     } elsif ($ordering =~ /1=4/) {
1410         # the title is in the biblionumbers string, so we just need to build a hash, sort it and return
1411         my %result;
1412         foreach (split /;/,$biblionumbers) {
1413             my ($biblionumber,$title) = split /,/,$_;
1414             # hint : the result is sorted by title.biblionumber because we can have X biblios with the same title
1415             # and we don't want to get only 1 result for each of them !!!
1416             # hint & speed improvement : we can order without reading the record
1417             # so order, and read records only for the requested page !
1418             $result{$title.$biblionumber}=$biblionumber;
1419         }
1420         # sort the hash and return the same structure as GetRecords (Zebra querying)
1421         my $result_hash;
1422         my $numbers=0;
1423         if ($ordering eq '1=4 <i') { # sort by title desc
1424             foreach my $key (sort (keys %result)) {
1425                 $result_hash->{'RECORDS'}[$numbers++] = $result{$key};
1426             }
1427         } else { # sort by title ASC
1428             foreach my $key (sort { $b cmp $a } (keys %result)) {
1429                 $result_hash->{'RECORDS'}[$numbers++] = $result{$key};
1430             }
1431         }
1432         # limit the $results_per_page to result size if it's more
1433         $results_per_page = $numbers-1 if $numbers < $results_per_page;
1434         # for the requested page, replace biblionumber by the complete record
1435         # speed improvement : avoid reading too much things
1436         for (my $counter=$offset;$counter<=$offset+$results_per_page;$counter++) {
1437             $result_hash->{'RECORDS'}[$counter] = GetMarcBiblio($result_hash->{'RECORDS'}[$counter])->as_usmarc;
1438         }
1439         my $finalresult=();
1440         $result_hash->{'hits'} = $numbers;
1441         $finalresult->{'biblioserver'} = $result_hash;
1442         return $finalresult;
1443     } else {
1444     #
1445     # order by ranking
1446     #
1447         # we need 2 hashes to order by ranking : the 1st one to count the ranking, the 2nd to order by ranking
1448         my %result;
1449         my %count_ranking;
1450         foreach (split /;/,$biblionumbers) {
1451             my ($biblionumber,$title) = split /,/,$_;
1452             $title =~ /(.*)-(\d)/;
1453             # get weight
1454             my $ranking =$2;
1455             # note that we + the ranking because ranking is calculated on weight of EACH term requested.
1456             # if we ask for "two towers", and "two" has weight 2 in biblio N, and "towers" has weight 4 in biblio N
1457             # biblio N has ranking = 6
1458             $count_ranking{$biblionumber} += $ranking;
1459         }
1460         # build the result by "inverting" the count_ranking hash
1461         # 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
1462 #         warn "counting";
1463         foreach (keys %count_ranking) {
1464             $result{sprintf("%10d",$count_ranking{$_}).'-'.$_} = $_;
1465         }
1466         # sort the hash and return the same structure as GetRecords (Zebra querying)
1467         my $result_hash;
1468         my $numbers=0;
1469             foreach my $key (sort {$b cmp $a} (keys %result)) {
1470                 $result_hash->{'RECORDS'}[$numbers++] = $result{$key};
1471             }
1472         # limit the $results_per_page to result size if it's more
1473         $results_per_page = $numbers-1 if $numbers < $results_per_page;
1474         # for the requested page, replace biblionumber by the complete record
1475         # speed improvement : avoid reading too much things
1476         for (my $counter=$offset;$counter<=$offset+$results_per_page;$counter++) {
1477             $result_hash->{'RECORDS'}[$counter] = GetMarcBiblio($result_hash->{'RECORDS'}[$counter])->as_usmarc;
1478         }
1479         my $finalresult=();
1480         $result_hash->{'hits'} = $numbers;
1481         $finalresult->{'biblioserver'} = $result_hash;
1482         return $finalresult;
1483     }
1484 }
1485 =head2 ModBiblios
1486
1487 ($countchanged,$listunchanged) = ModBiblios($listbiblios, $tagsubfield,$initvalue,$targetvalue,$test);
1488
1489 this function changes all the values $initvalue in subfield $tag$subfield in any record in $listbiblios
1490 test parameter if set donot perform change to records in database.
1491
1492 =over 2
1493
1494 =item C<input arg:>
1495
1496     * $listbiblios is an array ref to marcrecords to be changed
1497     * $tagsubfield is the reference of the subfield to change.
1498     * $initvalue is the value to search the record for
1499     * $targetvalue is the value to set the subfield to
1500     * $test is to be set only not to perform changes in database.
1501
1502 =item C<Output arg:>
1503     * $countchanged counts all the changes performed.
1504     * $listunchanged contains the list of all the biblionumbers of records unchanged.
1505
1506 =item C<usage in the script:>
1507
1508 =back
1509
1510 my ($countchanged, $listunchanged) = EditBiblios($results->{RECORD}, $tagsubfield,$initvalue,$targetvalue);;
1511 #If one wants to display unchanged records, you should get biblios foreach @$listunchanged
1512 $template->param(countchanged => $countchanged, loopunchanged=>$listunchanged);
1513
1514 =cut
1515
1516 sub ModBiblios{
1517   my ($listbiblios,$tagsubfield,$initvalue,$targetvalue,$test)=@_;
1518   my $countmatched;
1519   my @unmatched;
1520   my ($tag,$subfield)=($1,$2) if ($tagsubfield=~/^(\d{1,3})([a-z0-9A-Z@])?$/);
1521   if ((length($tag)<3)&& $subfield=~/0-9/){
1522     $tag=$tag.$subfield;
1523     undef $subfield;
1524   }
1525   my ($bntag,$bnsubf) = GetMarcFromKohaField('biblio.biblionumber');
1526   my ($itemtag,$itemsubf) = GetMarcFromKohaField('items.itemnumber');
1527   foreach my $usmarc (@$listbiblios){
1528     my $record;
1529     $record=eval{MARC::Record->new_from_usmarc($usmarc)};
1530     my $biblionumber;
1531     if ($@){
1532       # usmarc is not a valid usmarc May be a biblionumber
1533       if ($tag eq $itemtag){
1534         my $bib=GetBiblioFromItemNumber($usmarc);
1535         $record=GetMarcItem($bib->{'biblionumber'},$usmarc) ;
1536         $biblionumber=$bib->{'biblionumber'};
1537       } else {
1538         $record=GetMarcBiblio($usmarc);
1539         $biblionumber=$usmarc;
1540       }
1541     }  else {
1542       if ($bntag >= 010){
1543         $biblionumber = $record->subfield($bntag,$bnsubf);
1544       }else {
1545         $biblionumber=$record->field($bntag)->data;
1546       }
1547     }
1548     #GetBiblionumber is to be written.
1549     #Could be replaced by TransformMarcToKoha (But Would be longer)
1550     if ($record->field($tag)){
1551       my $modify=0;
1552       foreach my $field ($record->field($tag)){
1553         if ($subfield){
1554           if ($field->delete_subfield('code' =>$subfield,'match'=>qr($initvalue))){
1555             $countmatched++;
1556             $modify=1;
1557             $field->update($subfield,$targetvalue) if ($targetvalue);
1558           }
1559         } else {
1560           if ($tag >= 010){
1561             if ($field->delete_field($field)){
1562               $countmatched++;
1563               $modify=1;
1564             }
1565           } else {
1566             $field->data=$targetvalue if ($field->data=~qr($initvalue));
1567           }
1568         }
1569       }
1570 #       warn $record->as_formatted;
1571       if ($modify){
1572         ModBiblio($record,$biblionumber,GetFrameworkCode($biblionumber)) unless ($test);
1573       } else {
1574         push @unmatched, $biblionumber;
1575       }
1576     } else {
1577       push @unmatched, $biblionumber;
1578     }
1579   }
1580   return ($countmatched,\@unmatched);
1581 }
1582
1583 END { }    # module clean-up code here (global destructor)
1584
1585 1;
1586 __END__
1587
1588 =head1 AUTHOR
1589
1590 Koha Developement team <info@koha.org>
1591
1592 =cut