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