koha-dev.rot13.org Git - srvgit/blob - 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::Search::PazPar2;
  25 use XML::Simple;
  26 use C4::Dates qw(format_date);
  27
  28 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $DEBUG);
  29
  30 # set the version for version checking
  31 BEGIN {
  32     $VERSION = 3.01;
  33     $DEBUG = ($ENV{DEBUG}) ? 1 : 0;
  34 }
  35
  36 =head1 NAME
  37
  38 C4::Search - Functions for searching the Koha catalog.
  39
  40 =head1 SYNOPSIS
  41
  42 See opac/opac-search.pl or catalogue/search.pl for example of usage
  43
  44 =head1 DESCRIPTION
  45
  46 This module provides searching functions for Koha's bibliographic databases
  47
  48 =head1 FUNCTIONS
  49
  50 =cut
  51
  52 @ISA    = qw(Exporter);
  53 @EXPORT = qw(
  54   &findseealso
  55   &FindDuplicate
  56   &SimpleSearch
  57   &searchResults
  58   &getRecords
  59   &buildQuery
  60   &NZgetRecords
  61   &ModBiblios
  62 );
  63
  64 # make all your functions, whether exported or not;
  65
  66 =head2 findseealso($dbh,$fields);
  67
  68 C<$dbh> is a link to the DB handler.
  69
  70 use C4::Context;
  71 my $dbh =C4::Context->dbh;
  72
  73 C<$fields> is a reference to the fields array
  74
  75 This function modifies the @$fields array and adds related fields to search on.
  76
  77 FIXME: this function is probably deprecated in Koha 3
  78
  79 =cut
  80
  81 sub findseealso {
  82     my ( $dbh, $fields ) = @_;
  83     my $tagslib = GetMarcStructure(1);
  84     for ( my $i = 0 ; $i <= $#{$fields} ; $i++ ) {
  85         my ($tag)      = substr( @$fields[$i], 1, 3 );
  86         my ($subfield) = substr( @$fields[$i], 4, 1 );
  87         @$fields[$i] .= ',' . $tagslib->{$tag}->{$subfield}->{seealso}
  88           if ( $tagslib->{$tag}->{$subfield}->{seealso} );
  89     }
  90 }
  91
  92 =head2 FindDuplicate
  93
  94 ($biblionumber,$biblionumber,$title) = FindDuplicate($record);
  95
  96 This function attempts to find duplicate records using a hard-coded, fairly simplistic algorithm
  97
  98 =cut
  99
 100 sub FindDuplicate {
 101     my ($record) = @_;
 102     my $dbh = C4::Context->dbh;
 103     my $result = TransformMarcToKoha( $dbh, $record, '' );
 104     my $sth;
 105     my $query;
 106     my $search;
 107     my $type;
 108     my ( $biblionumber, $title );
 109
 110     # search duplicate on ISBN, easy and fast..
 111     # ... normalize first
 112     if ( $result->{isbn} ) {
 113         $result->{isbn} =~ s/\(.*$//;
 114         $result->{isbn} =~ s/\s+$//;
 115         $query = "isbn=$result->{isbn}";
 116     }
 117     else {
 118         $result->{title} =~ s /\\//g;
 119         $result->{title} =~ s /\"//g;
 120         $result->{title} =~ s /\(//g;
 121         $result->{title} =~ s /\)//g;
 122
 123         # FIXME: instead of removing operators, could just do
 124         # quotes around the value
 125         $result->{title} =~ s/(and|or|not)//g;
 126         $query = "ti,ext=$result->{title}";
 127         $query .= " and itemtype=$result->{itemtype}"
 128           if ( $result->{itemtype} );
 129         if   ( $result->{author} ) {
 130             $result->{author} =~ s /\\//g;
 131             $result->{author} =~ s /\"//g;
 132             $result->{author} =~ s /\(//g;
 133             $result->{author} =~ s /\)//g;
 134
 135             # remove valid operators
 136             $result->{author} =~ s/(and|or|not)//g;
 137             $query .= " and au,ext=$result->{author}";
 138         }
 139     }
 140
 141     # FIXME: add error handling
 142     my ( $error, $searchresults ) = SimpleSearch($query); # FIXME :: hardcoded !
 143     my @results;
 144     foreach my $possible_duplicate_record (@$searchresults) {
 145         my $marcrecord =
 146           MARC::Record->new_from_usmarc($possible_duplicate_record);
 147         my $result = TransformMarcToKoha( $dbh, $marcrecord, '' );
 148
 149         # FIXME :: why 2 $biblionumber ?
 150         if ($result) {
 151             push @results, $result->{'biblionumber'};
 152             push @results, $result->{'title'};
 153         }
 154     }
 155     return @results;
 156 }
 157
 158 =head2 SimpleSearch
 159
 160 ($error,$results) = SimpleSearch($query,@servers);
 161
 162 This function provides a simple search API on the bibliographic catalog
 163
 164 =over 2
 165
 166 =item C<input arg:>
 167
 168     * $query can be a simple keyword or a complete CCL query
 169     * @servers is optional. Defaults to biblioserver as found in koha-conf.xml
 170
 171 =item C<Output arg:>
 172     * $error is a empty unless an error is detected
 173     * \@results is an array of records.
 174
 175 =item C<usage in the script:>
 176
 177 =back
 178
 179 my ($error, $marcresults) = SimpleSearch($query);
 180
 181 if (defined $error) {
 182     $template->param(query_error => $error);
 183     warn "error: ".$error;
 184     output_html_with_http_headers $input, $cookie, $template->output;
 185     exit;
 186 }
 187
 188 my $hits = scalar @$marcresults;
 189 my @results;
 190
 191 for(my $i=0;$i<$hits;$i++) {
 192     my %resultsloop;
 193     my $marcrecord = MARC::File::USMARC::decode($marcresults->[$i]);
 194     my $biblio = TransformMarcToKoha(C4::Context->dbh,$marcrecord,'');
 195
 196     #build the hash for the template.
 197     $resultsloop{highlight}       = ($i % 2)?(1):(0);
 198     $resultsloop{title}           = $biblio->{'title'};
 199     $resultsloop{subtitle}        = $biblio->{'subtitle'};
 200     $resultsloop{biblionumber}    = $biblio->{'biblionumber'};
 201     $resultsloop{author}          = $biblio->{'author'};
 202     $resultsloop{publishercode}   = $biblio->{'publishercode'};
 203     $resultsloop{publicationyear} = $biblio->{'publicationyear'};
 204
 205     push @results, \%resultsloop;
 206 }
 207
 208 $template->param(result=>\@results);
 209
 210 =cut
 211
 212 sub SimpleSearch {
 213     my $query = shift;
 214     if ( C4::Context->preference('NoZebra') ) {
 215         my $result = NZorder( NZanalyse($query) )->{'biblioserver'};
 216         my $search_result =
 217           (      $result->{hits}
 218               && $result->{hits} > 0 ? $result->{'RECORDS'} : [] );
 219         return ( undef, $search_result );
 220     }
 221     else {
 222         my @servers = @_;
 223         my @results;
 224         my @tmpresults;
 225         my @zconns;
 226         return ( "No query entered", undef ) unless $query;
 227
 228         # FIXME hardcoded value. See catalog/search.pl & opac-search.pl too.
 229         @servers = ("biblioserver") unless @servers;
 230
 231         # Initialize & Search Zebra
 232         for ( my $i = 0 ; $i < @servers ; $i++ ) {
 233             eval {
 234                 $zconns[$i] = C4::Context->Zconn( $servers[$i], 1 );
 235                 $tmpresults[$i] =
 236                   $zconns[$i]
 237                   ->search( new ZOOM::Query::CCL2RPN( $query, $zconns[$i] ) );
 238
 239                 # error handling
 240                 my $error =
 241                     $zconns[$i]->errmsg() . " ("
 242                   . $zconns[$i]->errcode() . ") "
 243                   . $zconns[$i]->addinfo() . " "
 244                   . $zconns[$i]->diagset();
 245
 246                 return ( $error, undef ) if $zconns[$i]->errcode();
 247             };
 248             if ($@) {
 249
 250                 # caught a ZOOM::Exception
 251                 my $error =
 252                     $@->message() . " ("
 253                   . $@->code() . ") "
 254                   . $@->addinfo() . " "
 255                   . $@->diagset();
 256                 warn $error;
 257                 return ( $error, undef );
 258             }
 259         }
 260         my $hits = 0;
 261         my $ev;
 262         while ( ( my $i = ZOOM::event( \@zconns ) ) != 0 ) {
 263             $ev = $zconns[ $i - 1 ]->last_event();
 264             if ( $ev == ZOOM::Event::ZEND ) {
 265                 $hits = $tmpresults[ $i - 1 ]->size();
 266             }
 267             if ( $hits > 0 ) {
 268                 for ( my $j = 0 ; $j < $hits ; $j++ ) {
 269                     my $record = $tmpresults[ $i - 1 ]->record($j)->raw();
 270                     push @results, $record;
 271                 }
 272             }
 273             $hits = 0;
 274         }
 275         return ( undef, \@results );
 276     }
 277 }
 278
 279 =head2 getRecords
 280
 281 ( undef, $results_hashref, \@facets_loop ) = getRecords (
 282
 283         $koha_query,       $simple_query, $sort_by_ref,    $servers_ref,
 284         $results_per_page, $offset,       $expanded_facet, $branches,
 285         $query_type,       $scan
 286     );
 287
 288 The all singing, all dancing, multi-server, asynchronous, scanning,
 289 searching, record nabbing, facet-building
 290
 291 See verbse embedded documentation.
 292
 293 =cut
 294
 295 sub getRecords {
 296     my (
 297         $koha_query,       $simple_query, $sort_by_ref,    $servers_ref,
 298         $results_per_page, $offset,       $expanded_facet, $branches,
 299         $query_type,       $scan
 300     ) = @_;
 301
 302     my @servers = @$servers_ref;
 303     my @sort_by = @$sort_by_ref;
 304
 305     # Initialize variables for the ZOOM connection and results object
 306     my $zconn;
 307     my @zconns;
 308     my @results;
 309     my $results_hashref = ();
 310
 311     # Initialize variables for the faceted results objects
 312     my $facets_counter = ();
 313     my $facets_info    = ();
 314     my $facets         = getFacets();
 315
 316     my @facets_loop
 317       ;    # stores the ref to array of hashes for template facets loop
 318
 319     ### LOOP THROUGH THE SERVERS
 320     for ( my $i = 0 ; $i < @servers ; $i++ ) {
 321         $zconns[$i] = C4::Context->Zconn( $servers[$i], 1 );
 322
 323 # perform the search, create the results objects
 324 # if this is a local search, use the $koha-query, if it's a federated one, use the federated-query
 325         my $query_to_use;
 326         if ( $servers[$i] =~ /biblioserver/ ) {
 327             $query_to_use = $koha_query;
 328         }
 329         else {
 330             $query_to_use = $simple_query;
 331         }
 332
 333         #$query_to_use = $simple_query if $scan;
 334         warn $simple_query if ( $scan and $DEBUG );
 335
 336         # Check if we've got a query_type defined, if so, use it
 337         eval {
 338             if ($query_type)
 339             {
 340                 if ( $query_type =~ /^ccl/ ) {
 341                     $query_to_use =~
 342                       s/\:/\=/g;    # change : to = last minute (FIXME)
 343                     $results[$i] =
 344                       $zconns[$i]->search(
 345                         new ZOOM::Query::CCL2RPN( $query_to_use, $zconns[$i] )
 346                       );
 347                 }
 348                 elsif ( $query_type =~ /^cql/ ) {
 349                     $results[$i] =
 350                       $zconns[$i]->search(
 351                         new ZOOM::Query::CQL( $query_to_use, $zconns[$i] ) );
 352                 }
 353                 elsif ( $query_type =~ /^pqf/ ) {
 354                     $results[$i] =
 355                       $zconns[$i]->search(
 356                         new ZOOM::Query::PQF( $query_to_use, $zconns[$i] ) );
 357                 }
 358             }
 359             else {
 360                 if ($scan) {
 361                     $results[$i] =
 362                       $zconns[$i]->scan(
 363                         new ZOOM::Query::CCL2RPN( $query_to_use, $zconns[$i] )
 364                       );
 365                 }
 366                 else {
 367                     $results[$i] =
 368                       $zconns[$i]->search(
 369                         new ZOOM::Query::CCL2RPN( $query_to_use, $zconns[$i] )
 370                       );
 371                 }
 372             }
 373         };
 374         if ($@) {
 375             warn "WARNING: query problem with $query_to_use " . $@;
 376         }
 377
 378         # Concatenate the sort_by limits and pass them to the results object
 379         # Note: sort will override rank
 380         my $sort_by;
 381         foreach my $sort (@sort_by) {
 382             if ( $sort eq "author_az" ) {
 383                 $sort_by .= "1=1003 <i ";
 384             }
 385             elsif ( $sort eq "author_za" ) {
 386                 $sort_by .= "1=1003 >i ";
 387             }
 388             elsif ( $sort eq "popularity_asc" ) {
 389                 $sort_by .= "1=9003 <i ";
 390             }
 391             elsif ( $sort eq "popularity_dsc" ) {
 392                 $sort_by .= "1=9003 >i ";
 393             }
 394             elsif ( $sort eq "call_number_asc" ) {
 395                 $sort_by .= "1=20  <i ";
 396             }
 397             elsif ( $sort eq "call_number_dsc" ) {
 398                 $sort_by .= "1=20 >i ";
 399             }
 400             elsif ( $sort eq "pubdate_asc" ) {
 401                 $sort_by .= "1=31 <i ";
 402             }
 403             elsif ( $sort eq "pubdate_dsc" ) {
 404                 $sort_by .= "1=31 >i ";
 405             }
 406             elsif ( $sort eq "acqdate_asc" ) {
 407                 $sort_by .= "1=32 <i ";
 408             }
 409             elsif ( $sort eq "acqdate_dsc" ) {
 410                 $sort_by .= "1=32 >i ";
 411             }
 412             elsif ( $sort eq "title_az" ) {
 413                 $sort_by .= "1=4 <i ";
 414             }
 415             elsif ( $sort eq "title_za" ) {
 416                 $sort_by .= "1=4 >i ";
 417             }
 418         }
 419         if ($sort_by) {
 420             if ( $results[$i]->sort( "yaz", $sort_by ) < 0 ) {
 421                 warn "WARNING sort $sort_by failed";
 422             }
 423         }
 424     }    # finished looping through servers
 425
 426     # The big moment: asynchronously retrieve results from all servers
 427     while ( ( my $i = ZOOM::event( \@zconns ) ) != 0 ) {
 428         my $ev = $zconns[ $i - 1 ]->last_event();
 429         if ( $ev == ZOOM::Event::ZEND ) {
 430             next unless $results[ $i - 1 ];
 431             my $size = $results[ $i - 1 ]->size();
 432             if ( $size > 0 ) {
 433                 my $results_hash;
 434
 435                 # loop through the results
 436                 $results_hash->{'hits'} = $size;
 437                 my $times;
 438                 if ( $offset + $results_per_page <= $size ) {
 439                     $times = $offset + $results_per_page;
 440                 }
 441                 else {
 442                     $times = $size;
 443                 }
 444                 for ( my $j = $offset ; $j < $times ; $j++ ) {
 445                     my $records_hash;
 446                     my $record;
 447                     my $facet_record;
 448
 449                     ## Check if it's an index scan
 450                     if ($scan) {
 451                         my ( $term, $occ ) = $results[ $i - 1 ]->term($j);
 452
 453                  # here we create a minimal MARC record and hand it off to the
 454                  # template just like a normal result ... perhaps not ideal, but
 455                  # it works for now
 456                         my $tmprecord = MARC::Record->new();
 457                         $tmprecord->encoding('UTF-8');
 458                         my $tmptitle;
 459                         my $tmpauthor;
 460
 461                 # the minimal record in author/title (depending on MARC flavour)
 462                         if ( C4::Context->preference("marcflavour") eq
 463                             "UNIMARC" )
 464                         {
 465                             $tmptitle = MARC::Field->new(
 466                                 '200', ' ', ' ',
 467                                 a => $term,
 468                                 f => $occ
 469                             );
 470                             $tmprecord->append_fields($tmptitle);
 471                         }
 472                         else {
 473                             $tmptitle =
 474                               MARC::Field->new( '245', ' ', ' ', a => $term, );
 475                             $tmpauthor =
 476                               MARC::Field->new( '100', ' ', ' ', a => $occ, );
 477                             $tmprecord->append_fields($tmptitle);
 478                             $tmprecord->append_fields($tmpauthor);
 479                         }
 480                         $results_hash->{'RECORDS'}[$j] =
 481                           $tmprecord->as_usmarc();
 482                     }
 483
 484                     # not an index scan
 485                     else {
 486                         $record = $results[ $i - 1 ]->record($j)->raw();
 487
 488                         # warn "RECORD $j:".$record;
 489                         $results_hash->{'RECORDS'}[$j] = $record;
 490
 491             # Fill the facets while we're looping, but only for the biblioserver
 492                         $facet_record = MARC::Record->new_from_usmarc($record)
 493                           if $servers[ $i - 1 ] =~ /biblioserver/;
 494
 495                     #warn $servers[$i-1]."\n".$record; #.$facet_record->title();
 496                         if ($facet_record) {
 497                             for ( my $k = 0 ; $k <= @$facets ; $k++ ) {
 498
 499                                 if ( $facets->[$k] ) {
 500                                     my @fields;
 501                                     for my $tag ( @{ $facets->[$k]->{'tags'} } )
 502                                     {
 503                                         push @fields,
 504                                           $facet_record->field($tag);
 505                                     }
 506                                     for my $field (@fields) {
 507                                         my @subfields = $field->subfields();
 508                                         for my $subfield (@subfields) {
 509                                             my ( $code, $data ) = @$subfield;
 510                                             if ( $code eq
 511                                                 $facets->[$k]->{'subfield'} )
 512                                             {
 513                                                 $facets_counter->{ $facets->[$k]
 514                                                       ->{'link_value'} }
 515                                                   ->{$data}++;
 516                                             }
 517                                         }
 518                                     }
 519                                     $facets_info->{ $facets->[$k]
 520                                           ->{'link_value'} }->{'label_value'} =
 521                                       $facets->[$k]->{'label_value'};
 522                                     $facets_info->{ $facets->[$k]
 523                                           ->{'link_value'} }->{'expanded'} =
 524                                       $facets->[$k]->{'expanded'};
 525                                 }
 526                             }
 527                         }
 528                     }
 529                 }
 530                 $results_hashref->{ $servers[ $i - 1 ] } = $results_hash;
 531             }
 532
 533             # warn "connection ", $i-1, ": $size hits";
 534             # warn $results[$i-1]->record(0)->render() if $size > 0;
 535
 536             # BUILD FACETS
 537             if ( $servers[ $i - 1 ] =~ /biblioserver/ ) {
 538                 for my $link_value (
 539                     sort { $facets_counter->{$b} <=> $facets_counter->{$a} }
 540                     keys %$facets_counter )
 541                 {
 542                     my $expandable;
 543                     my $number_of_facets;
 544                     my @this_facets_array;
 545                     for my $one_facet (
 546                         sort {
 547                             $facets_counter->{$link_value}
 548                               ->{$b} <=> $facets_counter->{$link_value}->{$a}
 549                         } keys %{ $facets_counter->{$link_value} }
 550                       )
 551                     {
 552                         $number_of_facets++;
 553                         if (   ( $number_of_facets < 6 )
 554                             || ( $expanded_facet eq $link_value )
 555                             || ( $facets_info->{$link_value}->{'expanded'} ) )
 556                         {
 557
 558                       # Sanitize the link value ), ( will cause errors with CCL,
 559                             my $facet_link_value = $one_facet;
 560                             $facet_link_value =~ s/(\(|\))/ /g;
 561
 562                             # fix the length that will display in the label,
 563                             my $facet_label_value = $one_facet;
 564                             $facet_label_value =
 565                               substr( $one_facet, 0, 20 ) . "..."
 566                               unless length($facet_label_value) <= 20;
 567
 568                             # if it's a branch, label by the name, not the code,
 569                             if ( $link_value =~ /branch/ ) {
 570                                 $facet_label_value =
 571                                   $branches->{$one_facet}->{'branchname'};
 572                             }
 573
 574                 # but we're down with the whole label being in the link's title.
 575                             my $facet_title_value = $one_facet;
 576
 577                             push @this_facets_array,
 578                               (
 579                                 {
 580                                     facet_count =>
 581                                       $facets_counter->{$link_value}
 582                                       ->{$one_facet},
 583                                     facet_label_value => $facet_label_value,
 584                                     facet_title_value => $facet_title_value,
 585                                     facet_link_value  => $facet_link_value,
 586                                     type_link_value   => $link_value,
 587                                 },
 588                               );
 589                         }
 590                     }
 591
 592                     # handle expanded option
 593                     unless ( $facets_info->{$link_value}->{'expanded'} ) {
 594                         $expandable = 1
 595                           if ( ( $number_of_facets > 6 )
 596                             && ( $expanded_facet ne $link_value ) );
 597                     }
 598                     push @facets_loop,
 599                       (
 600                         {
 601                             type_link_value => $link_value,
 602                             type_id         => $link_value . "_id",
 603                             type_label =>
 604                               $facets_info->{$link_value}->{'label_value'},
 605                             facets     => \@this_facets_array,
 606                             expandable => $expandable,
 607                             expand     => $link_value,
 608                         }
 609                       );
 610                 }
 611             }
 612         }
 613     }
 614     return ( undef, $results_hashref, \@facets_loop );
 615 }
 616
 617 sub pazGetRecords {
 618     my (
 619         $koha_query,       $simple_query, $sort_by_ref,    $servers_ref,
 620         $results_per_page, $offset,       $expanded_facet, $branches,
 621         $query_type,       $scan
 622     ) = @_;
 623
 624     my $paz = C4::Search::PazPar2->new(C4::Context->config('pazpar2url'));
 625     $paz->init();
 626     $paz->search($simple_query);
 627     sleep 1;
 628
 629     # do results
 630     my $results_hashref = {};
 631     my $stats = XMLin($paz->stat);
 632     my $results = XMLin($paz->show($offset, $results_per_page, 'work-title:1'), forcearray => 1);
 633
 634     # for a grouped search result, the number of hits
 635     # is the number of groups returned; 'bib_hits' will have
 636     # the total number of bibs.
 637     $results_hashref->{'biblioserver'}->{'hits'} = $results->{'merged'}->[0];
 638     $results_hashref->{'biblioserver'}->{'bib_hits'} = $stats->{'hits'};
 639
 640     HIT: foreach my $hit (@{ $results->{'hit'} }) {
 641         my $recid = $hit->{recid}->[0];
 642
 643         my $work_title = $hit->{'md-work-title'}->[0];
 644         my $work_author;
 645         if (exists $hit->{'md-work-author'}) {
 646             $work_author = $hit->{'md-work-author'}->[0];
 647         }
 648         my $group_label = (defined $work_author) ? "$work_title / $work_author" : $work_title;
 649
 650         my $result_group = {};
 651         $result_group->{'group_label'} = $group_label;
 652         $result_group->{'group_merge_key'} = $recid;
 653
 654         my $count = 1;
 655         if (exists $hit->{count}) {
 656             $count = $hit->{count}->[0];
 657         }
 658         $result_group->{'group_count'} = $count;
 659
 660         for (my $i = 0; $i < $count; $i++) {
 661             # FIXME -- may need to worry about diacritics here
 662             my $rec = $paz->record($recid, $i);
 663             push @{ $result_group->{'RECORDS'} }, $rec;
 664         }
 665
 666         push @{ $results_hashref->{'biblioserver'}->{'GROUPS'} }, $result_group;
 667     }
 668
 669     # pass through facets
 670     my $termlist_xml = $paz->termlist('author,subject');
 671     my $terms = XMLin($termlist_xml, forcearray => 1);
 672     my @facets_loop = ();
 673     #die Dumper($results);
 674 #    foreach my $list (sort keys %{ $terms->{'list'} }) {
 675 #        my @facets = ();
 676 #        foreach my $facet (sort @{ $terms->{'list'}->{$list}->{'term'} } ) {
 677 #            push @facets, {
 678 #                facet_label_value => $facet->{'name'}->[0],
 679 #            };
 680 #        }
 681 #        push @facets_loop, ( {
 682 #            type_label => $list,
 683 #            facets => \@facets,
 684 #        } );
 685 #    }
 686
 687     return ( undef, $results_hashref, \@facets_loop );
 688 }
 689
 690 # STOPWORDS
 691 sub _remove_stopwords {
 692     my ( $operand, $index ) = @_;
 693     my @stopwords_removed;
 694
 695     # phrase and exact-qualified indexes shouldn't have stopwords removed
 696     if ( $index !~ m/phr|ext/ ) {
 697
 698 # remove stopwords from operand : parse all stopwords & remove them (case insensitive)
 699 #       we use IsAlpha unicode definition, to deal correctly with diacritics.
 700 #       otherwise, a French word like "leçon" woudl be split into "le" "çon", "le"
 701 #       is a stopword, we'd get "çon" and wouldn't find anything...
 702         foreach ( keys %{ C4::Context->stopwords } ) {
 703             next if ( $_ =~ /(and|or|not)/ );    # don't remove operators
 704             if ( $operand =~
 705                 /(\P{IsAlpha}$_\P{IsAlpha}|^$_\P{IsAlpha}|\P{IsAlpha}$_$)/ )
 706             {
 707                 $operand =~ s/\P{IsAlpha}$_\P{IsAlpha}/ /gi;
 708                 $operand =~ s/^$_\P{IsAlpha}/ /gi;
 709                 $operand =~ s/\P{IsAlpha}$_$/ /gi;
 710                 push @stopwords_removed, $_;
 711             }
 712         }
 713     }
 714     return ( $operand, \@stopwords_removed );
 715 }
 716
 717 # TRUNCATION
 718 sub _detect_truncation {
 719     my ( $operand, $index ) = @_;
 720     my ( @nontruncated, @righttruncated, @lefttruncated, @rightlefttruncated,
 721         @regexpr );
 722     $operand =~ s/^ //g;
 723     my @wordlist = split( /\s/, $operand );
 724     foreach my $word (@wordlist) {
 725         if ( $word =~ s/^\*([^\*]+)\*$/$1/ ) {
 726             push @rightlefttruncated, $word;
 727         }
 728         elsif ( $word =~ s/^\*([^\*]+)$/$1/ ) {
 729             push @lefttruncated, $word;
 730         }
 731         elsif ( $word =~ s/^([^\*]+)\*$/$1/ ) {
 732             push @righttruncated, $word;
 733         }
 734         elsif ( index( $word, "*" ) < 0 ) {
 735             push @nontruncated, $word;
 736         }
 737         else {
 738             push @regexpr, $word;
 739         }
 740     }
 741     return (
 742         \@nontruncated,       \@righttruncated, \@lefttruncated,
 743         \@rightlefttruncated, \@regexpr
 744     );
 745 }
 746
 747 # STEMMING
 748 sub _build_stemmed_operand {
 749     my ($operand) = @_;
 750     my $stemmed_operand;
 751
 752 # FIXME: the locale should be set based on the user's language and/or search choice
 753     my $stemmer = Lingua::Stem->new( -locale => 'EN-US' );
 754
 755 # FIXME: these should be stored in the db so the librarian can modify the behavior
 756     $stemmer->add_exceptions(
 757         {
 758             'and' => 'and',
 759             'or'  => 'or',
 760             'not' => 'not',
 761         }
 762     );
 763     my @words = split( / /, $operand );
 764     my $stems = $stemmer->stem(@words);
 765     for my $stem (@$stems) {
 766         $stemmed_operand .= "$stem";
 767         $stemmed_operand .= "?"
 768           unless ( $stem =~ /(and$|or$|not$)/ ) || ( length($stem) < 3 );
 769         $stemmed_operand .= " ";
 770     }
 771     warn "STEMMED OPERAND: $stemmed_operand" if $DEBUG;
 772     return $stemmed_operand;
 773 }
 774
 775 # FIELD WEIGHTING
 776 sub _build_weighted_query {
 777
 778 # FIELD WEIGHTING - This is largely experimental stuff. What I'm committing works
 779 # pretty well but could work much better if we had a smarter query parser
 780     my ( $operand, $stemmed_operand, $index ) = @_;
 781     my $stemming      = C4::Context->preference("QueryStemming")     || 0;
 782     my $weight_fields = C4::Context->preference("QueryWeightFields") || 0;
 783     my $fuzzy_enabled = C4::Context->preference("QueryFuzzy")        || 0;
 784
 785     my $weighted_query .= "(rk=(";    # Specifies that we're applying rank
 786
 787     # Keyword, or, no index specified
 788     if ( ( $index eq 'kw' ) || ( !$index ) ) {
 789         $weighted_query .=
 790           "Title-cover,ext,r1=\"$operand\"";    # exact title-cover
 791         $weighted_query .= " or ti,ext,r2=\"$operand\"";    # exact title
 792         $weighted_query .= " or ti,phr,r3=\"$operand\"";    # phrase title
 793           #$weighted_query .= " or any,ext,r4=$operand";               # exact any
 794           #$weighted_query .=" or kw,wrdl,r5=\"$operand\"";            # word list any
 795         $weighted_query .= " or wrdl,fuzzy,r8=\"$operand\""
 796           if $fuzzy_enabled;    # add fuzzy, word list
 797         $weighted_query .= " or wrdl,right-Truncation,r9=\"$stemmed_operand\""
 798           if ( $stemming and $stemmed_operand )
 799           ;                     # add stemming, right truncation
 800         $weighted_query .= " or wrdl,r9=\"$operand\"";
 801
 802         # embedded sorting: 0 a-z; 1 z-a
 803         # $weighted_query .= ") or (sort1,aut=1";
 804     }
 805
 806     # Barcode searches should skip this process
 807     elsif ( $index eq 'bc' ) {
 808         $weighted_query .= "bc=\"$operand\"";
 809     }
 810
 811     # Authority-number searches should skip this process
 812     elsif ( $index eq 'an' ) {
 813         $weighted_query .= "an=\"$operand\"";
 814     }
 815
 816     # If the index already has more than one qualifier, wrap the operand
 817     # in quotes and pass it back (assumption is that the user knows what they
 818     # are doing and won't appreciate us mucking up their query
 819     elsif ( $index =~ ',' ) {
 820         $weighted_query .= " $index=\"$operand\"";
 821     }
 822
 823     #TODO: build better cases based on specific search indexes
 824     else {
 825         $weighted_query .= " $index,ext,r1=\"$operand\"";    # exact index
 826           #$weighted_query .= " or (title-sort-az=0 or $index,startswithnt,st-word,r3=$operand #)";
 827         $weighted_query .= " or $index,phr,r3=\"$operand\"";    # phrase index
 828         $weighted_query .=
 829           " or $index,rt,wrdl,r3=\"$operand\"";    # word list index
 830     }
 831
 832     $weighted_query .= "))";                       # close rank specification
 833     return $weighted_query;
 834 }
 835
 836 =head2 buildQuery
 837
 838 ( $error, $query,
 839 $simple_query, $query_cgi,
 840 $query_desc, $limit,
 841 $limit_cgi, $limit_desc,
 842 $stopwords_removed, $query_type ) = getRecords ( $operators, $operands, $indexes, $limits, $sort_by, $scan);
 843
 844 Build queries and limits in CCL, CGI, Human,
 845 handle truncation, stemming, field weighting, stopwords, fuzziness, etc.
 846
 847 See verbose embedded documentation.
 848
 849
 850 =cut
 851
 852 sub buildQuery {
 853     my ( $operators, $operands, $indexes, $limits, $sort_by, $scan ) = @_;
 854
 855     warn "---------"        if $DEBUG;
 856     warn "Enter buildQuery" if $DEBUG;
 857     warn "---------"        if $DEBUG;
 858
 859     # dereference
 860     my @operators = @$operators if $operators;
 861     my @indexes   = @$indexes   if $indexes;
 862     my @operands  = @$operands  if $operands;
 863     my @limits    = @$limits    if $limits;
 864     my @sort_by   = @$sort_by   if $sort_by;
 865
 866     my $stemming         = C4::Context->preference("QueryStemming")        || 0;
 867     my $auto_truncation  = C4::Context->preference("QueryAutoTruncate")    || 0;
 868     my $weight_fields    = C4::Context->preference("QueryWeightFields")    || 0;
 869     my $fuzzy_enabled    = C4::Context->preference("QueryFuzzy")           || 0;
 870     my $remove_stopwords = C4::Context->preference("QueryRemoveStopwords") || 0;
 871
 872     # no stemming/weight/fuzzy in NoZebra
 873     if ( C4::Context->preference("NoZebra") ) {
 874         $stemming      = 0;
 875         $weight_fields = 0;
 876         $fuzzy_enabled = 0;
 877     }
 878
 879     my $query        = $operands[0];
 880     my $simple_query = $operands[0];
 881
 882     # initialize the variables we're passing back
 883     my $query_cgi;
 884     my $query_desc;
 885     my $query_type;
 886
 887     my $limit;
 888     my $limit_cgi;
 889     my $limit_desc;
 890
 891     my $stopwords_removed;    # flag to determine if stopwords have been removed
 892
 893 # for handling ccl, cql, pqf queries in diagnostic mode, skip the rest of the steps
 894 # DIAGNOSTIC ONLY!!
 895     if ( $query =~ /^ccl=/ ) {
 896         return ( undef, $', $', $', $', '', '', '', '', 'ccl' );
 897     }
 898     if ( $query =~ /^cql=/ ) {
 899         return ( undef, $', $', $', $', '', '', '', '', 'cql' );
 900     }
 901     if ( $query =~ /^pqf=/ ) {
 902         return ( undef, $', $', $', $', '', '', '', '', 'pqf' );
 903     }
 904
 905     # pass nested queries directly
 906     # FIXME: need better handling of some of these variables in this case
 907     if ( $query =~ /(\(|\))/ ) {
 908         return (
 909             undef,              $query, $simple_query, $query_cgi,
 910             $query,             $limit, $limit_cgi,    $limit_desc,
 911             $stopwords_removed, 'ccl'
 912         );
 913     }
 914
 915 # Form-based queries are non-nested and fixed depth, so we can easily modify the incoming
 916 # query operands and indexes and add stemming, truncation, field weighting, etc.
 917 # Once we do so, we'll end up with a value in $query, just like if we had an
 918 # incoming $query from the user
 919     else {
 920         $query = ""
 921           ; # clear it out so we can populate properly with field-weighted, stemmed, etc. query
 922         my $previous_operand
 923           ;    # a flag used to keep track if there was a previous query
 924                # if there was, we can apply the current operator
 925                # for every operand
 926         for ( my $i = 0 ; $i <= @operands ; $i++ ) {
 927
 928             # COMBINE OPERANDS, INDEXES AND OPERATORS
 929             if ( $operands[$i] ) {
 930
 931               # A flag to determine whether or not to add the index to the query
 932                 my $indexes_set;
 933
 934 # If the user is sophisticated enough to specify an index, turn off field weighting, stemming, and stopword handling
 935                 if ( $operands[$i] =~ /(:|=)/ || $scan ) {
 936                     $weight_fields    = 0;
 937                     $stemming         = 0;
 938                     $remove_stopwords = 0;
 939                 }
 940                 my $operand = $operands[$i];
 941                 my $index   = $indexes[$i];
 942
 943                 # Add index-specific attributes
 944                 # Date of Publication
 945                 if ( $index eq 'yr' ) {
 946                     $index .= ",st-numeric";
 947                     $indexes_set++;
 948                     (
 949                         $stemming,      $auto_truncation,
 950                         $weight_fields, $fuzzy_enabled,
 951                         $remove_stopwords
 952                     ) = ( 0, 0, 0, 0, 0 );
 953                 }
 954
 955                 # Date of Acquisition
 956                 elsif ( $index eq 'acqdate' ) {
 957                     $index .= ",st-date-normalized";
 958                     $indexes_set++;
 959                     (
 960                         $stemming,      $auto_truncation,
 961                         $weight_fields, $fuzzy_enabled,
 962                         $remove_stopwords
 963                     ) = ( 0, 0, 0, 0, 0 );
 964                 }
 965
 966                 # Set default structure attribute (word list)
 967                 my $struct_attr;
 968                 unless ( !$index || $index =~ /(st-|phr|ext|wrdl)/ ) {
 969                     $struct_attr = ",wrdl";
 970                 }
 971
 972                 # Some helpful index variants
 973                 my $index_plus       = $index . $struct_attr . ":" if $index;
 974                 my $index_plus_comma = $index . $struct_attr . "," if $index;
 975
 976                 # Remove Stopwords
 977                 if ($remove_stopwords) {
 978                     ( $operand, $stopwords_removed ) =
 979                       _remove_stopwords( $operand, $index );
 980                     warn "OPERAND w/out STOPWORDS: >$operand<" if $DEBUG;
 981                     warn "REMOVED STOPWORDS: @$stopwords_removed"
 982                       if ( $stopwords_removed && $DEBUG );
 983                 }
 984
 985                 # Detect Truncation
 986                 my ( $nontruncated, $righttruncated, $lefttruncated,
 987                     $rightlefttruncated, $regexpr );
 988                 my $truncated_operand;
 989                 (
 990                     $nontruncated, $righttruncated, $lefttruncated,
 991                     $rightlefttruncated, $regexpr
 992                 ) = _detect_truncation( $operand, $index );
 993                 warn
 994 "TRUNCATION: NON:>@$nontruncated< RIGHT:>@$righttruncated< LEFT:>@$lefttruncated< RIGHTLEFT:>@$rightlefttruncated< REGEX:>@$regexpr<"
 995                   if $DEBUG;
 996
 997                 # Apply Truncation
 998                 if (
 999                     scalar(@$righttruncated) + scalar(@$lefttruncated) +
1000                     scalar(@$rightlefttruncated) > 0 )
1001                 {
1002
1003                # Don't field weight or add the index to the query, we do it here
1004                     $indexes_set = 1;
1005                     undef $weight_fields;
1006                     my $previous_truncation_operand;
1007                     if ( scalar(@$nontruncated) > 0 ) {
1008                         $truncated_operand .= "$index_plus @$nontruncated ";
1009                         $previous_truncation_operand = 1;
1010                     }
1011                     if ( scalar(@$righttruncated) > 0 ) {
1012                         $truncated_operand .= "and "
1013                           if $previous_truncation_operand;
1014                         $truncated_operand .=
1015                           "$index_plus_comma" . "rtrn:@$righttruncated ";
1016                         $previous_truncation_operand = 1;
1017                     }
1018                     if ( scalar(@$lefttruncated) > 0 ) {
1019                         $truncated_operand .= "and "
1020                           if $previous_truncation_operand;
1021                         $truncated_operand .=
1022                           "$index_plus_comma" . "ltrn:@$lefttruncated ";
1023                         $previous_truncation_operand = 1;
1024                     }
1025                     if ( scalar(@$rightlefttruncated) > 0 ) {
1026                         $truncated_operand .= "and "
1027                           if $previous_truncation_operand;
1028                         $truncated_operand .=
1029                           "$index_plus_comma" . "rltrn:@$rightlefttruncated ";
1030                         $previous_truncation_operand = 1;
1031                     }
1032                 }
1033                 $operand = $truncated_operand if $truncated_operand;
1034                 warn "TRUNCATED OPERAND: >$truncated_operand<" if $DEBUG;
1035
1036                 # Handle Stemming
1037                 my $stemmed_operand;
1038                 $stemmed_operand = _build_stemmed_operand($operand)
1039                   if $stemming;
1040                 warn "STEMMED OPERAND: >$stemmed_operand<" if $DEBUG;
1041
1042                 # Handle Field Weighting
1043                 my $weighted_operand;
1044                 $weighted_operand =
1045                   _build_weighted_query( $operand, $stemmed_operand, $index )
1046                   if $weight_fields;
1047                 warn "FIELD WEIGHTED OPERAND: >$weighted_operand<" if $DEBUG;
1048                 $operand = $weighted_operand if $weight_fields;
1049                 $indexes_set = 1 if $weight_fields;
1050
1051                 # If there's a previous operand, we need to add an operator
1052                 if ($previous_operand) {
1053
1054                     # User-specified operator
1055                     if ( $operators[ $i - 1 ] ) {
1056                         $query     .= " $operators[$i-1] ";
1057                         $query     .= " $index_plus " unless $indexes_set;
1058                         $query     .= " $operand";
1059                         $query_cgi .= "&op=$operators[$i-1]";
1060                         $query_cgi .= "&idx=$index" if $index;
1061                         $query_cgi .= "&q=$operands[$i]" if $operands[$i];
1062                         $query_desc .=
1063                           " $operators[$i-1] $index_plus $operands[$i]";
1064                     }
1065
1066                     # Default operator is and
1067                     else {
1068                         $query      .= " and ";
1069                         $query      .= "$index_plus " unless $indexes_set;
1070                         $query      .= "$operand";
1071                         $query_cgi  .= "&op=and&idx=$index" if $index;
1072                         $query_cgi  .= "&q=$operands[$i]" if $operands[$i];
1073                         $query_desc .= " and $index_plus $operands[$i]";
1074                     }
1075                 }
1076
1077                 # There isn't a pervious operand, don't need an operator
1078                 else {
1079
1080                     # Field-weighted queries already have indexes set
1081                     $query .= " $index_plus " unless $indexes_set;
1082                     $query .= $operand;
1083                     $query_desc .= " $index_plus $operands[$i]";
1084                     $query_cgi  .= "&idx=$index" if $index;
1085                     $query_cgi  .= "&q=$operands[$i]" if $operands[$i];
1086                     $previous_operand = 1;
1087                 }
1088             }    #/if $operands
1089         }    # /for
1090     }
1091     warn "QUERY BEFORE LIMITS: >$query<" if $DEBUG;
1092
1093     # add limits
1094     my $group_OR_limits;
1095     my $availability_limit;
1096     foreach my $this_limit (@limits) {
1097         if ( $this_limit =~ /available/ ) {
1098
1099 # 'available' is defined as (items.onloan is NULL) and (items.itemlost = 0)
1100 # In English:
1101 # all records not indexed in the onloan register (zebra) and all records with a value of lost equal to 0
1102             $availability_limit .=
1103 "( ( allrecords,AlwaysMatches='' not onloan,AlwaysMatches='') and (lost,st-numeric=0) )"; #or ( allrecords,AlwaysMatches='' not lost,AlwaysMatches='')) )";
1104             $limit_cgi  .= "&limit=available";
1105             $limit_desc .= "";
1106         }
1107
1108         # group_OR_limits, prefixed by mc-
1109         # OR every member of the group
1110         elsif ( $this_limit =~ /mc/ ) {
1111             $group_OR_limits .= " or " if $group_OR_limits;
1112             $limit_desc      .= " or " if $group_OR_limits;
1113             $group_OR_limits .= "$this_limit";
1114             $limit_cgi       .= "&limit=$this_limit";
1115             $limit_desc      .= " $this_limit";
1116         }
1117
1118         # Regular old limits
1119         else {
1120             $limit .= " and " if $limit || $query;
1121             $limit      .= "$this_limit";
1122             $limit_cgi  .= "&limit=$this_limit";
1123             $limit_desc .= " $this_limit";
1124         }
1125     }
1126     if ($group_OR_limits) {
1127         $limit .= " and " if ( $query || $limit );
1128         $limit .= "($group_OR_limits)";
1129     }
1130     if ($availability_limit) {
1131         $limit .= " and " if ( $query || $limit );
1132         $limit .= "($availability_limit)";
1133     }
1134
1135     # Normalize the query and limit strings
1136     $query =~ s/:/=/g;
1137     $limit =~ s/:/=/g;
1138     for ( $query, $query_desc, $limit, $limit_desc ) {
1139         $_ =~ s/  / /g;    # remove extra spaces
1140         $_ =~ s/^ //g;     # remove any beginning spaces
1141         $_ =~ s/ $//g;     # remove any ending spaces
1142         $_ =~ s/==/=/g;    # remove double == from query
1143     }
1144     $query_cgi =~ s/^&//; # remove unnecessary & from beginning of the query cgi
1145
1146     for ($query_cgi,$simple_query) {
1147         $_ =~ s/"//g;
1148     }
1149     # append the limit to the query
1150     $query .= " " . $limit;
1151
1152     # Warnings if DEBUG
1153     if ($DEBUG) {
1154         warn "QUERY:" . $query;
1155         warn "QUERY CGI:" . $query_cgi;
1156         warn "QUERY DESC:" . $query_desc;
1157         warn "LIMIT:" . $limit;
1158         warn "LIMIT CGI:" . $limit_cgi;
1159         warn "LIMIT DESC:" . $limit_desc;
1160         warn "---------";
1161         warn "Leave buildQuery";
1162         warn "---------";
1163     }
1164     return (
1165         undef,              $query, $simple_query, $query_cgi,
1166         $query_desc,        $limit, $limit_cgi,    $limit_desc,
1167         $stopwords_removed, $query_type
1168     );
1169 }
1170
1171 =head2 searchResults
1172
1173 Format results in a form suitable for passing to the template
1174
1175 =cut
1176
1177 # IMO this subroutine is pretty messy still -- it's responsible for
1178 # building the HTML output for the template
1179 sub searchResults {
1180     my ( $searchdesc, $hits, $results_per_page, $offset, @marcresults ) = @_;
1181     my $dbh = C4::Context->dbh;
1182     my $toggle;
1183     my $even = 1;
1184     my @newresults;
1185
1186     # add search-term highlighting via <span>s on the search terms
1187     my $span_terms_hashref;
1188     for my $span_term ( split( / /, $searchdesc ) ) {
1189         $span_term =~ s/(.*=|\)|\(|\+|\.|\*)//g;
1190         $span_terms_hashref->{$span_term}++;
1191     }
1192
1193     #Build branchnames hash
1194     #find branchname
1195     #get branch information.....
1196     my %branches;
1197     my $bsth =
1198       $dbh->prepare("SELECT branchcode,branchname FROM branches")
1199       ;    # FIXME : use C4::Koha::GetBranches
1200     $bsth->execute();
1201     while ( my $bdata = $bsth->fetchrow_hashref ) {
1202         $branches{ $bdata->{'branchcode'} } = $bdata->{'branchname'};
1203     }
1204     my %locations;
1205     my $lsch =
1206       $dbh->prepare(
1207 "SELECT authorised_value,lib FROM authorised_values WHERE category = 'LOC'"
1208       );
1209     $lsch->execute();
1210     while ( my $ldata = $lsch->fetchrow_hashref ) {
1211         $locations{ $ldata->{'authorised_value'} } = $ldata->{'lib'};
1212     }
1213
1214     #Build itemtype hash
1215     #find itemtype & itemtype image
1216     my %itemtypes;
1217     $bsth =
1218       $dbh->prepare(
1219         "SELECT itemtype,description,imageurl,summary,notforloan FROM itemtypes"
1220       );
1221     $bsth->execute();
1222     while ( my $bdata = $bsth->fetchrow_hashref ) {
1223         $itemtypes{ $bdata->{'itemtype'} }->{description} =
1224           $bdata->{'description'};
1225         $itemtypes{ $bdata->{'itemtype'} }->{imageurl} = $bdata->{'imageurl'};
1226         $itemtypes{ $bdata->{'itemtype'} }->{summary}  = $bdata->{'summary'};
1227         $itemtypes{ $bdata->{'itemtype'} }->{notforloan} =
1228           $bdata->{'notforloan'};
1229     }
1230
1231     #search item field code
1232     my $sth =
1233       $dbh->prepare(
1234 "SELECT tagfield FROM marc_subfield_structure WHERE kohafield LIKE 'items.itemnumber'"
1235       );
1236     $sth->execute;
1237     my ($itemtag) = $sth->fetchrow;
1238
1239     # get notforloan authorised value list
1240     $sth =
1241       $dbh->prepare(
1242 "SELECT authorised_value FROM `marc_subfield_structure` WHERE kohafield = 'items.notforloan' AND frameworkcode=''"
1243       );
1244     $sth->execute;
1245     my ($notforloan_authorised_value) = $sth->fetchrow;
1246
1247     ## find column names of items related to MARC
1248     my $sth2 = $dbh->prepare("SHOW COLUMNS FROM items");
1249     $sth2->execute;
1250     my %subfieldstosearch;
1251     while ( ( my $column ) = $sth2->fetchrow ) {
1252         my ( $tagfield, $tagsubfield ) =
1253           &GetMarcFromKohaField( "items." . $column, "" );
1254         $subfieldstosearch{$column} = $tagsubfield;
1255     }
1256
1257     # handle which records to actually retrieve
1258     my $times;
1259     if ( $hits && $offset + $results_per_page <= $hits ) {
1260         $times = $offset + $results_per_page;
1261     }
1262     else {
1263         $times = $hits;
1264     }
1265
1266     # loop through all of the records we've retrieved
1267     for ( my $i = $offset ; $i <= $times - 1 ; $i++ ) {
1268         my $marcrecord;
1269         $marcrecord = MARC::File::USMARC::decode( $marcresults[$i] );
1270         my $oldbiblio = TransformMarcToKoha( $dbh, $marcrecord, '' );
1271         $oldbiblio->{result_number} = $i + 1;
1272
1273         # add imageurl to itemtype if there is one
1274         if ( $itemtypes{ $oldbiblio->{itemtype} }->{imageurl} =~ /^http:/ ) {
1275             $oldbiblio->{imageurl} =
1276               $itemtypes{ $oldbiblio->{itemtype} }->{imageurl};
1277             $oldbiblio->{description} =
1278               $itemtypes{ $oldbiblio->{itemtype} }->{description};
1279         }
1280         else {
1281             $oldbiblio->{imageurl} =
1282               getitemtypeimagesrc() . "/"
1283               . $itemtypes{ $oldbiblio->{itemtype} }->{imageurl}
1284               if ( $itemtypes{ $oldbiblio->{itemtype} }->{imageurl} );
1285             $oldbiblio->{description} =
1286               $itemtypes{ $oldbiblio->{itemtype} }->{description};
1287         }
1288
1289  # Build summary if there is one (the summary is defined in the itemtypes table)
1290  # FIXME: is this used anywhere, I think it can be commented out? -- JF
1291         if ( $itemtypes{ $oldbiblio->{itemtype} }->{summary} ) {
1292             my $summary = $itemtypes{ $oldbiblio->{itemtype} }->{summary};
1293             my @fields  = $marcrecord->fields();
1294             foreach my $field (@fields) {
1295                 my $tag      = $field->tag();
1296                 my $tagvalue = $field->as_string();
1297                 $summary =~
1298                   s/\[(.?.?.?.?)$tag\*(.*?)]/$1$tagvalue$2\[$1$tag$2]/g;
1299                 unless ( $tag < 10 ) {
1300                     my @subf = $field->subfields;
1301                     for my $i ( 0 .. $#subf ) {
1302                         my $subfieldcode  = $subf[$i][0];
1303                         my $subfieldvalue = $subf[$i][1];
1304                         my $tagsubf       = $tag . $subfieldcode;
1305                         $summary =~
1306 s/\[(.?.?.?.?)$tagsubf(.*?)]/$1$subfieldvalue$2\[$1$tagsubf$2]/g;
1307                     }
1308                 }
1309             }
1310             # FIXME: yuk
1311             $summary =~ s/\[(.*?)]//g;
1312             $summary =~ s/\n/<br\/>/g;
1313             $oldbiblio->{summary} = $summary;
1314         }
1315
1316 # Add search-term highlighting to the whole record where they match using <span>s
1317         if (C4::Context->preference("OpacHighlightedWords")){
1318             my $searchhighlightblob;
1319             for my $highlight_field ( $marcrecord->fields ) {
1320
1321     # FIXME: need to skip title, subtitle, author, etc., as they are handled below
1322                 next if $highlight_field->tag() =~ /(^00)/;    # skip fixed fields
1323                 for my $subfield ($highlight_field->subfields()) {
1324                     my $match;
1325                     next if $subfield->[0] eq '9';
1326                     my $field = $subfield->[1];
1327                     for my $term ( keys %$span_terms_hashref ) {
1328                         if ( ( $field =~ /$term/i ) && (( length($term) > 3 ) || ($field =~ / $term /i)) ) {
1329                             $field =~ s/$term/<span class=\"term\">$&<\/span>/gi;
1330                         $match++;
1331                         }
1332                     }
1333                     $searchhighlightblob .= $field . " ... " if $match;
1334                 }
1335
1336             }
1337             $searchhighlightblob = ' ... '.$searchhighlightblob if $searchhighlightblob;
1338             $oldbiblio->{'searchhighlightblob'} = $searchhighlightblob;
1339         }
1340 # save an author with no <span> tag, for the <a href=search.pl?q=<!--tmpl_var name="author"-->> link
1341         $oldbiblio->{'author_nospan'} = $oldbiblio->{'author'};
1342
1343         # Add search-term highlighting to the title, subtitle, etc. fields
1344         for my $term ( keys %$span_terms_hashref ) {
1345             my $old_term = $term;
1346             if ( length($term) > 3 ) {
1347                 $term =~ s/(.*=|\)|\(|\+|\.|\?|\[|\]|\\|\*)//g;
1348                 $oldbiblio->{'title'} =~
1349                   s/$term/<span class=\"term\">$&<\/span>/gi;
1350                 $oldbiblio->{'subtitle'} =~
1351                   s/$term/<span class=\"term\">$&<\/span>/gi;
1352                 $oldbiblio->{'author'} =~
1353                   s/$term/<span class=\"term\">$&<\/span>/gi;
1354                 $oldbiblio->{'publishercode'} =~
1355                   s/$term/<span class=\"term\">$&<\/span>/gi;
1356                 $oldbiblio->{'place'} =~
1357                   s/$term/<span class=\"term\">$&<\/span>/gi;
1358                 $oldbiblio->{'pages'} =~
1359                   s/$term/<span class=\"term\">$&<\/span>/gi;
1360                 $oldbiblio->{'notes'} =~
1361                   s/$term/<span class=\"term\">$&<\/span>/gi;
1362                 $oldbiblio->{'size'} =~
1363                   s/$term/<span class=\"term\">$&<\/span>/gi;
1364             }
1365         }
1366
1367         # FIXME:
1368         # surely there's a better way to handle this
1369         if ( $i % 2 ) {
1370             $toggle = "#ffffcc";
1371         }
1372         else {
1373             $toggle = "white";
1374         }
1375         $oldbiblio->{'toggle'} = $toggle;
1376
1377         # Pull out the items fields
1378         my @fields = $marcrecord->field($itemtag);
1379
1380         # Setting item statuses for display
1381         my @available_items_loop;
1382         my @onloan_items_loop;
1383         my @other_items_loop;
1384
1385         my $available_items;
1386         my $onloan_items;
1387         my $other_items;
1388
1389         my $ordered_count     = 0;
1390         my $available_count   = 0;
1391         my $onloan_count      = 0;
1392         my $longoverdue_count = 0;
1393         my $other_count       = 0;
1394         my $wthdrawn_count    = 0;
1395         my $itemlost_count    = 0;
1396         my $itembinding_count = 0;
1397         my $itemdamaged_count = 0;
1398         my $can_place_holds   = 0;
1399         my $items_count       = scalar(@fields);
1400         my $items_counter;
1401         my $maxitems =
1402           ( C4::Context->preference('maxItemsinSearchResults') )
1403           ? C4::Context->preference('maxItemsinSearchResults') - 1
1404           : 1;
1405
1406         # loop through every item
1407         foreach my $field (@fields) {
1408             my $item;
1409             $items_counter++;
1410
1411             # populate the items hash
1412             foreach my $code ( keys %subfieldstosearch ) {
1413                 $item->{$code} = $field->subfield( $subfieldstosearch{$code} );
1414             }
1415                         my $hbranch     = C4::Context->preference('HomeOrHoldingBranch') eq 'homebranch' ? 'homebranch'    : 'holdingbranch';
1416                         my $otherbranch = C4::Context->preference('HomeOrHoldingBranch') eq 'homebranch' ? 'holdingbranch' : 'homebranch';
1417             # set item's branch name, use HomeOrHoldingBranch syspref first, fall back to the other one
1418             if ($item->{$hbranch}) {
1419                 $item->{'branchname'} = $branches{$item->{$hbranch}};
1420             }
1421             elsif ($item->{$otherbranch}) {     # Last resort
1422                 $item->{'branchname'} = $branches{$item->{$otherbranch}};
1423             }
1424
1425                         my $prefix = $item->{$hbranch} . '--' . $item->{location} . $item->{itype} . $item->{itemcallnumber};
1426 # For each grouping of items (onloan, available, unavailable), we build a key to store relevant info about that item
1427             if ( $item->{onloan} ) {
1428                 $onloan_count++;
1429                                 my $key = $prefix . $item->{due_date};
1430                                 $onloan_items->{$key}->{due_date} = format_date($item->{onloan});
1431                                 $onloan_items->{$key}->{count}++ if $item->{homebranch};
1432                                 $onloan_items->{$key}->{branchname} = $item->{branchname};
1433                                 $onloan_items->{$key}->{location} = $locations{ $item->{location} };
1434                                 $onloan_items->{$key}->{itemcallnumber} = $item->{itemcallnumber};
1435                                 $onloan_items->{$key}->{imageurl} = getitemtypeimagesrc() . "/" . $itemtypes{ $item->{itype} }->{imageurl};
1436                 # if something's checked out and lost, mark it as 'long overdue'
1437                 if ( $item->{itemlost} ) {
1438                     $onloan_items->{$prefix}->{longoverdue}++;
1439                     $longoverdue_count++;
1440                 } else {        # can place holds as long as item isn't lost
1441                     $can_place_holds = 1;
1442                 }
1443             }
1444
1445          # items not on loan, but still unavailable ( lost, withdrawn, damaged )
1446             else {
1447
1448                 # item is on order
1449                 if ( $item->{notforloan} == -1 ) {
1450                     $ordered_count++;
1451                 }
1452
1453                 # item is withdrawn, lost or damaged
1454                 if (   $item->{wthdrawn}
1455                     || $item->{itemlost}
1456                     || $item->{damaged}
1457                     || $item->{notforloan} )
1458                 {
1459                     $wthdrawn_count++    if $item->{wthdrawn};
1460                     $itemlost_count++    if $item->{itemlost};
1461                     $itemdamaged_count++ if $item->{damaged};
1462                     $item->{status} = $item->{wthdrawn} . "-" . $item->{itemlost} . "-" . $item->{damaged} . "-" . $item->{notforloan};
1463                     $other_count++;
1464
1465                                         my $key = $prefix . $item->{status};
1466                                         foreach (qw(wthdrawn itemlost damaged branchname itemcallnumber)) {
1467                         $other_items->{$key}->{$_} = $item->{$_};
1468                                         }
1469                                         $other_items->{$key}->{notforloan} = GetAuthorisedValueDesc('','',$item->{notforloan},'','',$notforloan_authorised_value) if $notforloan_authorised_value;
1470                                         $other_items->{$key}->{count}++ if $item->{homebranch};
1471                                         $other_items->{$key}->{location} = $locations{ $item->{location} };
1472                                         $other_items->{$key}->{imageurl} = getitemtypeimagesrc() . "/" . $itemtypes{ $item->{itype} }->{imageurl};
1473                 }
1474                 # item is available
1475                 else {
1476                     $can_place_holds = 1;
1477                     $available_count++;
1478                                         $available_items->{$prefix}->{count}++ if $item->{homebranch};
1479                                         foreach (qw(branchname itemcallnumber)) {
1480                         $available_items->{$prefix}->{$_} = $item->{$_};
1481                                         }
1482                                         $available_items->{$prefix}->{location} = $locations{ $item->{location} };
1483                                         $available_items->{$prefix}->{imageurl} = getitemtypeimagesrc() . "/" . $itemtypes{ $item->{itype} }->{imageurl};
1484                 }
1485             }
1486         }    # notforloan, item level and biblioitem level
1487         my ( $availableitemscount, $onloanitemscount, $otheritemscount );
1488         $maxitems =
1489           ( C4::Context->preference('maxItemsinSearchResults') )
1490           ? C4::Context->preference('maxItemsinSearchResults') - 1
1491           : 1;
1492         for my $key ( sort keys %$onloan_items ) {
1493             $onloanitemscount++;
1494             push @onloan_items_loop, $onloan_items->{$key}
1495               unless $onloanitemscount > $maxitems;
1496         }
1497         for my $key ( sort keys %$other_items ) {
1498             $otheritemscount++;
1499             push @other_items_loop, $other_items->{$key}
1500               unless $otheritemscount > $maxitems;
1501         }
1502         for my $key ( sort keys %$available_items ) {
1503             $availableitemscount++;
1504             push @available_items_loop, $available_items->{$key}
1505               unless $availableitemscount > $maxitems;
1506         }
1507
1508 # last check for norequest : if itemtype is notforloan, it can't be reserved either, whatever the items
1509         $can_place_holds = 0
1510           if $itemtypes{ $oldbiblio->{itemtype} }->{notforloan};
1511         $oldbiblio->{norequests} = 1 unless $can_place_holds;
1512         $oldbiblio->{itemsplural}          = 1 if $items_count > 1;
1513         $oldbiblio->{items_count}          = $items_count;
1514         $oldbiblio->{available_items_loop} = \@available_items_loop;
1515         $oldbiblio->{onloan_items_loop}    = \@onloan_items_loop;
1516         $oldbiblio->{other_items_loop}     = \@other_items_loop;
1517         $oldbiblio->{availablecount}       = $available_count;
1518         $oldbiblio->{availableplural}      = 1 if $available_count > 1;
1519         $oldbiblio->{onloancount}          = $onloan_count;
1520         $oldbiblio->{onloanplural}         = 1 if $onloan_count > 1;
1521         $oldbiblio->{othercount}           = $other_count;
1522         $oldbiblio->{otherplural}          = 1 if $other_count > 1;
1523         $oldbiblio->{wthdrawncount}        = $wthdrawn_count;
1524         $oldbiblio->{itemlostcount}        = $itemlost_count;
1525         $oldbiblio->{damagedcount}         = $itemdamaged_count;
1526         $oldbiblio->{orderedcount}         = $ordered_count;
1527         $oldbiblio->{isbn} =~
1528           s/-//g;    # deleting - in isbn to enable amazon content
1529         push( @newresults, $oldbiblio );
1530     }
1531     return @newresults;
1532 }
1533
1534 #----------------------------------------------------------------------
1535 #
1536 # Non-Zebra GetRecords#
1537 #----------------------------------------------------------------------
1538
1539 =head2 NZgetRecords
1540
1541   NZgetRecords has the same API as zera getRecords, even if some parameters are not managed
1542
1543 =cut
1544
1545 sub NZgetRecords {
1546     my (
1547         $query,            $simple_query, $sort_by_ref,    $servers_ref,
1548         $results_per_page, $offset,       $expanded_facet, $branches,
1549         $query_type,       $scan
1550     ) = @_;
1551     warn "query =$query" if $DEBUG;
1552     my $result = NZanalyse($query);
1553     warn "results =$result" if $DEBUG;
1554     return ( undef,
1555         NZorder( $result, @$sort_by_ref[0], $results_per_page, $offset ),
1556         undef );
1557 }
1558
1559 =head2 NZanalyse
1560
1561   NZanalyse : get a CQL string as parameter, and returns a list of biblionumber;title,biblionumber;title,...
1562   the list is built from an inverted index in the nozebra SQL table
1563   note that title is here only for convenience : the sorting will be very fast when requested on title
1564   if the sorting is requested on something else, we will have to reread all results, and that may be longer.
1565
1566 =cut
1567
1568 sub NZanalyse {
1569     my ( $string, $server ) = @_;
1570 #     warn "---------"       if $DEBUG;
1571     warn " NZanalyse" if $DEBUG;
1572 #     warn "---------"       if $DEBUG;
1573
1574  # $server contains biblioserver or authorities, depending on what we search on.
1575  #warn "querying : $string on $server";
1576     $server = 'biblioserver' unless $server;
1577
1578 # if we have a ", replace the content to discard temporarily any and/or/not inside
1579     my $commacontent;
1580     if ( $string =~ /"/ ) {
1581         $string =~ s/"(.*?)"/__X__/;
1582         $commacontent = $1;
1583         warn "commacontent : $commacontent" if $DEBUG;
1584     }
1585
1586 # split the query string in 3 parts : X AND Y means : $left="X", $operand="AND" and $right="Y"
1587 # then, call again NZanalyse with $left and $right
1588 # (recursive until we find a leaf (=> something without and/or/not)
1589 # delete repeated operator... Would then go in infinite loop
1590     while ( $string =~ s/( and| or| not| AND| OR| NOT)\1/$1/g ) {
1591     }
1592
1593     #process parenthesis before.
1594     if ( $string =~ /^\s*\((.*)\)(( and | or | not | AND | OR | NOT )(.*))?/ ) {
1595         my $left     = $1;
1596         my $right    = $4;
1597         my $operator = lc($3);   # FIXME: and/or/not are operators, not operands
1598         warn
1599 "dealing w/parenthesis before recursive sub call. left :$left operator:$operator right:$right"
1600           if $DEBUG;
1601         my $leftresult = NZanalyse( $left, $server );
1602         if ($operator) {
1603             my $rightresult = NZanalyse( $right, $server );
1604
1605             # OK, we have the results for right and left part of the query
1606             # depending of operand, intersect, union or exclude both lists
1607             # to get a result list
1608             if ( $operator eq ' and ' ) {
1609                 return NZoperatorAND($leftresult,$rightresult);
1610             }
1611             elsif ( $operator eq ' or ' ) {
1612
1613                 # just merge the 2 strings
1614                 return $leftresult . $rightresult;
1615             }
1616             elsif ( $operator eq ' not ' ) {
1617                 return NZoperatorNOT($leftresult,$rightresult);
1618             }
1619         }
1620         else {
1621 # this error is impossible, because of the regexp that isolate the operand, but just in case...
1622             return $leftresult;
1623         }
1624     }
1625     warn "string :" . $string if $DEBUG;
1626     $string =~ /(.*?)( and | or | not | AND | OR | NOT )(.*)/;
1627     my $left     = $1;
1628     my $right    = $3;
1629     my $operator = lc($2);    # FIXME: and/or/not are operators, not operands
1630     warn "no parenthesis. left : $left operator: $operator right: $right"
1631       if $DEBUG;
1632
1633     # it's not a leaf, we have a and/or/not
1634     if ($operator) {
1635
1636         # reintroduce comma content if needed
1637         $right =~ s/__X__/"$commacontent"/ if $commacontent;
1638         $left  =~ s/__X__/"$commacontent"/ if $commacontent;
1639         warn "node : $left / $operator / $right\n" if $DEBUG;
1640         my $leftresult  = NZanalyse( $left,  $server );
1641         my $rightresult = NZanalyse( $right, $server );
1642         warn " leftresult : $leftresult" if $DEBUG;
1643         warn " rightresult : $rightresult" if $DEBUG;
1644         # OK, we have the results for right and left part of the query
1645         # depending of operand, intersect, union or exclude both lists
1646         # to get a result list
1647         if ( $operator eq ' and ' ) {
1648             warn "NZAND";
1649             return NZoperatorAND($leftresult,$rightresult);
1650         }
1651         elsif ( $operator eq ' or ' ) {
1652
1653             # just merge the 2 strings
1654             return $leftresult . $rightresult;
1655         }
1656         elsif ( $operator eq ' not ' ) {
1657             return NZoperatorNOT($leftresult,$rightresult);
1658         }
1659         else {
1660
1661 # this error is impossible, because of the regexp that isolate the operand, but just in case...
1662             die "error : operand unknown : $operator for $string";
1663         }
1664
1665         # it's a leaf, do the real SQL query and return the result
1666     }
1667     else {
1668         $string =~ s/__X__/"$commacontent"/ if $commacontent;
1669         $string =~ s/-|\.|\?|,|;|!|'|\(|\)|\[|\]|{|}|"|&|\+|\*|\// /g;
1670         #remove trailing blank at the beginning
1671         $string =~ s/^ //g;
1672         warn "leaf:$string" if $DEBUG;
1673
1674         # parse the string in in operator/operand/value again
1675         $string =~ /(.*)(>=|<=)(.*)/;
1676         my $left     = $1;
1677         my $operator = $2;
1678         my $right    = $3;
1679 #         warn "handling leaf... left:$left operator:$operator right:$right"
1680 #           if $DEBUG;
1681         unless ($operator) {
1682             $string =~ /(.*)(>|<|=)(.*)/;
1683             $left     = $1;
1684             $operator = $2;
1685             $right    = $3;
1686             warn
1687 "handling unless (operator)... left:$left operator:$operator right:$right"
1688               if $DEBUG;
1689         }
1690         my $results;
1691
1692 # strip adv, zebra keywords, currently not handled in nozebra: wrdl, ext, phr...
1693         $left =~ s/ .*$//;
1694
1695         # automatic replace for short operators
1696         $left = 'title'            if $left =~ '^ti$';
1697         $left = 'author'           if $left =~ '^au$';
1698         $left = 'publisher'        if $left =~ '^pb$';
1699         $left = 'subject'          if $left =~ '^su$';
1700         $left = 'koha-Auth-Number' if $left =~ '^an$';
1701         $left = 'keyword'          if $left =~ '^kw$';
1702         warn "handling leaf... left:$left operator:$operator right:$right" if $DEBUG;
1703         if ( $operator && $left ne 'keyword' ) {
1704
1705             #do a specific search
1706             my $dbh = C4::Context->dbh;
1707             $operator = 'LIKE' if $operator eq '=' and $right =~ /%/;
1708             my $sth =
1709               $dbh->prepare(
1710 "SELECT biblionumbers,value FROM nozebra WHERE server=? AND indexname=? AND value $operator ?"
1711               );
1712             warn "$left / $operator / $right\n" if $DEBUG;
1713
1714             # split each word, query the DB and build the biblionumbers result
1715             #sanitizing leftpart
1716             $left =~ s/^\s+|\s+$//;
1717             foreach ( split / /, $right ) {
1718                 my $biblionumbers;
1719                 $_ =~ s/^\s+|\s+$//;
1720                 next unless $_;
1721                 warn "EXECUTE : $server, $left, $_" if $DEBUG;
1722                 $sth->execute( $server, $left, $_ )
1723                   or warn "execute failed: $!";
1724                 while ( my ( $line, $value ) = $sth->fetchrow ) {
1725
1726 # if we are dealing with a numeric value, use only numeric results (in case of >=, <=, > or <)
1727 # otherwise, fill the result
1728                     $biblionumbers .= $line
1729                       unless ( $right =~ /^\d+$/ && $value =~ /\D/ );
1730                     warn "result : $value "
1731                       . ( $right  =~ /\d/ ) . "=="
1732                       . ( $value =~ /\D/?$line:"" ) if $DEBUG;         #= $line";
1733                 }
1734
1735 # do a AND with existing list if there is one, otherwise, use the biblionumbers list as 1st result list
1736                 if ($results) {
1737                     warn "NZAND" if $DEBUG;
1738                     $results = NZoperatorAND($biblionumbers,$results);
1739                 }
1740                 else {
1741                     $results = $biblionumbers;
1742                 }
1743             }
1744         }
1745         else {
1746
1747       #do a complete search (all indexes), if index='kw' do complete search too.
1748             my $dbh = C4::Context->dbh;
1749             my $sth =
1750               $dbh->prepare(
1751 "SELECT biblionumbers FROM nozebra WHERE server=? AND value LIKE ?"
1752               );
1753
1754             # split each word, query the DB and build the biblionumbers result
1755             foreach ( split / /, $string ) {
1756                 next if C4::Context->stopwords->{ uc($_) };   # skip if stopword
1757                 warn "search on all indexes on $_" if $DEBUG;
1758                 my $biblionumbers;
1759                 next unless $_;
1760                 $sth->execute( $server, $_ );
1761                 while ( my $line = $sth->fetchrow ) {
1762                     $biblionumbers .= $line;
1763                 }
1764
1765 # do a AND with existing list if there is one, otherwise, use the biblionumbers list as 1st result list
1766                 if ($results) {
1767                     $results = NZoperatorAND($biblionumbers,$results);
1768                 }
1769                 else {
1770                     warn "NEW RES for $_ = $biblionumbers" if $DEBUG;
1771                     $results = $biblionumbers;
1772                 }
1773             }
1774         }
1775         warn "return : $results for LEAF : $string" if $DEBUG;
1776         return $results;
1777     }
1778     warn "---------"       if $DEBUG;
1779     warn "Leave NZanalyse" if $DEBUG;
1780     warn "---------"       if $DEBUG;
1781 }
1782
1783 sub NZoperatorAND{
1784     my ($rightresult, $leftresult)=@_;
1785
1786     my @leftresult = split /;/, $leftresult;
1787     warn " @leftresult / $rightresult \n" if $DEBUG;
1788
1789     #             my @rightresult = split /;/,$leftresult;
1790     my $finalresult;
1791
1792 # parse the left results, and if the biblionumber exist in the right result, save it in finalresult
1793 # the result is stored twice, to have the same weight for AND than OR.
1794 # example : TWO : 61,61,64,121 (two is twice in the biblio #61) / TOWER : 61,64,130
1795 # result : 61,61,61,61,64,64 for two AND tower : 61 has more weight than 64
1796     foreach (@leftresult) {
1797         my $value = $_;
1798         my $countvalue;
1799         ( $value, $countvalue ) = ( $1, $2 ) if ($value=~/(.*)-(\d+)$/);
1800         if ( $rightresult =~ /\Q$value\E-(\d+);/ ) {
1801             $countvalue = ( $1 > $countvalue ? $countvalue : $1 );
1802             $finalresult .=
1803                 "$value-$countvalue;$value-$countvalue;";
1804         }
1805     }
1806     warn "NZAND DONE : $finalresult \n" if $DEBUG;
1807     return $finalresult;
1808 }
1809
1810 sub NZoperatorOR{
1811     my ($rightresult, $leftresult)=@_;
1812     return $rightresult.$leftresult;
1813 }
1814
1815 sub NZoperatorNOT{
1816     my ($rightresult, $leftresult)=@_;
1817
1818     my @leftresult = split /;/, $leftresult;
1819
1820     #             my @rightresult = split /;/,$leftresult;
1821     my $finalresult;
1822     foreach (@leftresult) {
1823         my $value=$_;
1824         $value=$1 if $value=~m/(.*)-\d+$/;
1825         unless ($rightresult =~ "$value-") {
1826             $finalresult .= "$_;";
1827         }
1828     }
1829     return $finalresult;
1830 }
1831
1832 =head2 NZorder
1833
1834   $finalresult = NZorder($biblionumbers, $ordering,$results_per_page,$offset);
1835
1836   TODO :: Description
1837
1838 =cut
1839
1840 sub NZorder {
1841     my ( $biblionumbers, $ordering, $results_per_page, $offset ) = @_;
1842     warn "biblionumbers = $biblionumbers and ordering = $ordering\n" if $DEBUG;
1843
1844     # order title asc by default
1845     #     $ordering = '1=36 <i' unless $ordering;
1846     $results_per_page = 20 unless $results_per_page;
1847     $offset           = 0  unless $offset;
1848     my $dbh = C4::Context->dbh;
1849
1850     #
1851     # order by POPULARITY
1852     #
1853     if ( $ordering =~ /popularity/ ) {
1854         my %result;
1855         my %popularity;
1856
1857         # popularity is not in MARC record, it's builded from a specific query
1858         my $sth =
1859           $dbh->prepare("select sum(issues) from items where biblionumber=?");
1860         foreach ( split /;/, $biblionumbers ) {
1861             my ( $biblionumber, $title ) = split /,/, $_;
1862             $result{$biblionumber} = GetMarcBiblio($biblionumber);
1863             $sth->execute($biblionumber);
1864             my $popularity = $sth->fetchrow || 0;
1865
1866 # hint : the key is popularity.title because we can have
1867 # many results with the same popularity. In this cas, sub-ordering is done by title
1868 # we also have biblionumber to avoid bug for 2 biblios with the same title & popularity
1869 # (un-frequent, I agree, but we won't forget anything that way ;-)
1870             $popularity{ sprintf( "%10d", $popularity ) . $title
1871                   . $biblionumber } = $biblionumber;
1872         }
1873
1874     # sort the hash and return the same structure as GetRecords (Zebra querying)
1875         my $result_hash;
1876         my $numbers = 0;
1877         if ( $ordering eq 'popularity_dsc' ) {    # sort popularity DESC
1878             foreach my $key ( sort { $b cmp $a } ( keys %popularity ) ) {
1879                 $result_hash->{'RECORDS'}[ $numbers++ ] =
1880                   $result{ $popularity{$key} }->as_usmarc();
1881             }
1882         }
1883         else {                                    # sort popularity ASC
1884             foreach my $key ( sort ( keys %popularity ) ) {
1885                 $result_hash->{'RECORDS'}[ $numbers++ ] =
1886                   $result{ $popularity{$key} }->as_usmarc();
1887             }
1888         }
1889         my $finalresult = ();
1890         $result_hash->{'hits'}         = $numbers;
1891         $finalresult->{'biblioserver'} = $result_hash;
1892         return $finalresult;
1893
1894         #
1895         # ORDER BY author
1896         #
1897     }
1898     elsif ( $ordering =~ /author/ ) {
1899         my %result;
1900         foreach ( split /;/, $biblionumbers ) {
1901             my ( $biblionumber, $title ) = split /,/, $_;
1902             my $record = GetMarcBiblio($biblionumber);
1903             my $author;
1904             if ( C4::Context->preference('marcflavour') eq 'UNIMARC' ) {
1905                 $author = $record->subfield( '200', 'f' );
1906                 $author = $record->subfield( '700', 'a' ) unless $author;
1907             }
1908             else {
1909                 $author = $record->subfield( '100', 'a' );
1910             }
1911
1912 # hint : the result is sorted by title.biblionumber because we can have X biblios with the same title
1913 # and we don't want to get only 1 result for each of them !!!
1914             $result{ $author . $biblionumber } = $record;
1915         }
1916
1917     # sort the hash and return the same structure as GetRecords (Zebra querying)
1918         my $result_hash;
1919         my $numbers = 0;
1920         if ( $ordering eq 'author_za' ) {    # sort by author desc
1921             foreach my $key ( sort { $b cmp $a } ( keys %result ) ) {
1922                 $result_hash->{'RECORDS'}[ $numbers++ ] =
1923                   $result{$key}->as_usmarc();
1924             }
1925         }
1926         else {                               # sort by author ASC
1927             foreach my $key ( sort ( keys %result ) ) {
1928                 $result_hash->{'RECORDS'}[ $numbers++ ] =
1929                   $result{$key}->as_usmarc();
1930             }
1931         }
1932         my $finalresult = ();
1933         $result_hash->{'hits'}         = $numbers;
1934         $finalresult->{'biblioserver'} = $result_hash;
1935         return $finalresult;
1936
1937         #
1938         # ORDER BY callnumber
1939         #
1940     }
1941     elsif ( $ordering =~ /callnumber/ ) {
1942         my %result;
1943         foreach ( split /;/, $biblionumbers ) {
1944             my ( $biblionumber, $title ) = split /,/, $_;
1945             my $record = GetMarcBiblio($biblionumber);
1946             my $callnumber;
1947             my ( $callnumber_tag, $callnumber_subfield ) =
1948               GetMarcFromKohaField( $dbh, 'items.itemcallnumber' );
1949             ( $callnumber_tag, $callnumber_subfield ) =
1950               GetMarcFromKohaField('biblioitems.callnumber')
1951               unless $callnumber_tag;
1952             if ( C4::Context->preference('marcflavour') eq 'UNIMARC' ) {
1953                 $callnumber = $record->subfield( '200', 'f' );
1954             }
1955             else {
1956                 $callnumber = $record->subfield( '100', 'a' );
1957             }
1958
1959 # hint : the result is sorted by title.biblionumber because we can have X biblios with the same title
1960 # and we don't want to get only 1 result for each of them !!!
1961             $result{ $callnumber . $biblionumber } = $record;
1962         }
1963
1964     # sort the hash and return the same structure as GetRecords (Zebra querying)
1965         my $result_hash;
1966         my $numbers = 0;
1967         if ( $ordering eq 'call_number_dsc' ) {    # sort by title desc
1968             foreach my $key ( sort { $b cmp $a } ( keys %result ) ) {
1969                 $result_hash->{'RECORDS'}[ $numbers++ ] =
1970                   $result{$key}->as_usmarc();
1971             }
1972         }
1973         else {                                     # sort by title ASC
1974             foreach my $key ( sort { $a cmp $b } ( keys %result ) ) {
1975                 $result_hash->{'RECORDS'}[ $numbers++ ] =
1976                   $result{$key}->as_usmarc();
1977             }
1978         }
1979         my $finalresult = ();
1980         $result_hash->{'hits'}         = $numbers;
1981         $finalresult->{'biblioserver'} = $result_hash;
1982         return $finalresult;
1983     }
1984     elsif ( $ordering =~ /pubdate/ ) {             #pub year
1985         my %result;
1986         foreach ( split /;/, $biblionumbers ) {
1987             my ( $biblionumber, $title ) = split /,/, $_;
1988             my $record = GetMarcBiblio($biblionumber);
1989             my ( $publicationyear_tag, $publicationyear_subfield ) =
1990               GetMarcFromKohaField( 'biblioitems.publicationyear', '' );
1991             my $publicationyear =
1992               $record->subfield( $publicationyear_tag,
1993                 $publicationyear_subfield );
1994
1995 # hint : the result is sorted by title.biblionumber because we can have X biblios with the same title
1996 # and we don't want to get only 1 result for each of them !!!
1997             $result{ $publicationyear . $biblionumber } = $record;
1998         }
1999
2000     # sort the hash and return the same structure as GetRecords (Zebra querying)
2001         my $result_hash;
2002         my $numbers = 0;
2003         if ( $ordering eq 'pubdate_dsc' ) {    # sort by pubyear desc
2004             foreach my $key ( sort { $b cmp $a } ( keys %result ) ) {
2005                 $result_hash->{'RECORDS'}[ $numbers++ ] =
2006                   $result{$key}->as_usmarc();
2007             }
2008         }
2009         else {                                 # sort by pub year ASC
2010             foreach my $key ( sort ( keys %result ) ) {
2011                 $result_hash->{'RECORDS'}[ $numbers++ ] =
2012                   $result{$key}->as_usmarc();
2013             }
2014         }
2015         my $finalresult = ();
2016         $result_hash->{'hits'}         = $numbers;
2017         $finalresult->{'biblioserver'} = $result_hash;
2018         return $finalresult;
2019
2020         #
2021         # ORDER BY title
2022         #
2023     }
2024     elsif ( $ordering =~ /title/ ) {
2025
2026 # the title is in the biblionumbers string, so we just need to build a hash, sort it and return
2027         my %result;
2028         foreach ( split /;/, $biblionumbers ) {
2029             my ( $biblionumber, $title ) = split /,/, $_;
2030
2031 # hint : the result is sorted by title.biblionumber because we can have X biblios with the same title
2032 # and we don't want to get only 1 result for each of them !!!
2033 # hint & speed improvement : we can order without reading the record
2034 # so order, and read records only for the requested page !
2035             $result{ $title . $biblionumber } = $biblionumber;
2036         }
2037
2038     # sort the hash and return the same structure as GetRecords (Zebra querying)
2039         my $result_hash;
2040         my $numbers = 0;
2041         if ( $ordering eq 'title_az' ) {    # sort by title desc
2042             foreach my $key ( sort ( keys %result ) ) {
2043                 $result_hash->{'RECORDS'}[ $numbers++ ] = $result{$key};
2044             }
2045         }
2046         else {                              # sort by title ASC
2047             foreach my $key ( sort { $b cmp $a } ( keys %result ) ) {
2048                 $result_hash->{'RECORDS'}[ $numbers++ ] = $result{$key};
2049             }
2050         }
2051
2052         # limit the $results_per_page to result size if it's more
2053         $results_per_page = $numbers - 1 if $numbers < $results_per_page;
2054
2055         # for the requested page, replace biblionumber by the complete record
2056         # speed improvement : avoid reading too much things
2057         for (
2058             my $counter = $offset ;
2059             $counter <= $offset + $results_per_page ;
2060             $counter++
2061           )
2062         {
2063             $result_hash->{'RECORDS'}[$counter] =
2064               GetMarcBiblio( $result_hash->{'RECORDS'}[$counter] )->as_usmarc;
2065         }
2066         my $finalresult = ();
2067         $result_hash->{'hits'}         = $numbers;
2068         $finalresult->{'biblioserver'} = $result_hash;
2069         return $finalresult;
2070     }
2071     else {
2072
2073 #
2074 # order by ranking
2075 #
2076 # we need 2 hashes to order by ranking : the 1st one to count the ranking, the 2nd to order by ranking
2077         my %result;
2078         my %count_ranking;
2079         foreach ( split /;/, $biblionumbers ) {
2080             my ( $biblionumber, $title ) = split /,/, $_;
2081             $title =~ /(.*)-(\d)/;
2082
2083             # get weight
2084             my $ranking = $2;
2085
2086 # note that we + the ranking because ranking is calculated on weight of EACH term requested.
2087 # if we ask for "two towers", and "two" has weight 2 in biblio N, and "towers" has weight 4 in biblio N
2088 # biblio N has ranking = 6
2089             $count_ranking{$biblionumber} += $ranking;
2090         }
2091
2092 # build the result by "inverting" the count_ranking hash
2093 # 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
2094 #         warn "counting";
2095         foreach ( keys %count_ranking ) {
2096             $result{ sprintf( "%10d", $count_ranking{$_} ) . '-' . $_ } = $_;
2097         }
2098
2099     # sort the hash and return the same structure as GetRecords (Zebra querying)
2100         my $result_hash;
2101         my $numbers = 0;
2102         foreach my $key ( sort { $b cmp $a } ( keys %result ) ) {
2103             $result_hash->{'RECORDS'}[ $numbers++ ] = $result{$key};
2104         }
2105
2106         # limit the $results_per_page to result size if it's more
2107         $results_per_page = $numbers - 1 if $numbers < $results_per_page;
2108
2109         # for the requested page, replace biblionumber by the complete record
2110         # speed improvement : avoid reading too much things
2111         for (
2112             my $counter = $offset ;
2113             $counter <= $offset + $results_per_page ;
2114             $counter++
2115           )
2116         {
2117             $result_hash->{'RECORDS'}[$counter] =
2118               GetMarcBiblio( $result_hash->{'RECORDS'}[$counter] )->as_usmarc
2119               if $result_hash->{'RECORDS'}[$counter];
2120         }
2121         my $finalresult = ();
2122         $result_hash->{'hits'}         = $numbers;
2123         $finalresult->{'biblioserver'} = $result_hash;
2124         return $finalresult;
2125     }
2126 }
2127
2128 =head2 ModBiblios
2129
2130 ($countchanged,$listunchanged) = ModBiblios($listbiblios, $tagsubfield,$initvalue,$targetvalue,$test);
2131
2132 this function changes all the values $initvalue in subfield $tag$subfield in any record in $listbiblios
2133 test parameter if set donot perform change to records in database.
2134
2135 =over 2
2136
2137 =item C<input arg:>
2138
2139     * $listbiblios is an array ref to marcrecords to be changed
2140     * $tagsubfield is the reference of the subfield to change.
2141     * $initvalue is the value to search the record for
2142     * $targetvalue is the value to set the subfield to
2143     * $test is to be set only not to perform changes in database.
2144
2145 =item C<Output arg:>
2146     * $countchanged counts all the changes performed.
2147     * $listunchanged contains the list of all the biblionumbers of records unchanged.
2148
2149 =item C<usage in the script:>
2150
2151 =back
2152
2153 my ($countchanged, $listunchanged) = EditBiblios($results->{RECORD}, $tagsubfield,$initvalue,$targetvalue);;
2154 #If one wants to display unchanged records, you should get biblios foreach @$listunchanged
2155 $template->param(countchanged => $countchanged, loopunchanged=>$listunchanged);
2156
2157 =cut
2158
2159 sub ModBiblios {
2160     my ( $listbiblios, $tagsubfield, $initvalue, $targetvalue, $test ) = @_;
2161     my $countmatched;
2162     my @unmatched;
2163     my ( $tag, $subfield ) = ( $1, $2 )
2164       if ( $tagsubfield =~ /^(\d{1,3})([a-z0-9A-Z@])?$/ );
2165     if ( ( length($tag) < 3 ) && $subfield =~ /0-9/ ) {
2166         $tag = $tag . $subfield;
2167         undef $subfield;
2168     }
2169     my ( $bntag,   $bnsubf )   = GetMarcFromKohaField('biblio.biblionumber');
2170     my ( $itemtag, $itemsubf ) = GetMarcFromKohaField('items.itemnumber');
2171     if ($tag eq $itemtag) {
2172         # do not allow the embedded item tag to be
2173         # edited from here
2174         warn "Attempting to edit item tag via C4::Search::ModBiblios -- not allowed";
2175         return (0, []);
2176     }
2177     foreach my $usmarc (@$listbiblios) {
2178         my $record;
2179         $record = eval { MARC::Record->new_from_usmarc($usmarc) };
2180         my $biblionumber;
2181         if ($@) {
2182
2183             # usmarc is not a valid usmarc May be a biblionumber
2184             # FIXME - sorry, please let's figure out whether
2185             #         this function is to be passed a list of
2186             #         record numbers or a list of MARC::Record
2187             #         objects.  The former is probably better
2188             #         because the MARC records supplied by Zebra
2189             #         may be not current.
2190             $record       = GetMarcBiblio($usmarc);
2191             $biblionumber = $usmarc;
2192         }
2193         else {
2194             if ( $bntag >= 010 ) {
2195                 $biblionumber = $record->subfield( $bntag, $bnsubf );
2196             }
2197             else {
2198                 $biblionumber = $record->field($bntag)->data;
2199             }
2200         }
2201
2202         #GetBiblionumber is to be written.
2203         #Could be replaced by TransformMarcToKoha (But Would be longer)
2204         if ( $record->field($tag) ) {
2205             my $modify = 0;
2206             foreach my $field ( $record->field($tag) ) {
2207                 if ($subfield) {
2208                     if (
2209                         $field->delete_subfield(
2210                             'code'  => $subfield,
2211                             'match' => qr($initvalue)
2212                         )
2213                       )
2214                     {
2215                         $countmatched++;
2216                         $modify = 1;
2217                         $field->update( $subfield, $targetvalue )
2218                           if ($targetvalue);
2219                     }
2220                 }
2221                 else {
2222                     if ( $tag >= 010 ) {
2223                         if ( $field->delete_field($field) ) {
2224                             $countmatched++;
2225                             $modify = 1;
2226                         }
2227                     }
2228                     else {
2229                         $field->data = $targetvalue
2230                           if ( $field->data =~ qr($initvalue) );
2231                     }
2232                 }
2233             }
2234
2235             #       warn $record->as_formatted;
2236             if ($modify) {
2237                 ModBiblio( $record, $biblionumber,
2238                     GetFrameworkCode($biblionumber) )
2239                   unless ($test);
2240             }
2241             else {
2242                 push @unmatched, $biblionumber;
2243             }
2244         }
2245         else {
2246             push @unmatched, $biblionumber;
2247         }
2248     }
2249     return ( $countmatched, \@unmatched );
2250 }
2251
2252 END { }    # module clean-up code here (global destructor)
2253
2254 1;
2255 __END__
2256
2257 =head1 AUTHOR
2258
2259 Koha Developement team <info@koha.org>
2260
2261 =cut