File Coverage

File:C4/Search.pm
Coverage:3.9%

linestmtbrancondsubtimecode
1package 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
8
8
8
2243
36
303
use strict;
19#use warnings; FIXME - Bug 2505
20require Exporter;
21
8
8
8
72
34
197
use C4::Context;
22
8
8
8
516
21
4768
use C4::Biblio; # GetMarcFromKohaField, GetBiblioData
23
8
8
8
57
73
2946
use C4::Koha; # getFacets
24
8
8
8
51773
69965
700
use Lingua::Stem;
25
8
8
8
2124
27
368
use C4::Search::PazPar2;
26
8
8
8
56
12
91
use XML::Simple;
27
8
8
8
726
12
462
use C4::Dates qw(format_date);
28
8
8
8
910
49
1327
use C4::Members qw(GetHideLostItemsPreference);
29
8
8
8
1705
58
1117
use C4::XSLT;
30
8
8
8
89
55
1316
use C4::Branch;
31
8
8
8
104
38
2115
use C4::Reserves; # CheckReserves
32
8
8
8
68
26
762
use C4::Debug;
33
8
8
8
51
36
2062
use C4::Items;
34
8
8
8
75
23
647
use C4::Charset;
35
8
8
8
109589
199718
684
use YAML;
36
8
8
8
85
25
670
use URI::Escape;
37
8
8
8
35204
140295
564
use Business::ISBN;
38
39
8
8
8
83
35
825
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $DEBUG);
40
41# set the version for version checking
42BEGIN {
43
8
36
    $VERSION = 3.01;
44
8
172997
    $DEBUG = ($ENV{DEBUG}) ? 1 : 0;
45}
46
47 - 61
=head1 NAME

C4::Search - Functions for searching the Koha catalog.

=head1 SYNOPSIS

See opac/opac-search.pl or catalogue/search.pl for example of usage

=head1 DESCRIPTION

This module provides searching functions for Koha's bibliographic databases

=head1 FUNCTIONS

=cut
62
63@ISA = qw(Exporter);
64@EXPORT = qw(
65  &FindDuplicate
66  &SimpleSearch
67  &searchResults
68  &getRecords
69  &buildQuery
70  &NZgetRecords
71  &AddSearchHistory
72  &GetDistinctValues
73  &BiblioAddAuthorities
74  &enabled_staff_search_views
75);
76#FIXME: i had to add BiblioAddAuthorities here because in Biblios.pm it caused circular dependencies (C4::Search uses C4::Biblio, and BiblioAddAuthorities uses SimpleSearch from C4::Search)
77
78# make all your functions, whether exported or not;
79
80 - 86
=head2 FindDuplicate

($biblionumber,$biblionumber,$title) = FindDuplicate($record);

This function attempts to find duplicate records using a hard-coded, fairly simplistic algorithm

