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                 # If there's a previous operand, we need to add an operator
1490                 if ($previous_operand) {
1491
1492                     # User-specified operator
1493                     if ( $operators[ $i - 1 ] ) {
1494                         $query     .= " $operators[$i-1] ";
1495                         $query     .= " $index_plus " unless $indexes_set;
1496                         $query     .= " $operand";
1497                         $query_cgi .= "&op=".uri_escape($operators[$i-1]);
1498                         $query_cgi .= "&idx=".uri_escape($index) if $index;
1499                         $query_cgi .= "&q=".uri_escape($operands[$i]) if $operands[$i];
1500                         $query_desc .=
1501                           " $operators[$i-1] $index_plus $operands[$i]";
1502                     }
1503
1504                     # Default operator is and
1505                     else {
1506                         $query      .= " and ";
1507                         $query      .= "$index_plus " unless $indexes_set;
1508                         $query      .= "$operand";
1509                         $query_cgi  .= "&op=and&idx=".uri_escape($index) if $index;
1510                         $query_cgi  .= "&q=".uri_escape($operands[$i]) if $operands[$i];
1511                         $query_desc .= " and $index_plus $operands[$i]";
1512                     }
1513                 }
1514
1515                 # There isn't a pervious operand, don't need an operator
1516                 else {
1517
1518                     # Field-weighted queries already have indexes set
1519                     $query .= " $index_plus " unless $indexes_set;
1520                     $query .= $operand;
1521                     $query_desc .= " $index_plus $operands[$i]";
1522                     $query_cgi  .= "&idx=".uri_escape($index) if $index;
1523                     $query_cgi  .= "&q=".uri_escape($operands[$i]) if $operands[$i];
1524                     $previous_operand = 1;
1525                 }
1526             }    #/if $operands
1527         }    # /for
1528     }
1529     warn "QUERY BEFORE LIMITS: >$query<" if $DEBUG;
1530
1531     # add limits
1532     my %group_OR_limits;
1533     my $availability_limit;
1534     foreach my $this_limit (@limits) {
1535         next unless $this_limit;
1536         if ( $this_limit =~ /available/ ) {
1537 #
1538 ## 'available' is defined as (items.onloan is NULL) and (items.itemlost = 0)
1539 ## In English:
1540 ## all records not indexed in the onloan register (zebra) and all records with a value of lost equal to 0
1541             $availability_limit .=
1542 "( ( allrecords,AlwaysMatches='' not onloan,AlwaysMatches='') and (lost,st-numeric=0) )"; #or ( allrecords,AlwaysMatches='' not lost,AlwaysMatches='')) )";
1543             $limit_cgi  .= "&limit=available";
1544             $limit_desc .= "";
1545         }
1546
1547         # group_OR_limits, prefixed by mc-
1548         # OR every member of the group
1549         elsif ( $this_limit =~ /mc/ ) {
1550             my ($k,$v) = split(/:/, $this_limit,2);
1551             if ( $k !~ /mc-i(tem)?type/ ) {
1552                 # in case the mc-ccode value has complicating chars like ()'s inside it we wrap in quotes
1553                 $this_limit =~ tr/"//d;
1554                 $this_limit = $k.":\"".$v."\"";
1555             }
1556
1557             $group_OR_limits{$k} .= " or " if $group_OR_limits{$k};
1558             $limit_desc      .= " or " if $group_OR_limits{$k};
1559             $group_OR_limits{$k} .= "$this_limit";
1560             $limit_cgi       .= "&limit=" . uri_escape($this_limit);
1561             $limit_desc      .= " $this_limit";
1562         }
1563
1564         # Regular old limits
1565         else {
1566             $limit .= " and " if $limit || $query;
1567             $limit      .= "$this_limit";
1568             $limit_cgi  .= "&limit=" . uri_escape($this_limit);
1569             if ($this_limit =~ /^branch:(.+)/) {
1570                 my $branchcode = $1;
1571                 my $branchname = GetBranchName($branchcode);
1572                 if (defined $branchname) {
1573                     $limit_desc .= " branch:$branchname";
1574                 } else {
1575                     $limit_desc .= " $this_limit";
1576                 }
1577             } else {
1578                 $limit_desc .= " $this_limit";
1579             }
1580         }
1581     }
1582     foreach my $k (keys (%group_OR_limits)) {
1583         $limit .= " and " if ( $query || $limit );
1584         $limit .= "($group_OR_limits{$k})";
1585     }
1586     if ($availability_limit) {
1587         $limit .= " and " if ( $query || $limit );
1588         $limit .= "($availability_limit)";
1589     }
1590
1591     # Normalize the query and limit strings
1592     # This is flawed , means we can't search anything with : in it
1593     # if user wants to do ccl or cql, start the query with that
1594 #    $query =~ s/:/=/g;
1595     $query =~ s/(?<=(ti|au|pb|su|an|kw|mc|nb|ns)):/=/g;
1596     $query =~ s/(?<=(wrdl)):/=/g;
1597     $query =~ s/(?<=(trn|phr)):/=/g;
1598     $limit =~ s/:/=/g;
1599     for ( $query, $query_desc, $limit, $limit_desc ) {
1600         s/  +/ /g;    # remove extra spaces
1601         s/^ //g;     # remove any beginning spaces
1602         s/ $//g;     # remove any ending spaces
1603         s/==/=/g;    # remove double == from query
1604     }
1605     $query_cgi =~ s/^&//; # remove unnecessary & from beginning of the query cgi
1606
1607     for ($query_cgi,$simple_query) {
1608         s/"//g;
1609     }
1610     # append the limit to the query
1611     $query .= " " . $limit;
1612
1613     # Warnings if DEBUG
1614     if ($DEBUG) {
1615         warn "QUERY:" . $query;
1616         warn "QUERY CGI:" . $query_cgi;
1617         warn "QUERY DESC:" . $query_desc;
1618         warn "LIMIT:" . $limit;
1619         warn "LIMIT CGI:" . $limit_cgi;
1620         warn "LIMIT DESC:" . $limit_desc;
1621         warn "---------\nLeave buildQuery\n---------";
1622     }
1623     return (
1624         undef,              $query, $simple_query, $query_cgi,
1625         $query_desc,        $limit, $limit_cgi,    $limit_desc,
1626         $stopwords_removed, $query_type
1627     );
1628 }
1629
1630 =head2 searchResults
1631
1632   my @search_results = searchResults($search_context, $searchdesc, $hits,
1633                                      $results_per_page, $offset, $scan,
1634                                      @marcresults);
1635
1636 Format results in a form suitable for passing to the template
1637
1638 =cut
1639
1640 # IMO this subroutine is pretty messy still -- it's responsible for
1641 # building the HTML output for the template
1642 sub searchResults {
1643     my ( $search_context, $searchdesc, $hits, $results_per_page, $offset, $scan, $marcresults ) = @_;
1644     my $dbh = C4::Context->dbh;
1645     my @newresults;
1646
1647     require C4::Items;
1648
1649     $search_context = 'opac' if !$search_context || $search_context ne 'intranet';
1650     my ($is_opac, $hidelostitems);
1651     if ($search_context eq 'opac') {
1652         $hidelostitems = C4::Context->preference('hidelostitems');
1653         $is_opac       = 1;
1654     }
1655
1656     #Build branchnames hash
1657     #find branchname
1658     #get branch information.....
1659     my %branches;
1660     my $bsth =$dbh->prepare("SELECT branchcode,branchname FROM branches"); # FIXME : use C4::Branch::GetBranches
1661     $bsth->execute();
1662     while ( my $bdata = $bsth->fetchrow_hashref ) {
1663         $branches{ $bdata->{'branchcode'} } = $bdata->{'branchname'};
1664     }
1665 # FIXME - We build an authorised values hash here, using the default framework
1666 # though it is possible to have different authvals for different fws.
1667
1668     my $shelflocations =GetKohaAuthorisedValues('items.location','');
1669
1670     # get notforloan authorised value list (see $shelflocations  FIXME)
1671     my $notforloan_authorised_value = GetAuthValCode('items.notforloan','');
1672
1673     #Build itemtype hash
1674     #find itemtype & itemtype image
1675     my %itemtypes;
1676     $bsth =
1677       $dbh->prepare(
1678         "SELECT itemtype,description,imageurl,summary,notforloan FROM itemtypes"
1679       );
1680     $bsth->execute();
1681     while ( my $bdata = $bsth->fetchrow_hashref ) {
1682                 foreach (qw(description imageurl summary notforloan)) {
1683                 $itemtypes{ $bdata->{'itemtype'} }->{$_} = $bdata->{$_};
1684                 }
1685     }
1686
1687     #search item field code
1688     my ($itemtag, undef) = &GetMarcFromKohaField( "items.itemnumber", "" );
1689
1690     ## find column names of items related to MARC
1691     my $sth2 = $dbh->prepare("SHOW COLUMNS FROM items");
1692     $sth2->execute;
1693     my %subfieldstosearch;
1694     while ( ( my $column ) = $sth2->fetchrow ) {
1695         my ( $tagfield, $tagsubfield ) =
1696           &GetMarcFromKohaField( "items." . $column, "" );
1697         if ( defined $tagsubfield ) {
1698             $subfieldstosearch{$column} = $tagsubfield;
1699         }
1700     }
1701
1702     # handle which records to actually retrieve
1703     my $times;
1704     if ( $hits && $offset + $results_per_page <= $hits ) {
1705         $times = $offset + $results_per_page;
1706     }
1707     else {
1708         $times = $hits;  # FIXME: if $hits is undefined, why do we want to equal it?
1709     }
1710
1711     my $marcflavour = C4::Context->preference("marcflavour");
1712     # We get the biblionumber position in MARC
1713     my ($bibliotag,$bibliosubf)=GetMarcFromKohaField('biblio.biblionumber','');
1714
1715     # loop through all of the records we've retrieved
1716     for ( my $i = $offset ; $i <= $times - 1 ; $i++ ) {
1717
1718         my $marcrecord;
1719         if ($scan) {
1720             # For Scan searches we built USMARC data
1721             $marcrecord = MARC::Record->new_from_usmarc( $marcresults->[$i]);
1722         } else {
1723             # Normal search, render from Zebra's output
1724             $marcrecord = new_record_from_zebra(
1725                 'biblioserver',
1726                 $marcresults->[$i]
1727             );
1728
1729             if ( ! defined $marcrecord ) {
1730                 warn "ERROR DECODING RECORD - $@: " . $marcresults->[$i];
1731                 next;
1732             }
1733         }
1734
1735         my $fw = $scan
1736              ? undef
1737              : $bibliotag < 10
1738                ? GetFrameworkCode($marcrecord->field($bibliotag)->data)
1739                : GetFrameworkCode($marcrecord->subfield($bibliotag,$bibliosubf));
1740         my $oldbiblio = TransformMarcToKoha( $dbh, $marcrecord, $fw );
1741         $oldbiblio->{subtitle} = GetRecordValue('subtitle', $marcrecord, $fw);
1742         $oldbiblio->{result_number} = $i + 1;
1743
1744         # add imageurl to itemtype if there is one
1745         $oldbiblio->{imageurl} = getitemtypeimagelocation( $search_context, $itemtypes{ $oldbiblio->{itemtype} }->{imageurl} );
1746
1747         $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 ) ) : [];
1748                 $oldbiblio->{normalized_upc}  = GetNormalizedUPC(       $marcrecord,$marcflavour);
1749                 $oldbiblio->{normalized_ean}  = GetNormalizedEAN(       $marcrecord,$marcflavour);
1750                 $oldbiblio->{normalized_oclc} = GetNormalizedOCLCNumber($marcrecord,$marcflavour);
1751                 $oldbiblio->{normalized_isbn} = GetNormalizedISBN(undef,$marcrecord,$marcflavour);
1752                 $oldbiblio->{content_identifier_exists} = 1 if ($oldbiblio->{normalized_isbn} or $oldbiblio->{normalized_oclc} or $oldbiblio->{normalized_ean} or $oldbiblio->{normalized_upc});
1753
1754                 # edition information, if any
1755         $oldbiblio->{edition} = $oldbiblio->{editionstatement};
1756                 $oldbiblio->{description} = $itemtypes{ $oldbiblio->{itemtype} }->{description};
1757  # Build summary if there is one (the summary is defined in the itemtypes table)
1758  # FIXME: is this used anywhere, I think it can be commented out? -- JF
1759         if ( $itemtypes{ $oldbiblio->{itemtype} }->{summary} ) {
1760             my $summary = $itemtypes{ $oldbiblio->{itemtype} }->{summary};
1761             my @fields  = $marcrecord->fields();
1762
1763             my $newsummary;
1764             foreach my $line ( "$summary\n" =~ /(.*)\n/g ){
1765                 my $tags = {};
1766                 foreach my $tag ( $line =~ /\[(\d{3}[\w|\d])\]/ ) {
1767                     $tag =~ /(.{3})(.)/;
1768                     if($marcrecord->field($1)){
1769                         my @abc = $marcrecord->field($1)->subfield($2);
1770                         $tags->{$tag} = $#abc + 1 ;
1771                     }
1772                 }
1773
1774                 # We catch how many times to repeat this line
1775                 my $max = 0;
1776                 foreach my $tag (keys(%$tags)){
1777                     $max = $tags->{$tag} if($tags->{$tag} > $max);
1778                  }
1779
1780                 # we replace, and repeat each line
1781                 for (my $i = 0 ; $i < $max ; $i++){
1782                     my $newline = $line;
1783
1784                     foreach my $tag ( $newline =~ /\[(\d{3}[\w|\d])\]/g ) {
1785                         $tag =~ /(.{3})(.)/;
1786
1787                         if($marcrecord->field($1)){
1788                             my @repl = $marcrecord->field($1)->subfield($2);
1789                             my $subfieldvalue = $repl[$i];
1790
1791                             if (! utf8::is_utf8($subfieldvalue)) {
1792                                 utf8::decode($subfieldvalue);
1793                             }
1794
1795                              $newline =~ s/\[$tag\]/$subfieldvalue/g;
1796                         }
1797                     }
1798                     $newsummary .= "$newline\n";
1799                 }
1800             }
1801
1802             $newsummary =~ s/\[(.*?)]//g;
1803             $newsummary =~ s/\n/<br\/>/g;
1804             $oldbiblio->{summary} = $newsummary;
1805         }
1806
1807         # Pull out the items fields
1808         my @fields = $marcrecord->field($itemtag);
1809         my $marcflavor = C4::Context->preference("marcflavour");
1810         # adding linked items that belong to host records
1811         my $analyticsfield = '773';
1812         if ($marcflavor eq 'MARC21' || $marcflavor eq 'NORMARC') {
1813             $analyticsfield = '773';
1814         } elsif ($marcflavor eq 'UNIMARC') {
1815             $analyticsfield = '461';
1816         }
1817         foreach my $hostfield ( $marcrecord->field($analyticsfield)) {
1818             my $hostbiblionumber = $hostfield->subfield("0");
1819             my $linkeditemnumber = $hostfield->subfield("9");
1820             if(!$hostbiblionumber eq undef){
1821                 my $hostbiblio = GetMarcBiblio($hostbiblionumber, 1);
1822                 my ($itemfield, undef) = GetMarcFromKohaField( 'items.itemnumber', GetFrameworkCode($hostbiblionumber) );
1823                 if(!$hostbiblio eq undef){
1824                     my @hostitems = $hostbiblio->field($itemfield);
1825                     foreach my $hostitem (@hostitems){
1826                         if ($hostitem->subfield("9") eq $linkeditemnumber){
1827                             my $linkeditem =$hostitem;
1828                             # append linked items if they exist
1829                             if (!$linkeditem eq undef){
1830                                 push (@fields, $linkeditem);}
1831                         }
1832                     }
1833                 }
1834             }
1835         }
1836
1837         # Setting item statuses for display
1838         my @available_items_loop;
1839         my @onloan_items_loop;
1840         my @other_items_loop;
1841
1842         my $available_items;
1843         my $onloan_items;
1844         my $other_items;
1845
1846         my $ordered_count         = 0;
1847         my $available_count       = 0;
1848         my $onloan_count          = 0;
1849         my $longoverdue_count     = 0;
1850         my $other_count           = 0;
1851         my $withdrawn_count        = 0;
1852         my $itemlost_count        = 0;
1853         my $hideatopac_count      = 0;
1854         my $itembinding_count     = 0;
1855         my $itemdamaged_count     = 0;
1856         my $item_in_transit_count = 0;
1857         my $can_place_holds       = 0;
1858         my $item_onhold_count     = 0;
1859         my $items_count           = scalar(@fields);
1860         my $maxitems_pref = C4::Context->preference('maxItemsinSearchResults');
1861         my $maxitems = $maxitems_pref ? $maxitems_pref - 1 : 1;
1862         my @hiddenitems; # hidden itemnumbers based on OpacHiddenItems syspref
1863
1864         # loop through every item
1865         foreach my $field (@fields) {
1866             my $item;
1867
1868             # populate the items hash
1869             foreach my $code ( keys %subfieldstosearch ) {
1870                 $item->{$code} = $field->subfield( $subfieldstosearch{$code} );
1871             }
1872             $item->{description} = $itemtypes{ $item->{itype} }{description};
1873
1874                 # OPAC hidden items
1875             if ($is_opac) {
1876                 # hidden because lost
1877                 if ($hidelostitems && $item->{itemlost}) {
1878                     $hideatopac_count++;
1879                     next;
1880                 }
1881                 # hidden based on OpacHiddenItems syspref
1882                 my @hi = C4::Items::GetHiddenItemnumbers($item);
1883                 if (scalar @hi) {
1884                     push @hiddenitems, @hi;
1885                     $hideatopac_count++;
1886                     next;
1887                 }
1888             }
1889
1890             my $hbranch     = C4::Context->preference('HomeOrHoldingBranch') eq 'homebranch' ? 'homebranch'    : 'holdingbranch';
1891             my $otherbranch = C4::Context->preference('HomeOrHoldingBranch') eq 'homebranch' ? 'holdingbranch' : 'homebranch';
1892
1893             # set item's branch name, use HomeOrHoldingBranch syspref first, fall back to the other one
1894             if ($item->{$hbranch}) {
1895                 $item->{'branchname'} = $branches{$item->{$hbranch}};
1896             }
1897             elsif ($item->{$otherbranch}) {     # Last resort
1898                 $item->{'branchname'} = $branches{$item->{$otherbranch}};
1899             }
1900
1901                         my $prefix = $item->{$hbranch} . '--' . $item->{location} . $item->{itype} . $item->{itemcallnumber};
1902 # For each grouping of items (onloan, available, unavailable), we build a key to store relevant info about that item
1903             my $userenv = C4::Context->userenv;
1904             if ( $item->{onloan} && !(C4::Members::GetHideLostItemsPreference($userenv->{'number'}) && $item->{itemlost}) ) {
1905                 $onloan_count++;
1906                                 my $key = $prefix . $item->{onloan} . $item->{barcode};
1907                                 $onloan_items->{$key}->{due_date} = format_date($item->{onloan});
1908                                 $onloan_items->{$key}->{count}++ if $item->{$hbranch};
1909                                 $onloan_items->{$key}->{branchname} = $item->{branchname};
1910                                 $onloan_items->{$key}->{location} = $shelflocations->{ $item->{location} };
1911                                 $onloan_items->{$key}->{itemcallnumber} = $item->{itemcallnumber};
1912                                 $onloan_items->{$key}->{description} = $item->{description};
1913                                 $onloan_items->{$key}->{imageurl} = getitemtypeimagelocation( $search_context, $itemtypes{ $item->{itype} }->{imageurl} );
1914                 # if something's checked out and lost, mark it as 'long overdue'
1915                 if ( $item->{itemlost} ) {
1916                     $onloan_items->{$prefix}->{longoverdue}++;
1917                     $longoverdue_count++;
1918                 } else {        # can place holds as long as item isn't lost
1919                     $can_place_holds = 1;
1920                 }
1921             }
1922
1923          # items not on loan, but still unavailable ( lost, withdrawn, damaged )
1924             else {
1925
1926                 # item is on order
1927                 if ( $item->{notforloan} < 0 ) {
1928                     $ordered_count++;
1929                 }
1930
1931                 # is item in transit?
1932                 my $transfertwhen = '';
1933                 my ($transfertfrom, $transfertto);
1934
1935                 # is item on the reserve shelf?
1936                 my $reservestatus = '';
1937
1938                 unless ($item->{withdrawn}
1939                         || $item->{itemlost}
1940                         || $item->{damaged}
1941                         || $item->{notforloan}
1942                         || $items_count > 20) {
1943
1944                     # A couple heuristics to limit how many times
1945                     # we query the database for item transfer information, sacrificing
1946                     # accuracy in some cases for speed;
1947                     #
1948                     # 1. don't query if item has one of the other statuses
1949                     # 2. don't check transit status if the bib has
1950                     #    more than 20 items
1951                     #
1952                     # FIXME: to avoid having the query the database like this, and to make
1953                     #        the in transit status count as unavailable for search limiting,
1954                     #        should map transit status to record indexed in Zebra.
1955                     #
1956                     ($transfertwhen, $transfertfrom, $transfertto) = C4::Circulation::GetTransfers($item->{itemnumber});
1957                     $reservestatus = C4::Reserves::GetReserveStatus( $item->{itemnumber}, $oldbiblio->{biblionumber} );
1958                 }
1959
1960                 # item is withdrawn, lost, damaged, not for loan, reserved or in transit
1961                 if (   $item->{withdrawn}
1962                     || $item->{itemlost}
1963                     || $item->{damaged}
1964                     || $item->{notforloan}
1965                     || $reservestatus eq 'Waiting'
1966                     || ($transfertwhen ne ''))
1967                 {
1968                     $withdrawn_count++        if $item->{withdrawn};
1969                     $itemlost_count++        if $item->{itemlost};
1970                     $itemdamaged_count++     if $item->{damaged};
1971                     $item_in_transit_count++ if $transfertwhen ne '';
1972                     $item_onhold_count++     if $reservestatus eq 'Waiting';
1973                     $item->{status} = $item->{withdrawn} . "-" . $item->{itemlost} . "-" . $item->{damaged} . "-" . $item->{notforloan};
1974
1975                     # can place a hold on a item if
1976                     # not lost nor withdrawn
1977                     # not damaged unless AllowHoldsOnDamagedItems is true
1978                     # item is either for loan or on order (notforloan < 0)
1979                     $can_place_holds = 1
1980                       if (
1981                            !$item->{itemlost}
1982                         && !$item->{withdrawn}
1983                         && ( !$item->{damaged} || C4::Context->preference('AllowHoldsOnDamagedItems') )
1984                         && ( !$item->{notforloan} || $item->{notforloan} < 0 )
1985                       );
1986
1987                     $other_count++;
1988
1989                     my $key = $prefix . $item->{status};
1990                     foreach (qw(withdrawn itemlost damaged branchname itemcallnumber)) {
1991                         $other_items->{$key}->{$_} = $item->{$_};
1992                     }
1993                     $other_items->{$key}->{intransit} = ( $transfertwhen ne '' ) ? 1 : 0;
1994                     $other_items->{$key}->{onhold} = ($reservestatus) ? 1 : 0;
1995                     $other_items->{$key}->{notforloan} = GetAuthorisedValueDesc('','',$item->{notforloan},'','',$notforloan_authorised_value) if $notforloan_authorised_value and $item->{notforloan};
1996                                         $other_items->{$key}->{count}++ if $item->{$hbranch};
1997                                         $other_items->{$key}->{location} = $shelflocations->{ $item->{location} };
1998                                         $other_items->{$key}->{description} = $item->{description};
1999                                         $other_items->{$key}->{imageurl} = getitemtypeimagelocation( $search_context, $itemtypes{ $item->{itype} }->{imageurl} );
2000                 }
2001                 # item is available
2002                 else {
2003                     $can_place_holds = 1;
2004                     $available_count++;
2005                                         $available_items->{$prefix}->{count}++ if $item->{$hbranch};
2006                                         foreach (qw(branchname itemcallnumber description)) {
2007                         $available_items->{$prefix}->{$_} = $item->{$_};
2008                                         }
2009                                         $available_items->{$prefix}->{location} = $shelflocations->{ $item->{location} };
2010                                         $available_items->{$prefix}->{imageurl} = getitemtypeimagelocation( $search_context, $itemtypes{ $item->{itype} }->{imageurl} );
2011                 }
2012             }
2013         }    # notforloan, item level and biblioitem level
2014
2015         # if all items are hidden, do not show the record
2016         if ($items_count > 0 && $hideatopac_count == $items_count) {
2017             next;
2018         }
2019
2020         my ( $availableitemscount, $onloanitemscount, $otheritemscount );
2021         for my $key ( sort keys %$onloan_items ) {
2022             (++$onloanitemscount > $maxitems) and last;
2023             push @onloan_items_loop, $onloan_items->{$key};
2024         }
2025         for my $key ( sort keys %$other_items ) {
2026             (++$otheritemscount > $maxitems) and last;
2027             push @other_items_loop, $other_items->{$key};
2028         }
2029         for my $key ( sort keys %$available_items ) {
2030             (++$availableitemscount > $maxitems) and last;
2031             push @available_items_loop, $available_items->{$key}
2032         }
2033
2034         # XSLT processing of some stuff
2035         use C4::Charset;
2036         SetUTF8Flag($marcrecord);
2037         warn $marcrecord->as_formatted if $DEBUG;
2038         my $interface = $search_context eq 'opac' ? 'OPAC' : '';
2039         if (!$scan && C4::Context->preference($interface . "XSLTResultsDisplay")) {
2040             $oldbiblio->{XSLTResultsRecord} = XSLTParse4Display($oldbiblio->{biblionumber}, $marcrecord, $interface."XSLTResultsDisplay", 1, \@hiddenitems);
2041             # the last parameter tells Koha to clean up the problematic ampersand entities that Zebra outputs
2042         }
2043
2044         # if biblio level itypes are used and itemtype is notforloan, it can't be reserved either
2045         if (!C4::Context->preference("item-level_itypes")) {
2046             if ($itemtypes{ $oldbiblio->{itemtype} }->{notforloan}) {
2047                 $can_place_holds = 0;
2048             }
2049         }
2050         $oldbiblio->{norequests} = 1 unless $can_place_holds;
2051         $oldbiblio->{itemsplural}          = 1 if $items_count > 1;
2052         $oldbiblio->{items_count}          = $items_count;
2053         $oldbiblio->{available_items_loop} = \@available_items_loop;
2054         $oldbiblio->{onloan_items_loop}    = \@onloan_items_loop;
2055         $oldbiblio->{other_items_loop}     = \@other_items_loop;
2056         $oldbiblio->{availablecount}       = $available_count;
2057         $oldbiblio->{availableplural}      = 1 if $available_count > 1;
2058         $oldbiblio->{onloancount}          = $onloan_count;
2059         $oldbiblio->{onloanplural}         = 1 if $onloan_count > 1;
2060         $oldbiblio->{othercount}           = $other_count;
2061         $oldbiblio->{otherplural}          = 1 if $other_count > 1;
2062         $oldbiblio->{withdrawncount}        = $withdrawn_count;
2063         $oldbiblio->{itemlostcount}        = $itemlost_count;
2064         $oldbiblio->{damagedcount}         = $itemdamaged_count;
2065         $oldbiblio->{intransitcount}       = $item_in_transit_count;
2066         $oldbiblio->{onholdcount}          = $item_onhold_count;
2067         $oldbiblio->{orderedcount}         = $ordered_count;
2068
2069         if (C4::Context->preference("AlternateHoldingsField") && $items_count == 0) {
2070             my $fieldspec = C4::Context->preference("AlternateHoldingsField");
2071             my $subfields = substr $fieldspec, 3;
2072             my $holdingsep = C4::Context->preference("AlternateHoldingsSeparator") || ' ';
2073             my @alternateholdingsinfo = ();
2074             my @holdingsfields = $marcrecord->field(substr $fieldspec, 0, 3);
2075             my $alternateholdingscount = 0;
2076
2077             for my $field (@holdingsfields) {
2078                 my %holding = ( holding => '' );
2079                 my $havesubfield = 0;
2080                 for my $subfield ($field->subfields()) {
2081                     if ((index $subfields, $$subfield[0]) >= 0) {
2082                         $holding{'holding'} .= $holdingsep if (length $holding{'holding'} > 0);
2083                         $holding{'holding'} .= $$subfield[1];
2084                         $havesubfield++;
2085                     }
2086                 }
2087                 if ($havesubfield) {
2088                     push(@alternateholdingsinfo, \%holding);
2089                     $alternateholdingscount++;
2090                 }
2091             }
2092
2093             $oldbiblio->{'ALTERNATEHOLDINGS'} = \@alternateholdingsinfo;
2094             $oldbiblio->{'alternateholdings_count'} = $alternateholdingscount;
2095         }
2096
2097         push( @newresults, $oldbiblio );
2098     }
2099
2100     return @newresults;
2101 }
2102
2103 =head2 SearchAcquisitions
2104     Search for acquisitions
2105 =cut
2106
2107 sub SearchAcquisitions{
2108     my ($datebegin, $dateend, $itemtypes,$criteria, $orderby) = @_;
2109
2110     my $dbh=C4::Context->dbh;
2111     # Variable initialization
2112     my $str=qq|
2113     SELECT marcxml
2114     FROM biblio
2115     LEFT JOIN biblioitems ON biblioitems.biblionumber=biblio.biblionumber
2116     LEFT JOIN items ON items.biblionumber=biblio.biblionumber
2117     WHERE dateaccessioned BETWEEN ? AND ?
2118     |;
2119
2120     my (@params,@loopcriteria);
2121
2122     push @params, $datebegin->output("iso");
2123     push @params, $dateend->output("iso");
2124
2125     if (scalar(@$itemtypes)>0 and $criteria ne "itemtype" ){
2126         if(C4::Context->preference("item-level_itypes")){
2127             $str .= "AND items.itype IN (?".( ',?' x scalar @$itemtypes - 1 ).") ";
2128         }else{
2129             $str .= "AND biblioitems.itemtype IN (?".( ',?' x scalar @$itemtypes - 1 ).") ";
2130         }
2131         push @params, @$itemtypes;
2132     }
2133
2134     if ($criteria =~/itemtype/){
2135         if(C4::Context->preference("item-level_itypes")){
2136             $str .= "AND items.itype=? ";
2137         }else{
2138             $str .= "AND biblioitems.itemtype=? ";
2139         }
2140
2141         if(scalar(@$itemtypes) == 0){
2142             my $itypes = GetItemTypes();
2143             for my $key (keys %$itypes){
2144                 push @$itemtypes, $key;
2145             }
2146         }
2147
2148         @loopcriteria= @$itemtypes;
2149     }elsif ($criteria=~/itemcallnumber/){
2150         $str .= "AND (items.itemcallnumber LIKE CONCAT(?,'%')
2151                  OR items.itemcallnumber is NULL
2152                  OR items.itemcallnumber = '')";
2153
2154         @loopcriteria = ("AA".."ZZ", "") unless (scalar(@loopcriteria)>0);
2155     }else {
2156         $str .= "AND biblio.title LIKE CONCAT(?,'%') ";
2157         @loopcriteria = ("A".."z") unless (scalar(@loopcriteria)>0);
2158     }
2159
2160     if ($orderby =~ /date_desc/){
2161         $str.=" ORDER BY dateaccessioned DESC";
2162     } else {
2163         $str.=" ORDER BY title";
2164     }
2165
2166     my $qdataacquisitions=$dbh->prepare($str);
2167
2168     my @loopacquisitions;
2169     foreach my $value(@loopcriteria){
2170         push @params,$value;
2171         my %cell;
2172         $cell{"title"}=$value;
2173         $cell{"titlecode"}=$value;
2174
2175         eval{$qdataacquisitions->execute(@params);};
2176
2177         if ($@){ warn "recentacquisitions Error :$@";}
2178         else {
2179             my @loopdata;
2180             while (my $data=$qdataacquisitions->fetchrow_hashref){
2181                 push @loopdata, {"summary"=>GetBiblioSummary( $data->{'marcxml'} ) };
2182             }
2183             $cell{"loopdata"}=\@loopdata;
2184         }
2185         push @loopacquisitions,\%cell if (scalar(@{$cell{loopdata}})>0);
2186         pop @params;
2187     }
2188     $qdataacquisitions->finish;
2189     return \@loopacquisitions;
2190 }
2191
2192 =head2 enabled_staff_search_views
2193
2194 %hash = enabled_staff_search_views()
2195
2196 This function returns a hash that contains three flags obtained from the system
2197 preferences, used to determine whether a particular staff search results view
2198 is enabled.
2199
2200 =over 2
2201
2202 =item C<Output arg:>
2203
2204     * $hash{can_view_MARC} is true only if the MARC view is enabled
2205     * $hash{can_view_ISBD} is true only if the ISBD view is enabled
2206     * $hash{can_view_labeledMARC} is true only if the Labeled MARC view is enabled
2207
2208 =item C<usage in the script:>
2209
2210 =back
2211
2212 $template->param ( C4::Search::enabled_staff_search_views );
2213
2214 =cut
2215
2216 sub enabled_staff_search_views
2217 {
2218         return (
2219                 can_view_MARC                   => C4::Context->preference('viewMARC'),                 # 1 if the staff search allows the MARC view
2220                 can_view_ISBD                   => C4::Context->preference('viewISBD'),                 # 1 if the staff search allows the ISBD view
2221                 can_view_labeledMARC    => C4::Context->preference('viewLabeledMARC'),  # 1 if the staff search allows the Labeled MARC view
2222         );
2223 }
2224
2225 sub PurgeSearchHistory{
2226     my ($pSearchhistory)=@_;
2227     my $dbh = C4::Context->dbh;
2228     my $sth = $dbh->prepare("DELETE FROM search_history WHERE time < DATE_SUB( NOW(), INTERVAL ? DAY )");
2229     $sth->execute($pSearchhistory) or die $dbh->errstr;
2230 }
2231
2232 =head2 z3950_search_args
2233
2234 $arrayref = z3950_search_args($matchpoints)
2235
2236 This function returns an array reference that contains the search parameters to be
2237 passed to the Z39.50 search script (z3950_search.pl). The array elements
2238 are hash refs whose keys are name and value, and whose values are the
2239 name of a search parameter, the value of that search parameter and the URL encoded
2240 value of that parameter.
2241
2242 The search parameter names are lccn, isbn, issn, title, author, dewey and subject.
2243
2244 The search parameter values are obtained from the bibliographic record whose
2245 data is in a hash reference in $matchpoints, as returned by Biblio::GetBiblioData().
2246
2247 If $matchpoints is a scalar, it is assumed to be an unnamed query descriptor, e.g.
2248 a general purpose search argument. In this case, the returned array contains only
2249 entry: the key is 'title' and the value is derived from $matchpoints.
2250
2251 If a search parameter value is undefined or empty, it is not included in the returned
2252 array.
2253
2254 The returned array reference may be passed directly to the template parameters.
2255
2256 =over 2
2257
2258 =item C<Output arg:>
2259
2260     * $array containing hash refs as described above
2261
2262 =item C<usage in the script:>
2263
2264 =back
2265
2266 $data = Biblio::GetBiblioData($bibno);
2267 $template->param ( MYLOOP => C4::Search::z3950_search_args($data) )
2268
2269 *OR*
2270
2271 $template->param ( MYLOOP => C4::Search::z3950_search_args($searchscalar) )
2272
2273 =cut
2274
2275 sub z3950_search_args {
2276     my $bibrec = shift;
2277
2278     my $isbn_string = ref( $bibrec ) ? $bibrec->{title} : $bibrec;
2279     my $isbn = Business::ISBN->new( $isbn_string );
2280
2281     if (defined $isbn && $isbn->is_valid)
2282     {
2283         if ( ref($bibrec) ) {
2284             $bibrec->{isbn} = $isbn_string;
2285             $bibrec->{title} = undef;
2286         } else {
2287             $bibrec = { isbn => $isbn_string };
2288         }
2289     }
2290     else {
2291         $bibrec = { title => $bibrec } if !ref $bibrec;
2292     }
2293     my $array = [];
2294     for my $field (qw/ lccn isbn issn title author dewey subject /)
2295     {
2296         push @$array, { name => $field, value => $bibrec->{$field} }
2297           if defined $bibrec->{$field};
2298     }
2299     return $array;
2300 }
2301
2302 =head2 GetDistinctValues($field);
2303
2304 C<$field> is a reference to the fields array
2305
2306 =cut
2307
2308 sub GetDistinctValues {
2309     my ($fieldname,$string)=@_;
2310     # returns a reference to a hash of references to branches...
2311     if ($fieldname=~/\./){
2312                         my ($table,$column)=split /\./, $fieldname;
2313                         my $dbh = C4::Context->dbh;
2314                         warn "select DISTINCT($column) as value, count(*) as cnt from $table group by lib order by $column " if $DEBUG;
2315                         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 ");
2316                         $sth->execute;
2317                         my $elements=$sth->fetchall_arrayref({});
2318                         return $elements;
2319    }
2320    else {
2321                 $string||= qq("");
2322                 my @servers=qw<biblioserver authorityserver>;
2323                 my (@zconns,@results);
2324         for ( my $i = 0 ; $i < @servers ; $i++ ) {
2325                 $zconns[$i] = C4::Context->Zconn( $servers[$i], 1 );
2326                         $results[$i] =
2327                       $zconns[$i]->scan(
2328                         ZOOM::Query::CCL2RPN->new( qq"$fieldname $string", $zconns[$i])
2329                       );
2330                 }
2331                 # The big moment: asynchronously retrieve results from all servers
2332                 my @elements;
2333         _ZOOM_event_loop(
2334             \@zconns,
2335             \@results,
2336             sub {
2337                 my ( $i, $size ) = @_;
2338                 for ( my $j = 0 ; $j < $size ; $j++ ) {
2339                     my %hashscan;
2340                     @hashscan{qw(value cnt)} =
2341                       $results[ $i - 1 ]->display_term($j);
2342                     push @elements, \%hashscan;
2343                 }
2344             }
2345         );
2346                 return \@elements;
2347    }
2348 }
2349
2350 =head2 _ZOOM_event_loop
2351
2352     _ZOOM_event_loop(\@zconns, \@results, sub {
2353         my ( $i, $size ) = @_;
2354         ....
2355     } );
2356
2357 Processes a ZOOM event loop and passes control to a closure for
2358 processing the results, and destroying the resultsets.
2359
2360 =cut
2361
2362 sub _ZOOM_event_loop {
2363     my ($zconns, $results, $callback) = @_;
2364     while ( ( my $i = ZOOM::event( $zconns ) ) != 0 ) {
2365         my $ev = $zconns->[ $i - 1 ]->last_event();
2366         if ( $ev == ZOOM::Event::ZEND ) {
2367             next unless $results->[ $i - 1 ];
2368             my $size = $results->[ $i - 1 ]->size();
2369             if ( $size > 0 ) {
2370                 $callback->($i, $size);
2371             }
2372         }
2373     }
2374
2375     foreach my $result (@$results) {
2376         $result->destroy();
2377     }
2378 }
2379
2380 =head2 new_record_from_zebra
2381
2382 Given raw data from a Zebra result set, return a MARC::Record object
2383
2384 This helper function is needed to take into account all the involved
2385 system preferences and configuration variables to properly create the
2386 MARC::Record object.
2387
2388 If we are using GRS-1, then the raw data we get from Zebra should be USMARC
2389 data. If we are using DOM, then it has to be MARCXML.
2390
2391 =cut
2392
2393 sub new_record_from_zebra {
2394
2395     my $server   = shift;
2396     my $raw_data = shift;
2397     # Set the default indexing modes
2398     my $index_mode = ( $server eq 'biblioserver' )
2399                         ? C4::Context->config('zebra_bib_index_mode') // 'grs1'
2400                         : C4::Context->config('zebra_auth_index_mode') // 'dom';
2401
2402     my $marc_record =  eval {
2403         if ( $index_mode eq 'dom' ) {
2404             MARC::Record->new_from_xml( $raw_data, 'UTF-8' );
2405         } else {
2406             MARC::Record->new_from_usmarc( $raw_data );
2407         }
2408     };
2409
2410     if ($@) {
2411         return;
2412     } else {
2413         return $marc_record;
2414     }
2415
2416 }
2417
2418 END { }    # module clean-up code here (global destructor)
2419
2420 1;
2421 __END__
2422
2423 =head1 AUTHOR
2424
2425 Koha Development Team <http://koha-community.org/>
2426
2427 =cut