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