3 # This file is part of Koha.
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
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.
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
19 #use warnings; FIXME - Bug 2505
22 use C4::Biblio; # GetMarcFromKohaField, GetBiblioData
23 use C4::Koha; # getFacets
25 use C4::Search::PazPar2;
27 use C4::Dates qw(format_date);
28 use C4::Members qw(GetHideLostItemsPreference);
31 use C4::Reserves; # CheckReserves
37 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $DEBUG);
39 # set the version for version checking
42 $DEBUG = ($ENV{DEBUG}) ? 1 : 0;
47 C4::Search - Functions for searching the Koha catalog.
51 See opac/opac-search.pl or catalogue/search.pl for example of usage
55 This module provides searching functions for Koha's bibliographic databases
73 #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)
75 # make all your functions, whether exported or not;
79 ($biblionumber,$biblionumber,$title) = FindDuplicate($record);
81 This function attempts to find duplicate records using a hard-coded, fairly simplistic algorithm
87 my $dbh = C4::Context->dbh;
88 my $result = TransformMarcToKoha( $dbh, $record, '' );
93 my ( $biblionumber, $title );
95 # search duplicate on ISBN, easy and fast..
97 if ( $result->{isbn} ) {
98 $result->{isbn} =~ s/\(.*$//;
99 $result->{isbn} =~ s/\s+$//;
100 $query = "isbn=$result->{isbn}";
103 $result->{title} =~ s /\\//g;
104 $result->{title} =~ s /\"//g;
105 $result->{title} =~ s /\(//g;
106 $result->{title} =~ s /\)//g;
108 # FIXME: instead of removing operators, could just do
109 # quotes around the value
110 $result->{title} =~ s/(and|or|not)//g;
111 $query = "ti,ext=$result->{title}";
112 $query .= " and itemtype=$result->{itemtype}"
113 if ( $result->{itemtype} );
114 if ( $result->{author} ) {
115 $result->{author} =~ s /\\//g;
116 $result->{author} =~ s /\"//g;
117 $result->{author} =~ s /\(//g;
118 $result->{author} =~ s /\)//g;
120 # remove valid operators
121 $result->{author} =~ s/(and|or|not)//g;
122 $query .= " and au,ext=$result->{author}";
126 my ( $error, $searchresults, undef ) = SimpleSearch($query); # FIXME :: hardcoded !
128 if (!defined $error) {
129 foreach my $possible_duplicate_record (@{$searchresults}) {
131 MARC::Record->new_from_usmarc($possible_duplicate_record);
132 my $result = TransformMarcToKoha( $dbh, $marcrecord, '' );
134 # FIXME :: why 2 $biblionumber ?
136 push @results, $result->{'biblionumber'};
137 push @results, $result->{'title'};
146 ( $error, $results, $total_hits ) = SimpleSearch( $query, $offset, $max_results, [@servers] );
148 This function provides a simple search API on the bibliographic catalog
154 * $query can be a simple keyword or a complete CCL query
155 * @servers is optional. Defaults to biblioserver as found in koha-conf.xml
156 * $offset - If present, represents the number of records at the beggining to omit. Defaults to 0
157 * $max_results - if present, determines the maximum number of records to fetch. undef is All. defaults to undef.
162 Returns an array consisting of three elements
163 * $error is undefined unless an error is detected
164 * $results is a reference to an array of records.
165 * $total_hits is the number of hits that would have been returned with no limit
167 If an error is returned the two other return elements are undefined. If error itself is undefined
168 the other two elements are always defined
170 =item C<usage in the script:>
174 my ( $error, $marcresults, $total_hits ) = SimpleSearch($query);
176 if (defined $error) {
177 $template->param(query_error => $error);
178 warn "error: ".$error;
179 output_html_with_http_headers $input, $cookie, $template->output;
183 my $hits = @{$marcresults};
186 for my $r ( @{$marcresults} ) {
187 my $marcrecord = MARC::File::USMARC::decode($r);
188 my $biblio = TransformMarcToKoha(C4::Context->dbh,$marcrecord,q{});
190 #build the iarray of hashs for the template.
192 title => $biblio->{'title'},
193 subtitle => $biblio->{'subtitle'},
194 biblionumber => $biblio->{'biblionumber'},
195 author => $biblio->{'author'},
196 publishercode => $biblio->{'publishercode'},
197 publicationyear => $biblio->{'publicationyear'},
202 $template->param(result=>\@results);
207 my ( $query, $offset, $max_results, $servers ) = @_;
209 if ( C4::Context->preference('NoZebra') ) {
210 my $result = NZorder( NZanalyse($query) )->{'biblioserver'};
213 && $result->{hits} > 0 ? $result->{'RECORDS'} : [] );
214 return ( undef, $search_result, scalar($result->{hits}) );
217 return ( 'No query entered', undef, undef ) unless $query;
218 # FIXME hardcoded value. See catalog/search.pl & opac-search.pl too.
219 my @servers = defined ( $servers ) ? @$servers : ( 'biblioserver' );
226 # Initialize & Search Zebra
227 for ( my $i = 0 ; $i < @servers ; $i++ ) {
229 $zconns[$i] = C4::Context->Zconn( $servers[$i], 1 );
230 $zoom_queries[$i] = new ZOOM::Query::CCL2RPN( $query, $zconns[$i]);
231 $tmpresults[$i] = $zconns[$i]->search( $zoom_queries[$i] );
235 $zconns[$i]->errmsg() . " ("
236 . $zconns[$i]->errcode() . ") "
237 . $zconns[$i]->addinfo() . " "
238 . $zconns[$i]->diagset();
240 return ( $error, undef, undef ) if $zconns[$i]->errcode();
244 # caught a ZOOM::Exception
248 . $@->addinfo() . " "
251 return ( $error, undef, undef );
254 while ( ( my $i = ZOOM::event( \@zconns ) ) != 0 ) {
255 my $event = $zconns[ $i - 1 ]->last_event();
256 if ( $event == ZOOM::Event::ZEND ) {
258 my $first_record = defined( $offset ) ? $offset+1 : 1;
259 my $hits = $tmpresults[ $i - 1 ]->size();
260 $total_hits += $hits;
261 my $last_record = $hits;
262 if ( defined $max_results && $offset + $max_results < $hits ) {
263 $last_record = $offset + $max_results;
266 for my $j ( $first_record..$last_record ) {
267 my $record = $tmpresults[ $i - 1 ]->record( $j-1 )->raw(); # 0 indexed
268 push @{$results}, $record;
273 foreach my $result (@tmpresults) {
276 foreach my $zoom_query (@zoom_queries) {
277 $zoom_query->destroy();
280 return ( undef, $results, $total_hits );
286 ( undef, $results_hashref, \@facets_loop ) = getRecords (
288 $koha_query, $simple_query, $sort_by_ref, $servers_ref,
289 $results_per_page, $offset, $expanded_facet, $branches,
293 The all singing, all dancing, multi-server, asynchronous, scanning,
294 searching, record nabbing, facet-building
296 See verbse embedded documentation.
302 $koha_query, $simple_query, $sort_by_ref, $servers_ref,
303 $results_per_page, $offset, $expanded_facet, $branches,
307 my @servers = @$servers_ref;
308 my @sort_by = @$sort_by_ref;
310 # Initialize variables for the ZOOM connection and results object
314 my $results_hashref = ();
316 # Initialize variables for the faceted results objects
317 my $facets_counter = ();
318 my $facets_info = ();
319 my $facets = getFacets();
320 my $facets_maxrecs = C4::Context->preference('maxRecordsForFacets')||20;
322 my @facets_loop; # stores the ref to array of hashes for template facets loop
324 ### LOOP THROUGH THE SERVERS
325 for ( my $i = 0 ; $i < @servers ; $i++ ) {
326 $zconns[$i] = C4::Context->Zconn( $servers[$i], 1 );
328 # perform the search, create the results objects
329 # if this is a local search, use the $koha-query, if it's a federated one, use the federated-query
330 my $query_to_use = ($servers[$i] =~ /biblioserver/) ? $koha_query : $simple_query;
332 #$query_to_use = $simple_query if $scan;
333 warn $simple_query if ( $scan and $DEBUG );
335 # Check if we've got a query_type defined, if so, use it
338 if ($query_type =~ /^ccl/) {
339 $query_to_use =~ s/\:/\=/g; # change : to = last minute (FIXME)
340 $results[$i] = $zconns[$i]->search(new ZOOM::Query::CCL2RPN($query_to_use, $zconns[$i]));
341 } elsif ($query_type =~ /^cql/) {
342 $results[$i] = $zconns[$i]->search(new ZOOM::Query::CQL($query_to_use, $zconns[$i]));
343 } elsif ($query_type =~ /^pqf/) {
344 $results[$i] = $zconns[$i]->search(new ZOOM::Query::PQF($query_to_use, $zconns[$i]));
346 warn "Unknown query_type '$query_type'. Results undetermined.";
349 $results[$i] = $zconns[$i]->scan( new ZOOM::Query::CCL2RPN($query_to_use, $zconns[$i]));
351 $results[$i] = $zconns[$i]->search(new ZOOM::Query::CCL2RPN($query_to_use, $zconns[$i]));
355 warn "WARNING: query problem with $query_to_use " . $@;
358 # Concatenate the sort_by limits and pass them to the results object
359 # Note: sort will override rank
361 foreach my $sort (@sort_by) {
362 if ( $sort eq "author_az" || $sort eq "author_asc" ) {
363 $sort_by .= "1=1003 <i ";
365 elsif ( $sort eq "author_za" || $sort eq "author_dsc" ) {
366 $sort_by .= "1=1003 >i ";
368 elsif ( $sort eq "popularity_asc" ) {
369 $sort_by .= "1=9003 <i ";
371 elsif ( $sort eq "popularity_dsc" ) {
372 $sort_by .= "1=9003 >i ";
374 elsif ( $sort eq "call_number_asc" ) {
375 $sort_by .= "1=8007 <i ";
377 elsif ( $sort eq "call_number_dsc" ) {
378 $sort_by .= "1=8007 >i ";
380 elsif ( $sort eq "pubdate_asc" ) {
381 $sort_by .= "1=31 <i ";
383 elsif ( $sort eq "pubdate_dsc" ) {
384 $sort_by .= "1=31 >i ";
386 elsif ( $sort eq "acqdate_asc" ) {
387 $sort_by .= "1=32 <i ";
389 elsif ( $sort eq "acqdate_dsc" ) {
390 $sort_by .= "1=32 >i ";
392 elsif ( $sort eq "title_az" || $sort eq "title_asc" ) {
393 $sort_by .= "1=4 <i ";
395 elsif ( $sort eq "title_za" || $sort eq "title_dsc" ) {
396 $sort_by .= "1=4 >i ";
399 warn "Ignoring unrecognized sort '$sort' requested" if $sort_by;
402 if ($sort_by && !$scan) {
403 if ( $results[$i]->sort( "yaz", $sort_by ) < 0 ) {
404 warn "WARNING sort $sort_by failed";
407 } # finished looping through servers
409 # The big moment: asynchronously retrieve results from all servers
410 while ( ( my $i = ZOOM::event( \@zconns ) ) != 0 ) {
411 my $ev = $zconns[ $i - 1 ]->last_event();
412 if ( $ev == ZOOM::Event::ZEND ) {
413 next unless $results[ $i - 1 ];
414 my $size = $results[ $i - 1 ]->size();
418 # loop through the results
419 $results_hash->{'hits'} = $size;
421 if ( $offset + $results_per_page <= $size ) {
422 $times = $offset + $results_per_page;
427 for ( my $j = $offset ; $j < $times ; $j++ ) {
431 ## Check if it's an index scan
433 my ( $term, $occ ) = $results[ $i - 1 ]->term($j);
435 # here we create a minimal MARC record and hand it off to the
436 # template just like a normal result ... perhaps not ideal, but
438 my $tmprecord = MARC::Record->new();
439 $tmprecord->encoding('UTF-8');
443 # the minimal record in author/title (depending on MARC flavour)
444 if (C4::Context->preference("marcflavour") eq "UNIMARC") {
445 $tmptitle = MARC::Field->new('200',' ',' ', a => $term, f => $occ);
446 $tmprecord->append_fields($tmptitle);
448 $tmptitle = MARC::Field->new('245',' ',' ', a => $term,);
449 $tmpauthor = MARC::Field->new('100',' ',' ', a => $occ,);
450 $tmprecord->append_fields($tmptitle);
451 $tmprecord->append_fields($tmpauthor);
453 $results_hash->{'RECORDS'}[$j] = $tmprecord->as_usmarc();
458 $record = $results[ $i - 1 ]->record($j)->raw();
460 # warn "RECORD $j:".$record;
461 $results_hash->{'RECORDS'}[$j] = $record;
465 $results_hashref->{ $servers[ $i - 1 ] } = $results_hash;
467 # Fill the facets while we're looping, but only for the biblioserver and not for a scan
468 if ( !$scan && $servers[ $i - 1 ] =~ /biblioserver/ ) {
470 my $jmax = $size>$facets_maxrecs? $facets_maxrecs: $size;
472 for ( my $k = 0 ; $k <= @$facets ; $k++ ) {
473 ($facets->[$k]) or next;
474 my @fcodes = @{$facets->[$k]->{'tags'}};
475 my $sfcode = $facets->[$k]->{'subfield'};
477 for ( my $j = 0 ; $j < $jmax ; $j++ ) {
478 my $render_record = $results[ $i - 1 ]->record($j)->render();
481 foreach my $fcode (@fcodes) {
484 my $field_pattern = '\n'.$fcode.' ([^\n]+)';
485 my @field_tokens = ( $render_record =~ /$field_pattern/g ) ;
487 foreach my $field_token (@field_tokens) {
488 my $subfield_pattern = '\$'.$sfcode.' ([^\$]+)';
489 my @subfield_values = ( $field_token =~ /$subfield_pattern/g );
491 foreach my $subfield_value (@subfield_values) {
493 my $data = $subfield_value;
494 $data =~ s/^\s+//; # trim left
495 $data =~ s/\s+$//; # trim right
497 unless ( $data ~~ @used_datas ) {
498 $facets_counter->{ $facets->[$k]->{'link_value'} }->{$data}++;
499 push @used_datas, $data;
506 $facets_info->{ $facets->[$k]->{'link_value'} }->{'label_value'} = $facets->[$k]->{'label_value'};
507 $facets_info->{ $facets->[$k]->{'link_value'} }->{'expanded'} = $facets->[$k]->{'expanded'};
513 # warn "connection ", $i-1, ": $size hits";
514 # warn $results[$i-1]->record(0)->render() if $size > 0;
517 if ( $servers[ $i - 1 ] =~ /biblioserver/ ) {
519 sort { $facets_counter->{$b} <=> $facets_counter->{$a} }
520 keys %$facets_counter )
523 my $number_of_facets;
524 my @this_facets_array;
527 $facets_counter->{$link_value}->{$b}
528 <=> $facets_counter->{$link_value}->{$a}
529 } keys %{ $facets_counter->{$link_value} }
533 if ( ( $number_of_facets < 6 )
534 || ( $expanded_facet eq $link_value )
535 || ( $facets_info->{$link_value}->{'expanded'} ) )
538 # Sanitize the link value ), ( will cause errors with CCL,
539 my $facet_link_value = $one_facet;
540 $facet_link_value =~ s/(\(|\))/ /g;
542 # fix the length that will display in the label,
543 my $facet_label_value = $one_facet;
544 my $facet_max_length =
545 C4::Context->preference('FacetLabelTruncationLength') || 20;
547 substr( $one_facet, 0, $facet_max_length ) . "..."
548 if length($facet_label_value) > $facet_max_length;
550 # if it's a branch, label by the name, not the code,
551 if ( $link_value =~ /branch/ ) {
552 if (defined $branches
553 && ref($branches) eq "HASH"
554 && defined $branches->{$one_facet}
555 && ref ($branches->{$one_facet}) eq "HASH")
558 $branches->{$one_facet}->{'branchname'};
561 $facet_label_value = "*";
565 # but we're down with the whole label being in the link's title.
566 push @this_facets_array, {
567 facet_count => $facets_counter->{$link_value}->{$one_facet},
568 facet_label_value => $facet_label_value,
569 facet_title_value => $one_facet,
570 facet_link_value => $facet_link_value,
571 type_link_value => $link_value,
576 # handle expanded option
577 unless ( $facets_info->{$link_value}->{'expanded'} ) {
579 if ( ( $number_of_facets > 6 )
580 && ( $expanded_facet ne $link_value ) );
583 type_link_value => $link_value,
584 type_id => $link_value . "_id",
585 "type_label_" . $facets_info->{$link_value}->{'label_value'} => 1,
586 facets => \@this_facets_array,
587 expandable => $expandable,
588 expand => $link_value,
589 } unless ( ($facets_info->{$link_value}->{'label_value'} =~ /Libraries/) and (C4::Context->preference('singleBranchMode')) );
594 return ( undef, $results_hashref, \@facets_loop );
599 $koha_query, $simple_query, $sort_by_ref, $servers_ref,
600 $results_per_page, $offset, $expanded_facet, $branches,
604 my $paz = C4::Search::PazPar2->new(C4::Context->config('pazpar2url'));
606 $paz->search($simple_query);
607 sleep 1; # FIXME: WHY?
610 my $results_hashref = {};
611 my $stats = XMLin($paz->stat);
612 my $results = XMLin($paz->show($offset, $results_per_page, 'work-title:1'), forcearray => 1);
614 # for a grouped search result, the number of hits
615 # is the number of groups returned; 'bib_hits' will have
616 # the total number of bibs.
617 $results_hashref->{'biblioserver'}->{'hits'} = $results->{'merged'}->[0];
618 $results_hashref->{'biblioserver'}->{'bib_hits'} = $stats->{'hits'};
620 HIT: foreach my $hit (@{ $results->{'hit'} }) {
621 my $recid = $hit->{recid}->[0];
623 my $work_title = $hit->{'md-work-title'}->[0];
625 if (exists $hit->{'md-work-author'}) {
626 $work_author = $hit->{'md-work-author'}->[0];
628 my $group_label = (defined $work_author) ? "$work_title / $work_author" : $work_title;
630 my $result_group = {};
631 $result_group->{'group_label'} = $group_label;
632 $result_group->{'group_merge_key'} = $recid;
635 if (exists $hit->{count}) {
636 $count = $hit->{count}->[0];
638 $result_group->{'group_count'} = $count;
640 for (my $i = 0; $i < $count; $i++) {
641 # FIXME -- may need to worry about diacritics here
642 my $rec = $paz->record($recid, $i);
643 push @{ $result_group->{'RECORDS'} }, $rec;
646 push @{ $results_hashref->{'biblioserver'}->{'GROUPS'} }, $result_group;
649 # pass through facets
650 my $termlist_xml = $paz->termlist('author,subject');
651 my $terms = XMLin($termlist_xml, forcearray => 1);
652 my @facets_loop = ();
653 #die Dumper($results);
654 # foreach my $list (sort keys %{ $terms->{'list'} }) {
656 # foreach my $facet (sort @{ $terms->{'list'}->{$list}->{'term'} } ) {
658 # facet_label_value => $facet->{'name'}->[0],
661 # push @facets_loop, ( {
662 # type_label => $list,
663 # facets => \@facets,
667 return ( undef, $results_hashref, \@facets_loop );
671 sub _remove_stopwords {
672 my ( $operand, $index ) = @_;
673 my @stopwords_removed;
675 # phrase and exact-qualified indexes shouldn't have stopwords removed
676 if ( $index !~ m/phr|ext/ ) {
678 # remove stopwords from operand : parse all stopwords & remove them (case insensitive)
679 # we use IsAlpha unicode definition, to deal correctly with diacritics.
680 # otherwise, a French word like "leçon" woudl be split into "le" "çon", "le"
681 # is a stopword, we'd get "çon" and wouldn't find anything...
683 foreach ( keys %{ C4::Context->stopwords } ) {
684 next if ( $_ =~ /(and|or|not)/ ); # don't remove operators
685 if ( my ($matched) = ($operand =~
686 /([^\X\p{isAlnum}]\Q$_\E[^\X\p{isAlnum}]|[^\X\p{isAlnum}]\Q$_\E$|^\Q$_\E[^\X\p{isAlnum}])/gi))
688 $operand =~ s/\Q$matched\E/ /gi;
689 push @stopwords_removed, $_;
693 return ( $operand, \@stopwords_removed );
697 sub _detect_truncation {
698 my ( $operand, $index ) = @_;
699 my ( @nontruncated, @righttruncated, @lefttruncated, @rightlefttruncated,
702 my @wordlist = split( /\s/, $operand );
703 foreach my $word (@wordlist) {
704 if ( $word =~ s/^\*([^\*]+)\*$/$1/ ) {
705 push @rightlefttruncated, $word;
707 elsif ( $word =~ s/^\*([^\*]+)$/$1/ ) {
708 push @lefttruncated, $word;
710 elsif ( $word =~ s/^([^\*]+)\*$/$1/ ) {
711 push @righttruncated, $word;
713 elsif ( index( $word, "*" ) < 0 ) {
714 push @nontruncated, $word;
717 push @regexpr, $word;
721 \@nontruncated, \@righttruncated, \@lefttruncated,
722 \@rightlefttruncated, \@regexpr
727 sub _build_stemmed_operand {
728 my ($operand,$lang) = @_;
729 require Lingua::Stem::Snowball ;
732 # If operand contains a digit, it is almost certainly an identifier, and should
733 # not be stemmed. This is particularly relevant for ISBNs and ISSNs, which
734 # can contain the letter "X" - for example, _build_stemmend_operand would reduce
735 # "014100018X" to "x ", which for a MARC21 database would bring up irrelevant
736 # results (e.g., "23 x 29 cm." from the 300$c). Bug 2098.
737 return $operand if $operand =~ /\d/;
739 # FIXME: the locale should be set based on the user's language and/or search choice
741 my $stemmer = Lingua::Stem::Snowball->new( lang => $lang,
742 encoding => "UTF-8" );
744 my @words = split( / /, $operand );
745 my @stems = $stemmer->stem(\@words);
746 for my $stem (@stems) {
747 $stemmed_operand .= "$stem";
748 $stemmed_operand .= "?"
749 unless ( $stem =~ /(and$|or$|not$)/ ) || ( length($stem) < 3 );
750 $stemmed_operand .= " ";
752 warn "STEMMED OPERAND: $stemmed_operand" if $DEBUG;
753 return $stemmed_operand;
757 sub _build_weighted_query {
759 # FIELD WEIGHTING - This is largely experimental stuff. What I'm committing works
760 # pretty well but could work much better if we had a smarter query parser
761 my ( $operand, $stemmed_operand, $index ) = @_;
762 my $stemming = C4::Context->preference("QueryStemming") || 0;
763 my $weight_fields = C4::Context->preference("QueryWeightFields") || 0;
764 my $fuzzy_enabled = C4::Context->preference("QueryFuzzy") || 0;
766 my $weighted_query .= "(rk=("; # Specifies that we're applying rank
768 # Keyword, or, no index specified
769 if ( ( $index eq 'kw' ) || ( !$index ) ) {
771 "Title-cover,ext,r1=\"$operand\""; # exact title-cover
772 $weighted_query .= " or ti,ext,r2=\"$operand\""; # exact title
773 $weighted_query .= " or ti,phr,r3=\"$operand\""; # phrase title
774 #$weighted_query .= " or any,ext,r4=$operand"; # exact any
775 #$weighted_query .=" or kw,wrdl,r5=\"$operand\""; # word list any
776 $weighted_query .= " or wrdl,fuzzy,r8=\"$operand\""
777 if $fuzzy_enabled; # add fuzzy, word list
778 $weighted_query .= " or wrdl,right-Truncation,r9=\"$stemmed_operand\""
779 if ( $stemming and $stemmed_operand )
780 ; # add stemming, right truncation
781 $weighted_query .= " or wrdl,r9=\"$operand\"";
783 # embedded sorting: 0 a-z; 1 z-a
784 # $weighted_query .= ") or (sort1,aut=1";
787 # Barcode searches should skip this process
788 elsif ( $index eq 'bc' ) {
789 $weighted_query .= "bc=\"$operand\"";
792 # Authority-number searches should skip this process
793 elsif ( $index eq 'an' ) {
794 $weighted_query .= "an=\"$operand\"";
797 # If the index already has more than one qualifier, wrap the operand
798 # in quotes and pass it back (assumption is that the user knows what they
799 # are doing and won't appreciate us mucking up their query
800 elsif ( $index =~ ',' ) {
801 $weighted_query .= " $index=\"$operand\"";
804 #TODO: build better cases based on specific search indexes
806 $weighted_query .= " $index,ext,r1=\"$operand\""; # exact index
807 #$weighted_query .= " or (title-sort-az=0 or $index,startswithnt,st-word,r3=$operand #)";
808 $weighted_query .= " or $index,phr,r3=\"$operand\""; # phrase index
810 " or $index,rt,wrdl,r3=\"$operand\""; # word list index
813 $weighted_query .= "))"; # close rank specification
814 return $weighted_query;
819 Return an array with available indexes.
841 'Author-personal-bibliography',
850 'Chronological-subdivision',
860 'Conference-name-heading',
861 'Conference-name-see',
862 'Conference-name-seealso',
867 'Corporate-name-heading',
868 'Corporate-name-see',
869 'Corporate-name-seealso',
871 'date-entered-on-file',
872 'Date-of-acquisition',
873 'Date-of-publication',
874 'Dewey-classification',
881 'Geographic-subdivision',
884 'Heading-use-main-or-added-entry',
885 'Heading-use-series-added-entry ',
886 'Heading-use-subject-added-entry',
904 'Local-classification',
907 'Match-heading-see-from',
915 'Name-geographic-heading',
916 'Name-geographic-see',
917 'Name-geographic-seealso',
925 'Personal-name-heading',
927 'Personal-name-seealso',
934 'Record-control-number',
945 'Subject-heading-thesaurus',
946 'Subject-name-personal',
947 'Subject-subdivision',
957 'Term-genre-form-heading',
958 'Term-genre-form-see',
959 'Term-genre-form-seealso',
966 'Title-uniform-heading',
968 'Title-uniform-seealso',
978 'classification-source',
980 'coded-location-qualifier',
991 'Local-classification',
994 'materials-specified',
1003 'replacementpricedate',
1021 $simple_query, $query_cgi,
1022 $query_desc, $limit,
1023 $limit_cgi, $limit_desc,
1024 $stopwords_removed, $query_type ) = buildQuery ( $operators, $operands, $indexes, $limits, $sort_by, $scan, $lang);
1026 Build queries and limits in CCL, CGI, Human,
1027 handle truncation, stemming, field weighting, stopwords, fuzziness, etc.
1029 See verbose embedded documentation.
1035 my ( $operators, $operands, $indexes, $limits, $sort_by, $scan, $lang) = @_;
1037 warn "---------\nEnter buildQuery\n---------" if $DEBUG;
1040 my @operators = $operators ? @$operators : ();
1041 my @indexes = $indexes ? @$indexes : ();
1042 my @operands = $operands ? @$operands : ();
1043 my @limits = $limits ? @$limits : ();
1044 my @sort_by = $sort_by ? @$sort_by : ();
1046 my $stemming = C4::Context->preference("QueryStemming") || 0;
1047 my $auto_truncation = C4::Context->preference("QueryAutoTruncate") || 0;
1048 my $weight_fields = C4::Context->preference("QueryWeightFields") || 0;
1049 my $fuzzy_enabled = C4::Context->preference("QueryFuzzy") || 0;
1050 my $remove_stopwords = C4::Context->preference("QueryRemoveStopwords") || 0;
1052 # no stemming/weight/fuzzy in NoZebra
1053 if ( C4::Context->preference("NoZebra") ) {
1057 $auto_truncation = 0;
1060 my $query = $operands[0];
1061 my $simple_query = $operands[0];
1063 # initialize the variables we're passing back
1072 my $stopwords_removed; # flag to determine if stopwords have been removed
1075 my $cclindexes = getIndexes();
1076 if( $query !~ /\s*ccl=/ ){
1077 for my $index (@$cclindexes){
1078 if($query =~ /($index)(,?\w)*[:=]/){
1082 $query = "ccl=$query" if($cclq);
1085 # for handling ccl, cql, pqf queries in diagnostic mode, skip the rest of the steps
1087 if ( $query =~ /^ccl=/ ) {
1089 # This is needed otherwise ccl= and &limit won't work together, and
1090 # this happens when selecting a subject on the opac-detail page
1092 $q .= ' and '.join(' and ', @limits);
1094 return ( undef, $q, $q, "q=ccl=$q", $q, '', '', '', '', 'ccl' );
1096 if ( $query =~ /^cql=/ ) {
1097 return ( undef, $', $', "q=cql=$'", $', '', '', '', '', 'cql' );
1099 if ( $query =~ /^pqf=/ ) {
1100 return ( undef, $', $', "q=pqf=$'", $', '', '', '', '', 'pqf' );
1103 # pass nested queries directly
1104 # FIXME: need better handling of some of these variables in this case
1105 # Nested queries aren't handled well and this implementation is flawed and causes users to be
1106 # unable to search for anything containing () commenting out, will be rewritten for 3.4.0
1107 # if ( $query =~ /(\(|\))/ ) {
1109 # undef, $query, $simple_query, $query_cgi,
1110 # $query, $limit, $limit_cgi, $limit_desc,
1111 # $stopwords_removed, 'ccl'
1115 # Form-based queries are non-nested and fixed depth, so we can easily modify the incoming
1116 # query operands and indexes and add stemming, truncation, field weighting, etc.
1117 # Once we do so, we'll end up with a value in $query, just like if we had an
1118 # incoming $query from the user
1121 ; # clear it out so we can populate properly with field-weighted, stemmed, etc. query
1122 my $previous_operand
1123 ; # a flag used to keep track if there was a previous query
1124 # if there was, we can apply the current operator
1126 for ( my $i = 0 ; $i <= @operands ; $i++ ) {
1128 # COMBINE OPERANDS, INDEXES AND OPERATORS
1129 if ( $operands[$i] ) {
1130 $operands[$i]=~s/^\s+//;
1132 # A flag to determine whether or not to add the index to the query
1135 # If the user is sophisticated enough to specify an index, turn off field weighting, stemming, and stopword handling
1136 if ( $operands[$i] =~ /\w(:|=)/ || $scan ) {
1139 $remove_stopwords = 0;
1141 $operands[$i] =~ s/\?/{?}/g; # need to escape question marks
1143 my $operand = $operands[$i];
1144 my $index = $indexes[$i];
1146 # Add index-specific attributes
1147 # Date of Publication
1148 if ( $index eq 'yr' ) {
1149 $index .= ",st-numeric";
1151 $stemming = $auto_truncation = $weight_fields = $fuzzy_enabled = $remove_stopwords = 0;
1154 # Date of Acquisition
1155 elsif ( $index eq 'acqdate' ) {
1156 $index .= ",st-date-normalized";
1158 $stemming = $auto_truncation = $weight_fields = $fuzzy_enabled = $remove_stopwords = 0;
1160 # ISBN,ISSN,Standard Number, don't need special treatment
1161 elsif ( $index eq 'nb' || $index eq 'ns' ) {
1163 $stemming, $auto_truncation,
1164 $weight_fields, $fuzzy_enabled,
1166 ) = ( 0, 0, 0, 0, 0 );
1174 # Set default structure attribute (word list)
1175 my $struct_attr = q{};
1176 unless ( $indexes_set || !$index || $index =~ /(st-|phr|ext|wrdl|nb|ns)/ ) {
1177 $struct_attr = ",wrdl";
1180 # Some helpful index variants
1181 my $index_plus = $index . $struct_attr . ':';
1182 my $index_plus_comma = $index . $struct_attr . ',';
1185 if ($remove_stopwords) {
1186 ( $operand, $stopwords_removed ) =
1187 _remove_stopwords( $operand, $index );
1188 warn "OPERAND w/out STOPWORDS: >$operand<" if $DEBUG;
1189 warn "REMOVED STOPWORDS: @$stopwords_removed"
1190 if ( $stopwords_removed && $DEBUG );
1193 if ($auto_truncation){
1194 unless ( $index =~ /(st-|phr|ext)/ ) {
1195 #FIXME only valid with LTR scripts
1196 $operand=join(" ",map{
1197 (index($_,"*")>0?"$_":"$_*")
1198 }split (/\s+/,$operand));
1199 warn $operand if $DEBUG;
1204 my $truncated_operand;
1205 my( $nontruncated, $righttruncated, $lefttruncated,
1206 $rightlefttruncated, $regexpr
1207 ) = _detect_truncation( $operand, $index );
1209 "TRUNCATION: NON:>@$nontruncated< RIGHT:>@$righttruncated< LEFT:>@$lefttruncated< RIGHTLEFT:>@$rightlefttruncated< REGEX:>@$regexpr<"
1214 scalar(@$righttruncated) + scalar(@$lefttruncated) +
1215 scalar(@$rightlefttruncated) > 0 )
1218 # Don't field weight or add the index to the query, we do it here
1220 undef $weight_fields;
1221 my $previous_truncation_operand;
1222 if (scalar @$nontruncated) {
1223 $truncated_operand .= "$index_plus @$nontruncated ";
1224 $previous_truncation_operand = 1;
1226 if (scalar @$righttruncated) {
1227 $truncated_operand .= "and " if $previous_truncation_operand;
1228 $truncated_operand .= $index_plus_comma . "rtrn:@$righttruncated ";
1229 $previous_truncation_operand = 1;
1231 if (scalar @$lefttruncated) {
1232 $truncated_operand .= "and " if $previous_truncation_operand;
1233 $truncated_operand .= $index_plus_comma . "ltrn:@$lefttruncated ";
1234 $previous_truncation_operand = 1;
1236 if (scalar @$rightlefttruncated) {
1237 $truncated_operand .= "and " if $previous_truncation_operand;
1238 $truncated_operand .= $index_plus_comma . "rltrn:@$rightlefttruncated ";
1239 $previous_truncation_operand = 1;
1242 $operand = $truncated_operand if $truncated_operand;
1243 warn "TRUNCATED OPERAND: >$truncated_operand<" if $DEBUG;
1246 my $stemmed_operand;
1247 $stemmed_operand = _build_stemmed_operand($operand, $lang)
1250 warn "STEMMED OPERAND: >$stemmed_operand<" if $DEBUG;
1252 # Handle Field Weighting
1253 my $weighted_operand;
1254 if ($weight_fields) {
1255 $weighted_operand = _build_weighted_query( $operand, $stemmed_operand, $index );
1256 $operand = $weighted_operand;
1260 warn "FIELD WEIGHTED OPERAND: >$weighted_operand<" if $DEBUG;
1262 # If there's a previous operand, we need to add an operator
1263 if ($previous_operand) {
1265 # User-specified operator
1266 if ( $operators[ $i - 1 ] ) {
1267 $query .= " $operators[$i-1] ";
1268 $query .= " $index_plus " unless $indexes_set;
1269 $query .= " $operand";
1270 $query_cgi .= "&op=$operators[$i-1]";
1271 $query_cgi .= "&idx=$index" if $index;
1272 $query_cgi .= "&q=$operands[$i]" if $operands[$i];
1274 " $operators[$i-1] $index_plus $operands[$i]";
1277 # Default operator is and
1280 $query .= "$index_plus " unless $indexes_set;
1281 $query .= "$operand";
1282 $query_cgi .= "&op=and&idx=$index" if $index;
1283 $query_cgi .= "&q=$operands[$i]" if $operands[$i];
1284 $query_desc .= " and $index_plus $operands[$i]";
1288 # There isn't a pervious operand, don't need an operator
1291 # Field-weighted queries already have indexes set
1292 $query .= " $index_plus " unless $indexes_set;
1294 $query_desc .= " $index_plus $operands[$i]";
1295 $query_cgi .= "&idx=$index" if $index;
1296 $query_cgi .= "&q=$operands[$i]" if $operands[$i];
1297 $previous_operand = 1;
1302 warn "QUERY BEFORE LIMITS: >$query<" if $DEBUG;
1305 my $group_OR_limits;
1306 my $availability_limit;
1307 foreach my $this_limit (@limits) {
1308 if ( $this_limit =~ /available/ ) {
1310 ## 'available' is defined as (items.onloan is NULL) and (items.itemlost = 0)
1312 ## all records not indexed in the onloan register (zebra) and all records with a value of lost equal to 0
1313 $availability_limit .=
1314 "( ( allrecords,AlwaysMatches='' not onloan,AlwaysMatches='') and (lost,st-numeric=0) )"; #or ( allrecords,AlwaysMatches='' not lost,AlwaysMatches='')) )";
1315 $limit_cgi .= "&limit=available";
1319 # group_OR_limits, prefixed by mc-
1320 # OR every member of the group
1321 elsif ( $this_limit =~ /mc/ ) {
1323 if ( $this_limit =~ /mc-ccode:/ ) {
1324 # in case the mc-ccode value has complicating chars like ()'s inside it we wrap in quotes
1325 $this_limit =~ tr/"//d;
1326 my ($k,$v) = split(/:/, $this_limit,2);
1327 $this_limit = $k.":\"".$v."\"";
1330 $group_OR_limits .= " or " if $group_OR_limits;
1331 $limit_desc .= " or " if $group_OR_limits;
1332 $group_OR_limits .= "$this_limit";
1333 $limit_cgi .= "&limit=$this_limit";
1334 $limit_desc .= " $this_limit";
1337 # Regular old limits
1339 $limit .= " and " if $limit || $query;
1340 $limit .= "$this_limit";
1341 $limit_cgi .= "&limit=$this_limit";
1342 if ($this_limit =~ /^branch:(.+)/) {
1343 my $branchcode = $1;
1344 my $branchname = GetBranchName($branchcode);
1345 if (defined $branchname) {
1346 $limit_desc .= " branch:$branchname";
1348 $limit_desc .= " $this_limit";
1351 $limit_desc .= " $this_limit";
1355 if ($group_OR_limits) {
1356 $limit .= " and " if ( $query || $limit );
1357 $limit .= "($group_OR_limits)";
1359 if ($availability_limit) {
1360 $limit .= " and " if ( $query || $limit );
1361 $limit .= "($availability_limit)";
1364 # Normalize the query and limit strings
1365 # This is flawed , means we can't search anything with : in it
1366 # if user wants to do ccl or cql, start the query with that
1367 # $query =~ s/:/=/g;
1368 $query =~ s/(?<=(ti|au|pb|su|an|kw|mc|nb|ns)):/=/g;
1369 $query =~ s/(?<=(wrdl)):/=/g;
1370 $query =~ s/(?<=(trn|phr)):/=/g;
1372 for ( $query, $query_desc, $limit, $limit_desc ) {
1373 s/ +/ /g; # remove extra spaces
1374 s/^ //g; # remove any beginning spaces
1375 s/ $//g; # remove any ending spaces
1376 s/==/=/g; # remove double == from query
1378 $query_cgi =~ s/^&//; # remove unnecessary & from beginning of the query cgi
1380 for ($query_cgi,$simple_query) {
1383 # append the limit to the query
1384 $query .= " " . $limit;
1388 warn "QUERY:" . $query;
1389 warn "QUERY CGI:" . $query_cgi;
1390 warn "QUERY DESC:" . $query_desc;
1391 warn "LIMIT:" . $limit;
1392 warn "LIMIT CGI:" . $limit_cgi;
1393 warn "LIMIT DESC:" . $limit_desc;
1394 warn "---------\nLeave buildQuery\n---------";
1397 undef, $query, $simple_query, $query_cgi,
1398 $query_desc, $limit, $limit_cgi, $limit_desc,
1399 $stopwords_removed, $query_type
1403 =head2 searchResults
1405 my @search_results = searchResults($search_context, $searchdesc, $hits,
1406 $results_per_page, $offset, $scan,
1407 @marcresults, $hidelostitems);
1409 Format results in a form suitable for passing to the template
1413 # IMO this subroutine is pretty messy still -- it's responsible for
1414 # building the HTML output for the template
1416 my ( $search_context, $searchdesc, $hits, $results_per_page, $offset, $scan, @marcresults, $hidelostitems ) = @_;
1417 my $dbh = C4::Context->dbh;
1420 $search_context = 'opac' unless $search_context eq 'opac' or $search_context eq 'intranet';
1422 #Build branchnames hash
1424 #get branch information.....
1426 my $bsth =$dbh->prepare("SELECT branchcode,branchname FROM branches"); # FIXME : use C4::Branch::GetBranches
1428 while ( my $bdata = $bsth->fetchrow_hashref ) {
1429 $branches{ $bdata->{'branchcode'} } = $bdata->{'branchname'};
1431 # FIXME - We build an authorised values hash here, using the default framework
1432 # though it is possible to have different authvals for different fws.
1434 my $shelflocations =GetKohaAuthorisedValues('items.location','');
1436 # get notforloan authorised value list (see $shelflocations FIXME)
1437 my $notforloan_authorised_value = GetAuthValCode('items.notforloan','');
1439 #Build itemtype hash
1440 #find itemtype & itemtype image
1444 "SELECT itemtype,description,imageurl,summary,notforloan FROM itemtypes"
1447 while ( my $bdata = $bsth->fetchrow_hashref ) {
1448 foreach (qw(description imageurl summary notforloan)) {
1449 $itemtypes{ $bdata->{'itemtype'} }->{$_} = $bdata->{$_};
1453 #search item field code
1456 "SELECT tagfield FROM marc_subfield_structure WHERE kohafield LIKE 'items.itemnumber'"
1459 my ($itemtag) = $sth->fetchrow;
1461 ## find column names of items related to MARC
1462 my $sth2 = $dbh->prepare("SHOW COLUMNS FROM items");
1464 my %subfieldstosearch;
1465 while ( ( my $column ) = $sth2->fetchrow ) {
1466 my ( $tagfield, $tagsubfield ) =
1467 &GetMarcFromKohaField( "items." . $column, "" );
1468 $subfieldstosearch{$column} = $tagsubfield;
1471 # handle which records to actually retrieve
1473 if ( $hits && $offset + $results_per_page <= $hits ) {
1474 $times = $offset + $results_per_page;
1477 $times = $hits; # FIXME: if $hits is undefined, why do we want to equal it?
1480 my $marcflavour = C4::Context->preference("marcflavour");
1481 # We get the biblionumber position in MARC
1482 my ($bibliotag,$bibliosubf)=GetMarcFromKohaField('biblio.biblionumber','');
1485 # loop through all of the records we've retrieved
1486 for ( my $i = $offset ; $i <= $times - 1 ; $i++ ) {
1487 my $marcrecord = MARC::File::USMARC::decode( $marcresults[$i] );
1491 ? GetFrameworkCode($marcrecord->field($bibliotag)->data)
1492 : GetFrameworkCode($marcrecord->subfield($bibliotag,$bibliosubf));
1493 my $oldbiblio = TransformMarcToKoha( $dbh, $marcrecord, $fw );
1494 $oldbiblio->{subtitle} = GetRecordValue('subtitle', $marcrecord, $fw);
1495 $oldbiblio->{result_number} = $i + 1;
1497 # add imageurl to itemtype if there is one
1498 $oldbiblio->{imageurl} = getitemtypeimagelocation( $search_context, $itemtypes{ $oldbiblio->{itemtype} }->{imageurl} );
1500 $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 ) ) : [];
1501 $oldbiblio->{normalized_upc} = GetNormalizedUPC( $marcrecord,$marcflavour);
1502 $oldbiblio->{normalized_ean} = GetNormalizedEAN( $marcrecord,$marcflavour);
1503 $oldbiblio->{normalized_oclc} = GetNormalizedOCLCNumber($marcrecord,$marcflavour);
1504 $oldbiblio->{normalized_isbn} = GetNormalizedISBN(undef,$marcrecord,$marcflavour);
1505 $oldbiblio->{content_identifier_exists} = 1 if ($oldbiblio->{normalized_isbn} or $oldbiblio->{normalized_oclc} or $oldbiblio->{normalized_ean} or $oldbiblio->{normalized_upc});
1507 # edition information, if any
1508 $oldbiblio->{edition} = $oldbiblio->{editionstatement};
1509 $oldbiblio->{description} = $itemtypes{ $oldbiblio->{itemtype} }->{description};
1510 # Build summary if there is one (the summary is defined in the itemtypes table)
1511 # FIXME: is this used anywhere, I think it can be commented out? -- JF
1512 if ( $itemtypes{ $oldbiblio->{itemtype} }->{summary} ) {
1513 my $summary = $itemtypes{ $oldbiblio->{itemtype} }->{summary};
1514 my @fields = $marcrecord->fields();
1517 foreach my $line ( "$summary\n" =~ /(.*)\n/g ){
1519 foreach my $tag ( $line =~ /\[(\d{3}[\w|\d])\]/ ) {
1520 $tag =~ /(.{3})(.)/;
1521 if($marcrecord->field($1)){
1522 my @abc = $marcrecord->field($1)->subfield($2);
1523 $tags->{$tag} = $#abc + 1 ;
1527 # We catch how many times to repeat this line
1529 foreach my $tag (keys(%$tags)){
1530 $max = $tags->{$tag} if($tags->{$tag} > $max);
1533 # we replace, and repeat each line
1534 for (my $i = 0 ; $i < $max ; $i++){
1535 my $newline = $line;
1537 foreach my $tag ( $newline =~ /\[(\d{3}[\w|\d])\]/g ) {
1538 $tag =~ /(.{3})(.)/;
1540 if($marcrecord->field($1)){
1541 my @repl = $marcrecord->field($1)->subfield($2);
1542 my $subfieldvalue = $repl[$i];
1544 if (! utf8::is_utf8($subfieldvalue)) {
1545 utf8::decode($subfieldvalue);
1548 $newline =~ s/\[$tag\]/$subfieldvalue/g;
1551 $newsummary .= "$newline\n";
1555 $newsummary =~ s/\[(.*?)]//g;
1556 $newsummary =~ s/\n/<br\/>/g;
1557 $oldbiblio->{summary} = $newsummary;
1560 # Pull out the items fields
1561 my @fields = $marcrecord->field($itemtag);
1563 # Setting item statuses for display
1564 my @available_items_loop;
1565 my @onloan_items_loop;
1566 my @other_items_loop;
1568 my $available_items;
1572 my $ordered_count = 0;
1573 my $available_count = 0;
1574 my $onloan_count = 0;
1575 my $longoverdue_count = 0;
1576 my $other_count = 0;
1577 my $wthdrawn_count = 0;
1578 my $itemlost_count = 0;
1579 my $itembinding_count = 0;
1580 my $itemdamaged_count = 0;
1581 my $item_in_transit_count = 0;
1582 my $can_place_holds = 0;
1583 my $item_onhold_count = 0;
1584 my $items_count = scalar(@fields);
1586 ( C4::Context->preference('maxItemsinSearchResults') )
1587 ? C4::Context->preference('maxItemsinSearchResults') - 1
1590 # loop through every item
1591 foreach my $field (@fields) {
1594 # populate the items hash
1595 foreach my $code ( keys %subfieldstosearch ) {
1596 $item->{$code} = $field->subfield( $subfieldstosearch{$code} );
1600 my @items = ($item);
1601 my (@hiddenitems) = GetHiddenItemnumbers(@items);
1602 $item->{'hideatopac'} = 1 if (@hiddenitems);
1604 my $hbranch = C4::Context->preference('HomeOrHoldingBranch') eq 'homebranch' ? 'homebranch' : 'holdingbranch';
1605 my $otherbranch = C4::Context->preference('HomeOrHoldingBranch') eq 'homebranch' ? 'holdingbranch' : 'homebranch';
1607 # set item's branch name, use HomeOrHoldingBranch syspref first, fall back to the other one
1608 if ($item->{$hbranch}) {
1609 $item->{'branchname'} = $branches{$item->{$hbranch}};
1611 elsif ($item->{$otherbranch}) { # Last resort
1612 $item->{'branchname'} = $branches{$item->{$otherbranch}};
1615 my $prefix = $item->{$hbranch} . '--' . $item->{location} . $item->{itype} . $item->{itemcallnumber};
1616 # For each grouping of items (onloan, available, unavailable), we build a key to store relevant info about that item
1617 my $userenv = C4::Context->userenv;
1618 if ( $item->{onloan} && !(C4::Members::GetHideLostItemsPreference($userenv->{'number'}) && $item->{itemlost}) ) {
1620 my $key = $prefix . $item->{onloan} . $item->{barcode};
1621 $onloan_items->{$key}->{due_date} = format_date($item->{onloan});
1622 $onloan_items->{$key}->{count}++ if $item->{$hbranch};
1623 $onloan_items->{$key}->{branchname} = $item->{branchname};
1624 $onloan_items->{$key}->{location} = $shelflocations->{ $item->{location} };
1625 $onloan_items->{$key}->{itemcallnumber} = $item->{itemcallnumber};
1626 $onloan_items->{$key}->{imageurl} = getitemtypeimagelocation( $search_context, $itemtypes{ $item->{itype} }->{imageurl} );
1627 # if something's checked out and lost, mark it as 'long overdue'
1628 if ( $item->{itemlost} ) {
1629 $onloan_items->{$prefix}->{longoverdue}++;
1630 $longoverdue_count++;
1631 } else { # can place holds as long as item isn't lost
1632 $can_place_holds = 1;
1636 # items not on loan, but still unavailable ( lost, withdrawn, damaged )
1640 if ( $item->{notforloan} == -1 ) {
1644 # is item in transit?
1645 my $transfertwhen = '';
1646 my ($transfertfrom, $transfertto);
1648 # is item on the reserve shelf?
1649 my $reservestatus = 0;
1652 unless ($item->{wthdrawn}
1653 || $item->{itemlost}
1655 || $item->{notforloan}
1656 || $items_count > 20) {
1658 # A couple heuristics to limit how many times
1659 # we query the database for item transfer information, sacrificing
1660 # accuracy in some cases for speed;
1662 # 1. don't query if item has one of the other statuses
1663 # 2. don't check transit status if the bib has
1664 # more than 20 items
1666 # FIXME: to avoid having the query the database like this, and to make
1667 # the in transit status count as unavailable for search limiting,
1668 # should map transit status to record indexed in Zebra.
1670 ($transfertwhen, $transfertfrom, $transfertto) = C4::Circulation::GetTransfers($item->{itemnumber});
1671 ($reservestatus, $reserveitem) = C4::Reserves::CheckReserves($item->{itemnumber});
1674 # item is withdrawn, lost, damaged, not for loan, reserved or in transit
1675 if ( $item->{wthdrawn}
1676 || $item->{itemlost}
1678 || $item->{notforloan} > 0
1679 || $item->{hideatopac}
1680 || $reservestatus eq 'Waiting'
1681 || ($transfertwhen ne ''))
1683 $wthdrawn_count++ if $item->{wthdrawn};
1684 $itemlost_count++ if $item->{itemlost};
1685 $itemdamaged_count++ if $item->{damaged};
1686 $item_in_transit_count++ if $transfertwhen ne '';
1687 $item_onhold_count++ if $reservestatus eq 'Waiting';
1688 $item->{status} = $item->{wthdrawn} . "-" . $item->{itemlost} . "-" . $item->{damaged} . "-" . $item->{notforloan};
1690 # can place hold on item ?
1691 if ((!$item->{damaged} || C4::Context->preference('AllowHoldsOnDamagedItems'))
1692 && !$item->{itemlost}
1693 && !$item->{withdrawn}
1695 $can_place_holds = 1;
1700 my $key = $prefix . $item->{status};
1701 foreach (qw(wthdrawn itemlost damaged branchname itemcallnumber hideatopac)) {
1702 $other_items->{$key}->{$_} = $item->{$_};
1704 $other_items->{$key}->{intransit} = ( $transfertwhen ne '' ) ? 1 : 0;
1705 $other_items->{$key}->{onhold} = ($reservestatus) ? 1 : 0;
1706 $other_items->{$key}->{notforloan} = GetAuthorisedValueDesc('','',$item->{notforloan},'','',$notforloan_authorised_value) if $notforloan_authorised_value;
1707 $other_items->{$key}->{count}++ if $item->{$hbranch};
1708 $other_items->{$key}->{location} = $shelflocations->{ $item->{location} };
1709 $other_items->{$key}->{imageurl} = getitemtypeimagelocation( $search_context, $itemtypes{ $item->{itype} }->{imageurl} );
1713 $can_place_holds = 1;
1715 $available_items->{$prefix}->{count}++ if $item->{$hbranch};
1716 foreach (qw(branchname itemcallnumber hideatopac)) {
1717 $available_items->{$prefix}->{$_} = $item->{$_};
1719 $available_items->{$prefix}->{location} = $shelflocations->{ $item->{location} };
1720 $available_items->{$prefix}->{imageurl} = getitemtypeimagelocation( $search_context, $itemtypes{ $item->{itype} }->{imageurl} );
1723 } # notforloan, item level and biblioitem level
1724 my ( $availableitemscount, $onloanitemscount, $otheritemscount );
1726 ( C4::Context->preference('maxItemsinSearchResults') )
1727 ? C4::Context->preference('maxItemsinSearchResults') - 1
1729 for my $key ( sort keys %$onloan_items ) {
1730 (++$onloanitemscount > $maxitems) and last;
1731 push @onloan_items_loop, $onloan_items->{$key};
1733 for my $key ( sort keys %$other_items ) {
1734 (++$otheritemscount > $maxitems) and last;
1735 push @other_items_loop, $other_items->{$key};
1737 for my $key ( sort keys %$available_items ) {
1738 (++$availableitemscount > $maxitems) and last;
1739 push @available_items_loop, $available_items->{$key}
1742 # XSLT processing of some stuff
1744 SetUTF8Flag($marcrecord);
1745 $debug && warn $marcrecord->as_formatted;
1746 if (!$scan && $search_context eq 'opac' && C4::Context->preference("OPACXSLTResultsDisplay")) {
1747 # FIXME note that XSLTResultsDisplay (use of XSLT to format staff interface bib search results)
1748 # is not implemented yet
1749 $oldbiblio->{XSLTResultsRecord} = XSLTParse4Display($oldbiblio->{biblionumber}, $marcrecord, 'Results',
1750 $search_context, 1);
1751 # the last parameter tells Koha to clean up the problematic ampersand entities that Zebra outputs
1755 # if biblio level itypes are used and itemtype is notforloan, it can't be reserved either
1756 if (!C4::Context->preference("item-level_itypes")) {
1757 if ($itemtypes{ $oldbiblio->{itemtype} }->{notforloan}) {
1758 $can_place_holds = 0;
1761 $oldbiblio->{norequests} = 1 unless $can_place_holds;
1762 $oldbiblio->{itemsplural} = 1 if $items_count > 1;
1763 $oldbiblio->{items_count} = $items_count;
1764 $oldbiblio->{available_items_loop} = \@available_items_loop;
1765 $oldbiblio->{onloan_items_loop} = \@onloan_items_loop;
1766 $oldbiblio->{other_items_loop} = \@other_items_loop;
1767 $oldbiblio->{availablecount} = $available_count;
1768 $oldbiblio->{availableplural} = 1 if $available_count > 1;
1769 $oldbiblio->{onloancount} = $onloan_count;
1770 $oldbiblio->{onloanplural} = 1 if $onloan_count > 1;
1771 $oldbiblio->{othercount} = $other_count;
1772 $oldbiblio->{otherplural} = 1 if $other_count > 1;
1773 $oldbiblio->{wthdrawncount} = $wthdrawn_count;
1774 $oldbiblio->{itemlostcount} = $itemlost_count;
1775 $oldbiblio->{damagedcount} = $itemdamaged_count;
1776 $oldbiblio->{intransitcount} = $item_in_transit_count;
1777 $oldbiblio->{onholdcount} = $item_onhold_count;
1778 $oldbiblio->{orderedcount} = $ordered_count;
1779 $oldbiblio->{isbn} =~
1780 s/-//g; # deleting - in isbn to enable amazon content
1782 if (C4::Context->preference("AlternateHoldingsField") && $items_count == 0) {
1783 my $fieldspec = C4::Context->preference("AlternateHoldingsField");
1784 my $subfields = substr $fieldspec, 3;
1785 my $holdingsep = C4::Context->preference("AlternateHoldingsSeparator") || ' ';
1786 my @alternateholdingsinfo = ();
1787 my @holdingsfields = $marcrecord->field(substr $fieldspec, 0, 3);
1788 my $alternateholdingscount = 0;
1790 for my $field (@holdingsfields) {
1791 my %holding = ( holding => '' );
1792 my $havesubfield = 0;
1793 for my $subfield ($field->subfields()) {
1794 if ((index $subfields, $$subfield[0]) >= 0) {
1795 $holding{'holding'} .= $holdingsep if (length $holding{'holding'} > 0);
1796 $holding{'holding'} .= $$subfield[1];
1800 if ($havesubfield) {
1801 push(@alternateholdingsinfo, \%holding);
1802 $alternateholdingscount++;
1806 $oldbiblio->{'ALTERNATEHOLDINGS'} = \@alternateholdingsinfo;
1807 $oldbiblio->{'alternateholdings_count'} = $alternateholdingscount;
1810 push( @newresults, $oldbiblio )
1811 if(not $hidelostitems
1812 or (($items_count > $itemlost_count )
1813 && $hidelostitems));
1819 =head2 SearchAcquisitions
1820 Search for acquisitions
1823 sub SearchAcquisitions{
1824 my ($datebegin, $dateend, $itemtypes,$criteria, $orderby) = @_;
1826 my $dbh=C4::Context->dbh;
1827 # Variable initialization
1831 LEFT JOIN biblioitems ON biblioitems.biblionumber=biblio.biblionumber
1832 LEFT JOIN items ON items.biblionumber=biblio.biblionumber
1833 WHERE dateaccessioned BETWEEN ? AND ?
1836 my (@params,@loopcriteria);
1838 push @params, $datebegin->output("iso");
1839 push @params, $dateend->output("iso");
1841 if (scalar(@$itemtypes)>0 and $criteria ne "itemtype" ){
1842 if(C4::Context->preference("item-level_itypes")){
1843 $str .= "AND items.itype IN (?".( ',?' x scalar @$itemtypes - 1 ).") ";
1845 $str .= "AND biblioitems.itemtype IN (?".( ',?' x scalar @$itemtypes - 1 ).") ";
1847 push @params, @$itemtypes;
1850 if ($criteria =~/itemtype/){
1851 if(C4::Context->preference("item-level_itypes")){
1852 $str .= "AND items.itype=? ";
1854 $str .= "AND biblioitems.itemtype=? ";
1857 if(scalar(@$itemtypes) == 0){
1858 my $itypes = GetItemTypes();
1859 for my $key (keys %$itypes){
1860 push @$itemtypes, $key;
1864 @loopcriteria= @$itemtypes;
1865 }elsif ($criteria=~/itemcallnumber/){
1866 $str .= "AND (items.itemcallnumber LIKE CONCAT(?,'%')
1867 OR items.itemcallnumber is NULL
1868 OR items.itemcallnumber = '')";
1870 @loopcriteria = ("AA".."ZZ", "") unless (scalar(@loopcriteria)>0);
1872 $str .= "AND biblio.title LIKE CONCAT(?,'%') ";
1873 @loopcriteria = ("A".."z") unless (scalar(@loopcriteria)>0);
1876 if ($orderby =~ /date_desc/){
1877 $str.=" ORDER BY dateaccessioned DESC";
1879 $str.=" ORDER BY title";
1882 my $qdataacquisitions=$dbh->prepare($str);
1884 my @loopacquisitions;
1885 foreach my $value(@loopcriteria){
1886 push @params,$value;
1888 $cell{"title"}=$value;
1889 $cell{"titlecode"}=$value;
1891 eval{$qdataacquisitions->execute(@params);};
1893 if ($@){ warn "recentacquisitions Error :$@";}
1896 while (my $data=$qdataacquisitions->fetchrow_hashref){
1897 push @loopdata, {"summary"=>GetBiblioSummary( $data->{'marcxml'} ) };
1899 $cell{"loopdata"}=\@loopdata;
1901 push @loopacquisitions,\%cell if (scalar(@{$cell{loopdata}})>0);
1904 $qdataacquisitions->finish;
1905 return \@loopacquisitions;
1907 #----------------------------------------------------------------------
1909 # Non-Zebra GetRecords#
1910 #----------------------------------------------------------------------
1914 NZgetRecords has the same API as zera getRecords, even if some parameters are not managed
1920 $query, $simple_query, $sort_by_ref, $servers_ref,
1921 $results_per_page, $offset, $expanded_facet, $branches,
1924 warn "query =$query" if $DEBUG;
1925 my $result = NZanalyse($query);
1926 warn "results =$result" if $DEBUG;
1928 NZorder( $result, @$sort_by_ref[0], $results_per_page, $offset ),
1934 NZanalyse : get a CQL string as parameter, and returns a list of biblionumber;title,biblionumber;title,...
1935 the list is built from an inverted index in the nozebra SQL table
1936 note that title is here only for convenience : the sorting will be very fast when requested on title
1937 if the sorting is requested on something else, we will have to reread all results, and that may be longer.
1942 my ( $string, $server ) = @_;
1943 # warn "---------" if $DEBUG;
1944 warn " NZanalyse" if $DEBUG;
1945 # warn "---------" if $DEBUG;
1947 # $server contains biblioserver or authorities, depending on what we search on.
1948 #warn "querying : $string on $server";
1949 $server = 'biblioserver' unless $server;
1951 # if we have a ", replace the content to discard temporarily any and/or/not inside
1953 if ( $string =~ /"/ ) {
1954 $string =~ s/"(.*?)"/__X__/;
1956 warn "commacontent : $commacontent" if $DEBUG;
1959 # split the query string in 3 parts : X AND Y means : $left="X", $operand="AND" and $right="Y"
1960 # then, call again NZanalyse with $left and $right
1961 # (recursive until we find a leaf (=> something without and/or/not)
1962 # delete repeated operator... Would then go in infinite loop
1963 while ( $string =~ s/( and| or| not| AND| OR| NOT)\1/$1/g ) {
1966 #process parenthesis before.
1967 if ( $string =~ /^\s*\((.*)\)(( and | or | not | AND | OR | NOT )(.*))?/ ) {
1970 my $operator = lc($3); # FIXME: and/or/not are operators, not operands
1972 "dealing w/parenthesis before recursive sub call. left :$left operator:$operator right:$right"
1974 my $leftresult = NZanalyse( $left, $server );
1976 my $rightresult = NZanalyse( $right, $server );
1978 # OK, we have the results for right and left part of the query
1979 # depending of operand, intersect, union or exclude both lists
1980 # to get a result list
1981 if ( $operator eq ' and ' ) {
1982 return NZoperatorAND($leftresult,$rightresult);
1984 elsif ( $operator eq ' or ' ) {
1986 # just merge the 2 strings
1987 return $leftresult . $rightresult;
1989 elsif ( $operator eq ' not ' ) {
1990 return NZoperatorNOT($leftresult,$rightresult);
1994 # this error is impossible, because of the regexp that isolate the operand, but just in case...
1998 warn "string :" . $string if $DEBUG;
2002 if ($string =~ /(.*?)( and | or | not | AND | OR | NOT )(.*)/) {
2005 $operator = lc($2); # FIXME: and/or/not are operators, not operands
2007 warn "no parenthesis. left : $left operator: $operator right: $right"
2010 # it's not a leaf, we have a and/or/not
2013 # reintroduce comma content if needed
2014 $right =~ s/__X__/"$commacontent"/ if $commacontent;
2015 $left =~ s/__X__/"$commacontent"/ if $commacontent;
2016 warn "node : $left / $operator / $right\n" if $DEBUG;
2017 my $leftresult = NZanalyse( $left, $server );
2018 my $rightresult = NZanalyse( $right, $server );
2019 warn " leftresult : $leftresult" if $DEBUG;
2020 warn " rightresult : $rightresult" if $DEBUG;
2021 # OK, we have the results for right and left part of the query
2022 # depending of operand, intersect, union or exclude both lists
2023 # to get a result list
2024 if ( $operator eq ' and ' ) {
2025 return NZoperatorAND($leftresult,$rightresult);
2027 elsif ( $operator eq ' or ' ) {
2029 # just merge the 2 strings
2030 return $leftresult . $rightresult;
2032 elsif ( $operator eq ' not ' ) {
2033 return NZoperatorNOT($leftresult,$rightresult);
2037 # this error is impossible, because of the regexp that isolate the operand, but just in case...
2038 die "error : operand unknown : $operator for $string";
2041 # it's a leaf, do the real SQL query and return the result
2044 $string =~ s/__X__/"$commacontent"/ if $commacontent;
2045 $string =~ s/-|\.|\?|,|;|!|'|\(|\)|\[|\]|{|}|"|&|\+|\*|\// /g;
2046 #remove trailing blank at the beginning
2048 warn "leaf:$string" if $DEBUG;
2050 # parse the string in in operator/operand/value again
2054 if ($string =~ /(.*)(>=|<=)(.*)/) {
2061 # warn "handling leaf... left:$left operator:$operator right:$right"
2063 unless ($operator) {
2064 if ($string =~ /(.*)(>|<|=)(.*)/) {
2069 "handling unless (operator)... left:$left operator:$operator right:$right"
2077 # strip adv, zebra keywords, currently not handled in nozebra: wrdl, ext, phr...
2080 # automatic replace for short operators
2081 $left = 'title' if $left =~ '^ti$';
2082 $left = 'author' if $left =~ '^au$';
2083 $left = 'publisher' if $left =~ '^pb$';
2084 $left = 'subject' if $left =~ '^su$';
2085 $left = 'koha-Auth-Number' if $left =~ '^an$';
2086 $left = 'keyword' if $left =~ '^kw$';
2087 $left = 'itemtype' if $left =~ '^mc$'; # Fix for Bug 2599 - Search limits not working for NoZebra
2088 warn "handling leaf... left:$left operator:$operator right:$right" if $DEBUG;
2089 my $dbh = C4::Context->dbh;
2090 if ( $operator && $left ne 'keyword' ) {
2091 #do a specific search
2092 $operator = 'LIKE' if $operator eq '=' and $right =~ /%/;
2093 my $sth = $dbh->prepare(
2094 "SELECT biblionumbers,value FROM nozebra WHERE server=? AND indexname=? AND value $operator ?"
2096 warn "$left / $operator / $right\n" if $DEBUG;
2098 # split each word, query the DB and build the biblionumbers result
2099 #sanitizing leftpart
2100 $left =~ s/^\s+|\s+$//;
2101 foreach ( split / /, $right ) {
2103 $_ =~ s/^\s+|\s+$//;
2105 warn "EXECUTE : $server, $left, $_" if $DEBUG;
2106 $sth->execute( $server, $left, $_ )
2107 or warn "execute failed: $!";
2108 while ( my ( $line, $value ) = $sth->fetchrow ) {
2110 # if we are dealing with a numeric value, use only numeric results (in case of >=, <=, > or <)
2111 # otherwise, fill the result
2112 $biblionumbers .= $line
2113 unless ( $right =~ /^\d+$/ && $value =~ /\D/ );
2114 warn "result : $value "
2115 . ( $right =~ /\d/ ) . "=="
2116 . ( $value =~ /\D/?$line:"" ) if $DEBUG; #= $line";
2119 # do a AND with existing list if there is one, otherwise, use the biblionumbers list as 1st result list
2121 warn "NZAND" if $DEBUG;
2122 $results = NZoperatorAND($biblionumbers,$results);
2124 $results = $biblionumbers;
2129 #do a complete search (all indexes), if index='kw' do complete search too.
2130 my $sth = $dbh->prepare(
2131 "SELECT biblionumbers FROM nozebra WHERE server=? AND value LIKE ?"
2134 # split each word, query the DB and build the biblionumbers result
2135 foreach ( split / /, $string ) {
2136 next if C4::Context->stopwords->{ uc($_) }; # skip if stopword
2137 warn "search on all indexes on $_" if $DEBUG;
2140 $sth->execute( $server, $_ );
2141 while ( my $line = $sth->fetchrow ) {
2142 $biblionumbers .= $line;
2145 # do a AND with existing list if there is one, otherwise, use the biblionumbers list as 1st result list
2147 $results = NZoperatorAND($biblionumbers,$results);
2150 warn "NEW RES for $_ = $biblionumbers" if $DEBUG;
2151 $results = $biblionumbers;
2155 warn "return : $results for LEAF : $string" if $DEBUG;
2158 warn "---------\nLeave NZanalyse\n---------" if $DEBUG;
2162 my ($rightresult, $leftresult)=@_;
2164 my @leftresult = split /;/, $leftresult;
2165 warn " @leftresult / $rightresult \n" if $DEBUG;
2167 # my @rightresult = split /;/,$leftresult;
2170 # parse the left results, and if the biblionumber exist in the right result, save it in finalresult
2171 # the result is stored twice, to have the same weight for AND than OR.
2172 # example : TWO : 61,61,64,121 (two is twice in the biblio #61) / TOWER : 61,64,130
2173 # result : 61,61,61,61,64,64 for two AND tower : 61 has more weight than 64
2174 foreach (@leftresult) {
2177 ( $value, $countvalue ) = ( $1, $2 ) if ($value=~/(.*)-(\d+)$/);
2178 if ( $rightresult =~ /\Q$value\E-(\d+);/ ) {
2179 $countvalue = ( $1 > $countvalue ? $countvalue : $1 );
2181 "$value-$countvalue;$value-$countvalue;";
2184 warn "NZAND DONE : $finalresult \n" if $DEBUG;
2185 return $finalresult;
2189 my ($rightresult, $leftresult)=@_;
2190 return $rightresult.$leftresult;
2194 my ($leftresult, $rightresult)=@_;
2196 my @leftresult = split /;/, $leftresult;
2198 # my @rightresult = split /;/,$leftresult;
2200 foreach (@leftresult) {
2202 $value=$1 if $value=~m/(.*)-\d+$/;
2203 unless ($rightresult =~ "$value-") {
2204 $finalresult .= "$_;";
2207 return $finalresult;
2212 $finalresult = NZorder($biblionumbers, $ordering,$results_per_page,$offset);
2219 my ( $biblionumbers, $ordering, $results_per_page, $offset ) = @_;
2220 warn "biblionumbers = $biblionumbers and ordering = $ordering\n" if $DEBUG;
2222 # order title asc by default
2223 # $ordering = '1=36 <i' unless $ordering;
2224 $results_per_page = 20 unless $results_per_page;
2225 $offset = 0 unless $offset;
2226 my $dbh = C4::Context->dbh;
2229 # order by POPULARITY
2231 if ( $ordering =~ /popularity/ ) {
2235 # popularity is not in MARC record, it's builded from a specific query
2237 $dbh->prepare("select sum(issues) from items where biblionumber=?");
2238 foreach ( split /;/, $biblionumbers ) {
2239 my ( $biblionumber, $title ) = split /,/, $_;
2240 $result{$biblionumber} = GetMarcBiblio($biblionumber);
2241 $sth->execute($biblionumber);
2242 my $popularity = $sth->fetchrow || 0;
2244 # hint : the key is popularity.title because we can have
2245 # many results with the same popularity. In this case, sub-ordering is done by title
2246 # we also have biblionumber to avoid bug for 2 biblios with the same title & popularity
2247 # (un-frequent, I agree, but we won't forget anything that way ;-)
2248 $popularity{ sprintf( "%10d", $popularity ) . $title
2249 . $biblionumber } = $biblionumber;
2252 # sort the hash and return the same structure as GetRecords (Zebra querying)
2255 if ( $ordering eq 'popularity_dsc' ) { # sort popularity DESC
2256 foreach my $key ( sort { $b cmp $a } ( keys %popularity ) ) {
2257 $result_hash->{'RECORDS'}[ $numbers++ ] =
2258 $result{ $popularity{$key} }->as_usmarc();
2261 else { # sort popularity ASC
2262 foreach my $key ( sort ( keys %popularity ) ) {
2263 $result_hash->{'RECORDS'}[ $numbers++ ] =
2264 $result{ $popularity{$key} }->as_usmarc();
2267 my $finalresult = ();
2268 $result_hash->{'hits'} = $numbers;
2269 $finalresult->{'biblioserver'} = $result_hash;
2270 return $finalresult;
2276 elsif ( $ordering =~ /author/ ) {
2278 foreach ( split /;/, $biblionumbers ) {
2279 my ( $biblionumber, $title ) = split /,/, $_;
2280 my $record = GetMarcBiblio($biblionumber);
2282 if ( C4::Context->preference('marcflavour') eq 'UNIMARC' ) {
2283 $author = $record->subfield( '200', 'f' );
2284 $author = $record->subfield( '700', 'a' ) unless $author;
2287 $author = $record->subfield( '100', 'a' );
2290 # hint : the result is sorted by title.biblionumber because we can have X biblios with the same title
2291 # and we don't want to get only 1 result for each of them !!!
2292 $result{ $author . $biblionumber } = $record;
2295 # sort the hash and return the same structure as GetRecords (Zebra querying)
2298 if ( $ordering eq 'author_za' || $ordering eq 'author_dsc' ) { # sort by author desc
2299 foreach my $key ( sort { $b cmp $a } ( keys %result ) ) {
2300 $result_hash->{'RECORDS'}[ $numbers++ ] =
2301 $result{$key}->as_usmarc();
2304 else { # sort by author ASC
2305 foreach my $key ( sort ( keys %result ) ) {
2306 $result_hash->{'RECORDS'}[ $numbers++ ] =
2307 $result{$key}->as_usmarc();
2310 my $finalresult = ();
2311 $result_hash->{'hits'} = $numbers;
2312 $finalresult->{'biblioserver'} = $result_hash;
2313 return $finalresult;
2316 # ORDER BY callnumber
2319 elsif ( $ordering =~ /callnumber/ ) {
2321 foreach ( split /;/, $biblionumbers ) {
2322 my ( $biblionumber, $title ) = split /,/, $_;
2323 my $record = GetMarcBiblio($biblionumber);
2325 my $frameworkcode = GetFrameworkCode($biblionumber);
2326 my ( $callnumber_tag, $callnumber_subfield ) = GetMarcFromKohaField( 'items.itemcallnumber', $frameworkcode);
2327 ( $callnumber_tag, $callnumber_subfield ) = GetMarcFromKohaField('biblioitems.callnumber', $frameworkcode)
2328 unless $callnumber_tag;
2329 if ( C4::Context->preference('marcflavour') eq 'UNIMARC' ) {
2330 $callnumber = $record->subfield( '200', 'f' );
2332 $callnumber = $record->subfield( '100', 'a' );
2335 # hint : the result is sorted by title.biblionumber because we can have X biblios with the same title
2336 # and we don't want to get only 1 result for each of them !!!
2337 $result{ $callnumber . $biblionumber } = $record;
2340 # sort the hash and return the same structure as GetRecords (Zebra querying)
2343 if ( $ordering eq 'call_number_dsc' ) { # sort by title desc
2344 foreach my $key ( sort { $b cmp $a } ( keys %result ) ) {
2345 $result_hash->{'RECORDS'}[ $numbers++ ] =
2346 $result{$key}->as_usmarc();
2349 else { # sort by title ASC
2350 foreach my $key ( sort { $a cmp $b } ( keys %result ) ) {
2351 $result_hash->{'RECORDS'}[ $numbers++ ] =
2352 $result{$key}->as_usmarc();
2355 my $finalresult = ();
2356 $result_hash->{'hits'} = $numbers;
2357 $finalresult->{'biblioserver'} = $result_hash;
2358 return $finalresult;
2360 elsif ( $ordering =~ /pubdate/ ) { #pub year
2362 foreach ( split /;/, $biblionumbers ) {
2363 my ( $biblionumber, $title ) = split /,/, $_;
2364 my $record = GetMarcBiblio($biblionumber);
2365 my ( $publicationyear_tag, $publicationyear_subfield ) =
2366 GetMarcFromKohaField( 'biblioitems.publicationyear', '' );
2367 my $publicationyear =
2368 $record->subfield( $publicationyear_tag,
2369 $publicationyear_subfield );
2371 # hint : the result is sorted by title.biblionumber because we can have X biblios with the same title
2372 # and we don't want to get only 1 result for each of them !!!
2373 $result{ $publicationyear . $biblionumber } = $record;
2376 # sort the hash and return the same structure as GetRecords (Zebra querying)
2379 if ( $ordering eq 'pubdate_dsc' ) { # sort by pubyear desc
2380 foreach my $key ( sort { $b cmp $a } ( keys %result ) ) {
2381 $result_hash->{'RECORDS'}[ $numbers++ ] =
2382 $result{$key}->as_usmarc();
2385 else { # sort by pub year ASC
2386 foreach my $key ( sort ( keys %result ) ) {
2387 $result_hash->{'RECORDS'}[ $numbers++ ] =
2388 $result{$key}->as_usmarc();
2391 my $finalresult = ();
2392 $result_hash->{'hits'} = $numbers;
2393 $finalresult->{'biblioserver'} = $result_hash;
2394 return $finalresult;
2400 elsif ( $ordering =~ /title/ ) {
2402 # the title is in the biblionumbers string, so we just need to build a hash, sort it and return
2404 foreach ( split /;/, $biblionumbers ) {
2405 my ( $biblionumber, $title ) = split /,/, $_;
2407 # hint : the result is sorted by title.biblionumber because we can have X biblios with the same title
2408 # and we don't want to get only 1 result for each of them !!!
2409 # hint & speed improvement : we can order without reading the record
2410 # so order, and read records only for the requested page !
2411 $result{ $title . $biblionumber } = $biblionumber;
2414 # sort the hash and return the same structure as GetRecords (Zebra querying)
2417 if ( $ordering eq 'title_az' ) { # sort by title desc
2418 foreach my $key ( sort ( keys %result ) ) {
2419 $result_hash->{'RECORDS'}[ $numbers++ ] = $result{$key};
2422 else { # sort by title ASC
2423 foreach my $key ( sort { $b cmp $a } ( keys %result ) ) {
2424 $result_hash->{'RECORDS'}[ $numbers++ ] = $result{$key};
2428 # limit the $results_per_page to result size if it's more
2429 $results_per_page = $numbers - 1 if $numbers < $results_per_page;
2431 # for the requested page, replace biblionumber by the complete record
2432 # speed improvement : avoid reading too much things
2434 my $counter = $offset ;
2435 $counter <= $offset + $results_per_page ;
2439 $result_hash->{'RECORDS'}[$counter] =
2440 GetMarcBiblio( $result_hash->{'RECORDS'}[$counter] )->as_usmarc;
2442 my $finalresult = ();
2443 $result_hash->{'hits'} = $numbers;
2444 $finalresult->{'biblioserver'} = $result_hash;
2445 return $finalresult;
2452 # we need 2 hashes to order by ranking : the 1st one to count the ranking, the 2nd to order by ranking
2455 foreach ( split /;/, $biblionumbers ) {
2456 my ( $biblionumber, $title ) = split /,/, $_;
2457 $title =~ /(.*)-(\d)/;
2462 # note that we + the ranking because ranking is calculated on weight of EACH term requested.
2463 # if we ask for "two towers", and "two" has weight 2 in biblio N, and "towers" has weight 4 in biblio N
2464 # biblio N has ranking = 6
2465 $count_ranking{$biblionumber} += $ranking;
2468 # build the result by "inverting" the count_ranking hash
2469 # 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
2471 foreach ( keys %count_ranking ) {
2472 $result{ sprintf( "%10d", $count_ranking{$_} ) . '-' . $_ } = $_;
2475 # sort the hash and return the same structure as GetRecords (Zebra querying)
2478 foreach my $key ( sort { $b cmp $a } ( keys %result ) ) {
2479 $result_hash->{'RECORDS'}[ $numbers++ ] = $result{$key};
2482 # limit the $results_per_page to result size if it's more
2483 $results_per_page = $numbers - 1 if $numbers < $results_per_page;
2485 # for the requested page, replace biblionumber by the complete record
2486 # speed improvement : avoid reading too much things
2488 my $counter = $offset ;
2489 $counter <= $offset + $results_per_page ;
2493 $result_hash->{'RECORDS'}[$counter] =
2494 GetMarcBiblio( $result_hash->{'RECORDS'}[$counter] )->as_usmarc
2495 if $result_hash->{'RECORDS'}[$counter];
2497 my $finalresult = ();
2498 $result_hash->{'hits'} = $numbers;
2499 $finalresult->{'biblioserver'} = $result_hash;
2500 return $finalresult;
2504 =head2 enabled_staff_search_views
2506 %hash = enabled_staff_search_views()
2508 This function returns a hash that contains three flags obtained from the system
2509 preferences, used to determine whether a particular staff search results view
2514 =item C<Output arg:>
2516 * $hash{can_view_MARC} is true only if the MARC view is enabled
2517 * $hash{can_view_ISBD} is true only if the ISBD view is enabled
2518 * $hash{can_view_labeledMARC} is true only if the Labeled MARC view is enabled
2520 =item C<usage in the script:>
2524 $template->param ( C4::Search::enabled_staff_search_views );
2528 sub enabled_staff_search_views
2531 can_view_MARC => C4::Context->preference('viewMARC'), # 1 if the staff search allows the MARC view
2532 can_view_ISBD => C4::Context->preference('viewISBD'), # 1 if the staff search allows the ISBD view
2533 can_view_labeledMARC => C4::Context->preference('viewLabeledMARC'), # 1 if the staff search allows the Labeled MARC view
2537 sub AddSearchHistory{
2538 my ($borrowernumber,$session,$query_desc,$query_cgi, $total)=@_;
2539 my $dbh = C4::Context->dbh;
2541 # Add the request the user just made
2542 my $sql = "INSERT INTO search_history(userid, sessionid, query_desc, query_cgi, total, time) VALUES(?, ?, ?, ?, ?, NOW())";
2543 my $sth = $dbh->prepare($sql);
2544 $sth->execute($borrowernumber, $session, $query_desc, $query_cgi, $total);
2545 return $dbh->last_insert_id(undef, 'search_history', undef,undef,undef);
2548 sub GetSearchHistory{
2549 my ($borrowernumber,$session)=@_;
2550 my $dbh = C4::Context->dbh;
2552 # Add the request the user just made
2553 my $query = "SELECT FROM search_history WHERE (userid=? OR sessionid=?)";
2554 my $sth = $dbh->prepare($query);
2555 $sth->execute($borrowernumber, $session);
2556 return $sth->fetchall_hashref({});
2559 =head2 z3950_search_args
2561 $arrayref = z3950_search_args($matchpoints)
2563 This function returns an array reference that contains the search parameters to be
2564 passed to the Z39.50 search script (z3950_search.pl). The array elements
2565 are hash refs whose keys are name, value and encvalue, and whose values are the
2566 name of a search parameter, the value of that search parameter and the URL encoded
2567 value of that parameter.
2569 The search parameter names are lccn, isbn, issn, title, author, dewey and subject.
2571 The search parameter values are obtained from the bibliographic record whose
2572 data is in a hash reference in $matchpoints, as returned by Biblio::GetBiblioData().
2574 If $matchpoints is a scalar, it is assumed to be an unnamed query descriptor, e.g.
2575 a general purpose search argument. In this case, the returned array contains only
2576 entry: the key is 'title' and the value and encvalue are derived from $matchpoints.
2578 If a search parameter value is undefined or empty, it is not included in the returned
2581 The returned array reference may be passed directly to the template parameters.
2585 =item C<Output arg:>
2587 * $array containing hash refs as described above
2589 =item C<usage in the script:>
2593 $data = Biblio::GetBiblioData($bibno);
2594 $template->param ( MYLOOP => C4::Search::z3950_search_args($data) )
2598 $template->param ( MYLOOP => C4::Search::z3950_search_args($searchscalar) )
2602 sub z3950_search_args {
2604 $bibrec = { title => $bibrec } if !ref $bibrec;
2606 for my $field (qw/ lccn isbn issn title author dewey subject /)
2608 my $encvalue = URI::Escape::uri_escape_utf8($bibrec->{$field});
2609 push @$array, { name=>$field, value=>$bibrec->{$field}, encvalue=>$encvalue } if defined $bibrec->{$field};
2614 =head2 BiblioAddAuthorities
2616 ( $countlinked, $countcreated ) = BiblioAddAuthorities($record, $frameworkcode);
2618 this function finds the authorities linked to the biblio
2619 * search in the authority DB for the same authid (in $9 of the biblio)
2620 * search in the authority DB for the same 001 (in $3 of the biblio in UNIMARC)
2621 * search in the authority DB for the same values (exactly) (in all subfields of the biblio)
2622 OR adds a new authority record
2628 * $record is the MARC record in question (marc blob)
2629 * $frameworkcode is the bibliographic framework to use (if it is "" it uses the default framework)
2631 =item C<Output arg:>
2633 * $countlinked is the number of authorities records that are linked to this authority
2637 * 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)
2644 sub BiblioAddAuthorities{
2645 my ( $record, $frameworkcode ) = @_;
2646 my $dbh=C4::Context->dbh;
2647 my $query=$dbh->prepare(qq|
2648 SELECT authtypecode,tagfield
2649 FROM marc_subfield_structure
2650 WHERE frameworkcode=?
2651 AND (authtypecode IS NOT NULL AND authtypecode<>\"\")|);
2652 # SELECT authtypecode,tagfield
2653 # FROM marc_subfield_structure
2654 # WHERE frameworkcode=?
2655 # AND (authtypecode IS NOT NULL OR authtypecode<>\"\")|);
2656 $query->execute($frameworkcode);
2657 my ($countcreated,$countlinked);
2658 while (my $data=$query->fetchrow_hashref){
2659 foreach my $field ($record->field($data->{tagfield})){
2660 next if ($field->subfield('3')||$field->subfield('9'));
2661 # No authorities id in the tag.
2662 # Search if there is any authorities to link to.
2663 my $query='at='.$data->{authtypecode}.' ';
2664 map {$query.= ' and he,ext="'.$_->[1].'"' if ($_->[0]=~/[A-z]/)} $field->subfields();
2665 my ($error, $results, $total_hits)=SimpleSearch( $query, undef, undef, [ "authorityserver" ] );
2666 # there is only 1 result
2668 warn "BIBLIOADDSAUTHORITIES: $error";
2671 if ( @{$results} == 1 ) {
2672 my $marcrecord = MARC::File::USMARC::decode($results->[0]);
2673 $field->add_subfields('9'=>$marcrecord->field('001')->data);
2675 } elsif ( @{$results} > 1 ) {
2676 #More than One result
2677 #This can comes out of a lack of a subfield.
2678 # my $marcrecord = MARC::File::USMARC::decode($results->[0]);
2679 # $record->field($data->{tagfield})->add_subfields('9'=>$marcrecord->field('001')->data);
2682 #There are no results, build authority record, add it to Authorities, get authid and add it to 9
2683 ###NOTICE : This is only valid if a subfield is linked to one and only one authtypecode
2684 ###NOTICE : This can be a problem. We should also look into other types and rejected forms.
2685 my $authtypedata=C4::AuthoritiesMarc::GetAuthType($data->{authtypecode});
2686 next unless $authtypedata;
2687 my $marcrecordauth=MARC::Record->new();
2688 my $authfield=MARC::Field->new($authtypedata->{auth_tag_to_report},'','',"a"=>"".$field->subfield('a'));
2689 map { $authfield->add_subfields($_->[0]=>$_->[1]) if ($_->[0]=~/[A-z]/ && $_->[0] ne "a" )} $field->subfields();
2690 $marcrecordauth->insert_fields_ordered($authfield);
2692 # bug 2317: ensure new authority knows it's using UTF-8; currently
2693 # only need to do this for MARC21, as MARC::Record->as_xml_record() handles
2694 # automatically for UNIMARC (by not transcoding)
2695 # FIXME: AddAuthority() instead should simply explicitly require that the MARC::Record
2696 # use UTF-8, but as of 2008-08-05, did not want to introduce that kind
2697 # of change to a core API just before the 3.0 release.
2698 if (C4::Context->preference('marcflavour') eq 'MARC21') {
2699 SetMarcUnicodeFlag($marcrecordauth, 'MARC21');
2702 # warn "AUTH RECORD ADDED : ".$marcrecordauth->as_formatted;
2704 my $authid=AddAuthority($marcrecordauth,'',$data->{authtypecode});
2706 $field->add_subfields('9'=>$authid);
2710 return ($countlinked,$countcreated);
2713 =head2 GetDistinctValues($field);
2715 C<$field> is a reference to the fields array
2719 sub GetDistinctValues {
2720 my ($fieldname,$string)=@_;
2721 # returns a reference to a hash of references to branches...
2722 if ($fieldname=~/\./){
2723 my ($table,$column)=split /\./, $fieldname;
2724 my $dbh = C4::Context->dbh;
2725 warn "select DISTINCT($column) as value, count(*) as cnt from $table group by lib order by $column " if $DEBUG;
2726 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 ");
2728 my $elements=$sth->fetchall_arrayref({});
2733 my @servers=qw<biblioserver authorityserver>;
2734 my (@zconns,@results);
2735 for ( my $i = 0 ; $i < @servers ; $i++ ) {
2736 $zconns[$i] = C4::Context->Zconn( $servers[$i], 1 );
2739 ZOOM::Query::CCL2RPN->new( qq"$fieldname $string", $zconns[$i])
2742 # The big moment: asynchronously retrieve results from all servers
2744 while ( ( my $i = ZOOM::event( \@zconns ) ) != 0 ) {
2745 my $ev = $zconns[ $i - 1 ]->last_event();
2746 if ( $ev == ZOOM::Event::ZEND ) {
2747 next unless $results[ $i - 1 ];
2748 my $size = $results[ $i - 1 ]->size();
2750 for (my $j=0;$j<$size;$j++){
2752 @hashscan{qw(value cnt)}=$results[ $i - 1 ]->display_term($j);
2753 push @elements, \%hashscan;
2763 END { } # module clean-up code here (global destructor)
2770 Koha Development Team <http://koha-community.org/>