=cut
87
88sub FindDuplicate {
89
0
    my ($record) = @_;
90
0
    my $dbh = C4::Context->dbh;
91
0
    my $result = TransformMarcToKoha( $dbh, $record, '' );
92
0
    my $sth;
93
0
    my $query;
94
0
    my $search;
95
0
    my $type;
96
0
    my ( $biblionumber, $title );
97
98    # search duplicate on ISBN, easy and fast..
99    # ... normalize first
100
0
    if ( $result->{isbn} ) {
101
0
        $result->{isbn} =~ s/\(.*$//;
102
0
        $result->{isbn} =~ s/\s+$//;
103
0
        $query = "isbn=$result->{isbn}";
104    }
105    else {
106
0
        $result->{title} =~ s /\\//g;
107
0
        $result->{title} =~ s /\"//g;
108
0
        $result->{title} =~ s /\(//g;
109
0
        $result->{title} =~ s /\)//g;
110
111        # FIXME: instead of removing operators, could just do
112        # quotes around the value
113
0
        $result->{title} =~ s/(and|or|not)//g;
114
0
        $query = "ti,ext=$result->{title}";
115
0
        $query .= " and itemtype=$result->{itemtype}"
116          if ( $result->{itemtype} );
117
0
        if ( $result->{author} ) {
118
0
            $result->{author} =~ s /\\//g;
119
0
            $result->{author} =~ s /\"//g;
120
0
            $result->{author} =~ s /\(//g;
121
0
            $result->{author} =~ s /\)//g;
122
123            # remove valid operators
124
0
            $result->{author} =~ s/(and|or|not)//g;
125
0
            $query .= " and au,ext=$result->{author}";
126        }
127    }
128
129
0
    my ( $error, $searchresults, undef ) = SimpleSearch($query); # FIXME :: hardcoded !
130
0
    my @results;
131
0
    if (!defined $error) {
132
0
0
        foreach my $possible_duplicate_record (@{$searchresults}) {
133
0
            my $marcrecord =
134            MARC::Record->new_from_usmarc($possible_duplicate_record);
135
0
            my $result = TransformMarcToKoha( $dbh, $marcrecord, '' );
136
137            # FIXME :: why 2 $biblionumber ?
138
0
            if ($result) {
139
0
                push @results, $result->{'biblionumber'};
140
0
                push @results, $result->{'title'};
141            }
142        }
143    }
144
0
    return @results;
145}
146
147 - 207
=head2 SimpleSearch

( $error, $results, $total_hits ) = SimpleSearch( $query, $offset, $max_results, [@servers] );

This function provides a simple search API on the bibliographic catalog

=over 2

=item C<input arg:>

    * $query can be a simple keyword or a complete CCL query
    * @servers is optional. Defaults to biblioserver as found in koha-conf.xml
    * $offset - If present, represents the number of records at the beggining to omit. Defaults to 0
    * $max_results - if present, determines the maximum number of records to fetch. undef is All. defaults to undef.


=item C<Return:>

    Returns an array consisting of three elements
    * $error is undefined unless an error is detected
    * $results is a reference to an array of records.
    * $total_hits is the number of hits that would have been returned with no limit

    If an error is returned the two other return elements are undefined. If error itself is undefined
    the other two elements are always defined

=item C<usage in the script:>

=back

my ( $error, $marcresults, $total_hits ) = SimpleSearch($query);

if (defined $error) {
    $template->param(query_error => $error);
    warn "error: ".$error;
    output_html_with_http_headers $input, $cookie, $template->output;
    exit;
}

my $hits = @{$marcresults};
my @results;

for my $r ( @{$marcresults} ) {
    my $marcrecord = MARC::File::USMARC::decode($r);
    my $biblio = TransformMarcToKoha(C4::Context->dbh,$marcrecord,q{});

    #build the iarray of hashs for the template.
    push @results, {
        title           => $biblio->{'title'},
        subtitle        => $biblio->{'subtitle'},
        biblionumber    => $biblio->{'biblionumber'},
        author          => $biblio->{'author'},
        publishercode   => $biblio->{'publishercode'},
        publicationyear => $biblio->{'publicationyear'},
        };

}

$template->param(result=>\@results);

=cut
208
209sub SimpleSearch {
210
0
    my ( $query, $offset, $max_results, $servers ) = @_;
211
212
0
    if ( C4::Context->preference('NoZebra') ) {
213
0
        my $result = NZorder( NZanalyse($query) )->{'biblioserver'};
214
0
        my $search_result =
215          ( $result->{hits}
216              && $result->{hits} > 0 ? $result->{'RECORDS'} : [] );
217
0
        return ( undef, $search_result, scalar($result->{hits}) );
218    }
219    else {
220
0
        return ( 'No query entered', undef, undef ) unless $query;
221        # FIXME hardcoded value. See catalog/search.pl & opac-search.pl too.
222
0
        my @servers = defined ( $servers ) ? @$servers : ( 'biblioserver' );
223
0
        my @zoom_queries;
224
0
        my @tmpresults;
225
0
        my @zconns;
226
0
        my $results = [];
227
0
        my $total_hits = 0;
228
229        # Initialize & Search Zebra
230        for ( my $i = 0 ; $i < @servers ; $i++ ) {
231
0
            eval {
232
0
                $zconns[$i] = C4::Context->Zconn( $servers[$i], 1 );
233
0
                $zoom_queries[$i] = new ZOOM::Query::CCL2RPN( $query, $zconns[$i]);
234
0
                $tmpresults[$i] = $zconns[$i]->search( $zoom_queries[$i] );
235
236                # error handling
237
0
                my $error =
238                    $zconns[$i]->errmsg() . " ("
239                  . $zconns[$i]->errcode() . ") "
240                  . $zconns[$i]->addinfo() . " "
241                  . $zconns[$i]->diagset();
242
243
0
                return ( $error, undef, undef ) if $zconns[$i]->errcode();
244            };
245
0
            if ($@) {
246
247                # caught a ZOOM::Exception
248
0
                my $error =
249                    $@->message() . " ("
250                  . $@->code() . ") "
251                  . $@->addinfo() . " "
252                  . $@->diagset();
253
0
                warn $error;
254
0
                return ( $error, undef, undef );
255            }
256
0
        }
257
0
        while ( ( my $i = ZOOM::event( \@zconns ) ) != 0 ) {
258
0
            my $event = $zconns[ $i - 1 ]->last_event();
259
0
            if ( $event == ZOOM::Event::ZEND ) {
260
261
0
                my $first_record = defined( $offset ) ? $offset+1 : 1;
262
0
                my $hits = $tmpresults[ $i - 1 ]->size();
263
0
                $total_hits += $hits;
264
0
                my $last_record = $hits;
265
0
                if ( defined $max_results && $offset + $max_results < $hits ) {
266
0
                    $last_record = $offset + $max_results;
267                }
268
269
0
                for my $j ( $first_record..$last_record ) {
270
0
                    my $record = $tmpresults[ $i - 1 ]->record( $j-1 )->raw(); # 0 indexed
271
0
0
                    push @{$results}, $record;
272                }
273            }
274        }
275
276
0
        foreach my $result (@tmpresults) {
277
0
            $result->destroy();
278        }
279
0
        foreach my $zoom_query (@zoom_queries) {
280
0
            $zoom_query->destroy();
281        }
282
283
0
        return ( undef, $results, $total_hits );
284    }
285}
286
287 - 301
=head2 getRecords

( undef, $results_hashref, \@facets_loop ) = getRecords (

        $koha_query,       $simple_query, $sort_by_ref,    $servers_ref,
        $results_per_page, $offset,       $expanded_facet, $branches,
        $query_type,       $scan
    );

The all singing, all dancing, multi-server, asynchronous, scanning,
searching, record nabbing, facet-building

See verbse embedded documentation.

=cut
302
303sub getRecords {
304    my (
305
0
        $koha_query, $simple_query, $sort_by_ref, $servers_ref,
306        $results_per_page, $offset, $expanded_facet, $branches,
307        $query_type, $scan
308    ) = @_;
309
310
0
    my @servers = @$servers_ref;
311
0
    my @sort_by = @$sort_by_ref;
312
313    # Initialize variables for the ZOOM connection and results object
314
0
    my $zconn;
315
0
    my @zconns;
316
0
    my @results;
317
0
    my $results_hashref = ();
318
319    # Initialize variables for the faceted results objects
320
0
    my $facets_counter = ();
321
0
    my $facets_info = ();
322
0
    my $facets = getFacets();
323
0
    my $facets_maxrecs = C4::Context->preference('maxRecordsForFacets')||20;
324
325
0
    my @facets_loop; # stores the ref to array of hashes for template facets loop
326
327    ### LOOP THROUGH THE SERVERS
328    for ( my $i = 0 ; $i < @servers ; $i++ ) {
329
0
        $zconns[$i] = C4::Context->Zconn( $servers[$i], 1 );
330
331# perform the search, create the results objects
332# if this is a local search, use the $koha-query, if it's a federated one, use the federated-query
333
0
        my $query_to_use = ($servers[$i] =~ /biblioserver/) ? $koha_query : $simple_query;
334
335        #$query_to_use = $simple_query if $scan;
336
0
        warn $simple_query if ( $scan and $DEBUG );
337
338        # Check if we've got a query_type defined, if so, use it
339
0
        eval {
340
0
            if ($query_type) {
341
0
                if ($query_type =~ /^ccl/) {
342
0
                    $query_to_use =~ s/\:/\=/g; # change : to = last minute (FIXME)
343
0
                    $results[$i] = $zconns[$i]->search(new ZOOM::Query::CCL2RPN($query_to_use, $zconns[$i]));
344                } elsif ($query_type =~ /^cql/) {
345
0
                    $results[$i] = $zconns[$i]->search(new ZOOM::Query::CQL($query_to_use, $zconns[$i]));
346                } elsif ($query_type =~ /^pqf/) {
347
0
                    $results[$i] = $zconns[$i]->search(new ZOOM::Query::PQF($query_to_use, $zconns[$i]));
348                } else {
349
0
                    warn "Unknown query_type '$query_type'. Results undetermined.";
350                }
351            } elsif ($scan) {
352
0
                    $results[$i] = $zconns[$i]->scan( new ZOOM::Query::CCL2RPN($query_to_use, $zconns[$i]));
353            } else {
354
0
                    $results[$i] = $zconns[$i]->search(new ZOOM::Query::CCL2RPN($query_to_use, $zconns[$i]));
355            }
356        };
357
0
        if ($@) {
358
0
            warn "WARNING: query problem with $query_to_use " . $@;
359        }
360
361        # Concatenate the sort_by limits and pass them to the results object
362        # Note: sort will override rank
363
0
        my $sort_by;
364
0
        foreach my $sort (@sort_by) {
365
0
            if ( $sort eq "author_az" || $sort eq "author_asc" ) {
366
0
                $sort_by .= "1=1003 <i ";
367            }
368            elsif ( $sort eq "author_za" || $sort eq "author_dsc" ) {
369
0
                $sort_by .= "1=1003 >i ";
370            }
371            elsif ( $sort eq "popularity_asc" ) {
372
0
                $sort_by .= "1=9003 <i ";
373            }
374            elsif ( $sort eq "popularity_dsc" ) {
375
0
                $sort_by .= "1=9003 >i ";
376            }
377            elsif ( $sort eq "call_number_asc" ) {
378
0
                $sort_by .= "1=8007 <i ";
379            }
380            elsif ( $sort eq "call_number_dsc" ) {
381
0
                $sort_by .= "1=8007 >i ";
382            }
383            elsif ( $sort eq "pubdate_asc" ) {
384
0
                $sort_by .= "1=31 <i ";
385            }
386            elsif ( $sort eq "pubdate_dsc" ) {
387
0
                $sort_by .= "1=31 >i ";
388            }
389            elsif ( $sort eq "acqdate_asc" ) {
390
0
                $sort_by .= "1=32 <i ";
391            }
392            elsif ( $sort eq "acqdate_dsc" ) {
393
0
                $sort_by .= "1=32 >i ";
394            }
395            elsif ( $sort eq "title_az" || $sort eq "title_asc" ) {
396
0
                $sort_by .= "1=4 <i ";
397            }
398            elsif ( $sort eq "title_za" || $sort eq "title_dsc" ) {
399
0
                $sort_by .= "1=4 >i ";
400            }
401            else {
402
0
                warn "Ignoring unrecognized sort '$sort' requested" if $sort_by;
403            }
404        }
405
0
        if ($sort_by && !$scan) {
406
0
            if ( $results[$i]->sort( "yaz", $sort_by ) < 0 ) {
407
0
                warn "WARNING sort $sort_by failed";
408            }
409        }
410
0
    } # finished looping through servers
411
412    # The big moment: asynchronously retrieve results from all servers
413
0
    while ( ( my $i = ZOOM::event( \@zconns ) ) != 0 ) {
414
0
        my $ev = $zconns[ $i - 1 ]->last_event();
415
0
        if ( $ev == ZOOM::Event::ZEND ) {
416
0
            next unless $results[ $i - 1 ];
417
0
            my $size = $results[ $i - 1 ]->size();
418
0
            if ( $size > 0 ) {
419
0
                my $results_hash;
420
421                # loop through the results
422
0
                $results_hash->{'hits'} = $size;
423
0
                my $times;
424
0
                if ( $offset + $results_per_page <= $size ) {
425
0
                    $times = $offset + $results_per_page;
426                }
427                else {
428
0
                    $times = $size;
429                }
430                for ( my $j = $offset ; $j < $times ; $j++ ) {
431
0
                    my $records_hash;
432
0
                    my $record;
433
434                    ## Check if it's an index scan
435
0
                    if ($scan) {
436
0
                        my ( $term, $occ ) = $results[ $i - 1 ]->term($j);
437
438                 # here we create a minimal MARC record and hand it off to the
439                 # template just like a normal result ... perhaps not ideal, but
440                 # it works for now
441
0
                        my $tmprecord = MARC::Record->new();
442
0
                        $tmprecord->encoding('UTF-8');
443
0
                        my $tmptitle;
444
0
                        my $tmpauthor;
445
446                # the minimal record in author/title (depending on MARC flavour)
447
0
                        if (C4::Context->preference("marcflavour") eq "UNIMARC") {
448
0
                            $tmptitle = MARC::Field->new('200',' ',' ', a => $term, f => $occ);
449
0
                            $tmprecord->append_fields($tmptitle);
450                        } else {
451
0
                            $tmptitle = MARC::Field->new('245',' ',' ', a => $term,);
452
0
                            $tmpauthor = MARC::Field->new('100',' ',' ', a => $occ,);
453
0
                            $tmprecord->append_fields($tmptitle);
454
0
                            $tmprecord->append_fields($tmpauthor);
455                        }
456
0
                        $results_hash->{'RECORDS'}[$j] = $tmprecord->as_usmarc();
457                    }
458
459                    # not an index scan
460                    else {
461
0
                        $record = $results[ $i - 1 ]->record($j)->raw();
462
463                        # warn "RECORD $j:".$record;
464
0
                        $results_hash->{'RECORDS'}[$j] = $record;
465                    }
466
467
0
                }
468
0
                $results_hashref->{ $servers[ $i - 1 ] } = $results_hash;
469
470                # Fill the facets while we're looping, but only for the biblioserver and not for a scan
471
0
                if ( !$scan && $servers[ $i - 1 ] =~ /biblioserver/ ) {
472
473
0
                    my $jmax = $size>$facets_maxrecs? $facets_maxrecs: $size;
474
475                    for ( my $k = 0 ; $k <= @$facets ; $k++ ) {
476
0
                        ($facets->[$k]) or next;
477
0
0
                        my @fcodes = @{$facets->[$k]->{'tags'}};
478
0
                        my $sfcode = $facets->[$k]->{'subfield'};
479
480                                for ( my $j = 0 ; $j < $jmax ; $j++ ) {
481
0
                                    my $render_record = $results[ $i - 1 ]->record($j)->render();
482
0
                            my @used_datas = ();
483
484
0
                            foreach my $fcode (@fcodes) {
485
486                                # avoid first line
487
0
                                my $field_pattern = '\n'.$fcode.' ([^\n]+)';
488
0
                                my @field_tokens = ( $render_record =~ /$field_pattern/g ) ;
489
490
0
                                foreach my $field_token (@field_tokens) {
491
0
                                    my $subfield_pattern = '\$'.$sfcode.' ([^\$]+)';
492
0
                                    my @subfield_values = ( $field_token =~ /$subfield_pattern/g );
493
494
0
                                    foreach my $subfield_value (@subfield_values) {
495
496
0
                                        my $data = $subfield_value;
497
0
                                        $data =~ s/^\s+//; # trim left
498
0
                                        $data =~ s/\s+$//; # trim right
499
500
0
                                        unless ( $data ~~ @used_datas ) {
501
0
                                            $facets_counter->{ $facets->[$k]->{'link_value'} }->{$data}++;
502
0
                                            push @used_datas, $data;
503                                        }
504                                    } # subfields
505                                } # fields
506                            } # field codes
507
0
                        } # records
508
509
0
                        $facets_info->{ $facets->[$k]->{'link_value'} }->{'label_value'} = $facets->[$k]->{'label_value'};
510
0
                        $facets_info->{ $facets->[$k]->{'link_value'} }->{'expanded'} = $facets->[$k]->{'expanded'};
511
0
                    } # facets
512                }
513                # End PROGILONE
514            }
515
516            # warn "connection ", $i-1, ": $size hits";
517            # warn $results[$i-1]->record(0)->render() if $size > 0;
518
519            # BUILD FACETS
520
0
            if ( $servers[ $i - 1 ] =~ /biblioserver/ ) {
521
0
0
                for my $link_value (
522                    sort { $facets_counter->{$b} <=> $facets_counter->{$a} }
523                        keys %$facets_counter )
524                {
525
0
                    my $expandable;
526
0
                    my $number_of_facets;
527
0
                    my @this_facets_array;
528
0
0
                    for my $one_facet (
529                        sort {
530
0
                             $facets_counter->{$link_value}->{$b}
531                         <=> $facets_counter->{$link_value}->{$a}
532                        } keys %{ $facets_counter->{$link_value} }
533                      )
534                    {
535
0
                        $number_of_facets++;
536
0
                        if ( ( $number_of_facets < 6 )
537                            || ( $expanded_facet eq $link_value )
538                            || ( $facets_info->{$link_value}->{'expanded'} ) )
539                        {
540
541                      # Sanitize the link value ), ( will cause errors with CCL,
542
0
                            my $facet_link_value = $one_facet;
543
0
                            $facet_link_value =~ s/(\(|\))/ /g;
544
545                            # fix the length that will display in the label,
546
0
                            my $facet_label_value = $one_facet;
547
0
                            my $facet_max_length =
548                                C4::Context->preference('FacetLabelTruncationLength') || 20;
549
0
                            $facet_label_value =
550                              substr( $one_facet, 0, $facet_max_length ) . "..."
551                                if length($facet_label_value) > $facet_max_length;
552
553                            # if it's a branch, label by the name, not the code,
554
0
                            if ( $link_value =~ /branch/ ) {
555
0
                                                                if (defined $branches
556                                                                        && ref($branches) eq "HASH"
557                                                                        && defined $branches->{$one_facet}
558                                                                        && ref ($branches->{$one_facet}) eq "HASH")
559                                                                {
560
0
                                 $facet_label_value =
561                                    $branches->{$one_facet}->{'branchname'};
562                                                                }
563                                                                else {
564
0
                                                                        $facet_label_value = "*";
565                                                                }
566                            }
567
568                            # but we're down with the whole label being in the link's title.
569
0
                            push @this_facets_array, {
570                                facet_count => $facets_counter->{$link_value}->{$one_facet},
571                                facet_label_value => $facet_label_value,
572                                facet_title_value => $one_facet,
573                                facet_link_value => $facet_link_value,
574                                type_link_value => $link_value,
575                            };
576                        }
577                    }
578
579                    # handle expanded option
580
0
                    unless ( $facets_info->{$link_value}->{'expanded'} ) {
581
0
                        $expandable = 1
582                          if ( ( $number_of_facets > 6 )
583                            && ( $expanded_facet ne $link_value ) );
584                    }
585
0
                    push @facets_loop, {
586                        type_link_value => $link_value,
587                        type_id => $link_value . "_id",
588                        "type_label_" . $facets_info->{$link_value}->{'label_value'} => 1,
589                        facets => \@this_facets_array,
590                        expandable => $expandable,
591                        expand => $link_value,
592                    } unless ( ($facets_info->{$link_value}->{'label_value'} =~ /Libraries/) and (C4::Context->preference('singleBranchMode')) );
593                }
594            }
595        }
596    }
597
0
    return ( undef, $results_hashref, \@facets_loop );
598}
599
600sub pazGetRecords {
601    my (
602
0
        $koha_query, $simple_query, $sort_by_ref, $servers_ref,
603        $results_per_page, $offset, $expanded_facet, $branches,
604        $query_type, $scan
605    ) = @_;
606
607
0
    my $paz = C4::Search::PazPar2->new(C4::Context->config('pazpar2url'));
608
0
    $paz->init();
609
0
    $paz->search($simple_query);
610
0
    sleep 1; # FIXME: WHY?
611
612    # do results
613
0
    my $results_hashref = {};
614
0
    my $stats = XMLin($paz->stat);
615
0
    my $results = XMLin($paz->show($offset, $results_per_page, 'work-title:1'), forcearray => 1);
616
617    # for a grouped search result, the number of hits
618    # is the number of groups returned; 'bib_hits' will have
619    # the total number of bibs.
620
0
    $results_hashref->{'biblioserver'}->{'hits'} = $results->{'merged'}->[0];
621
0
    $results_hashref->{'biblioserver'}->{'bib_hits'} = $stats->{'hits'};
622
623
0
0
    HIT: foreach my $hit (@{ $results->{'hit'} }) {
624
0
        my $recid = $hit->{recid}->[0];
625
626
0
        my $work_title = $hit->{'md-work-title'}->[0];
627
0
        my $work_author;
628
0
        if (exists $hit->{'md-work-author'}) {
629
0
            $work_author = $hit->{'md-work-author'}->[0];
630        }
631
0
        my $group_label = (defined $work_author) ? "$work_title / $work_author" : $work_title;
632
633
0
        my $result_group = {};
634
0
        $result_group->{'group_label'} = $group_label;
635
0
        $result_group->{'group_merge_key'} = $recid;
636
637
0
        my $count = 1;
638
0
        if (exists $hit->{count}) {
639
0
            $count = $hit->{count}->[0];
640        }
641
0
        $result_group->{'group_count'} = $count;
642
643        for (my $i = 0; $i < $count; $i++) {
644            # FIXME -- may need to worry about diacritics here
645
0
            my $rec = $paz->record($recid, $i);
646
0
0
            push @{ $result_group->{'RECORDS'} }, $rec;
647
0
        }
648
649
0
0
        push @{ $results_hashref->{'biblioserver'}->{'GROUPS'} }, $result_group;
650    }
651
652    # pass through facets
653
0
    my $termlist_xml = $paz->termlist('author,subject');
654
0
    my $terms = XMLin($termlist_xml, forcearray => 1);
655
0
    my @facets_loop = ();
656    #die Dumper($results);
657# foreach my $list (sort keys %{ $terms->{'list'} }) {
658# my @facets = ();
659# foreach my $facet (sort @{ $terms->{'list'}->{$list}->{'term'} } ) {
660# push @facets, {
661# facet_label_value => $facet->{'name'}->[0],
662# };
663# }
664# push @facets_loop, ( {
665# type_label => $list,
666# facets => \@facets,
667# } );
668# }
669
670
0
    return ( undef, $results_hashref, \@facets_loop );
671}
672
673# STOPWORDS
674sub _remove_stopwords {
675
0
    my ( $operand, $index ) = @_;
676
0
    my @stopwords_removed;
677
678    # phrase and exact-qualified indexes shouldn't have stopwords removed
679
0
    if ( $index !~ m/phr|ext/ ) {
680
681# remove stopwords from operand : parse all stopwords & remove them (case insensitive)
682# we use IsAlpha unicode definition, to deal correctly with diacritics.
683# otherwise, a French word like "leçon" woudl be split into "le" "çon", "le"
684# is a stopword, we'd get "çon" and wouldn't find anything...
685#
686
0
0
                foreach ( keys %{ C4::Context->stopwords } ) {
687
0
                        next if ( $_ =~ /(and|or|not)/ ); # don't remove operators
688
0
                        if ( my ($matched) = ($operand =~
689                                /([^\X\p{isAlnum}]\Q$_\E[^\X\p{isAlnum}]|[^\X\p{isAlnum}]\Q$_\E$|^\Q$_\E[^\X\p{isAlnum}])/gi))
690                        {
691
0
                                $operand =~ s/\Q$matched\E/ /gi;
692
0
                                push @stopwords_removed, $_;
693                        }
694                }
695        }
696
0
    return ( $operand, \@stopwords_removed );
697}
698
699# TRUNCATION
700sub _detect_truncation {
701
0
    my ( $operand, $index ) = @_;
702
0
    my ( @nontruncated, @righttruncated, @lefttruncated, @rightlefttruncated,
703        @regexpr );
704
0
    $operand =~ s/^ //g;
705
0
    my @wordlist = split( /\s/, $operand );
706
0
    foreach my $word (@wordlist) {
707
0
        if ( $word =~ s/^\*([^\*]+)\*$/$1/ ) {
708
0
            push @rightlefttruncated, $word;
709        }
710        elsif ( $word =~ s/^\*([^\*]+)$/$1/ ) {
711
0
            push @lefttruncated, $word;
712        }
713        elsif ( $word =~ s/^([^\*]+)\*$/$1/ ) {
714
0
            push @righttruncated, $word;
715        }
716        elsif ( index( $word, "*" ) < 0 ) {
717
0
            push @nontruncated, $word;
718        }
719        else {
720
0
            push @regexpr, $word;
721        }
722    }
723    return (
724
0
        \@nontruncated, \@righttruncated, \@lefttruncated,
725        \@rightlefttruncated, \@regexpr
726    );
727}
728
729# STEMMING
730sub _build_stemmed_operand {
731
0
    my ($operand,$lang) = @_;
732
0
    require Lingua::Stem::Snowball ;
733
0
    my $stemmed_operand;
734
735    # If operand contains a digit, it is almost certainly an identifier, and should
736    # not be stemmed. This is particularly relevant for ISBNs and ISSNs, which
737    # can contain the letter "X" - for example, _build_stemmend_operand would reduce
738    # "014100018X" to "x ", which for a MARC21 database would bring up irrelevant
739    # results (e.g., "23 x 29 cm." from the 300$c). Bug 2098.
740
0
    return $operand if $operand =~ /\d/;
741
742# FIXME: the locale should be set based on the user's language and/or search choice
743    #warn "$lang";
744
0
    my $stemmer = Lingua::Stem::Snowball->new( lang => $lang,
745                                               encoding => "UTF-8" );
746
747
0
    my @words = split( / /, $operand );
748
0
    my @stems = $stemmer->stem(\@words);
749
0
    for my $stem (@stems) {
750
0
        $stemmed_operand .= "$stem";
751
0
        $stemmed_operand .= "?"
752          unless ( $stem =~ /(and$|or$|not$)/ ) || ( length($stem) < 3 );
753
0
        $stemmed_operand .= " ";
754    }
755
0
    warn "STEMMED OPERAND: $stemmed_operand" if $DEBUG;
756
0
    return $stemmed_operand;
757}
758
759# FIELD WEIGHTING
760sub _build_weighted_query {
761
762# FIELD WEIGHTING - This is largely experimental stuff. What I'm committing works
763# pretty well but could work much better if we had a smarter query parser
764
0
    my ( $operand, $stemmed_operand, $index ) = @_;
765
0
    my $stemming = C4::Context->preference("QueryStemming") || 0;
766
0
    my $weight_fields = C4::Context->preference("QueryWeightFields") || 0;
767
0
    my $fuzzy_enabled = C4::Context->preference("QueryFuzzy") || 0;
768
769
0
    my $weighted_query .= "(rk=("; # Specifies that we're applying rank
770
771    # Keyword, or, no index specified
772
0
    if ( ( $index eq 'kw' ) || ( !$index ) ) {
773
0
        $weighted_query .=
774          "Title-cover,ext,r1=\"$operand\""; # exact title-cover
775
0
        $weighted_query .= " or ti,ext,r2=\"$operand\""; # exact title
776
0
        $weighted_query .= " or ti,phr,r3=\"$operand\""; # phrase title
777          #$weighted_query .= " or any,ext,r4=$operand"; # exact any
778          #$weighted_query .=" or kw,wrdl,r5=\"$operand\""; # word list any
779
0
        $weighted_query .= " or wrdl,fuzzy,r8=\"$operand\""
780          if $fuzzy_enabled; # add fuzzy, word list
781
0
        $weighted_query .= " or wrdl,right-Truncation,r9=\"$stemmed_operand\""
782          if ( $stemming and $stemmed_operand )
783          ; # add stemming, right truncation
784
0
        $weighted_query .= " or wrdl,r9=\"$operand\"";
785
786        # embedded sorting: 0 a-z; 1 z-a
787        # $weighted_query .= ") or (sort1,aut=1";
788    }
789
790    # Barcode searches should skip this process
791    elsif ( $index eq 'bc' ) {
792
0
        $weighted_query .= "bc=\"$operand\"";
793    }
794
795    # Authority-number searches should skip this process
796    elsif ( $index eq 'an' ) {
797
0
        $weighted_query .= "an=\"$operand\"";
798    }
799
800    # If the index already has more than one qualifier, wrap the operand
801    # in quotes and pass it back (assumption is that the user knows what they
802    # are doing and won't appreciate us mucking up their query
803    elsif ( $index =~ ',' ) {
804
0
        $weighted_query .= " $index=\"$operand\"";
805    }
806
807    #TODO: build better cases based on specific search indexes
808    else {
809
0
        $weighted_query .= " $index,ext,r1=\"$operand\""; # exact index
810          #$weighted_query .= " or (title-sort-az=0 or $index,startswithnt,st-word,r3=$operand #)";
811
0
        $weighted_query .= " or $index,phr,r3=\"$operand\""; # phrase index
812
0
        $weighted_query .=
813          " or $index,rt,wrdl,r3=\"$operand\""; # word list index
814    }
815
816
0
    $weighted_query .= "))"; # close rank specification
817
0
    return $weighted_query;
818}
819
820 - 824
=head2 getIndexes

Return an array with available indexes.

=cut
825
826sub getIndexes{
827
0
    my @indexes = (
828                    # biblio indexes
829                    'ab',
830                    'Abstract',
831                    'acqdate',
832                    'allrecords',
833                    'an',
834                    'Any',
835                    'at',
836                    'au',
837                    'aub',
838                    'aud',
839                    'audience',
840                    'auo',
841                    'aut',
842                    'Author',
843                    'Author-in-order ',
844                    'Author-personal-bibliography',
845                    'Authority-Number',
846                    'authtype',
847                    'bc',
848                    'Bib-level',
849                    'biblionumber',
850                    'bio',
851                    'biography',
852                    'callnum',
853                    'cfn',
854                    'Chronological-subdivision',
855                    'cn-bib-source',
856                    'cn-bib-sort',
857                    'cn-class',
858                    'cn-item',
859                    'cn-prefix',
860                    'cn-suffix',
861                    'cpn',
862                    'Code-institution',
863                    'Conference-name',
864                    'Conference-name-heading',
865                    'Conference-name-see',
866                    'Conference-name-seealso',
867                    'Content-type',
868                    'Control-number',
869                    'copydate',
870                    'Corporate-name',
871                    'Corporate-name-heading',
872                    'Corporate-name-see',
873                    'Corporate-name-seealso',
874                    'ctype',
875                    'date-entered-on-file',
876                    'Date-of-acquisition',
877                    'Date-of-publication',
878                    'Dewey-classification',
879                    'EAN',
880                    'extent',
881                    'fic',
882                    'fiction',
883                    'Form-subdivision',
884                    'format',
885                    'Geographic-subdivision',
886                    'he',
887                    'Heading',
888                    'Heading-use-main-or-added-entry',
889                    'Heading-use-series-added-entry ',
890                    'Heading-use-subject-added-entry',
891                    'Host-item',
892                    'id-other',
893                    'Illustration-code',
894                    'ISBN',
895                    'isbn',
896                    'ISSN',
897                    'issn',
898                    'itemtype',
899                    'kw',
900                    'Koha-Auth-Number',
901                    'l-format',
902                    'language',
903                    'lc-card',
904                    'LC-card-number',
905                    'lcn',
906                    'llength',
907                    'ln',
908                    'Local-classification',
909                    'Local-number',
910                    'Match-heading',
911                    'Match-heading-see-from',
912                    'Material-type',
913                    'mc-itemtype',
914                    'mc-rtype',
915                    'mus',
916                    'name',
917                    'Music-number',
918                    'Name-geographic',
919                    'Name-geographic-heading',
920                    'Name-geographic-see',
921                    'Name-geographic-seealso',
922                    'nb',
923                    'Note',
924                    'notes',
925                    'ns',
926                    'nt',
927                    'pb',
928                    'Personal-name',
929                    'Personal-name-heading',
930                    'Personal-name-see',
931                    'Personal-name-seealso',
932                    'pl',
933                    'Place-publication',
934                    'pn',
935                    'popularity',
936                    'pubdate',
937                    'Publisher',
938                    'Record-control-number',
939                    'rcn',
940                    'Record-type',
941                    'rtype',
942                    'se',
943                    'See',
944                    'See-also',
945                    'sn',
946                    'Stock-number',
947                    'su',
948                    'Subject',
949                    'Subject-heading-thesaurus',
950                    'Subject-name-personal',
951                    'Subject-subdivision',
952                    'Summary',
953                    'Suppress',
954                    'su-geo',
955                    'su-na',
956                    'su-to',
957                    'su-ut',
958                    'ut',
959                    'UPC',
960                    'Term-genre-form',
961                    'Term-genre-form-heading',
962                    'Term-genre-form-see',
963                    'Term-genre-form-seealso',
964                    'ti',
965                    'Title',
966                    'Title-cover',
967                    'Title-series',
968                    'Title-host',
969                    'Title-uniform',
970                    'Title-uniform-heading',
971                    'Title-uniform-see',
972                    'Title-uniform-seealso',
973                    'totalissues',
974                    'yr',
975
976                    # items indexes
977                    'acqsource',
978                    'barcode',
979                    'bc',
980                    'branch',
981                    'ccode',
982                    'classification-source',
983                    'cn-sort',
984                    'coded-location-qualifier',
985                    'copynumber',
986                    'damaged',
987                    'datelastborrowed',
988                    'datelastseen',
989                    'holdingbranch',
990                    'homebranch',
991                    'issues',
992                    'item',
993                    'itemnumber',
994                    'itype',
995                    'Local-classification',
996                    'location',
997                    'lost',
998                    'materials-specified',
999                    'mc-ccode',
1000                    'mc-itype',
1001                    'mc-loc',
1002                    'notforloan',
1003                    'onloan',
1004                    'price',
1005                    'renewals',
1006                    'replacementprice',
1007                    'replacementpricedate',
1008                    'reserves',
1009                    'restricted',
1010                    'stack',
1011                    'stocknumber',
1012                    'inv',
1013                    'uri',
1014                    'withdrawn',
1015
1016                    # subject related
1017                  );
1018
1019
0
    return \@indexes;
1020}
1021
1022 - 1036
=head2 buildQuery

( $error, $query,
$simple_query, $query_cgi,
$query_desc, $limit,
$limit_cgi, $limit_desc,
$stopwords_removed, $query_type ) = buildQuery ( $operators, $operands, $indexes, $limits, $sort_by, $scan, $lang);

Build queries and limits in CCL, CGI, Human,
handle truncation, stemming, field weighting, stopwords, fuzziness, etc.

See verbose embedded documentation.


=cut
1037
1038sub buildQuery {
1039
0
    my ( $operators, $operands, $indexes, $limits, $sort_by, $scan, $lang) = @_;
1040
1041
0
    warn "---------\nEnter buildQuery\n---------" if $DEBUG;
1042
1043    # dereference
1044
0
    my @operators = $operators ? @$operators : ();
1045
0
    my @indexes = $indexes ? @$indexes : ();
1046
0
    my @operands = $operands ? @$operands : ();
1047
0
    my @limits = $limits ? @$limits : ();
1048
0
    my @sort_by = $sort_by ? @$sort_by : ();
1049
1050
0
    my $stemming = C4::Context->preference("QueryStemming") || 0;
1051
0
    my $auto_truncation = C4::Context->preference("QueryAutoTruncate") || 0;
1052
0
    my $weight_fields = C4::Context->preference("QueryWeightFields") || 0;
1053
0
    my $fuzzy_enabled = C4::Context->preference("QueryFuzzy") || 0;
1054
0
    my $remove_stopwords = C4::Context->preference("QueryRemoveStopwords") || 0;
1055
1056    # no stemming/weight/fuzzy in NoZebra
1057
0
    if ( C4::Context->preference("NoZebra") ) {
1058
0
        $stemming = 0;
1059
0
        $weight_fields = 0;
1060
0
        $fuzzy_enabled = 0;
1061
0
     $auto_truncation = 0;
1062    }
1063
1064
0
    my $query = $operands[0];
1065
0
    my $simple_query = $operands[0];
1066
1067    # initialize the variables we're passing back
1068
0
    my $query_cgi;
1069
0
    my $query_desc;
1070
0
    my $query_type;
1071
1072
0
    my $limit;
1073
0
    my $limit_cgi;
1074
0
    my $limit_desc;
1075
1076
0
    my $stopwords_removed; # flag to determine if stopwords have been removed
1077
1078
0
    my $cclq = 0;
1079
0
    my $cclindexes = getIndexes();
1080
0
    if ( $query !~ /\s*ccl=/ ) {
1081
0
        while ( !$cclq && $query =~ /(?:^|\W)([\w-]+)(,[\w-]+)*[:=]/g ) {
1082
0
            my $dx = lc($1);
1083
0
0
            $cclq = grep { lc($_) eq $dx } @$cclindexes;
1084        }
1085
0
        $query = "ccl=$query" if $cclq;
1086    }
1087
1088# for handling ccl, cql, pqf queries in diagnostic mode, skip the rest of the steps
1089# DIAGNOSTIC ONLY!!
1090
0
    if ( $query =~ /^ccl=/ ) {
1091
0
        my $q=$';
1092        # This is needed otherwise ccl= and &limit won't work together, and
1093        # this happens when selecting a subject on the opac-detail page
1094
0
        if (@limits) {
1095
0
            $q .= ' and '.join(' and ', @limits);
1096        }
1097
0
        return ( undef, $q, $q, "q=ccl=$q", $q, '', '', '', '', 'ccl' );
1098    }
1099
0
    if ( $query =~ /^cql=/ ) {
1100
0
        return ( undef, $', $', "q=cql=$'", $', '', '', '', '', 'cql' );
1101    }
1102
0
    if ( $query =~ /^pqf=/ ) {
1103
0
        return ( undef, $', $', "q=pqf=$'", $', '', '', '', '', 'pqf' );
1104    }
1105
1106    # pass nested queries directly
1107    # FIXME: need better handling of some of these variables in this case
1108    # Nested queries aren't handled well and this implementation is flawed and causes users to be
1109    # unable to search for anything containing () commenting out, will be rewritten for 3.4.0
1110# if ( $query =~ /(\(|\))/ ) {
1111# return (
1112# undef, $query, $simple_query, $query_cgi,
1113# $query, $limit, $limit_cgi, $limit_desc,
1114# $stopwords_removed, 'ccl'
1115# );
1116# }
1117
1118# Form-based queries are non-nested and fixed depth, so we can easily modify the incoming
1119# query operands and indexes and add stemming, truncation, field weighting, etc.
1120# Once we do so, we'll end up with a value in $query, just like if we had an
1121# incoming $query from the user
1122    else {
1123
0
        $query = ""
1124          ; # clear it out so we can populate properly with field-weighted, stemmed, etc. query
1125
0
        my $previous_operand
1126          ; # a flag used to keep track if there was a previous query
1127               # if there was, we can apply the current operator
1128               # for every operand
1129        for ( my $i = 0 ; $i <= @operands ; $i++ ) {
1130
1131            # COMBINE OPERANDS, INDEXES AND OPERATORS
1132
0
            if ( $operands[$i] ) {
1133
0
                $operands[$i]=~s/^\s+//;
1134
1135              # A flag to determine whether or not to add the index to the query
1136
0
                my $indexes_set;
1137
1138# If the user is sophisticated enough to specify an index, turn off field weighting, stemming, and stopword handling
1139
0
                if ( $operands[$i] =~ /\w(:|=)/ || $scan ) {
1140
0
                    $weight_fields = 0;
1141
0
                    $stemming = 0;
1142
0
                    $remove_stopwords = 0;
1143                } else {
1144
0
                    $operands[$i] =~ s/\?/{?}/g; # need to escape question marks
1145                }
1146
0
                my $operand = $operands[$i];
1147
0
                my $index = $indexes[$i];
1148
1149                # Add index-specific attributes
1150                # Date of Publication
1151
0
                if ( $index eq 'yr' ) {
1152
0
                    $index .= ",st-numeric";
1153
0
                    $indexes_set++;
1154
0
                                        $stemming = $auto_truncation = $weight_fields = $fuzzy_enabled = $remove_stopwords = 0;
1155                }
1156
1157                # Date of Acquisition
1158                elsif ( $index eq 'acqdate' ) {
1159
0
                    $index .= ",st-date-normalized";
1160
0
                    $indexes_set++;
1161
0
                                        $stemming = $auto_truncation = $weight_fields = $fuzzy_enabled = $remove_stopwords = 0;
1162                }
1163                # ISBN,ISSN,Standard Number, don't need special treatment
1164                elsif ( $index eq 'nb' || $index eq 'ns' ) {
1165                    (
1166
0
                        $stemming, $auto_truncation,
1167                        $weight_fields, $fuzzy_enabled,
1168                        $remove_stopwords
1169                    ) = ( 0, 0, 0, 0, 0 );
1170
1171                }
1172
1173
0
                if(not $index){
1174
0
                    $index = 'kw';
1175                }
1176
1177                # Set default structure attribute (word list)
1178
0
                my $struct_attr = q{};
1179
0
                unless ( $indexes_set || !$index || $index =~ /(st-|phr|ext|wrdl|nb|ns)/ ) {
1180
0
                    $struct_attr = ",wrdl";
1181                }
1182
1183                # Some helpful index variants
1184
0
                my $index_plus = $index . $struct_attr . ':';
1185
0
                my $index_plus_comma = $index . $struct_attr . ',';
1186
1187                # Remove Stopwords
1188
0
                if ($remove_stopwords) {
1189
0
                    ( $operand, $stopwords_removed ) =
1190                      _remove_stopwords( $operand, $index );
1191
0
                    warn "OPERAND w/out STOPWORDS: >$operand<" if $DEBUG;
1192
0
                    warn "REMOVED STOPWORDS: @$stopwords_removed"
1193                      if ( $stopwords_removed && $DEBUG );
1194                }
1195
1196
0
                if ($auto_truncation){
1197
0
                                        unless ( $index =~ /(st-|phr|ext)/ ) {
1198                                                #FIXME only valid with LTR scripts
1199
0
                                                $operand=join(" ",map{
1200
0
                                                                                        (index($_,"*")>0?"$_":"$_*")
1201                                                                                         }split (/\s+/,$operand));
1202
0
                                                warn $operand if $DEBUG;
1203                                        }
1204                                }
1205
1206                # Detect Truncation
1207
0
                my $truncated_operand;
1208
0
                my( $nontruncated, $righttruncated, $lefttruncated,
1209                    $rightlefttruncated, $regexpr
1210                ) = _detect_truncation( $operand, $index );
1211
0
                warn
1212"TRUNCATION: NON:>@$nontruncated< RIGHT:>@$righttruncated< LEFT:>@$lefttruncated< RIGHTLEFT:>@$rightlefttruncated< REGEX:>@$regexpr<"
1213                  if $DEBUG;
1214
1215                # Apply Truncation
1216
0
                if (
1217                    scalar(@$righttruncated) + scalar(@$lefttruncated) +
1218                    scalar(@$rightlefttruncated) > 0 )
1219                {
1220
1221               # Don't field weight or add the index to the query, we do it here
1222
0
                    $indexes_set = 1;
1223
0
                    undef $weight_fields;
1224
0
                    my $previous_truncation_operand;
1225
0
                    if (scalar @$nontruncated) {
1226
0
                        $truncated_operand .= "$index_plus @$nontruncated ";
1227
0
                        $previous_truncation_operand = 1;
1228                    }
1229
0
                    if (scalar @$righttruncated) {
1230
0
                        $truncated_operand .= "and " if $previous_truncation_operand;
1231
0
                        $truncated_operand .= $index_plus_comma . "rtrn:@$righttruncated ";
1232
0
                        $previous_truncation_operand = 1;
1233                    }
1234
0
                    if (scalar @$lefttruncated) {
1235
0
                        $truncated_operand .= "and " if $previous_truncation_operand;
1236
0
                        $truncated_operand .= $index_plus_comma . "ltrn:@$lefttruncated ";
1237
0
                        $previous_truncation_operand = 1;
1238                    }
1239
0
                    if (scalar @$rightlefttruncated) {
1240
0
                        $truncated_operand .= "and " if $previous_truncation_operand;
1241
0
                        $truncated_operand .= $index_plus_comma . "rltrn:@$rightlefttruncated ";
1242
0
                        $previous_truncation_operand = 1;
1243                    }
1244                }
1245
0
                $operand = $truncated_operand if $truncated_operand;
1246
0
                warn "TRUNCATED OPERAND: >$truncated_operand<" if $DEBUG;
1247
1248                # Handle Stemming
1249
0
                my $stemmed_operand;
1250
0
                $stemmed_operand = _build_stemmed_operand($operand, $lang)
1251                                                                                if $stemming;
1252
1253
0
                warn "STEMMED OPERAND: >$stemmed_operand<" if $DEBUG;
1254
1255                # Handle Field Weighting
1256
0
                my $weighted_operand;
1257
0
                if ($weight_fields) {
1258
0
                    $weighted_operand = _build_weighted_query( $operand, $stemmed_operand, $index );
1259
0
                    $operand = $weighted_operand;
1260
0
                    $indexes_set = 1;
1261                }
1262
1263
0
                warn "FIELD WEIGHTED OPERAND: >$weighted_operand<" if $DEBUG;
1264
1265                # If there's a previous operand, we need to add an operator
1266
0
                if ($previous_operand) {
1267
1268                    # User-specified operator
1269
0
                    if ( $operators[ $i - 1 ] ) {
1270
0
                        $query .= " $operators[$i-1] ";
1271
0
                        $query .= " $index_plus " unless $indexes_set;
1272
0
                        $query .= " $operand";
1273
0
                        $query_cgi .= "&op=$operators[$i-1]";
1274
0
                        $query_cgi .= "&idx=$index" if $index;
1275
0
                        $query_cgi .= "&q=$operands[$i]" if $operands[$i];
1276
0
                        $query_desc .=
1277                          " $operators[$i-1] $index_plus $operands[$i]";
1278                    }
1279
1280                    # Default operator is and
1281                    else {
1282
0
                        $query .= " and ";
1283
0
                        $query .= "$index_plus " unless $indexes_set;
1284
0
                        $query .= "$operand";
1285
0
                        $query_cgi .= "&op=and&idx=$index" if $index;
1286
0
                        $query_cgi .= "&q=$operands[$i]" if $operands[$i];
1287
0
                        $query_desc .= " and $index_plus $operands[$i]";
1288                    }
1289                }
1290
1291                # There isn't a pervious operand, don't need an operator
1292                else {
1293
1294                    # Field-weighted queries already have indexes set
1295
0
                    $query .= " $index_plus " unless $indexes_set;
1296
0
                    $query .= $operand;
1297
0
                    $query_desc .= " $index_plus $operands[$i]";
1298
0
                    $query_cgi .= "&idx=$index" if $index;
1299
0
                    $query_cgi .= "&q=$operands[$i]" if $operands[$i];
1300
0
                    $previous_operand = 1;
1301                }
1302            } #/if $operands
1303
0
        } # /for
1304    }
1305
0
    warn "QUERY BEFORE LIMITS: >$query<" if $DEBUG;
1306
1307    # add limits
1308
0
    my $group_OR_limits;
1309
0
    my $availability_limit;
1310
0
    foreach my $this_limit (@limits) {
1311
0
        if ( $this_limit =~ /available/ ) {
1312#
1313## 'available' is defined as (items.onloan is NULL) and (items.itemlost = 0)
1314## In English:
1315## all records not indexed in the onloan register (zebra) and all records with a value of lost equal to 0
1316
0
            $availability_limit .=
1317"( ( allrecords,AlwaysMatches='' not onloan,AlwaysMatches='') and (lost,st-numeric=0) )"; #or ( allrecords,AlwaysMatches='' not lost,AlwaysMatches='')) )";
1318
0
            $limit_cgi .= "&limit=available";
1319
0
            $limit_desc .= "";
1320        }
1321
1322        # group_OR_limits, prefixed by mc-
1323        # OR every member of the group
1324        elsif ( $this_limit =~ /mc/ ) {
1325
1326
0
            if ( $this_limit =~ /mc-ccode:/ ) {
1327                # in case the mc-ccode value has complicating chars like ()'s inside it we wrap in quotes
1328
0
                $this_limit =~ tr/"//d;
1329
0
                my ($k,$v) = split(/:/, $this_limit,2);
1330
0
                $this_limit = $k.":\"".$v."\"";
1331            }
1332
1333
0
            $group_OR_limits .= " or " if $group_OR_limits;
1334
0
            $limit_desc .= " or " if $group_OR_limits;
1335
0
            $group_OR_limits .= "$this_limit";
1336
0
            $limit_cgi .= "&limit=$this_limit";
1337
0
            $limit_desc .= " $this_limit";
1338        }
1339
1340        # Regular old limits
1341        else {
1342
0
            $limit .= " and " if $limit || $query;
1343
0
            $limit .= "$this_limit";
1344
0
            $limit_cgi .= "&limit=$this_limit";
1345
0
            if ($this_limit =~ /^branch:(.+)/) {
1346
0
                my $branchcode = $1;
1347
0
                my $branchname = GetBranchName($branchcode);
1348
0
                if (defined $branchname) {
1349
0
                    $limit_desc .= " branch:$branchname";
1350                } else {
1351
0
                    $limit_desc .= " $this_limit";
1352                }
1353            } else {
1354
0
                $limit_desc .= " $this_limit";
1355            }
1356        }
1357    }
1358
0
    if ($group_OR_limits) {
1359
0
        $limit .= " and " if ( $query || $limit );
1360
0
        $limit .= "($group_OR_limits)";
1361    }
1362
0
    if ($availability_limit) {
1363
0
        $limit .= " and " if ( $query || $limit );
1364
0
        $limit .= "($availability_limit)";
1365    }
1366
1367    # Normalize the query and limit strings
1368    # This is flawed , means we can't search anything with : in it
1369    # if user wants to do ccl or cql, start the query with that
1370# $query =~ s/:/=/g;
1371
0
    $query =~ s/(?<=(ti|au|pb|su|an|kw|mc|nb|ns)):/=/g;
1372
0
    $query =~ s/(?<=(wrdl)):/=/g;
1373
0
    $query =~ s/(?<=(trn|phr)):/=/g;
1374
0
    $limit =~ s/:/=/g;
1375
0
    for ( $query, $query_desc, $limit, $limit_desc ) {
1376
0
        s/ +/ /g; # remove extra spaces
1377
0
        s/^ //g; # remove any beginning spaces
1378
0
        s/ $//g; # remove any ending spaces
1379
0
        s/==/=/g; # remove double == from query
1380    }
1381
0
    $query_cgi =~ s/^&//; # remove unnecessary & from beginning of the query cgi
1382
1383
0
    for ($query_cgi,$simple_query) {
1384
0
        s/"//g;
1385    }
1386    # append the limit to the query
1387
0
    $query .= " " . $limit;
1388
1389    # Warnings if DEBUG
1390
0
    if ($DEBUG) {
1391
0
        warn "QUERY:" . $query;
1392
0
        warn "QUERY CGI:" . $query_cgi;
1393
0
        warn "QUERY DESC:" . $query_desc;
1394
0
        warn "LIMIT:" . $limit;
1395
0
        warn "LIMIT CGI:" . $limit_cgi;
1396
0
        warn "LIMIT DESC:" . $limit_desc;
1397
0
        warn "---------\nLeave buildQuery\n---------";
1398    }
1399    return (
1400
0
        undef, $query, $simple_query, $query_cgi,
1401        $query_desc, $limit, $limit_cgi, $limit_desc,
1402        $stopwords_removed, $query_type
1403    );
1404}
1405
1406 - 1414
=head2 searchResults

  my @search_results = searchResults($search_context, $searchdesc, $hits, 
                                     $results_per_page, $offset, $scan, 
                                     @marcresults, $hidelostitems);

Format results in a form suitable for passing to the template

=cut
1415
1416# IMO this subroutine is pretty messy still -- it's responsible for
1417# building the HTML output for the template
1418sub searchResults {
1419
0
    my ( $search_context, $searchdesc, $hits, $results_per_page, $offset, $scan, $marcresults ) = @_;
1420
0
    my $dbh = C4::Context->dbh;
1421
0
    my @newresults;
1422
1423
0
    $search_context = 'opac' if !$search_context || $search_context ne 'intranet';
1424
0
    my ($is_opac, $hidelostitems);
1425
0
    if ($search_context eq 'opac') {
1426
0
        $hidelostitems = C4::Context->preference('hidelostitems');
1427
0
        $is_opac = 1;
1428    }
1429
1430    #Build branchnames hash
1431    #find branchname
1432    #get branch information.....
1433
0
    my %branches;
1434
0
    my $bsth =$dbh->prepare("SELECT branchcode,branchname FROM branches"); # FIXME : use C4::Branch::GetBranches
1435
0
    $bsth->execute();
1436
0
    while ( my $bdata = $bsth->fetchrow_hashref ) {
1437
0
        $branches{ $bdata->{'branchcode'} } = $bdata->{'branchname'};
1438    }
1439# FIXME - We build an authorised values hash here, using the default framework
1440# though it is possible to have different authvals for different fws.
1441
1442
0
    my $shelflocations =GetKohaAuthorisedValues('items.location','');
1443
1444    # get notforloan authorised value list (see $shelflocations FIXME)
1445
0
    my $notforloan_authorised_value = GetAuthValCode('items.notforloan','');
1446
1447    #Build itemtype hash
1448    #find itemtype & itemtype image
1449
0
    my %itemtypes;
1450
0
    $bsth =
1451      $dbh->prepare(
1452        "SELECT itemtype,description,imageurl,summary,notforloan FROM itemtypes"
1453      );
1454
0
    $bsth->execute();
1455
0
    while ( my $bdata = $bsth->fetchrow_hashref ) {
1456
0
                foreach (qw(description imageurl summary notforloan)) {
1457
0
         $itemtypes{ $bdata->{'itemtype'} }->{$_} = $bdata->{$_};
1458                }
1459    }
1460
1461    #search item field code
1462
0
    my $sth =
1463      $dbh->prepare(
1464"SELECT tagfield FROM marc_subfield_structure WHERE kohafield LIKE 'items.itemnumber'"
1465      );
1466
0
    $sth->execute;
1467
0
    my ($itemtag) = $sth->fetchrow;
1468
1469    ## find column names of items related to MARC
1470
0
    my $sth2 = $dbh->prepare("SHOW COLUMNS FROM items");
1471
0
    $sth2->execute;
1472
0
    my %subfieldstosearch;
1473
0
    while ( ( my $column ) = $sth2->fetchrow ) {
1474
0
        my ( $tagfield, $tagsubfield ) =
1475          &GetMarcFromKohaField( "items." . $column, "" );
1476
0
        $subfieldstosearch{$column} = $tagsubfield;
1477    }
1478
1479    # handle which records to actually retrieve
1480
0
    my $times;
1481
0
    if ( $hits && $offset + $results_per_page <= $hits ) {
1482
0
        $times = $offset + $results_per_page;
1483    }
1484    else {
1485
0
        $times = $hits; # FIXME: if $hits is undefined, why do we want to equal it?
1486    }
1487
1488
0
        my $marcflavour = C4::Context->preference("marcflavour");
1489    # We get the biblionumber position in MARC
1490
0
    my ($bibliotag,$bibliosubf)=GetMarcFromKohaField('biblio.biblionumber','');
1491
1492    # loop through all of the records we've retrieved
1493    for ( my $i = $offset ; $i <= $times - 1 ; $i++ ) {
1494
0
        my $marcrecord = MARC::File::USMARC::decode( $marcresults->[$i] );
1495
0
        my $fw = $scan
1496             ? undef
1497             : $bibliotag < 10
1498               ? GetFrameworkCode($marcrecord->field($bibliotag)->data)
1499               : GetFrameworkCode($marcrecord->subfield($bibliotag,$bibliosubf));
1500
0
        my $oldbiblio = TransformMarcToKoha( $dbh, $marcrecord, $fw );
1501
0
        $oldbiblio->{subtitle} = GetRecordValue('subtitle', $marcrecord, $fw);
1502
0
        $oldbiblio->{result_number} = $i + 1;
1503
1504        # add imageurl to itemtype if there is one
1505
0
        $oldbiblio->{imageurl} = getitemtypeimagelocation( $search_context, $itemtypes{ $oldbiblio->{itemtype} }->{imageurl} );
1506
1507
0
        $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 ) ) : [];
1508
0
                $oldbiblio->{normalized_upc} = GetNormalizedUPC( $marcrecord,$marcflavour);
1509
0
                $oldbiblio->{normalized_ean} = GetNormalizedEAN( $marcrecord,$marcflavour);
1510
0
                $oldbiblio->{normalized_oclc} = GetNormalizedOCLCNumber($marcrecord,$marcflavour);
1511
0
                $oldbiblio->{normalized_isbn} = GetNormalizedISBN(undef,$marcrecord,$marcflavour);
1512
0
                $oldbiblio->{content_identifier_exists} = 1 if ($oldbiblio->{normalized_isbn} or $oldbiblio->{normalized_oclc} or $oldbiblio->{normalized_ean} or $oldbiblio->{normalized_upc});
1513
1514                # edition information, if any
1515
0
        $oldbiblio->{edition} = $oldbiblio->{editionstatement};
1516
0
                $oldbiblio->{description} = $itemtypes{ $oldbiblio->{itemtype} }->{description};
1517 # Build summary if there is one (the summary is defined in the itemtypes table)
1518 # FIXME: is this used anywhere, I think it can be commented out? -- JF
1519
0
        if ( $itemtypes{ $oldbiblio->{itemtype} }->{summary} ) {
1520
0
            my $summary = $itemtypes{ $oldbiblio->{itemtype} }->{summary};
1521
0
            my @fields = $marcrecord->fields();
1522
1523
0
            my $newsummary;
1524
0
            foreach my $line ( "$summary\n" =~ /(.*)\n/g ){
1525
0
                my $tags = {};
1526
0
                foreach my $tag ( $line =~ /\[(\d{3}[\w|\d])\]/ ) {
1527
0
                    $tag =~ /(.{3})(.)/;
1528
0
                    if($marcrecord->field($1)){
1529
0
                        my @abc = $marcrecord->field($1)->subfield($2);
1530
0
                        $tags->{$tag} = $#abc + 1 ;
1531                    }
1532                }
1533
1534                # We catch how many times to repeat this line
1535
0
                my $max = 0;
1536
0
                foreach my $tag (keys(%$tags)){
1537
0
                    $max = $tags->{$tag} if($tags->{$tag} > $max);
1538                 }
1539
1540                # we replace, and repeat each line
1541                for (my $i = 0 ; $i < $max ; $i++){
1542
0
                    my $newline = $line;
1543
1544
0
                    foreach my $tag ( $newline =~ /\[(\d{3}[\w|\d])\]/g ) {
1545
0
                        $tag =~ /(.{3})(.)/;
1546
1547
0
                        if($marcrecord->field($1)){
1548
0
                            my @repl = $marcrecord->field($1)->subfield($2);
1549
0
                            my $subfieldvalue = $repl[$i];
1550
1551
0
                            if (! utf8::is_utf8($subfieldvalue)) {
1552
0
                                utf8::decode($subfieldvalue);
1553                            }
1554
1555
0
                             $newline =~ s/\[$tag\]/$subfieldvalue/g;
1556                        }
1557                    }
1558
0
                    $newsummary .= "$newline\n";
1559
0
                }
1560            }
1561
1562
0
            $newsummary =~ s/\[(.*?)]//g;
1563
0
            $newsummary =~ s/\n/<br\/>/g;
1564
0
            $oldbiblio->{summary} = $newsummary;
1565        }
1566
1567        # Pull out the items fields
1568
0
        my @fields = $marcrecord->field($itemtag);
1569
0
        my $marcflavor = C4::Context->preference("marcflavour");
1570        # adding linked items that belong to host records
1571
0
        my $analyticsfield = '773';
1572
0
        if ($marcflavor eq 'MARC21' || $marcflavor eq 'NORMARC') {
1573
0
            $analyticsfield = '773';
1574        } elsif ($marcflavor eq 'UNIMARC') {
1575
0
            $analyticsfield = '461';
1576        }
1577
0
        foreach my $hostfield ( $marcrecord->field($analyticsfield)) {
1578
0
            my $hostbiblionumber = $hostfield->subfield("0");
1579
0
            my $linkeditemnumber = $hostfield->subfield("9");
1580
0
            if(!$hostbiblionumber eq undef){
1581
0
                my $hostbiblio = GetMarcBiblio($hostbiblionumber, 1);
1582
0
                my ($itemfield, undef) = GetMarcFromKohaField( 'items.itemnumber', GetFrameworkCode($hostbiblionumber) );
1583
0
                if(!$hostbiblio eq undef){
1584
0
                    my @hostitems = $hostbiblio->field($itemfield);
1585
0
                    foreach my $hostitem (@hostitems){
1586
0
                        if ($hostitem->subfield("9") eq $linkeditemnumber){
1587
0
                            my $linkeditem =$hostitem;
1588                            # append linked items if they exist
1589
0
                            if (!$linkeditem eq undef){
1590
0
                                push (@fields, $linkeditem);}
1591                        }
1592                    }
1593                }
1594            }
1595        }
1596
1597        # Setting item statuses for display
1598
0
        my @available_items_loop;
1599
0
        my @onloan_items_loop;
1600
0
        my @other_items_loop;
1601
1602
0
        my $available_items;
1603
0
        my $onloan_items;
1604
0
        my $other_items;
1605
1606
0
        my $ordered_count = 0;
1607
0
        my $available_count = 0;
1608
0
        my $onloan_count = 0;
1609
0
        my $longoverdue_count = 0;
1610
0
        my $other_count = 0;
1611
0
        my $wthdrawn_count = 0;
1612
0
        my $itemlost_count = 0;
1613
0
        my $hideatopac_count = 0;
1614
0
        my $itembinding_count = 0;
1615
0
        my $itemdamaged_count = 0;
1616
0
        my $item_in_transit_count = 0;
1617
0
        my $can_place_holds = 0;
1618
0
        my $item_onhold_count = 0;
1619
0
        my $items_count = scalar(@fields);
1620
0
        my $maxitems_pref = C4::Context->preference('maxItemsinSearchResults');
1621
0
        my $maxitems = $maxitems_pref ? $maxitems_pref - 1 : 1;
1622
1623        # loop through every item
1624
0
              my @hiddenitems;
1625
0
        foreach my $field (@fields) {
1626
0
            my $item;
1627
1628            # populate the items hash
1629
0
            foreach my $code ( keys %subfieldstosearch ) {
1630
0
                $item->{$code} = $field->subfield( $subfieldstosearch{$code} );
1631            }
1632
1633                # Hidden items
1634
0
            if ($is_opac) {
1635
0
                    my @hi = GetHiddenItemnumbers($item);
1636
0
                $item->{'hideatopac'} = @hi;
1637
0
              push @hiddenitems, @hi;
1638            }
1639
1640
0
            my $hbranch = C4::Context->preference('HomeOrHoldingBranch') eq 'homebranch' ? 'homebranch' : 'holdingbranch';
1641
0
            my $otherbranch = C4::Context->preference('HomeOrHoldingBranch') eq 'homebranch' ? 'holdingbranch' : 'homebranch';
1642
1643            # set item's branch name, use HomeOrHoldingBranch syspref first, fall back to the other one
1644
0
            if ($item->{$hbranch}) {
1645
0
                $item->{'branchname'} = $branches{$item->{$hbranch}};
1646            }
1647            elsif ($item->{$otherbranch}) { # Last resort
1648
0
                $item->{'branchname'} = $branches{$item->{$otherbranch}};
1649            }
1650
1651
0
                        my $prefix = $item->{$hbranch} . '--' . $item->{location} . $item->{itype} . $item->{itemcallnumber};
1652# For each grouping of items (onloan, available, unavailable), we build a key to store relevant info about that item
1653
0
            my $userenv = C4::Context->userenv;
1654
0
            if ( $item->{onloan} && !(C4::Members::GetHideLostItemsPreference($userenv->{'number'}) && $item->{itemlost}) ) {
1655
0
                $onloan_count++;
1656
0
                                my $key = $prefix . $item->{onloan} . $item->{barcode};
1657
0
                                $onloan_items->{$key}->{due_date} = format_date($item->{onloan});
1658
0
                                $onloan_items->{$key}->{count}++ if $item->{$hbranch};
1659
0
                                $onloan_items->{$key}->{branchname} = $item->{branchname};
1660
0
                                $onloan_items->{$key}->{location} = $shelflocations->{ $item->{location} };
1661
0
                                $onloan_items->{$key}->{itemcallnumber} = $item->{itemcallnumber};
1662
0
                                $onloan_items->{$key}->{imageurl} = getitemtypeimagelocation( $search_context, $itemtypes{ $item->{itype} }->{imageurl} );
1663                # if something's checked out and lost, mark it as 'long overdue'
1664
0
                if ( $item->{itemlost} ) {
1665
0
                    $onloan_items->{$prefix}->{longoverdue}++;
1666
0
                    $longoverdue_count++;
1667                } else { # can place holds as long as item isn't lost
1668
0
                    $can_place_holds = 1;
1669                }
1670            }
1671
1672         # items not on loan, but still unavailable ( lost, withdrawn, damaged )
1673            else {
1674
1675                # item is on order
1676
0
                if ( $item->{notforloan} == -1 ) {
1677
0
                    $ordered_count++;
1678                }
1679
1680                # is item in transit?
1681
0
                my $transfertwhen = '';
1682
0
                my ($transfertfrom, $transfertto);
1683
1684                # is item on the reserve shelf?
1685
0
                my $reservestatus = '';
1686
0
                my $reserveitem;
1687
1688
0
                unless ($item->{wthdrawn}
1689                        || $item->{itemlost}
1690                        || $item->{damaged}
1691                        || $item->{notforloan}
1692                        || $items_count > 20) {
1693
1694                    # A couple heuristics to limit how many times
1695                    # we query the database for item transfer information, sacrificing
1696                    # accuracy in some cases for speed;
1697                    #
1698                    # 1. don't query if item has one of the other statuses
1699                    # 2. don't check transit status if the bib has
1700                    # more than 20 items
1701                    #
1702                    # FIXME: to avoid having the query the database like this, and to make
1703                    # the in transit status count as unavailable for search limiting,
1704                    # should map transit status to record indexed in Zebra.
1705                    #
1706
0
                    ($transfertwhen, $transfertfrom, $transfertto) = C4::Circulation::GetTransfers($item->{itemnumber});
1707
0
                    ($reservestatus, $reserveitem, undef) = C4::Reserves::CheckReserves($item->{itemnumber});
1708                }
1709
1710                # item is withdrawn, lost, damaged, not for loan, reserved or in transit
1711
0
                if ( $item->{wthdrawn}
1712                    || $item->{itemlost}
1713                    || $item->{damaged}
1714                    || $item->{notforloan} > 0
1715                    || $item->{hideatopac}
1716                    || $reservestatus eq 'Waiting'
1717                    || ($transfertwhen ne ''))
1718                {
1719
0
                    $wthdrawn_count++ if $item->{wthdrawn};
1720
0
                    $itemlost_count++ if $item->{itemlost};
1721
0
                    $itemdamaged_count++ if $item->{damaged};
1722
0
                    $hideatopac_count++ if $item->{hideatopac};
1723
0
                    $item_in_transit_count++ if $transfertwhen ne '';
1724
0
                    $item_onhold_count++ if $reservestatus eq 'Waiting';
1725
0
                    $item->{status} = $item->{wthdrawn} . "-" . $item->{itemlost} . "-" . $item->{damaged} . "-" . $item->{notforloan};
1726
1727                    # can place hold on item ?
1728
0
                    if ((!$item->{damaged} || C4::Context->preference('AllowHoldsOnDamagedItems'))
1729                      && !$item->{itemlost}
1730                      && !$item->{withdrawn}
1731                    ) {
1732
0
                        $can_place_holds = 1;
1733                    }
1734
1735
0
                    $other_count++;
1736
1737
0
                    my $key = $prefix . $item->{status};
1738
0
                    foreach (qw(wthdrawn itemlost damaged branchname itemcallnumber hideatopac)) {
1739
0
                        $other_items->{$key}->{$_} = $item->{$_};
1740                    }
1741
0
                    $other_items->{$key}->{intransit} = ( $transfertwhen ne '' ) ? 1 : 0;
1742
0
                    $other_items->{$key}->{onhold} = ($reservestatus) ? 1 : 0;
1743
0
                                        $other_items->{$key}->{notforloan} = GetAuthorisedValueDesc('','',$item->{notforloan},'','',$notforloan_authorised_value) if $notforloan_authorised_value;
1744
0
                                        $other_items->{$key}->{count}++ if $item->{$hbranch};
1745
0
                                        $other_items->{$key}->{location} = $shelflocations->{ $item->{location} };
1746
0
                                        $other_items->{$key}->{imageurl} = getitemtypeimagelocation( $search_context, $itemtypes{ $item->{itype} }->{imageurl} );
1747                }
1748                # item is available
1749                else {
1750
0
                    $can_place_holds = 1;
1751
0
                    $available_count++;
1752
0
                                        $available_items->{$prefix}->{count}++ if $item->{$hbranch};
1753
0
                                        foreach (qw(branchname itemcallnumber hideatopac)) {
1754
0
                     $available_items->{$prefix}->{$_} = $item->{$_};
1755                                        }
1756
0
                                        $available_items->{$prefix}->{location} = $shelflocations->{ $item->{location} };
1757
0
                                        $available_items->{$prefix}->{imageurl} = getitemtypeimagelocation( $search_context, $itemtypes{ $item->{itype} }->{imageurl} );
1758                }
1759            }
1760        } # notforloan, item level and biblioitem level
1761
0
        if ($items_count > 0) {
1762
0
        next if $is_opac && $hideatopac_count >= $items_count;
1763
0
        next if $hidelostitems && $itemlost_count >= $items_count;
1764        }
1765
0
        my ( $availableitemscount, $onloanitemscount, $otheritemscount );
1766
0
        for my $key ( sort keys %$onloan_items ) {
1767
0
            (++$onloanitemscount > $maxitems) and last;
1768
0
            push @onloan_items_loop, $onloan_items->{$key};
1769        }
1770
0
        for my $key ( sort keys %$other_items ) {
1771
0
            (++$otheritemscount > $maxitems) and last;
1772
0
            push @other_items_loop, $other_items->{$key};
1773        }
1774
0
        for my $key ( sort keys %$available_items ) {
1775
0
            (++$availableitemscount > $maxitems) and last;
1776
0
            push @available_items_loop, $available_items->{$key}
1777        }
1778
1779         # if biblio level itypes are used and itemtype is notforloan, it can't be reserved either
1780
0
        if (!C4::Context->preference("item-level_itypes")) {
1781
0
            if ($itemtypes{ $oldbiblio->{itemtype} }->{notforloan}) {
1782
0
                $can_place_holds = 0;
1783            }
1784        }
1785
0
        $oldbiblio->{norequests} = 1 unless $can_place_holds;
1786
0
        $oldbiblio->{itemsplural} = 1 if $items_count > 1;
1787
0
        $oldbiblio->{items_count} = $items_count;
1788
0
        $oldbiblio->{available_items_loop} = \@available_items_loop;
1789
0
        $oldbiblio->{onloan_items_loop} = \@onloan_items_loop;
1790
0
        $oldbiblio->{other_items_loop} = \@other_items_loop;
1791
0
        $oldbiblio->{availablecount} = $available_count;
1792
0
        $oldbiblio->{availableplural} = 1 if $available_count > 1;
1793
0
        $oldbiblio->{onloancount} = $onloan_count;
1794
0
        $oldbiblio->{onloanplural} = 1 if $onloan_count > 1;
1795
0
        $oldbiblio->{othercount} = $other_count;
1796
0
        $oldbiblio->{otherplural} = 1 if $other_count > 1;
1797
0
        $oldbiblio->{wthdrawncount} = $wthdrawn_count;
1798
0
        $oldbiblio->{itemlostcount} = $itemlost_count;
1799
0
        $oldbiblio->{damagedcount} = $itemdamaged_count;
1800
0
        $oldbiblio->{intransitcount} = $item_in_transit_count;
1801
0
        $oldbiblio->{onholdcount} = $item_onhold_count;
1802
0
        $oldbiblio->{orderedcount} = $ordered_count;
1803        # deleting - in isbn to enable amazon content
1804
0
        $oldbiblio->{isbn} =~ s/-//g;
1805
1806
0
        if (C4::Context->preference("AlternateHoldingsField") && $items_count == 0) {
1807
0
            my $fieldspec = C4::Context->preference("AlternateHoldingsField");
1808
0
            my $subfields = substr $fieldspec, 3;
1809
0
            my $holdingsep = C4::Context->preference("AlternateHoldingsSeparator") || ' ';
1810
0
            my @alternateholdingsinfo = ();
1811
0
            my @holdingsfields = $marcrecord->field(substr $fieldspec, 0, 3);
1812
0
            my $alternateholdingscount = 0;
1813
1814
0
            for my $field (@holdingsfields) {
1815
0
                my %holding = ( holding => '' );
1816
0
                my $havesubfield = 0;
1817
0
                for my $subfield ($field->subfields()) {
1818
0
                    if ((index $subfields, $$subfield[0]) >= 0) {
1819
0
                        $holding{'holding'} .= $holdingsep if (length $holding{'holding'} > 0);
1820
0
                        $holding{'holding'} .= $$subfield[1];
1821
0
                        $havesubfield++;
1822                    }
1823                }
1824
0
                if ($havesubfield) {
1825
0
                    push(@alternateholdingsinfo, \%holding);
1826
0
                    $alternateholdingscount++;
1827                }
1828            }
1829
1830
0
            $oldbiblio->{'ALTERNATEHOLDINGS'} = \@alternateholdingsinfo;
1831
0
            $oldbiblio->{'alternateholdings_count'} = $alternateholdingscount;
1832        }
1833
1834       # XSLT processing of some stuff
1835
0
        if (!$scan && $search_context eq 'opac' && C4::Context->preference("OPACXSLTResultsDisplay")) {
1836
0
            SetUTF8Flag($marcrecord);
1837
0
            $debug && warn $marcrecord->as_formatted;
1838            # FIXME note that XSLTResultsDisplay (use of XSLT to format staff interface bib search results)
1839            # is not implemented yet
1840
0
            $oldbiblio->{XSLTResultsRecord}
1841              = XSLTParse4Display($oldbiblio->{biblionumber},
1842                                  $marcrecord,
1843                                  'Results',
1844                                  $search_context,
1845                                  1, # clean up the problematic ampersand entities that Zebra outputs
1846                                  \@hiddenitems
1847                                );
1848
1849        }
1850
1851
0
        push( @newresults, $oldbiblio );
1852
0
    }
1853
1854
0
    return @newresults;
1855}
1856
1857 - 1859
=head2 SearchAcquisitions
    Search for acquisitions
=cut
1860
1861sub SearchAcquisitions{
1862
0
    my ($datebegin, $dateend, $itemtypes,$criteria, $orderby) = @_;
1863
1864
0
    my $dbh=C4::Context->dbh;
1865    # Variable initialization
1866
0
    my $str=qq|
1867    SELECT marcxml
1868    FROM biblio
1869    LEFT JOIN biblioitems ON biblioitems.biblionumber=biblio.biblionumber
1870    LEFT JOIN items ON items.biblionumber=biblio.biblionumber
1871    WHERE dateaccessioned BETWEEN ? AND ?
1872    |;
1873
1874
0
    my (@params,@loopcriteria);
1875
1876
0
    push @params, $datebegin->output("iso");
1877
0
    push @params, $dateend->output("iso");
1878
1879
0
    if (scalar(@$itemtypes)>0 and $criteria ne "itemtype" ){
1880
0
        if(C4::Context->preference("item-level_itypes")){
1881
0
            $str .= "AND items.itype IN (?".( ',?' x scalar @$itemtypes - 1 ).") ";
1882        }else{
1883
0
            $str .= "AND biblioitems.itemtype IN (?".( ',?' x scalar @$itemtypes - 1 ).") ";
1884        }
1885
0
        push @params, @$itemtypes;
1886    }
1887
1888
0
    if ($criteria =~/itemtype/){
1889
0
        if(C4::Context->preference("item-level_itypes")){
1890
0
            $str .= "AND items.itype=? ";
1891        }else{
1892
0
            $str .= "AND biblioitems.itemtype=? ";
1893        }
1894
1895
0
        if(scalar(@$itemtypes) == 0){
1896
0
            my $itypes = GetItemTypes();
1897
0
            for my $key (keys %$itypes){
1898
0
                push @$itemtypes, $key;
1899            }
1900        }
1901
1902
0
        @loopcriteria= @$itemtypes;
1903    }elsif ($criteria=~/itemcallnumber/){
1904
0
        $str .= "AND (items.itemcallnumber LIKE CONCAT(?,'%')
1905                 OR items.itemcallnumber is NULL
1906                 OR items.itemcallnumber = '')";
1907
1908
0
        @loopcriteria = ("AA".."ZZ", "") unless (scalar(@loopcriteria)>0);
1909    }else {
1910
0
        $str .= "AND biblio.title LIKE CONCAT(?,'%') ";
1911
0
        @loopcriteria = ("A".."z") unless (scalar(@loopcriteria)>0);
1912    }
1913
1914
0
    if ($orderby =~ /date_desc/){
1915
0
        $str.=" ORDER BY dateaccessioned DESC";
1916    } else {
1917
0
        $str.=" ORDER BY title";
1918    }
1919
1920
0
    my $qdataacquisitions=$dbh->prepare($str);
1921
1922
0
    my @loopacquisitions;
1923
0
    foreach my $value(@loopcriteria){
1924
0
        push @params,$value;
1925
0
        my %cell;
1926
0
        $cell{"title"}=$value;
1927
0
        $cell{"titlecode"}=$value;
1928
1929
0
0
        eval{$qdataacquisitions->execute(@params);};
1930
1931
0
0
        if ($@){ warn "recentacquisitions Error :$@";}
1932        else {
1933
0
            my @loopdata;
1934
0
            while (my $data=$qdataacquisitions->fetchrow_hashref){
1935
0
                push @loopdata, {"summary"=>GetBiblioSummary( $data->{'marcxml'} ) };
1936            }
1937
0
            $cell{"loopdata"}=\@loopdata;
1938        }
1939
0
0
        push @loopacquisitions,\%cell if (scalar(@{$cell{loopdata}})>0);
1940
0
        pop @params;
1941    }
1942
0
    $qdataacquisitions->finish;
1943
0
    return \@loopacquisitions;
1944}
1945#----------------------------------------------------------------------
1946#
1947# Non-Zebra GetRecords#
1948#----------------------------------------------------------------------
1949
1950 - 1954
=head2 NZgetRecords

  NZgetRecords has the same API as zera getRecords, even if some parameters are not managed

