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