← Index
Performance Profile   « block view • line view • sub view »
For opac/opac-main.pl
  Run on Mon Aug 24 11:28:47 2009
Reported on Mon Aug 24 11:29:13 2009

File /home/chris/git/koha.git/C4/Search.pm
Statements Executed 44
Total Time 0.0126526 seconds
Subroutines — ordered by exclusive time
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
0000s0sC4::Search::::BEGINC4::Search::BEGIN
0000s0sC4::Search::::ENDC4::Search::END
0000s0sC4::Search::::FindDuplicateC4::Search::FindDuplicate
0000s0sC4::Search::::NZanalyseC4::Search::NZanalyse
0000s0sC4::Search::::NZgetRecordsC4::Search::NZgetRecords
0000s0sC4::Search::::NZoperatorANDC4::Search::NZoperatorAND
0000s0sC4::Search::::NZoperatorNOTC4::Search::NZoperatorNOT
0000s0sC4::Search::::NZoperatorORC4::Search::NZoperatorOR
0000s0sC4::Search::::NZorderC4::Search::NZorder
0000s0sC4::Search::::SimpleSearchC4::Search::SimpleSearch
0000s0sC4::Search::::_build_stemmed_operandC4::Search::_build_stemmed_operand
0000s0sC4::Search::::_build_weighted_queryC4::Search::_build_weighted_query
0000s0sC4::Search::::_detect_truncationC4::Search::_detect_truncation
0000s0sC4::Search::::_remove_stopwordsC4::Search::_remove_stopwords
0000s0sC4::Search::::buildQueryC4::Search::buildQuery
0000s0sC4::Search::::enabled_staff_search_viewsC4::Search::enabled_staff_search_views
0000s0sC4::Search::::getRecordsC4::Search::getRecords
0000s0sC4::Search::::pazGetRecordsC4::Search::pazGetRecords
0000s0sC4::Search::::searchResultsC4::Search::searchResults
0000s0sC4::Search::::z3950_search_argsC4::Search::z3950_search_args
LineStmts.Exclusive
Time		Avg.Code
1package C4::Search;
2
3# This file is part of Koha.
4#
5# Koha is free software; you can redistribute it and/or modify it under the
6# terms of the GNU General Public License as published by the Free Software
7# Foundation; either version 2 of the License, or (at your option) any later
8# version.
9#
10# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
11# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
12# A PARTICULAR PURPOSE. See the GNU General Public License for more details.
13#
14# You should have received a copy of the GNU General Public License along with
15# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
16# Suite 330, Boston, MA 02111-1307 USA
17
18334µs11µsuse strict;
# spent 9µs making 1 call to strict::import
19# use warnings; # FIXME
2012µs2µsrequire Exporter;
21327µs9µsuse C4::Context;
# spent 7µs making 1 call to C4::Context::import
22331µs10µsuse C4::Biblio; # GetMarcFromKohaField, GetBiblioData
# spent 383µs making 1 call to Exporter::import
23330µs10µsuse C4::Koha; # getFacets
# spent 298µs making 1 call to Exporter::import
243135µs45µsuse Lingua::Stem;
# spent 42µs making 1 call to Exporter::import
253259µs86µsuse C4::Search::PazPar2;
# spent 8µs making 1 call to UNIVERSAL::import
26332µs11µsuse XML::Simple;
# spent 14µs making 1 call to XML::Simple::import
27333µs11µsuse C4::Dates qw(format_date);
# spent 38µs making 1 call to Exporter::import
283226µs75µsuse C4::XSLT;
# spent 100µs making 1 call to Exporter::import
29330µs10µsuse C4::Branch;
# spent 181µs making 1 call to Exporter::import
30341µs14µsuse URI::Escape;
# spent 46µs making 1 call to Exporter::import
31
32346µs15µsuse vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $DEBUG);
# spent 65µs making 1 call to vars::import
33
34# set the version for version checking
35BEGIN {
361500ns500ns $VERSION = 3.01;
3711µs1µs $DEBUG = ($ENV{DEBUG}) ? 1 : 0;
38111.7ms11.7ms}
39
40=head1 NAME
41
42C4::Search - Functions for searching the Koha catalog.
43
44=head1 SYNOPSIS
45
46See opac/opac-search.pl or catalogue/search.pl for example of usage
47
48=head1 DESCRIPTION
49
50This module provides searching functions for Koha's bibliographic databases
51
52=head1 FUNCTIONS
53
54=cut
55
56113µs13µs@ISA = qw(Exporter);
5713µs3µs@EXPORT = qw(
58 &FindDuplicate
59 &SimpleSearch
60 &searchResults
61 &getRecords
62 &buildQuery
63 &NZgetRecords
64);
65
66# make all your functions, whether exported or not;
67
68=head2 FindDuplicate
69
70($biblionumber,$biblionumber,$title) = FindDuplicate($record);
71
72This function attempts to find duplicate records using a hard-coded, fairly simplistic algorithm
73
74=cut
75
76sub FindDuplicate {
77 my ($record) = @_;
78 my $dbh = C4::Context->dbh;
79 my $result = TransformMarcToKoha( $dbh, $record, '' );
80 my $sth;
81 my $query;
82 my $search;
83 my $type;
84 my ( $biblionumber, $title );
85
86 # search duplicate on ISBN, easy and fast..
87 # ... normalize first
88 if ( $result->{isbn} ) {
89 $result->{isbn} =~ s/\(.*$//;
90 $result->{isbn} =~ s/\s+$//;
91 $query = "isbn=$result->{isbn}";
92 }
93 else {
94 $result->{title} =~ s /\\//g;
95 $result->{title} =~ s /\"//g;
96 $result->{title} =~ s /\(//g;
97 $result->{title} =~ s /\)//g;
98
99 # FIXME: instead of removing operators, could just do
100 # quotes around the value
101 $result->{title} =~ s/(and|or|not)//g;
102 $query = "ti,ext=$result->{title}";
103 $query .= " and itemtype=$result->{itemtype}"
104 if ( $result->{itemtype} );
105 if ( $result->{author} ) {
106 $result->{author} =~ s /\\//g;
107 $result->{author} =~ s /\"//g;
108 $result->{author} =~ s /\(//g;
109 $result->{author} =~ s /\)//g;
110
111 # remove valid operators
112 $result->{author} =~ s/(and|or|not)//g;
113 $query .= " and au,ext=$result->{author}";
114 }
115 }
116
117 # FIXME: add error handling
118 my ( $error, $searchresults ) = SimpleSearch($query); # FIXME :: hardcoded !
119 my @results;
120 foreach my $possible_duplicate_record (@$searchresults) {
121 my $marcrecord =
122 MARC::Record->new_from_usmarc($possible_duplicate_record);
123 my $result = TransformMarcToKoha( $dbh, $marcrecord, '' );
124
125 # FIXME :: why 2 $biblionumber ?
126 if ($result) {
127 push @results, $result->{'biblionumber'};
128 push @results, $result->{'title'};
129 }
130 }
131 return @results;
132}
133
134=head2 SimpleSearch
135
136( $error, $results, $total_hits ) = SimpleSearch( $query, $offset, $max_results, [@servers] );
137
138This function provides a simple search API on the bibliographic catalog
139
140=over 2
141
142=item C<input arg:>
143
144 * $query can be a simple keyword or a complete CCL query
145 * @servers is optional. Defaults to biblioserver as found in koha-conf.xml
146 * $offset - If present, represents the number of records at the beggining to omit. Defaults to 0
147 * $max_results - if present, determines the maximum number of records to fetch. undef is All. defaults to undef.
148
149
150=item C<Output:>
151
152 * $error is a empty unless an error is detected
153 * \@results is an array of records.
154 * $total_hits is the number of hits that would have been returned with no limit
155
156=item C<usage in the script:>
157
158=back
159
160my ( $error, $marcresults, $total_hits ) = SimpleSearch($query);
161
162if (defined $error) {
163 $template->param(query_error => $error);
164 warn "error: ".$error;
165 output_html_with_http_headers $input, $cookie, $template->output;
166 exit;
167}
168
169my $hits = scalar @$marcresults;
170my @results;
171
172for my $i (0..$hits) {
173 my %resultsloop;
174 my $marcrecord = MARC::File::USMARC::decode($marcresults->[$i]);
175 my $biblio = TransformMarcToKoha(C4::Context->dbh,$marcrecord,'');
176
177 #build the hash for the template.
178 $resultsloop{title} = $biblio->{'title'};
179 $resultsloop{subtitle} = $biblio->{'subtitle'};
180 $resultsloop{biblionumber} = $biblio->{'biblionumber'};
181 $resultsloop{author} = $biblio->{'author'};
182 $resultsloop{publishercode} = $biblio->{'publishercode'};
183 $resultsloop{publicationyear} = $biblio->{'publicationyear'};
184
185 push @results, \%resultsloop;
186}
187
188$template->param(result=>\@results);
189
190=cut
191
192sub SimpleSearch {
193 my ( $query, $offset, $max_results, $servers ) = @_;
194
195 if ( C4::Context->preference('NoZebra') ) {
196 my $result = NZorder( NZanalyse($query) )->{'biblioserver'};
197 my $search_result =
198 ( $result->{hits}
199 && $result->{hits} > 0 ? $result->{'RECORDS'} : [] );
200 return ( undef, $search_result, scalar($result->{hits}) );
201 }
202 else {
203 # FIXME hardcoded value. See catalog/search.pl & opac-search.pl too.
204 my @servers = defined ( $servers ) ? @$servers : ( "biblioserver" );
205 my @results;
206 my @zoom_queries;
207 my @tmpresults;
208 my @zconns;
209 my $total_hits;
210 return ( "No query entered", undef, undef ) unless $query;
211
212 # Initialize & Search Zebra
213 for ( my $i = 0 ; $i < @servers ; $i++ ) {
214 eval {
215 $zconns[$i] = C4::Context->Zconn( $servers[$i], 1 );
216 $zoom_queries[$i] = new ZOOM::Query::CCL2RPN( $query, $zconns[$i]);
217 $tmpresults[$i] = $zconns[$i]->search( $zoom_queries[$i] );
218
219 # error handling
220 my $error =
221 $zconns[$i]->errmsg() . " ("
222 . $zconns[$i]->errcode() . ") "
223 . $zconns[$i]->addinfo() . " "
224 . $zconns[$i]->diagset();
225
226 return ( $error, undef, undef ) if $zconns[$i]->errcode();
227 };
228 if ($@) {
229
230 # caught a ZOOM::Exception
231 my $error =
232 $@->message() . " ("
233 . $@->code() . ") "
234 . $@->addinfo() . " "
235 . $@->diagset();
236 warn $error;
237 return ( $error, undef, undef );
238 }
239 }
240 while ( ( my $i = ZOOM::event( \@zconns ) ) != 0 ) {
241 my $event = $zconns[ $i - 1 ]->last_event();
242 if ( $event == ZOOM::Event::ZEND ) {
243
244 my $first_record = defined( $offset ) ? $offset+1 : 1;
245 my $hits = $tmpresults[ $i - 1 ]->size();
246 $total_hits += $hits;
247 my $last_record = $hits;
248 if ( defined $max_results && $offset + $max_results < $hits ) {
249 $last_record = $offset + $max_results;
250 }
251
252 for my $j ( $first_record..$last_record ) {
253 my $record = $tmpresults[ $i - 1 ]->record( $j-1 )->raw(); # 0 indexed
254 push @results, $record;
255 }
256 }
257 }
258
259 foreach my $result (@tmpresults) {
260 $result->destroy();
261 }
262 foreach my $zoom_query (@zoom_queries) {
263 $zoom_query->destroy();
264 }
265
266 return ( undef, \@results, $total_hits );
267 }
268}
269
270=head2 getRecords
271
272( undef, $results_hashref, \@facets_loop ) = getRecords (
273
274 $koha_query, $simple_query, $sort_by_ref, $servers_ref,
275 $results_per_page, $offset, $expanded_facet, $branches,
276 $query_type, $scan
277 );
278
279The all singing, all dancing, multi-server, asynchronous, scanning,
280searching, record nabbing, facet-building
281
282See verbse embedded documentation.
283
284=cut
285
286sub getRecords {
287 my (
288 $koha_query, $simple_query, $sort_by_ref, $servers_ref,
289 $results_per_page, $offset, $expanded_facet, $branches,
290 $query_type, $scan
291 ) = @_;
292
293 my @servers = @$servers_ref;
294 my @sort_by = @$sort_by_ref;
295
296 # Initialize variables for the ZOOM connection and results object
297 my $zconn;
298 my @zconns;
299 my @results;
300 my $results_hashref = ();
301
302 # Initialize variables for the faceted results objects
303 my $facets_counter = ();
304 my $facets_info = ();
305 my $facets = getFacets();
306
307 my @facets_loop; # stores the ref to array of hashes for template facets loop
308
309 ### LOOP THROUGH THE SERVERS
310 for ( my $i = 0 ; $i < @servers ; $i++ ) {
311 $zconns[$i] = C4::Context->Zconn( $servers[$i], 1 );
312
313# perform the search, create the results objects
314# if this is a local search, use the $koha-query, if it's a federated one, use the federated-query
315 my $query_to_use = ($servers[$i] =~ /biblioserver/) ? $koha_query : $simple_query;
316
317 #$query_to_use = $simple_query if $scan;
318 warn $simple_query if ( $scan and $DEBUG );
319
320 # Check if we've got a query_type defined, if so, use it
321 eval {
322 if ($query_type) {
323 if ($query_type =~ /^ccl/) {
324 $query_to_use =~ s/\:/\=/g; # change : to = last minute (FIXME)
325 $results[$i] = $zconns[$i]->search(new ZOOM::Query::CCL2RPN($query_to_use, $zconns[$i]));
326 } elsif ($query_type =~ /^cql/) {
327 $results[$i] = $zconns[$i]->search(new ZOOM::Query::CQL($query_to_use, $zconns[$i]));
328 } elsif ($query_type =~ /^pqf/) {
329 $results[$i] = $zconns[$i]->search(new ZOOM::Query::PQF($query_to_use, $zconns[$i]));
330 } else {
331 warn "Unknown query_type '$query_type'. Results undetermined.";
332 }
333 } elsif ($scan) {
334 $results[$i] = $zconns[$i]->scan( new ZOOM::Query::CCL2RPN($query_to_use, $zconns[$i]));
335 } else {
336 $results[$i] = $zconns[$i]->search(new ZOOM::Query::CCL2RPN($query_to_use, $zconns[$i]));
337 }
338 };
339 if ($@) {
340 warn "WARNING: query problem with $query_to_use " . $@;
341 }
342
343 # Concatenate the sort_by limits and pass them to the results object
344 # Note: sort will override rank
345 my $sort_by;
346 foreach my $sort (@sort_by) {
347 if ( $sort eq "author_az" ) {
348 $sort_by .= "1=1003 <i ";
349 }
350 elsif ( $sort eq "author_za" ) {
351 $sort_by .= "1=1003 >i ";
352 }
353 elsif ( $sort eq "popularity_asc" ) {
354 $sort_by .= "1=9003 <i ";
355 }
356 elsif ( $sort eq "popularity_dsc" ) {
357 $sort_by .= "1=9003 >i ";
358 }
359 elsif ( $sort eq "call_number_asc" ) {
360 $sort_by .= "1=20 <i ";
361 }
362 elsif ( $sort eq "call_number_dsc" ) {
363 $sort_by .= "1=20 >i ";
364 }
365 elsif ( $sort eq "pubdate_asc" ) {
366 $sort_by .= "1=31 <i ";
367 }
368 elsif ( $sort eq "pubdate_dsc" ) {
369 $sort_by .= "1=31 >i ";
370 }
371 elsif ( $sort eq "acqdate_asc" ) {
372 $sort_by .= "1=32 <i ";
373 }
374 elsif ( $sort eq "acqdate_dsc" ) {
375 $sort_by .= "1=32 >i ";
376 }
377 elsif ( $sort eq "title_az" ) {
378 $sort_by .= "1=4 <i ";
379 }
380 elsif ( $sort eq "title_za" ) {
381 $sort_by .= "1=4 >i ";
382 }
383 else {
384 warn "Ignoring unrecognized sort '$sort' requested" if $sort_by;
385 }
386 }
387 if ($sort_by) {
388 if ( $results[$i]->sort( "yaz", $sort_by ) < 0 ) {
389 warn "WARNING sort $sort_by failed";
390 }
391 }
392 } # finished looping through servers
393
394 # The big moment: asynchronously retrieve results from all servers
395 while ( ( my $i = ZOOM::event( \@zconns ) ) != 0 ) {
396 my $ev = $zconns[ $i - 1 ]->last_event();
397 if ( $ev == ZOOM::Event::ZEND ) {
398 next unless $results[ $i - 1 ];
399 my $size = $results[ $i - 1 ]->size();
400 if ( $size > 0 ) {
401 my $results_hash;
402
403 # loop through the results
404 $results_hash->{'hits'} = $size;
405 my $times;
406 if ( $offset + $results_per_page <= $size ) {
407 $times = $offset + $results_per_page;
408 }
409 else {
410 $times = $size;
411 }
412 for ( my $j = $offset ; $j < $times ; $j++ ) {
413 my $records_hash;
414 my $record;
415 my $facet_record;
416
417 ## Check if it's an index scan
418 if ($scan) {
419 my ( $term, $occ ) = $results[ $i - 1 ]->term($j);
420
421 # here we create a minimal MARC record and hand it off to the
422 # template just like a normal result ... perhaps not ideal, but
423 # it works for now
424 my $tmprecord = MARC::Record->new();
425 $tmprecord->encoding('UTF-8');
426 my $tmptitle;
427 my $tmpauthor;
428
429 # the minimal record in author/title (depending on MARC flavour)
430 if (C4::Context->preference("marcflavour") eq "UNIMARC") {
431 $tmptitle = MARC::Field->new('200',' ',' ', a => $term, f => $occ);
432 $tmprecord->append_fields($tmptitle);
433 } else {
434 $tmptitle = MARC::Field->new('245',' ',' ', a => $term,);
435 $tmpauthor = MARC::Field->new('100',' ',' ', a => $occ,);
436 $tmprecord->append_fields($tmptitle);
437 $tmprecord->append_fields($tmpauthor);
438 }
439 $results_hash->{'RECORDS'}[$j] = $tmprecord->as_usmarc();
440 }
441
442 # not an index scan
443 else {
444 $record = $results[ $i - 1 ]->record($j)->raw();
445
446 # warn "RECORD $j:".$record;
447 $results_hash->{'RECORDS'}[$j] = $record;
448
449 # Fill the facets while we're looping, but only for the biblioserver
450 $facet_record = MARC::Record->new_from_usmarc($record)
451 if $servers[ $i - 1 ] =~ /biblioserver/;
452
453 #warn $servers[$i-1]."\n".$record; #.$facet_record->title();
454 if ($facet_record) {
455 for ( my $k = 0 ; $k <= @$facets ; $k++ ) {
456 ($facets->[$k]) or next;
457 my @fields = map {$facet_record->field($_)} @{$facets->[$k]->{'tags'}} ;
458 for my $field (@fields) {
459 my @subfields = $field->subfields();
460 for my $subfield (@subfields) {
461 my ( $code, $data ) = @$subfield;
462 ($code eq $facets->[$k]->{'subfield'}) or next;
463 $facets_counter->{ $facets->[$k]->{'link_value'} }->{$data}++;
464 }
465 }
466 $facets_info->{ $facets->[$k]->{'link_value'} }->{'label_value'} =
467 $facets->[$k]->{'label_value'};
468 $facets_info->{ $facets->[$k]->{'link_value'} }->{'expanded'} =
469 $facets->[$k]->{'expanded'};
470 }
471 }
472 }
473 }
474 $results_hashref->{ $servers[ $i - 1 ] } = $results_hash;
475 }
476
477 # warn "connection ", $i-1, ": $size hits";
478 # warn $results[$i-1]->record(0)->render() if $size > 0;
479
480 # BUILD FACETS
481 if ( $servers[ $i - 1 ] =~ /biblioserver/ ) {
482 for my $link_value (
483 sort { $facets_counter->{$b} <=> $facets_counter->{$a} }
484 keys %$facets_counter )
485 {
486 my $expandable;
487 my $number_of_facets;
488 my @this_facets_array;
489 for my $one_facet (
490 sort {
491 $facets_counter->{$link_value}->{$b}
492 <=> $facets_counter->{$link_value}->{$a}
493 } keys %{ $facets_counter->{$link_value} }
494 )
495 {
496 $number_of_facets++;
497 if ( ( $number_of_facets < 6 )
498 || ( $expanded_facet eq $link_value )
499 || ( $facets_info->{$link_value}->{'expanded'} ) )
500 {
501
502 # Sanitize the link value ), ( will cause errors with CCL,
503 my $facet_link_value = $one_facet;
504 $facet_link_value =~ s/(\(|\))/ /g;
505
506 # fix the length that will display in the label,
507 my $facet_label_value = $one_facet;
508 $facet_label_value =
509 substr( $one_facet, 0, 20 ) . "..."
510 unless length($facet_label_value) <= 20;
511
512 # if it's a branch, label by the name, not the code,
513 if ( $link_value =~ /branch/ ) {
514 $facet_label_value =
515 $branches->{$one_facet}->{'branchname'};
516 }
517
518 # but we're down with the whole label being in the link's title.
519 push @this_facets_array, {
520 facet_count => $facets_counter->{$link_value}->{$one_facet},
521 facet_label_value => $facet_label_value,
522 facet_title_value => $one_facet,
523 facet_link_value => $facet_link_value,
524 type_link_value => $link_value,
525 };
526 }
527 }
528
529 # handle expanded option
530 unless ( $facets_info->{$link_value}->{'expanded'} ) {
531 $expandable = 1
532 if ( ( $number_of_facets > 6 )
533 && ( $expanded_facet ne $link_value ) );
534 }
535 push @facets_loop, {
536 type_link_value => $link_value,
537 type_id => $link_value . "_id",
538 "type_label_" . $facets_info->{$link_value}->{'label_value'} => 1,
539 facets => \@this_facets_array,
540 expandable => $expandable,
541 expand => $link_value,
542 } unless ( ($facets_info->{$link_value}->{'label_value'} =~ /Libraries/) and (C4::Context->preference('singleBranchMode')) );
543 }
544 }
545 }
546 }
547 return ( undef, $results_hashref, \@facets_loop );
548}
549
550sub pazGetRecords {
551 my (
552 $koha_query, $simple_query, $sort_by_ref, $servers_ref,
553 $results_per_page, $offset, $expanded_facet, $branches,
554 $query_type, $scan
555 ) = @_;
556
557 my $paz = C4::Search::PazPar2->new(C4::Context->config('pazpar2url'));
558 $paz->init();
559 $paz->search($simple_query);
560 sleep 1; # FIXME: WHY?
561
562 # do results
563 my $results_hashref = {};
564 my $stats = XMLin($paz->stat);
565 my $results = XMLin($paz->show($offset, $results_per_page, 'work-title:1'), forcearray => 1);
566
567 # for a grouped search result, the number of hits
568 # is the number of groups returned; 'bib_hits' will have
569 # the total number of bibs.
570 $results_hashref->{'biblioserver'}->{'hits'} = $results->{'merged'}->[0];
571 $results_hashref->{'biblioserver'}->{'bib_hits'} = $stats->{'hits'};
572
573 HIT: foreach my $hit (@{ $results->{'hit'} }) {
574 my $recid = $hit->{recid}->[0];
575
576 my $work_title = $hit->{'md-work-title'}->[0];
577 my $work_author;
578 if (exists $hit->{'md-work-author'}) {
579 $work_author = $hit->{'md-work-author'}->[0];
580 }
581 my $group_label = (defined $work_author) ? "$work_title / $work_author" : $work_title;
582
583 my $result_group = {};
584 $result_group->{'group_label'} = $group_label;
585 $result_group->{'group_merge_key'} = $recid;
586
587 my $count = 1;
588 if (exists $hit->{count}) {
589 $count = $hit->{count}->[0];
590 }
591 $result_group->{'group_count'} = $count;
592
593 for (my $i = 0; $i < $count; $i++) {
594 # FIXME -- may need to worry about diacritics here
595 my $rec = $paz->record($recid, $i);
596 push @{ $result_group->{'RECORDS'} }, $rec;
597 }
598
599 push @{ $results_hashref->{'biblioserver'}->{'GROUPS'} }, $result_group;
600 }
601
602 # pass through facets
603 my $termlist_xml = $paz->termlist('author,subject');
604 my $terms = XMLin($termlist_xml, forcearray => 1);
605 my @facets_loop = ();
606 #die Dumper($results);
607# foreach my $list (sort keys %{ $terms->{'list'} }) {
608# my @facets = ();
609# foreach my $facet (sort @{ $terms->{'list'}->{$list}->{'term'} } ) {
610# push @facets, {
611# facet_label_value => $facet->{'name'}->[0],
612# };
613# }
614# push @facets_loop, ( {
615# type_label => $list,
616# facets => \@facets,
617# } );
618# }
619
620 return ( undef, $results_hashref, \@facets_loop );
621}
622
623# STOPWORDS
624sub _remove_stopwords {
625 my ( $operand, $index ) = @_;
626 my @stopwords_removed;
627
628 # phrase and exact-qualified indexes shouldn't have stopwords removed
629 if ( $index !~ m/phr|ext/ ) {
630
631# remove stopwords from operand : parse all stopwords & remove them (case insensitive)
632# we use IsAlpha unicode definition, to deal correctly with diacritics.
633# otherwise, a French word like "leçon" woudl be split into "le" "çon", "le"
634# is a stopword, we'd get "çon" and wouldn't find anything...
635 foreach ( keys %{ C4::Context->stopwords } ) {
636 next if ( $_ =~ /(and|or|not)/ ); # don't remove operators
637 if ( my ($matched) = ($operand =~
638 /(\P{IsAlnum}\Q$_\E\P{IsAlnum}|^\Q$_\E\P{IsAlnum}|\P{IsAlnum}\Q$_\E$|^\Q$_\E$)/gi) )
639 {
640 $operand =~ s/\Q$matched\E/ /gi;
641 push @stopwords_removed, $_;
642 }
643 }
644 }
645 return ( $operand, \@stopwords_removed );
646}
647
648# TRUNCATION
649sub _detect_truncation {
650 my ( $operand, $index ) = @_;
651 my ( @nontruncated, @righttruncated, @lefttruncated, @rightlefttruncated,
652 @regexpr );
653 $operand =~ s/^ //g;
654 my @wordlist = split( /\s/, $operand );
655 foreach my $word (@wordlist) {
656 if ( $word =~ s/^\*([^\*]+)\*$/$1/ ) {
657 push @rightlefttruncated, $word;
658 }
659 elsif ( $word =~ s/^\*([^\*]+)$/$1/ ) {
660 push @lefttruncated, $word;
661 }
662 elsif ( $word =~ s/^([^\*]+)\*$/$1/ ) {
663 push @righttruncated, $word;
664 }
665 elsif ( index( $word, "*" ) < 0 ) {
666 push @nontruncated, $word;
667 }
668 else {
669 push @regexpr, $word;
670 }
671 }
672 return (
673 \@nontruncated, \@righttruncated, \@lefttruncated,
674 \@rightlefttruncated, \@regexpr
675 );
676}
677
678# STEMMING
679sub _build_stemmed_operand {
680 my ($operand) = @_;
681 my $stemmed_operand;
682
683 # If operand contains a digit, it is almost certainly an identifier, and should
684 # not be stemmed. This is particularly relevant for ISBNs and ISSNs, which
685 # can contain the letter "X" - for example, _build_stemmend_operand would reduce
686 # "014100018X" to "x ", which for a MARC21 database would bring up irrelevant
687 # results (e.g., "23 x 29 cm." from the 300$c). Bug 2098.
688 return $operand if $operand =~ /\d/;
689
690# FIXME: the locale should be set based on the user's language and/or search choice
691 my $stemmer = Lingua::Stem->new( -locale => 'EN-US' );
692
693# FIXME: these should be stored in the db so the librarian can modify the behavior
694 $stemmer->add_exceptions(
695 {
696 'and' => 'and',
697 'or' => 'or',
698 'not' => 'not',
699 }
700 );
701 my @words = split( / /, $operand );
702 my $stems = $stemmer->stem(@words);
703 for my $stem (@$stems) {
704 $stemmed_operand .= "$stem";
705 $stemmed_operand .= "?"
706 unless ( $stem =~ /(and$|or$|not$)/ ) || ( length($stem) < 3 );
707 $stemmed_operand .= " ";
708 }
709 warn "STEMMED OPERAND: $stemmed_operand" if $DEBUG;
710 return $stemmed_operand;
711}
712
713# FIELD WEIGHTING
714sub _build_weighted_query {
715
716# FIELD WEIGHTING - This is largely experimental stuff. What I'm committing works
717# pretty well but could work much better if we had a smarter query parser
718 my ( $operand, $stemmed_operand, $index ) = @_;
719 my $stemming = C4::Context->preference("QueryStemming") || 0;
720 my $weight_fields = C4::Context->preference("QueryWeightFields") || 0;
721 my $fuzzy_enabled = C4::Context->preference("QueryFuzzy") || 0;
722
723 my $weighted_query .= "(rk=("; # Specifies that we're applying rank
724
725 # Keyword, or, no index specified
726 if ( ( $index eq 'kw' ) || ( !$index ) ) {
727 $weighted_query .=
728 "Title-cover,ext,r1=\"$operand\""; # exact title-cover
729 $weighted_query .= " or ti,ext,r2=\"$operand\""; # exact title
730 $weighted_query .= " or ti,phr,r3=\"$operand\""; # phrase title
731 #$weighted_query .= " or any,ext,r4=$operand"; # exact any
732 #$weighted_query .=" or kw,wrdl,r5=\"$operand\""; # word list any
733 $weighted_query .= " or wrdl,fuzzy,r8=\"$operand\""
734 if $fuzzy_enabled; # add fuzzy, word list
735 $weighted_query .= " or wrdl,right-Truncation,r9=\"$stemmed_operand\""
736 if ( $stemming and $stemmed_operand )
737 ; # add stemming, right truncation
738 $weighted_query .= " or wrdl,r9=\"$operand\"";
739
740 # embedded sorting: 0 a-z; 1 z-a
741 # $weighted_query .= ") or (sort1,aut=1";
742 }
743
744 # Barcode searches should skip this process
745 elsif ( $index eq 'bc' ) {
746 $weighted_query .= "bc=\"$operand\"";
747 }
748
749 # Authority-number searches should skip this process
750 elsif ( $index eq 'an' ) {
751 $weighted_query .= "an=\"$operand\"";
752 }
753
754 # If the index already has more than one qualifier, wrap the operand
755 # in quotes and pass it back (assumption is that the user knows what they
756 # are doing and won't appreciate us mucking up their query
757 elsif ( $index =~ ',' ) {
758 $weighted_query .= " $index=\"$operand\"";
759 }
760
761 #TODO: build better cases based on specific search indexes
762 else {
763 $weighted_query .= " $index,ext,r1=\"$operand\""; # exact index
764 #$weighted_query .= " or (title-sort-az=0 or $index,startswithnt,st-word,r3=$operand #)";
765 $weighted_query .= " or $index,phr,r3=\"$operand\""; # phrase index
766 $weighted_query .=
767 " or $index,rt,wrdl,r3=\"$operand\""; # word list index
768 }
769
770 $weighted_query .= "))"; # close rank specification
771 return $weighted_query;
772}
773
774=head2 buildQuery
775
776( $error, $query,
777$simple_query, $query_cgi,
778$query_desc, $limit,
779$limit_cgi, $limit_desc,
780$stopwords_removed, $query_type ) = getRecords ( $operators, $operands, $indexes, $limits, $sort_by, $scan);
781
782Build queries and limits in CCL, CGI, Human,
783handle truncation, stemming, field weighting, stopwords, fuzziness, etc.
784
785See verbose embedded documentation.
786
787
788=cut
789
790sub buildQuery {
791 my ( $operators, $operands, $indexes, $limits, $sort_by, $scan ) = @_;
792
793 warn "---------\nEnter buildQuery\n---------" if $DEBUG;
794
795 # dereference
796 my @operators = $operators ? @$operators : ();
797 my @indexes = $indexes ? @$indexes : ();
798 my @operands = $operands ? @$operands : ();
799 my @limits = $limits ? @$limits : ();
800 my @sort_by = $sort_by ? @$sort_by : ();
801
802 my $stemming = C4::Context->preference("QueryStemming") || 0;
803 my $auto_truncation = C4::Context->preference("QueryAutoTruncate") || 0;
804 my $weight_fields = C4::Context->preference("QueryWeightFields") || 0;
805 my $fuzzy_enabled = C4::Context->preference("QueryFuzzy") || 0;
806 my $remove_stopwords = C4::Context->preference("QueryRemoveStopwords") || 0;
807
808 # no stemming/weight/fuzzy in NoZebra
809 if ( C4::Context->preference("NoZebra") ) {
810 $stemming = 0;
811 $weight_fields = 0;
812 $fuzzy_enabled = 0;
813 }
814
815 my $query = $operands[0];
816 my $simple_query = $operands[0];
817
818 # initialize the variables we're passing back
819 my $query_cgi;
820 my $query_desc;
821 my $query_type;
822
823 my $limit;
824 my $limit_cgi;
825 my $limit_desc;
826
827 my $stopwords_removed; # flag to determine if stopwords have been removed
828
829# for handling ccl, cql, pqf queries in diagnostic mode, skip the rest of the steps
830# DIAGNOSTIC ONLY!!
831 if ( $query =~ /^ccl=/ ) {
832 return ( undef, $', $', "q=ccl=$'", $', '', '', '', '', 'ccl' );
833 }
834 if ( $query =~ /^cql=/ ) {
835 return ( undef, $', $', "q=cql=$'", $', '', '', '', '', 'cql' );
836 }
837 if ( $query =~ /^pqf=/ ) {
838 return ( undef, $', $', "q=pqf=$'", $', '', '', '', '', 'pqf' );
839 }
840
841 # pass nested queries directly
842 # FIXME: need better handling of some of these variables in this case
843 if ( $query =~ /(\(|\))/ ) {
844 return (
845 undef, $query, $simple_query, $query_cgi,
846 $query, $limit, $limit_cgi, $limit_desc,
847 $stopwords_removed, 'ccl'
848 );
849 }
850
851# Form-based queries are non-nested and fixed depth, so we can easily modify the incoming
852# query operands and indexes and add stemming, truncation, field weighting, etc.
853# Once we do so, we'll end up with a value in $query, just like if we had an
854# incoming $query from the user
855 else {
856 $query = ""
857 ; # clear it out so we can populate properly with field-weighted, stemmed, etc. query
858 my $previous_operand
859 ; # a flag used to keep track if there was a previous query
860 # if there was, we can apply the current operator
861 # for every operand
862 for ( my $i = 0 ; $i <= @operands ; $i++ ) {
863
864 # COMBINE OPERANDS, INDEXES AND OPERATORS
865 if ( $operands[$i] ) {
866
867 # A flag to determine whether or not to add the index to the query
868 my $indexes_set;
869
870# If the user is sophisticated enough to specify an index, turn off field weighting, stemming, and stopword handling
871 if ( $operands[$i] =~ /(:|=)/ || $scan ) {
872 $weight_fields = 0;
873 $stemming = 0;
874 $remove_stopwords = 0;
875 }
876 my $operand = $operands[$i];
877 my $index = $indexes[$i];
878
879 # Add index-specific attributes
880 # Date of Publication
881 if ( $index eq 'yr' ) {
882 $index .= ",st-numeric";
883 $indexes_set++;
884 $stemming = $auto_truncation = $weight_fields = $fuzzy_enabled = $remove_stopwords = 0;
885 }
886
887 # Date of Acquisition
888 elsif ( $index eq 'acqdate' ) {
889 $index .= ",st-date-normalized";
890 $indexes_set++;
891 $stemming = $auto_truncation = $weight_fields = $fuzzy_enabled = $remove_stopwords = 0;
892 }
893 # ISBN,ISSN,Standard Number, don't need special treatment
894 elsif ( $index eq 'nb' || $index eq 'ns' ) {
895 $indexes_set++;
896 (
897 $stemming, $auto_truncation,
898 $weight_fields, $fuzzy_enabled,
899 $remove_stopwords
900 ) = ( 0, 0, 0, 0, 0 );
901
902 }
903 # Set default structure attribute (word list)
904 my $struct_attr;
905 unless ( $indexes_set || !$index || $index =~ /(st-|phr|ext|wrdl)/ ) {
906 $struct_attr = ",wrdl";
907 }
908
909 # Some helpful index variants
910 my $index_plus = $index . $struct_attr . ":" if $index;
911 my $index_plus_comma = $index . $struct_attr . "," if $index;
912 if ($auto_truncation){
913# FIXME Auto Truncation is only valid for LTR languages
914# use C4::Output;
915# use C4::Languages qw(regex_lang_subtags get_bidi);
916# $lang = $query->cookie('KohaOpacLanguage') if (defined $query && $query->cookie('KohaOpacLanguage'));
917# my $current_lang = regex_lang_subtags($lang);
918# my $bidi;
919# $bidi = get_bidi($current_lang->{script}) if $current_lang->{script};
920 $index_plus_comma .= "rtrn:";
921 }
922
923 # Remove Stopwords
924 if ($remove_stopwords) {
925 ( $operand, $stopwords_removed ) =
926 _remove_stopwords( $operand, $index );
927 warn "OPERAND w/out STOPWORDS: >$operand<" if $DEBUG;
928 warn "REMOVED STOPWORDS: @$stopwords_removed"
929 if ( $stopwords_removed && $DEBUG );
930 }
931
932 # Detect Truncation
933 my $truncated_operand;
934 my( $nontruncated, $righttruncated, $lefttruncated,
935 $rightlefttruncated, $regexpr
936 ) = _detect_truncation( $operand, $index );
937 warn
938"TRUNCATION: NON:>@$nontruncated< RIGHT:>@$righttruncated< LEFT:>@$lefttruncated< RIGHTLEFT:>@$rightlefttruncated< REGEX:>@$regexpr<"
939 if $DEBUG;
940
941 # Apply Truncation
942 if (
943 scalar(@$righttruncated) + scalar(@$lefttruncated) +
944 scalar(@$rightlefttruncated) > 0 )
945 {
946
947 # Don't field weight or add the index to the query, we do it here
948 $indexes_set = 1;
949 undef $weight_fields;
950 my $previous_truncation_operand;
951 if (scalar @$nontruncated) {
952 $truncated_operand .= "$index_plus @$nontruncated ";
953 $previous_truncation_operand = 1;
954 }
955 if (scalar @$righttruncated) {
956 $truncated_operand .= "and " if $previous_truncation_operand;
957 $truncated_operand .= $index_plus_comma . "rtrn:@$righttruncated ";
958 $previous_truncation_operand = 1;
959 }
960 if (scalar @$lefttruncated) {
961 $truncated_operand .= "and " if $previous_truncation_operand;
962 $truncated_operand .= $index_plus_comma . "ltrn:@$lefttruncated ";
963 $previous_truncation_operand = 1;
964 }
965 if (scalar @$rightlefttruncated) {
966 $truncated_operand .= "and " if $previous_truncation_operand;
967 $truncated_operand .= $index_plus_comma . "rltrn:@$rightlefttruncated ";
968 $previous_truncation_operand = 1;
969 }
970 }
971 $operand = $truncated_operand if $truncated_operand;
972 warn "TRUNCATED OPERAND: >$truncated_operand<" if $DEBUG;
973
974 # Handle Stemming
975 my $stemmed_operand;
976 $stemmed_operand = _build_stemmed_operand($operand) if $stemming;
977
978 warn "STEMMED OPERAND: >$stemmed_operand<" if $DEBUG;
979
980 # Handle Field Weighting
981 my $weighted_operand;
982 if ($weight_fields) {
983 $weighted_operand = _build_weighted_query( $operand, $stemmed_operand, $index );
984 $operand = $weighted_operand;
985 $indexes_set = 1;
986 }
987
988 warn "FIELD WEIGHTED OPERAND: >$weighted_operand<" if $DEBUG;
989
990 # If there's a previous operand, we need to add an operator
991 if ($previous_operand) {
992
993 # User-specified operator
994 if ( $operators[ $i - 1 ] ) {
995 $query .= " $operators[$i-1] ";
996 $query .= " $index_plus " unless $indexes_set;
997 $query .= " $operand";
998 $query_cgi .= "&op=$operators[$i-1]";
999 $query_cgi .= "&idx=$index" if $index;
1000 $query_cgi .= "&q=$operands[$i]" if $operands[$i];
1001 $query_desc .=
1002 " $operators[$i-1] $index_plus $operands[$i]";
1003 }
1004
1005 # Default operator is and
1006 else {
1007 $query .= " and ";
1008 $query .= "$index_plus " unless $indexes_set;
1009 $query .= "$operand";
1010 $query_cgi .= "&op=and&idx=$index" if $index;
1011 $query_cgi .= "&q=$operands[$i]" if $operands[$i];
1012 $query_desc .= " and $index_plus $operands[$i]";
1013 }
1014 }
1015
1016 # There isn't a pervious operand, don't need an operator
1017 else {
1018
1019 # Field-weighted queries already have indexes set
1020 $query .= " $index_plus " unless $indexes_set;
1021 $query .= $operand;
1022 $query_desc .= " $index_plus $operands[$i]";
1023 $query_cgi .= "&idx=$index" if $index;
1024 $query_cgi .= "&q=$operands[$i]" if $operands[$i];
1025 $previous_operand = 1;
1026 }
1027 } #/if $operands
1028 } # /for
1029 }
1030 warn "QUERY BEFORE LIMITS: >$query<" if $DEBUG;
1031
1032 # add limits
1033 my $group_OR_limits;
1034 my $availability_limit;
1035 foreach my $this_limit (@limits) {
1036 if ( $this_limit =~ /available/ ) {
1037
1038# 'available' is defined as (items.onloan is NULL) and (items.itemlost = 0)
1039# In English:
1040# all records not indexed in the onloan register (zebra) and all records with a value of lost equal to 0
1041 $availability_limit .=
1042"( ( allrecords,AlwaysMatches='' not onloan,AlwaysMatches='') and (lost,st-numeric=0) )"; #or ( allrecords,AlwaysMatches='' not lost,AlwaysMatches='')) )";
1043 $limit_cgi .= "&limit=available";
1044 $limit_desc .= "";
1045 }
1046
1047 # group_OR_limits, prefixed by mc-
1048 # OR every member of the group
1049 elsif ( $this_limit =~ /mc/ ) {
1050 $group_OR_limits .= " or " if $group_OR_limits;
1051 $limit_desc .= " or " if $group_OR_limits;
1052 $group_OR_limits .= "$this_limit";
1053 $limit_cgi .= "&limit=$this_limit";
1054 $limit_desc .= " $this_limit";
1055 }
1056
1057 # Regular old limits
1058 else {
1059 $limit .= " and " if $limit || $query;
1060 $limit .= "$this_limit";
1061 $limit_cgi .= "&limit=$this_limit";
1062 if ($this_limit =~ /^branch:(.+)/) {
1063 my $branchcode = $1;
1064 my $branchname = GetBranchName($branchcode);
1065 if (defined $branchname) {
1066 $limit_desc .= " branch:$branchname";
1067 } else {
1068 $limit_desc .= " $this_limit";
1069 }
1070 } else {
1071 $limit_desc .= " $this_limit";
1072 }
1073 }
1074 }
1075 if ($group_OR_limits) {
1076 $limit .= " and " if ( $query || $limit );
1077 $limit .= "($group_OR_limits)";
1078 }
1079 if ($availability_limit) {
1080 $limit .= " and " if ( $query || $limit );
1081 $limit .= "($availability_limit)";
1082 }
1083
1084 # Normalize the query and limit strings
1085 $query =~ s/:/=/g;
1086 $limit =~ s/:/=/g;
1087 for ( $query, $query_desc, $limit, $limit_desc ) {
1088 s/ / /g; # remove extra spaces
1089 s/^ //g; # remove any beginning spaces
1090 s/ $//g; # remove any ending spaces
1091 s/==/=/g; # remove double == from query
1092 }
1093 $query_cgi =~ s/^&//; # remove unnecessary & from beginning of the query cgi
1094
1095 for ($query_cgi,$simple_query) {
1096 s/"//g;
1097 }
1098 # append the limit to the query
1099 $query .= " " . $limit;
1100
1101 # Warnings if DEBUG
1102 if ($DEBUG) {
1103 warn "QUERY:" . $query;
1104 warn "QUERY CGI:" . $query_cgi;
1105 warn "QUERY DESC:" . $query_desc;
1106 warn "LIMIT:" . $limit;
1107 warn "LIMIT CGI:" . $limit_cgi;
1108 warn "LIMIT DESC:" . $limit_desc;
1109 warn "---------\nLeave buildQuery\n---------";
1110 }
1111 return (
1112 undef, $query, $simple_query, $query_cgi,
1113 $query_desc, $limit, $limit_cgi, $limit_desc,
1114 $stopwords_removed, $query_type
1115 );
1116}
1117
1118=head2 searchResults
1119
1120Format results in a form suitable for passing to the template
1121
1122=cut
1123
1124# IMO this subroutine is pretty messy still -- it's responsible for
1125# building the HTML output for the template
1126sub searchResults {
1127 my ( $searchdesc, $hits, $results_per_page, $offset, $scan, @marcresults ) = @_;
1128 my $dbh = C4::Context->dbh;
1129 my @newresults;
1130
1131 #Build branchnames hash
1132 #find branchname
1133 #get branch information.....
1134 my %branches;
1135 my $bsth =$dbh->prepare("SELECT branchcode,branchname FROM branches"); # FIXME : use C4::Branch::GetBranches
1136 $bsth->execute();
1137 while ( my $bdata = $bsth->fetchrow_hashref ) {
1138 $branches{ $bdata->{'branchcode'} } = $bdata->{'branchname'};
1139 }
1140# FIXME - We build an authorised values hash here, using the default framework
1141# though it is possible to have different authvals for different fws.
1142
1143 my $shelflocations =GetKohaAuthorisedValues('items.location','');
1144
1145 # get notforloan authorised value list (see $shelflocations FIXME)
1146 my $notforloan_authorised_value = GetAuthValCode('items.notforloan','');
1147
1148 #Build itemtype hash
1149 #find itemtype & itemtype image
1150 my %itemtypes;
1151 $bsth =
1152 $dbh->prepare(
1153 "SELECT itemtype,description,imageurl,summary,notforloan FROM itemtypes"
1154 );
1155 $bsth->execute();
1156 while ( my $bdata = $bsth->fetchrow_hashref ) {
1157 foreach (qw(description imageurl summary notforloan)) {
1158 $itemtypes{ $bdata->{'itemtype'} }->{$_} = $bdata->{$_};
1159 }
1160 }
1161
1162 #search item field code
1163 my $sth =
1164 $dbh->prepare(
1165"SELECT tagfield FROM marc_subfield_structure WHERE kohafield LIKE 'items.itemnumber'"
1166 );
1167 $sth->execute;
1168 my ($itemtag) = $sth->fetchrow;
1169
1170 ## find column names of items related to MARC
1171 my $sth2 = $dbh->prepare("SHOW COLUMNS FROM items");
1172 $sth2->execute;
1173 my %subfieldstosearch;
1174 while ( ( my $column ) = $sth2->fetchrow ) {
1175 my ( $tagfield, $tagsubfield ) =
1176 &GetMarcFromKohaField( "items." . $column, "" );
1177 $subfieldstosearch{$column} = $tagsubfield;
1178 }
1179
1180 # handle which records to actually retrieve
1181 my $times;
1182 if ( $hits && $offset + $results_per_page <= $hits ) {
1183 $times = $offset + $results_per_page;
1184 }
1185 else {
1186 $times = $hits; # FIXME: if $hits is undefined, why do we want to equal it?
1187 }
1188
1189 my $marcflavour = C4::Context->preference("marcflavour");
1190 # loop through all of the records we've retrieved
1191 for ( my $i = $offset ; $i <= $times - 1 ; $i++ ) {
1192 my $marcrecord = MARC::File::USMARC::decode( $marcresults[$i] );
1193 my $oldbiblio = TransformMarcToKoha( $dbh, $marcrecord, '' );
1194 $oldbiblio->{subtitle} = C4::Biblio::get_koha_field_from_marc('bibliosubtitle', 'subtitle', $marcrecord, '');
1195 $oldbiblio->{result_number} = $i + 1;
1196
1197 # add imageurl to itemtype if there is one
1198 $oldbiblio->{imageurl} = getitemtypeimagelocation( 'opac', $itemtypes{ $oldbiblio->{itemtype} }->{imageurl} );
1199
1200 $oldbiblio->{'authorised_value_images'} = C4::Items::get_authorised_value_images( C4::Biblio::get_biblio_authorised_values( $oldbiblio->{'biblionumber'}, $marcrecord ) );
1201 $oldbiblio->{normalized_upc} = GetNormalizedUPC( $marcrecord,$marcflavour);
1202 $oldbiblio->{normalized_ean} = GetNormalizedEAN( $marcrecord,$marcflavour);
1203 $oldbiblio->{normalized_oclc} = GetNormalizedOCLCNumber($marcrecord,$marcflavour);
1204 $oldbiblio->{normalized_isbn} = GetNormalizedISBN(undef,$marcrecord,$marcflavour);
1205 $oldbiblio->{content_identifier_exists} = 1 if ($oldbiblio->{normalized_isbn} or $oldbiblio->{normalized_oclc} or $oldbiblio->{normalized_ean} or $oldbiblio->{normalized_upc});
1206
1207 # edition information, if any
1208 $oldbiblio->{edition} = $oldbiblio->{editionstatement};
1209 $oldbiblio->{description} = $itemtypes{ $oldbiblio->{itemtype} }->{description};
1210 # Build summary if there is one (the summary is defined in the itemtypes table)
1211 # FIXME: is this used anywhere, I think it can be commented out? -- JF
1212 if ( $itemtypes{ $oldbiblio->{itemtype} }->{summary} ) {
1213 my $summary = $itemtypes{ $oldbiblio->{itemtype} }->{summary};
1214 my @fields = $marcrecord->fields();
1215 foreach my $field (@fields) {
1216 my $tag = $field->tag();
1217 my $tagvalue = $field->as_string();
1218 $summary =~
1219 s/\[(.?.?.?.?)$tag\*(.*?)]/$1$tagvalue$2\[$1$tag$2]/g;
1220 unless ( $tag < 10 ) {
1221 my @subf = $field->subfields;
1222 for my $i ( 0 .. $#subf ) {
1223 my $subfieldcode = $subf[$i][0];
1224 my $subfieldvalue = $subf[$i][1];
1225 my $tagsubf = $tag . $subfieldcode;
1226 $summary =~
1227s/\[(.?.?.?.?)$tagsubf(.*?)]/$1$subfieldvalue$2\[$1$tagsubf$2]/g;
1228 }
1229 }
1230 }
1231 # FIXME: yuk
1232 $summary =~ s/\[(.*?)]//g;
1233 $summary =~ s/\n/<br\/>/g;
1234 $oldbiblio->{summary} = $summary;
1235 }
1236
1237 # Pull out the items fields
1238 my @fields = $marcrecord->field($itemtag);
1239
1240 # Setting item statuses for display
1241 my @available_items_loop;
1242 my @onloan_items_loop;
1243 my @other_items_loop;
1244
1245 my $available_items;
1246 my $onloan_items;
1247 my $other_items;
1248
1249 my $ordered_count = 0;
1250 my $available_count = 0;
1251 my $onloan_count = 0;
1252 my $longoverdue_count = 0;
1253 my $other_count = 0;
1254 my $wthdrawn_count = 0;
1255 my $itemlost_count = 0;
1256 my $itembinding_count = 0;
1257 my $itemdamaged_count = 0;
1258 my $item_in_transit_count = 0;
1259 my $can_place_holds = 0;
1260 my $items_count = scalar(@fields);
1261 my $maxitems =
1262 ( C4::Context->preference('maxItemsinSearchResults') )
1263 ? C4::Context->preference('maxItemsinSearchResults') - 1
1264 : 1;
1265
1266 # loop through every item
1267 foreach my $field (@fields) {
1268 my $item;
1269
1270 # populate the items hash
1271 foreach my $code ( keys %subfieldstosearch ) {
1272 $item->{$code} = $field->subfield( $subfieldstosearch{$code} );
1273 }
1274 my $hbranch = C4::Context->preference('HomeOrHoldingBranch') eq 'homebranch' ? 'homebranch' : 'holdingbranch';
1275 my $otherbranch = C4::Context->preference('HomeOrHoldingBranch') eq 'homebranch' ? 'holdingbranch' : 'homebranch';
1276 # set item's branch name, use HomeOrHoldingBranch syspref first, fall back to the other one
1277 if ($item->{$hbranch}) {
1278 $item->{'branchname'} = $branches{$item->{$hbranch}};
1279 }
1280 elsif ($item->{$otherbranch}) { # Last resort
1281 $item->{'branchname'} = $branches{$item->{$otherbranch}};
1282 }
1283
1284 my $prefix = $item->{$hbranch} . '--' . $item->{location} . $item->{itype} . $item->{itemcallnumber};
1285# For each grouping of items (onloan, available, unavailable), we build a key to store relevant info about that item
1286 if ( $item->{onloan} ) {
1287 $onloan_count++;
1288 my $key = $prefix . $item->{onloan} . $item->{barcode};
1289 $onloan_items->{$key}->{due_date} = format_date($item->{onloan});
1290 $onloan_items->{$key}->{count}++ if $item->{$hbranch};
1291 $onloan_items->{$key}->{branchname} = $item->{branchname};
1292 $onloan_items->{$key}->{location} = $shelflocations->{ $item->{location} };
1293 $onloan_items->{$key}->{itemcallnumber} = $item->{itemcallnumber};
1294 $onloan_items->{$key}->{imageurl} = getitemtypeimagelocation( 'opac', $itemtypes{ $item->{itype} }->{imageurl} );
1295 # if something's checked out and lost, mark it as 'long overdue'
1296 if ( $item->{itemlost} ) {
1297 $onloan_items->{$prefix}->{longoverdue}++;
1298 $longoverdue_count++;
1299 } else { # can place holds as long as item isn't lost
1300 $can_place_holds = 1;
1301 }
1302 }
1303
1304 # items not on loan, but still unavailable ( lost, withdrawn, damaged )
1305 else {
1306
1307 # item is on order
1308 if ( $item->{notforloan} == -1 ) {
1309 $ordered_count++;
1310 }
1311
1312 # is item in transit?
1313 my $transfertwhen = '';
1314 my ($transfertfrom, $transfertto);
1315
1316 unless ($item->{wthdrawn}
1317 || $item->{itemlost}
1318 || $item->{damaged}
1319 || $item->{notforloan}
1320 || $items_count > 20) {
1321
1322 # A couple heuristics to limit how many times
1323 # we query the database for item transfer information, sacrificing
1324 # accuracy in some cases for speed;
1325 #
1326 # 1. don't query if item has one of the other statuses
1327 # 2. don't check transit status if the bib has
1328 # more than 20 items
1329 #
1330 # FIXME: to avoid having the query the database like this, and to make
1331 # the in transit status count as unavailable for search limiting,
1332 # should map transit status to record indexed in Zebra.
1333 #
1334 ($transfertwhen, $transfertfrom, $transfertto) = C4::Circulation::GetTransfers($item->{itemnumber});
1335 }
1336
1337 # item is withdrawn, lost or damaged
1338 if ( $item->{wthdrawn}
1339 || $item->{itemlost}
1340 || $item->{damaged}
1341 || $item->{notforloan}
1342 || ($transfertwhen ne ''))
1343 {
1344 $wthdrawn_count++ if $item->{wthdrawn};
1345 $itemlost_count++ if $item->{itemlost};
1346 $itemdamaged_count++ if $item->{damaged};
1347 $item_in_transit_count++ if $transfertwhen ne '';
1348 $item->{status} = $item->{wthdrawn} . "-" . $item->{itemlost} . "-" . $item->{damaged} . "-" . $item->{notforloan};
1349 $other_count++;
1350
1351 my $key = $prefix . $item->{status};
1352 foreach (qw(wthdrawn itemlost damaged branchname itemcallnumber)) {
1353 $other_items->{$key}->{$_} = $item->{$_};
1354 }
1355 $other_items->{$key}->{intransit} = ($transfertwhen ne '') ? 1 : 0;
1356 $other_items->{$key}->{notforloan} = GetAuthorisedValueDesc('','',$item->{notforloan},'','',$notforloan_authorised_value) if $notforloan_authorised_value;
1357 $other_items->{$key}->{count}++ if $item->{$hbranch};
1358 $other_items->{$key}->{location} = $shelflocations->{ $item->{location} };
1359 $other_items->{$key}->{imageurl} = getitemtypeimagelocation( 'opac', $itemtypes{ $item->{itype} }->{imageurl} );
1360 }
1361 # item is available
1362 else {
1363 $can_place_holds = 1;
1364 $available_count++;
1365 $available_items->{$prefix}->{count}++ if $item->{$hbranch};
1366 foreach (qw(branchname itemcallnumber)) {
1367 $available_items->{$prefix}->{$_} = $item->{$_};
1368 }
1369 $available_items->{$prefix}->{location} = $shelflocations->{ $item->{location} };
1370 $available_items->{$prefix}->{imageurl} = getitemtypeimagelocation( 'opac', $itemtypes{ $item->{itype} }->{imageurl} );
1371 }
1372 }
1373 } # notforloan, item level and biblioitem level
1374 my ( $availableitemscount, $onloanitemscount, $otheritemscount );
1375 $maxitems =
1376 ( C4::Context->preference('maxItemsinSearchResults') )
1377 ? C4::Context->preference('maxItemsinSearchResults') - 1
1378 : 1;
1379 for my $key ( sort keys %$onloan_items ) {
1380 (++$onloanitemscount > $maxitems) and last;
1381 push @onloan_items_loop, $onloan_items->{$key};
1382 }
1383 for my $key ( sort keys %$other_items ) {
1384 (++$otheritemscount > $maxitems) and last;
1385 push @other_items_loop, $other_items->{$key};
1386 }
1387 for my $key ( sort keys %$available_items ) {
1388 (++$availableitemscount > $maxitems) and last;
1389 push @available_items_loop, $available_items->{$key}
1390 }
1391
1392 # XSLT processing of some stuff
1393 if (C4::Context->preference("XSLTResultsDisplay") && !$scan) {
1394 $oldbiblio->{XSLTResultsRecord} = XSLTParse4Display(
1395 $oldbiblio->{biblionumber}, $marcrecord, 'Results' );
1396 }
1397
1398 # last check for norequest : if itemtype is notforloan, it can't be reserved either, whatever the items
1399 $can_place_holds = 0
1400 if $itemtypes{ $oldbiblio->{itemtype} }->{notforloan};
1401 $oldbiblio->{norequests} = 1 unless $can_place_holds;
1402 $oldbiblio->{itemsplural} = 1 if $items_count > 1;
1403 $oldbiblio->{items_count} = $items_count;
1404 $oldbiblio->{available_items_loop} = \@available_items_loop;
1405 $oldbiblio->{onloan_items_loop} = \@onloan_items_loop;
1406 $oldbiblio->{other_items_loop} = \@other_items_loop;
1407 $oldbiblio->{availablecount} = $available_count;
1408 $oldbiblio->{availableplural} = 1 if $available_count > 1;
1409 $oldbiblio->{onloancount} = $onloan_count;
1410 $oldbiblio->{onloanplural} = 1 if $onloan_count > 1;
1411 $oldbiblio->{othercount} = $other_count;
1412 $oldbiblio->{otherplural} = 1 if $other_count > 1;
1413 $oldbiblio->{wthdrawncount} = $wthdrawn_count;
1414 $oldbiblio->{itemlostcount} = $itemlost_count;
1415 $oldbiblio->{damagedcount} = $itemdamaged_count;
1416 $oldbiblio->{intransitcount} = $item_in_transit_count;
1417 $oldbiblio->{orderedcount} = $ordered_count;
1418 push( @newresults, $oldbiblio );
1419 }
1420 return @newresults;
1421}
1422
1423#----------------------------------------------------------------------
1424#
1425# Non-Zebra GetRecords#
1426#----------------------------------------------------------------------
1427
1428=head2 NZgetRecords
1429
1430 NZgetRecords has the same API as zera getRecords, even if some parameters are not managed
1431
1432=cut
1433
1434sub NZgetRecords {
1435 my (
1436 $query, $simple_query, $sort_by_ref, $servers_ref,
1437 $results_per_page, $offset, $expanded_facet, $branches,
1438 $query_type, $scan
1439 ) = @_;
1440 warn "query =$query" if $DEBUG;
1441 my $result = NZanalyse($query);
1442 warn "results =$result" if $DEBUG;
1443 return ( undef,
1444 NZorder( $result, @$sort_by_ref[0], $results_per_page, $offset ),
1445 undef );
1446}
1447
1448=head2 NZanalyse
1449
1450 NZanalyse : get a CQL string as parameter, and returns a list of biblionumber;title,biblionumber;title,...
1451 the list is built from an inverted index in the nozebra SQL table
1452 note that title is here only for convenience : the sorting will be very fast when requested on title
1453 if the sorting is requested on something else, we will have to reread all results, and that may be longer.
1454
1455=cut
1456
1457sub NZanalyse {
1458 my ( $string, $server ) = @_;
1459# warn "---------" if $DEBUG;
1460 warn " NZanalyse" if $DEBUG;
1461# warn "---------" if $DEBUG;
1462
1463 # $server contains biblioserver or authorities, depending on what we search on.
1464 #warn "querying : $string on $server";
1465 $server = 'biblioserver' unless $server;
1466
1467# if we have a ", replace the content to discard temporarily any and/or/not inside
1468 my $commacontent;
1469 if ( $string =~ /"/ ) {
1470 $string =~ s/"(.*?)"/__X__/;
1471 $commacontent = $1;
1472 warn "commacontent : $commacontent" if $DEBUG;
1473 }
1474
1475# split the query string in 3 parts : X AND Y means : $left="X", $operand="AND" and $right="Y"
1476# then, call again NZanalyse with $left and $right
1477# (recursive until we find a leaf (=> something without and/or/not)
1478# delete repeated operator... Would then go in infinite loop
1479 while ( $string =~ s/( and| or| not| AND| OR| NOT)\1/$1/g ) {
1480 }
1481
1482 #process parenthesis before.
1483 if ( $string =~ /^\s*\((.*)\)(( and | or | not | AND | OR | NOT )(.*))?/ ) {
1484 my $left = $1;
1485 my $right = $4;
1486 my $operator = lc($3); # FIXME: and/or/not are operators, not operands
1487 warn
1488"dealing w/parenthesis before recursive sub call. left :$left operator:$operator right:$right"
1489 if $DEBUG;
1490 my $leftresult = NZanalyse( $left, $server );
1491 if ($operator) {
1492 my $rightresult = NZanalyse( $right, $server );
1493
1494 # OK, we have the results for right and left part of the query
1495 # depending of operand, intersect, union or exclude both lists
1496 # to get a result list
1497 if ( $operator eq ' and ' ) {
1498 return NZoperatorAND($leftresult,$rightresult);
1499 }
1500 elsif ( $operator eq ' or ' ) {
1501
1502 # just merge the 2 strings
1503 return $leftresult . $rightresult;
1504 }
1505 elsif ( $operator eq ' not ' ) {
1506 return NZoperatorNOT($leftresult,$rightresult);
1507 }
1508 }
1509 else {
1510# this error is impossible, because of the regexp that isolate the operand, but just in case...
1511 return $leftresult;
1512 }
1513 }
1514 warn "string :" . $string if $DEBUG;
1515 my $left = "";
1516 my $right = "";
1517 my $operator = "";
1518 if ($string =~ /(.*?)( and | or | not | AND | OR | NOT )(.*)/) {
1519 $left = $1;
1520 $right = $3;
1521 $operator = lc($2); # FIXME: and/or/not are operators, not operands
1522 }
1523 warn "no parenthesis. left : $left operator: $operator right: $right"
1524 if $DEBUG;
1525
1526 # it's not a leaf, we have a and/or/not
1527 if ($operator) {
1528
1529 # reintroduce comma content if needed
1530 $right =~ s/__X__/"$commacontent"/ if $commacontent;
1531 $left =~ s/__X__/"$commacontent"/ if $commacontent;
1532 warn "node : $left / $operator / $right\n" if $DEBUG;
1533 my $leftresult = NZanalyse( $left, $server );
1534 my $rightresult = NZanalyse( $right, $server );
1535 warn " leftresult : $leftresult" if $DEBUG;
1536 warn " rightresult : $rightresult" if $DEBUG;
1537 # OK, we have the results for right and left part of the query
1538 # depending of operand, intersect, union or exclude both lists
1539 # to get a result list
1540 if ( $operator eq ' and ' ) {
1541 warn "NZAND";
1542 return NZoperatorAND($leftresult,$rightresult);
1543 }
1544 elsif ( $operator eq ' or ' ) {
1545
1546 # just merge the 2 strings
1547 return $leftresult . $rightresult;
1548 }
1549 elsif ( $operator eq ' not ' ) {
1550 return NZoperatorNOT($leftresult,$rightresult);
1551 }
1552 else {
1553
1554# this error is impossible, because of the regexp that isolate the operand, but just in case...
1555 die "error : operand unknown : $operator for $string";
1556 }
1557
1558 # it's a leaf, do the real SQL query and return the result
1559 }
1560 else {
1561 $string =~ s/__X__/"$commacontent"/ if $commacontent;
1562 $string =~ s/-|\.|\?|,|;|!|'|\(|\)|\[|\]|{|}|"|&|\+|\*|\// /g;
1563 #remove trailing blank at the beginning
1564 $string =~ s/^ //g;
1565 warn "leaf:$string" if $DEBUG;
1566
1567 # parse the string in in operator/operand/value again
1568 my $left = "";
1569 my $operator = "";
1570 my $right = "";
1571 if ($string =~ /(.*)(>=|<=)(.*)/) {
1572 $left = $1;
1573 $operator = $2;
1574 $right = $3;
1575 } else {
1576 $left = $string;
1577 }
1578# warn "handling leaf... left:$left operator:$operator right:$right"
1579# if $DEBUG;
1580 unless ($operator) {
1581 if ($string =~ /(.*)(>|<|=)(.*)/) {
1582 $left = $1;
1583 $operator = $2;
1584 $right = $3;
1585 warn
1586 "handling unless (operator)... left:$left operator:$operator right:$right"
1587 if $DEBUG;
1588 } else {
1589 $left = $string;
1590 }
1591 }
1592 my $results;
1593
1594# strip adv, zebra keywords, currently not handled in nozebra: wrdl, ext, phr...
1595 $left =~ s/ .*$//;
1596
1597 # automatic replace for short operators
1598 $left = 'title' if $left =~ '^ti$';
1599 $left = 'author' if $left =~ '^au$';
1600 $left = 'publisher' if $left =~ '^pb$';
1601 $left = 'subject' if $left =~ '^su$';
1602 $left = 'koha-Auth-Number' if $left =~ '^an$';
1603 $left = 'keyword' if $left =~ '^kw$';
1604 $left = 'itemtype' if $left =~ '^mc$'; # Fix for Bug 2599 - Search limits not working for NoZebra
1605 warn "handling leaf... left:$left operator:$operator right:$right" if $DEBUG;
1606 my $dbh = C4::Context->dbh;
1607 if ( $operator && $left ne 'keyword' ) {
1608 #do a specific search
1609 $operator = 'LIKE' if $operator eq '=' and $right =~ /%/;
1610 my $sth = $dbh->prepare(
1611"SELECT biblionumbers,value FROM nozebra WHERE server=? AND indexname=? AND value $operator ?"
1612 );
1613 warn "$left / $operator / $right\n" if $DEBUG;
1614
1615 # split each word, query the DB and build the biblionumbers result
1616 #sanitizing leftpart
1617 $left =~ s/^\s+|\s+$//;
1618 foreach ( split / /, $right ) {
1619 my $biblionumbers;
1620 $_ =~ s/^\s+|\s+$//;
1621 next unless $_;
1622 warn "EXECUTE : $server, $left, $_" if $DEBUG;
1623 $sth->execute( $server, $left, $_ )
1624 or warn "execute failed: $!";
1625 while ( my ( $line, $value ) = $sth->fetchrow ) {
1626
1627# if we are dealing with a numeric value, use only numeric results (in case of >=, <=, > or <)
1628# otherwise, fill the result
1629 $biblionumbers .= $line
1630 unless ( $right =~ /^\d+$/ && $value =~ /\D/ );
1631 warn "result : $value "
1632 . ( $right =~ /\d/ ) . "=="
1633 . ( $value =~ /\D/?$line:"" ) if $DEBUG; #= $line";
1634 }
1635
1636# do a AND with existing list if there is one, otherwise, use the biblionumbers list as 1st result list
1637 if ($results) {
1638 warn "NZAND" if $DEBUG;
1639 $results = NZoperatorAND($biblionumbers,$results);
1640 } else {
1641 $results = $biblionumbers;
1642 }
1643 }
1644 }
1645 else {
1646 #do a complete search (all indexes), if index='kw' do complete search too.
1647 my $sth = $dbh->prepare(
1648"SELECT biblionumbers FROM nozebra WHERE server=? AND value LIKE ?"
1649 );
1650
1651 # split each word, query the DB and build the biblionumbers result
1652 foreach ( split / /, $string ) {
1653 next if C4::Context->stopwords->{ uc($_) }; # skip if stopword
1654 warn "search on all indexes on $_" if $DEBUG;
1655 my $biblionumbers;
1656 next unless $_;
1657 $sth->execute( $server, $_ );
1658 while ( my $line = $sth->fetchrow ) {
1659 $biblionumbers .= $line;
1660 }
1661
1662# do a AND with existing list if there is one, otherwise, use the biblionumbers list as 1st result list
1663 if ($results) {
1664 $results = NZoperatorAND($biblionumbers,$results);
1665 }
1666 else {
1667 warn "NEW RES for $_ = $biblionumbers" if $DEBUG;
1668 $results = $biblionumbers;
1669 }
1670 }
1671 }
1672 warn "return : $results for LEAF : $string" if $DEBUG;
1673 return $results;
1674 }
1675 warn "---------\nLeave NZanalyse\n---------" if $DEBUG;
1676}
1677
1678sub NZoperatorAND{
1679 my ($rightresult, $leftresult)=@_;
1680
1681 my @leftresult = split /;/, $leftresult;
1682 warn " @leftresult / $rightresult \n" if $DEBUG;
1683
1684 # my @rightresult = split /;/,$leftresult;
1685 my $finalresult;
1686
1687# parse the left results, and if the biblionumber exist in the right result, save it in finalresult
1688# the result is stored twice, to have the same weight for AND than OR.
1689# example : TWO : 61,61,64,121 (two is twice in the biblio #61) / TOWER : 61,64,130
1690# result : 61,61,61,61,64,64 for two AND tower : 61 has more weight than 64
1691 foreach (@leftresult) {
1692 my $value = $_;
1693 my $countvalue;
1694 ( $value, $countvalue ) = ( $1, $2 ) if ($value=~/(.*)-(\d+)$/);
1695 if ( $rightresult =~ /\Q$value\E-(\d+);/ ) {
1696 $countvalue = ( $1 > $countvalue ? $countvalue : $1 );
1697 $finalresult .=
1698 "$value-$countvalue;$value-$countvalue;";
1699 }
1700 }
1701 warn "NZAND DONE : $finalresult \n" if $DEBUG;
1702 return $finalresult;
1703}
1704
1705sub NZoperatorOR{
1706 my ($rightresult, $leftresult)=@_;
1707 return $rightresult.$leftresult;
1708}
1709
1710sub NZoperatorNOT{
1711 my ($leftresult, $rightresult)=@_;
1712
1713 my @leftresult = split /;/, $leftresult;
1714
1715 # my @rightresult = split /;/,$leftresult;
1716 my $finalresult;
1717 foreach (@leftresult) {
1718 my $value=$_;
1719 $value=$1 if $value=~m/(.*)-\d+$/;
1720 unless ($rightresult =~ "$value-") {
1721 $finalresult .= "$_;";
1722 }
1723 }
1724 return $finalresult;
1725}
1726
1727=head2 NZorder
1728
1729 $finalresult = NZorder($biblionumbers, $ordering,$results_per_page,$offset);
1730
1731 TODO :: Description
1732
1733=cut
1734
1735sub NZorder {
1736 my ( $biblionumbers, $ordering, $results_per_page, $offset ) = @_;
1737 warn "biblionumbers = $biblionumbers and ordering = $ordering\n" if $DEBUG;
1738
1739 # order title asc by default
1740 # $ordering = '1=36 <i' unless $ordering;
1741 $results_per_page = 20 unless $results_per_page;
1742 $offset = 0 unless $offset;
1743 my $dbh = C4::Context->dbh;
1744
1745 #
1746 # order by POPULARITY
1747 #
1748 if ( $ordering =~ /popularity/ ) {
1749 my %result;
1750 my %popularity;
1751
1752 # popularity is not in MARC record, it's builded from a specific query
1753 my $sth =
1754 $dbh->prepare("select sum(issues) from items where biblionumber=?");
1755 foreach ( split /;/, $biblionumbers ) {
1756 my ( $biblionumber, $title ) = split /,/, $_;
1757 $result{$biblionumber} = GetMarcBiblio($biblionumber);
1758 $sth->execute($biblionumber);
1759 my $popularity = $sth->fetchrow || 0;
1760
1761# hint : the key is popularity.title because we can have
1762# many results with the same popularity. In this case, sub-ordering is done by title
1763# we also have biblionumber to avoid bug for 2 biblios with the same title & popularity
1764# (un-frequent, I agree, but we won't forget anything that way ;-)
1765 $popularity{ sprintf( "%10d", $popularity ) . $title
1766 . $biblionumber } = $biblionumber;
1767 }
1768
1769 # sort the hash and return the same structure as GetRecords (Zebra querying)
1770 my $result_hash;
1771 my $numbers = 0;
1772 if ( $ordering eq 'popularity_dsc' ) { # sort popularity DESC
1773 foreach my $key ( sort { $b cmp $a } ( keys %popularity ) ) {
1774 $result_hash->{'RECORDS'}[ $numbers++ ] =
1775 $result{ $popularity{$key} }->as_usmarc();
1776 }
1777 }
1778 else { # sort popularity ASC
1779 foreach my $key ( sort ( keys %popularity ) ) {
1780 $result_hash->{'RECORDS'}[ $numbers++ ] =
1781 $result{ $popularity{$key} }->as_usmarc();
1782 }
1783 }
1784 my $finalresult = ();
1785 $result_hash->{'hits'} = $numbers;
1786 $finalresult->{'biblioserver'} = $result_hash;
1787 return $finalresult;
1788
1789 #
1790 # ORDER BY author
1791 #
1792 }
1793 elsif ( $ordering =~ /author/ ) {
1794 my %result;
1795 foreach ( split /;/, $biblionumbers ) {
1796 my ( $biblionumber, $title ) = split /,/, $_;
1797 my $record = GetMarcBiblio($biblionumber);
1798 my $author;
1799 if ( C4::Context->preference('marcflavour') eq 'UNIMARC' ) {
1800 $author = $record->subfield( '200', 'f' );
1801 $author = $record->subfield( '700', 'a' ) unless $author;
1802 }
1803 else {
1804 $author = $record->subfield( '100', 'a' );
1805 }
1806
1807# hint : the result is sorted by title.biblionumber because we can have X biblios with the same title
1808# and we don't want to get only 1 result for each of them !!!
1809 $result{ $author . $biblionumber } = $record;
1810 }
1811
1812 # sort the hash and return the same structure as GetRecords (Zebra querying)
1813 my $result_hash;
1814 my $numbers = 0;
1815 if ( $ordering eq 'author_za' ) { # sort by author desc
1816 foreach my $key ( sort { $b cmp $a } ( keys %result ) ) {
1817 $result_hash->{'RECORDS'}[ $numbers++ ] =
1818 $result{$key}->as_usmarc();
1819 }
1820 }
1821 else { # sort by author ASC
1822 foreach my $key ( sort ( keys %result ) ) {
1823 $result_hash->{'RECORDS'}[ $numbers++ ] =
1824 $result{$key}->as_usmarc();
1825 }
1826 }
1827 my $finalresult = ();
1828 $result_hash->{'hits'} = $numbers;
1829 $finalresult->{'biblioserver'} = $result_hash;
1830 return $finalresult;
1831
1832 #
1833 # ORDER BY callnumber
1834 #
1835 }
1836 elsif ( $ordering =~ /callnumber/ ) {
1837 my %result;
1838 foreach ( split /;/, $biblionumbers ) {
1839 my ( $biblionumber, $title ) = split /,/, $_;
1840 my $record = GetMarcBiblio($biblionumber);
1841 my $callnumber;
1842 my $frameworkcode = GetFrameworkCode($biblionumber);
1843 my ( $callnumber_tag, $callnumber_subfield ) = GetMarcFromKohaField( 'items.itemcallnumber', $frameworkcode);
1844 ( $callnumber_tag, $callnumber_subfield ) = GetMarcFromKohaField('biblioitems.callnumber', $frameworkcode)
1845 unless $callnumber_tag;
1846 if ( C4::Context->preference('marcflavour') eq 'UNIMARC' ) {
1847 $callnumber = $record->subfield( '200', 'f' );
1848 } else {
1849 $callnumber = $record->subfield( '100', 'a' );
1850 }
1851
1852# hint : the result is sorted by title.biblionumber because we can have X biblios with the same title
1853# and we don't want to get only 1 result for each of them !!!
1854 $result{ $callnumber . $biblionumber } = $record;
1855 }
1856
1857 # sort the hash and return the same structure as GetRecords (Zebra querying)
1858 my $result_hash;
1859 my $numbers = 0;
1860 if ( $ordering eq 'call_number_dsc' ) { # sort by title desc
1861 foreach my $key ( sort { $b cmp $a } ( keys %result ) ) {
1862 $result_hash->{'RECORDS'}[ $numbers++ ] =
1863 $result{$key}->as_usmarc();
1864 }
1865 }
1866 else { # sort by title ASC
1867 foreach my $key ( sort { $a cmp $b } ( keys %result ) ) {
1868 $result_hash->{'RECORDS'}[ $numbers++ ] =
1869 $result{$key}->as_usmarc();
1870 }
1871 }
1872 my $finalresult = ();
1873 $result_hash->{'hits'} = $numbers;
1874 $finalresult->{'biblioserver'} = $result_hash;
1875 return $finalresult;
1876 }
1877 elsif ( $ordering =~ /pubdate/ ) { #pub year
1878 my %result;
1879 foreach ( split /;/, $biblionumbers ) {
1880 my ( $biblionumber, $title ) = split /,/, $_;
1881 my $record = GetMarcBiblio($biblionumber);
1882 my ( $publicationyear_tag, $publicationyear_subfield ) =
1883 GetMarcFromKohaField( 'biblioitems.publicationyear', '' );
1884 my $publicationyear =
1885 $record->subfield( $publicationyear_tag,
1886 $publicationyear_subfield );
1887
1888# hint : the result is sorted by title.biblionumber because we can have X biblios with the same title
1889# and we don't want to get only 1 result for each of them !!!
1890 $result{ $publicationyear . $biblionumber } = $record;
1891 }
1892
1893 # sort the hash and return the same structure as GetRecords (Zebra querying)
1894 my $result_hash;
1895 my $numbers = 0;
1896 if ( $ordering eq 'pubdate_dsc' ) { # sort by pubyear desc
1897 foreach my $key ( sort { $b cmp $a } ( keys %result ) ) {
1898 $result_hash->{'RECORDS'}[ $numbers++ ] =
1899 $result{$key}->as_usmarc();
1900 }
1901 }
1902 else { # sort by pub year ASC
1903 foreach my $key ( sort ( keys %result ) ) {
1904 $result_hash->{'RECORDS'}[ $numbers++ ] =
1905 $result{$key}->as_usmarc();
1906 }
1907 }
1908 my $finalresult = ();
1909 $result_hash->{'hits'} = $numbers;
1910 $finalresult->{'biblioserver'} = $result_hash;
1911 return $finalresult;
1912
1913 #
1914 # ORDER BY title
1915 #
1916 }
1917 elsif ( $ordering =~ /title/ ) {
1918
1919# the title is in the biblionumbers string, so we just need to build a hash, sort it and return
1920 my %result;
1921 foreach ( split /;/, $biblionumbers ) {
1922 my ( $biblionumber, $title ) = split /,/, $_;
1923
1924# hint : the result is sorted by title.biblionumber because we can have X biblios with the same title
1925# and we don't want to get only 1 result for each of them !!!
1926# hint & speed improvement : we can order without reading the record
1927# so order, and read records only for the requested page !
1928 $result{ $title . $biblionumber } = $biblionumber;
1929 }
1930
1931 # sort the hash and return the same structure as GetRecords (Zebra querying)
1932 my $result_hash;
1933 my $numbers = 0;
1934 if ( $ordering eq 'title_az' ) { # sort by title desc
1935 foreach my $key ( sort ( keys %result ) ) {
1936 $result_hash->{'RECORDS'}[ $numbers++ ] = $result{$key};
1937 }
1938 }
1939 else { # sort by title ASC
1940 foreach my $key ( sort { $b cmp $a } ( keys %result ) ) {
1941 $result_hash->{'RECORDS'}[ $numbers++ ] = $result{$key};
1942 }
1943 }
1944
1945 # limit the $results_per_page to result size if it's more
1946 $results_per_page = $numbers - 1 if $numbers < $results_per_page;
1947
1948 # for the requested page, replace biblionumber by the complete record
1949 # speed improvement : avoid reading too much things
1950 for (
1951 my $counter = $offset ;
1952 $counter <= $offset + $results_per_page ;
1953 $counter++
1954 )
1955 {
1956 $result_hash->{'RECORDS'}[$counter] =
1957 GetMarcBiblio( $result_hash->{'RECORDS'}[$counter] )->as_usmarc;
1958 }
1959 my $finalresult = ();
1960 $result_hash->{'hits'} = $numbers;
1961 $finalresult->{'biblioserver'} = $result_hash;
1962 return $finalresult;
1963 }
1964 else {
1965
1966#
1967# order by ranking
1968#
1969# we need 2 hashes to order by ranking : the 1st one to count the ranking, the 2nd to order by ranking
1970 my %result;
1971 my %count_ranking;
1972 foreach ( split /;/, $biblionumbers ) {
1973 my ( $biblionumber, $title ) = split /,/, $_;
1974 $title =~ /(.*)-(\d)/;
1975
1976 # get weight
1977 my $ranking = $2;
1978
1979# note that we + the ranking because ranking is calculated on weight of EACH term requested.
1980# if we ask for "two towers", and "two" has weight 2 in biblio N, and "towers" has weight 4 in biblio N
1981# biblio N has ranking = 6
1982 $count_ranking{$biblionumber} += $ranking;
1983 }
1984
1985# build the result by "inverting" the count_ranking hash
1986# 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
1987# warn "counting";
1988 foreach ( keys %count_ranking ) {
1989 $result{ sprintf( "%10d", $count_ranking{$_} ) . '-' . $_ } = $_;
1990 }
1991
1992 # sort the hash and return the same structure as GetRecords (Zebra querying)
1993 my $result_hash;
1994 my $numbers = 0;
1995 foreach my $key ( sort { $b cmp $a } ( keys %result ) ) {
1996 $result_hash->{'RECORDS'}[ $numbers++ ] = $result{$key};
1997 }
1998
1999 # limit the $results_per_page to result size if it's more
2000 $results_per_page = $numbers - 1 if $numbers < $results_per_page;
2001
2002 # for the requested page, replace biblionumber by the complete record
2003 # speed improvement : avoid reading too much things
2004 for (
2005 my $counter = $offset ;
2006 $counter <= $offset + $results_per_page ;
2007 $counter++
2008 )
2009 {
2010 $result_hash->{'RECORDS'}[$counter] =
2011 GetMarcBiblio( $result_hash->{'RECORDS'}[$counter] )->as_usmarc
2012 if $result_hash->{'RECORDS'}[$counter];
2013 }
2014 my $finalresult = ();
2015 $result_hash->{'hits'} = $numbers;
2016 $finalresult->{'biblioserver'} = $result_hash;
2017 return $finalresult;
2018 }
2019}
2020
2021=head2 enabled_staff_search_views
2022
2023%hash = enabled_staff_search_views()
2024
2025This function returns a hash that contains three flags obtained from the system
2026preferences, used to determine whether a particular staff search results view
2027is enabled.
2028
2029=over 2
2030
2031=item C<Output arg:>
2032
2033 * $hash{can_view_MARC} is true only if the MARC view is enabled
2034 * $hash{can_view_ISBD} is true only if the ISBD view is enabled
2035 * $hash{can_view_labeledMARC} is true only if the Labeled MARC view is enabled
2036
2037=item C<usage in the script:>
2038
2039=back
2040
2041$template->param ( C4::Search::enabled_staff_search_views );
2042
2043=cut
2044
2045sub enabled_staff_search_views
2046{
2047 return (
2048 can_view_MARC => C4::Context->preference('viewMARC'), # 1 if the staff search allows the MARC view
2049 can_view_ISBD => C4::Context->preference('viewISBD'), # 1 if the staff search allows the ISBD view
2050 can_view_labeledMARC => C4::Context->preference('viewLabeledMARC'), # 1 if the staff search allows the Labeled MARC view
2051 );
2052}
2053
2054
2055=head2 z3950_search_args
2056
2057$arrayref = z3950_search_args($matchpoints)
2058
2059This function returns an array reference that contains the search parameters to be
2060passed to the Z39.50 search script (z3950_search.pl). The array elements
2061are hash refs whose keys are name, value and encvalue, and whose values are the
2062name of a search parameter, the value of that search parameter and the URL encoded
2063value of that parameter.
2064
2065The search parameter names are lccn, isbn, issn, title, author, dewey and subject.
2066
2067The search parameter values are obtained from the bibliographic record whose
2068data is in a hash reference in $matchpoints, as returned by Biblio::GetBiblioData().
2069
2070If $matchpoints is a scalar, it is assumed to be an unnamed query descriptor, e.g.
2071a general purpose search argument. In this case, the returned array contains only
2072entry: the key is 'title' and the value and encvalue are derived from $matchpoints.
2073
2074If a search parameter value is undefined or empty, it is not included in the returned
2075array.
2076
2077The returned array reference may be passed directly to the template parameters.
2078
2079=over 2
2080
2081=item C<Output arg:>
2082
2083 * $array containing hash refs as described above
2084
2085=item C<usage in the script:>
2086
2087=back
2088
2089$data = Biblio::GetBiblioData($bibno);
2090$template->param ( MYLOOP => C4::Search::z3950_search_args($data) )
2091
2092*OR*
2093
2094$template->param ( MYLOOP => C4::Search::z3950_search_args($searchscalar) )
2095
2096=cut
2097
2098sub z3950_search_args {
2099 my $bibrec = shift;
2100 $bibrec = { title => $bibrec } if !ref $bibrec;
2101 my $array = [];
2102 for my $field (qw/ lccn isbn issn title author dewey subject /)
2103 {
2104 my $encvalue = URI::Escape::uri_escape_utf8($bibrec->{$field});
2105 push @$array, { name=>$field, value=>$bibrec->{$field}, encvalue=>$encvalue } if defined $bibrec->{$field};
2106 }
2107 return $array;
2108}
2109
2110
21111300ns300nsEND { } # module clean-up code here (global destructor)
2112
211318µs8µs1;
2114__END__
2115
2116=head1 AUTHOR
2117
2118Koha Developement team <info@koha.org>
2119
2120=cut
Report produced by the NYTProf 2.10 Perl profiler, developed by Tim Bunce and Adam Kaplan.