=cut
1955
1956sub NZgetRecords {
1957    my (
1958
0
        $query, $simple_query, $sort_by_ref, $servers_ref,
1959        $results_per_page, $offset, $expanded_facet, $branches,
1960        $query_type, $scan
1961    ) = @_;
1962
0
    warn "query =$query" if $DEBUG;
1963
0
    my $result = NZanalyse($query);
1964
0
    warn "results =$result" if $DEBUG;
1965    return ( undef,
1966
0
        NZorder( $result, @$sort_by_ref[0], $results_per_page, $offset ),
1967        undef );
1968}
1969
1970 - 1977
=head2 NZanalyse

  NZanalyse : get a CQL string as parameter, and returns a list of biblionumber;title,biblionumber;title,...
  the list is built from an inverted index in the nozebra SQL table
  note that title is here only for convenience : the sorting will be very fast when requested on title
  if the sorting is requested on something else, we will have to reread all results, and that may be longer.

=cut
1978
1979sub NZanalyse {
1980
0
    my ( $string, $server ) = @_;
1981# warn "---------" if $DEBUG;
1982
0
    warn " NZanalyse" if $DEBUG;
1983# warn "---------" if $DEBUG;
1984
1985 # $server contains biblioserver or authorities, depending on what we search on.
1986 #warn "querying : $string on $server";
1987
0
    $server = 'biblioserver' unless $server;
1988
1989# if we have a ", replace the content to discard temporarily any and/or/not inside
1990
0
    my $commacontent;
1991
0
    if ( $string =~ /"/ ) {
1992
0
        $string =~ s/"(.*?)"/__X__/;
1993
0
        $commacontent = $1;
1994
0
        warn "commacontent : $commacontent" if $DEBUG;
1995    }
1996
1997# split the query string in 3 parts : X AND Y means : $left="X", $operand="AND" and $right="Y"
1998# then, call again NZanalyse with $left and $right
1999# (recursive until we find a leaf (=> something without and/or/not)
2000# delete repeated operator... Would then go in infinite loop
2001
0
    while ( $string =~ s/( and| or| not| AND| OR| NOT)\1/$1/g ) {
2002    }
2003
2004    #process parenthesis before.
2005
0
    if ( $string =~ /^\s*\((.*)\)(( and | or | not | AND | OR | NOT )(.*))?/ ) {
2006
0
        my $left = $1;
2007
0
        my $right = $4;
2008
0
        my $operator = lc($3); # FIXME: and/or/not are operators, not operands
2009
0
        warn
2010"dealing w/parenthesis before recursive sub call. left :$left operator:$operator right:$right"
2011          if $DEBUG;
2012
0
        my $leftresult = NZanalyse( $left, $server );
2013
0
        if ($operator) {
2014
0
            my $rightresult = NZanalyse( $right, $server );
2015
2016            # OK, we have the results for right and left part of the query
2017            # depending of operand, intersect, union or exclude both lists
2018            # to get a result list
2019
0
            if ( $operator eq ' and ' ) {
2020
0
                return NZoperatorAND($leftresult,$rightresult);
2021            }
2022            elsif ( $operator eq ' or ' ) {
2023
2024                # just merge the 2 strings
2025
0
                return $leftresult . $rightresult;
2026            }
2027            elsif ( $operator eq ' not ' ) {
2028
0
                return NZoperatorNOT($leftresult,$rightresult);
2029            }
2030        }
2031        else {
2032# this error is impossible, because of the regexp that isolate the operand, but just in case...
2033
0
            return $leftresult;
2034        }
2035    }
2036
0
    warn "string :" . $string if $DEBUG;
2037
0
    my $left = "";
2038
0
    my $right = "";
2039
0
    my $operator = "";
2040
0
    if ($string =~ /(.*?)( and | or | not | AND | OR | NOT )(.*)/) {
2041
0
        $left = $1;
2042
0
        $right = $3;
2043
0
        $operator = lc($2); # FIXME: and/or/not are operators, not operands
2044    }
2045
0
    warn "no parenthesis. left : $left operator: $operator right: $right"
2046      if $DEBUG;
2047
2048    # it's not a leaf, we have a and/or/not
2049
0
    if ($operator) {
2050
2051        # reintroduce comma content if needed
2052
0
        $right =~ s/__X__/"$commacontent"/ if $commacontent;
2053
0
        $left =~ s/__X__/"$commacontent"/ if $commacontent;
2054
0
        warn "node : $left / $operator / $right\n" if $DEBUG;
2055
0
        my $leftresult = NZanalyse( $left, $server );
2056
0
        my $rightresult = NZanalyse( $right, $server );
2057
0
        warn " leftresult : $leftresult" if $DEBUG;
2058
0
        warn " rightresult : $rightresult" if $DEBUG;
2059        # OK, we have the results for right and left part of the query
2060        # depending of operand, intersect, union or exclude both lists
2061        # to get a result list
2062
0
        if ( $operator eq ' and ' ) {
2063
0
            return NZoperatorAND($leftresult,$rightresult);
2064        }
2065        elsif ( $operator eq ' or ' ) {
2066
2067            # just merge the 2 strings
2068
0
            return $leftresult . $rightresult;
2069        }
2070        elsif ( $operator eq ' not ' ) {
2071
0
            return NZoperatorNOT($leftresult,$rightresult);
2072        }
2073        else {
2074
2075# this error is impossible, because of the regexp that isolate the operand, but just in case...
2076
0
            die "error : operand unknown : $operator for $string";
2077        }
2078
2079        # it's a leaf, do the real SQL query and return the result
2080    }
2081    else {
2082
0
        $string =~ s/__X__/"$commacontent"/ if $commacontent;
2083
0
        $string =~ s/-|\.|\?|,|;|!|'|\(|\)|\[|\]|{|}|"|&|\+|\*|\// /g;
2084        #remove trailing blank at the beginning
2085
0
        $string =~ s/^ //g;
2086
0
        warn "leaf:$string" if $DEBUG;
2087
2088        # parse the string in in operator/operand/value again
2089
0
        my $left = "";
2090
0
        my $operator = "";
2091
0
        my $right = "";
2092
0
        if ($string =~ /(.*)(>=|<=)(.*)/) {
2093
0
            $left = $1;
2094
0
            $operator = $2;
2095
0
            $right = $3;
2096        } else {
2097
0
            $left = $string;
2098        }
2099# warn "handling leaf... left:$left operator:$operator right:$right"
2100# if $DEBUG;
2101
0
        unless ($operator) {
2102
0
            if ($string =~ /(.*)(>|<|=)(.*)/) {
2103
0
                $left = $1;
2104
0
                $operator = $2;
2105
0
                $right = $3;
2106
0
                warn
2107    "handling unless (operator)... left:$left operator:$operator right:$right"
2108                if $DEBUG;
2109            } else {
2110
0
                $left = $string;
2111            }
2112        }
2113
0
        my $results;
2114
2115# strip adv, zebra keywords, currently not handled in nozebra: wrdl, ext, phr...
2116
0
        $left =~ s/ .*$//;
2117
2118        # automatic replace for short operators
2119
0
        $left = 'title' if $left =~ '^ti$';
2120
0
        $left = 'author' if $left =~ '^au$';
2121
0
        $left = 'publisher' if $left =~ '^pb$';
2122
0
        $left = 'subject' if $left =~ '^su$';
2123
0
        $left = 'koha-Auth-Number' if $left =~ '^an$';
2124
0
        $left = 'keyword' if $left =~ '^kw$';
2125
0
        $left = 'itemtype' if $left =~ '^mc$'; # Fix for Bug 2599 - Search limits not working for NoZebra
2126
0
        warn "handling leaf... left:$left operator:$operator right:$right" if $DEBUG;
2127
0
        my $dbh = C4::Context->dbh;
2128
0
        if ( $operator && $left ne 'keyword' ) {
2129            #do a specific search
2130
0
            $operator = 'LIKE' if $operator eq '=' and $right =~ /%/;
2131
0
            my $sth = $dbh->prepare(
2132"SELECT biblionumbers,value FROM nozebra WHERE server=? AND indexname=? AND value $operator ?"
2133            );
2134
0
            warn "$left / $operator / $right\n" if $DEBUG;
2135
2136            # split each word, query the DB and build the biblionumbers result
2137            #sanitizing leftpart
2138
0
            $left =~ s/^\s+|\s+$//;
2139
0
            foreach ( split / /, $right ) {
2140
0
                my $biblionumbers;
2141
0
                $_ =~ s/^\s+|\s+$//;
2142
0
                next unless $_;
2143
0
                warn "EXECUTE : $server, $left, $_" if $DEBUG;
2144
0
                $sth->execute( $server, $left, $_ )
2145                  or warn "execute failed: $!";
2146
0
                while ( my ( $line, $value ) = $sth->fetchrow ) {
2147
2148# if we are dealing with a numeric value, use only numeric results (in case of >=, <=, > or <)
2149# otherwise, fill the result
2150
0
                    $biblionumbers .= $line
2151                      unless ( $right =~ /^\d+$/ && $value =~ /\D/ );
2152
0
                    warn "result : $value "
2153                      . ( $right =~ /\d/ ) . "=="
2154                      . ( $value =~ /\D/?$line:"" ) if $DEBUG; #= $line";
2155                }
2156
2157# do a AND with existing list if there is one, otherwise, use the biblionumbers list as 1st result list
2158
0
                if ($results) {
2159
0
                    warn "NZAND" if $DEBUG;
2160
0
                    $results = NZoperatorAND($biblionumbers,$results);
2161                } else {
2162
0
                    $results = $biblionumbers;
2163                }
2164            }
2165        }
2166        else {
2167      #do a complete search (all indexes), if index='kw' do complete search too.
2168
0
            my $sth = $dbh->prepare(
2169"SELECT biblionumbers FROM nozebra WHERE server=? AND value LIKE ?"
2170            );
2171
2172            # split each word, query the DB and build the biblionumbers result
2173
0
            foreach ( split / /, $string ) {
2174
0
                next if C4::Context->stopwords->{ uc($_) }; # skip if stopword
2175
0
                warn "search on all indexes on $_" if $DEBUG;
2176
0
                my $biblionumbers;
2177
0
                next unless $_;
2178
0
                $sth->execute( $server, $_ );
2179
0
                while ( my $line = $sth->fetchrow ) {
2180
0
                    $biblionumbers .= $line;
2181                }
2182
2183# do a AND with existing list if there is one, otherwise, use the biblionumbers list as 1st result list
2184
0
                if ($results) {
2185
0
                    $results = NZoperatorAND($biblionumbers,$results);
2186                }
2187                else {
2188
0
                    warn "NEW RES for $_ = $biblionumbers" if $DEBUG;
2189
0
                    $results = $biblionumbers;
2190                }
2191            }
2192        }
2193
0
        warn "return : $results for LEAF : $string" if $DEBUG;
2194
0
        return $results;
2195    }
2196
0
    warn "---------\nLeave NZanalyse\n---------" if $DEBUG;
2197}
2198
2199sub NZoperatorAND{
2200
0
    my ($rightresult, $leftresult)=@_;
2201
2202
0
    my @leftresult = split /;/, $leftresult;
2203
0
    warn " @leftresult / $rightresult \n" if $DEBUG;
2204
2205    # my @rightresult = split /;/,$leftresult;
2206
0
    my $finalresult;
2207
2208# parse the left results, and if the biblionumber exist in the right result, save it in finalresult
2209# the result is stored twice, to have the same weight for AND than OR.
2210# example : TWO : 61,61,64,121 (two is twice in the biblio #61) / TOWER : 61,64,130
2211# result : 61,61,61,61,64,64 for two AND tower : 61 has more weight than 64
2212
0
    foreach (@leftresult) {
2213
0
        my $value = $_;
2214
0
        my $countvalue;
2215
0
        ( $value, $countvalue ) = ( $1, $2 ) if ($value=~/(.*)-(\d+)$/);
2216
0
        if ( $rightresult =~ /\Q$value\E-(\d+);/ ) {
2217
0
            $countvalue = ( $1 > $countvalue ? $countvalue : $1 );
2218
0
            $finalresult .=
2219                "$value-$countvalue;$value-$countvalue;";
2220        }
2221    }
2222
0
    warn "NZAND DONE : $finalresult \n" if $DEBUG;
2223
0
    return $finalresult;
2224}
2225
2226sub NZoperatorOR{
2227
0
    my ($rightresult, $leftresult)=@_;
2228
0
    return $rightresult.$leftresult;
2229}
2230
2231sub NZoperatorNOT{
2232
0
    my ($leftresult, $rightresult)=@_;
2233
2234
0
    my @leftresult = split /;/, $leftresult;
2235
2236    # my @rightresult = split /;/,$leftresult;
2237
0
    my $finalresult;
2238
0
    foreach (@leftresult) {
2239
0
        my $value=$_;
2240
0
        $value=$1 if $value=~m/(.*)-\d+$/;
2241
0
        unless ($rightresult =~ "$value-") {
2242
0
            $finalresult .= "$_;";
2243        }
2244    }
2245
0
    return $finalresult;
2246}
2247
2248 - 2254
=head2 NZorder

  $finalresult = NZorder($biblionumbers, $ordering,$results_per_page,$offset);

  TODO :: Description

