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
26 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
28 # set the version for version checking
29 $VERSION = do { my @v = '$Revision$' =~ /\d+/g;
30 shift(@v) . "." . join( "_", map { sprintf "%03d", $_ } @v );
35 C4::Search - Functions for searching the Koha catalog.
39 see opac/opac-search.pl or catalogue/search.pl for example of usage
43 This module provides the searching facilities for the Koha into a zebra catalog.
61 # make all your functions, whether exported or not;
63 =head2 findseealso($dbh,$fields);
65 C<$dbh> is a link to the DB handler.
68 my $dbh =C4::Context->dbh;
70 C<$fields> is a reference to the fields array
72 This function modify the @$fields array and add related fields to search on.
77 my ( $dbh, $fields ) = @_;
78 my $tagslib = GetMarcStructure( 1 );
79 for ( my $i = 0 ; $i <= $#{$fields} ; $i++ ) {
80 my ($tag) = substr( @$fields[$i], 1, 3 );
81 my ($subfield) = substr( @$fields[$i], 4, 1 );
82 @$fields[$i] .= ',' . $tagslib->{$tag}->{$subfield}->{seealso}
83 if ( $tagslib->{$tag}->{$subfield}->{seealso} );
89 ($biblionumber,$biblionumber,$title) = FindDuplicate($record);
95 my $dbh = C4::Context->dbh;
96 my $result = TransformMarcToKoha( $dbh, $record, '' );
101 my ( $biblionumber, $title );
103 # search duplicate on ISBN, easy and fast..
104 #$search->{'avoidquerylog'}=1;
105 if ( $result->{isbn} ) {
106 $query = "isbn=$result->{isbn}";
109 $result->{title} =~ s /\\//g;
110 $result->{title} =~ s /\"//g;
111 $result->{title} =~ s /\(//g;
112 $result->{title} =~ s /\)//g;
113 $query = "ti,ext=$result->{title}";
114 $query .= " and mt=$result->{itemtype}" if ($result->{itemtype});
115 if ($result->{author}){
116 $result->{author} =~ s /\\//g;
117 $result->{author} =~ s /\"//g;
118 $result->{author} =~ s /\(//g;
119 $result->{author} =~ s /\)//g;
120 $query .= " and au,ext=$result->{author}";
123 my ($error,$searchresults) =
124 SimpleSearch($query); # FIXME :: hardcoded !
126 foreach my $possible_duplicate_record (@$searchresults) {
128 MARC::Record->new_from_usmarc($possible_duplicate_record);
129 my $result = TransformMarcToKoha( $dbh, $marcrecord, '' );
131 # FIXME :: why 2 $biblionumber ?
133 push @results, $result->{'biblionumber'};
134 push @results, $result->{'title'};
142 ($error,$results) = SimpleSearch($query,@servers);
144 this function performs a simple search on the catalog using zoom.
150 * $query could be a simple keyword or a complete CCL query wich is depending on your ccl file.
151 * @servers is optionnal. default one is read on koha.xml
154 * $error is a string which containt the description error if there is one. Else it's empty.
155 * \@results is an array of marc record.
157 =item C<usage in the script:>
161 my ($error, $marcresults) = SimpleSearch($query);
163 if (defined $error) {
164 $template->param(query_error => $error);
165 warn "error: ".$error;
166 output_html_with_http_headers $input, $cookie, $template->output;
170 my $hits = scalar @$marcresults;
173 for(my $i=0;$i<$hits;$i++) {
175 my $marcrecord = MARC::File::USMARC::decode($marcresults->[$i]);
176 my $biblio = TransformMarcToKoha(C4::Context->dbh,$marcrecord,'');
178 #build the hash for the template.
179 $resultsloop{highlight} = ($i % 2)?(1):(0);
180 $resultsloop{title} = $biblio->{'title'};
181 $resultsloop{subtitle} = $biblio->{'subtitle'};
182 $resultsloop{biblionumber} = $biblio->{'biblionumber'};
183 $resultsloop{author} = $biblio->{'author'};
184 $resultsloop{publishercode} = $biblio->{'publishercode'};
185 $resultsloop{publicationyear} = $biblio->{'publicationyear'};
187 push @results, \%resultsloop;
189 $template->param(result=>\@results);
195 if (C4::Context->preference('NoZebra')) {
196 my $result = NZorder(NZanalyse($query))->{'biblioserver'}->{'RECORDS'};
197 return (undef,$result);
203 return ( "No query entered", undef ) unless $query;
205 #@servers = (C4::Context->config("biblioserver")) unless @servers;
207 ("biblioserver") unless @servers
208 ; # FIXME hardcoded value. See catalog/search.pl & opac-search.pl too.
211 for ( my $i = 0 ; $i < @servers ; $i++ ) {
212 $zconns[$i] = C4::Context->Zconn( $servers[$i], 1 );
215 ->search( new ZOOM::Query::CCL2RPN( $query, $zconns[$i] ) );
217 # getting error message if one occured.
219 $zconns[$i]->errmsg() . " ("
220 . $zconns[$i]->errcode() . ") "
221 . $zconns[$i]->addinfo() . " "
222 . $zconns[$i]->diagset();
224 return ( $error, undef ) if $zconns[$i]->errcode();
228 while ( ( my $i = ZOOM::event( \@zconns ) ) != 0 ) {
229 $ev = $zconns[ $i - 1 ]->last_event();
230 if ( $ev == ZOOM::Event::ZEND ) {
231 $hits = $tmpresults[ $i - 1 ]->size();
234 for ( my $j = 0 ; $j < $hits ; $j++ ) {
235 my $record = $tmpresults[ $i - 1 ]->record($j)->raw();
236 push @results, $record;
240 return ( undef, \@results );
244 # performs the search
247 $koha_query, $federated_query, $sort_by_ref,
248 $servers_ref, $results_per_page, $offset,
249 $expanded_facet, $branches, $query_type,
252 # warn "Query : $koha_query";
253 my @servers = @$servers_ref;
254 my @sort_by = @$sort_by_ref;
256 # create the zoom connection and query object
260 my $results_hashref = ();
263 my $facets_counter = ();
264 my $facets_info = ();
265 my $facets = getFacets();
267 #### INITIALIZE SOME VARS USED CREATE THE FACETED RESULTS
268 my @facets_loop; # stores the ref to array of hashes for template
269 for ( my $i = 0 ; $i < @servers ; $i++ ) {
270 $zconns[$i] = C4::Context->Zconn( $servers[$i], 1 );
272 # perform the search, create the results objects
273 # if this is a local search, use the $koha-query, if it's a federated one, use the federated-query
275 if ( $servers[$i] =~ /biblioserver/ ) {
276 $query_to_use = $koha_query;
279 $query_to_use = $federated_query;
282 # check if we've got a query_type defined
286 if ( $query_type =~ /^ccl/ ) {
288 s/\:/\=/g; # change : to = last minute (FIXME)
290 # warn "CCL : $query_to_use";
293 new ZOOM::Query::CCL2RPN( $query_to_use, $zconns[$i] )
296 elsif ( $query_type =~ /^cql/ ) {
298 # warn "CQL : $query_to_use";
301 new ZOOM::Query::CQL( $query_to_use, $zconns[$i] ) );
303 elsif ( $query_type =~ /^pqf/ ) {
305 # warn "PQF : $query_to_use";
308 new ZOOM::Query::PQF( $query_to_use, $zconns[$i] ) );
314 # warn "preparing to scan";
317 new ZOOM::Query::CCL2RPN( $query_to_use, $zconns[$i] )
322 # warn "LAST : $query_to_use";
325 new ZOOM::Query::CCL2RPN( $query_to_use, $zconns[$i] )
331 warn "prob with query toto $query_to_use " . $@;
334 # concatenate the sort_by limits and pass them to the results object
336 foreach my $sort (@sort_by) {
337 $sort_by .= $sort . " "; # used to be $sort,
339 $results[$i]->sort( "yaz", $sort_by ) if $sort_by;
341 while ( ( my $i = ZOOM::event( \@zconns ) ) != 0 ) {
342 my $ev = $zconns[ $i - 1 ]->last_event();
343 if ( $ev == ZOOM::Event::ZEND ) {
344 my $size = $results[ $i - 1 ]->size();
347 #$results_hash->{'server'} = $servers[$i-1];
348 # loop through the results
349 $results_hash->{'hits'} = $size;
351 if ( $offset + $results_per_page <= $size ) {
352 $times = $offset + $results_per_page;
357 for ( my $j = $offset ; $j < $times ; $j++ )
358 { #(($offset+$count<=$size) ? ($offset+$count):$size) ; $j++){
362 ## This is just an index scan
364 my ( $term, $occ ) = $results[ $i - 1 ]->term($j);
366 # here we create a minimal MARC record and hand it off to the
367 # template just like a normal result ... perhaps not ideal, but
369 my $tmprecord = MARC::Record->new();
370 $tmprecord->encoding('UTF-8');
373 # srote the minimal record in author/title (depending on MARC flavour)
374 if ( C4::Context->preference("marcflavour") eq
377 $tmptitle = MARC::Field->new(
384 $tmptitle = MARC::Field->new(
390 $tmprecord->append_fields($tmptitle);
391 $results_hash->{'RECORDS'}[$j] =
392 $tmprecord->as_usmarc();
395 $record = $results[ $i - 1 ]->record($j)->raw();
397 #warn "RECORD $j:".$record;
398 $results_hash->{'RECORDS'}[$j] =
399 $record; # making a reference to a hash
400 # Fill the facets while we're looping
401 $facet_record = MARC::Record->new_from_usmarc($record);
403 #warn $servers[$i-1].$facet_record->title();
404 for ( my $k = 0 ; $k <= @$facets ; $k++ ) {
405 if ( $facets->[$k] ) {
407 for my $tag ( @{ $facets->[$k]->{'tags'} } ) {
408 push @fields, $facet_record->field($tag);
410 for my $field (@fields) {
411 my @subfields = $field->subfields();
412 for my $subfield (@subfields) {
413 my ( $code, $data ) = @$subfield;
415 $facets->[$k]->{'subfield'} )
417 $facets_counter->{ $facets->[$k]
418 ->{'link_value'} }->{$data}++;
422 $facets_info->{ $facets->[$k]->{'link_value'} }
424 $facets->[$k]->{'label_value'};
425 $facets_info->{ $facets->[$k]->{'link_value'} }
426 ->{'expanded'} = $facets->[$k]->{'expanded'};
431 $results_hashref->{ $servers[ $i - 1 ] } = $results_hash;
434 #print "connection ", $i-1, ": $size hits";
435 #print $results[$i-1]->record(0)->render() if $size > 0;
438 sort { $facets_counter->{$b} <=> $facets_counter->{$a} }
439 keys %$facets_counter
443 my $number_of_facets;
444 my @this_facets_array;
447 $facets_counter->{$link_value}
448 ->{$b} <=> $facets_counter->{$link_value}->{$a}
449 } keys %{ $facets_counter->{$link_value} }
453 if ( ( $number_of_facets < 6 )
454 || ( $expanded_facet eq $link_value )
455 || ( $facets_info->{$link_value}->{'expanded'} ) )
458 # sanitize the link value ), ( will cause errors with CCL
459 my $facet_link_value = $one_facet;
460 $facet_link_value =~ s/(\(|\))/ /g;
462 # fix the length that will display in the label
463 my $facet_label_value = $one_facet;
464 $facet_label_value = substr( $one_facet, 0, 20 ) . "..."
465 unless length($facet_label_value) <= 20;
467 # well, if it's a branch, label by the name, not the code
468 if ( $link_value =~ /branch/ ) {
470 $branches->{$one_facet}->{'branchname'};
473 # but we're down with the whole label being in the link's title
474 my $facet_title_value = $one_facet;
476 push @this_facets_array,
480 $facets_counter->{$link_value}->{$one_facet},
481 facet_label_value => $facet_label_value,
482 facet_title_value => $facet_title_value,
483 facet_link_value => $facet_link_value,
484 type_link_value => $link_value,
489 unless ( $facets_info->{$link_value}->{'expanded'} ) {
491 if ( ( $number_of_facets > 6 )
492 && ( $expanded_facet ne $link_value ) );
497 type_link_value => $link_value,
498 type_id => $link_value . "_id",
500 $facets_info->{$link_value}->{'label_value'},
501 facets => \@this_facets_array,
502 expandable => $expandable,
503 expand => $link_value,
509 return ( undef, $results_hashref, \@facets_loop );
512 # build the query itself
514 my ( $query, $operators, $operands, $indexes, $limits, $sort_by ) = @_;
516 my @operators = @$operators if $operators;
517 my @indexes = @$indexes if $indexes;
518 my @operands = @$operands if $operands;
519 my @limits = @$limits if $limits;
520 my @sort_by = @$sort_by if $sort_by;
522 my $human_search_desc; # a human-readable query
523 my $machine_search_desc; #a machine-readable query
524 # FIXME: the locale should be set based on the syspref
525 my $stemmer = Lingua::Stem->new( -locale => 'EN-US' );
527 # FIXME: these should be stored in the db so the librarian can modify the behavior
528 $stemmer->add_exceptions(
537 # STEP I: determine if this is a form-based / simple query or if it's complex (if complex,
538 # we can't handle field weighting, stemming until a formal query parser is written
539 # I'll work on this soon -- JF
540 #if (!$query) { # form-based
541 # check if this is a known query language query, if it is, return immediately:
542 if ( $query =~ /^ccl=/ ) {
543 return ( undef, $', $', $', 'ccl' );
545 if ( $query =~ /^cql=/ ) {
546 return ( undef, $', $', $', 'cql' );
548 if ( $query =~ /^pqf=/ ) {
549 return ( undef, $', $', $', 'pqf' );
551 if ( $query =~ /(\(|\))/ ) { # sorry, too complex
552 return ( undef, $query, $query, $query, 'ccl' );
555 # form-based queries are limited to non-nested a specific depth, so we can easily
556 # modify the incoming query operands and indexes to do stemming and field weighting
557 # Once we do so, we'll end up with a value in $query, just like if we had an
558 # incoming $query from the user
561 ; # clear it out so we can populate properly with field-weighted stemmed query
563 ; # a flag used to keep track if there was a previous query
564 # if there was, we can apply the current operator
565 for ( my $i = 0 ; $i <= @operands ; $i++ ) {
566 my $operand = $operands[$i];
567 # remove stopwords from operand : parse all stopwords & remove them (case insensitive)
568 # we use IsAlpha unicode definition, to deal correctly with diacritics.
569 # otherwise, a french word like "leçon" is splitted in "le" "çon", le is an empty word, we get "çon"
570 # and don't find anything...
571 foreach (keys %{C4::Context->stopwords}) {
572 $operand=~ s/\P{IsAlpha}$_\P{IsAlpha}/ /i;
573 $operand=~ s/^$_\P{IsAlpha}/ /i;
574 $operand=~ s/\P{IsAlpha}$_$/ /i;
576 my $index = $indexes[$i];
578 my $stemming = C4::Context->parameters("Stemming") || 0;
579 my $weight_fields = C4::Context->parameters("WeightFields") || 0;
581 if ( $operands[$i] ) {
582 $operand =~ s/^(and |or |not )//i;
584 # STEMMING FIXME: need to refine the field weighting so stemmed operands don't disrupt the query ranking
586 my @words = split( / /, $operands[$i] );
587 my $stems = $stemmer->stem(@words);
588 foreach my $stem (@$stems) {
589 $stemmed_operand .= "$stem";
590 $stemmed_operand .= "?"
591 unless ( $stem =~ /(and$|or$|not$)/ )
592 || ( length($stem) < 3 );
593 $stemmed_operand .= " ";
595 #warn "STEM: $stemmed_operand";
598 #$operand = $stemmed_operand;
601 # FIELD WEIGHTING - This is largely experimental stuff. What I'm committing works
602 # pretty well but will work much better when we have an actual query parser
604 if ($weight_fields) {
606 " rk=("; # Specifies that we're applying rank
607 # keyword has different weight properties
608 if ( ( $index =~ /kw/ ) || ( !$index ) )
609 { # FIXME: do I need to add right-truncation in the case of stemming?
610 # a simple way to find out if this query uses an index
611 if ( $operand =~ /(\=|\:)/ ) {
612 $weighted_query .= " $operand";
616 " Title-cover,ext,r1=\"$operand\""
617 ; # index label as exact
619 " or ti,ext,r2=$operand"; # index as exact
620 #$weighted_query .= " or ti,phr,r3=$operand"; # index as phrase
621 #$weighted_query .= " or any,ext,r4=$operand"; # index as exact
623 " or kw,wrdl,r5=$operand"; # index as exact
624 $weighted_query .= " or wrd,fuzzy,r9=$operand";
625 $weighted_query .= " or wrd=$stemmed_operand"
629 elsif ( $index =~ /au/ ) {
631 " $index,ext,r1=$operand"; # index label as exact
632 #$weighted_query .= " or (title-sort-az=0 or $index,startswithnt,st-word,r3=$operand #)";
634 " or $index,phr,r3=$operand"; # index as phrase
635 $weighted_query .= " or $index,rt,wrd,r3=$operand";
637 elsif ( $index =~ /ti/ ) {
639 " Title-cover,ext,r1=$operand"; # index label as exact
640 $weighted_query .= " or Title-series,ext,r2=$operand";
642 #$weighted_query .= " or ti,ext,r2=$operand";
643 #$weighted_query .= " or ti,phr,r3=$operand";
644 #$weighted_query .= " or ti,wrd,r3=$operand";
646 " or (title-sort-az=0 or Title-cover,startswithnt,st-word,r3=$operand #)";
648 " or (title-sort-az=0 or Title-cover,phr,r6=$operand)";
650 #$weighted_query .= " or Title-cover,wrd,r5=$operand";
651 #$weighted_query .= " or ti,ext,r6=$operand";
652 #$weighted_query .= " or ti,startswith,phr,r7=$operand";
653 #$weighted_query .= " or ti,phr,r8=$operand";
654 #$weighted_query .= " or ti,wrd,r9=$operand";
656 #$weighted_query .= " or ti,ext,r2=$operand"; # index as exact
657 #$weighted_query .= " or ti,phr,r3=$operand"; # index as phrase
658 #$weighted_query .= " or any,ext,r4=$operand"; # index as exact
659 #$weighted_query .= " or kw,wrd,r5=$operand"; # index as exact
663 " $index,ext,r1=$operand"; # index label as exact
664 #$weighted_query .= " or $index,ext,r2=$operand"; # index as exact
666 " or $index,phr,r3=$operand"; # index as phrase
667 $weighted_query .= " or $index,rt,wrd,r3=$operand";
669 " or $index,wrd,r5=$operand"
670 ; # index as word right-truncated
671 $weighted_query .= " or $index,wrd,fuzzy,r8=$operand";
673 $weighted_query .= ")"; # close rank specification
674 $operand = $weighted_query;
677 # only add an operator if there is a previous operand
678 if ($previous_operand) {
679 if ( $operators[ $i - 1 ] ) {
680 $query .= " $operators[$i-1] $index: $operand";
682 $human_search_desc .=
683 " $operators[$i-1] $operands[$i]";
686 $human_search_desc .=
687 " $operators[$i-1] $index: $operands[$i]";
691 # the default operator is and
693 $query .= " and $index: $operand";
694 $human_search_desc .= " and $index: $operands[$i]";
699 $query .= " $operand";
700 $human_search_desc .= " $operands[$i]";
703 $query .= " $index: $operand";
704 $human_search_desc .= " $index: $operands[$i]";
706 $previous_operand = 1;
714 my $limit_search_desc;
715 foreach my $limit (@limits) {
717 # FIXME: not quite right yet ... will work on this soon -- JF
718 my $type = $1 if $limit =~ m/([^:]+):([^:]*)/;
719 if ( $limit =~ /available/ ) {
721 " (($query and datedue=0000-00-00) or ($query and datedue=0000-00-00 not lost=1) or ($query and datedue=0000-00-00 not lost=2))";
723 #$limit_search_desc.=" and available";
725 elsif ( ($limit_query) && ( index( $limit_query, $type, 0 ) > 0 ) ) {
726 if ( $limit_query !~ /\(/ ) {
728 substr( $limit_query, 0, index( $limit_query, $type, 0 ) )
730 . substr( $limit_query, index( $limit_query, $type, 0 ) )
734 substr( $limit_search_desc, 0,
735 index( $limit_search_desc, $type, 0 ) )
737 . substr( $limit_search_desc,
738 index( $limit_search_desc, $type, 0 ) )
744 chop $limit_search_desc;
745 $limit_query .= " or $limit )" if $limit;
746 $limit_search_desc .= " or $limit )" if $limit;
749 elsif ( ($limit_query) && ( $limit =~ /mc/ ) ) {
750 $limit_query .= " or $limit" if $limit;
751 $limit_search_desc .= " or $limit" if $limit;
754 # these are treated as AND
755 elsif ($limit_query) {
756 if ($limit =~ /branch/){
757 $limit_query .= " ) and ( $limit" if $limit;
758 $limit_search_desc .= " ) and ( $limit" if $limit;
760 $limit_query .= " or $limit" if $limit;
761 $limit_search_desc .= " or $limit" if $limit;
765 # otherwise, there is nothing but the limit
767 $limit_query .= "$limit" if $limit;
768 $limit_search_desc .= "$limit" if $limit;
772 # if there's also a query, we need to AND the limits to it
773 if ( ($limit_query) && ($query) ) {
774 $limit_query = " and (" . $limit_query . ")";
775 $limit_search_desc = " and ($limit_search_desc)" if $limit_search_desc;
778 $query .= $limit_query;
779 $human_search_desc .= $limit_search_desc;
781 # now normalize the strings
782 $query =~ s/ / /g; # remove extra spaces
783 $query =~ s/^ //g; # remove any beginning spaces
784 $query =~ s/:/=/g; # causes probs for server
785 $query =~ s/==/=/g; # remove double == from query
787 my $federated_query = $human_search_desc;
788 $federated_query =~ s/ / /g;
789 $federated_query =~ s/^ //g;
790 $federated_query =~ s/:/=/g;
791 my $federated_query_opensearch = $federated_query;
793 # my $federated_query_RPN = new ZOOM::Query::CCL2RPN( $query , C4::Context->ZConn('biblioserver'));
795 $human_search_desc =~ s/ / /g;
796 $human_search_desc =~ s/^ //g;
797 my $koha_query = $query;
799 # warn "QUERY:".$koha_query;
800 # warn "SEARCHDESC:".$human_search_desc;
801 # warn "FEDERATED QUERY:".$federated_query;
802 return ( undef, $human_search_desc, $koha_query, $federated_query );
805 # IMO this subroutine is pretty messy still -- it's responsible for
806 # building the HTML output for the template
808 my ( $searchdesc, $hits, $results_per_page, $offset, @marcresults ) = @_;
810 my $dbh = C4::Context->dbh;
814 my $span_terms_hashref;
815 for my $span_term ( split( / /, $searchdesc ) ) {
816 $span_term =~ s/(.*=|\)|\(|\+|\.)//g;
817 $span_terms_hashref->{$span_term}++;
820 #Build brancnames hash
822 #get branch information.....
825 $dbh->prepare("SELECT branchcode,branchname FROM branches")
826 ; # FIXME : use C4::Koha::GetBranches
828 while ( my $bdata = $bsth->fetchrow_hashref ) {
829 $branches{ $bdata->{'branchcode'} } = $bdata->{'branchname'};
833 #find itemtype & itemtype image
836 $dbh->prepare("SELECT itemtype,description,imageurl,summary,notforloan FROM itemtypes");
838 while ( my $bdata = $bsth->fetchrow_hashref ) {
839 $itemtypes{ $bdata->{'itemtype'} }->{description} =
840 $bdata->{'description'};
841 $itemtypes{ $bdata->{'itemtype'} }->{imageurl} = $bdata->{'imageurl'};
842 $itemtypes{ $bdata->{'itemtype'} }->{summary} = $bdata->{'summary'};
843 $itemtypes{ $bdata->{'itemtype'} }->{notforloan} = $bdata->{'notforloan'};
846 #search item field code
849 "select tagfield from marc_subfield_structure where kohafield like 'items.itemnumber'"
852 my ($itemtag) = $sth->fetchrow;
854 ## find column names of items related to MARC
855 my $sth2 = $dbh->prepare("SHOW COLUMNS from items");
857 my %subfieldstosearch;
858 while ( ( my $column ) = $sth2->fetchrow ) {
859 my ( $tagfield, $tagsubfield ) =
860 &GetMarcFromKohaField( "items." . $column, "" );
861 $subfieldstosearch{$column} = $tagsubfield;
865 if ( $hits && $offset + $results_per_page <= $hits ) {
866 $times = $offset + $results_per_page;
872 for ( my $i = $offset ; $i <= $times - 1 ; $i++ ) {
874 $marcrecord = MARC::File::USMARC::decode( $marcresults[$i] );
875 my $oldbiblio = TransformMarcToKoha( $dbh, $marcrecord, '' );
876 # add image url if there is one
877 if ( $itemtypes{ $oldbiblio->{itemtype} }->{imageurl} =~ /^http:/ ) {
878 $oldbiblio->{imageurl} =
879 $itemtypes{ $oldbiblio->{itemtype} }->{imageurl};
880 $oldbiblio->{description} =
881 $itemtypes{ $oldbiblio->{itemtype} }->{description};
884 $oldbiblio->{imageurl} =
885 getitemtypeimagesrc() . "/"
886 . $itemtypes{ $oldbiblio->{itemtype} }->{imageurl}
887 if ( $itemtypes{ $oldbiblio->{itemtype} }->{imageurl} );
888 $oldbiblio->{description} =
889 $itemtypes{ $oldbiblio->{itemtype} }->{description};
892 # build summary if there is one (the summary is defined in itemtypes table
894 if ($itemtypes{ $oldbiblio->{itemtype} }->{summary}) {
895 my $summary = $itemtypes{ $oldbiblio->{itemtype} }->{summary};
896 my @fields = $marcrecord->fields();
897 foreach my $field (@fields) {
898 my $tag = $field->tag();
899 my $tagvalue = $field->as_string();
900 $summary =~ s/\[(.?.?.?.?)$tag\*(.*?)]/$1$tagvalue$2\[$1$tag$2]/g;
902 my @subf = $field->subfields;
903 for my $i (0..$#subf) {
904 my $subfieldcode = $subf[$i][0];
905 my $subfieldvalue = $subf[$i][1];
906 my $tagsubf = $tag.$subfieldcode;
907 $summary =~ s/\[(.?.?.?.?)$tagsubf(.*?)]/$1$subfieldvalue$2\[$1$tagsubf$2]/g;
911 $summary =~ s/\[(.*?)]//g;
912 $summary =~ s/\n/<br>/g;
913 $oldbiblio->{summary} = $summary;
915 # add spans to search term in results
916 foreach my $term ( keys %$span_terms_hashref ) {
919 my $old_term = $term;
920 if ( length($term) > 3 ) {
921 $term =~ s/(.*=|\)|\(|\+|\.|\?)//g;
923 #FIXME: is there a better way to do this?
924 $oldbiblio->{'title'} =~ s/$term/<span class=term>$&<\/span>/gi;
925 $oldbiblio->{'subtitle'} =~
926 s/$term/<span class=term>$&<\/span>/gi;
928 $oldbiblio->{'author'} =~ s/$term/<span class=term>$&<\/span>/gi;
929 $oldbiblio->{'publishercode'} =~ s/$term/<span class=term>$&<\/span>/gi;
930 $oldbiblio->{'place'} =~ s/$term/<span class=term>$&<\/span>/gi;
931 $oldbiblio->{'pages'} =~ s/$term/<span class=term>$&<\/span>/gi;
932 $oldbiblio->{'notes'} =~ s/$term/<span class=term>$&<\/span>/gi;
933 $oldbiblio->{'size'} =~ s/$term/<span class=term>$&<\/span>/gi;
943 $oldbiblio->{'toggle'} = $toggle;
944 my @fields = $marcrecord->field($itemtag);
947 my $ordered_count = 0;
948 my $onloan_count = 0;
949 my $wthdrawn_count = 0;
950 my $itemlost_count = 0;
954 # check the loan status of the item :
955 # it is not stored in the MARC record, for pref (zebra reindexing)
956 # reason. Thus, we have to get the status from a specific SQL query
958 my $sth_issue = $dbh->prepare("
959 SELECT date_due,returndate
961 WHERE itemnumber=? AND returndate IS NULL");
963 foreach my $field (@fields) {
965 foreach my $code ( keys %subfieldstosearch ) {
966 $item->{$code} = $field->subfield( $subfieldstosearch{$code} );
968 $sth_issue->execute($item->{itemnumber});
969 $item->{due_date} = format_date($sth_issue->fetchrow);
970 $item->{onloan} = 1 if $item->{due_date};
971 # at least one item can be reserved : suppose no
973 if ( $item->{wthdrawn} ) {
976 elsif ( $item->{itemlost} ) {
979 unless ( $item->{notforloan}) {
980 # OK, this one can be issued, so at least one can be reserved
983 if ( ( $item->{onloan} ) && ( $item->{onloan} != '0000-00-00' ) )
985 $items->{ $item->{'homebranch'}.'--'.$item->{'itemcallnumber'} }->{onloancount} = 1;
986 $items->{ $item->{'homebranch'}.'--'.$item->{'itemcallnumber'} }->{due_date} = $item->{due_date};
989 if ( $item->{'homebranch'} ) {
990 $items->{ $item->{'homebranch'}.'--'.$item->{'itemcallnumber'} }->{count}++;
994 elsif ( $item->{'holdingbranch'} ) {
995 $items->{ $item->{'holdingbranch'} }->{count}++;
997 $items->{ $item->{'homebranch'}.'--'.$item->{'itemcallnumber'} }->{itemcallnumber} = $item->{itemcallnumber};
998 $items->{ $item->{'homebranch'}.'--'.$item->{'itemcallnumber'} }->{location} = $item->{location};
999 $items->{ $item->{'homebranch'}.'--'.$item->{'itemcallnumber'} }->{branchcode} = $item->{homebranch};
1000 } # notforloan, item level and biblioitem level
1002 # last check for norequest : if itemtype is notforloan, it can't be reserved either, whatever the items
1003 $norequests = 1 if $itemtypes{$oldbiblio->{itemtype}}->{notforloan};
1005 for my $key ( sort keys %$items ) {
1007 branchname => $branches{$items->{$key}->{branchcode}},
1008 branchcode => $items->{$key}->{branchcode},
1009 count => $items->{$key}->{count}==1 ?"":$items->{$key}->{count},
1010 itemcallnumber => $items->{$key}->{itemcallnumber},
1011 location => $items->{$key}->{location},
1012 onloancount => $items->{$key}->{onloancount},
1013 due_date => $items->{$key}->{due_date},
1015 push @items_loop, $this_item;
1017 $oldbiblio->{norequests} = $norequests;
1018 $oldbiblio->{items_loop} = \@items_loop;
1019 $oldbiblio->{onloancount} = $onloan_count;
1020 $oldbiblio->{wthdrawncount} = $wthdrawn_count;
1021 $oldbiblio->{itemlostcount} = $itemlost_count;
1022 $oldbiblio->{orderedcount} = $ordered_count;
1023 $oldbiblio->{isbn} =~ s/-//g; # deleting - in isbn to enable amazon content
1024 push( @newresults, $oldbiblio );
1031 #----------------------------------------------------------------------
1033 # Non-Zebra GetRecords#
1034 #----------------------------------------------------------------------
1038 NZgetRecords has the same API as zera getRecords, even if some parameters are not managed
1044 $koha_query, $federated_query, $sort_by_ref,
1045 $servers_ref, $results_per_page, $offset,
1046 $expanded_facet, $branches, $query_type,
1049 my $result = NZanalyse($koha_query);
1050 return (undef,NZorder($result,@$sort_by_ref[0],$results_per_page,$offset),undef);
1055 NZanalyse : get a CQL string as parameter, and returns a list of biblionumber;title,biblionumber;title,...
1056 the list is builded from inverted index in nozebra SQL table
1057 note that title is here only for convenience : the sorting will be very fast when requested on title
1058 if the sorting is requested on something else, we will have to reread all results, and that may be longer.
1063 my ($string,$server) = @_;
1064 # $server contains biblioserver or authorities, depending on what we search on.
1065 warn "querying : $string on $server";
1066 $server='biblioserver' unless $server;
1067 # if we have a ", replace the content to discard temporarily any and/or/not inside
1069 if ($string =~/"/) {
1070 $string =~ s/"(.*?)"/__X__/;
1072 # print "commacontent : $commacontent\n";
1074 # split the query string in 3 parts : X AND Y means : $left="X", $operand="AND" and $right="Y"
1075 # then, call again NZanalyse with $left and $right
1076 # (recursive until we find a leaf (=> something without and/or/not)
1077 $string =~ /(.*)( and | or | not | AND | OR | NOT )(.*)/;
1080 my $operand = lc($2);
1081 # it's not a leaf, we have a and/or/not
1083 # reintroduce comma content if needed
1084 $right =~ s/__X__/"$commacontent"/ if $commacontent;
1085 $left =~ s/__X__/"$commacontent"/ if $commacontent;
1086 # warn "node : $left / $operand / $right\n";
1087 my $leftresult = NZanalyse($left,$server);
1088 my $rightresult = NZanalyse($right,$server);
1089 # OK, we have the results for right and left part of the query
1090 # depending of operand, intersect, union or exclude both lists
1091 # to get a result list
1092 if ($operand eq ' and ') {
1093 my @leftresult = split /;/, $leftresult;
1094 # my @rightresult = split /;/,$leftresult;
1096 # parse the left results, and if the biblionumber exist in the right result, save it in finalresult
1097 # the result is stored twice, to have the same weight for AND than OR.
1098 # example : TWO : 61,61,64,121 (two is twice in the biblio #61) / TOWER : 61,64,130
1099 # result : 61,61,61,61,64,64 for two AND tower : 61 has more weight than 64
1100 foreach (@leftresult) {
1101 if ($rightresult =~ "$_;") {
1102 $finalresult .= "$_;$_;";
1105 return $finalresult;
1106 } elsif ($operand eq ' or ') {
1107 # just merge the 2 strings
1108 return $leftresult.$rightresult;
1109 } elsif ($operand eq ' not ') {
1110 my @leftresult = split /;/, $leftresult;
1111 # my @rightresult = split /;/,$leftresult;
1113 foreach (@leftresult) {
1114 unless ($rightresult =~ "$_;") {
1115 $finalresult .= "$_;";
1118 return $finalresult;
1120 # this error is impossible, because of the regexp that isolate the operand, but just in case...
1121 die "error : operand unknown : $operand for $string";
1123 # it's a leaf, do the real SQL query and return the result
1125 $string =~ s/__X__/"$commacontent"/ if $commacontent;
1126 $string =~ s/-|\.|\?|,|;|!|'|\(|\)|\[|\]|{|}|"|<|>|&|\+|\*|\// /g;
1127 # warn "leaf : $string\n";
1128 # parse the string in in operator/operand/value again
1129 $string =~ /(.*)(=|>|>=|<|<=)(.*)/;
1134 # automatic replace for short operators
1135 $left='title' if $left eq 'ti';
1136 $left='author' if $left eq 'au';
1137 $left='publisher' if $left eq 'pb';
1138 $left='subject' if $left eq 'su';
1139 $left='koha-Auth-Number' if $left eq 'an';
1140 $left='keyword' if $left eq 'kw';
1142 #do a specific search
1143 my $dbh = C4::Context->dbh;
1144 $operator='LIKE' if $operator eq '=' and $right=~ /%/;
1145 my $sth = $dbh->prepare("SELECT biblionumbers FROM nozebra WHERE server=? AND indexname=? AND value $operator ?");
1146 warn "$left / $operator / $right\n";
1147 # split each word, query the DB and build the biblionumbers result
1148 foreach (split / /,$right) {
1151 # warn "EXECUTE : $server, $left, $_";
1152 $sth->execute($server, $left, $_);
1153 while (my $line = $sth->fetchrow) {
1154 $biblionumbers .= $line;
1155 # warn "result : $line";
1157 # do a AND with existing list if there is one, otherwise, use the biblionumbers list as 1st result list
1159 my @leftresult = split /;/, $biblionumbers;
1161 foreach (@leftresult) {
1162 if ($results =~ "$_;") {
1168 $results = $biblionumbers;
1172 #do a complete search (all indexes)
1173 my $dbh = C4::Context->dbh;
1174 my $sth = $dbh->prepare("SELECT biblionumbers FROM nozebra WHERE server=? AND value LIKE ?");
1175 # split each word, query the DB and build the biblionumbers result
1176 foreach (split / /,$string) {
1177 next if C4::Context->stopwords->{uc($_)}; # skip if stopword
1178 #warn "search on all indexes on $_";
1181 $sth->execute($server, $_);
1182 while (my $line = $sth->fetchrow) {
1183 $biblionumbers .= $line;
1185 # do a AND with existing list if there is one, otherwise, use the biblionumbers list as 1st result list
1187 my @leftresult = split /;/, $biblionumbers;
1189 foreach (@leftresult) {
1190 if ($results =~ "$_;") {
1196 $results = $biblionumbers;
1200 # warn "return : $results for LEAF : $string";
1207 $finalresult = NZorder($biblionumbers, $ordering,$results_per_page,$offset);
1215 my ($biblionumbers, $ordering,$results_per_page,$offset) = @_;
1216 # order title asc by default
1217 # $ordering = '1=36 <i' unless $ordering;
1218 $results_per_page=20 unless $results_per_page;
1219 $offset = 0 unless $offset;
1220 my $dbh = C4::Context->dbh;
1222 # order by POPULARITY
1224 if ($ordering =~ /1=9523/) {
1227 # popularity is not in MARC record, it's builded from a specific query
1228 my $sth = $dbh->prepare("select sum(issues) from items where biblionumber=?");
1229 foreach (split /;/,$biblionumbers) {
1230 my ($biblionumber,$title) = split /,/,$_;
1231 $result{$biblionumber}=GetMarcBiblio($biblionumber);
1232 $sth->execute($biblionumber);
1233 my $popularity= $sth->fetchrow ||0;
1234 # hint : the key is popularity.title because we can have
1235 # many results with the same popularity. In this cas, sub-ordering is done by title
1236 # we also have biblionumber to avoid bug for 2 biblios with the same title & popularity
1237 # (un-frequent, I agree, but we won't forget anything that way ;-)
1238 $popularity{sprintf("%10d",$popularity).$title.$biblionumber} = $biblionumber;
1240 # sort the hash and return the same structure as GetRecords (Zebra querying)
1243 if ($ordering eq '1=9523 >i') { # sort popularity DESC
1244 foreach my $key (sort {$b cmp $a} (keys %popularity)) {
1245 $result_hash->{'RECORDS'}[$numbers++] = $result{$popularity{$key}}->as_usmarc();
1247 } else { # sort popularity ASC
1248 foreach my $key (sort (keys %popularity)) {
1249 $result_hash->{'RECORDS'}[$numbers++] = $result{$popularity{$key}}->as_usmarc();
1253 $result_hash->{'hits'} = $numbers;
1254 $finalresult->{'biblioserver'} = $result_hash;
1255 return $finalresult;
1259 } elsif ($ordering eq '1=1003 <i'){
1261 foreach (split /;/,$biblionumbers) {
1262 my ($biblionumber,$title) = split /,/,$_;
1263 my $record=GetMarcBiblio($biblionumber);
1265 if (C4::Context->preference('marcflavour') eq 'UNIMARC') {
1266 $author=$record->subfield('200','f');
1267 $author=$record->subfield('700','a') unless $author;
1269 $author=$record->subfield('100','a');
1271 # hint : the result is sorted by title.biblionumber because we can have X biblios with the same title
1272 # and we don't want to get only 1 result for each of them !!!
1273 $result{$author.$biblionumber}=$record;
1275 # sort the hash and return the same structure as GetRecords (Zebra querying)
1278 if ($ordering eq '1=1003 <i') { # sort by author desc
1279 foreach my $key (sort (keys %result)) {
1280 $result_hash->{'RECORDS'}[$numbers++] = $result{$key}->as_usmarc();
1282 } else { # sort by author ASC
1283 foreach my $key (sort { $a cmp $b } (keys %result)) {
1284 $result_hash->{'RECORDS'}[$numbers++] = $result{$key}->as_usmarc();
1288 $result_hash->{'hits'} = $numbers;
1289 $finalresult->{'biblioserver'} = $result_hash;
1290 return $finalresult;
1292 # ORDER BY callnumber
1294 } elsif ($ordering eq '1=20 <i'){
1296 foreach (split /;/,$biblionumbers) {
1297 my ($biblionumber,$title) = split /,/,$_;
1298 my $record=GetMarcBiblio($biblionumber);
1300 my ($callnumber_tag,$callnumber_subfield)=GetMarcFromKohaField($dbh,'items.itemcallnumber');
1301 ($callnumber_tag,$callnumber_subfield)= GetMarcFromKohaField('biblioitems.callnumber') unless $callnumber_tag;
1302 if (C4::Context->preference('marcflavour') eq 'UNIMARC') {
1303 $callnumber=$record->subfield('200','f');
1305 $callnumber=$record->subfield('100','a');
1307 # hint : the result is sorted by title.biblionumber because we can have X biblios with the same title
1308 # and we don't want to get only 1 result for each of them !!!
1309 $result{$callnumber.$biblionumber}=$record;
1311 # sort the hash and return the same structure as GetRecords (Zebra querying)
1314 if ($ordering eq '1=1003 <i') { # sort by title desc
1315 foreach my $key (sort (keys %result)) {
1316 $result_hash->{'RECORDS'}[$numbers++] = $result{$key}->as_usmarc();
1318 } else { # sort by title ASC
1319 foreach my $key (sort { $a cmp $b } (keys %result)) {
1320 $result_hash->{'RECORDS'}[$numbers++] = $result{$key}->as_usmarc();
1324 $result_hash->{'hits'} = $numbers;
1325 $finalresult->{'biblioserver'} = $result_hash;
1326 return $finalresult;
1327 } elsif ($ordering =~ /1=31/){ #pub year
1329 foreach (split /;/,$biblionumbers) {
1330 my ($biblionumber,$title) = split /,/,$_;
1331 my $record=GetMarcBiblio($biblionumber);
1332 my ($publicationyear_tag,$publicationyear_subfield)=GetMarcFromKohaField($dbh,'biblioitems.publicationyear');
1333 my $publicationyear=$record->subfield($publicationyear_tag,$publicationyear_subfield);
1334 # hint : the result is sorted by title.biblionumber because we can have X biblios with the same title
1335 # and we don't want to get only 1 result for each of them !!!
1336 $result{$publicationyear.$biblionumber}=$record;
1338 # sort the hash and return the same structure as GetRecords (Zebra querying)
1341 if ($ordering eq '1=31 <i') { # sort by pubyear desc
1342 foreach my $key (sort (keys %result)) {
1343 $result_hash->{'RECORDS'}[$numbers++] = $result{$key}->as_usmarc();
1345 } else { # sort by pub year ASC
1346 foreach my $key (sort { $b cmp $a } (keys %result)) {
1347 $result_hash->{'RECORDS'}[$numbers++] = $result{$key}->as_usmarc();
1351 $result_hash->{'hits'} = $numbers;
1352 $finalresult->{'biblioserver'} = $result_hash;
1353 return $finalresult;
1357 } elsif ($ordering =~ /1=4/) {
1358 # the title is in the biblionumbers string, so we just need to build a hash, sort it and return
1360 foreach (split /;/,$biblionumbers) {
1361 my ($biblionumber,$title) = split /,/,$_;
1362 # hint : the result is sorted by title.biblionumber because we can have X biblios with the same title
1363 # and we don't want to get only 1 result for each of them !!!
1364 # hint & speed improvement : we can order without reading the record
1365 # so order, and read records only for the requested page !
1366 $result{$title.$biblionumber}=$biblionumber;
1368 # sort the hash and return the same structure as GetRecords (Zebra querying)
1371 if ($ordering eq '1=4 <i') { # sort by title desc
1372 foreach my $key (sort (keys %result)) {
1373 $result_hash->{'RECORDS'}[$numbers++] = $result{$key};
1375 } else { # sort by title ASC
1376 foreach my $key (sort { $b cmp $a } (keys %result)) {
1377 $result_hash->{'RECORDS'}[$numbers++] = $result{$key};
1380 # limit the $results_per_page to result size if it's more
1381 $results_per_page = $numbers-1 if $numbers < $results_per_page;
1382 # for the requested page, replace biblionumber by the complete record
1383 # speed improvement : avoid reading too much things
1384 for (my $counter=$offset;$counter<=$offset+$results_per_page;$counter++) {
1385 $result_hash->{'RECORDS'}[$counter] = GetMarcBiblio($result_hash->{'RECORDS'}[$counter])->as_usmarc;
1388 $result_hash->{'hits'} = $numbers;
1389 $finalresult->{'biblioserver'} = $result_hash;
1390 return $finalresult;
1395 # we need 2 hashes to order by ranking : the 1st one to count the ranking, the 2nd to order by ranking
1398 foreach (split /;/,$biblionumbers) {
1399 my ($biblionumber,$title) = split /,/,$_;
1400 $title =~ /(.*)-(\d)/;
1403 # note that we + the ranking because ranking is calculated on weight of EACH term requested.
1404 # if we ask for "two towers", and "two" has weight 2 in biblio N, and "towers" has weight 4 in biblio N
1405 # biblio N has ranking = 6
1406 $count_ranking{$biblionumber} += $ranking;
1408 # build the result by "inverting" the count_ranking hash
1409 # 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
1411 foreach (keys %count_ranking) {
1412 $result{sprintf("%10d",$count_ranking{$_}).'-'.$_} = $_;
1414 # sort the hash and return the same structure as GetRecords (Zebra querying)
1417 foreach my $key (sort {$b cmp $a} (keys %result)) {
1418 $result_hash->{'RECORDS'}[$numbers++] = $result{$key};
1420 # limit the $results_per_page to result size if it's more
1421 $results_per_page = $numbers-1 if $numbers < $results_per_page;
1422 # for the requested page, replace biblionumber by the complete record
1423 # speed improvement : avoid reading too much things
1424 for (my $counter=$offset;$counter<=$offset+$results_per_page;$counter++) {
1425 $result_hash->{'RECORDS'}[$counter] = GetMarcBiblio($result_hash->{'RECORDS'}[$counter])->as_usmarc;
1428 $result_hash->{'hits'} = $numbers;
1429 $finalresult->{'biblioserver'} = $result_hash;
1430 return $finalresult;
1435 ($countchanged,$listunchanged) = ModBiblios($listbiblios, $tagsubfield,$initvalue,$targetvalue,$test);
1437 this function changes all the values $initvalue in subfield $tag$subfield in any record in $listbiblios
1438 test parameter if set donot perform change to records in database.
1444 * $listbiblios is an array ref to marcrecords to be changed
1445 * $tagsubfield is the reference of the subfield to change.
1446 * $initvalue is the value to search the record for
1447 * $targetvalue is the value to set the subfield to
1448 * $test is to be set only not to perform changes in database.
1450 =item C<Output arg:>
1451 * $countchanged counts all the changes performed.
1452 * $listunchanged contains the list of all the biblionumbers of records unchanged.
1454 =item C<usage in the script:>
1458 my ($countchanged, $listunchanged) = EditBiblios($results->{RECORD}, $tagsubfield,$initvalue,$targetvalue);;
1459 #If one wants to display unchanged records, you should get biblios foreach @$listunchanged
1460 $template->param(countchanged => $countchanged, loopunchanged=>$listunchanged);
1465 my ($listbiblios,$tagsubfield,$initvalue,$targetvalue,$test)=@_;
1468 my ($tag,$subfield)=($1,$2) if ($tagsubfield=~/^(\d{1,3})([a-z0-9A-Z@])?$/);
1469 if ((length($tag)<3)&& $subfield=~/0-9/){
1470 $tag=$tag.$subfield;
1473 my ($bntag,$bnsubf) = GetMarcFromKohaField('biblio.biblionumber');
1474 my ($itemtag,$itemsubf) = GetMarcFromKohaField('items.itemnumber');
1475 foreach my $usmarc (@$listbiblios){
1477 $record=eval{MARC::Record->new_from_usmarc($usmarc)};
1480 # usmarc is not a valid usmarc May be a biblionumber
1481 if ($tag eq $itemtag){
1482 my $bib=GetBiblioFromItemNumber($usmarc);
1483 $record=GetMarcItem($bib->{'biblionumber'},$usmarc) ;
1484 $biblionumber=$bib->{'biblionumber'};
1486 $record=GetMarcBiblio($usmarc);
1487 $biblionumber=$usmarc;
1491 $biblionumber = $record->subfield($bntag,$bnsubf);
1493 $biblionumber=$record->field($bntag)->data;
1496 #GetBiblionumber is to be written.
1497 #Could be replaced by TransformMarcToKoha (But Would be longer)
1498 if ($record->field($tag)){
1500 foreach my $field ($record->field($tag)){
1502 if ($field->delete_subfield('code' =>$subfield,'match'=>qr($initvalue))){
1505 $field->update($subfield,$targetvalue) if ($targetvalue);
1509 if ($field->delete_field($field)){
1514 $field->data=$targetvalue if ($field->data=~qr($initvalue));
1518 # warn $record->as_formatted;
1520 ModBiblio($record,$biblionumber,GetFrameworkCode($biblionumber)) unless ($test);
1522 push @unmatched, $biblionumber;
1525 push @unmatched, $biblionumber;
1528 return ($countmatched,\@unmatched);
1531 END { } # module clean-up code here (global destructor)
1538 Koha Developement team <info@koha.org>