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
21 use C4::Biblio; # GetMarcFromKohaField
22 use C4::Koha; # getFacets
24 use C4::Search::PazPar2;
26 use C4::Dates qw(format_date);
28 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $DEBUG);
30 # set the version for version checking
33 $DEBUG = ($ENV{DEBUG}) ? 1 : 0;
38 C4::Search - Functions for searching the Koha catalog.
42 See opac/opac-search.pl or catalogue/search.pl for example of usage
46 This module provides searching functions for Koha's bibliographic databases
64 # make all your functions, whether exported or not;
66 =head2 findseealso($dbh,$fields);
68 C<$dbh> is a link to the DB handler.
71 my $dbh =C4::Context->dbh;
73 C<$fields> is a reference to the fields array
75 This function modifies the @$fields array and adds related fields to search on.
77 FIXME: this function is probably deprecated in Koha 3
82 my ( $dbh, $fields ) = @_;
83 my $tagslib = GetMarcStructure(1);
84 for ( my $i = 0 ; $i <= $#{$fields} ; $i++ ) {
85 my ($tag) = substr( @$fields[$i], 1, 3 );
86 my ($subfield) = substr( @$fields[$i], 4, 1 );
87 @$fields[$i] .= ',' . $tagslib->{$tag}->{$subfield}->{seealso}
88 if ( $tagslib->{$tag}->{$subfield}->{seealso} );
94 ($biblionumber,$biblionumber,$title) = FindDuplicate($record);
96 This function attempts to find duplicate records using a hard-coded, fairly simplistic algorithm
102 my $dbh = C4::Context->dbh;
103 my $result = TransformMarcToKoha( $dbh, $record, '' );
108 my ( $biblionumber, $title );
110 # search duplicate on ISBN, easy and fast..
111 # ... normalize first
112 if ( $result->{isbn} ) {
113 $result->{isbn} =~ s/\(.*$//;
114 $result->{isbn} =~ s/\s+$//;
115 $query = "isbn=$result->{isbn}";
118 $result->{title} =~ s /\\//g;
119 $result->{title} =~ s /\"//g;
120 $result->{title} =~ s /\(//g;
121 $result->{title} =~ s /\)//g;
123 # FIXME: instead of removing operators, could just do
124 # quotes around the value
125 $result->{title} =~ s/(and|or|not)//g;
126 $query = "ti,ext=$result->{title}";
127 $query .= " and itemtype=$result->{itemtype}"
128 if ( $result->{itemtype} );
129 if ( $result->{author} ) {
130 $result->{author} =~ s /\\//g;
131 $result->{author} =~ s /\"//g;
132 $result->{author} =~ s /\(//g;
133 $result->{author} =~ s /\)//g;
135 # remove valid operators
136 $result->{author} =~ s/(and|or|not)//g;
137 $query .= " and au,ext=$result->{author}";
141 # FIXME: add error handling
142 my ( $error, $searchresults ) = SimpleSearch($query); # FIXME :: hardcoded !
144 foreach my $possible_duplicate_record (@$searchresults) {
146 MARC::Record->new_from_usmarc($possible_duplicate_record);
147 my $result = TransformMarcToKoha( $dbh, $marcrecord, '' );
149 # FIXME :: why 2 $biblionumber ?
151 push @results, $result->{'biblionumber'};
152 push @results, $result->{'title'};
160 ($error,$results) = SimpleSearch($query,@servers);
162 This function provides a simple search API on the bibliographic catalog
168 * $query can be a simple keyword or a complete CCL query
169 * @servers is optional. Defaults to biblioserver as found in koha-conf.xml
172 * $error is a empty unless an error is detected
173 * \@results is an array of records.
175 =item C<usage in the script:>
179 my ($error, $marcresults) = SimpleSearch($query);
181 if (defined $error) {
182 $template->param(query_error => $error);
183 warn "error: ".$error;
184 output_html_with_http_headers $input, $cookie, $template->output;
188 my $hits = scalar @$marcresults;
191 for(my $i=0;$i<$hits;$i++) {
193 my $marcrecord = MARC::File::USMARC::decode($marcresults->[$i]);
194 my $biblio = TransformMarcToKoha(C4::Context->dbh,$marcrecord,'');
196 #build the hash for the template.
197 $resultsloop{highlight} = ($i % 2)?(1):(0);
198 $resultsloop{title} = $biblio->{'title'};
199 $resultsloop{subtitle} = $biblio->{'subtitle'};
200 $resultsloop{biblionumber} = $biblio->{'biblionumber'};
201 $resultsloop{author} = $biblio->{'author'};
202 $resultsloop{publishercode} = $biblio->{'publishercode'};
203 $resultsloop{publicationyear} = $biblio->{'publicationyear'};
205 push @results, \%resultsloop;
208 $template->param(result=>\@results);
214 if ( C4::Context->preference('NoZebra') ) {
215 my $result = NZorder( NZanalyse($query) )->{'biblioserver'};
218 && $result->{hits} > 0 ? $result->{'RECORDS'} : [] );
219 return ( undef, $search_result );
226 return ( "No query entered", undef ) unless $query;
228 # FIXME hardcoded value. See catalog/search.pl & opac-search.pl too.
229 @servers = ("biblioserver") unless @servers;
231 # Initialize & Search Zebra
232 for ( my $i = 0 ; $i < @servers ; $i++ ) {
234 $zconns[$i] = C4::Context->Zconn( $servers[$i], 1 );
237 ->search( new ZOOM::Query::CCL2RPN( $query, $zconns[$i] ) );
241 $zconns[$i]->errmsg() . " ("
242 . $zconns[$i]->errcode() . ") "
243 . $zconns[$i]->addinfo() . " "
244 . $zconns[$i]->diagset();
246 return ( $error, undef ) if $zconns[$i]->errcode();
250 # caught a ZOOM::Exception
254 . $@->addinfo() . " "
257 return ( $error, undef );
262 while ( ( my $i = ZOOM::event( \@zconns ) ) != 0 ) {
263 $ev = $zconns[ $i - 1 ]->last_event();
264 if ( $ev == ZOOM::Event::ZEND ) {
265 $hits = $tmpresults[ $i - 1 ]->size();
268 for ( my $j = 0 ; $j < $hits ; $j++ ) {
269 my $record = $tmpresults[ $i - 1 ]->record($j)->raw();
270 push @results, $record;
275 return ( undef, \@results );
281 ( undef, $results_hashref, \@facets_loop ) = getRecords (
283 $koha_query, $simple_query, $sort_by_ref, $servers_ref,
284 $results_per_page, $offset, $expanded_facet, $branches,
288 The all singing, all dancing, multi-server, asynchronous, scanning,
289 searching, record nabbing, facet-building
291 See verbse embedded documentation.
297 $koha_query, $simple_query, $sort_by_ref, $servers_ref,
298 $results_per_page, $offset, $expanded_facet, $branches,
302 my @servers = @$servers_ref;
303 my @sort_by = @$sort_by_ref;
305 # Initialize variables for the ZOOM connection and results object
309 my $results_hashref = ();
311 # Initialize variables for the faceted results objects
312 my $facets_counter = ();
313 my $facets_info = ();
314 my $facets = getFacets();
317 ; # stores the ref to array of hashes for template facets loop
319 ### LOOP THROUGH THE SERVERS
320 for ( my $i = 0 ; $i < @servers ; $i++ ) {
321 $zconns[$i] = C4::Context->Zconn( $servers[$i], 1 );
323 # perform the search, create the results objects
324 # if this is a local search, use the $koha-query, if it's a federated one, use the federated-query
326 if ( $servers[$i] =~ /biblioserver/ ) {
327 $query_to_use = $koha_query;
330 $query_to_use = $simple_query;
333 #$query_to_use = $simple_query if $scan;
334 warn $simple_query if ( $scan and $DEBUG );
336 # Check if we've got a query_type defined, if so, use it
340 if ( $query_type =~ /^ccl/ ) {
342 s/\:/\=/g; # change : to = last minute (FIXME)
345 new ZOOM::Query::CCL2RPN( $query_to_use, $zconns[$i] )
348 elsif ( $query_type =~ /^cql/ ) {
351 new ZOOM::Query::CQL( $query_to_use, $zconns[$i] ) );
353 elsif ( $query_type =~ /^pqf/ ) {
356 new ZOOM::Query::PQF( $query_to_use, $zconns[$i] ) );
363 new ZOOM::Query::CCL2RPN( $query_to_use, $zconns[$i] )
369 new ZOOM::Query::CCL2RPN( $query_to_use, $zconns[$i] )
375 warn "WARNING: query problem with $query_to_use " . $@;
378 # Concatenate the sort_by limits and pass them to the results object
379 # Note: sort will override rank
381 foreach my $sort (@sort_by) {
382 if ( $sort eq "author_az" ) {
383 $sort_by .= "1=1003 <i ";
385 elsif ( $sort eq "author_za" ) {
386 $sort_by .= "1=1003 >i ";
388 elsif ( $sort eq "popularity_asc" ) {
389 $sort_by .= "1=9003 <i ";
391 elsif ( $sort eq "popularity_dsc" ) {
392 $sort_by .= "1=9003 >i ";
394 elsif ( $sort eq "call_number_asc" ) {
395 $sort_by .= "1=20 <i ";
397 elsif ( $sort eq "call_number_dsc" ) {
398 $sort_by .= "1=20 >i ";
400 elsif ( $sort eq "pubdate_asc" ) {
401 $sort_by .= "1=31 <i ";
403 elsif ( $sort eq "pubdate_dsc" ) {
404 $sort_by .= "1=31 >i ";
406 elsif ( $sort eq "acqdate_asc" ) {
407 $sort_by .= "1=32 <i ";
409 elsif ( $sort eq "acqdate_dsc" ) {
410 $sort_by .= "1=32 >i ";
412 elsif ( $sort eq "title_az" ) {
413 $sort_by .= "1=4 <i ";
415 elsif ( $sort eq "title_za" ) {
416 $sort_by .= "1=4 >i ";
420 if ( $results[$i]->sort( "yaz", $sort_by ) < 0 ) {
421 warn "WARNING sort $sort_by failed";
424 } # finished looping through servers
426 # The big moment: asynchronously retrieve results from all servers
427 while ( ( my $i = ZOOM::event( \@zconns ) ) != 0 ) {
428 my $ev = $zconns[ $i - 1 ]->last_event();
429 if ( $ev == ZOOM::Event::ZEND ) {
430 next unless $results[ $i - 1 ];
431 my $size = $results[ $i - 1 ]->size();
435 # loop through the results
436 $results_hash->{'hits'} = $size;
438 if ( $offset + $results_per_page <= $size ) {
439 $times = $offset + $results_per_page;
444 for ( my $j = $offset ; $j < $times ; $j++ ) {
449 ## Check if it's an index scan
451 my ( $term, $occ ) = $results[ $i - 1 ]->term($j);
453 # here we create a minimal MARC record and hand it off to the
454 # template just like a normal result ... perhaps not ideal, but
456 my $tmprecord = MARC::Record->new();
457 $tmprecord->encoding('UTF-8');
461 # the minimal record in author/title (depending on MARC flavour)
462 if ( C4::Context->preference("marcflavour") eq
465 $tmptitle = MARC::Field->new(
473 MARC::Field->new( '245', ' ', ' ', a => $term, );
475 MARC::Field->new( '100', ' ', ' ', a => $occ, );
477 $tmprecord->append_fields($tmptitle);
478 $tmprecord->append_fields($tmpauthor);
479 $results_hash->{'RECORDS'}[$j] =
480 $tmprecord->as_usmarc();
485 $record = $results[ $i - 1 ]->record($j)->raw();
487 # warn "RECORD $j:".$record;
488 $results_hash->{'RECORDS'}[$j] = $record;
490 # Fill the facets while we're looping, but only for the biblioserver
491 $facet_record = MARC::Record->new_from_usmarc($record)
492 if $servers[ $i - 1 ] =~ /biblioserver/;
494 #warn $servers[$i-1]."\n".$record; #.$facet_record->title();
496 for ( my $k = 0 ; $k <= @$facets ; $k++ ) {
498 if ( $facets->[$k] ) {
500 for my $tag ( @{ $facets->[$k]->{'tags'} } )
503 $facet_record->field($tag);
505 for my $field (@fields) {
506 my @subfields = $field->subfields();
507 for my $subfield (@subfields) {
508 my ( $code, $data ) = @$subfield;
510 $facets->[$k]->{'subfield'} )
512 $facets_counter->{ $facets->[$k]
518 $facets_info->{ $facets->[$k]
519 ->{'link_value'} }->{'label_value'} =
520 $facets->[$k]->{'label_value'};
521 $facets_info->{ $facets->[$k]
522 ->{'link_value'} }->{'expanded'} =
523 $facets->[$k]->{'expanded'};
529 $results_hashref->{ $servers[ $i - 1 ] } = $results_hash;
532 # warn "connection ", $i-1, ": $size hits";
533 # warn $results[$i-1]->record(0)->render() if $size > 0;
536 if ( $servers[ $i - 1 ] =~ /biblioserver/ ) {
538 sort { $facets_counter->{$b} <=> $facets_counter->{$a} }
539 keys %$facets_counter )
542 my $number_of_facets;
543 my @this_facets_array;
546 $facets_counter->{$link_value}
547 ->{$b} <=> $facets_counter->{$link_value}->{$a}
548 } keys %{ $facets_counter->{$link_value} }
552 if ( ( $number_of_facets < 6 )
553 || ( $expanded_facet eq $link_value )
554 || ( $facets_info->{$link_value}->{'expanded'} ) )
557 # Sanitize the link value ), ( will cause errors with CCL,
558 my $facet_link_value = $one_facet;
559 $facet_link_value =~ s/(\(|\))/ /g;
561 # fix the length that will display in the label,
562 my $facet_label_value = $one_facet;
564 substr( $one_facet, 0, 20 ) . "..."
565 unless length($facet_label_value) <= 20;
567 # if it's a branch, label by the name, not the code,
568 if ( $link_value =~ /branch/ ) {
570 $branches->{$one_facet}->{'branchname'};
573 # but we're down with the whole label being in the link's title.
574 my $facet_title_value = $one_facet;
576 push @this_facets_array,
580 $facets_counter->{$link_value}
582 facet_label_value => $facet_label_value,
583 facet_title_value => $facet_title_value,
584 facet_link_value => $facet_link_value,
585 type_link_value => $link_value,
591 # handle expanded option
592 unless ( $facets_info->{$link_value}->{'expanded'} ) {
594 if ( ( $number_of_facets > 6 )
595 && ( $expanded_facet ne $link_value ) );
600 type_link_value => $link_value,
601 type_id => $link_value . "_id",
603 $facets_info->{$link_value}->{'label_value'},
604 facets => \@this_facets_array,
605 expandable => $expandable,
606 expand => $link_value,
613 return ( undef, $results_hashref, \@facets_loop );
618 $koha_query, $simple_query, $sort_by_ref, $servers_ref,
619 $results_per_page, $offset, $expanded_facet, $branches,
623 my $paz = C4::Search::PazPar2->new(C4::Context->config('pazpar2url'));
625 $paz->search($simple_query);
629 my $results_hashref = {};
630 my $stats = XMLin($paz->stat);
631 my $results = XMLin($paz->show($offset, $results_per_page, 'work-title:1'), forcearray => 1);
633 # for a grouped search result, the number of hits
634 # is the number of groups returned; 'bib_hits' will have
635 # the total number of bibs.
636 $results_hashref->{'biblioserver'}->{'hits'} = $results->{'merged'}->[0];
637 $results_hashref->{'biblioserver'}->{'bib_hits'} = $stats->{'hits'};
639 HIT: foreach my $hit (@{ $results->{'hit'} }) {
640 my $recid = $hit->{recid}->[0];
642 my $work_title = $hit->{'md-work-title'}->[0];
644 if (exists $hit->{'md-work-author'}) {
645 $work_author = $hit->{'md-work-author'}->[0];
647 my $group_label = (defined $work_author) ? "$work_title / $work_author" : $work_title;
649 my $result_group = {};
650 $result_group->{'group_label'} = $group_label;
651 $result_group->{'group_merge_key'} = $recid;
654 if (exists $hit->{count}) {
655 $count = $hit->{count}->[0];
657 $result_group->{'group_count'} = $count;
659 for (my $i = 0; $i < $count; $i++) {
660 # FIXME -- may need to worry about diacritics here
661 my $rec = $paz->record($recid, $i);
662 push @{ $result_group->{'RECORDS'} }, $rec;
665 push @{ $results_hashref->{'biblioserver'}->{'GROUPS'} }, $result_group;
668 # pass through facets
669 my $termlist_xml = $paz->termlist('author,subject');
670 my $terms = XMLin($termlist_xml, forcearray => 1);
671 my @facets_loop = ();
672 #die Dumper($results);
673 # foreach my $list (sort keys %{ $terms->{'list'} }) {
675 # foreach my $facet (sort @{ $terms->{'list'}->{$list}->{'term'} } ) {
677 # facet_label_value => $facet->{'name'}->[0],
680 # push @facets_loop, ( {
681 # type_label => $list,
682 # facets => \@facets,
686 return ( undef, $results_hashref, \@facets_loop );
690 sub _remove_stopwords {
691 my ( $operand, $index ) = @_;
692 my @stopwords_removed;
694 # phrase and exact-qualified indexes shouldn't have stopwords removed
695 if ( $index !~ m/phr|ext/ ) {
697 # remove stopwords from operand : parse all stopwords & remove them (case insensitive)
698 # we use IsAlpha unicode definition, to deal correctly with diacritics.
699 # otherwise, a French word like "leçon" woudl be split into "le" "çon", "le"
700 # is a stopword, we'd get "çon" and wouldn't find anything...
701 foreach ( keys %{ C4::Context->stopwords } ) {
702 next if ( $_ =~ /(and|or|not)/ ); # don't remove operators
704 /(\P{IsAlpha}$_\P{IsAlpha}|^$_\P{IsAlpha}|\P{IsAlpha}$_$)/ )
706 $operand =~ s/\P{IsAlpha}$_\P{IsAlpha}/ /gi;
707 $operand =~ s/^$_\P{IsAlpha}/ /gi;
708 $operand =~ s/\P{IsAlpha}$_$/ /gi;
709 push @stopwords_removed, $_;
713 return ( $operand, \@stopwords_removed );
717 sub _detect_truncation {
718 my ( $operand, $index ) = @_;
719 my ( @nontruncated, @righttruncated, @lefttruncated, @rightlefttruncated,
722 my @wordlist = split( /\s/, $operand );
723 foreach my $word (@wordlist) {
724 if ( $word =~ s/^\*([^\*]+)\*$/$1/ ) {
725 push @rightlefttruncated, $word;
727 elsif ( $word =~ s/^\*([^\*]+)$/$1/ ) {
728 push @lefttruncated, $word;
730 elsif ( $word =~ s/^([^\*]+)\*$/$1/ ) {
731 push @righttruncated, $word;
733 elsif ( index( $word, "*" ) < 0 ) {
734 push @nontruncated, $word;
737 push @regexpr, $word;
741 \@nontruncated, \@righttruncated, \@lefttruncated,
742 \@rightlefttruncated, \@regexpr
747 sub _build_stemmed_operand {
751 # FIXME: the locale should be set based on the user's language and/or search choice
752 my $stemmer = Lingua::Stem->new( -locale => 'EN-US' );
754 # FIXME: these should be stored in the db so the librarian can modify the behavior
755 $stemmer->add_exceptions(
762 my @words = split( / /, $operand );
763 my $stems = $stemmer->stem(@words);
764 for my $stem (@$stems) {
765 $stemmed_operand .= "$stem";
766 $stemmed_operand .= "?"
767 unless ( $stem =~ /(and$|or$|not$)/ ) || ( length($stem) < 3 );
768 $stemmed_operand .= " ";
770 warn "STEMMED OPERAND: $stemmed_operand" if $DEBUG;
771 return $stemmed_operand;
775 sub _build_weighted_query {
777 # FIELD WEIGHTING - This is largely experimental stuff. What I'm committing works
778 # pretty well but could work much better if we had a smarter query parser
779 my ( $operand, $stemmed_operand, $index ) = @_;
780 my $stemming = C4::Context->preference("QueryStemming") || 0;
781 my $weight_fields = C4::Context->preference("QueryWeightFields") || 0;
782 my $fuzzy_enabled = C4::Context->preference("QueryFuzzy") || 0;
784 my $weighted_query .= "(rk=("; # Specifies that we're applying rank
786 # Keyword, or, no index specified
787 if ( ( $index eq 'kw' ) || ( !$index ) ) {
789 "Title-cover,ext,r1=\"$operand\""; # exact title-cover
790 $weighted_query .= " or ti,ext,r2=\"$operand\""; # exact title
791 $weighted_query .= " or ti,phr,r3=\"$operand\""; # phrase title
792 #$weighted_query .= " or any,ext,r4=$operand"; # exact any
793 #$weighted_query .=" or kw,wrdl,r5=\"$operand\""; # word list any
794 $weighted_query .= " or wrdl,fuzzy,r8=\"$operand\""
795 if $fuzzy_enabled; # add fuzzy, word list
796 $weighted_query .= " or wrdl,right-Truncation,r9=\"$stemmed_operand\""
797 if ( $stemming and $stemmed_operand )
798 ; # add stemming, right truncation
799 $weighted_query .= " or wrdl,r9=\"$operand\"";
801 # embedded sorting: 0 a-z; 1 z-a
802 # $weighted_query .= ") or (sort1,aut=1";
805 # Barcode searches should skip this process
806 elsif ( $index eq 'bc' ) {
807 $weighted_query .= "bc=\"$operand\"";
810 # Authority-number searches should skip this process
811 elsif ( $index eq 'an' ) {
812 $weighted_query .= "an=\"$operand\"";
815 # If the index already has more than one qualifier, wrap the operand
816 # in quotes and pass it back (assumption is that the user knows what they
817 # are doing and won't appreciate us mucking up their query
818 elsif ( $index =~ ',' ) {
819 $weighted_query .= " $index=\"$operand\"";
822 #TODO: build better cases based on specific search indexes
824 $weighted_query .= " $index,ext,r1=\"$operand\""; # exact index
825 #$weighted_query .= " or (title-sort-az=0 or $index,startswithnt,st-word,r3=$operand #)";
826 $weighted_query .= " or $index,phr,r3=\"$operand\""; # phrase index
828 " or $index,rt,wrdl,r3=\"$operand\""; # word list index
831 $weighted_query .= "))"; # close rank specification
832 return $weighted_query;
838 $simple_query, $query_cgi,
840 $limit_cgi, $limit_desc,
841 $stopwords_removed, $query_type ) = getRecords ( $operators, $operands, $indexes, $limits, $sort_by, $scan);
843 Build queries and limits in CCL, CGI, Human,
844 handle truncation, stemming, field weighting, stopwords, fuzziness, etc.
846 See verbose embedded documentation.
852 my ( $operators, $operands, $indexes, $limits, $sort_by, $scan ) = @_;
854 warn "---------" if $DEBUG;
855 warn "Enter buildQuery" if $DEBUG;
856 warn "---------" if $DEBUG;
859 my @operators = @$operators if $operators;
860 my @indexes = @$indexes if $indexes;
861 my @operands = @$operands if $operands;
862 my @limits = @$limits if $limits;
863 my @sort_by = @$sort_by if $sort_by;
865 my $stemming = C4::Context->preference("QueryStemming") || 0;
866 my $auto_truncation = C4::Context->preference("QueryAutoTruncate") || 0;
867 my $weight_fields = C4::Context->preference("QueryWeightFields") || 0;
868 my $fuzzy_enabled = C4::Context->preference("QueryFuzzy") || 0;
869 my $remove_stopwords = C4::Context->preference("QueryRemoveStopwords") || 0;
871 # no stemming/weight/fuzzy in NoZebra
872 if ( C4::Context->preference("NoZebra") ) {
878 my $query = $operands[0];
879 my $simple_query = $operands[0];
881 # initialize the variables we're passing back
890 my $stopwords_removed; # flag to determine if stopwords have been removed
892 # for handling ccl, cql, pqf queries in diagnostic mode, skip the rest of the steps
894 if ( $query =~ /^ccl=/ ) {
895 return ( undef, $', $', $', $', '', '', '', '', 'ccl' );
897 if ( $query =~ /^cql=/ ) {
898 return ( undef, $', $', $', $', '', '', '', '', 'cql' );
900 if ( $query =~ /^pqf=/ ) {
901 return ( undef, $', $', $', $', '', '', '', '', 'pqf' );
904 # pass nested queries directly
905 # FIXME: need better handling of some of these variables in this case
906 if ( $query =~ /(\(|\))/ ) {
908 undef, $query, $simple_query, $query_cgi,
909 $query, $limit, $limit_cgi, $limit_desc,
910 $stopwords_removed, 'ccl'
914 # Form-based queries are non-nested and fixed depth, so we can easily modify the incoming
915 # query operands and indexes and add stemming, truncation, field weighting, etc.
916 # Once we do so, we'll end up with a value in $query, just like if we had an
917 # incoming $query from the user
920 ; # clear it out so we can populate properly with field-weighted, stemmed, etc. query
922 ; # a flag used to keep track if there was a previous query
923 # if there was, we can apply the current operator
925 for ( my $i = 0 ; $i <= @operands ; $i++ ) {
927 # COMBINE OPERANDS, INDEXES AND OPERATORS
928 if ( $operands[$i] ) {
930 # A flag to determine whether or not to add the index to the query
933 # If the user is sophisticated enough to specify an index, turn off field weighting, stemming, and stopword handling
934 if ( $operands[$i] =~ /(:|=)/ || $scan ) {
937 $remove_stopwords = 0;
939 my $operand = $operands[$i];
940 my $index = $indexes[$i];
942 # Add index-specific attributes
943 # Date of Publication
944 if ( $index eq 'yr' ) {
945 $index .= ",st-numeric";
948 $stemming, $auto_truncation,
949 $weight_fields, $fuzzy_enabled,
951 ) = ( 0, 0, 0, 0, 0 );
954 # Date of Acquisition
955 elsif ( $index eq 'acqdate' ) {
956 $index .= ",st-date-normalized";
959 $stemming, $auto_truncation,
960 $weight_fields, $fuzzy_enabled,
962 ) = ( 0, 0, 0, 0, 0 );
965 # Set default structure attribute (word list)
967 unless ( !$index || $index =~ /(st-|phr|ext|wrdl)/ ) {
968 $struct_attr = ",wrdl";
971 # Some helpful index variants
972 my $index_plus = $index . $struct_attr . ":" if $index;
973 my $index_plus_comma = $index . $struct_attr . "," if $index;
976 if ($remove_stopwords) {
977 ( $operand, $stopwords_removed ) =
978 _remove_stopwords( $operand, $index );
979 warn "OPERAND w/out STOPWORDS: >$operand<" if $DEBUG;
980 warn "REMOVED STOPWORDS: @$stopwords_removed"
981 if ( $stopwords_removed && $DEBUG );
985 my ( $nontruncated, $righttruncated, $lefttruncated,
986 $rightlefttruncated, $regexpr );
987 my $truncated_operand;
989 $nontruncated, $righttruncated, $lefttruncated,
990 $rightlefttruncated, $regexpr
991 ) = _detect_truncation( $operand, $index );
993 "TRUNCATION: NON:>@$nontruncated< RIGHT:>@$righttruncated< LEFT:>@$lefttruncated< RIGHTLEFT:>@$rightlefttruncated< REGEX:>@$regexpr<"
998 scalar(@$righttruncated) + scalar(@$lefttruncated) +
999 scalar(@$rightlefttruncated) > 0 )
1002 # Don't field weight or add the index to the query, we do it here
1004 undef $weight_fields;
1005 my $previous_truncation_operand;
1006 if ( scalar(@$nontruncated) > 0 ) {
1007 $truncated_operand .= "$index_plus @$nontruncated ";
1008 $previous_truncation_operand = 1;
1010 if ( scalar(@$righttruncated) > 0 ) {
1011 $truncated_operand .= "and "
1012 if $previous_truncation_operand;
1013 $truncated_operand .=
1014 "$index_plus_comma" . "rtrn:@$righttruncated ";
1015 $previous_truncation_operand = 1;
1017 if ( scalar(@$lefttruncated) > 0 ) {
1018 $truncated_operand .= "and "
1019 if $previous_truncation_operand;
1020 $truncated_operand .=
1021 "$index_plus_comma" . "ltrn:@$lefttruncated ";
1022 $previous_truncation_operand = 1;
1024 if ( scalar(@$rightlefttruncated) > 0 ) {
1025 $truncated_operand .= "and "
1026 if $previous_truncation_operand;
1027 $truncated_operand .=
1028 "$index_plus_comma" . "rltrn:@$rightlefttruncated ";
1029 $previous_truncation_operand = 1;
1032 $operand = $truncated_operand if $truncated_operand;
1033 warn "TRUNCATED OPERAND: >$truncated_operand<" if $DEBUG;
1036 my $stemmed_operand;
1037 $stemmed_operand = _build_stemmed_operand($operand)
1039 warn "STEMMED OPERAND: >$stemmed_operand<" if $DEBUG;
1041 # Handle Field Weighting
1042 my $weighted_operand;
1044 _build_weighted_query( $operand, $stemmed_operand, $index )
1046 warn "FIELD WEIGHTED OPERAND: >$weighted_operand<" if $DEBUG;
1047 $operand = $weighted_operand if $weight_fields;
1048 $indexes_set = 1 if $weight_fields;
1050 # If there's a previous operand, we need to add an operator
1051 if ($previous_operand) {
1053 # User-specified operator
1054 if ( $operators[ $i - 1 ] ) {
1055 $query .= " $operators[$i-1] ";
1056 $query .= " $index_plus " unless $indexes_set;
1057 $query .= " $operand";
1058 $query_cgi .= "&op=$operators[$i-1]";
1059 $query_cgi .= "&idx=$index" if $index;
1060 $query_cgi .= "&q=$operands[$i]" if $operands[$i];
1062 " $operators[$i-1] $index_plus $operands[$i]";
1065 # Default operator is and
1068 $query .= "$index_plus " unless $indexes_set;
1069 $query .= "$operand";
1070 $query_cgi .= "&op=and&idx=$index" if $index;
1071 $query_cgi .= "&q=$operands[$i]" if $operands[$i];
1072 $query_desc .= " and $index_plus $operands[$i]";
1076 # There isn't a pervious operand, don't need an operator
1079 # Field-weighted queries already have indexes set
1080 $query .= " $index_plus " unless $indexes_set;
1082 $query_desc .= " $index_plus $operands[$i]";
1083 $query_cgi .= "&idx=$index" if $index;
1084 $query_cgi .= "&q=$operands[$i]" if $operands[$i];
1085 $previous_operand = 1;
1090 warn "QUERY BEFORE LIMITS: >$query<" if $DEBUG;
1093 my $group_OR_limits;
1094 my $availability_limit;
1095 foreach my $this_limit (@limits) {
1096 if ( $this_limit =~ /available/ ) {
1098 # 'available' is defined as (items.onloan is NULL) and (items.itemlost = 0)
1100 # all records not indexed in the onloan register (zebra) and all records with a value of lost equal to 0
1101 $availability_limit .=
1102 "( ( allrecords,AlwaysMatches='' not onloan,AlwaysMatches='') and (lost,st-numeric=0) )"; #or ( allrecords,AlwaysMatches='' not lost,AlwaysMatches='')) )";
1103 $limit_cgi .= "&limit=available";
1107 # group_OR_limits, prefixed by mc-
1108 # OR every member of the group
1109 elsif ( $this_limit =~ /mc/ ) {
1110 $group_OR_limits .= " or " if $group_OR_limits;
1111 $limit_desc .= " or " if $group_OR_limits;
1112 $group_OR_limits .= "$this_limit";
1113 $limit_cgi .= "&limit=$this_limit";
1114 $limit_desc .= " $this_limit";
1117 # Regular old limits
1119 $limit .= " and " if $limit || $query;
1120 $limit .= "$this_limit";
1121 $limit_cgi .= "&limit=$this_limit";
1122 $limit_desc .= " $this_limit";
1125 if ($group_OR_limits) {
1126 $limit .= " and " if ( $query || $limit );
1127 $limit .= "($group_OR_limits)";
1129 if ($availability_limit) {
1130 $limit .= " and " if ( $query || $limit );
1131 $limit .= "($availability_limit)";
1134 # Normalize the query and limit strings
1137 for ( $query, $query_desc, $limit, $limit_desc ) {
1138 $_ =~ s/ / /g; # remove extra spaces
1139 $_ =~ s/^ //g; # remove any beginning spaces
1140 $_ =~ s/ $//g; # remove any ending spaces
1141 $_ =~ s/==/=/g; # remove double == from query
1143 $query_cgi =~ s/^&//; # remove unnecessary & from beginning of the query cgi
1145 for ($query_cgi,$simple_query) {
1148 # append the limit to the query
1149 $query .= " " . $limit;
1153 warn "QUERY:" . $query;
1154 warn "QUERY CGI:" . $query_cgi;
1155 warn "QUERY DESC:" . $query_desc;
1156 warn "LIMIT:" . $limit;
1157 warn "LIMIT CGI:" . $limit_cgi;
1158 warn "LIMIT DESC:" . $limit_desc;
1160 warn "Leave buildQuery";
1164 undef, $query, $simple_query, $query_cgi,
1165 $query_desc, $limit, $limit_cgi, $limit_desc,
1166 $stopwords_removed, $query_type
1170 =head2 searchResults
1172 Format results in a form suitable for passing to the template
1176 # IMO this subroutine is pretty messy still -- it's responsible for
1177 # building the HTML output for the template
1179 my ( $searchdesc, $hits, $results_per_page, $offset, @marcresults ) = @_;
1180 my $dbh = C4::Context->dbh;
1185 # add search-term highlighting via <span>s on the search terms
1186 my $span_terms_hashref;
1187 for my $span_term ( split( / /, $searchdesc ) ) {
1188 $span_term =~ s/(.*=|\)|\(|\+|\.|\*)//g;
1189 $span_terms_hashref->{$span_term}++;
1192 #Build branchnames hash
1194 #get branch information.....
1197 $dbh->prepare("SELECT branchcode,branchname FROM branches")
1198 ; # FIXME : use C4::Koha::GetBranches
1200 while ( my $bdata = $bsth->fetchrow_hashref ) {
1201 $branches{ $bdata->{'branchcode'} } = $bdata->{'branchname'};
1206 "SELECT authorised_value,lib FROM authorised_values WHERE category = 'LOC'"
1209 while ( my $ldata = $lsch->fetchrow_hashref ) {
1210 $locations{ $ldata->{'authorised_value'} } = $ldata->{'lib'};
1213 #Build itemtype hash
1214 #find itemtype & itemtype image
1218 "SELECT itemtype,description,imageurl,summary,notforloan FROM itemtypes"
1221 while ( my $bdata = $bsth->fetchrow_hashref ) {
1222 $itemtypes{ $bdata->{'itemtype'} }->{description} =
1223 $bdata->{'description'};
1224 $itemtypes{ $bdata->{'itemtype'} }->{imageurl} = $bdata->{'imageurl'};
1225 $itemtypes{ $bdata->{'itemtype'} }->{summary} = $bdata->{'summary'};
1226 $itemtypes{ $bdata->{'itemtype'} }->{notforloan} =
1227 $bdata->{'notforloan'};
1230 #search item field code
1233 "SELECT tagfield FROM marc_subfield_structure WHERE kohafield LIKE 'items.itemnumber'"
1236 my ($itemtag) = $sth->fetchrow;
1238 # get notforloan authorised value list
1241 "SELECT authorised_value FROM `marc_subfield_structure` WHERE kohafield = 'items.notforloan' AND frameworkcode=''"
1244 my ($notforloan_authorised_value) = $sth->fetchrow;
1246 ## find column names of items related to MARC
1247 my $sth2 = $dbh->prepare("SHOW COLUMNS FROM items");
1249 my %subfieldstosearch;
1250 while ( ( my $column ) = $sth2->fetchrow ) {
1251 my ( $tagfield, $tagsubfield ) =
1252 &GetMarcFromKohaField( "items." . $column, "" );
1253 $subfieldstosearch{$column} = $tagsubfield;
1256 # handle which records to actually retrieve
1258 if ( $hits && $offset + $results_per_page <= $hits ) {
1259 $times = $offset + $results_per_page;
1265 # loop through all of the records we've retrieved
1266 for ( my $i = $offset ; $i <= $times - 1 ; $i++ ) {
1268 $marcrecord = MARC::File::USMARC::decode( $marcresults[$i] );
1269 my $oldbiblio = TransformMarcToKoha( $dbh, $marcrecord, '' );
1270 $oldbiblio->{result_number} = $i + 1;
1272 # add imageurl to itemtype if there is one
1273 if ( $itemtypes{ $oldbiblio->{itemtype} }->{imageurl} =~ /^http:/ ) {
1274 $oldbiblio->{imageurl} =
1275 $itemtypes{ $oldbiblio->{itemtype} }->{imageurl};
1276 $oldbiblio->{description} =
1277 $itemtypes{ $oldbiblio->{itemtype} }->{description};
1280 $oldbiblio->{imageurl} =
1281 getitemtypeimagesrc() . "/"
1282 . $itemtypes{ $oldbiblio->{itemtype} }->{imageurl}
1283 if ( $itemtypes{ $oldbiblio->{itemtype} }->{imageurl} );
1284 $oldbiblio->{description} =
1285 $itemtypes{ $oldbiblio->{itemtype} }->{description};
1288 # Build summary if there is one (the summary is defined in the itemtypes table)
1289 # FIXME: is this used anywhere, I think it can be commented out? -- JF
1290 if ( $itemtypes{ $oldbiblio->{itemtype} }->{summary} ) {
1291 my $summary = $itemtypes{ $oldbiblio->{itemtype} }->{summary};
1292 my @fields = $marcrecord->fields();
1293 foreach my $field (@fields) {
1294 my $tag = $field->tag();
1295 my $tagvalue = $field->as_string();
1297 s/\[(.?.?.?.?)$tag\*(.*?)]/$1$tagvalue$2\[$1$tag$2]/g;
1298 unless ( $tag < 10 ) {
1299 my @subf = $field->subfields;
1300 for my $i ( 0 .. $#subf ) {
1301 my $subfieldcode = $subf[$i][0];
1302 my $subfieldvalue = $subf[$i][1];
1303 my $tagsubf = $tag . $subfieldcode;
1305 s/\[(.?.?.?.?)$tagsubf(.*?)]/$1$subfieldvalue$2\[$1$tagsubf$2]/g;
1310 $summary =~ s/\[(.*?)]//g;
1311 $summary =~ s/\n/<br>/g;
1312 $oldbiblio->{summary} = $summary;
1315 # Add search-term highlighting to the whole record where they match using <span>s
1316 if (C4::Context->preference("OpacHighlightedWords")){
1317 my $searchhighlightblob;
1318 for my $highlight_field ( $marcrecord->fields ) {
1320 # FIXME: need to skip title, subtitle, author, etc., as they are handled below
1321 next if $highlight_field->tag() =~ /(^00)/; # skip fixed fields
1322 for my $subfield ($highlight_field->subfields()) {
1324 next if $subfield->[0] eq '9';
1325 my $field = $subfield->[1];
1326 for my $term ( keys %$span_terms_hashref ) {
1327 if ( ( $field =~ /$term/i ) && (( length($term) > 3 ) || ($field =~ / $term /i)) ) {
1328 $field =~ s/$term/<span class=\"term\">$&<\/span>/gi;
1332 $searchhighlightblob .= $field . " ... " if $match;
1336 $searchhighlightblob = ' ... '.$searchhighlightblob if $searchhighlightblob;
1337 $oldbiblio->{'searchhighlightblob'} = $searchhighlightblob;
1339 # save an author with no <span> tag, for the <a href=search.pl?q=<!--tmpl_var name="author"-->> link
1340 $oldbiblio->{'author_nospan'} = $oldbiblio->{'author'};
1342 # Add search-term highlighting to the title, subtitle, etc. fields
1343 for my $term ( keys %$span_terms_hashref ) {
1344 my $old_term = $term;
1345 if ( length($term) > 3 ) {
1346 $term =~ s/(.*=|\)|\(|\+|\.|\?|\[|\]|\\|\*)//g;
1347 $oldbiblio->{'title'} =~
1348 s/$term/<span class=\"term\">$&<\/span>/gi;
1349 $oldbiblio->{'subtitle'} =~
1350 s/$term/<span class=\"term\">$&<\/span>/gi;
1351 $oldbiblio->{'author'} =~
1352 s/$term/<span class=\"term\">$&<\/span>/gi;
1353 $oldbiblio->{'publishercode'} =~
1354 s/$term/<span class=\"term\">$&<\/span>/gi;
1355 $oldbiblio->{'place'} =~
1356 s/$term/<span class=\"term\">$&<\/span>/gi;
1357 $oldbiblio->{'pages'} =~
1358 s/$term/<span class=\"term\">$&<\/span>/gi;
1359 $oldbiblio->{'notes'} =~
1360 s/$term/<span class=\"term\">$&<\/span>/gi;
1361 $oldbiblio->{'size'} =~
1362 s/$term/<span class=\"term\">$&<\/span>/gi;
1367 # surely there's a better way to handle this
1369 $toggle = "#ffffcc";
1374 $oldbiblio->{'toggle'} = $toggle;
1376 # Pull out the items fields
1377 my @fields = $marcrecord->field($itemtag);
1379 # Setting item statuses for display
1380 my @available_items_loop;
1381 my @onloan_items_loop;
1382 my @other_items_loop;
1384 my $available_items;
1388 my $ordered_count = 0;
1389 my $available_count = 0;
1390 my $onloan_count = 0;
1391 my $longoverdue_count = 0;
1392 my $other_count = 0;
1393 my $wthdrawn_count = 0;
1394 my $itemlost_count = 0;
1395 my $itembinding_count = 0;
1396 my $itemdamaged_count = 0;
1397 my $can_place_holds = 0;
1398 my $items_count = scalar(@fields);
1401 ( C4::Context->preference('maxItemsinSearchResults') )
1402 ? C4::Context->preference('maxItemsinSearchResults') - 1
1405 # loop through every item
1406 foreach my $field (@fields) {
1410 # populate the items hash
1411 foreach my $code ( keys %subfieldstosearch ) {
1412 $item->{$code} = $field->subfield( $subfieldstosearch{$code} );
1415 # set item's branch name, use HomeOrHoldingBranch syspref first, fall back to the other one
1416 if ( $item->{C4::Context->preference('HomeOrHoldingBranch') eq 'homebranch'?'homebranch':'holdingbranch'} ) {
1417 $item->{'branchname'} = $branches{ $item->{C4::Context->preference('HomeOrHoldingBranch') eq 'homebranch'?'homebranch':'holdingbranch'} };
1420 elsif ( $item->{C4::Context->preference('HomeOrHoldingBranch') eq 'homebranch'?'holdingbranch':'homebranch'} ) {
1421 $item->{'branchname'} = $branches{ $item->{C4::Context->preference('HomeOrHoldingBranch') eq 'homebranch'?'holdingbranch':'homebranch'} };
1424 # For each grouping of items (onloan, available, unavailable), we build a key to store relevant info about that item
1425 if ( $item->{onloan} ) {
1427 $onloan_items->{ $item->{C4::Context->preference('HomeOrHoldingBranch') eq 'homebranch'?'homebranch':'holdingbranch'} . '--' . $item->{location} . $item->{'itype'} . $item->{'itemcallnumber'} . $item->{due_date} }->{due_date} = format_date( $item->{onloan} );
1428 $onloan_items->{ $item->{C4::Context->preference('HomeOrHoldingBranch') eq 'homebranch'?'homebranch':'holdingbranch'} . '--' . $item->{location} . $item->{'itype'} . $item->{'itemcallnumber'} . $item->{due_date} }->{count}++ if $item->{'homebranch'};
1429 $onloan_items->{ $item->{C4::Context->preference('HomeOrHoldingBranch') eq 'homebranch'?'homebranch':'holdingbranch'} . '--' . $item->{location} . $item->{'itype'} . $item->{'itemcallnumber'} . $item->{due_date} }->{branchname} = $item->{'branchname'};
1430 $onloan_items->{ $item->{C4::Context->preference('HomeOrHoldingBranch') eq 'homebranch'?'homebranch':'holdingbranch'} . '--' . $item->{location} . $item->{'itype'} . $item->{'itemcallnumber'} . $item->{due_date} }->{location} = $locations{ $item->{location} };
1431 $onloan_items->{ $item->{C4::Context->preference('HomeOrHoldingBranch') eq 'homebranch'?'homebranch':'holdingbranch'} . '--' . $item->{location} . $item->{'itype'} . $item->{'itemcallnumber'} . $item->{due_date} }->{itemcallnumber} = $item->{itemcallnumber};
1432 $onloan_items->{ $item->{C4::Context->preference('HomeOrHoldingBranch') eq 'homebranch'?'homebranch':'holdingbranch'} . '--' . $item->{location} . $item->{'itype'} . $item->{'itemcallnumber'} . $item->{due_date} }->{imageurl} = getitemtypeimagesrc() . "/" . $itemtypes{ $item->{itype} }->{imageurl};
1433 # if something's checked out and lost, mark it as 'long overdue'
1434 if ( $item->{itemlost} ) {
1435 $onloan_items->{ $item->{C4::Context->preference('HomeOrHoldingBranch') eq 'homebranch'?'homebranch':'holdingbranch'} . '--' . $item->{location} . $item->{'itype'} . $item->{'itemcallnumber'} . $item->{due_date} }->{longoverdue}++;
1436 $longoverdue_count++;
1439 # can place holds as long as this item isn't lost
1441 $can_place_holds = 1;
1445 # items not on loan, but still unavailable ( lost, withdrawn, damaged )
1449 if ( $item->{notforloan} == -1 ) {
1453 # item is withdrawn, lost or damaged
1454 if ( $item->{wthdrawn}
1455 || $item->{itemlost}
1457 || $item->{notforloan} )
1459 $wthdrawn_count++ if $item->{wthdrawn};
1460 $itemlost_count++ if $item->{itemlost};
1461 $itemdamaged_count++ if $item->{damaged};
1462 $item->{status} = $item->{wthdrawn} . "-" . $item->{itemlost} . "-" . $item->{damaged} . "-" . $item->{notforloan};
1465 $other_items->{ $item->{C4::Context->preference('HomeOrHoldingBranch') eq 'homebranch'?'homebranch':'holdingbranch'} . '--' . $item->{location} . $item->{'itype'} . $item->{'itemcallnumber'} . $item->{status} }->{wthdrawn} = $item->{wthdrawn};
1466 $other_items->{ $item->{C4::Context->preference('HomeOrHoldingBranch') eq 'homebranch'?'homebranch':'holdingbranch'} . '--' . $item->{location} . $item->{'itype'} . $item->{'itemcallnumber'} . $item->{status} }->{itemlost} = $item->{itemlost};
1467 $other_items->{ $item->{C4::Context->preference('HomeOrHoldingBranch') eq 'homebranch'?'homebranch':'holdingbranch'} . '--' . $item->{location} . $item->{'itype'} . $item->{'itemcallnumber'} . $item->{status} }->{damaged} = $item->{damaged};
1468 $other_items->{ $item->{C4::Context->preference('HomeOrHoldingBranch') eq 'homebranch'?'homebranch':'holdingbranch'} . '--' . $item->{location} . $item->{'itype'} . $item->{'itemcallnumber'} . $item->{status} }->{notforloan} = GetAuthorisedValueDesc( '', '', $item->{notforloan}, '', '', $notforloan_authorised_value ) if $notforloan_authorised_value;
1469 $other_items->{ $item->{C4::Context->preference('HomeOrHoldingBranch') eq 'homebranch'?'homebranch':'holdingbranch'} . '--' . $item->{location} . $item->{'itype'} . $item->{'itemcallnumber'} . $item->{status} }->{count}++ if $item->{'homebranch'};
1470 $other_items->{ $item->{C4::Context->preference('HomeOrHoldingBranch') eq 'homebranch'?'homebranch':'holdingbranch'} . '--' . $item->{location} . $item->{'itype'} . $item->{'itemcallnumber'} . $item->{status} }->{branchname} = $item->{'branchname'};
1471 $other_items->{ $item->{C4::Context->preference('HomeOrHoldingBranch') eq 'homebranch'?'homebranch':'holdingbranch'} . '--' . $item->{location} . $item->{'itype'} . $item->{'itemcallnumber'} . $item->{status} }->{location} = $locations{ $item->{location} };
1472 $other_items->{ $item->{C4::Context->preference('HomeOrHoldingBranch') eq 'homebranch'?'homebranch':'holdingbranch'} . '--' . $item->{location} . $item->{'itype'} . $item->{'itemcallnumber'} . $item->{status} }->{itemcallnumber} = $item->{itemcallnumber};
1473 $other_items->{ $item->{C4::Context->preference('HomeOrHoldingBranch') eq 'homebranch'?'homebranch':'holdingbranch'} . '--' . $item->{location} . $item->{'itype'} . $item->{'itemcallnumber'} . $item->{status} }->{imageurl} = getitemtypeimagesrc() . "/" . $itemtypes{ $item->{itype} }->{imageurl};
1478 $can_place_holds = 1;
1480 $available_items->{ $item->{C4::Context->preference('HomeOrHoldingBranch') eq 'homebranch'?'homebranch':'holdingbranch'} . '--' . $item->{location} . $item->{'itype'} . $item->{'itemcallnumber'} }->{count}++ if $item->{'homebranch'};
1481 $available_items->{ $item->{C4::Context->preference('HomeOrHoldingBranch') eq 'homebranch'?'homebranch':'holdingbranch'} . '--' . $item->{location} . $item->{'itype'} . $item->{'itemcallnumber'} }->{branchname} = $item->{'branchname'};
1482 $available_items->{ $item->{C4::Context->preference('HomeOrHoldingBranch') eq 'homebranch'?'homebranch':'holdingbranch'} . '--' . $item->{location} . $item->{'itype'} . $item->{'itemcallnumber'} }->{location} = $locations{ $item->{location} };
1483 $available_items->{ $item->{C4::Context->preference('HomeOrHoldingBranch') eq 'homebranch'?'homebranch':'holdingbranch'} . '--' . $item->{location} . $item->{'itype'} . $item->{'itemcallnumber'} }->{itemcallnumber} = $item->{itemcallnumber};
1484 $available_items->{ $item->{C4::Context->preference('HomeOrHoldingBranch') eq 'homebranch'?'homebranch':'holdingbranch'} . '--' . $item->{location} . $item->{'itype'} . $item->{'itemcallnumber'} }->{imageurl} = getitemtypeimagesrc() . "/" . $itemtypes{ $item->{itype} }->{imageurl};
1487 } # notforloan, item level and biblioitem level
1488 my ( $availableitemscount, $onloanitemscount, $otheritemscount );
1490 ( C4::Context->preference('maxItemsinSearchResults') )
1491 ? C4::Context->preference('maxItemsinSearchResults') - 1
1493 for my $key ( sort keys %$onloan_items ) {
1494 $onloanitemscount++;
1495 push @onloan_items_loop, $onloan_items->{$key}
1496 unless $onloanitemscount > $maxitems;
1498 for my $key ( sort keys %$other_items ) {
1500 push @other_items_loop, $other_items->{$key}
1501 unless $otheritemscount > $maxitems;
1503 for my $key ( sort keys %$available_items ) {
1504 $availableitemscount++;
1505 push @available_items_loop, $available_items->{$key}
1506 unless $availableitemscount > $maxitems;
1509 # last check for norequest : if itemtype is notforloan, it can't be reserved either, whatever the items
1510 $can_place_holds = 0
1511 if $itemtypes{ $oldbiblio->{itemtype} }->{notforloan};
1512 $oldbiblio->{norequests} = 1 unless $can_place_holds;
1513 $oldbiblio->{itemsplural} = 1 if $items_count > 1;
1514 $oldbiblio->{items_count} = $items_count;
1515 $oldbiblio->{available_items_loop} = \@available_items_loop;
1516 $oldbiblio->{onloan_items_loop} = \@onloan_items_loop;
1517 $oldbiblio->{other_items_loop} = \@other_items_loop;
1518 $oldbiblio->{availablecount} = $available_count;
1519 $oldbiblio->{availableplural} = 1 if $available_count > 1;
1520 $oldbiblio->{onloancount} = $onloan_count;
1521 $oldbiblio->{onloanplural} = 1 if $onloan_count > 1;
1522 $oldbiblio->{othercount} = $other_count;
1523 $oldbiblio->{otherplural} = 1 if $other_count > 1;
1524 $oldbiblio->{wthdrawncount} = $wthdrawn_count;
1525 $oldbiblio->{itemlostcount} = $itemlost_count;
1526 $oldbiblio->{damagedcount} = $itemdamaged_count;
1527 $oldbiblio->{orderedcount} = $ordered_count;
1528 $oldbiblio->{isbn} =~
1529 s/-//g; # deleting - in isbn to enable amazon content
1530 push( @newresults, $oldbiblio );
1535 #----------------------------------------------------------------------
1537 # Non-Zebra GetRecords#
1538 #----------------------------------------------------------------------
1542 NZgetRecords has the same API as zera getRecords, even if some parameters are not managed
1548 $query, $simple_query, $sort_by_ref, $servers_ref,
1549 $results_per_page, $offset, $expanded_facet, $branches,
1552 warn "query =$query" if $DEBUG;
1553 my $result = NZanalyse($query);
1554 warn "results =$result" if $DEBUG;
1556 NZorder( $result, @$sort_by_ref[0], $results_per_page, $offset ),
1562 NZanalyse : get a CQL string as parameter, and returns a list of biblionumber;title,biblionumber;title,...
1563 the list is built from an inverted index in the nozebra SQL table
1564 note that title is here only for convenience : the sorting will be very fast when requested on title
1565 if the sorting is requested on something else, we will have to reread all results, and that may be longer.
1570 my ( $string, $server ) = @_;
1571 # warn "---------" if $DEBUG;
1572 warn " NZanalyse" if $DEBUG;
1573 # warn "---------" if $DEBUG;
1575 # $server contains biblioserver or authorities, depending on what we search on.
1576 #warn "querying : $string on $server";
1577 $server = 'biblioserver' unless $server;
1579 # if we have a ", replace the content to discard temporarily any and/or/not inside
1581 if ( $string =~ /"/ ) {
1582 $string =~ s/"(.*?)"/__X__/;
1584 warn "commacontent : $commacontent" if $DEBUG;
1587 # split the query string in 3 parts : X AND Y means : $left="X", $operand="AND" and $right="Y"
1588 # then, call again NZanalyse with $left and $right
1589 # (recursive until we find a leaf (=> something without and/or/not)
1590 # delete repeated operator... Would then go in infinite loop
1591 while ( $string =~ s/( and| or| not| AND| OR| NOT)\1/$1/g ) {
1594 #process parenthesis before.
1595 if ( $string =~ /^\s*\((.*)\)(( and | or | not | AND | OR | NOT )(.*))?/ ) {
1598 my $operator = lc($3); # FIXME: and/or/not are operators, not operands
1600 "dealing w/parenthesis before recursive sub call. left :$left operator:$operator right:$right"
1602 my $leftresult = NZanalyse( $left, $server );
1604 my $rightresult = NZanalyse( $right, $server );
1606 # OK, we have the results for right and left part of the query
1607 # depending of operand, intersect, union or exclude both lists
1608 # to get a result list
1609 if ( $operator eq ' and ' ) {
1610 return NZoperatorAND($leftresult,$rightresult);
1612 elsif ( $operator eq ' or ' ) {
1614 # just merge the 2 strings
1615 return $leftresult . $rightresult;
1617 elsif ( $operator eq ' not ' ) {
1618 return NZoperatorNOT($leftresult,$rightresult);
1622 # this error is impossible, because of the regexp that isolate the operand, but just in case...
1626 warn "string :" . $string if $DEBUG;
1627 $string =~ /(.*?)( and | or | not | AND | OR | NOT )(.*)/;
1630 my $operator = lc($2); # FIXME: and/or/not are operators, not operands
1631 warn "no parenthesis. left : $left operator: $operator right: $right"
1634 # it's not a leaf, we have a and/or/not
1637 # reintroduce comma content if needed
1638 $right =~ s/__X__/"$commacontent"/ if $commacontent;
1639 $left =~ s/__X__/"$commacontent"/ if $commacontent;
1640 warn "node : $left / $operator / $right\n" if $DEBUG;
1641 my $leftresult = NZanalyse( $left, $server );
1642 my $rightresult = NZanalyse( $right, $server );
1643 warn " leftresult : $leftresult" if $DEBUG;
1644 warn " rightresult : $rightresult" if $DEBUG;
1645 # OK, we have the results for right and left part of the query
1646 # depending of operand, intersect, union or exclude both lists
1647 # to get a result list
1648 if ( $operator eq ' and ' ) {
1650 return NZoperatorAND($leftresult,$rightresult);
1652 elsif ( $operator eq ' or ' ) {
1654 # just merge the 2 strings
1655 return $leftresult . $rightresult;
1657 elsif ( $operator eq ' not ' ) {
1658 return NZoperatorNOT($leftresult,$rightresult);
1662 # this error is impossible, because of the regexp that isolate the operand, but just in case...
1663 die "error : operand unknown : $operator for $string";
1666 # it's a leaf, do the real SQL query and return the result
1669 $string =~ s/__X__/"$commacontent"/ if $commacontent;
1670 $string =~ s/-|\.|\?|,|;|!|'|\(|\)|\[|\]|{|}|"|&|\+|\*|\// /g;
1671 warn "leaf:$string" if $DEBUG;
1673 # parse the string in in operator/operand/value again
1674 $string =~ /(.*)(>=|<=)(.*)/;
1678 # warn "handling leaf... left:$left operator:$operator right:$right"
1680 unless ($operator) {
1681 $string =~ /(.*)(>|<|=)(.*)/;
1686 # "handling unless (operator)... left:$left operator:$operator right:$right"
1691 # strip adv, zebra keywords, currently not handled in nozebra: wrdl, ext, phr...
1692 $left =~ s/[, ].*$//;
1694 # automatic replace for short operators
1695 $left = 'title' if $left =~ '^ti$';
1696 $left = 'author' if $left =~ '^au$';
1697 $left = 'publisher' if $left =~ '^pb$';
1698 $left = 'subject' if $left =~ '^su$';
1699 $left = 'koha-Auth-Number' if $left =~ '^an$';
1700 $left = 'keyword' if $left =~ '^kw$';
1701 warn "handling leaf... left:$left operator:$operator right:$right";
1702 if ( $operator && $left ne 'keyword' ) {
1704 #do a specific search
1705 my $dbh = C4::Context->dbh;
1706 $operator = 'LIKE' if $operator eq '=' and $right =~ /%/;
1709 "SELECT biblionumbers,value FROM nozebra WHERE server=? AND indexname=? AND value $operator ?"
1711 warn "$left / $operator / $right\n";
1713 # split each word, query the DB and build the biblionumbers result
1714 #sanitizing leftpart
1715 $left =~ s/^\s+|\s+$//;
1716 foreach ( split / /, $right ) {
1718 $_ =~ s/^\s+|\s+$//;
1720 warn "EXECUTE : $server, $left, $_";
1721 $sth->execute( $server, $left, $_ )
1722 or warn "execute failed: $!";
1723 while ( my ( $line, $value ) = $sth->fetchrow ) {
1725 # if we are dealing with a numeric value, use only numeric results (in case of >=, <=, > or <)
1726 # otherwise, fill the result
1727 $biblionumbers .= $line
1728 unless ( $right =~ /^\d+$/ && $value =~ /\D/ );
1729 warn "result : $value "
1730 . ( $right =~ /\d/ ) . "=="
1731 . ( $value =~ /\D/?$line:"" ); #= $line";
1734 # do a AND with existing list if there is one, otherwise, use the biblionumbers list as 1st result list
1737 $results = NZoperatorAND($biblionumbers,$results);
1740 $results = $biblionumbers;
1746 #do a complete search (all indexes), if index='kw' do complete search too.
1747 my $dbh = C4::Context->dbh;
1750 "SELECT biblionumbers FROM nozebra WHERE server=? AND value LIKE ?"
1753 # split each word, query the DB and build the biblionumbers result
1754 foreach ( split / /, $string ) {
1755 next if C4::Context->stopwords->{ uc($_) }; # skip if stopword
1756 warn "search on all indexes on $_" if $DEBUG;
1759 $sth->execute( $server, $_ );
1760 while ( my $line = $sth->fetchrow ) {
1761 $biblionumbers .= $line;
1764 # do a AND with existing list if there is one, otherwise, use the biblionumbers list as 1st result list
1766 $results = NZoperatorAND($biblionumbers,$results);
1769 warn "NEW RES for $_ = $biblionumbers" if $DEBUG;
1770 $results = $biblionumbers;
1774 warn "return : $results for LEAF : $string" if $DEBUG;
1777 warn "---------" if $DEBUG;
1778 warn "Leave NZanalyse" if $DEBUG;
1779 warn "---------" if $DEBUG;
1783 my ($rightresult, $leftresult)=@_;
1785 my @leftresult = split /;/, $leftresult;
1786 warn " @leftresult / $rightresult \n" if $DEBUG;
1788 # my @rightresult = split /;/,$leftresult;
1791 # parse the left results, and if the biblionumber exist in the right result, save it in finalresult
1792 # the result is stored twice, to have the same weight for AND than OR.
1793 # example : TWO : 61,61,64,121 (two is twice in the biblio #61) / TOWER : 61,64,130
1794 # result : 61,61,61,61,64,64 for two AND tower : 61 has more weight than 64
1795 foreach (@leftresult) {
1798 ( $value, $countvalue ) = ( $1, $2 ) if ($value=~/(.*)-(\d+)$/);
1799 if ( $rightresult =~ /$value-(\d+);/ ) {
1800 $countvalue = ( $1 > $countvalue ? $countvalue : $1 );
1802 "$value-$countvalue;$value-$countvalue;";
1805 warn " $finalresult \n" if $DEBUG;
1806 return $finalresult;
1810 my ($rightresult, $leftresult)=@_;
1811 return $rightresult.$leftresult;
1815 my ($rightresult, $leftresult)=@_;
1817 my @leftresult = split /;/, $leftresult;
1819 # my @rightresult = split /;/,$leftresult;
1821 foreach (@leftresult) {
1823 $value=$1 if $value=~m/(.*)-\d+$/;
1824 unless ($rightresult =~ "$value-") {
1825 $finalresult .= "$_;";
1828 return $finalresult;
1833 $finalresult = NZorder($biblionumbers, $ordering,$results_per_page,$offset);
1840 my ( $biblionumbers, $ordering, $results_per_page, $offset ) = @_;
1841 warn "biblionumbers = $biblionumbers and ordering = $ordering\n" if $DEBUG;
1843 # order title asc by default
1844 # $ordering = '1=36 <i' unless $ordering;
1845 $results_per_page = 20 unless $results_per_page;
1846 $offset = 0 unless $offset;
1847 my $dbh = C4::Context->dbh;
1850 # order by POPULARITY
1852 if ( $ordering =~ /popularity/ ) {
1856 # popularity is not in MARC record, it's builded from a specific query
1858 $dbh->prepare("select sum(issues) from items where biblionumber=?");
1859 foreach ( split /;/, $biblionumbers ) {
1860 my ( $biblionumber, $title ) = split /,/, $_;
1861 $result{$biblionumber} = GetMarcBiblio($biblionumber);
1862 $sth->execute($biblionumber);
1863 my $popularity = $sth->fetchrow || 0;
1865 # hint : the key is popularity.title because we can have
1866 # many results with the same popularity. In this cas, sub-ordering is done by title
1867 # we also have biblionumber to avoid bug for 2 biblios with the same title & popularity
1868 # (un-frequent, I agree, but we won't forget anything that way ;-)
1869 $popularity{ sprintf( "%10d", $popularity ) . $title
1870 . $biblionumber } = $biblionumber;
1873 # sort the hash and return the same structure as GetRecords (Zebra querying)
1876 if ( $ordering eq 'popularity_dsc' ) { # sort popularity DESC
1877 foreach my $key ( sort { $b cmp $a } ( keys %popularity ) ) {
1878 $result_hash->{'RECORDS'}[ $numbers++ ] =
1879 $result{ $popularity{$key} }->as_usmarc();
1882 else { # sort popularity ASC
1883 foreach my $key ( sort ( keys %popularity ) ) {
1884 $result_hash->{'RECORDS'}[ $numbers++ ] =
1885 $result{ $popularity{$key} }->as_usmarc();
1888 my $finalresult = ();
1889 $result_hash->{'hits'} = $numbers;
1890 $finalresult->{'biblioserver'} = $result_hash;
1891 return $finalresult;
1897 elsif ( $ordering =~ /author/ ) {
1899 foreach ( split /;/, $biblionumbers ) {
1900 my ( $biblionumber, $title ) = split /,/, $_;
1901 my $record = GetMarcBiblio($biblionumber);
1903 if ( C4::Context->preference('marcflavour') eq 'UNIMARC' ) {
1904 $author = $record->subfield( '200', 'f' );
1905 $author = $record->subfield( '700', 'a' ) unless $author;
1908 $author = $record->subfield( '100', 'a' );
1911 # hint : the result is sorted by title.biblionumber because we can have X biblios with the same title
1912 # and we don't want to get only 1 result for each of them !!!
1913 $result{ $author . $biblionumber } = $record;
1916 # sort the hash and return the same structure as GetRecords (Zebra querying)
1919 if ( $ordering eq 'author_za' ) { # sort by author desc
1920 foreach my $key ( sort { $b cmp $a } ( keys %result ) ) {
1921 $result_hash->{'RECORDS'}[ $numbers++ ] =
1922 $result{$key}->as_usmarc();
1925 else { # sort by author ASC
1926 foreach my $key ( sort ( keys %result ) ) {
1927 $result_hash->{'RECORDS'}[ $numbers++ ] =
1928 $result{$key}->as_usmarc();
1931 my $finalresult = ();
1932 $result_hash->{'hits'} = $numbers;
1933 $finalresult->{'biblioserver'} = $result_hash;
1934 return $finalresult;
1937 # ORDER BY callnumber
1940 elsif ( $ordering =~ /callnumber/ ) {
1942 foreach ( split /;/, $biblionumbers ) {
1943 my ( $biblionumber, $title ) = split /,/, $_;
1944 my $record = GetMarcBiblio($biblionumber);
1946 my ( $callnumber_tag, $callnumber_subfield ) =
1947 GetMarcFromKohaField( $dbh, 'items.itemcallnumber' );
1948 ( $callnumber_tag, $callnumber_subfield ) =
1949 GetMarcFromKohaField('biblioitems.callnumber')
1950 unless $callnumber_tag;
1951 if ( C4::Context->preference('marcflavour') eq 'UNIMARC' ) {
1952 $callnumber = $record->subfield( '200', 'f' );
1955 $callnumber = $record->subfield( '100', 'a' );
1958 # hint : the result is sorted by title.biblionumber because we can have X biblios with the same title
1959 # and we don't want to get only 1 result for each of them !!!
1960 $result{ $callnumber . $biblionumber } = $record;
1963 # sort the hash and return the same structure as GetRecords (Zebra querying)
1966 if ( $ordering eq 'call_number_dsc' ) { # sort by title desc
1967 foreach my $key ( sort { $b cmp $a } ( keys %result ) ) {
1968 $result_hash->{'RECORDS'}[ $numbers++ ] =
1969 $result{$key}->as_usmarc();
1972 else { # sort by title ASC
1973 foreach my $key ( sort { $a cmp $b } ( keys %result ) ) {
1974 $result_hash->{'RECORDS'}[ $numbers++ ] =
1975 $result{$key}->as_usmarc();
1978 my $finalresult = ();
1979 $result_hash->{'hits'} = $numbers;
1980 $finalresult->{'biblioserver'} = $result_hash;
1981 return $finalresult;
1983 elsif ( $ordering =~ /pubdate/ ) { #pub year
1985 foreach ( split /;/, $biblionumbers ) {
1986 my ( $biblionumber, $title ) = split /,/, $_;
1987 my $record = GetMarcBiblio($biblionumber);
1988 my ( $publicationyear_tag, $publicationyear_subfield ) =
1989 GetMarcFromKohaField( 'biblioitems.publicationyear', '' );
1990 my $publicationyear =
1991 $record->subfield( $publicationyear_tag,
1992 $publicationyear_subfield );
1994 # hint : the result is sorted by title.biblionumber because we can have X biblios with the same title
1995 # and we don't want to get only 1 result for each of them !!!
1996 $result{ $publicationyear . $biblionumber } = $record;
1999 # sort the hash and return the same structure as GetRecords (Zebra querying)
2002 if ( $ordering eq 'pubdate_dsc' ) { # sort by pubyear desc
2003 foreach my $key ( sort { $b cmp $a } ( keys %result ) ) {
2004 $result_hash->{'RECORDS'}[ $numbers++ ] =
2005 $result{$key}->as_usmarc();
2008 else { # sort by pub year ASC
2009 foreach my $key ( sort ( keys %result ) ) {
2010 $result_hash->{'RECORDS'}[ $numbers++ ] =
2011 $result{$key}->as_usmarc();
2014 my $finalresult = ();
2015 $result_hash->{'hits'} = $numbers;
2016 $finalresult->{'biblioserver'} = $result_hash;
2017 return $finalresult;
2023 elsif ( $ordering =~ /title/ ) {
2025 # the title is in the biblionumbers string, so we just need to build a hash, sort it and return
2027 foreach ( split /;/, $biblionumbers ) {
2028 my ( $biblionumber, $title ) = split /,/, $_;
2030 # hint : the result is sorted by title.biblionumber because we can have X biblios with the same title
2031 # and we don't want to get only 1 result for each of them !!!
2032 # hint & speed improvement : we can order without reading the record
2033 # so order, and read records only for the requested page !
2034 $result{ $title . $biblionumber } = $biblionumber;
2037 # sort the hash and return the same structure as GetRecords (Zebra querying)
2040 if ( $ordering eq 'title_az' ) { # sort by title desc
2041 foreach my $key ( sort ( keys %result ) ) {
2042 $result_hash->{'RECORDS'}[ $numbers++ ] = $result{$key};
2045 else { # sort by title ASC
2046 foreach my $key ( sort { $b cmp $a } ( keys %result ) ) {
2047 $result_hash->{'RECORDS'}[ $numbers++ ] = $result{$key};
2051 # limit the $results_per_page to result size if it's more
2052 $results_per_page = $numbers - 1 if $numbers < $results_per_page;
2054 # for the requested page, replace biblionumber by the complete record
2055 # speed improvement : avoid reading too much things
2057 my $counter = $offset ;
2058 $counter <= $offset + $results_per_page ;
2062 $result_hash->{'RECORDS'}[$counter] =
2063 GetMarcBiblio( $result_hash->{'RECORDS'}[$counter] )->as_usmarc;
2065 my $finalresult = ();
2066 $result_hash->{'hits'} = $numbers;
2067 $finalresult->{'biblioserver'} = $result_hash;
2068 return $finalresult;
2075 # we need 2 hashes to order by ranking : the 1st one to count the ranking, the 2nd to order by ranking
2078 foreach ( split /;/, $biblionumbers ) {
2079 my ( $biblionumber, $title ) = split /,/, $_;
2080 $title =~ /(.*)-(\d)/;
2085 # note that we + the ranking because ranking is calculated on weight of EACH term requested.
2086 # if we ask for "two towers", and "two" has weight 2 in biblio N, and "towers" has weight 4 in biblio N
2087 # biblio N has ranking = 6
2088 $count_ranking{$biblionumber} += $ranking;
2091 # build the result by "inverting" the count_ranking hash
2092 # 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
2094 foreach ( keys %count_ranking ) {
2095 $result{ sprintf( "%10d", $count_ranking{$_} ) . '-' . $_ } = $_;
2098 # sort the hash and return the same structure as GetRecords (Zebra querying)
2101 foreach my $key ( sort { $b cmp $a } ( keys %result ) ) {
2102 $result_hash->{'RECORDS'}[ $numbers++ ] = $result{$key};
2105 # limit the $results_per_page to result size if it's more
2106 $results_per_page = $numbers - 1 if $numbers < $results_per_page;
2108 # for the requested page, replace biblionumber by the complete record
2109 # speed improvement : avoid reading too much things
2111 my $counter = $offset ;
2112 $counter <= $offset + $results_per_page ;
2116 $result_hash->{'RECORDS'}[$counter] =
2117 GetMarcBiblio( $result_hash->{'RECORDS'}[$counter] )->as_usmarc
2118 if $result_hash->{'RECORDS'}[$counter];
2120 my $finalresult = ();
2121 $result_hash->{'hits'} = $numbers;
2122 $finalresult->{'biblioserver'} = $result_hash;
2123 return $finalresult;
2129 ($countchanged,$listunchanged) = ModBiblios($listbiblios, $tagsubfield,$initvalue,$targetvalue,$test);
2131 this function changes all the values $initvalue in subfield $tag$subfield in any record in $listbiblios
2132 test parameter if set donot perform change to records in database.
2138 * $listbiblios is an array ref to marcrecords to be changed
2139 * $tagsubfield is the reference of the subfield to change.
2140 * $initvalue is the value to search the record for
2141 * $targetvalue is the value to set the subfield to
2142 * $test is to be set only not to perform changes in database.
2144 =item C<Output arg:>
2145 * $countchanged counts all the changes performed.
2146 * $listunchanged contains the list of all the biblionumbers of records unchanged.
2148 =item C<usage in the script:>
2152 my ($countchanged, $listunchanged) = EditBiblios($results->{RECORD}, $tagsubfield,$initvalue,$targetvalue);;
2153 #If one wants to display unchanged records, you should get biblios foreach @$listunchanged
2154 $template->param(countchanged => $countchanged, loopunchanged=>$listunchanged);
2159 my ( $listbiblios, $tagsubfield, $initvalue, $targetvalue, $test ) = @_;
2162 my ( $tag, $subfield ) = ( $1, $2 )
2163 if ( $tagsubfield =~ /^(\d{1,3})([a-z0-9A-Z@])?$/ );
2164 if ( ( length($tag) < 3 ) && $subfield =~ /0-9/ ) {
2165 $tag = $tag . $subfield;
2168 my ( $bntag, $bnsubf ) = GetMarcFromKohaField('biblio.biblionumber');
2169 my ( $itemtag, $itemsubf ) = GetMarcFromKohaField('items.itemnumber');
2170 if ($tag eq $itemtag) {
2171 # do not allow the embedded item tag to be
2173 warn "Attempting to edit item tag via C4::Search::ModBiblios -- not allowed";
2176 foreach my $usmarc (@$listbiblios) {
2178 $record = eval { MARC::Record->new_from_usmarc($usmarc) };
2182 # usmarc is not a valid usmarc May be a biblionumber
2183 # FIXME - sorry, please let's figure out whether
2184 # this function is to be passed a list of
2185 # record numbers or a list of MARC::Record
2186 # objects. The former is probably better
2187 # because the MARC records supplied by Zebra
2188 # may be not current.
2189 $record = GetMarcBiblio($usmarc);
2190 $biblionumber = $usmarc;
2193 if ( $bntag >= 010 ) {
2194 $biblionumber = $record->subfield( $bntag, $bnsubf );
2197 $biblionumber = $record->field($bntag)->data;
2201 #GetBiblionumber is to be written.
2202 #Could be replaced by TransformMarcToKoha (But Would be longer)
2203 if ( $record->field($tag) ) {
2205 foreach my $field ( $record->field($tag) ) {
2208 $field->delete_subfield(
2209 'code' => $subfield,
2210 'match' => qr($initvalue)
2216 $field->update( $subfield, $targetvalue )
2221 if ( $tag >= 010 ) {
2222 if ( $field->delete_field($field) ) {
2228 $field->data = $targetvalue
2229 if ( $field->data =~ qr($initvalue) );
2234 # warn $record->as_formatted;
2236 ModBiblio( $record, $biblionumber,
2237 GetFrameworkCode($biblionumber) )
2241 push @unmatched, $biblionumber;
2245 push @unmatched, $biblionumber;
2248 return ( $countmatched, \@unmatched );
2251 END { } # module clean-up code here (global destructor)
2258 Koha Developement team <info@koha.org>