=cut
2255
2256sub NZorder {
2257
0
    my ( $biblionumbers, $ordering, $results_per_page, $offset ) = @_;
2258
0
    warn "biblionumbers = $biblionumbers and ordering = $ordering\n" if $DEBUG;
2259
2260    # order title asc by default
2261    # $ordering = '1=36 <i' unless $ordering;
2262
0
    $results_per_page = 20 unless $results_per_page;
2263
0
    $offset = 0 unless $offset;
2264
0
    my $dbh = C4::Context->dbh;
2265
2266    #
2267    # order by POPULARITY
2268    #
2269
0
    if ( $ordering =~ /popularity/ ) {
2270
0
        my %result;
2271
0
        my %popularity;
2272
2273        # popularity is not in MARC record, it's builded from a specific query
2274
0
        my $sth =
2275          $dbh->prepare("select sum(issues) from items where biblionumber=?");
2276
0
        foreach ( split /;/, $biblionumbers ) {
2277
0
            my ( $biblionumber, $title ) = split /,/, $_;
2278
0
            $result{$biblionumber} = GetMarcBiblio($biblionumber);
2279
0
            $sth->execute($biblionumber);
2280
0
            my $popularity = $sth->fetchrow || 0;
2281
2282# hint : the key is popularity.title because we can have
2283# many results with the same popularity. In this case, sub-ordering is done by title
2284# we also have biblionumber to avoid bug for 2 biblios with the same title & popularity
2285# (un-frequent, I agree, but we won't forget anything that way ;-)
2286
0
            $popularity{ sprintf( "%10d", $popularity ) . $title
2287                  . $biblionumber } = $biblionumber;
2288        }
2289
2290    # sort the hash and return the same structure as GetRecords (Zebra querying)
2291
0
        my $result_hash;
2292
0
        my $numbers = 0;
2293
0
        if ( $ordering eq 'popularity_dsc' ) { # sort popularity DESC
2294
0
0
            foreach my $key ( sort { $b cmp $a } ( keys %popularity ) ) {
2295
0
                $result_hash->{'RECORDS'}[ $numbers++ ] =
2296                  $result{ $popularity{$key} }->as_usmarc();
2297            }
2298        }
2299        else { # sort popularity ASC
2300
0
            foreach my $key ( sort ( keys %popularity ) ) {
2301
0
                $result_hash->{'RECORDS'}[ $numbers++ ] =
2302                  $result{ $popularity{$key} }->as_usmarc();
2303            }
2304        }
2305
0
        my $finalresult = ();
2306
0
        $result_hash->{'hits'} = $numbers;
2307
0
        $finalresult->{'biblioserver'} = $result_hash;
2308
0
        return $finalresult;
2309
2310        #
2311        # ORDER BY author
2312        #
2313    }
2314    elsif ( $ordering =~ /author/ ) {
2315
0
        my %result;
2316
0
        foreach ( split /;/, $biblionumbers ) {
2317
0
            my ( $biblionumber, $title ) = split /,/, $_;
2318
0
            my $record = GetMarcBiblio($biblionumber);
2319
0
            my $author;
2320
0
            if ( C4::Context->preference('marcflavour') eq 'UNIMARC' ) {
2321
0
                $author = $record->subfield( '200', 'f' );
2322
0
                $author = $record->subfield( '700', 'a' ) unless $author;
2323            }
2324            else {
2325
0
                $author = $record->subfield( '100', 'a' );
2326            }
2327
2328# hint : the result is sorted by title.biblionumber because we can have X biblios with the same title
2329# and we don't want to get only 1 result for each of them !!!
2330
0
            $result{ $author . $biblionumber } = $record;
2331        }
2332
2333    # sort the hash and return the same structure as GetRecords (Zebra querying)
2334
0
        my $result_hash;
2335
0
        my $numbers = 0;
2336
0
        if ( $ordering eq 'author_za' || $ordering eq 'author_dsc' ) { # sort by author desc
2337
0
0
            foreach my $key ( sort { $b cmp $a } ( keys %result ) ) {
2338
0
                $result_hash->{'RECORDS'}[ $numbers++ ] =
2339                  $result{$key}->as_usmarc();
2340            }
2341        }
2342        else { # sort by author ASC
2343
0
            foreach my $key ( sort ( keys %result ) ) {
2344
0
                $result_hash->{'RECORDS'}[ $numbers++ ] =
2345                  $result{$key}->as_usmarc();
2346            }
2347        }
2348
0
        my $finalresult = ();
2349
0
        $result_hash->{'hits'} = $numbers;
2350
0
        $finalresult->{'biblioserver'} = $result_hash;
2351
0
        return $finalresult;
2352
2353        #
2354        # ORDER BY callnumber
2355        #
2356    }
2357    elsif ( $ordering =~ /callnumber/ ) {
2358
0
        my %result;
2359
0
        foreach ( split /;/, $biblionumbers ) {
2360
0
            my ( $biblionumber, $title ) = split /,/, $_;
2361
0
            my $record = GetMarcBiblio($biblionumber);
2362
0
            my $callnumber;
2363
0
            my $frameworkcode = GetFrameworkCode($biblionumber);
2364
0
            my ( $callnumber_tag, $callnumber_subfield ) = GetMarcFromKohaField( 'items.itemcallnumber', $frameworkcode);
2365
0
               ( $callnumber_tag, $callnumber_subfield ) = GetMarcFromKohaField('biblioitems.callnumber', $frameworkcode)
2366                unless $callnumber_tag;
2367
0
            if ( C4::Context->preference('marcflavour') eq 'UNIMARC' ) {
2368
0
                $callnumber = $record->subfield( '200', 'f' );
2369            } else {
2370
0
                $callnumber = $record->subfield( '100', 'a' );
2371            }
2372
2373# hint : the result is sorted by title.biblionumber because we can have X biblios with the same title
2374# and we don't want to get only 1 result for each of them !!!
2375
0
            $result{ $callnumber . $biblionumber } = $record;
2376        }
2377
2378    # sort the hash and return the same structure as GetRecords (Zebra querying)
2379
0
        my $result_hash;
2380
0
        my $numbers = 0;
2381
0
        if ( $ordering eq 'call_number_dsc' ) { # sort by title desc
2382
0
0
            foreach my $key ( sort { $b cmp $a } ( keys %result ) ) {
2383
0
                $result_hash->{'RECORDS'}[ $numbers++ ] =
2384                  $result{$key}->as_usmarc();
2385            }
2386        }
2387        else { # sort by title ASC
2388
0
0
            foreach my $key ( sort { $a cmp $b } ( keys %result ) ) {
2389
0
                $result_hash->{'RECORDS'}[ $numbers++ ] =
2390                  $result{$key}->as_usmarc();
2391            }
2392        }
2393
0
        my $finalresult = ();
2394
0
        $result_hash->{'hits'} = $numbers;
2395
0
        $finalresult->{'biblioserver'} = $result_hash;
2396
0
        return $finalresult;
2397    }
2398    elsif ( $ordering =~ /pubdate/ ) { #pub year
2399
0
        my %result;
2400
0
        foreach ( split /;/, $biblionumbers ) {
2401
0
            my ( $biblionumber, $title ) = split /,/, $_;
2402
0
            my $record = GetMarcBiblio($biblionumber);
2403
0
            my ( $publicationyear_tag, $publicationyear_subfield ) =
2404              GetMarcFromKohaField( 'biblioitems.publicationyear', '' );
2405
0
            my $publicationyear =
2406              $record->subfield( $publicationyear_tag,
2407                $publicationyear_subfield );
2408
2409# hint : the result is sorted by title.biblionumber because we can have X biblios with the same title
2410# and we don't want to get only 1 result for each of them !!!
2411
0
            $result{ $publicationyear . $biblionumber } = $record;
2412        }
2413
2414    # sort the hash and return the same structure as GetRecords (Zebra querying)
2415
0
        my $result_hash;
2416
0
        my $numbers = 0;
2417
0
        if ( $ordering eq 'pubdate_dsc' ) { # sort by pubyear desc
2418
0
0
            foreach my $key ( sort { $b cmp $a } ( keys %result ) ) {
2419
0
                $result_hash->{'RECORDS'}[ $numbers++ ] =
2420                  $result{$key}->as_usmarc();
2421            }
2422        }
2423        else { # sort by pub year ASC
2424
0
            foreach my $key ( sort ( keys %result ) ) {
2425
0
                $result_hash->{'RECORDS'}[ $numbers++ ] =
2426                  $result{$key}->as_usmarc();
2427            }
2428        }
2429
0
        my $finalresult = ();
2430
0
        $result_hash->{'hits'} = $numbers;
2431
0
        $finalresult->{'biblioserver'} = $result_hash;
2432
0
        return $finalresult;
2433
2434        #
2435        # ORDER BY title
2436        #
2437    }
2438    elsif ( $ordering =~ /title/ ) {
2439
2440# the title is in the biblionumbers string, so we just need to build a hash, sort it and return
2441
0
        my %result;
2442
0
        foreach ( split /;/, $biblionumbers ) {
2443
0
            my ( $biblionumber, $title ) = split /,/, $_;
2444
2445# hint : the result is sorted by title.biblionumber because we can have X biblios with the same title
2446# and we don't want to get only 1 result for each of them !!!
2447# hint & speed improvement : we can order without reading the record
2448# so order, and read records only for the requested page !
2449
0
            $result{ $title . $biblionumber } = $biblionumber;
2450        }
2451
2452    # sort the hash and return the same structure as GetRecords (Zebra querying)
2453
0
        my $result_hash;
2454
0
        my $numbers = 0;
2455
0
        if ( $ordering eq 'title_az' ) { # sort by title desc
2456
0
            foreach my $key ( sort ( keys %result ) ) {
2457
0
                $result_hash->{'RECORDS'}[ $numbers++ ] = $result{$key};
2458            }
2459        }
2460        else { # sort by title ASC
2461
0
0
            foreach my $key ( sort { $b cmp $a } ( keys %result ) ) {
2462
0
                $result_hash->{'RECORDS'}[ $numbers++ ] = $result{$key};
2463            }
2464        }
2465
2466        # limit the $results_per_page to result size if it's more
2467
0
        $results_per_page = $numbers - 1 if $numbers < $results_per_page;
2468
2469        # for the requested page, replace biblionumber by the complete record
2470        # speed improvement : avoid reading too much things
2471        for (
2472            my $counter = $offset ;
2473            $counter <= $offset + $results_per_page ;
2474            $counter++
2475          )
2476        {
2477
0
            $result_hash->{'RECORDS'}[$counter] =
2478              GetMarcBiblio( $result_hash->{'RECORDS'}[$counter] )->as_usmarc;
2479
0
        }
2480
0
        my $finalresult = ();
2481
0
        $result_hash->{'hits'} = $numbers;
2482
0
        $finalresult->{'biblioserver'} = $result_hash;
2483
0
        return $finalresult;
2484    }
2485    else {
2486
2487#
2488# order by ranking
2489#
2490# we need 2 hashes to order by ranking : the 1st one to count the ranking, the 2nd to order by ranking
2491
0
        my %result;
2492
0
        my %count_ranking;
2493
0
        foreach ( split /;/, $biblionumbers ) {
2494
0
            my ( $biblionumber, $title ) = split /,/, $_;
2495
0
            $title =~ /(.*)-(\d)/;
2496
2497            # get weight
2498
0
            my $ranking = $2;
2499
2500# note that we + the ranking because ranking is calculated on weight of EACH term requested.
2501# if we ask for "two towers", and "two" has weight 2 in biblio N, and "towers" has weight 4 in biblio N
2502# biblio N has ranking = 6
2503
0
            $count_ranking{$biblionumber} += $ranking;
2504        }
2505
2506# build the result by "inverting" the count_ranking hash
2507# hing : as usual, we don't order by ranking only, to avoid having only 1 result for each rank. We build an hash on concat(ranking,biblionumber) instead
2508# warn "counting";
2509
0
        foreach ( keys %count_ranking ) {
2510
0
            $result{ sprintf( "%10d", $count_ranking{$_} ) . '-' . $_ } = $_;
2511        }
2512
2513    # sort the hash and return the same structure as GetRecords (Zebra querying)
2514
0
        my $result_hash;
2515
0
        my $numbers = 0;
2516
0
0
        foreach my $key ( sort { $b cmp $a } ( keys %result ) ) {
2517
0
            $result_hash->{'RECORDS'}[ $numbers++ ] = $result{$key};
2518        }
2519
2520        # limit the $results_per_page to result size if it's more
2521
0
        $results_per_page = $numbers - 1 if $numbers < $results_per_page;
2522
2523        # for the requested page, replace biblionumber by the complete record
2524        # speed improvement : avoid reading too much things
2525        for (
2526            my $counter = $offset ;
2527            $counter <= $offset + $results_per_page ;
2528            $counter++
2529          )
2530        {
2531
0
            $result_hash->{'RECORDS'}[$counter] =
2532              GetMarcBiblio( $result_hash->{'RECORDS'}[$counter] )->as_usmarc
2533              if $result_hash->{'RECORDS'}[$counter];
2534
0
        }
2535
0
        my $finalresult = ();
2536
0
        $result_hash->{'hits'} = $numbers;
2537
0
        $finalresult->{'biblioserver'} = $result_hash;
2538
0
        return $finalresult;
2539    }
2540}
2541
2542 - 2564
=head2 enabled_staff_search_views

