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