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
22 use C4
::Biblio
; # GetMarcFromKohaField, GetBiblioData
23 use C4
::Koha
; # getFacets
25 use C4
::Search
::PazPar2
;
27 use C4
::Dates
qw(format_date);
32 use vars
qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $DEBUG);
34 # set the version for version checking
37 $DEBUG = ($ENV{DEBUG}) ? 1 : 0;
42 C4::Search - Functions for searching the Koha catalog.
46 See opac/opac-search.pl or catalogue/search.pl for example of usage
50 This module provides searching functions for Koha's bibliographic databases
68 #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)
70 # make all your functions, whether exported or not;
74 ($biblionumber,$biblionumber,$title) = FindDuplicate($record);
76 This function attempts to find duplicate records using a hard-coded, fairly simplistic algorithm
82 my $dbh = C4
::Context
->dbh;
83 my $result = TransformMarcToKoha
( $dbh, $record, '' );
88 my ( $biblionumber, $title );
90 # search duplicate on ISBN, easy and fast..
92 if ( $result->{isbn
} ) {
93 $result->{isbn
} =~ s/\(.*$//;
94 $result->{isbn
} =~ s/\s+$//;
95 $query = "isbn=$result->{isbn}";
98 $result->{title
} =~ s
/\\//g
;
99 $result->{title
} =~ s
/\"//g
;
100 $result->{title
} =~ s
/\(//g
;
101 $result->{title
} =~ s
/\)//g
;
103 # FIXME: instead of removing operators, could just do
104 # quotes around the value
105 $result->{title
} =~ s/(and|or|not)//g;
106 $query = "ti,ext=$result->{title}";
107 $query .= " and itemtype=$result->{itemtype}"
108 if ( $result->{itemtype
} );
109 if ( $result->{author
} ) {
110 $result->{author
} =~ s
/\\//g
;
111 $result->{author
} =~ s
/\"//g
;
112 $result->{author
} =~ s
/\(//g
;
113 $result->{author
} =~ s
/\)//g
;
115 # remove valid operators
116 $result->{author
} =~ s/(and|or|not)//g;
117 $query .= " and au,ext=$result->{author}";
121 # FIXME: add error handling
122 my ( $error, $searchresults ) = SimpleSearch
($query); # FIXME :: hardcoded !
124 foreach my $possible_duplicate_record (@
$searchresults) {
126 MARC
::Record
->new_from_usmarc($possible_duplicate_record);
127 my $result = TransformMarcToKoha
( $dbh, $marcrecord, '' );
129 # FIXME :: why 2 $biblionumber ?
131 push @results, $result->{'biblionumber'};
132 push @results, $result->{'title'};
140 ( $error, $results, $total_hits ) = SimpleSearch( $query, $offset, $max_results, [@servers] );
142 This function provides a simple search API on the bibliographic catalog
148 * $query can be a simple keyword or a complete CCL query
149 * @servers is optional. Defaults to biblioserver as found in koha-conf.xml
150 * $offset - If present, represents the number of records at the beggining to omit. Defaults to 0
151 * $max_results - if present, determines the maximum number of records to fetch. undef is All. defaults to undef.
156 * $error is a empty unless an error is detected
157 * \@results is an array of records.
158 * $total_hits is the number of hits that would have been returned with no limit
160 =item C<usage in the script:>
164 my ( $error, $marcresults, $total_hits ) = SimpleSearch($query);
166 if (defined $error) {
167 $template->param(query_error => $error);
168 warn "error: ".$error;
169 output_html_with_http_headers $input, $cookie, $template->output;
173 my $hits = scalar @$marcresults;
176 for my $i (0..$hits) {
178 my $marcrecord = MARC::File::USMARC::decode($marcresults->[$i]);
179 my $biblio = TransformMarcToKoha(C4::Context->dbh,$marcrecord,'');
181 #build the hash for the template.
182 $resultsloop{title} = $biblio->{'title'};
183 $resultsloop{subtitle} = $biblio->{'subtitle'};
184 $resultsloop{biblionumber} = $biblio->{'biblionumber'};
185 $resultsloop{author} = $biblio->{'author'};
186 $resultsloop{publishercode} = $biblio->{'publishercode'};
187 $resultsloop{publicationyear} = $biblio->{'publicationyear'};
189 push @results, \%resultsloop;
192 $template->param(result=>\@results);
197 my ( $query, $offset, $max_results, $servers ) = @_;
199 if ( C4
::Context
->preference('NoZebra') ) {
200 my $result = NZorder
( NZanalyse
($query) )->{'biblioserver'};
203 && $result->{hits
} > 0 ?
$result->{'RECORDS'} : [] );
204 return ( undef, $search_result, scalar($result->{hits
}) );
207 # FIXME hardcoded value. See catalog/search.pl & opac-search.pl too.
208 my @servers = defined ( $servers ) ? @
$servers : ( "biblioserver" );
214 return ( "No query entered", undef, undef ) unless $query;
216 # Initialize & Search Zebra
217 for ( my $i = 0 ; $i < @servers ; $i++ ) {
219 $zconns[$i] = C4
::Context
->Zconn( $servers[$i], 1 );
220 $zoom_queries[$i] = new ZOOM
::Query
::CCL2RPN
( $query, $zconns[$i]);
221 $tmpresults[$i] = $zconns[$i]->search( $zoom_queries[$i] );
225 $zconns[$i]->errmsg() . " ("
226 . $zconns[$i]->errcode() . ") "
227 . $zconns[$i]->addinfo() . " "
228 . $zconns[$i]->diagset();
230 return ( $error, undef, undef ) if $zconns[$i]->errcode();
234 # caught a ZOOM::Exception
238 . $@
->addinfo() . " "
241 return ( $error, undef, undef );
244 while ( ( my $i = ZOOM
::event
( \
@zconns ) ) != 0 ) {
245 my $event = $zconns[ $i - 1 ]->last_event();
246 if ( $event == ZOOM
::Event
::ZEND
) {
248 my $first_record = defined( $offset ) ?
$offset+1 : 1;
249 my $hits = $tmpresults[ $i - 1 ]->size();
250 $total_hits += $hits;
251 my $last_record = $hits;
252 if ( defined $max_results && $offset + $max_results < $hits ) {
253 $last_record = $offset + $max_results;
256 for my $j ( $first_record..$last_record ) {
257 my $record = $tmpresults[ $i - 1 ]->record( $j-1 )->raw(); # 0 indexed
258 push @results, $record;
263 foreach my $result (@tmpresults) {
266 foreach my $zoom_query (@zoom_queries) {
267 $zoom_query->destroy();
270 return ( undef, \
@results, $total_hits );
276 ( undef, $results_hashref, \@facets_loop ) = getRecords (
278 $koha_query, $simple_query, $sort_by_ref, $servers_ref,
279 $results_per_page, $offset, $expanded_facet, $branches,
283 The all singing, all dancing, multi-server, asynchronous, scanning,
284 searching, record nabbing, facet-building
286 See verbse embedded documentation.
292 $koha_query, $simple_query, $sort_by_ref, $servers_ref,
293 $results_per_page, $offset, $expanded_facet, $branches,
297 my @servers = @
$servers_ref;
298 my @sort_by = @
$sort_by_ref;
300 # Initialize variables for the ZOOM connection and results object
304 my $results_hashref = ();
306 # Initialize variables for the faceted results objects
307 my $facets_counter = ();
308 my $facets_info = ();
309 my $facets = getFacets
();
311 my @facets_loop; # stores the ref to array of hashes for template facets loop
313 ### LOOP THROUGH THE SERVERS
314 for ( my $i = 0 ; $i < @servers ; $i++ ) {
315 $zconns[$i] = C4
::Context
->Zconn( $servers[$i], 1 );
317 # perform the search, create the results objects
318 # if this is a local search, use the $koha-query, if it's a federated one, use the federated-query
319 my $query_to_use = ($servers[$i] =~ /biblioserver/) ?
$koha_query : $simple_query;
321 #$query_to_use = $simple_query if $scan;
322 warn $simple_query if ( $scan and $DEBUG );
324 # Check if we've got a query_type defined, if so, use it
327 if ($query_type =~ /^ccl/) {
328 $query_to_use =~ s/\:/\=/g; # change : to = last minute (FIXME)
329 $results[$i] = $zconns[$i]->search(new ZOOM
::Query
::CCL2RPN
($query_to_use, $zconns[$i]));
330 } elsif ($query_type =~ /^cql/) {
331 $results[$i] = $zconns[$i]->search(new ZOOM
::Query
::CQL
($query_to_use, $zconns[$i]));
332 } elsif ($query_type =~ /^pqf/) {
333 $results[$i] = $zconns[$i]->search(new ZOOM
::Query
::PQF
($query_to_use, $zconns[$i]));
335 warn "Unknown query_type '$query_type'. Results undetermined.";
338 $results[$i] = $zconns[$i]->scan( new ZOOM
::Query
::CCL2RPN
($query_to_use, $zconns[$i]));
340 $results[$i] = $zconns[$i]->search(new ZOOM
::Query
::CCL2RPN
($query_to_use, $zconns[$i]));
344 warn "WARNING: query problem with $query_to_use " . $@
;
347 # Concatenate the sort_by limits and pass them to the results object
348 # Note: sort will override rank
350 foreach my $sort (@sort_by) {
351 if ( $sort eq "author_az" ) {
352 $sort_by .= "1=1003 <i ";
354 elsif ( $sort eq "author_za" ) {
355 $sort_by .= "1=1003 >i ";
357 elsif ( $sort eq "popularity_asc" ) {
358 $sort_by .= "1=9003 <i ";
360 elsif ( $sort eq "popularity_dsc" ) {
361 $sort_by .= "1=9003 >i ";
363 elsif ( $sort eq "call_number_asc" ) {
364 $sort_by .= "1=20 <i ";
366 elsif ( $sort eq "call_number_dsc" ) {
367 $sort_by .= "1=20 >i ";
369 elsif ( $sort eq "pubdate_asc" ) {
370 $sort_by .= "1=31 <i ";
372 elsif ( $sort eq "pubdate_dsc" ) {
373 $sort_by .= "1=31 >i ";
375 elsif ( $sort eq "acqdate_asc" ) {
376 $sort_by .= "1=32 <i ";
378 elsif ( $sort eq "acqdate_dsc" ) {
379 $sort_by .= "1=32 >i ";
381 elsif ( $sort eq "title_az" ) {
382 $sort_by .= "1=4 <i ";
384 elsif ( $sort eq "title_za" ) {
385 $sort_by .= "1=4 >i ";
388 warn "Ignoring unrecognized sort '$sort' requested" if $sort_by;
392 if ( $results[$i]->sort( "yaz", $sort_by ) < 0 ) {
393 warn "WARNING sort $sort_by failed";
396 } # finished looping through servers
398 # The big moment: asynchronously retrieve results from all servers
399 while ( ( my $i = ZOOM
::event
( \
@zconns ) ) != 0 ) {
400 my $ev = $zconns[ $i - 1 ]->last_event();
401 if ( $ev == ZOOM
::Event
::ZEND
) {
402 next unless $results[ $i - 1 ];
403 my $size = $results[ $i - 1 ]->size();
407 # loop through the results
408 $results_hash->{'hits'} = $size;
410 if ( $offset + $results_per_page <= $size ) {
411 $times = $offset + $results_per_page;
416 for ( my $j = $offset ; $j < $times ; $j++ ) {
421 ## Check if it's an index scan
423 my ( $term, $occ ) = $results[ $i - 1 ]->term($j);
425 # here we create a minimal MARC record and hand it off to the
426 # template just like a normal result ... perhaps not ideal, but
428 my $tmprecord = MARC
::Record
->new();
429 $tmprecord->encoding('UTF-8');
433 # the minimal record in author/title (depending on MARC flavour)
434 if (C4
::Context
->preference("marcflavour") eq "UNIMARC") {
435 $tmptitle = MARC
::Field
->new('200',' ',' ', a
=> $term, f
=> $occ);
436 $tmprecord->append_fields($tmptitle);
438 $tmptitle = MARC
::Field
->new('245',' ',' ', a
=> $term,);
439 $tmpauthor = MARC
::Field
->new('100',' ',' ', a
=> $occ,);
440 $tmprecord->append_fields($tmptitle);
441 $tmprecord->append_fields($tmpauthor);
443 $results_hash->{'RECORDS'}[$j] = $tmprecord->as_usmarc();
448 $record = $results[ $i - 1 ]->record($j)->raw();
450 # warn "RECORD $j:".$record;
451 $results_hash->{'RECORDS'}[$j] = $record;
453 # Fill the facets while we're looping, but only for the biblioserver
454 $facet_record = MARC
::Record
->new_from_usmarc($record)
455 if $servers[ $i - 1 ] =~ /biblioserver/;
457 #warn $servers[$i-1]."\n".$record; #.$facet_record->title();
459 for ( my $k = 0 ; $k <= @
$facets ; $k++ ) {
460 ($facets->[$k]) or next;
461 my @fields = map {$facet_record->field($_)} @
{$facets->[$k]->{'tags'}} ;
462 for my $field (@fields) {
463 my @subfields = $field->subfields();
464 for my $subfield (@subfields) {
465 my ( $code, $data ) = @
$subfield;
466 ($code eq $facets->[$k]->{'subfield'}) or next;
467 $facets_counter->{ $facets->[$k]->{'link_value'} }->{$data}++;
470 $facets_info->{ $facets->[$k]->{'link_value'} }->{'label_value'} =
471 $facets->[$k]->{'label_value'};
472 $facets_info->{ $facets->[$k]->{'link_value'} }->{'expanded'} =
473 $facets->[$k]->{'expanded'};
478 $results_hashref->{ $servers[ $i - 1 ] } = $results_hash;
481 # warn "connection ", $i-1, ": $size hits";
482 # warn $results[$i-1]->record(0)->render() if $size > 0;
485 if ( $servers[ $i - 1 ] =~ /biblioserver/ ) {
487 sort { $facets_counter->{$b} <=> $facets_counter->{$a} }
488 keys %$facets_counter )
491 my $number_of_facets;
492 my @this_facets_array;
495 $facets_counter->{$link_value}->{$b}
496 <=> $facets_counter->{$link_value}->{$a}
497 } keys %{ $facets_counter->{$link_value} }
501 if ( ( $number_of_facets < 6 )
502 || ( $expanded_facet eq $link_value )
503 || ( $facets_info->{$link_value}->{'expanded'} ) )
506 # Sanitize the link value ), ( will cause errors with CCL,
507 my $facet_link_value = $one_facet;
508 $facet_link_value =~ s/(\(|\))/ /g;
510 # fix the length that will display in the label,
511 my $facet_label_value = $one_facet;
513 substr( $one_facet, 0, 20 ) . "..."
514 unless length($facet_label_value) <= 20;
516 # if it's a branch, label by the name, not the code,
517 if ( $link_value =~ /branch/ ) {
518 if (defined $branches
519 && ref($branches) eq "HASH"
520 && defined $branches->{$one_facet}
521 && ref ($branches->{$one_facet}) eq "HASH")
524 $branches->{$one_facet}->{'branchname'};
527 $facet_label_value = "*";
531 # but we're down with the whole label being in the link's title.
532 push @this_facets_array, {
533 facet_count
=> $facets_counter->{$link_value}->{$one_facet},
534 facet_label_value
=> $facet_label_value,
535 facet_title_value
=> $one_facet,
536 facet_link_value
=> $facet_link_value,
537 type_link_value
=> $link_value,
542 # handle expanded option
543 unless ( $facets_info->{$link_value}->{'expanded'} ) {
545 if ( ( $number_of_facets > 6 )
546 && ( $expanded_facet ne $link_value ) );
549 type_link_value
=> $link_value,
550 type_id
=> $link_value . "_id",
551 "type_label_" . $facets_info->{$link_value}->{'label_value'} => 1,
552 facets
=> \
@this_facets_array,
553 expandable
=> $expandable,
554 expand
=> $link_value,
555 } unless ( ($facets_info->{$link_value}->{'label_value'} =~ /Libraries/) and (C4
::Context
->preference('singleBranchMode')) );
560 return ( undef, $results_hashref, \
@facets_loop );
565 $koha_query, $simple_query, $sort_by_ref, $servers_ref,
566 $results_per_page, $offset, $expanded_facet, $branches,
570 my $paz = C4
::Search
::PazPar2
->new(C4
::Context
->config('pazpar2url'));
572 $paz->search($simple_query);
573 sleep 1; # FIXME: WHY?
576 my $results_hashref = {};
577 my $stats = XMLin
($paz->stat);
578 my $results = XMLin
($paz->show($offset, $results_per_page, 'work-title:1'), forcearray
=> 1);
580 # for a grouped search result, the number of hits
581 # is the number of groups returned; 'bib_hits' will have
582 # the total number of bibs.
583 $results_hashref->{'biblioserver'}->{'hits'} = $results->{'merged'}->[0];
584 $results_hashref->{'biblioserver'}->{'bib_hits'} = $stats->{'hits'};
586 HIT
: foreach my $hit (@
{ $results->{'hit'} }) {
587 my $recid = $hit->{recid
}->[0];
589 my $work_title = $hit->{'md-work-title'}->[0];
591 if (exists $hit->{'md-work-author'}) {
592 $work_author = $hit->{'md-work-author'}->[0];
594 my $group_label = (defined $work_author) ?
"$work_title / $work_author" : $work_title;
596 my $result_group = {};
597 $result_group->{'group_label'} = $group_label;
598 $result_group->{'group_merge_key'} = $recid;
601 if (exists $hit->{count
}) {
602 $count = $hit->{count
}->[0];
604 $result_group->{'group_count'} = $count;
606 for (my $i = 0; $i < $count; $i++) {
607 # FIXME -- may need to worry about diacritics here
608 my $rec = $paz->record($recid, $i);
609 push @
{ $result_group->{'RECORDS'} }, $rec;
612 push @
{ $results_hashref->{'biblioserver'}->{'GROUPS'} }, $result_group;
615 # pass through facets
616 my $termlist_xml = $paz->termlist('author,subject');
617 my $terms = XMLin
($termlist_xml, forcearray
=> 1);
618 my @facets_loop = ();
619 #die Dumper($results);
620 # foreach my $list (sort keys %{ $terms->{'list'} }) {
622 # foreach my $facet (sort @{ $terms->{'list'}->{$list}->{'term'} } ) {
624 # facet_label_value => $facet->{'name'}->[0],
627 # push @facets_loop, ( {
628 # type_label => $list,
629 # facets => \@facets,
633 return ( undef, $results_hashref, \
@facets_loop );
637 sub _remove_stopwords
{
638 my ( $operand, $index ) = @_;
639 my @stopwords_removed;
641 # phrase and exact-qualified indexes shouldn't have stopwords removed
642 if ( $index !~ m/phr|ext/ ) {
644 # remove stopwords from operand : parse all stopwords & remove them (case insensitive)
645 # we use IsAlpha unicode definition, to deal correctly with diacritics.
646 # otherwise, a French word like "leçon" woudl be split into "le" "çon", "le"
647 # is a stopword, we'd get "çon" and wouldn't find anything...
648 foreach ( keys %{ C4
::Context
->stopwords } ) {
649 next if ( $_ =~ /(and|or|not)/ ); # don't remove operators
650 if ( my ($matched) = ($operand =~
651 /(\P{IsAlnum}\Q$_\E\P{IsAlnum}|^\Q$_\E\P{IsAlnum}|\P{IsAlnum}\Q$_\E$|^\Q$_\E$)/gi) )
653 $operand =~ s/\Q$matched\E/ /gi;
654 push @stopwords_removed, $_;
658 return ( $operand, \
@stopwords_removed );
662 sub _detect_truncation
{
663 my ( $operand, $index ) = @_;
664 my ( @nontruncated, @righttruncated, @lefttruncated, @rightlefttruncated,
667 my @wordlist = split( /\s/, $operand );
668 foreach my $word (@wordlist) {
669 if ( $word =~ s/^\*([^\*]+)\*$/$1/ ) {
670 push @rightlefttruncated, $word;
672 elsif ( $word =~ s/^\*([^\*]+)$/$1/ ) {
673 push @lefttruncated, $word;
675 elsif ( $word =~ s/^([^\*]+)\*$/$1/ ) {
676 push @righttruncated, $word;
678 elsif ( index( $word, "*" ) < 0 ) {
679 push @nontruncated, $word;
682 push @regexpr, $word;
686 \
@nontruncated, \
@righttruncated, \
@lefttruncated,
687 \
@rightlefttruncated, \
@regexpr
692 sub _build_stemmed_operand
{
693 my ($operand,$lang) = @_;
694 require Lingua
::Stem
::Snowball
;
697 # If operand contains a digit, it is almost certainly an identifier, and should
698 # not be stemmed. This is particularly relevant for ISBNs and ISSNs, which
699 # can contain the letter "X" - for example, _build_stemmend_operand would reduce
700 # "014100018X" to "x ", which for a MARC21 database would bring up irrelevant
701 # results (e.g., "23 x 29 cm." from the 300$c). Bug 2098.
702 return $operand if $operand =~ /\d/;
704 # FIXME: the locale should be set based on the user's language and/or search choice
705 my $stemmer = Lingua
::Stem
::Snowball
->new( lang
=> $lang,
706 encoding
=> "UTF-8" );
708 # FIXME: these should be stored in the db so the librarian can modify the behavior
709 $stemmer->add_exceptions(
716 my @words = split( / /, $operand );
717 my @stems = $stemmer->stem(\
@words);
718 for my $stem (@stems) {
719 $stemmed_operand .= "$stem";
720 $stemmed_operand .= "?"
721 unless ( $stem =~ /(and$|or$|not$)/ ) || ( length($stem) < 3 );
722 $stemmed_operand .= " ";
724 warn "STEMMED OPERAND: $stemmed_operand" if $DEBUG;
725 return $stemmed_operand;
729 sub _build_weighted_query
{
731 # FIELD WEIGHTING - This is largely experimental stuff. What I'm committing works
732 # pretty well but could work much better if we had a smarter query parser
733 my ( $operand, $stemmed_operand, $index ) = @_;
734 my $stemming = C4
::Context
->preference("QueryStemming") || 0;
735 my $weight_fields = C4
::Context
->preference("QueryWeightFields") || 0;
736 my $fuzzy_enabled = C4
::Context
->preference("QueryFuzzy") || 0;
738 my $weighted_query .= "(rk=("; # Specifies that we're applying rank
740 # Keyword, or, no index specified
741 if ( ( $index eq 'kw' ) || ( !$index ) ) {
743 "Title-cover,ext,r1=\"$operand\""; # exact title-cover
744 $weighted_query .= " or ti,ext,r2=\"$operand\""; # exact title
745 $weighted_query .= " or ti,phr,r3=\"$operand\""; # phrase title
746 #$weighted_query .= " or any,ext,r4=$operand"; # exact any
747 #$weighted_query .=" or kw,wrdl,r5=\"$operand\""; # word list any
748 $weighted_query .= " or wrdl,fuzzy,r8=\"$operand\""
749 if $fuzzy_enabled; # add fuzzy, word list
750 $weighted_query .= " or wrdl,right-Truncation,r9=\"$stemmed_operand\""
751 if ( $stemming and $stemmed_operand )
752 ; # add stemming, right truncation
753 $weighted_query .= " or wrdl,r9=\"$operand\"";
755 # embedded sorting: 0 a-z; 1 z-a
756 # $weighted_query .= ") or (sort1,aut=1";
759 # Barcode searches should skip this process
760 elsif ( $index eq 'bc' ) {
761 $weighted_query .= "bc=\"$operand\"";
764 # Authority-number searches should skip this process
765 elsif ( $index eq 'an' ) {
766 $weighted_query .= "an=\"$operand\"";
769 # If the index already has more than one qualifier, wrap the operand
770 # in quotes and pass it back (assumption is that the user knows what they
771 # are doing and won't appreciate us mucking up their query
772 elsif ( $index =~ ',' ) {
773 $weighted_query .= " $index=\"$operand\"";
776 #TODO: build better cases based on specific search indexes
778 $weighted_query .= " $index,ext,r1=\"$operand\""; # exact index
779 #$weighted_query .= " or (title-sort-az=0 or $index,startswithnt,st-word,r3=$operand #)";
780 $weighted_query .= " or $index,phr,r3=\"$operand\""; # phrase index
782 " or $index,rt,wrdl,r3=\"$operand\""; # word list index
785 $weighted_query .= "))"; # close rank specification
786 return $weighted_query;
792 $simple_query, $query_cgi,
794 $limit_cgi, $limit_desc,
795 $stopwords_removed, $query_type ) = buildQuery ( $operators, $operands, $indexes, $limits, $sort_by, $scan, $lang);
797 Build queries and limits in CCL, CGI, Human,
798 handle truncation, stemming, field weighting, stopwords, fuzziness, etc.
800 See verbose embedded documentation.
806 my ( $operators, $operands, $indexes, $limits, $sort_by, $scan, $lang) = @_;
808 warn "---------\nEnter buildQuery\n---------" if $DEBUG;
811 my @operators = $operators ? @
$operators : ();
812 my @indexes = $indexes ? @
$indexes : ();
813 my @operands = $operands ? @
$operands : ();
814 my @limits = $limits ? @
$limits : ();
815 my @sort_by = $sort_by ? @
$sort_by : ();
817 my $stemming = C4
::Context
->preference("QueryStemming") || 0;
818 my $auto_truncation = C4
::Context
->preference("QueryAutoTruncate") || 0;
819 my $weight_fields = C4
::Context
->preference("QueryWeightFields") || 0;
820 my $fuzzy_enabled = C4
::Context
->preference("QueryFuzzy") || 0;
821 my $remove_stopwords = C4
::Context
->preference("QueryRemoveStopwords") || 0;
823 # no stemming/weight/fuzzy in NoZebra
824 if ( C4
::Context
->preference("NoZebra") ) {
830 my $query = $operands[0];
831 my $simple_query = $operands[0];
833 # initialize the variables we're passing back
842 my $stopwords_removed; # flag to determine if stopwords have been removed
844 # for handling ccl, cql, pqf queries in diagnostic mode, skip the rest of the steps
846 if ( $query =~ /^ccl=/ ) {
847 return ( undef, $', $', "q=ccl=$'", $', '', '', '', '', 'ccl
' );
849 if ( $query =~ /^cql=/ ) {
850 return ( undef, $', $', "q=cql=$'", $', '', '', '', '', 'cql' );
852 if ( $query =~ /^pqf=/ ) {
853 return ( undef, $', $', "q
=pqf
=$'", $', '', '', '', '', 'pqf' );
856 # pass nested queries directly
857 # FIXME: need better handling of some of these variables in this case
858 if ( $query =~ /(\(|\))/ ) {
860 undef, $query, $simple_query, $query_cgi,
861 $query, $limit, $limit_cgi, $limit_desc,
862 $stopwords_removed, 'ccl'
866 # Form-based queries are non-nested and fixed depth, so we can easily modify the incoming
867 # query operands and indexes and add stemming, truncation, field weighting, etc.
868 # Once we do so, we'll end up with a value in $query, just like if we had an
869 # incoming $query from the user
872 ; # clear it out so we can populate properly with field-weighted, stemmed, etc. query
874 ; # a flag used to keep track if there was a previous query
875 # if there was, we can apply the current operator
877 for ( my $i = 0 ; $i <= @operands ; $i++ ) {
879 # COMBINE OPERANDS, INDEXES AND OPERATORS
880 if ( $operands[$i] ) {
882 # A flag to determine whether or not to add the index to the query
885 # If the user is sophisticated enough to specify an index, turn off field weighting, stemming, and stopword handling
886 if ( $operands[$i] =~ /(:|=)/ || $scan ) {
889 $remove_stopwords = 0;
891 my $operand = $operands[$i];
892 my $index = $indexes[$i];
894 # Add index-specific attributes
895 # Date of Publication
896 if ( $index eq 'yr' ) {
897 $index .= ",st-numeric";
899 $stemming = $auto_truncation = $weight_fields = $fuzzy_enabled = $remove_stopwords = 0;
902 # Date of Acquisition
903 elsif ( $index eq 'acqdate' ) {
904 $index .= ",st-date-normalized";
906 $stemming = $auto_truncation = $weight_fields = $fuzzy_enabled = $remove_stopwords = 0;
908 # ISBN,ISSN,Standard Number, don't need special treatment
909 elsif ( $index eq 'nb' || $index eq 'ns' ) {
912 $stemming, $auto_truncation,
913 $weight_fields, $fuzzy_enabled,
915 ) = ( 0, 0, 0, 0, 0 );
918 # Set default structure attribute (word list)
920 unless ( $indexes_set || !$index || $index =~ /(st-|phr|ext|wrdl)/ ) {
921 $struct_attr = ",wrdl";
924 # Some helpful index variants
925 my $index_plus = $index . $struct_attr . ":" if $index;
926 my $index_plus_comma = $index . $struct_attr . "," if $index;
929 if ($remove_stopwords) {
930 ( $operand, $stopwords_removed ) =
931 _remove_stopwords
( $operand, $index );
932 warn "OPERAND w/out STOPWORDS: >$operand<" if $DEBUG;
933 warn "REMOVED STOPWORDS: @$stopwords_removed"
934 if ( $stopwords_removed && $DEBUG );
937 if ($auto_truncation){
938 $operand=~join(" ",map{ "$_*" }split (/\s+/,$operand));
942 my $truncated_operand;
943 my( $nontruncated, $righttruncated, $lefttruncated,
944 $rightlefttruncated, $regexpr
945 ) = _detect_truncation
( $operand, $index );
947 "TRUNCATION: NON:>@$nontruncated< RIGHT:>@$righttruncated< LEFT:>@$lefttruncated< RIGHTLEFT:>@$rightlefttruncated< REGEX:>@$regexpr<"
952 scalar(@
$righttruncated) + scalar(@
$lefttruncated) +
953 scalar(@
$rightlefttruncated) > 0 )
956 # Don't field weight or add the index to the query, we do it here
958 undef $weight_fields;
959 my $previous_truncation_operand;
960 if (scalar @
$nontruncated) {
961 $truncated_operand .= "$index_plus @$nontruncated ";
962 $previous_truncation_operand = 1;
964 if (scalar @
$righttruncated) {
965 $truncated_operand .= "and " if $previous_truncation_operand;
966 $truncated_operand .= $index_plus_comma . "rtrn:@$righttruncated ";
967 $previous_truncation_operand = 1;
969 if (scalar @
$lefttruncated) {
970 $truncated_operand .= "and " if $previous_truncation_operand;
971 $truncated_operand .= $index_plus_comma . "ltrn:@$lefttruncated ";
972 $previous_truncation_operand = 1;
974 if (scalar @
$rightlefttruncated) {
975 $truncated_operand .= "and " if $previous_truncation_operand;
976 $truncated_operand .= $index_plus_comma . "rltrn:@$rightlefttruncated ";
977 $previous_truncation_operand = 1;
980 $operand = $truncated_operand if $truncated_operand;
981 warn "TRUNCATED OPERAND: >$truncated_operand<" if $DEBUG;
985 $stemmed_operand = _build_stemmed_operand
($operand, $lang)
988 warn "STEMMED OPERAND: >$stemmed_operand<" if $DEBUG;
990 # Handle Field Weighting
991 my $weighted_operand;
992 if ($weight_fields) {
993 $weighted_operand = _build_weighted_query
( $operand, $stemmed_operand, $index );
994 $operand = $weighted_operand;
998 warn "FIELD WEIGHTED OPERAND: >$weighted_operand<" if $DEBUG;
1000 # If there's a previous operand, we need to add an operator
1001 if ($previous_operand) {
1003 # User-specified operator
1004 if ( $operators[ $i - 1 ] ) {
1005 $query .= " $operators[$i-1] ";
1006 $query .= " $index_plus " unless $indexes_set;
1007 $query .= " $operand";
1008 $query_cgi .= "&op=$operators[$i-1]";
1009 $query_cgi .= "&idx=$index" if $index;
1010 $query_cgi .= "&q=$operands[$i]" if $operands[$i];
1012 " $operators[$i-1] $index_plus $operands[$i]";
1015 # Default operator is and
1018 $query .= "$index_plus " unless $indexes_set;
1019 $query .= "$operand";
1020 $query_cgi .= "&op=and&idx=$index" if $index;
1021 $query_cgi .= "&q=$operands[$i]" if $operands[$i];
1022 $query_desc .= " and $index_plus $operands[$i]";
1026 # There isn't a pervious operand, don't need an operator
1029 # Field-weighted queries already have indexes set
1030 $query .= " $index_plus " unless $indexes_set;
1032 $query_desc .= " $index_plus $operands[$i]";
1033 $query_cgi .= "&idx=$index" if $index;
1034 $query_cgi .= "&q=$operands[$i]" if $operands[$i];
1035 $previous_operand = 1;
1040 warn "QUERY BEFORE LIMITS: >$query<" if $DEBUG;
1043 my $group_OR_limits;
1044 my $availability_limit;
1045 foreach my $this_limit (@limits) {
1046 if ( $this_limit =~ /available/ ) {
1048 # 'available' is defined as (items.onloan is NULL) and (items.itemlost = 0)
1050 # all records not indexed in the onloan register (zebra) and all records with a value of lost equal to 0
1051 $availability_limit .=
1052 "( ( allrecords,AlwaysMatches='' not onloan,AlwaysMatches='') and (lost,st-numeric=0) )"; #or ( allrecords,AlwaysMatches='' not lost,AlwaysMatches='')) )";
1053 $limit_cgi .= "&limit=available";
1057 # group_OR_limits, prefixed by mc-
1058 # OR every member of the group
1059 elsif ( $this_limit =~ /mc/ ) {
1060 $group_OR_limits .= " or " if $group_OR_limits;
1061 $limit_desc .= " or " if $group_OR_limits;
1062 $group_OR_limits .= "$this_limit";
1063 $limit_cgi .= "&limit=$this_limit";
1064 $limit_desc .= " $this_limit";
1067 # Regular old limits
1069 $limit .= " and " if $limit || $query;
1070 $limit .= "$this_limit";
1071 $limit_cgi .= "&limit=$this_limit";
1072 if ($this_limit =~ /^branch:(.+)/) {
1073 my $branchcode = $1;
1074 my $branchname = GetBranchName
($branchcode);
1075 if (defined $branchname) {
1076 $limit_desc .= " branch:$branchname";
1078 $limit_desc .= " $this_limit";
1081 $limit_desc .= " $this_limit";
1085 if ($group_OR_limits) {
1086 $limit .= " and " if ( $query || $limit );
1087 $limit .= "($group_OR_limits)";
1089 if ($availability_limit) {
1090 $limit .= " and " if ( $query || $limit );
1091 $limit .= "($availability_limit)";
1094 # Normalize the query and limit strings
1097 for ( $query, $query_desc, $limit, $limit_desc ) {
1098 s/ / /g; # remove extra spaces
1099 s/^ //g; # remove any beginning spaces
1100 s/ $//g; # remove any ending spaces
1101 s/==/=/g; # remove double == from query
1103 $query_cgi =~ s/^&//; # remove unnecessary & from beginning of the query cgi
1105 for ($query_cgi,$simple_query) {
1108 # append the limit to the query
1109 $query .= " " . $limit;
1113 warn "QUERY:" . $query;
1114 warn "QUERY CGI:" . $query_cgi;
1115 warn "QUERY DESC:" . $query_desc;
1116 warn "LIMIT:" . $limit;
1117 warn "LIMIT CGI:" . $limit_cgi;
1118 warn "LIMIT DESC:" . $limit_desc;
1119 warn "---------\nLeave buildQuery\n---------";
1122 undef, $query, $simple_query, $query_cgi,
1123 $query_desc, $limit, $limit_cgi, $limit_desc,
1124 $stopwords_removed, $query_type
1128 =head2 searchResults
1130 Format results in a form suitable for passing to the template
1134 # IMO this subroutine is pretty messy still -- it's responsible for
1135 # building the HTML output for the template
1137 my ( $searchdesc, $hits, $results_per_page, $offset, $scan, @marcresults ) = @_;
1138 my $dbh = C4
::Context
->dbh;
1141 #Build branchnames hash
1143 #get branch information.....
1145 my $bsth =$dbh->prepare("SELECT branchcode,branchname FROM branches"); # FIXME : use C4::Branch::GetBranches
1147 while ( my $bdata = $bsth->fetchrow_hashref ) {
1148 $branches{ $bdata->{'branchcode'} } = $bdata->{'branchname'};
1150 # FIXME - We build an authorised values hash here, using the default framework
1151 # though it is possible to have different authvals for different fws.
1153 my $shelflocations =GetKohaAuthorisedValues
('items.location','');
1155 # get notforloan authorised value list (see $shelflocations FIXME)
1156 my $notforloan_authorised_value = GetAuthValCode
('items.notforloan','');
1158 #Build itemtype hash
1159 #find itemtype & itemtype image
1163 "SELECT itemtype,description,imageurl,summary,notforloan FROM itemtypes"
1166 while ( my $bdata = $bsth->fetchrow_hashref ) {
1167 foreach (qw(description imageurl summary notforloan)) {
1168 $itemtypes{ $bdata->{'itemtype'} }->{$_} = $bdata->{$_};
1172 #search item field code
1175 "SELECT tagfield FROM marc_subfield_structure WHERE kohafield LIKE 'items.itemnumber'"
1178 my ($itemtag) = $sth->fetchrow;
1180 ## find column names of items related to MARC
1181 my $sth2 = $dbh->prepare("SHOW COLUMNS FROM items");
1183 my %subfieldstosearch;
1184 while ( ( my $column ) = $sth2->fetchrow ) {
1185 my ( $tagfield, $tagsubfield ) =
1186 &GetMarcFromKohaField
( "items." . $column, "" );
1187 $subfieldstosearch{$column} = $tagsubfield;
1190 # handle which records to actually retrieve
1192 if ( $hits && $offset + $results_per_page <= $hits ) {
1193 $times = $offset + $results_per_page;
1196 $times = $hits; # FIXME: if $hits is undefined, why do we want to equal it?
1199 my $marcflavour = C4
::Context
->preference("marcflavour");
1200 # We get the biblionumber position in MARC
1201 my ($bibliotag,$bibliosubf)=GetMarcFromKohaField
('biblio.biblionumber','');
1204 # loop through all of the records we've retrieved
1205 for ( my $i = $offset ; $i <= $times - 1 ; $i++ ) {
1206 my $marcrecord = MARC
::File
::USMARC
::decode
( $marcresults[$i] );
1209 $fw = GetFrameworkCode
($marcrecord->field($bibliotag)->data);
1211 $fw = GetFrameworkCode
($marcrecord->subfield($bibliotag,$bibliosubf));
1214 my $oldbiblio = TransformMarcToKoha
( $dbh, $marcrecord, $fw );
1215 $oldbiblio->{subtitle
} = GetRecordValue
('subtitle', $marcrecord, $fw);
1216 $oldbiblio->{result_number
} = $i + 1;
1218 # add imageurl to itemtype if there is one
1219 $oldbiblio->{imageurl
} = getitemtypeimagelocation
( 'opac', $itemtypes{ $oldbiblio->{itemtype
} }->{imageurl
} );
1221 $oldbiblio->{'authorised_value_images'} = C4
::Items
::get_authorised_value_images
( C4
::Biblio
::get_biblio_authorised_values
( $oldbiblio->{'biblionumber'}, $marcrecord ) );
1222 $oldbiblio->{normalized_upc
} = GetNormalizedUPC
( $marcrecord,$marcflavour);
1223 $oldbiblio->{normalized_ean
} = GetNormalizedEAN
( $marcrecord,$marcflavour);
1224 $oldbiblio->{normalized_oclc
} = GetNormalizedOCLCNumber
($marcrecord,$marcflavour);
1225 $oldbiblio->{normalized_isbn
} = GetNormalizedISBN
(undef,$marcrecord,$marcflavour);
1226 $oldbiblio->{content_identifier_exists
} = 1 if ($oldbiblio->{normalized_isbn
} or $oldbiblio->{normalized_oclc
} or $oldbiblio->{normalized_ean
} or $oldbiblio->{normalized_upc
});
1228 # edition information, if any
1229 $oldbiblio->{edition
} = $oldbiblio->{editionstatement
};
1230 $oldbiblio->{description
} = $itemtypes{ $oldbiblio->{itemtype
} }->{description
};
1231 # Build summary if there is one (the summary is defined in the itemtypes table)
1232 # FIXME: is this used anywhere, I think it can be commented out? -- JF
1233 if ( $itemtypes{ $oldbiblio->{itemtype
} }->{summary
} ) {
1234 my $summary = $itemtypes{ $oldbiblio->{itemtype
} }->{summary
};
1235 my @fields = $marcrecord->fields();
1236 foreach my $field (@fields) {
1237 my $tag = $field->tag();
1238 my $tagvalue = $field->as_string();
1240 s/\[(.?.?.?.?)$tag\*(.*?)]/$1$tagvalue$2\[$1$tag$2]/g;
1241 unless ( $tag < 10 ) {
1242 my @subf = $field->subfields;
1243 for my $i ( 0 .. $#subf ) {
1244 my $subfieldcode = $subf[$i][0];
1245 my $subfieldvalue = $subf[$i][1];
1246 my $tagsubf = $tag . $subfieldcode;
1248 s/\[(.?.?.?.?)$tagsubf(.*?)]/$1$subfieldvalue$2\[$1$tagsubf$2]/g;
1253 $summary =~ s/\[(.*?)]//g;
1254 $summary =~ s/\n/<br\/>/g
;
1255 $oldbiblio->{summary
} = $summary;
1258 # Pull out the items fields
1259 my @fields = $marcrecord->field($itemtag);
1261 # Setting item statuses for display
1262 my @available_items_loop;
1263 my @onloan_items_loop;
1264 my @other_items_loop;
1266 my $available_items;
1270 my $ordered_count = 0;
1271 my $available_count = 0;
1272 my $onloan_count = 0;
1273 my $longoverdue_count = 0;
1274 my $other_count = 0;
1275 my $wthdrawn_count = 0;
1276 my $itemlost_count = 0;
1277 my $itembinding_count = 0;
1278 my $itemdamaged_count = 0;
1279 my $item_in_transit_count = 0;
1280 my $can_place_holds = 0;
1281 my $items_count = scalar(@fields);
1283 ( C4
::Context
->preference('maxItemsinSearchResults') )
1284 ? C4
::Context
->preference('maxItemsinSearchResults') - 1
1287 # loop through every item
1288 foreach my $field (@fields) {
1291 # populate the items hash
1292 foreach my $code ( keys %subfieldstosearch ) {
1293 $item->{$code} = $field->subfield( $subfieldstosearch{$code} );
1295 my $hbranch = C4
::Context
->preference('HomeOrHoldingBranch') eq 'homebranch' ?
'homebranch' : 'holdingbranch';
1296 my $otherbranch = C4
::Context
->preference('HomeOrHoldingBranch') eq 'homebranch' ?
'holdingbranch' : 'homebranch';
1297 # set item's branch name, use HomeOrHoldingBranch syspref first, fall back to the other one
1298 if ($item->{$hbranch}) {
1299 $item->{'branchname'} = $branches{$item->{$hbranch}};
1301 elsif ($item->{$otherbranch}) { # Last resort
1302 $item->{'branchname'} = $branches{$item->{$otherbranch}};
1305 my $prefix = $item->{$hbranch} . '--' . $item->{location
} . $item->{itype
} . $item->{itemcallnumber
};
1306 # For each grouping of items (onloan, available, unavailable), we build a key to store relevant info about that item
1307 if ( $item->{onloan
} ) {
1309 my $key = $prefix . $item->{onloan
} . $item->{barcode
};
1310 $onloan_items->{$key}->{due_date
} = format_date
($item->{onloan
});
1311 $onloan_items->{$key}->{count
}++ if $item->{$hbranch};
1312 $onloan_items->{$key}->{branchname
} = $item->{branchname
};
1313 $onloan_items->{$key}->{location
} = $shelflocations->{ $item->{location
} };
1314 $onloan_items->{$key}->{itemcallnumber
} = $item->{itemcallnumber
};
1315 $onloan_items->{$key}->{imageurl
} = getitemtypeimagelocation
( 'opac', $itemtypes{ $item->{itype
} }->{imageurl
} );
1316 # if something's checked out and lost, mark it as 'long overdue'
1317 if ( $item->{itemlost
} ) {
1318 $onloan_items->{$prefix}->{longoverdue
}++;
1319 $longoverdue_count++;
1320 } else { # can place holds as long as item isn't lost
1321 $can_place_holds = 1;
1325 # items not on loan, but still unavailable ( lost, withdrawn, damaged )
1329 if ( $item->{notforloan
} == -1 ) {
1333 # is item in transit?
1334 my $transfertwhen = '';
1335 my ($transfertfrom, $transfertto);
1337 unless ($item->{wthdrawn
}
1338 || $item->{itemlost
}
1340 || $item->{notforloan
}
1341 || $items_count > 20) {
1343 # A couple heuristics to limit how many times
1344 # we query the database for item transfer information, sacrificing
1345 # accuracy in some cases for speed;
1347 # 1. don't query if item has one of the other statuses
1348 # 2. don't check transit status if the bib has
1349 # more than 20 items
1351 # FIXME: to avoid having the query the database like this, and to make
1352 # the in transit status count as unavailable for search limiting,
1353 # should map transit status to record indexed in Zebra.
1355 ($transfertwhen, $transfertfrom, $transfertto) = C4
::Circulation
::GetTransfers
($item->{itemnumber
});
1358 # item is withdrawn, lost or damaged
1359 if ( $item->{wthdrawn
}
1360 || $item->{itemlost
}
1362 || $item->{notforloan
}
1363 || ($transfertwhen ne ''))
1365 $wthdrawn_count++ if $item->{wthdrawn
};
1366 $itemlost_count++ if $item->{itemlost
};
1367 $itemdamaged_count++ if $item->{damaged
};
1368 $item_in_transit_count++ if $transfertwhen ne '';
1369 $item->{status
} = $item->{wthdrawn
} . "-" . $item->{itemlost
} . "-" . $item->{damaged
} . "-" . $item->{notforloan
};
1372 my $key = $prefix . $item->{status
};
1373 foreach (qw(wthdrawn itemlost damaged branchname itemcallnumber)) {
1374 $other_items->{$key}->{$_} = $item->{$_};
1376 $other_items->{$key}->{intransit
} = ($transfertwhen ne '') ?
1 : 0;
1377 $other_items->{$key}->{notforloan
} = GetAuthorisedValueDesc
('','',$item->{notforloan
},'','',$notforloan_authorised_value) if $notforloan_authorised_value;
1378 $other_items->{$key}->{count
}++ if $item->{$hbranch};
1379 $other_items->{$key}->{location
} = $shelflocations->{ $item->{location
} };
1380 $other_items->{$key}->{imageurl
} = getitemtypeimagelocation
( 'opac', $itemtypes{ $item->{itype
} }->{imageurl
} );
1384 $can_place_holds = 1;
1386 $available_items->{$prefix}->{count
}++ if $item->{$hbranch};
1387 foreach (qw(branchname itemcallnumber)) {
1388 $available_items->{$prefix}->{$_} = $item->{$_};
1390 $available_items->{$prefix}->{location
} = $shelflocations->{ $item->{location
} };
1391 $available_items->{$prefix}->{imageurl
} = getitemtypeimagelocation
( 'opac', $itemtypes{ $item->{itype
} }->{imageurl
} );
1394 } # notforloan, item level and biblioitem level
1395 my ( $availableitemscount, $onloanitemscount, $otheritemscount );
1397 ( C4
::Context
->preference('maxItemsinSearchResults') )
1398 ? C4
::Context
->preference('maxItemsinSearchResults') - 1
1400 for my $key ( sort keys %$onloan_items ) {
1401 (++$onloanitemscount > $maxitems) and last;
1402 push @onloan_items_loop, $onloan_items->{$key};
1404 for my $key ( sort keys %$other_items ) {
1405 (++$otheritemscount > $maxitems) and last;
1406 push @other_items_loop, $other_items->{$key};
1408 for my $key ( sort keys %$available_items ) {
1409 (++$availableitemscount > $maxitems) and last;
1410 push @available_items_loop, $available_items->{$key}
1413 # XSLT processing of some stuff
1414 if (C4
::Context
->preference("XSLTResultsDisplay") && !$scan) {
1415 $oldbiblio->{XSLTResultsRecord
} = XSLTParse4Display
(
1416 $oldbiblio->{biblionumber
}, $marcrecord, 'Results' );
1419 # last check for norequest : if itemtype is notforloan, it can't be reserved either, whatever the items
1420 $can_place_holds = 0
1421 if $itemtypes{ $oldbiblio->{itemtype
} }->{notforloan
};
1422 $oldbiblio->{norequests
} = 1 unless $can_place_holds;
1423 $oldbiblio->{itemsplural
} = 1 if $items_count > 1;
1424 $oldbiblio->{items_count
} = $items_count;
1425 $oldbiblio->{available_items_loop
} = \
@available_items_loop;
1426 $oldbiblio->{onloan_items_loop
} = \
@onloan_items_loop;
1427 $oldbiblio->{other_items_loop
} = \
@other_items_loop;
1428 $oldbiblio->{availablecount
} = $available_count;
1429 $oldbiblio->{availableplural
} = 1 if $available_count > 1;
1430 $oldbiblio->{onloancount
} = $onloan_count;
1431 $oldbiblio->{onloanplural
} = 1 if $onloan_count > 1;
1432 $oldbiblio->{othercount
} = $other_count;
1433 $oldbiblio->{otherplural
} = 1 if $other_count > 1;
1434 $oldbiblio->{wthdrawncount
} = $wthdrawn_count;
1435 $oldbiblio->{itemlostcount
} = $itemlost_count;
1436 $oldbiblio->{damagedcount
} = $itemdamaged_count;
1437 $oldbiblio->{intransitcount
} = $item_in_transit_count;
1438 $oldbiblio->{orderedcount
} = $ordered_count;
1439 push( @newresults, $oldbiblio );
1444 #----------------------------------------------------------------------
1446 # Non-Zebra GetRecords#
1447 #----------------------------------------------------------------------
1451 NZgetRecords has the same API as zera getRecords, even if some parameters are not managed
1457 $query, $simple_query, $sort_by_ref, $servers_ref,
1458 $results_per_page, $offset, $expanded_facet, $branches,
1461 warn "query =$query" if $DEBUG;
1462 my $result = NZanalyse
($query);
1463 warn "results =$result" if $DEBUG;
1465 NZorder
( $result, @
$sort_by_ref[0], $results_per_page, $offset ),
1471 NZanalyse : get a CQL string as parameter, and returns a list of biblionumber;title,biblionumber;title,...
1472 the list is built from an inverted index in the nozebra SQL table
1473 note that title is here only for convenience : the sorting will be very fast when requested on title
1474 if the sorting is requested on something else, we will have to reread all results, and that may be longer.
1479 my ( $string, $server ) = @_;
1480 # warn "---------" if $DEBUG;
1481 warn " NZanalyse" if $DEBUG;
1482 # warn "---------" if $DEBUG;
1484 # $server contains biblioserver or authorities, depending on what we search on.
1485 #warn "querying : $string on $server";
1486 $server = 'biblioserver' unless $server;
1488 # if we have a ", replace the content to discard temporarily any and/or/not inside
1490 if ( $string =~ /"/ ) {
1491 $string =~ s/"(.*?)"/__X__/;
1493 warn "commacontent : $commacontent" if $DEBUG;
1496 # split the query string in 3 parts : X AND Y means : $left="X", $operand="AND" and $right="Y"
1497 # then, call again NZanalyse with $left and $right
1498 # (recursive until we find a leaf (=> something without and/or/not)
1499 # delete repeated operator... Would then go in infinite loop
1500 while ( $string =~ s/( and| or| not| AND| OR| NOT)\1/$1/g ) {
1503 #process parenthesis before.
1504 if ( $string =~ /^\s*\((.*)\)(( and | or | not | AND | OR | NOT )(.*))?/ ) {
1507 my $operator = lc($3); # FIXME: and/or/not are operators, not operands
1509 "dealing w/parenthesis before recursive sub call. left :$left operator:$operator right:$right"
1511 my $leftresult = NZanalyse
( $left, $server );
1513 my $rightresult = NZanalyse
( $right, $server );
1515 # OK, we have the results for right and left part of the query
1516 # depending of operand, intersect, union or exclude both lists
1517 # to get a result list
1518 if ( $operator eq ' and ' ) {
1519 return NZoperatorAND
($leftresult,$rightresult);
1521 elsif ( $operator eq ' or ' ) {
1523 # just merge the 2 strings
1524 return $leftresult . $rightresult;
1526 elsif ( $operator eq ' not ' ) {
1527 return NZoperatorNOT
($leftresult,$rightresult);
1531 # this error is impossible, because of the regexp that isolate the operand, but just in case...
1535 warn "string :" . $string if $DEBUG;
1539 if ($string =~ /(.*?)( and | or | not | AND | OR | NOT )(.*)/) {
1542 $operator = lc($2); # FIXME: and/or/not are operators, not operands
1544 warn "no parenthesis. left : $left operator: $operator right: $right"
1547 # it's not a leaf, we have a and/or/not
1550 # reintroduce comma content if needed
1551 $right =~ s/__X__/"$commacontent"/ if $commacontent;
1552 $left =~ s/__X__/"$commacontent"/ if $commacontent;
1553 warn "node : $left / $operator / $right\n" if $DEBUG;
1554 my $leftresult = NZanalyse
( $left, $server );
1555 my $rightresult = NZanalyse
( $right, $server );
1556 warn " leftresult : $leftresult" if $DEBUG;
1557 warn " rightresult : $rightresult" if $DEBUG;
1558 # OK, we have the results for right and left part of the query
1559 # depending of operand, intersect, union or exclude both lists
1560 # to get a result list
1561 if ( $operator eq ' and ' ) {
1563 return NZoperatorAND
($leftresult,$rightresult);
1565 elsif ( $operator eq ' or ' ) {
1567 # just merge the 2 strings
1568 return $leftresult . $rightresult;
1570 elsif ( $operator eq ' not ' ) {
1571 return NZoperatorNOT
($leftresult,$rightresult);
1575 # this error is impossible, because of the regexp that isolate the operand, but just in case...
1576 die "error : operand unknown : $operator for $string";
1579 # it's a leaf, do the real SQL query and return the result
1582 $string =~ s/__X__/"$commacontent"/ if $commacontent;
1583 $string =~ s/-|\.|\?|,|;|!|'|\(|\)|\[|\]|{|}|"|&|\+|\*|\// /g
;
1584 #remove trailing blank at the beginning
1586 warn "leaf:$string" if $DEBUG;
1588 # parse the string in in operator/operand/value again
1592 if ($string =~ /(.*)(>=|<=)(.*)/) {
1599 # warn "handling leaf... left:$left operator:$operator right:$right"
1601 unless ($operator) {
1602 if ($string =~ /(.*)(>|<|=)(.*)/) {
1607 "handling unless (operator)... left:$left operator:$operator right:$right"
1615 # strip adv, zebra keywords, currently not handled in nozebra: wrdl, ext, phr...
1618 # automatic replace for short operators
1619 $left = 'title' if $left =~ '^ti$';
1620 $left = 'author' if $left =~ '^au$';
1621 $left = 'publisher' if $left =~ '^pb$';
1622 $left = 'subject' if $left =~ '^su$';
1623 $left = 'koha-Auth-Number' if $left =~ '^an$';
1624 $left = 'keyword' if $left =~ '^kw$';
1625 $left = 'itemtype' if $left =~ '^mc$'; # Fix for Bug 2599 - Search limits not working for NoZebra
1626 warn "handling leaf... left:$left operator:$operator right:$right" if $DEBUG;
1627 my $dbh = C4
::Context
->dbh;
1628 if ( $operator && $left ne 'keyword' ) {
1629 #do a specific search
1630 $operator = 'LIKE' if $operator eq '=' and $right =~ /%/;
1631 my $sth = $dbh->prepare(
1632 "SELECT biblionumbers,value FROM nozebra WHERE server=? AND indexname=? AND value $operator ?"
1634 warn "$left / $operator / $right\n" if $DEBUG;
1636 # split each word, query the DB and build the biblionumbers result
1637 #sanitizing leftpart
1638 $left =~ s/^\s+|\s+$//;
1639 foreach ( split / /, $right ) {
1641 $_ =~ s/^\s+|\s+$//;
1643 warn "EXECUTE : $server, $left, $_" if $DEBUG;
1644 $sth->execute( $server, $left, $_ )
1645 or warn "execute failed: $!";
1646 while ( my ( $line, $value ) = $sth->fetchrow ) {
1648 # if we are dealing with a numeric value, use only numeric results (in case of >=, <=, > or <)
1649 # otherwise, fill the result
1650 $biblionumbers .= $line
1651 unless ( $right =~ /^\d+$/ && $value =~ /\D/ );
1652 warn "result : $value "
1653 . ( $right =~ /\d/ ) . "=="
1654 . ( $value =~ /\D/?
$line:"" ) if $DEBUG; #= $line";
1657 # do a AND with existing list if there is one, otherwise, use the biblionumbers list as 1st result list
1659 warn "NZAND" if $DEBUG;
1660 $results = NZoperatorAND
($biblionumbers,$results);
1662 $results = $biblionumbers;
1667 #do a complete search (all indexes), if index='kw' do complete search too.
1668 my $sth = $dbh->prepare(
1669 "SELECT biblionumbers FROM nozebra WHERE server=? AND value LIKE ?"
1672 # split each word, query the DB and build the biblionumbers result
1673 foreach ( split / /, $string ) {
1674 next if C4
::Context
->stopwords->{ uc($_) }; # skip if stopword
1675 warn "search on all indexes on $_" if $DEBUG;
1678 $sth->execute( $server, $_ );
1679 while ( my $line = $sth->fetchrow ) {
1680 $biblionumbers .= $line;
1683 # do a AND with existing list if there is one, otherwise, use the biblionumbers list as 1st result list
1685 $results = NZoperatorAND
($biblionumbers,$results);
1688 warn "NEW RES for $_ = $biblionumbers" if $DEBUG;
1689 $results = $biblionumbers;
1693 warn "return : $results for LEAF : $string" if $DEBUG;
1696 warn "---------\nLeave NZanalyse\n---------" if $DEBUG;
1700 my ($rightresult, $leftresult)=@_;
1702 my @leftresult = split /;/, $leftresult;
1703 warn " @leftresult / $rightresult \n" if $DEBUG;
1705 # my @rightresult = split /;/,$leftresult;
1708 # parse the left results, and if the biblionumber exist in the right result, save it in finalresult
1709 # the result is stored twice, to have the same weight for AND than OR.
1710 # example : TWO : 61,61,64,121 (two is twice in the biblio #61) / TOWER : 61,64,130
1711 # result : 61,61,61,61,64,64 for two AND tower : 61 has more weight than 64
1712 foreach (@leftresult) {
1715 ( $value, $countvalue ) = ( $1, $2 ) if ($value=~/(.*)-(\d+)$/);
1716 if ( $rightresult =~ /\Q$value\E-(\d+);/ ) {
1717 $countvalue = ( $1 > $countvalue ?
$countvalue : $1 );
1719 "$value-$countvalue;$value-$countvalue;";
1722 warn "NZAND DONE : $finalresult \n" if $DEBUG;
1723 return $finalresult;
1727 my ($rightresult, $leftresult)=@_;
1728 return $rightresult.$leftresult;
1732 my ($leftresult, $rightresult)=@_;
1734 my @leftresult = split /;/, $leftresult;
1736 # my @rightresult = split /;/,$leftresult;
1738 foreach (@leftresult) {
1740 $value=$1 if $value=~m/(.*)-\d+$/;
1741 unless ($rightresult =~ "$value-") {
1742 $finalresult .= "$_;";
1745 return $finalresult;
1750 $finalresult = NZorder($biblionumbers, $ordering,$results_per_page,$offset);
1757 my ( $biblionumbers, $ordering, $results_per_page, $offset ) = @_;
1758 warn "biblionumbers = $biblionumbers and ordering = $ordering\n" if $DEBUG;
1760 # order title asc by default
1761 # $ordering = '1=36 <i' unless $ordering;
1762 $results_per_page = 20 unless $results_per_page;
1763 $offset = 0 unless $offset;
1764 my $dbh = C4
::Context
->dbh;
1767 # order by POPULARITY
1769 if ( $ordering =~ /popularity/ ) {
1773 # popularity is not in MARC record, it's builded from a specific query
1775 $dbh->prepare("select sum(issues) from items where biblionumber=?");
1776 foreach ( split /;/, $biblionumbers ) {
1777 my ( $biblionumber, $title ) = split /,/, $_;
1778 $result{$biblionumber} = GetMarcBiblio
($biblionumber);
1779 $sth->execute($biblionumber);
1780 my $popularity = $sth->fetchrow || 0;
1782 # hint : the key is popularity.title because we can have
1783 # many results with the same popularity. In this case, sub-ordering is done by title
1784 # we also have biblionumber to avoid bug for 2 biblios with the same title & popularity
1785 # (un-frequent, I agree, but we won't forget anything that way ;-)
1786 $popularity{ sprintf( "%10d", $popularity ) . $title
1787 . $biblionumber } = $biblionumber;
1790 # sort the hash and return the same structure as GetRecords (Zebra querying)
1793 if ( $ordering eq 'popularity_dsc' ) { # sort popularity DESC
1794 foreach my $key ( sort { $b cmp $a } ( keys %popularity ) ) {
1795 $result_hash->{'RECORDS'}[ $numbers++ ] =
1796 $result{ $popularity{$key} }->as_usmarc();
1799 else { # sort popularity ASC
1800 foreach my $key ( sort ( keys %popularity ) ) {
1801 $result_hash->{'RECORDS'}[ $numbers++ ] =
1802 $result{ $popularity{$key} }->as_usmarc();
1805 my $finalresult = ();
1806 $result_hash->{'hits'} = $numbers;
1807 $finalresult->{'biblioserver'} = $result_hash;
1808 return $finalresult;
1814 elsif ( $ordering =~ /author/ ) {
1816 foreach ( split /;/, $biblionumbers ) {
1817 my ( $biblionumber, $title ) = split /,/, $_;
1818 my $record = GetMarcBiblio
($biblionumber);
1820 if ( C4
::Context
->preference('marcflavour') eq 'UNIMARC' ) {
1821 $author = $record->subfield( '200', 'f' );
1822 $author = $record->subfield( '700', 'a' ) unless $author;
1825 $author = $record->subfield( '100', 'a' );
1828 # hint : the result is sorted by title.biblionumber because we can have X biblios with the same title
1829 # and we don't want to get only 1 result for each of them !!!
1830 $result{ $author . $biblionumber } = $record;
1833 # sort the hash and return the same structure as GetRecords (Zebra querying)
1836 if ( $ordering eq 'author_za' ) { # sort by author desc
1837 foreach my $key ( sort { $b cmp $a } ( keys %result ) ) {
1838 $result_hash->{'RECORDS'}[ $numbers++ ] =
1839 $result{$key}->as_usmarc();
1842 else { # sort by author ASC
1843 foreach my $key ( sort ( keys %result ) ) {
1844 $result_hash->{'RECORDS'}[ $numbers++ ] =
1845 $result{$key}->as_usmarc();
1848 my $finalresult = ();
1849 $result_hash->{'hits'} = $numbers;
1850 $finalresult->{'biblioserver'} = $result_hash;
1851 return $finalresult;
1854 # ORDER BY callnumber
1857 elsif ( $ordering =~ /callnumber/ ) {
1859 foreach ( split /;/, $biblionumbers ) {
1860 my ( $biblionumber, $title ) = split /,/, $_;
1861 my $record = GetMarcBiblio
($biblionumber);
1863 my $frameworkcode = GetFrameworkCode
($biblionumber);
1864 my ( $callnumber_tag, $callnumber_subfield ) = GetMarcFromKohaField
( 'items.itemcallnumber', $frameworkcode);
1865 ( $callnumber_tag, $callnumber_subfield ) = GetMarcFromKohaField
('biblioitems.callnumber', $frameworkcode)
1866 unless $callnumber_tag;
1867 if ( C4
::Context
->preference('marcflavour') eq 'UNIMARC' ) {
1868 $callnumber = $record->subfield( '200', 'f' );
1870 $callnumber = $record->subfield( '100', 'a' );
1873 # hint : the result is sorted by title.biblionumber because we can have X biblios with the same title
1874 # and we don't want to get only 1 result for each of them !!!
1875 $result{ $callnumber . $biblionumber } = $record;
1878 # sort the hash and return the same structure as GetRecords (Zebra querying)
1881 if ( $ordering eq 'call_number_dsc' ) { # sort by title desc
1882 foreach my $key ( sort { $b cmp $a } ( keys %result ) ) {
1883 $result_hash->{'RECORDS'}[ $numbers++ ] =
1884 $result{$key}->as_usmarc();
1887 else { # sort by title ASC
1888 foreach my $key ( sort { $a cmp $b } ( keys %result ) ) {
1889 $result_hash->{'RECORDS'}[ $numbers++ ] =
1890 $result{$key}->as_usmarc();
1893 my $finalresult = ();
1894 $result_hash->{'hits'} = $numbers;
1895 $finalresult->{'biblioserver'} = $result_hash;
1896 return $finalresult;
1898 elsif ( $ordering =~ /pubdate/ ) { #pub year
1900 foreach ( split /;/, $biblionumbers ) {
1901 my ( $biblionumber, $title ) = split /,/, $_;
1902 my $record = GetMarcBiblio
($biblionumber);
1903 my ( $publicationyear_tag, $publicationyear_subfield ) =
1904 GetMarcFromKohaField
( 'biblioitems.publicationyear', '' );
1905 my $publicationyear =
1906 $record->subfield( $publicationyear_tag,
1907 $publicationyear_subfield );
1909 # hint : the result is sorted by title.biblionumber because we can have X biblios with the same title
1910 # and we don't want to get only 1 result for each of them !!!
1911 $result{ $publicationyear . $biblionumber } = $record;
1914 # sort the hash and return the same structure as GetRecords (Zebra querying)
1917 if ( $ordering eq 'pubdate_dsc' ) { # sort by pubyear desc
1918 foreach my $key ( sort { $b cmp $a } ( keys %result ) ) {
1919 $result_hash->{'RECORDS'}[ $numbers++ ] =
1920 $result{$key}->as_usmarc();
1923 else { # sort by pub year ASC
1924 foreach my $key ( sort ( keys %result ) ) {
1925 $result_hash->{'RECORDS'}[ $numbers++ ] =
1926 $result{$key}->as_usmarc();
1929 my $finalresult = ();
1930 $result_hash->{'hits'} = $numbers;
1931 $finalresult->{'biblioserver'} = $result_hash;
1932 return $finalresult;
1938 elsif ( $ordering =~ /title/ ) {
1940 # the title is in the biblionumbers string, so we just need to build a hash, sort it and return
1942 foreach ( split /;/, $biblionumbers ) {
1943 my ( $biblionumber, $title ) = split /,/, $_;
1945 # hint : the result is sorted by title.biblionumber because we can have X biblios with the same title
1946 # and we don't want to get only 1 result for each of them !!!
1947 # hint & speed improvement : we can order without reading the record
1948 # so order, and read records only for the requested page !
1949 $result{ $title . $biblionumber } = $biblionumber;
1952 # sort the hash and return the same structure as GetRecords (Zebra querying)
1955 if ( $ordering eq 'title_az' ) { # sort by title desc
1956 foreach my $key ( sort ( keys %result ) ) {
1957 $result_hash->{'RECORDS'}[ $numbers++ ] = $result{$key};
1960 else { # sort by title ASC
1961 foreach my $key ( sort { $b cmp $a } ( keys %result ) ) {
1962 $result_hash->{'RECORDS'}[ $numbers++ ] = $result{$key};
1966 # limit the $results_per_page to result size if it's more
1967 $results_per_page = $numbers - 1 if $numbers < $results_per_page;
1969 # for the requested page, replace biblionumber by the complete record
1970 # speed improvement : avoid reading too much things
1972 my $counter = $offset ;
1973 $counter <= $offset + $results_per_page ;
1977 $result_hash->{'RECORDS'}[$counter] =
1978 GetMarcBiblio
( $result_hash->{'RECORDS'}[$counter] )->as_usmarc;
1980 my $finalresult = ();
1981 $result_hash->{'hits'} = $numbers;
1982 $finalresult->{'biblioserver'} = $result_hash;
1983 return $finalresult;
1990 # we need 2 hashes to order by ranking : the 1st one to count the ranking, the 2nd to order by ranking
1993 foreach ( split /;/, $biblionumbers ) {
1994 my ( $biblionumber, $title ) = split /,/, $_;
1995 $title =~ /(.*)-(\d)/;
2000 # note that we + the ranking because ranking is calculated on weight of EACH term requested.
2001 # if we ask for "two towers", and "two" has weight 2 in biblio N, and "towers" has weight 4 in biblio N
2002 # biblio N has ranking = 6
2003 $count_ranking{$biblionumber} += $ranking;
2006 # build the result by "inverting" the count_ranking hash
2007 # 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
2009 foreach ( keys %count_ranking ) {
2010 $result{ sprintf( "%10d", $count_ranking{$_} ) . '-' . $_ } = $_;
2013 # sort the hash and return the same structure as GetRecords (Zebra querying)
2016 foreach my $key ( sort { $b cmp $a } ( keys %result ) ) {
2017 $result_hash->{'RECORDS'}[ $numbers++ ] = $result{$key};
2020 # limit the $results_per_page to result size if it's more
2021 $results_per_page = $numbers - 1 if $numbers < $results_per_page;
2023 # for the requested page, replace biblionumber by the complete record
2024 # speed improvement : avoid reading too much things
2026 my $counter = $offset ;
2027 $counter <= $offset + $results_per_page ;
2031 $result_hash->{'RECORDS'}[$counter] =
2032 GetMarcBiblio
( $result_hash->{'RECORDS'}[$counter] )->as_usmarc
2033 if $result_hash->{'RECORDS'}[$counter];
2035 my $finalresult = ();
2036 $result_hash->{'hits'} = $numbers;
2037 $finalresult->{'biblioserver'} = $result_hash;
2038 return $finalresult;
2042 =head2 enabled_staff_search_views
2044 %hash = enabled_staff_search_views()
2046 This function returns a hash that contains three flags obtained from the system
2047 preferences, used to determine whether a particular staff search results view
2052 =item C<Output arg:>
2054 * $hash{can_view_MARC} is true only if the MARC view is enabled
2055 * $hash{can_view_ISBD} is true only if the ISBD view is enabled
2056 * $hash{can_view_labeledMARC} is true only if the Labeled MARC view is enabled
2058 =item C<usage in the script:>
2062 $template->param ( C4::Search::enabled_staff_search_views );
2066 sub enabled_staff_search_views
2069 can_view_MARC
=> C4
::Context
->preference('viewMARC'), # 1 if the staff search allows the MARC view
2070 can_view_ISBD
=> C4
::Context
->preference('viewISBD'), # 1 if the staff search allows the ISBD view
2071 can_view_labeledMARC
=> C4
::Context
->preference('viewLabeledMARC'), # 1 if the staff search allows the Labeled MARC view
2075 sub AddSearchHistory
{
2076 my ($borrowernumber,$session,$query_desc,$query_cgi, $total)=@_;
2077 my $dbh = C4
::Context
->dbh;
2079 # Add the request the user just made
2080 my $sql = "INSERT INTO search_history(userid, sessionid, query_desc, query_cgi, total, time) VALUES(?, ?, ?, ?, ?, NOW())";
2081 my $sth = $dbh->prepare($sql);
2082 $sth->execute($borrowernumber, $session, $query_desc, $query_cgi, $total);
2083 return $dbh->last_insert_id(undef, 'search_history', undef,undef,undef);
2086 sub GetSearchHistory
{
2087 my ($borrowernumber,$session)=@_;
2088 my $dbh = C4
::Context
->dbh;
2090 # Add the request the user just made
2091 my $query = "SELECT FROM search_history WHERE (userid=? OR sessionid=?)";
2092 my $sth = $dbh->prepare($query);
2093 $sth->execute($borrowernumber, $session);
2094 return $sth->fetchall_hashref({});
2097 =head2 z3950_search_args
2099 $arrayref = z3950_search_args($matchpoints)
2101 This function returns an array reference that contains the search parameters to be
2102 passed to the Z39.50 search script (z3950_search.pl). The array elements
2103 are hash refs whose keys are name, value and encvalue, and whose values are the
2104 name of a search parameter, the value of that search parameter and the URL encoded
2105 value of that parameter.
2107 The search parameter names are lccn, isbn, issn, title, author, dewey and subject.
2109 The search parameter values are obtained from the bibliographic record whose
2110 data is in a hash reference in $matchpoints, as returned by Biblio::GetBiblioData().
2112 If $matchpoints is a scalar, it is assumed to be an unnamed query descriptor, e.g.
2113 a general purpose search argument. In this case, the returned array contains only
2114 entry: the key is 'title' and the value and encvalue are derived from $matchpoints.
2116 If a search parameter value is undefined or empty, it is not included in the returned
2119 The returned array reference may be passed directly to the template parameters.
2123 =item C<Output arg:>
2125 * $array containing hash refs as described above
2127 =item C<usage in the script:>
2131 $data = Biblio::GetBiblioData($bibno);
2132 $template->param ( MYLOOP => C4::Search::z3950_search_args($data) )
2136 $template->param ( MYLOOP => C4::Search::z3950_search_args($searchscalar) )
2140 sub z3950_search_args
{
2142 $bibrec = { title
=> $bibrec } if !ref $bibrec;
2144 for my $field (qw
/ lccn isbn issn title author dewey subject /)
2146 my $encvalue = URI
::Escape
::uri_escape_utf8
($bibrec->{$field});
2147 push @
$array, { name
=>$field, value
=>$bibrec->{$field}, encvalue
=>$encvalue } if defined $bibrec->{$field};
2152 =head2 BiblioAddAuthorities
2154 ( $countlinked, $countcreated ) = BiblioAddAuthorities($record, $frameworkcode);
2156 this function finds the authorities linked to the biblio
2157 * search in the authority DB for the same authid (in $9 of the biblio)
2158 * search in the authority DB for the same 001 (in $3 of the biblio in UNIMARC)
2159 * search in the authority DB for the same values (exactly) (in all subfields of the biblio)
2160 OR adds a new authority record
2166 * $record is the MARC record in question (marc blob)
2167 * $frameworkcode is the bibliographic framework to use (if it is "" it uses the default framework)
2169 =item C<Output arg:>
2171 * $countlinked is the number of authorities records that are linked to this authority
2175 * 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)
2181 sub BiblioAddAuthorities
{
2182 my ( $record, $frameworkcode ) = @_;
2183 my $dbh=C4
::Context
->dbh;
2184 my $query=$dbh->prepare(qq|
2185 SELECT authtypecode
,tagfield
2186 FROM marc_subfield_structure
2187 WHERE frameworkcode
=?
2188 AND
(authtypecode IS NOT NULL AND authtypecode
<>\"\")|);
2189 # SELECT authtypecode,tagfield
2190 # FROM marc_subfield_structure
2191 # WHERE frameworkcode=?
2192 # AND (authtypecode IS NOT NULL OR authtypecode<>\"\")|);
2193 $query->execute($frameworkcode);
2194 my ($countcreated,$countlinked);
2195 while (my $data=$query->fetchrow_hashref){
2196 foreach my $field ($record->field($data->{tagfield
})){
2197 next if ($field->subfield('3')||$field->subfield('9'));
2198 # No authorities id in the tag.
2199 # Search if there is any authorities to link to.
2200 my $query='at='.$data->{authtypecode
}.' ';
2201 map {$query.= ' and he,ext="'.$_->[1].'"' if ($_->[0]=~/[A-z]/)} $field->subfields();
2202 my ($error, $results, $total_hits)=SimpleSearch
( $query, undef, undef, [ "authorityserver" ] );
2203 # there is only 1 result
2205 warn "BIBLIOADDSAUTHORITIES: $error";
2208 if ($results && scalar(@
$results)==1) {
2209 my $marcrecord = MARC
::File
::USMARC
::decode
($results->[0]);
2210 $field->add_subfields('9'=>$marcrecord->field('001')->data);
2212 } elsif (scalar(@
$results)>1) {
2213 #More than One result
2214 #This can comes out of a lack of a subfield.
2215 # my $marcrecord = MARC::File::USMARC::decode($results->[0]);
2216 # $record->field($data->{tagfield})->add_subfields('9'=>$marcrecord->field('001')->data);
2219 #There are no results, build authority record, add it to Authorities, get authid and add it to 9
2220 ###NOTICE : This is only valid if a subfield is linked to one and only one authtypecode
2221 ###NOTICE : This can be a problem. We should also look into other types and rejected forms.
2222 my $authtypedata=C4
::AuthoritiesMarc
->GetAuthType($data->{authtypecode
});
2223 next unless $authtypedata;
2224 my $marcrecordauth=MARC
::Record
->new();
2225 my $authfield=MARC
::Field
->new($authtypedata->{auth_tag_to_report
},'','',"a"=>"".$field->subfield('a'));
2226 map { $authfield->add_subfields($_->[0]=>$_->[1]) if ($_->[0]=~/[A-z]/ && $_->[0] ne "a" )} $field->subfields();
2227 $marcrecordauth->insert_fields_ordered($authfield);
2229 # bug 2317: ensure new authority knows it's using UTF-8; currently
2230 # only need to do this for MARC21, as MARC::Record->as_xml_record() handles
2231 # automatically for UNIMARC (by not transcoding)
2232 # FIXME: AddAuthority() instead should simply explicitly require that the MARC::Record
2233 # use UTF-8, but as of 2008-08-05, did not want to introduce that kind
2234 # of change to a core API just before the 3.0 release.
2235 if (C4
::Context
->preference('marcflavour') eq 'MARC21') {
2236 SetMarcUnicodeFlag
($marcrecordauth, 'MARC21');
2239 # warn "AUTH RECORD ADDED : ".$marcrecordauth->as_formatted;
2241 my $authid=AddAuthority
($marcrecordauth,'',$data->{authtypecode
});
2243 $field->add_subfields('9'=>$authid);
2247 return ($countlinked,$countcreated);
2250 =head2 GetDistinctValues($field);
2252 C<$field> is a reference to the fields array
2256 sub GetDistinctValues
{
2257 my ($fieldname,$string)=@_;
2258 # returns a reference to a hash of references to branches...
2259 if ($fieldname=~/\./){
2260 my ($table,$column)=split /\./, $fieldname;
2261 my $dbh = C4
::Context
->dbh;
2262 warn "select DISTINCT($column) as value, count(*) as cnt from $table group by lib order by $column ";
2263 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 ");
2265 my $elements=$sth->fetchall_arrayref({});
2270 my @servers=qw
<biblioserver authorityserver
>;
2271 my (@zconns,@results);
2272 for ( my $i = 0 ; $i < @servers ; $i++ ) {
2273 $zconns[$i] = C4
::Context
->Zconn( $servers[$i], 1 );
2276 ZOOM
::Query
::CCL2RPN
->new( qq"$fieldname $string", $zconns[$i])
2279 # The big moment: asynchronously retrieve results from all servers
2281 while ( ( my $i = ZOOM
::event
( \
@zconns ) ) != 0 ) {
2282 my $ev = $zconns[ $i - 1 ]->last_event();
2283 if ( $ev == ZOOM
::Event
::ZEND
) {
2284 next unless $results[ $i - 1 ];
2285 my $size = $results[ $i - 1 ]->size();
2287 for (my $j=0;$j<$size;$j++){
2289 @hashscan{qw(value cnt)}=$results[ $i - 1 ]->display_term($j);
2290 push @elements, \
%hashscan;
2299 END { } # module clean-up code here (global destructor)
2306 Koha Developement team <info@koha.org>