%hash = enabled_staff_search_views()

This function returns a hash that contains three flags obtained from the system
preferences, used to determine whether a particular staff search results view
is enabled.

=over 2

=item C<Output arg:>

    * $hash{can_view_MARC} is true only if the MARC view is enabled
    * $hash{can_view_ISBD} is true only if the ISBD view is enabled
    * $hash{can_view_labeledMARC} is true only if the Labeled MARC view is enabled

=item C<usage in the script:>

=back

$template->param ( C4::Search::enabled_staff_search_views );

=cut
2565
2566sub enabled_staff_search_views
2567{
2568        return (
2569
0
                can_view_MARC => C4::Context->preference('viewMARC'), # 1 if the staff search allows the MARC view
2570                can_view_ISBD => C4::Context->preference('viewISBD'), # 1 if the staff search allows the ISBD view
2571                can_view_labeledMARC => C4::Context->preference('viewLabeledMARC'), # 1 if the staff search allows the Labeled MARC view
2572        );
2573}
2574
2575sub AddSearchHistory{
2576
0
        my ($borrowernumber,$session,$query_desc,$query_cgi, $total)=@_;
2577
0
    my $dbh = C4::Context->dbh;
2578
2579    # Add the request the user just made
2580
0
    my $sql = "INSERT INTO search_history(userid, sessionid, query_desc, query_cgi, total, time) VALUES(?, ?, ?, ?, ?, NOW())";
2581
0
    my $sth = $dbh->prepare($sql);
2582
0
    $sth->execute($borrowernumber, $session, $query_desc, $query_cgi, $total);
2583
0
        return $dbh->last_insert_id(undef, 'search_history', undef,undef,undef);
2584}
2585
2586sub GetSearchHistory{
2587
0
        my ($borrowernumber,$session)=@_;
2588
0
    my $dbh = C4::Context->dbh;
2589
2590    # Add the request the user just made
2591
0
    my $query = "SELECT FROM search_history WHERE (userid=? OR sessionid=?)";
2592
0
    my $sth = $dbh->prepare($query);
2593
0
        $sth->execute($borrowernumber, $session);
2594
0
    return $sth->fetchall_hashref({});
2595}
2596
2597 - 2638
=head2 z3950_search_args

