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
 413                  # here we create a minimal MARC record and hand it off to the
 414                  # template just like a normal result ... perhaps not ideal, but
 415                  # it works for now
 416                         my $tmprecord = MARC::Record->new();
 417                         $tmprecord->encoding('UTF-8');
 418                         my $tmptitle;
 419
 420           # srote the minimal record in author/title (depending on MARC flavour)
 421                         if ( C4::Context->preference("marcflavour") eq
 422                             "UNIMARC" )
 423                         {
 424                             $tmptitle = MARC::Field->new(
 425                                 '200', ' ', ' ',
 426                                 a => $term,
 427                                 f => $occ
 428                             );
 429                         }
 430                         else {
 431                             $tmptitle = MARC::Field->new(
 432                                 '245', ' ', ' ',
 433                                 a => $term,
 434                                 b => $occ
 435                             );
 436                         }
 437                         $tmprecord->append_fields($tmptitle);
 438                         $results_hash->{'RECORDS'}[$j] =
 439                           $tmprecord->as_usmarc();
 440                     }
 441                     else {
 442                         $record = $results[ $i - 1 ]->record($j)->raw();
 443
 444                         #warn "RECORD $j:".$record;
 445                         $results_hash->{'RECORDS'}[$j] =
 446                           $record;    # making a reference to a hash
 447                                       # Fill the facets while we're looping
 448                         $facet_record = MARC::Record->new_from_usmarc($record);
 449
 450                         #warn $servers[$i-1].$facet_record->title();
 451                         for ( my $k = 0 ; $k <= @$facets ; $k++ ) {
 452                             if ( $facets->[$k] ) {
 453                                 my @fields;
 454                                 for my $tag ( @{ $facets->[$k]->{'tags'} } ) {
 455                                     push @fields, $facet_record->field($tag);
 456                                 }
 457                                 for my $field (@fields) {
 458                                     my @subfields = $field->subfields();
 459                                     for my $subfield (@subfields) {
 460                                         my ( $code, $data ) = @$subfield;
 461                                         if ( $code eq
 462                                             $facets->[$k]->{'subfield'} )
 463                                         {
 464                                             $facets_counter->{ $facets->[$k]
 465                                                   ->{'link_value'} }->{$data}++;
 466                                         }
 467                                     }
 468                                 }
 469                                 $facets_info->{ $facets->[$k]->{'link_value'} }
 470                                   ->{'label_value'} =
 471                                   $facets->[$k]->{'label_value'};
 472                                 $facets_info->{ $facets->[$k]->{'link_value'} }
 473                                   ->{'expanded'} = $facets->[$k]->{'expanded'};
 474                             }
 475                         }
 476                     }
 477                 }
 478                 $results_hashref->{ $servers[ $i - 1 ] } = $results_hash;
 479             }
 480
 481             #print "connection ", $i-1, ": $size hits";
 482             #print $results[$i-1]->record(0)->render() if $size > 0;
 483             # BUILD FACETS
 484             for my $link_value (
 485                 sort { $facets_counter->{$b} <=> $facets_counter->{$a} }
 486                 keys %$facets_counter
 487               )
 488             {
 489                 my $expandable;
 490                 my $number_of_facets;
 491                 my @this_facets_array;
 492                 for my $one_facet (
 493                     sort {
 494                         $facets_counter->{$link_value}
 495                           ->{$b} <=> $facets_counter->{$link_value}->{$a}
 496                     } keys %{ $facets_counter->{$link_value} }
 497                   )
 498                 {
 499                     $number_of_facets++;
 500                     if (   ( $number_of_facets < 6 )
 501                         || ( $expanded_facet eq $link_value )
 502                         || ( $facets_info->{$link_value}->{'expanded'} ) )
 503                     {
 504
 505                        # sanitize the link value ), ( will cause errors with CCL
 506                         my $facet_link_value = $one_facet;
 507                         $facet_link_value =~ s/(\(|\))/ /g;
 508
 509                         # fix the length that will display in the label
 510                         my $facet_label_value = $one_facet;
 511                         $facet_label_value = substr( $one_facet, 0, 20 ) . "..."
 512                           unless length($facet_label_value) <= 20;
 513
 514                        # well, if it's a branch, label by the name, not the code
 515                         if ( $link_value =~ /branch/ ) {
 516                             $facet_label_value =
 517                               $branches->{$one_facet}->{'branchname'};
 518                         }
 519
 520                  # but we're down with the whole label being in the link's title
 521                         my $facet_title_value = $one_facet;
 522
 523                         push @this_facets_array,
 524                           (
 525                             {
 526                                 facet_count =>
 527                                   $facets_counter->{$link_value}->{$one_facet},
 528                                 facet_label_value => $facet_label_value,
 529                                 facet_title_value => $facet_title_value,
 530                                 facet_link_value  => $facet_link_value,
 531                                 type_link_value   => $link_value,
 532                             },
 533                           );
 534                     }
 535                 }
 536                 unless ( $facets_info->{$link_value}->{'expanded'} ) {
 537                     $expandable = 1
 538                       if ( ( $number_of_facets > 6 )
 539                         && ( $expanded_facet ne $link_value ) );
 540                 }
 541                 push @facets_loop,
 542                   (
 543                     {
 544                         type_link_value => $link_value,
 545                         type_id         => $link_value . "_id",
 546                         type_label      =>
 547                           $facets_info->{$link_value}->{'label_value'},
 548                         facets     => \@this_facets_array,
 549                         expandable => $expandable,
 550                         expand     => $link_value,
 551                     }
 552                   );
 553             }
 554         }
 555     }
 556     return ( undef, $results_hashref, \@facets_loop );
 557 }
 558
 559 # STOPWORDS
 560 sub _remove_stopwords {
 561     my ($operand,$index) = @_;
 562     # phrase and exact-qualified indexes shoudln't have stopwords removed
 563     if ($index!~m/phr|ext/){
 564     # remove stopwords from operand : parse all stopwords & remove them (case insensitive)
 565     #       we use IsAlpha unicode definition, to deal correctly with diacritics.
 566     #       otherwise, a french word like "leçon" woudl be split into "le" "çon", le
 567     #       is an empty word, we get "çon" and wouldn't find anything...
 568         foreach (keys %{C4::Context->stopwords}) {
 569             next if ($_ =~/(and|or|not)/); # don't remove operators
 570             $operand=~ s/\P{IsAlpha}$_\P{IsAlpha}/ /i;
 571             $operand=~ s/^$_\P{IsAlpha}/ /i;
 572             $operand=~ s/\P{IsAlpha}$_$/ /i;
 573         }
 574     }
 575     return $operand;
 576 }
 577
 578 # TRUNCATION
 579 sub _detect_truncation {
 580     my ($operand,$index) = @_;
 581     my (@nontruncated,@righttruncated,@lefttruncated,@rightlefttruncated,@regexpr);
 582     $operand =~s/^ //g;
 583     my @wordlist= split (/\s/,$operand);
 584     foreach my $word (@wordlist){
 585         if ($word=~s/^\*([^\*]+)\*$/$1/){
 586             push @rightlefttruncated,$word;
 587         }
 588         elsif($word=~s/^\*([^\*]+)$/$1/){
 589             push @lefttruncated,$word;
 590         }
 591         elsif ($word=~s/^([^\*]+)\*$/$1/){
 592             push @righttruncated,$word;
 593         }
 594         elsif (index($word,"*")<0){
 595             push @nontruncated,$word;
 596         }
 597         else {
 598             push @regexpr,$word;
 599         }
 600     }
 601     return (\@nontruncated,\@righttruncated,\@lefttruncated,\@rightlefttruncated,\@regexpr);
 602 }
 603
 604 sub _build_stemmed_operand {
 605     my ($operand) = @_;
 606     my $stemmed_operand;
 607     # FIXME: the locale should be set based on the user's language and/or search choice
 608     my $stemmer = Lingua::Stem->new( -locale => 'EN-US' );
 609     # FIXME: these should be stored in the db so the librarian can modify the behavior
 610     $stemmer->add_exceptions(
 611             {
 612                 'and' => 'and',
 613                 'or'  => 'or',
 614                 'not' => 'not',
 615             }
 616
 617         );
 618     my @words = split( / /, $operand );
 619     my $stems = $stemmer->stem(@words);
 620     for my $stem (@$stems) {
 621             $stemmed_operand .= "$stem";
 622             $stemmed_operand .= "?" unless ( $stem =~ /(and$|or$|not$)/ ) || ( length($stem) < 3 );
 623             $stemmed_operand .= " ";
 624     }
 625     #warn "STEMMED OPERAND: $stemmed_operand";
 626     return $stemmed_operand;
 627 }
 628
 629 sub _build_weighted_query {
 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 ($operand,$stemmed_operand,$index) = @_;
 633     my $stemming      = C4::Context->preference("QueryStemming")     || 0;
 634     my $weight_fields = C4::Context->preference("QueryWeightFields") || 0;
 635     my $fuzzy_enabled = C4::Context->preference("QueryFuzzy") || 0;
 636
 637     my $weighted_query .= "(rk=(";     # Specifies that we're applying rank
 638
 639     # Keyword, or, no index specified
 640     if ( ( $index eq 'kw' ) || ( !$index ) ) {
 641         $weighted_query .= "Title-cover,ext,r1=\"$operand\"";       # exact title-cover
 642         $weighted_query .= " or ti,ext,r2=\"$operand\"";            # exact title
 643         $weighted_query .= " or ti,phr,r3=\"$operand\"";            # phrase title
 644        #$weighted_query .= " or any,ext,r4=$operand";               # exact any
 645        #$weighted_query .=" or kw,wrdl,r5=\"$operand\"";            # word list any
 646         $weighted_query .= " or wrd,fuzzy,r8=\"$operand\"" if $fuzzy_enabled; # add fuzzy, word list
 647         $weighted_query .= " or wrd,right-Truncation,r9=\"$stemmed_operand\"" if ($stemming and $stemmed_operand); # add stemming, right truncation
 648        # embedded sorting: 0 a-z; 1 z-a
 649        # $weighted_query .= ") or (sort1,aut=1";
 650     }
 651     # if the index already has more than one qualifier, just wrap the operand
 652     # in quotes and pass it back
 653     elsif ($index =~ ',') {
 654         $weighted_query .=" $index=\"$operand\"";
 655     }
 656     #TODO: build better cases based on specific search indexes
 657     else {
 658        $weighted_query .= " $index,ext,r1=\"$operand\"";            # exact index
 659        #$weighted_query .= " or (title-sort-az=0 or $index,startswithnt,st-word,r3=$operand #)";
 660        $weighted_query .= " or $index,phr,r3=\"$operand\"";         # phrase index
 661        $weighted_query .= " or $index,rt,wrd,r3=\"$operand\"";      # word list index
 662     }
 663     $weighted_query .= "))";    # close rank specification
 664     return $weighted_query;
 665 }
 666
 667 # build the query itself
 668 sub buildQuery {
 669     my ( $operators, $operands, $indexes, $limits, $sort_by ) = @_;
 670
 671     my @operators = @$operators if $operators;
 672     my @indexes   = @$indexes   if $indexes;
 673     my @operands  = @$operands  if $operands;
 674     my @limits    = @$limits    if $limits;
 675     my @sort_by   = @$sort_by   if $sort_by;
 676
 677     my $stemming      = C4::Context->preference("QueryStemming")     || 0;
 678     my $weight_fields = C4::Context->preference("QueryWeightFields") || 0;
 679     my $fuzzy_enabled = C4::Context->preference("QueryFuzzy") || 0;
 680
 681     my $query = $operands[0];
 682         my $simple_query = $operands[0];
 683         my $query_cgi;
 684         my $query_search_desc;
 685
 686         my $limit;
 687         my $limit_cgi;
 688         my $limit_desc;
 689
 690 # STEP I: determine if this is a form-based / simple query or if it's complex (if complex,
 691 # pass it off to zebra directly)
 692
 693 # check if this is a known query language query, if it is, return immediately,
 694 # the user is responsible for constructing valid syntax:
 695     if ( $query =~ /^ccl=/ ) {
 696         return ( undef, $', $', $', '', '', '', 'ccl' );
 697     }
 698     if ( $query =~ /^cql=/ ) {
 699         return ( undef, $', $', $', '', '', '', 'cql' );
 700     }
 701     if ( $query =~ /^pqf=/ ) {
 702         return ( undef, $', $', $', '', '', '', 'pqf' );
 703     }
 704
 705 # FIXME: this is bound to be broken now
 706     if ( $query =~ /(\(|\)|:|=)/ ) {    # sorry, too complex, assume CCL
 707         return ( undef, $query, $query_cgi, $query_search_desc, $limit, $limit_cgi, $limit_desc, 'ccl' );
 708     }
 709
 710 # form-based queries are limited to non-nested at a specific depth, so we can easily
 711 # modify the incoming query operands and indexes to do stemming and field weighting
 712 # Once we do so, we'll end up with a value in $query, just like if we had an
 713 # incoming $query from the user
 714     else {
 715         $query = ""; # clear it out so we can populate properly with field-weighted stemmed query
 716         my $previous_operand;    # a flag used to keep track if there was a previous query
 717                                 # if there was, we can apply the current operator
 718         # for every operand
 719         for ( my $i = 0 ; $i <= @operands ; $i++ ) {
 720
 721             # COMBINE OPERANDS, INDEXES AND OPERATORS
 722             if ( $operands[$i] ) {
 723                 my $operand = $operands[$i];
 724                 my $index   = $indexes[$i];
 725
 726                 # if there's no index, don't use one, it will throw a CCL error
 727                 my $index_plus = "$index:" if $index;
 728                 my $index_plus_comma="$index," if $index;
 729
 730                 # Remove Stopwords
 731                 $operand = _remove_stopwords($operand,$index);
 732                 warn "OPERAND w/out STOPWORDS: >$operand<" if $DEBUG;
 733
 734                 my $indexes_set;
 735
 736                 # Detect Truncation
 737                 my ($nontruncated,$righttruncated,$lefttruncated,$rightlefttruncated,$regexpr);
 738                 my $truncated_operand;
 739                 ($nontruncated,$righttruncated,$lefttruncated,$rightlefttruncated,$regexpr) = _detect_truncation($operand,$index);
 740                 warn "TRUNCATION: NON:>@$nontruncated< RIGHT:>@$righttruncated< LEFT:>@$lefttruncated< RIGHTLEFT:>@$rightlefttruncated< REGEX:>@$regexpr<" if $DEBUG;
 741                 # Apply Truncation
 742                 # Problem is when build_weights gets ahold if this is wraps in quotes which breaks the truncation :/
 743                 if (scalar(@$righttruncated)+scalar(@$lefttruncated)+scalar(@$rightlefttruncated)>0){
 744                     $indexes_set = 1;
 745                     undef $weight_fields;
 746                     my $previous_truncation_operand;
 747                     if (scalar(@$nontruncated)>0) {
 748                         $truncated_operand.= "$index_plus @$nontruncated ";
 749                         $previous_truncation_operand = 1;
 750                     }
 751                     if (scalar(@$righttruncated)>0){
 752                         $truncated_operand .= "and " if $previous_truncation_operand;
 753                         $truncated_operand .= "$index_plus_comma"."rtrn:@$righttruncated ";
 754                         $previous_truncation_operand = 1;
 755                     }
 756                     if (scalar(@$lefttruncated)>0){
 757                         $truncated_operand .= "and " if $previous_truncation_operand;
 758                         $truncated_operand .= "$index_plus_comma"."ltrn:@$lefttruncated ";
 759                         $previous_truncation_operand = 1;
 760                     }
 761                     if (scalar(@$rightlefttruncated)>0){
 762                         $truncated_operand .= "and " if $previous_truncation_operand;
 763                         $truncated_operand .= "$index_plus_comma"."rltrn:@$rightlefttruncated ";
 764                         $previous_truncation_operand = 1;
 765                     }
 766                 }
 767                 $operand = $truncated_operand if $truncated_operand;
 768                 warn "TRUNCATED OPERAND: >$truncated_operand<" if $DEBUG;
 769
 770                 # Handle Stemming
 771                 my $stemmed_operand;
 772                 $stemmed_operand = _build_stemmed_operand($operand) if $stemming;
 773                 warn "STEMMED OPERAND: >$stemmed_operand<" if $DEBUG;
 774
 775                 # Handle Field Weighting
 776                 my $weighted_operand;
 777                 $weighted_operand = _build_weighted_query($operand,$stemmed_operand,$index) if $weight_fields;
 778                 warn "FIELD WEIGHTED OPERAND: >$weighted_operand<" if $DEBUG;
 779                 $operand = $weighted_operand if $weight_fields;
 780                 $indexes_set = 1 if $weight_fields;
 781
 782                 # If there's a previous operand, we need to add an operator
 783                 if ($previous_operand) {
 784
 785                     # user-specified operator
 786                     if ( $operators[$i-1] ) {
 787                         $query .= " $operators[$i-1] ";
 788                         $query .= " $index_plus " unless $indexes_set;
 789                         $query .= " $operand";
 790                                                 $query_cgi .="";
 791                                                 $query_search_desc .=" $operators[$i-1] $index_plus $operands[$i]";
 792                     }
 793
 794                     # the default operator is and
 795                     else {
 796                         $query .= " and ";
 797                         $query .= "$index_plus " unless $indexes_set;
 798                         $query .= "$operand";
 799                                                 $query_cgi .="";
 800                         $query_search_desc .= " and $index_plus $operands[$i]";
 801                     }
 802                 }
 803
 804                 else {
 805                                         # field-weighted queries already have indexes set
 806                                         $query .=" $index_plus " unless $indexes_set;
 807                                         $query .= $operand;
 808                                         $query_search_desc .= " $index_plus $operands[$i]";
 809                                         $query_cgi.="";
 810
 811                     $previous_operand = 1;
 812                 }
 813             }    #/if $operands
 814         }    # /for
 815     }
 816     warn "QUERY BEFORE LIMITS: >$query<" if $DEBUG;
 817
 818     # add limits
 819     foreach my $this_limit (@limits) {
 820         if ( $this_limit =~ /available/ ) {
 821                         # FIXME: switch to zebra search for null values
 822             $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))";
 823                         $limit_cgi .= "&limit=available";
 824                         $limit_desc .="";
 825         }
 826                 # these are treated as OR
 827         elsif ( $this_limit =~ /mc/ ) {
 828             $limit .= " or $this_limit";
 829                         $limit_cgi .="&limit=$this_limit";
 830             $limit_desc .= " or $this_limit";
 831         }
 832                 else {
 833                         $limit .= " and $this_limit";
 834                         $limit_cgi .="&limit=$this_limit";
 835                         $limit_desc .=" and $this_limit";
 836                 }
 837     }
 838
 839         # normalize the strings
 840         for ($query, $query_search_desc, $limit, $limit_desc) {
 841                 $_ =~ s/  / /g;    # remove extra spaces
 842         $_ =~ s/^ //g;     # remove any beginning spaces
 843                 $_ =~ s/ $//g;     # remove any beginning spaces
 844         $_ =~ s/:/=/g;     # causes probs for server
 845         $_ =~ s/==/=/g;    # remove double == from query
 846
 847         }
 848
 849         # append the limit to the query
 850         $query .= $limit;
 851
 852     warn "QUERY:".$query if $DEBUG;
 853         warn "QUERY CGI:".$query_cgi if $DEBUG;
 854     warn "QUERY DESC:".$query_search_desc if $DEBUG;
 855     warn "LIMIT:".$limit if $DEBUG;
 856     warn "LIMIT CGI:".$limit_cgi if $DEBUG;
 857     warn "LIMIT DESC:".$limit_desc if $DEBUG;
 858
 859         return ( undef, $query,$simple_query,$query_cgi,$query_search_desc,$limit,$limit_cgi,$limit_desc );
 860 }
 861
 862 # IMO this subroutine is pretty messy still -- it's responsible for
 863 # building the HTML output for the template
 864 sub searchResults {
 865     my ( $searchdesc, $hits, $results_per_page, $offset, @marcresults ) = @_;
 866
 867     my $dbh = C4::Context->dbh;
 868     my $toggle;
 869     my $even = 1;
 870     my @newresults;
 871     my $span_terms_hashref;
 872     for my $span_term ( split( / /, $searchdesc ) ) {
 873         $span_term =~ s/(.*=|\)|\(|\+|\.)//g;
 874         $span_terms_hashref->{$span_term}++;
 875     }
 876
 877     #Build brancnames hash
 878     #find branchname
 879     #get branch information.....
 880     my %branches;
 881     my $bsth =
 882       $dbh->prepare("SELECT branchcode,branchname FROM branches")
 883       ;    # FIXME : use C4::Koha::GetBranches
 884     $bsth->execute();
 885     while ( my $bdata = $bsth->fetchrow_hashref ) {
 886         $branches{ $bdata->{'branchcode'} } = $bdata->{'branchname'};
 887     }
 888
 889     #Build itemtype hash
 890     #find itemtype & itemtype image
 891     my %itemtypes;
 892     $bsth =
 893       $dbh->prepare("SELECT itemtype,description,imageurl,summary,notforloan FROM itemtypes");
 894     $bsth->execute();
 895     while ( my $bdata = $bsth->fetchrow_hashref ) {
 896         $itemtypes{ $bdata->{'itemtype'} }->{description} =
 897           $bdata->{'description'};
 898         $itemtypes{ $bdata->{'itemtype'} }->{imageurl} = $bdata->{'imageurl'};
 899         $itemtypes{ $bdata->{'itemtype'} }->{summary} = $bdata->{'summary'};
 900         $itemtypes{ $bdata->{'itemtype'} }->{notforloan} = $bdata->{'notforloan'};
 901     }
 902
 903     #search item field code
 904     my $sth =
 905       $dbh->prepare(
 906 "select tagfield from marc_subfield_structure where kohafield like 'items.itemnumber'"
 907       );
 908     $sth->execute;
 909     my ($itemtag) = $sth->fetchrow;
 910
 911     ## find column names of items related to MARC
 912     my $sth2 = $dbh->prepare("SHOW COLUMNS from items");
 913     $sth2->execute;
 914     my %subfieldstosearch;
 915     while ( ( my $column ) = $sth2->fetchrow ) {
 916         my ( $tagfield, $tagsubfield ) =
 917           &GetMarcFromKohaField( "items." . $column, "" );
 918         $subfieldstosearch{$column} = $tagsubfield;
 919     }
 920     my $times;
 921
 922     if ( $hits && $offset + $results_per_page <= $hits ) {
 923         $times = $offset + $results_per_page;
 924     }
 925     else {
 926         $times = $hits;
 927     }
 928
 929     for ( my $i = $offset ; $i <= $times - 1 ; $i++ ) {
 930         my $marcrecord;
 931         $marcrecord = MARC::File::USMARC::decode( $marcresults[$i] );
 932         my $oldbiblio = TransformMarcToKoha( $dbh, $marcrecord, '' );
 933         # add image url if there is one
 934         if ( $itemtypes{ $oldbiblio->{itemtype} }->{imageurl} =~ /^http:/ ) {
 935             $oldbiblio->{imageurl} =
 936               $itemtypes{ $oldbiblio->{itemtype} }->{imageurl};
 937             $oldbiblio->{description} =
 938               $itemtypes{ $oldbiblio->{itemtype} }->{description};
 939         }
 940         else {
 941             $oldbiblio->{imageurl} =
 942               getitemtypeimagesrc() . "/"
 943               . $itemtypes{ $oldbiblio->{itemtype} }->{imageurl}
 944               if ( $itemtypes{ $oldbiblio->{itemtype} }->{imageurl} );
 945             $oldbiblio->{description} =
 946               $itemtypes{ $oldbiblio->{itemtype} }->{description};
 947         }
 948         #
 949         # build summary if there is one (the summary is defined in itemtypes table
 950         #
 951         if ($itemtypes{ $oldbiblio->{itemtype} }->{summary}) {
 952             my $summary = $itemtypes{ $oldbiblio->{itemtype} }->{summary};
 953             my @fields = $marcrecord->fields();
 954             foreach my $field (@fields) {
 955                 my $tag = $field->tag();
 956                 my $tagvalue = $field->as_string();
 957                 $summary =~ s/\[(.?.?.?.?)$tag\*(.*?)]/$1$tagvalue$2\[$1$tag$2]/g;
 958                 unless ($tag<10) {
 959                     my @subf = $field->subfields;
 960                     for my $i (0..$#subf) {
 961                         my $subfieldcode = $subf[$i][0];
 962                         my $subfieldvalue = $subf[$i][1];
 963                         my $tagsubf = $tag.$subfieldcode;
 964                         $summary =~ s/\[(.?.?.?.?)$tagsubf(.*?)]/$1$subfieldvalue$2\[$1$tagsubf$2]/g;
 965                     }
 966                 }
 967             }
 968             $summary =~ s/\[(.*?)]//g;
 969             $summary =~ s/\n/<br>/g;
 970             $oldbiblio->{summary} = $summary;
 971         }
 972         # add spans to search term in results for search term highlighting
 973         foreach my $term ( keys %$span_terms_hashref ) {
 974             my $old_term = $term;
 975             if ( length($term) > 3 ) {
 976                 $term =~ s/(.*=|\)|\(|\+|\.|\?|\[|\])//g;
 977                 $term =~ s/\\//g;
 978                 $term =~ s/\*//g;
 979
 980                 #FIXME: is there a better way to do this?
 981                 $oldbiblio->{'title'} =~ s/$term/<span class=\"term\">$&<\/span>/gi;
 982                 $oldbiblio->{'subtitle'} =~
 983                   s/$term/<span class=\"term\">$&<\/span>/gi;
 984
 985                 $oldbiblio->{'author'} =~ s/$term/<span class=\"term\">$&<\/span>/gi;
 986                 $oldbiblio->{'publishercode'} =~ s/$term/<span class=\"term\">$&<\/span>/gi;
 987                 $oldbiblio->{'place'} =~ s/$term/<span class=\"term\">$&<\/span>/gi;
 988                 $oldbiblio->{'pages'} =~ s/$term/<span class=\"term\">$&<\/span>/gi;
 989                 $oldbiblio->{'notes'} =~ s/$term/<span class=\"term\">$&<\/span>/gi;
 990                 $oldbiblio->{'size'}  =~ s/$term/<span class=\"term\">$&<\/span>/gi;
 991             }
 992         }
 993
 994         if ( $i % 2 ) {
 995             $toggle = "#ffffcc";
 996         }
 997         else {
 998             $toggle = "white";
 999         }
1000         $oldbiblio->{'toggle'} = $toggle;
1001         my @fields = $marcrecord->field($itemtag);
1002         my @items_loop;
1003         my $items;
1004         my $ordered_count     = 0;
1005         my $onloan_count      = 0;
1006         my $wthdrawn_count    = 0;
1007         my $itemlost_count    = 0;
1008         my $norequests        = 1;
1009
1010         #
1011         # check the loan status of the item :
1012         # it is not stored in the MARC record, for pref (zebra reindexing)
1013         # reason. Thus, we have to get the status from a specific SQL query
1014         #
1015         my $sth_issue = $dbh->prepare("
1016             SELECT date_due,returndate
1017             FROM issues
1018             WHERE itemnumber=? AND returndate IS NULL");
1019         my $items_count=scalar(@fields);
1020         foreach my $field (@fields) {
1021             my $item;
1022             foreach my $code ( keys %subfieldstosearch ) {
1023                 $item->{$code} = $field->subfield( $subfieldstosearch{$code} );
1024             }
1025             $sth_issue->execute($item->{itemnumber});
1026             $item->{due_date} = format_date($sth_issue->fetchrow);
1027             $item->{onloan} = 1 if $item->{due_date};
1028             # at least one item can be reserved : suppose no
1029             $norequests = 1;
1030             if ( $item->{wthdrawn} ) {
1031                 $wthdrawn_count++;
1032                 $items->{ $item->{'homebranch'}.'--'.$item->{'itemcallnumber'} }->{unavailable}=1;
1033                 $items->{ $item->{'homebranch'}.'--'.$item->{'itemcallnumber'} }->{wthdrawn}=1;
1034             }
1035             elsif ( $item->{itemlost} ) {
1036                 $itemlost_count++;
1037                 $items->{ $item->{'homebranch'}.'--'.$item->{'itemcallnumber'} }->{unavailable}=1;
1038                 $items->{ $item->{'homebranch'}.'--'.$item->{'itemcallnumber'} }->{itemlost}=1;
1039             }
1040             unless ( $item->{notforloan}) {
1041                 # OK, this one can be issued, so at least one can be reserved
1042                 $norequests = 0;
1043             }
1044             if ( ( $item->{onloan} ) && ( $item->{onloan} != '0000-00-00' ) )
1045             {
1046                 $items->{ $item->{'homebranch'}.'--'.$item->{'itemcallnumber'} }->{unavailable}=1;
1047                 $items->{ $item->{'homebranch'}.'--'.$item->{'itemcallnumber'} }->{onloancount} = 1;
1048                 $items->{ $item->{'homebranch'}.'--'.$item->{'itemcallnumber'} }->{due_date} = $item->{due_date};
1049                 $onloan_count++;
1050             }
1051             if ( $item->{'homebranch'} ) {
1052                 $items->{ $item->{'homebranch'}.'--'.$item->{'itemcallnumber'} }->{count}++;
1053             }
1054
1055             # Last resort
1056             elsif ( $item->{'holdingbranch'} ) {
1057                 $items->{ $item->{'holdingbranch'} }->{count}++;
1058             }
1059             $items->{ $item->{'homebranch'}.'--'.$item->{'itemcallnumber'} }->{itemcallnumber} =                $item->{itemcallnumber};
1060             $items->{ $item->{'homebranch'}.'--'.$item->{'itemcallnumber'} }->{location} =                $item->{location};
1061             $items->{ $item->{'homebranch'}.'--'.$item->{'itemcallnumber'} }->{branchcode} =               $item->{homebranch};
1062         }    # notforloan, item level and biblioitem level
1063
1064         # last check for norequest : if itemtype is notforloan, it can't be reserved either, whatever the items
1065         $norequests = 1 if $itemtypes{$oldbiblio->{itemtype}}->{notforloan};
1066
1067         for my $key ( sort keys %$items ) {
1068             my $this_item = {
1069                 branchname     => $branches{$items->{$key}->{branchcode}},
1070                 branchcode     => $items->{$key}->{branchcode},
1071                 count          => $items->{$key}->{count},
1072                 itemcallnumber => $items->{$key}->{itemcallnumber},
1073                 location => $items->{$key}->{location},
1074                 onloancount      => $items->{$key}->{onloancount},
1075                 due_date         => $items->{$key}->{due_date},
1076                 wthdrawn      => $items->{$key}->{wthdrawn},
1077                 lost         => $items->{$key}->{itemlost},
1078             };
1079             push @items_loop, $this_item;
1080         }
1081         $oldbiblio->{norequests}    = $norequests;
1082         $oldbiblio->{items_count}    = $items_count;
1083         $oldbiblio->{items_loop}    = \@items_loop;
1084         $oldbiblio->{onloancount}   = $onloan_count;
1085         $oldbiblio->{wthdrawncount} = $wthdrawn_count;
1086         $oldbiblio->{itemlostcount} = $itemlost_count;
1087         $oldbiblio->{orderedcount}  = $ordered_count;
1088         $oldbiblio->{isbn}          =~ s/-//g; # deleting - in isbn to enable amazon content
1089         push( @newresults, $oldbiblio );
1090     }
1091     return @newresults;
1092 }
1093
1094
1095
1096 #----------------------------------------------------------------------
1097 #
1098 # Non-Zebra GetRecords#
1099 #----------------------------------------------------------------------
1100
1101 =head2 NZgetRecords
1102
1103   NZgetRecords has the same API as zera getRecords, even if some parameters are not managed
1104
1105 =cut
1106
1107 sub NZgetRecords {
1108     my (
1109         $koha_query,     $simple_query,  $sort_by_ref,
1110         $servers_ref,    $results_per_page, $offset,
1111         $expanded_facet, $branches,         $query_type,
1112         $scan
1113     ) = @_;
1114     my $result = NZanalyse($koha_query);
1115     return (undef,NZorder($result,@$sort_by_ref[0],$results_per_page,$offset),undef);
1116 }
1117
1118 =head2 NZanalyse
1119
1120   NZanalyse : get a CQL string as parameter, and returns a list of biblionumber;title,biblionumber;title,...
1121   the list is builded from inverted index in nozebra SQL table
1122   note that title is here only for convenience : the sorting will be very fast when requested on title
1123   if the sorting is requested on something else, we will have to reread all results, and that may be longer.
1124
1125 =cut
1126
1127 sub NZanalyse {
1128     my ($string,$server) = @_;
1129     # $server contains biblioserver or authorities, depending on what we search on.
1130     #warn "querying : $string on $server";
1131     $server='biblioserver' unless $server;
1132     # if we have a ", replace the content to discard temporarily any and/or/not inside
1133     my $commacontent;
1134     if ($string =~/"/) {
1135         $string =~ s/"(.*?)"/__X__/;
1136         $commacontent = $1;
1137 #         print "commacontent : $commacontent\n";
1138     }
1139     # split the query string in 3 parts : X AND Y means : $left="X", $operand="AND" and $right="Y"
1140     # then, call again NZanalyse with $left and $right
1141     # (recursive until we find a leaf (=> something without and/or/not)
1142     $string =~ /(.*)( and | or | not | AND | OR | NOT )(.*)/;
1143     my $left = $1;
1144     my $right = $3;
1145     my $operand = lc($2);
1146     # it's not a leaf, we have a and/or/not
1147     if ($operand) {
1148         # reintroduce comma content if needed
1149         $right =~ s/__X__/"$commacontent"/ if $commacontent;
1150         $left =~ s/__X__/"$commacontent"/ if $commacontent;
1151 #         warn "node : $left / $operand / $right\n";
1152         my $leftresult = NZanalyse($left,$server);
1153         my $rightresult = NZanalyse($right,$server);
1154         # OK, we have the results for right and left part of the query
1155         # depending of operand, intersect, union or exclude both lists
1156         # to get a result list
1157         if ($operand eq ' and ') {
1158             my @leftresult = split /;/, $leftresult;
1159 #             my @rightresult = split /;/,$leftresult;
1160             my $finalresult;
1161             # parse the left results, and if the biblionumber exist in the right result, save it in finalresult
1162             # the result is stored twice, to have the same weight for AND than OR.
1163             # example : TWO : 61,61,64,121 (two is twice in the biblio #61) / TOWER : 61,64,130
1164             # result : 61,61,61,61,64,64 for two AND tower : 61 has more weight than 64
1165             foreach (@leftresult) {
1166                 if ($rightresult =~ "$_;") {
1167                     $finalresult .= "$_;$_;";
1168                 }
1169             }
1170             return $finalresult;
1171         } elsif ($operand eq ' or ') {
1172             # just merge the 2 strings
1173             return $leftresult.$rightresult;
1174         } elsif ($operand eq ' not ') {
1175             my @leftresult = split /;/, $leftresult;
1176 #             my @rightresult = split /;/,$leftresult;
1177             my $finalresult;
1178             foreach (@leftresult) {
1179                 unless ($rightresult =~ "$_;") {
1180                     $finalresult .= "$_;";
1181                 }
1182             }
1183             return $finalresult;
1184         } else {
1185             # this error is impossible, because of the regexp that isolate the operand, but just in case...
1186             die "error : operand unknown : $operand for $string";
1187         }
1188     # it's a leaf, do the real SQL query and return the result
1189     } else {
1190         $string =~  s/__X__/"$commacontent"/ if $commacontent;
1191         $string =~ s/-|\.|\?|,|;|!|'|\(|\)|\[|\]|{|}|"|&|\+|\*|\// /g;
1192 #         warn "leaf : $string\n";
1193         # parse the string in in operator/operand/value again
1194         $string =~ /(.*)(>=|<=)(.*)/;
1195         my $left = $1;
1196         my $operator = $2;
1197         my $right = $3;
1198         unless ($operator) {
1199             $string =~ /(.*)(>|<|=)(.*)/;
1200             $left = $1;
1201             $operator = $2;
1202             $right = $3;
1203         }
1204         my $results;
1205         # automatic replace for short operators
1206         $left='title' if $left =~ '^ti';
1207         $left='author' if $left =~ '^au';
1208         $left='publisher' if $left =~ '^pb';
1209         $left='subject' if $left =~ '^su';
1210         $left='koha-Auth-Number' if $left =~ '^an';
1211         $left='keyword' if $left =~ '^kw';
1212         if ($operator) {
1213             #do a specific search
1214             my $dbh = C4::Context->dbh;
1215             $operator='LIKE' if $operator eq '=' and $right=~ /%/;
1216             my $sth = $dbh->prepare("SELECT biblionumbers,value FROM nozebra WHERE server=? AND indexname=? AND value $operator ?");
1217             warn "$left / $operator / $right\n";
1218             # split each word, query the DB and build the biblionumbers result
1219             foreach (split / /,$right) {
1220                 my ($biblionumbers,$value);
1221                 next unless $_;
1222                 warn "EXECUTE : $server, $left, $_";
1223                 $sth->execute($server, $left, $_);
1224                 while (my ($line,$value) = $sth->fetchrow) {
1225                     # if we are dealing with a numeric value, use only numeric results (in case of >=, <=, > or <)
1226                     # otherwise, fill the result
1227                     $biblionumbers .= $line unless ($right =~ /\d/ && $value =~ /\D/);
1228                     warn "result : $value ". ($right =~ /\d/) . "==".(!$value =~ /\d/) ;#= $line";
1229                 }
1230                 # do a AND with existing list if there is one, otherwise, use the biblionumbers list as 1st result list
1231                 if ($results) {
1232                     my @leftresult = split /;/, $biblionumbers;
1233                     my $temp;
1234                     foreach my $entry (@leftresult) { # $_ contains biblionumber,title-weight
1235                         # remove weight at the end
1236                         my $cleaned = $entry;
1237                         $cleaned =~ s/-\d*$//;
1238                         # if the entry already in the hash, take it & increase weight
1239 #                         warn "===== $cleaned =====";
1240                         if ($results =~ "$cleaned") {
1241                             $temp .= "$entry;$entry;";
1242 #                             warn "INCLUDING $entry";
1243                         }
1244                     }
1245                     $results = $temp;
1246                 } else {
1247                     $results = $biblionumbers;
1248                 }
1249             }
1250         } else {
1251             #do a complete search (all indexes)
1252             my $dbh = C4::Context->dbh;
1253             my $sth = $dbh->prepare("SELECT biblionumbers FROM nozebra WHERE server=? AND value LIKE ?");
1254             # split each word, query the DB and build the biblionumbers result
1255             foreach (split / /,$string) {
1256                 next if C4::Context->stopwords->{uc($_)}; # skip if stopword
1257                 #warn "search on all indexes on $_";
1258                 my $biblionumbers;
1259                 next unless $_;
1260                 $sth->execute($server, $_);
1261                 while (my $line = $sth->fetchrow) {
1262                     $biblionumbers .= $line;
1263                 }
1264                 # do a AND with existing list if there is one, otherwise, use the biblionumbers list as 1st result list
1265                 if ($results) {
1266 #                 warn "RES for $_ = $biblionumbers";
1267                     my @leftresult = split /;/, $biblionumbers;
1268                     my $temp;
1269                     foreach my $entry (@leftresult) { # $_ contains biblionumber,title-weight
1270                         # remove weight at the end
1271                         my $cleaned = $entry;
1272                         $cleaned =~ s/-\d*$//;
1273                         # if the entry already in the hash, take it & increase weight
1274 #                         warn "===== $cleaned =====";
1275                         if ($results =~ "$cleaned") {
1276                             $temp .= "$entry;$entry;";
1277 #                             warn "INCLUDING $entry";
1278                         }
1279                     }
1280                     $results = $temp;
1281                 } else {
1282 #                 warn "NEW RES for $_ = $biblionumbers";
1283                     $results = $biblionumbers;
1284                 }
1285             }
1286         }
1287 #         warn "return : $results for LEAF : $string";
1288         return $results;
1289     }
1290 }
1291
1292 =head2 NZorder
1293
1294   $finalresult = NZorder($biblionumbers, $ordering,$results_per_page,$offset);
1295
1296   TODO :: Description
1297
1298 =cut
1299
1300
1301 sub NZorder {
1302     my ($biblionumbers, $ordering,$results_per_page,$offset) = @_;
1303     # order title asc by default
1304 #     $ordering = '1=36 <i' unless $ordering;
1305     $results_per_page=20 unless $results_per_page;
1306     $offset = 0 unless $offset;
1307     my $dbh = C4::Context->dbh;
1308     #
1309     # order by POPULARITY
1310     #
1311     if ($ordering =~ /popularity/) {
1312         my %result;
1313         my %popularity;
1314         # popularity is not in MARC record, it's builded from a specific query
1315         my $sth = $dbh->prepare("select sum(issues) from items where biblionumber=?");
1316         foreach (split /;/,$biblionumbers) {
1317             my ($biblionumber,$title) = split /,/,$_;
1318             $result{$biblionumber}=GetMarcBiblio($biblionumber);
1319             $sth->execute($biblionumber);
1320             my $popularity= $sth->fetchrow ||0;
1321             # hint : the key is popularity.title because we can have
1322             # many results with the same popularity. In this cas, sub-ordering is done by title
1323             # we also have biblionumber to avoid bug for 2 biblios with the same title & popularity
1324             # (un-frequent, I agree, but we won't forget anything that way ;-)
1325             $popularity{sprintf("%10d",$popularity).$title.$biblionumber} = $biblionumber;
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 'popularity_dsc') { # sort popularity DESC
1331             foreach my $key (sort {$b cmp $a} (keys %popularity)) {
1332                 $result_hash->{'RECORDS'}[$numbers++] = $result{$popularity{$key}}->as_usmarc();
1333             }
1334         } else { # sort popularity ASC
1335             foreach my $key (sort (keys %popularity)) {
1336                 $result_hash->{'RECORDS'}[$numbers++] = $result{$popularity{$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 author
1345     #
1346     } elsif ($ordering =~/author/){
1347         my %result;
1348         foreach (split /;/,$biblionumbers) {
1349             my ($biblionumber,$title) = split /,/,$_;
1350             my $record=GetMarcBiblio($biblionumber);
1351             my $author;
1352             if (C4::Context->preference('marcflavour') eq 'UNIMARC') {
1353                 $author=$record->subfield('200','f');
1354                 $author=$record->subfield('700','a') unless $author;
1355             } else {
1356                 $author=$record->subfield('100','a');
1357             }
1358             # hint : the result is sorted by title.biblionumber because we can have X biblios with the same title
1359             # and we don't want to get only 1 result for each of them !!!
1360             $result{$author.$biblionumber}=$record;
1361         }
1362         # sort the hash and return the same structure as GetRecords (Zebra querying)
1363         my $result_hash;
1364         my $numbers=0;
1365         if ($ordering eq 'author_za') { # sort by author desc
1366             foreach my $key (sort { $b cmp $a } (keys %result)) {
1367                 $result_hash->{'RECORDS'}[$numbers++] = $result{$key}->as_usmarc();
1368             }
1369         } else { # sort by author ASC
1370             foreach my $key (sort (keys %result)) {
1371                 $result_hash->{'RECORDS'}[$numbers++] = $result{$key}->as_usmarc();
1372             }
1373         }
1374         my $finalresult=();
1375         $result_hash->{'hits'} = $numbers;
1376         $finalresult->{'biblioserver'} = $result_hash;
1377         return $finalresult;
1378     #
1379     # ORDER BY callnumber
1380     #
1381     } elsif ($ordering =~/callnumber/){
1382         my %result;
1383         foreach (split /;/,$biblionumbers) {
1384             my ($biblionumber,$title) = split /,/,$_;
1385             my $record=GetMarcBiblio($biblionumber);
1386             my $callnumber;
1387             my ($callnumber_tag,$callnumber_subfield)=GetMarcFromKohaField($dbh,'items.itemcallnumber');
1388             ($callnumber_tag,$callnumber_subfield)= GetMarcFromKohaField('biblioitems.callnumber') unless $callnumber_tag;
1389             if (C4::Context->preference('marcflavour') eq 'UNIMARC') {
1390                 $callnumber=$record->subfield('200','f');
1391             } else {
1392                 $callnumber=$record->subfield('100','a');
1393             }
1394             # hint : the result is sorted by title.biblionumber because we can have X biblios with the same title
1395             # and we don't want to get only 1 result for each of them !!!
1396             $result{$callnumber.$biblionumber}=$record;
1397         }
1398         # sort the hash and return the same structure as GetRecords (Zebra querying)
1399         my $result_hash;
1400         my $numbers=0;
1401         if ($ordering eq 'call_number_dsc') { # sort by title desc
1402             foreach my $key (sort { $b cmp $a } (keys %result)) {
1403                 $result_hash->{'RECORDS'}[$numbers++] = $result{$key}->as_usmarc();
1404             }
1405         } else { # sort by title ASC
1406             foreach my $key (sort { $a cmp $b } (keys %result)) {
1407                 $result_hash->{'RECORDS'}[$numbers++] = $result{$key}->as_usmarc();
1408             }
1409         }
1410         my $finalresult=();
1411         $result_hash->{'hits'} = $numbers;
1412         $finalresult->{'biblioserver'} = $result_hash;
1413         return $finalresult;
1414     } elsif ($ordering =~ /pubdate/){ #pub year
1415         my %result;
1416         foreach (split /;/,$biblionumbers) {
1417             my ($biblionumber,$title) = split /,/,$_;
1418             my $record=GetMarcBiblio($biblionumber);
1419             my ($publicationyear_tag,$publicationyear_subfield)=GetMarcFromKohaField('biblioitems.publicationyear','');
1420             my $publicationyear=$record->subfield($publicationyear_tag,$publicationyear_subfield);
1421             # hint : the result is sorted by title.biblionumber because we can have X biblios with the same title
1422             # and we don't want to get only 1 result for each of them !!!
1423             $result{$publicationyear.$biblionumber}=$record;
1424         }
1425         # sort the hash and return the same structure as GetRecords (Zebra querying)
1426         my $result_hash;
1427         my $numbers=0;
1428         if ($ordering eq 'pubdate_dsc') { # sort by pubyear desc
1429             foreach my $key (sort { $b cmp $a } (keys %result)) {
1430                 $result_hash->{'RECORDS'}[$numbers++] = $result{$key}->as_usmarc();
1431             }
1432         } else { # sort by pub year ASC
1433             foreach my $key (sort (keys %result)) {
1434                 $result_hash->{'RECORDS'}[$numbers++] = $result{$key}->as_usmarc();
1435             }
1436         }
1437         my $finalresult=();
1438         $result_hash->{'hits'} = $numbers;
1439         $finalresult->{'biblioserver'} = $result_hash;
1440         return $finalresult;
1441     #
1442     # ORDER BY title
1443     #
1444     } elsif ($ordering =~ /title/) {
1445         # the title is in the biblionumbers string, so we just need to build a hash, sort it and return
1446         my %result;
1447         foreach (split /;/,$biblionumbers) {
1448             my ($biblionumber,$title) = split /,/,$_;
1449             # hint : the result is sorted by title.biblionumber because we can have X biblios with the same title
1450             # and we don't want to get only 1 result for each of them !!!
1451             # hint & speed improvement : we can order without reading the record
1452             # so order, and read records only for the requested page !
1453             $result{$title.$biblionumber}=$biblionumber;
1454         }
1455         # sort the hash and return the same structure as GetRecords (Zebra querying)
1456         my $result_hash;
1457         my $numbers=0;
1458         if ($ordering eq 'title_az') { # sort by title desc
1459             foreach my $key (sort (keys %result)) {
1460                 $result_hash->{'RECORDS'}[$numbers++] = $result{$key};
1461             }
1462         } else { # sort by title ASC
1463             foreach my $key (sort { $b cmp $a } (keys %result)) {
1464                 $result_hash->{'RECORDS'}[$numbers++] = $result{$key};
1465             }
1466         }
1467         # limit the $results_per_page to result size if it's more
1468         $results_per_page = $numbers-1 if $numbers < $results_per_page;
1469         # for the requested page, replace biblionumber by the complete record
1470         # speed improvement : avoid reading too much things
1471         for (my $counter=$offset;$counter<=$offset+$results_per_page;$counter++) {
1472             $result_hash->{'RECORDS'}[$counter] = GetMarcBiblio($result_hash->{'RECORDS'}[$counter])->as_usmarc;
1473         }
1474         my $finalresult=();
1475         $result_hash->{'hits'} = $numbers;
1476         $finalresult->{'biblioserver'} = $result_hash;
1477         return $finalresult;
1478     } else {
1479     #
1480     # order by ranking
1481     #
1482         # we need 2 hashes to order by ranking : the 1st one to count the ranking, the 2nd to order by ranking
1483         my %result;
1484         my %count_ranking;
1485         foreach (split /;/,$biblionumbers) {
1486             my ($biblionumber,$title) = split /,/,$_;
1487             $title =~ /(.*)-(\d)/;
1488             # get weight
1489             my $ranking =$2;
1490             # note that we + the ranking because ranking is calculated on weight of EACH term requested.
1491             # if we ask for "two towers", and "two" has weight 2 in biblio N, and "towers" has weight 4 in biblio N
1492             # biblio N has ranking = 6
1493             $count_ranking{$biblionumber} += $ranking;
1494         }
1495         # build the result by "inverting" the count_ranking hash
1496         # 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
1497 #         warn "counting";
1498         foreach (keys %count_ranking) {
1499             $result{sprintf("%10d",$count_ranking{$_}).'-'.$_} = $_;
1500         }
1501         # sort the hash and return the same structure as GetRecords (Zebra querying)
1502         my $result_hash;
1503         my $numbers=0;
1504             foreach my $key (sort {$b cmp $a} (keys %result)) {
1505                 $result_hash->{'RECORDS'}[$numbers++] = $result{$key};
1506             }
1507         # limit the $results_per_page to result size if it's more
1508         $results_per_page = $numbers-1 if $numbers < $results_per_page;
1509         # for the requested page, replace biblionumber by the complete record
1510         # speed improvement : avoid reading too much things
1511         for (my $counter=$offset;$counter<=$offset+$results_per_page;$counter++) {
1512             $result_hash->{'RECORDS'}[$counter] = GetMarcBiblio($result_hash->{'RECORDS'}[$counter])->as_usmarc if $result_hash->{'RECORDS'}[$counter];
1513         }
1514         my $finalresult=();
1515         $result_hash->{'hits'} = $numbers;
1516         $finalresult->{'biblioserver'} = $result_hash;
1517         return $finalresult;
1518     }
1519 }
1520 =head2 ModBiblios
1521
1522 ($countchanged,$listunchanged) = ModBiblios($listbiblios, $tagsubfield,$initvalue,$targetvalue,$test);
1523
1524 this function changes all the values $initvalue in subfield $tag$subfield in any record in $listbiblios
1525 test parameter if set donot perform change to records in database.
1526
1527 =over 2
1528
1529 =item C<input arg:>
1530
1531     * $listbiblios is an array ref to marcrecords to be changed
1532     * $tagsubfield is the reference of the subfield to change.
1533     * $initvalue is the value to search the record for
1534     * $targetvalue is the value to set the subfield to
1535     * $test is to be set only not to perform changes in database.
1536
1537 =item C<Output arg:>
1538     * $countchanged counts all the changes performed.
1539     * $listunchanged contains the list of all the biblionumbers of records unchanged.
1540
1541 =item C<usage in the script:>
1542
1543 =back
1544
1545 my ($countchanged, $listunchanged) = EditBiblios($results->{RECORD}, $tagsubfield,$initvalue,$targetvalue);;
1546 #If one wants to display unchanged records, you should get biblios foreach @$listunchanged
1547 $template->param(countchanged => $countchanged, loopunchanged=>$listunchanged);
1548
1549 =cut
1550
1551 sub ModBiblios{
1552   my ($listbiblios,$tagsubfield,$initvalue,$targetvalue,$test)=@_;
1553   my $countmatched;
1554   my @unmatched;
1555   my ($tag,$subfield)=($1,$2) if ($tagsubfield=~/^(\d{1,3})([a-z0-9A-Z@])?$/);
1556   if ((length($tag)<3)&& $subfield=~/0-9/){
1557     $tag=$tag.$subfield;
1558     undef $subfield;
1559   }
1560   my ($bntag,$bnsubf) = GetMarcFromKohaField('biblio.biblionumber');
1561   my ($itemtag,$itemsubf) = GetMarcFromKohaField('items.itemnumber');
1562   foreach my $usmarc (@$listbiblios){
1563     my $record;
1564     $record=eval{MARC::Record->new_from_usmarc($usmarc)};
1565     my $biblionumber;
1566     if ($@){
1567       # usmarc is not a valid usmarc May be a biblionumber
1568       if ($tag eq $itemtag){
1569         my $bib=GetBiblioFromItemNumber($usmarc);
1570         $record=GetMarcItem($bib->{'biblionumber'},$usmarc) ;
1571         $biblionumber=$bib->{'biblionumber'};
1572       } else {
1573         $record=GetMarcBiblio($usmarc);
1574         $biblionumber=$usmarc;
1575       }
1576     }  else {
1577       if ($bntag >= 010){
1578         $biblionumber = $record->subfield($bntag,$bnsubf);
1579       }else {
1580         $biblionumber=$record->field($bntag)->data;
1581       }
1582     }
1583     #GetBiblionumber is to be written.
1584     #Could be replaced by TransformMarcToKoha (But Would be longer)
1585     if ($record->field($tag)){
1586       my $modify=0;
1587       foreach my $field ($record->field($tag)){
1588         if ($subfield){
1589           if ($field->delete_subfield('code' =>$subfield,'match'=>qr($initvalue))){
1590             $countmatched++;
1591             $modify=1;
1592             $field->update($subfield,$targetvalue) if ($targetvalue);
1593           }
1594         } else {
1595           if ($tag >= 010){
1596             if ($field->delete_field($field)){
1597               $countmatched++;
1598               $modify=1;
1599             }
1600           } else {
1601             $field->data=$targetvalue if ($field->data=~qr($initvalue));
1602           }
1603         }
1604       }
1605 #       warn $record->as_formatted;
1606       if ($modify){
1607         ModBiblio($record,$biblionumber,GetFrameworkCode($biblionumber)) unless ($test);
1608       } else {
1609         push @unmatched, $biblionumber;
1610       }
1611     } else {
1612       push @unmatched, $biblionumber;
1613     }
1614   }
1615   return ($countmatched,\@unmatched);
1616 }
1617
1618 END { }    # module clean-up code here (global destructor)
1619
1620 1;
1621 __END__
1622
1623 =head1 AUTHOR
1624
1625 Koha Developement team <info@koha.org>
1626
1627 =cut