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