$arrayref = z3950_search_args($matchpoints)

This function returns an array reference that contains the search parameters to be
passed to the Z39.50 search script (z3950_search.pl). The array elements
are hash refs whose keys are name, value and encvalue, and whose values are the
name of a search parameter, the value of that search parameter and the URL encoded
value of that parameter.

The search parameter names are lccn, isbn, issn, title, author, dewey and subject.

The search parameter values are obtained from the bibliographic record whose
data is in a hash reference in $matchpoints, as returned by Biblio::GetBiblioData().

If $matchpoints is a scalar, it is assumed to be an unnamed query descriptor, e.g.
a general purpose search argument. In this case, the returned array contains only
entry: the key is 'title' and the value and encvalue are derived from $matchpoints.

If a search parameter value is undefined or empty, it is not included in the returned
array.

The returned array reference may be passed directly to the template parameters.

=over 2

=item C<Output arg:>

    * $array containing hash refs as described above

=item C<usage in the script:>

=back

$data = Biblio::GetBiblioData($bibno);
$template->param ( MYLOOP => C4::Search::z3950_search_args($data) )

*OR*

$template->param ( MYLOOP => C4::Search::z3950_search_args($searchscalar) )

=cut
2639
2640sub z3950_search_args {
2641
0
    my $bibrec = shift;
2642
0
    my $isbn = Business::ISBN->new($bibrec);
2643
2644
0
    if (defined $isbn && $isbn->is_valid)
2645    {
2646
0
        $bibrec = { isbn => $bibrec } if !ref $bibrec;
2647    }
2648    else {
2649
0
        $bibrec = { title => $bibrec } if !ref $bibrec;
2650    }
2651
0
    my $array = [];
2652
0
    for my $field (qw/ lccn isbn issn title author dewey subject /)
2653    {
2654
0
        my $encvalue = URI::Escape::uri_escape_utf8($bibrec->{$field});
2655
0
        push @$array, { name=>$field, value=>$bibrec->{$field}, encvalue=>$encvalue } if defined $bibrec->{$field};
2656    }
2657
0
    return $array;
2658}
2659
2660 - 2687
=head2 BiblioAddAuthorities

