C4/Search.pm

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