( $countlinked, $countcreated ) = BiblioAddAuthorities($record, $frameworkcode);

this function finds the authorities linked to the biblio
    * search in the authority DB for the same authid (in $9 of the biblio)
    * search in the authority DB for the same 001 (in $3 of the biblio in UNIMARC)
    * search in the authority DB for the same values (exactly) (in all subfields of the biblio)
OR adds a new authority record

=over 2

=item C<input arg:>

    * $record is the MARC record in question (marc blob)
    * $frameworkcode is the bibliographic framework to use (if it is "" it uses the default framework)

=item C<Output arg:>

    * $countlinked is the number of authorities records that are linked to this authority
    * $countcreated

=item C<BUGS>
    * I had to add this to Search.pm (instead of the logical Biblio.pm) because of a circular dependency (this sub uses SimpleSearch, and Search.pm uses Biblio.pm)

=back

=cut
2688
2689
2690sub BiblioAddAuthorities{
2691
0
  my ( $record, $frameworkcode ) = @_;
2692
0
  my $dbh=C4::Context->dbh;
2693
0
  my $query=$dbh->prepare(qq|
2694SELECT authtypecode,tagfield
2695FROM marc_subfield_structure
2696WHERE frameworkcode=?
2697AND (authtypecode IS NOT NULL AND authtypecode<>\"\")|);
2698# SELECT authtypecode,tagfield
2699# FROM marc_subfield_structure
2700# WHERE frameworkcode=?
2701# AND (authtypecode IS NOT NULL OR authtypecode<>\"\")|);
2702
0
  $query->execute($frameworkcode);
2703
0
  my ($countcreated,$countlinked);
2704
0
  while (my $data=$query->fetchrow_hashref){
2705
0
    foreach my $field ($record->field($data->{tagfield})){
2706
0
      next if ($field->subfield('3')||$field->subfield('9'));
2707      # No authorities id in the tag.
2708      # Search if there is any authorities to link to.
2709
0
      my $query='at='.$data->{authtypecode}.' ';
2710
0
0
      map {$query.= ' and he,ext="'.$_->[1].'"' if ($_->[0]=~/[A-z]/)} $field->subfields();
2711
0
      my ($error, $results, $total_hits)=SimpleSearch( $query, undef, undef, [ "authorityserver" ] );
2712    # there is only 1 result
2713
0
          if ( $error ) {
2714
0
        warn "BIBLIOADDSAUTHORITIES: $error";
2715
0
            return (0,0) ;
2716          }
2717
0
0
0
      if ( @{$results} == 1 ) {
2718
0
        my $marcrecord = MARC::File::USMARC::decode($results->[0]);
2719
0
        $field->add_subfields('9'=>$marcrecord->field('001')->data);
2720
0
        $countlinked++;
2721      } elsif ( @{$results} > 1 ) {
2722   #More than One result
2723   #This can comes out of a lack of a subfield.
2724# my $marcrecord = MARC::File::USMARC::decode($results->[0]);
2725# $record->field($data->{tagfield})->add_subfields('9'=>$marcrecord->field('001')->data);
2726
0
  $countlinked++;
2727      } else {
2728  #There are no results, build authority record, add it to Authorities, get authid and add it to 9
2729  ###NOTICE : This is only valid if a subfield is linked to one and only one authtypecode
2730  ###NOTICE : This can be a problem. We should also look into other types and rejected forms.
2731
0
         my $authtypedata=C4::AuthoritiesMarc::GetAuthType($data->{authtypecode});
2732
0
         next unless $authtypedata;
2733
0
         my $marcrecordauth=MARC::Record->new();
2734
0
         my $authfield=MARC::Field->new($authtypedata->{auth_tag_to_report},'','',"a"=>"".$field->subfield('a'));
2735
0
0
         map { $authfield->add_subfields($_->[0]=>$_->[1]) if ($_->[0]=~/[A-z]/ && $_->[0] ne "a" )} $field->subfields();
2736
0
         $marcrecordauth->insert_fields_ordered($authfield);
2737
2738         # bug 2317: ensure new authority knows it's using UTF-8; currently
2739         # only need to do this for MARC21, as MARC::Record->as_xml_record() handles
2740         # automatically for UNIMARC (by not transcoding)
2741         # FIXME: AddAuthority() instead should simply explicitly require that the MARC::Record
2742         # use UTF-8, but as of 2008-08-05, did not want to introduce that kind
2743         # of change to a core API just before the 3.0 release.
2744
0
         if (C4::Context->preference('marcflavour') eq 'MARC21') {
2745
0
            SetMarcUnicodeFlag($marcrecordauth, 'MARC21');
2746         }
2747
2748# warn "AUTH RECORD ADDED : ".$marcrecordauth->as_formatted;
2749
2750
0
         my $authid=AddAuthority($marcrecordauth,'',$data->{authtypecode});
2751
0
         $countcreated++;
2752
0
         $field->add_subfields('9'=>$authid);
2753      }
2754    }
2755  }
2756
0
  return ($countlinked,$countcreated);
2757}
2758
2759 - 2763
=head2 GetDistinctValues($field);

C<$field> is a reference to the fields array

=cut
2764
2765sub GetDistinctValues {
2766
0
    my ($fieldname,$string)=@_;
2767    # returns a reference to a hash of references to branches...
2768
0
    if ($fieldname=~/\./){
2769
0
                        my ($table,$column)=split /\./, $fieldname;
2770
0
                        my $dbh = C4::Context->dbh;
2771
0
                        warn "select DISTINCT($column) as value, count(*) as cnt from $table group by lib order by $column " if $DEBUG;
2772
0
                        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 ");
2773
0
                        $sth->execute;
2774
0
                        my $elements=$sth->fetchall_arrayref({});
2775
0
                        return $elements;
2776   }
2777   else {
2778
0
                $string||= qq("");
2779
0
                my @servers=qw<biblioserver authorityserver>;
2780
0
                my (@zconns,@results);
2781        for ( my $i = 0 ; $i < @servers ; $i++ ) {
2782
0
         $zconns[$i] = C4::Context->Zconn( $servers[$i], 1 );
2783
0
                        $results[$i] =
2784                      $zconns[$i]->scan(
2785                        ZOOM::Query::CCL2RPN->new( qq"$fieldname $string", $zconns[$i])
2786                      );
2787
0
                }
2788                # The big moment: asynchronously retrieve results from all servers
2789
0
                my @elements;
2790
0
                while ( ( my $i = ZOOM::event( \@zconns ) ) != 0 ) {
2791
0
                        my $ev = $zconns[ $i - 1 ]->last_event();
2792
0
                        if ( $ev == ZOOM::Event::ZEND ) {
2793
0
                                next unless $results[ $i - 1 ];
2794
0
                                my $size = $results[ $i - 1 ]->size();
2795
0
                                if ( $size > 0 ) {
2796                      for (my $j=0;$j<$size;$j++){
2797
0
                                                my %hashscan;
2798
0
                                                @hashscan{qw(value cnt)}=$results[ $i - 1 ]->display_term($j);
2799
0
                                                push @elements, \%hashscan;
2800
0
                                          }
2801                                }
2802                        }
2803                }
2804
0
                return \@elements;
2805   }
2806}
2807
2808
2809
8
1995987
END { } # module clean-up code here (global destructor)
2810
28111;