X-Git-Url: http://git.rot13.org/?a=blobdiff_plain;f=C4%2FSearch.pm;h=1f7cd982d169cc55e26860ae98bb77d1bd89cca7;hb=7273e0f0dab192f2513ca04a1d6292f6bb5868f3;hp=d3fbfca4a0d20072c860b1b0316158b8c53d90fa;hpb=2ffd5b7228f4e638583162d483e1dd2febeafe1b;p=koha.git diff --git a/C4/Search.pm b/C4/Search.pm old mode 100755 new mode 100644 index d3fbfca4a0..1f7cd982d1 --- a/C4/Search.pm +++ b/C4/Search.pm @@ -18,16 +18,15 @@ package C4::Search; use strict; require Exporter; use C4::Context; -use C4::Biblio; # MARCfind_marc_from_kohafield +use C4::Biblio; # GetMarcFromKohaField use C4::Koha; # getFacets use Lingua::Stem; +use C4::Date; use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); # set the version for version checking -$VERSION = do { my @v = '$Revision$' =~ /\d+/g; - shift(@v) . "." . join( "_", map { sprintf "%03d", $_ } @v ); -}; +$VERSION = 3.00; =head1 NAME @@ -53,6 +52,8 @@ This module provides the searching facilities for the Koha into a zebra catalog. &searchResults &getRecords &buildQuery + &NZgetRecords + &ModBiblios ); # make all your functions, whether exported or not; @@ -72,7 +73,7 @@ This function modify the @$fields array and add related fields to search on. sub findseealso { my ( $dbh, $fields ) = @_; - my $tagslib = MARCgettagslib( $dbh, 1 ); + my $tagslib = GetMarcStructure( 1 ); for ( my $i = 0 ; $i <= $#{$fields} ; $i++ ) { my ($tag) = substr( @$fields[$i], 1, 3 ); my ($subfield) = substr( @$fields[$i], 4, 1 ); @@ -89,9 +90,8 @@ sub findseealso { sub FindDuplicate { my ($record) = @_; - return; my $dbh = C4::Context->dbh; - my $result = MARCmarc2koha( $dbh, $record, '' ); + my $result = TransformMarcToKoha( $dbh, $record, '' ); my $sth; my $query; my $search; @@ -99,6 +99,11 @@ sub FindDuplicate { my ( $biblionumber, $title ); # search duplicate on ISBN, easy and fast.. + # ... normalize first + if ( $result->{isbn} ) { + $result->{isbn} =~ s/\(.*$//; + $result->{isbn} =~ s/\s+$//; + } #$search->{'avoidquerylog'}=1; if ( $result->{isbn} ) { $query = "isbn=$result->{isbn}"; @@ -108,20 +113,35 @@ sub FindDuplicate { $result->{title} =~ s /\"//g; $result->{title} =~ s /\(//g; $result->{title} =~ s /\)//g; + # remove valid operators + $result->{title} =~ s/(and|or|not)//g; $query = "ti,ext=$result->{title}"; + $query .= " and mt=$result->{itemtype}" if ($result->{itemtype}); + if ($result->{author}){ + $result->{author} =~ s /\\//g; + $result->{author} =~ s /\"//g; + $result->{author} =~ s /\(//g; + $result->{author} =~ s /\)//g; + # remove valid operators + $result->{author} =~ s/(and|or|not)//g; + $query .= " and au,ext=$result->{author}"; + } } - my ($possible_duplicate_record) = - C4::Biblio::getRecord( "biblioserver", $query, "usmarc" ); # FIXME :: hardcoded ! - if ($possible_duplicate_record) { + my ($error,$searchresults) = + SimpleSearch($query); # FIXME :: hardcoded ! + my @results; + foreach my $possible_duplicate_record (@$searchresults) { my $marcrecord = MARC::Record->new_from_usmarc($possible_duplicate_record); - my $result = MARCmarc2koha( $dbh, $marcrecord, '' ); + my $result = TransformMarcToKoha( $dbh, $marcrecord, '' ); # FIXME :: why 2 $biblionumber ? - return $result->{'biblionumber'}, $result->{'biblionumber'}, - $result->{'title'} - if $result; + if ($result){ + push @results, $result->{'biblionumber'}; + push @results, $result->{'title'}; + } } + return @results; } =head2 SimpleSearch @@ -160,7 +180,7 @@ my @results; for(my $i=0;$i<$hits;$i++) { my %resultsloop; my $marcrecord = MARC::File::USMARC::decode($marcresults->[$i]); - my $biblio = MARCmarc2koha(C4::Context->dbh,$marcrecord,''); + my $biblio = TransformMarcToKoha(C4::Context->dbh,$marcrecord,''); #build the hash for the template. $resultsloop{highlight} = ($i % 2)?(1):(0); @@ -179,48 +199,53 @@ $template->param(result=>\@results); sub SimpleSearch { my $query = shift; - my @servers = @_; - my @results; - my @tmpresults; - my @zconns; - return ( "No query entered", undef ) unless $query; - - #@servers = (C4::Context->config("biblioserver")) unless @servers; - @servers = - ("biblioserver") unless @servers - ; # FIXME hardcoded value. See catalog/search.pl & opac-search.pl too. - - # Connect & Search - for ( my $i = 0 ; $i < @servers ; $i++ ) { - $zconns[$i] = C4::Context->Zconn( $servers[$i], 1 ); - $tmpresults[$i] = - $zconns[$i] - ->search( new ZOOM::Query::CCL2RPN( $query, $zconns[$i] ) ); - - # getting error message if one occured. - my $error = - $zconns[$i]->errmsg() . " (" - . $zconns[$i]->errcode() . ") " - . $zconns[$i]->addinfo() . " " - . $zconns[$i]->diagset(); - - return ( $error, undef ) if $zconns[$i]->errcode(); - } - my $hits; - my $ev; - while ( ( my $i = ZOOM::event( \@zconns ) ) != 0 ) { - $ev = $zconns[ $i - 1 ]->last_event(); - if ( $ev == ZOOM::Event::ZEND ) { - $hits = $tmpresults[ $i - 1 ]->size(); + if (C4::Context->preference('NoZebra')) { + my $result = NZorder(NZanalyse($query))->{'biblioserver'}->{'RECORDS'}; + return (undef,$result); + } else { + my @servers = @_; + my @results; + my @tmpresults; + my @zconns; + return ( "No query entered", undef ) unless $query; + + #@servers = (C4::Context->config("biblioserver")) unless @servers; + @servers = + ("biblioserver") unless @servers + ; # FIXME hardcoded value. See catalog/search.pl & opac-search.pl too. + + # Connect & Search + for ( my $i = 0 ; $i < @servers ; $i++ ) { + $zconns[$i] = C4::Context->Zconn( $servers[$i], 1 ); + $tmpresults[$i] = + $zconns[$i] + ->search( new ZOOM::Query::CCL2RPN( $query, $zconns[$i] ) ); + + # getting error message if one occured. + my $error = + $zconns[$i]->errmsg() . " (" + . $zconns[$i]->errcode() . ") " + . $zconns[$i]->addinfo() . " " + . $zconns[$i]->diagset(); + + return ( $error, undef ) if $zconns[$i]->errcode(); } - if ( $hits > 0 ) { - for ( my $j = 0 ; $j < $hits ; $j++ ) { - my $record = $tmpresults[ $i - 1 ]->record($j)->raw(); - push @results, $record; + my $hits; + my $ev; + while ( ( my $i = ZOOM::event( \@zconns ) ) != 0 ) { + $ev = $zconns[ $i - 1 ]->last_event(); + if ( $ev == ZOOM::Event::ZEND ) { + $hits = $tmpresults[ $i - 1 ]->size(); + } + if ( $hits > 0 ) { + for ( my $j = 0 ; $j < $hits ; $j++ ) { + my $record = $tmpresults[ $i - 1 ]->record($j)->raw(); + push @results, $record; + } } } + return ( undef, \@results ); } - return ( undef, \@results ); } # performs the search @@ -231,7 +256,7 @@ sub getRecords { $expanded_facet, $branches, $query_type, $scan ) = @_; - +# warn "Query : $koha_query"; my @servers = @$servers_ref; my @sort_by = @$sort_by_ref; @@ -261,7 +286,6 @@ sub getRecords { $query_to_use = $federated_query; } - # warn "HERE : $query_type => $query_to_use"; # check if we've got a query_type defined eval { if ($query_type) @@ -311,15 +335,54 @@ sub getRecords { } }; if ($@) { - warn "prob with query toto $query_to_use " . $@; + warn "WARNING: query problem with $query_to_use " . $@; } # concatenate the sort_by limits and pass them to the results object my $sort_by; foreach my $sort (@sort_by) { - $sort_by .= $sort . " "; # used to be $sort, + if ($sort eq "author_az") { + $sort_by.="1=1003 sort( "yaz", $sort_by ) if $sort_by; + if ($sort_by) { + if ( $results[$i]->sort( "yaz", $sort_by ) < 0) { + warn "WARNING sort $sort_by failed"; + } + } } while ( ( my $i = ZOOM::event( \@zconns ) ) != 0 ) { my $ev = $zconns[ $i - 1 ]->last_event(); @@ -492,9 +555,156 @@ sub getRecords { return ( undef, $results_hashref, \@facets_loop ); } +sub _remove_stopwords { + my ($operand,$index) = @_; + # if the index contains more than one qualifier, but not phrase: + if (index($index,"phr")<0 && index($index,",")>0){ + # operand may be a wordlist deleting stopwords + # remove stopwords from operand : parse all stopwords & remove them (case insensitive) + # we use IsAlpha unicode definition, to deal correctly with diacritics. + # otherwise, a french word like "leçon" is splitted in "le" "çon", le is an empty word, we get "çon" + # and don't find anything... + foreach (keys %{C4::Context->stopwords}) { + $operand=~ s/\P{IsAlpha}$_\P{IsAlpha}/ /i; + $operand=~ s/^$_\P{IsAlpha}/ /i; + $operand=~ s/\P{IsAlpha}$_$/ /i; + + } + } + return $operand; +} + +sub _add_truncation { + my ($operand,$index) = @_; + my (@nontruncated,@righttruncated,@lefttruncated,@rightlefttruncated,@regexpr); + # if the index contains more than one qualifier, but not phrase, add truncation qualifiers + #if (index($index,"phr")<0 && index($index,",")>0){ + # warn "ADDING TRUNCATION QUALIFIERS"; + $operand =~ s/ //g; + my @wordlist= split (/\s/,$operand); + foreach my $word (@wordlist){ + #warn "WORD: $word"; + if (index($word,"*")==0 && index($word,"*",1)==length($word)-2){ + $word=~s/\*//; + push @rightlefttruncated,$word; + } + elsif(index($word,"*")==0 && index($word,"*",1)<0){ + $word=~s/\*//; + push @lefttruncated,$word; + + } + elsif (index($word,"*")==length($word)-1){ + $word=~s/\*//; + push @righttruncated,$word; + } + elsif (index($word,"*")<0){ + push @nontruncated,$word; + } + else { + push @regexpr,$word; + + } + } + #} + return (\@nontruncated,\@righttruncated,\@lefttruncated,\@rightlefttruncated,\@regexpr); +} + +sub _build_stemmed_operand { + my ($operand) = @_; + my $stemmed_operand; + #$operand =~ s/^(and |or |not )//i; + # STEMMING FIXME: may need to refine the field weighting so stemmed operands don't + # disrupt the query ranking, this needs more testing + # FIXME: the locale should be set based on the user's language and/or search choice + my $stemmer = Lingua::Stem->new( -locale => 'EN-US' ); + # FIXME: these should be stored in the db so the librarian can modify the behavior + $stemmer->add_exceptions( + { + 'and' => 'and', + 'or' => 'or', + 'not' => 'not', + } + + ); + my @words = split( / /, $operand ); + my $stems = $stemmer->stem(@words); + foreach my $stem (@$stems) { + $stemmed_operand .= "$stem"; + $stemmed_operand .= "?" unless ( $stem =~ /(and$|or$|not$)/ ) || ( length($stem) < 3 ); + $stemmed_operand .= " "; + } + #warn "STEMMED OPERAND: $stemmed_operand"; + return $stemmed_operand; +} + +sub _build_weighted_query { + # FIELD WEIGHTING - This is largely experimental stuff. What I'm committing works + # pretty well but will work much better when we have an actual query parser + my ($operand,$stemmed_operand,$index) = @_; + my $stemming = C4::Context->preference("QueryStemming") || 0; + my $weight_fields = C4::Context->preference("QueryWeightFields") || 0; + my $fuzzy_enabled = C4::Context->preference("QueryFuzzy") || 0; + + my $weighted_query .= " (rk=("; # Specifies that we're applying rank + # keyword has different weight properties + if ( ( $index =~ /kw/ ) || ( !$index ) ) { + # a simple way to find out if this query uses an index + if ( $operand =~ /(\=|\:)/ ) { + $weighted_query .= " $operand"; + } + else { + $weighted_query .=" Title-cover,ext,r1=\"$operand\""; # title cover as exact + $weighted_query .=" or ti,ext,r2=\"$operand\""; # exact title elsewhere + $weighted_query .= " or ti,phr,r3=\"$operand\""; # index as phrase + #$weighted_query .= " or any,ext,r4=$operand"; # index as exact + #$weighted_query .=" or kw,wrdl,r5=\"$operand\""; # all the words in the query (wordlist) + $weighted_query .= " or wrd,fuzzy,r8=\"$operand\"" if $fuzzy_enabled; # add fuzzy + $weighted_query .= " or wrd,right-Truncation,r9=\"$stemmed_operand\"" if ($stemming and $stemmed_operand); # add stemming + # embedded sorting: 0 a-z; 1 z-a + #$weighted_query .= ") or (sort1,aut=1"; + } + + } + #TODO: build better cases based on specific search indexes + #elsif ( $index =~ /au/ ) { + # $weighted_query .=" $index,ext,r1=$operand"; # index label as exact + # #$weighted_query .= " or (title-sort-az=0 or $index,startswithnt,st-word,r3=$operand #)"; + # $weighted_query .=" or $index,phr,r3=$operand"; # index as phrase + # $weighted_query .= " or $index,rt,wrd,r3=$operand"; + #} + #elsif ( $index =~ /ti/ ) { + # $weighted_query .=" Title-cover,ext,r1=$operand"; # index label as exact + # $weighted_query .= " or Title-series,ext,r2=$operand"; + # #$weighted_query .= " or ti,ext,r2=$operand"; + # #$weighted_query .= " or ti,phr,r3=$operand"; + # #$weighted_query .= " or ti,wrd,r3=$operand"; + # $weighted_query .=" or (title-sort-az=0 or Title-cover,startswithnt,st-word,r3=$operand #)"; + # $weighted_query .=" or (title-sort-az=0 or Title-cover,phr,r6=$operand)"; + #$weighted_query .= " or Title-cover,wrd,r5=$operand"; + #$weighted_query .= " or ti,ext,r6=$operand"; + #$weighted_query .= " or ti,startswith,phr,r7=$operand"; + #$weighted_query .= " or ti,phr,r8=$operand"; + #$weighted_query .= " or ti,wrd,r9=$operand"; + #$weighted_query .= " or ti,ext,r2=$operand"; # index as exact + #$weighted_query .= " or ti,phr,r3=$operand"; # index as phrase + #$weighted_query .= " or any,ext,r4=$operand"; # index as exact + #$weighted_query .= " or kw,wrd,r5=$operand"; # index as exact + #} + else { + $weighted_query .=" $index,ext,r1=$operand"; # index label as exact + #$weighted_query .= " or $index,ext,r2=$operand"; # index as exact + $weighted_query .=" or $index,phr,r3=$operand"; # index as phrase + $weighted_query .= " or $index,rt,wrd,r3=$operand"; + $weighted_query .=" or $index,wrd,r5=$operand"; # index as word right-truncated + $weighted_query .= " or $index,wrd,fuzzy,r8=$operand" if $fuzzy_enabled; + } + $weighted_query .= "))"; # close rank specification + return $weighted_query; +} + # build the query itself sub buildQuery { - my ( $query, $operators, $operands, $indexes, $limits, $sort_by ) = @_; + my ( $operators, $operands, $indexes, $limits, $sort_by ) = @_; my @operators = @$operators if $operators; my @indexes = @$indexes if $indexes; @@ -502,25 +712,19 @@ sub buildQuery { my @limits = @$limits if $limits; my @sort_by = @$sort_by if $sort_by; + my $stemming = C4::Context->preference("QueryStemming") || 0; + my $weight_fields = C4::Context->preference("QueryWeightFields") || 0; + my $fuzzy_enabled = C4::Context->preference("QueryFuzzy") || 0; + my $human_search_desc; # a human-readable query my $machine_search_desc; #a machine-readable query - # FIXME: the locale should be set based on the syspref - my $stemmer = Lingua::Stem->new( -locale => 'EN-US' ); - -# FIXME: these should be stored in the db so the librarian can modify the behavior - $stemmer->add_exceptions( - { - 'and' => 'and', - 'or' => 'or', - 'not' => 'not', - } - ); - + #warn "OPERATORS: >@operators< INDEXES: >@indexes< OPERANDS: >@operands< LIMITS: >@limits< SORTS: >@sort_by<"; + my $query = $operands[0]; # STEP I: determine if this is a form-based / simple query or if it's complex (if complex, # we can't handle field weighting, stemming until a formal query parser is written -# I'll work on this soon -- JF -#if (!$query) { # form-based -# check if this is a known query language query, if it is, return immediately: + +# check if this is a known query language query, if it is, return immediately, +# the user is responsible for constructing valid syntax: if ( $query =~ /^ccl=/ ) { return ( undef, $', $', $', 'ccl' ); } @@ -530,151 +734,83 @@ sub buildQuery { if ( $query =~ /^pqf=/ ) { return ( undef, $', $', $', 'pqf' ); } - if ( $query =~ /(\(|\))/ ) { # sorry, too complex + if ( $query =~ /(\(|\))/ ) { # sorry, too complex, assume CCL return ( undef, $query, $query, $query, 'ccl' ); } -# form-based queries are limited to non-nested a specific depth, so we can easily +# form-based queries are limited to non-nested at a specific depth, so we can easily # modify the incoming query operands and indexes to do stemming and field weighting # Once we do so, we'll end up with a value in $query, just like if we had an # incoming $query from the user else { - $query = "" - ; # clear it out so we can populate properly with field-weighted stemmed query - my $previous_operand - ; # a flag used to keep track if there was a previous query - # if there was, we can apply the current operator + $query = ""; # clear it out so we can populate properly with field-weighted stemmed query + my $previous_operand; # a flag used to keep track if there was a previous query + # if there was, we can apply the current operator + # for every operand for ( my $i = 0 ; $i <= @operands ; $i++ ) { - my $operand = $operands[$i]; - my $index = $indexes[$i]; - my $stemmed_operand; - my $stemming = C4::Context->parameters("Stemming") || 0; - my $weight_fields = C4::Context->parameters("WeightFields") || 0; - - if ( $operands[$i] ) { - -# STEMMING FIXME: need to refine the field weighting so stemmed operands don't disrupt the query ranking - if ($stemming) { - my @words = split( / /, $operands[$i] ); - my $stems = $stemmer->stem(@words); - foreach my $stem (@$stems) { - $stemmed_operand .= "$stem"; - $stemmed_operand .= "?" - unless ( $stem =~ /(and$|or$|not$)/ ) - || ( length($stem) < 3 ); - $stemmed_operand .= " "; - - #warn "STEM: $stemmed_operand"; - } - #$operand = $stemmed_operand; - } + # COMBINE OPERANDS, INDEXES AND OPERATORS + if ( $operands[$i] ) { + my $operand = $operands[$i]; + my $index = $indexes[$i]; + # if there's no index, don't use one, it will throw a CCL error + my $index_plus; $index_plus = "$index:" if $index; + my $index_plus_comma; $index_plus_comma="$index_plus," if $index; -# FIELD WEIGHTING - This is largely experimental stuff. What I'm committing works -# pretty well but will work much better when we have an actual query parser - my $weighted_query; - if ($weight_fields) { - $weighted_query .= - " rk=("; # Specifies that we're applying rank - # keyword has different weight properties - if ( ( $index =~ /kw/ ) || ( !$index ) ) - { # FIXME: do I need to add right-truncation in the case of stemming? - # a simple way to find out if this query uses an index - if ( $operand =~ /(\=|\:)/ ) { - $weighted_query .= " $operand"; - } - else { - $weighted_query .= - " Title-cover,ext,r1=\"$operand\"" - ; # index label as exact - $weighted_query .= - " or ti,ext,r2=$operand"; # index as exact - #$weighted_query .= " or ti,phr,r3=$operand"; # index as phrase - #$weighted_query .= " or any,ext,r4=$operand"; # index as exact - $weighted_query .= - " or kw,wrdl,r5=$operand"; # index as exact - $weighted_query .= " or wrd,fuzzy,r9=$operand"; - $weighted_query .= " or wrd=$stemmed_operand" - if $stemming; - } - } - elsif ( $index =~ /au/ ) { - $weighted_query .= - " $index,ext,r1=$operand"; # index label as exact - #$weighted_query .= " or (title-sort-az=0 or $index,startswithnt,st-word,r3=$operand #)"; - $weighted_query .= - " or $index,phr,r3=$operand"; # index as phrase - $weighted_query .= " or $index,rt,wrd,r3=$operand"; - } - elsif ( $index =~ /ti/ ) { - $weighted_query .= - " Title-cover,ext,r1=$operand"; # index label as exact - $weighted_query .= " or Title-series,ext,r2=$operand"; - - #$weighted_query .= " or ti,ext,r2=$operand"; - #$weighted_query .= " or ti,phr,r3=$operand"; - #$weighted_query .= " or ti,wrd,r3=$operand"; - $weighted_query .= -" or (title-sort-az=0 or Title-cover,startswithnt,st-word,r3=$operand #)"; - $weighted_query .= -" or (title-sort-az=0 or Title-cover,phr,r6=$operand)"; - - #$weighted_query .= " or Title-cover,wrd,r5=$operand"; - #$weighted_query .= " or ti,ext,r6=$operand"; - #$weighted_query .= " or ti,startswith,phr,r7=$operand"; - #$weighted_query .= " or ti,phr,r8=$operand"; - #$weighted_query .= " or ti,wrd,r9=$operand"; - - #$weighted_query .= " or ti,ext,r2=$operand"; # index as exact - #$weighted_query .= " or ti,phr,r3=$operand"; # index as phrase - #$weighted_query .= " or any,ext,r4=$operand"; # index as exact - #$weighted_query .= " or kw,wrd,r5=$operand"; # index as exact - } - else { - $weighted_query .= - " $index,ext,r1=$operand"; # index label as exact - #$weighted_query .= " or $index,ext,r2=$operand"; # index as exact - $weighted_query .= - " or $index,phr,r3=$operand"; # index as phrase - $weighted_query .= " or $index,rt,wrd,r3=$operand"; - $weighted_query .= - " or $index,wrd,r5=$operand" - ; # index as word right-truncated - $weighted_query .= " or $index,wrd,fuzzy,r8=$operand"; - } - $weighted_query .= ")"; # close rank specification - $operand = $weighted_query; - } + # Remove Stopwords + $operand = _remove_stopwords($operand,$index); - # only add an operator if there is a previous operand + # Handle Truncation + my ($nontruncated,$righttruncated,$lefttruncated,$rightlefttruncated,$regexpr); + ($nontruncated,$righttruncated,$lefttruncated,$rightlefttruncated,$regexpr) = _add_truncation($operand,$index); + #warn "TRUNCATION: NON:@$nontruncated RIGHT:@$righttruncated LEFT:@$lefttruncated RIGHTLEFT:@$rightlefttruncated REGEX:@$regexpr"; + + # Handle Stemming + my $stemmed_operand; + $stemmed_operand = _build_stemmed_operand($operand) if $stemming; + + # Handle Field Weighting + my $weighted_operand; + $weighted_operand = _build_weighted_query($operand,$stemmed_operand,$index) if $weight_fields; + + # proves we're operating in multi-leaf mode + # $weighted_operand = "$weighted_operand and $weighted_operand"; + $operand = $weighted_operand if $weight_fields; + + # If there's a previous operand, we need to add an operator if ($previous_operand) { if ( $operators[ $i - 1 ] ) { - $query .= " $operators[$i-1] $index: $operand"; - if ( !$index ) { - $human_search_desc .= - " $operators[$i-1] $operands[$i]"; - } - else { - $human_search_desc .= - " $operators[$i-1] $index: $operands[$i]"; - } + $human_search_desc .=" $operators[$i-1] $index_plus $operands[$i]"; + $query .= " $operators[$i-1] $index_plus $operand"; } - # the default operator is and else { - $query .= " and $index: $operand"; - $human_search_desc .= " and $index: $operands[$i]"; + $query .= " and $index_plus $operand"; + $human_search_desc .= " and $index_plus $operands[$i]"; } } - else { - if ( !$index ) { - $query .= " $operand"; - $human_search_desc .= " $operands[$i]"; - } - else { - $query .= " $index: $operand"; - $human_search_desc .= " $index: $operands[$i]"; - } + # There's no previous operand - FIXME: completely ignoring our $query, no field weighting, no stemming + # FIXME: also, doesn't preserve original order + else { + # if there are terms to fit with truncation + if (scalar(@$righttruncated)+scalar(@$lefttruncated)+scalar(@$rightlefttruncated)>0){ + # add the non-truncated ones first + $query.= "$index_plus @$nontruncated " if (scalar(@$nontruncated)>0); + if (scalar(@$righttruncated)>0){ + $query .= "and $index_plus_comma"."rtrn:@$righttruncated "; + } + if (scalar(@$lefttruncated)>0){ + $query .= "and $index_plus_comma"."ltrn:@$lefttruncated "; + } + if (scalar(@$rightlefttruncated)>0){ + $query .= "and $index_plus_comma"."rltrn:@$rightlefttruncated "; + } + $query=~s/^and//; # FIXME: this is cheating :-) + $human_search_desc .= $query; + } else { + $query .= " $index_plus $operand"; + $human_search_desc .= " $index_plus $operands[$i]"; + } $previous_operand = 1; } } #/if $operands @@ -689,9 +825,7 @@ sub buildQuery { # FIXME: not quite right yet ... will work on this soon -- JF my $type = $1 if $limit =~ m/([^:]+):([^:]*)/; if ( $limit =~ /available/ ) { - $limit_query .= -" (($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))"; - + $limit_query .= " (($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))"; #$limit_search_desc.=" and available"; } elsif ( ($limit_query) && ( index( $limit_query, $type, 0 ) > 0 ) ) { @@ -725,8 +859,13 @@ sub buildQuery { # these are treated as AND elsif ($limit_query) { - $limit_query .= " and $limit" if $limit; - $limit_search_desc .= " and $limit" if $limit; + if ($limit =~ /branch/){ + $limit_query .= " ) and ( $limit" if $limit; + $limit_search_desc .= " ) and ( $limit" if $limit; + }else{ + $limit_query .= " or $limit" if $limit; + $limit_search_desc .= " or $limit" if $limit; + } } # otherwise, there is nothing but the limit @@ -742,6 +881,7 @@ sub buildQuery { $limit_search_desc = " and ($limit_search_desc)" if $limit_search_desc; } + #warn "LIMIT: $limit_query"; $query .= $limit_query; $human_search_desc .= $limit_search_desc; @@ -800,13 +940,14 @@ sub searchResults { #find itemtype & itemtype image my %itemtypes; $bsth = - $dbh->prepare("SELECT itemtype,description,imageurl,summary FROM itemtypes"); + $dbh->prepare("SELECT itemtype,description,imageurl,summary,notforloan FROM itemtypes"); $bsth->execute(); while ( my $bdata = $bsth->fetchrow_hashref ) { $itemtypes{ $bdata->{'itemtype'} }->{description} = $bdata->{'description'}; $itemtypes{ $bdata->{'itemtype'} }->{imageurl} = $bdata->{'imageurl'}; $itemtypes{ $bdata->{'itemtype'} }->{summary} = $bdata->{'summary'}; + $itemtypes{ $bdata->{'itemtype'} }->{notforloan} = $bdata->{'notforloan'}; } #search item field code @@ -823,7 +964,7 @@ sub searchResults { my %subfieldstosearch; while ( ( my $column ) = $sth2->fetchrow ) { my ( $tagfield, $tagsubfield ) = - &MARCfind_marc_from_kohafield( $dbh, "items." . $column, "" ); + &GetMarcFromKohaField( "items." . $column, "" ); $subfieldstosearch{$column} = $tagsubfield; } my $times; @@ -838,9 +979,7 @@ sub searchResults { for ( my $i = $offset ; $i <= $times - 1 ; $i++ ) { my $marcrecord; $marcrecord = MARC::File::USMARC::decode( $marcresults[$i] ); - - my $oldbiblio = MARCmarc2koha( $dbh, $marcrecord, '' ); - + my $oldbiblio = TransformMarcToKoha( $dbh, $marcrecord, '' ); # add image url if there is one if ( $itemtypes{ $oldbiblio->{itemtype} }->{imageurl} =~ /^http:/ ) { $oldbiblio->{imageurl} = @@ -880,13 +1019,13 @@ sub searchResults { $summary =~ s/\n/
/g; $oldbiblio->{summary} = $summary; } - # add spans to search term in results + # add spans to search term in results for search term highlighting foreach my $term ( keys %$span_terms_hashref ) { - - #warn "term: $term"; my $old_term = $term; if ( length($term) > 3 ) { - $term =~ s/(.*=|\)|\(|\+|\.|\?)//g; + $term =~ s/(.*=|\)|\(|\+|\.|\?|\[|\])//g; + $term =~ s/\\//g; + $term =~ s/\*//g; #FIXME: is there a better way to do this? $oldbiblio->{'title'} =~ s/$term/$&<\/span>/gi; @@ -916,127 +1055,594 @@ sub searchResults { my $onloan_count = 0; my $wthdrawn_count = 0; my $itemlost_count = 0; - my $itembinding_count = 0; my $norequests = 1; + # + # check the loan status of the item : + # it is not stored in the MARC record, for pref (zebra reindexing) + # reason. Thus, we have to get the status from a specific SQL query + # + my $sth_issue = $dbh->prepare(" + SELECT date_due,returndate + FROM issues + WHERE itemnumber=? AND returndate IS NULL"); + my $items_count=scalar(@fields); foreach my $field (@fields) { my $item; foreach my $code ( keys %subfieldstosearch ) { $item->{$code} = $field->subfield( $subfieldstosearch{$code} ); } + $sth_issue->execute($item->{itemnumber}); + $item->{due_date} = format_date($sth_issue->fetchrow); + $item->{onloan} = 1 if $item->{due_date}; + # at least one item can be reserved : suppose no + $norequests = 1; if ( $item->{wthdrawn} ) { $wthdrawn_count++; - } - elsif ( $item->{notforloan} == -1 ) { - $ordered_count++; - $norequests = 0; + $items->{ $item->{'homebranch'}.'--'.$item->{'itemcallnumber'} }->{unavailable}=1; + $items->{ $item->{'homebranch'}.'--'.$item->{'itemcallnumber'} }->{wthdrawn}=1; } elsif ( $item->{itemlost} ) { $itemlost_count++; + $items->{ $item->{'homebranch'}.'--'.$item->{'itemcallnumber'} }->{unavailable}=1; + $items->{ $item->{'homebranch'}.'--'.$item->{'itemcallnumber'} }->{itemlost}=1; } - elsif ( $item->{binding} ) { - $itembinding_count++; + unless ( $item->{notforloan}) { + # OK, this one can be issued, so at least one can be reserved + $norequests = 0; } - elsif ( ( $item->{onloan} ) && ( $item->{onloan} != '0000-00-00' ) ) + if ( ( $item->{onloan} ) && ( $item->{onloan} != '0000-00-00' ) ) { + $items->{ $item->{'homebranch'}.'--'.$item->{'itemcallnumber'} }->{unavailable}=1; + $items->{ $item->{'homebranch'}.'--'.$item->{'itemcallnumber'} }->{onloancount} = 1; + $items->{ $item->{'homebranch'}.'--'.$item->{'itemcallnumber'} }->{due_date} = $item->{due_date}; $onloan_count++; - $norequests = 0; } - else { - $norequests = 0; - if ( $item->{'homebranch'} ) { - $items->{ $item->{'homebranch'} }->{count}++; - } + if ( $item->{'homebranch'} ) { + $items->{ $item->{'homebranch'}.'--'.$item->{'itemcallnumber'} }->{count}++; + } - # Last resort - elsif ( $item->{'holdingbranch'} ) { - $items->{ $item->{'homebranch'} }->{count}++; - } - $items->{ $item->{homebranch} }->{itemcallnumber} = - $item->{itemcallnumber}; - $items->{ $item->{homebranch} }->{location} = - $item->{location}; + # Last resort + elsif ( $item->{'holdingbranch'} ) { + $items->{ $item->{'holdingbranch'} }->{count}++; } + $items->{ $item->{'homebranch'}.'--'.$item->{'itemcallnumber'} }->{itemcallnumber} = $item->{itemcallnumber}; + $items->{ $item->{'homebranch'}.'--'.$item->{'itemcallnumber'} }->{location} = $item->{location}; + $items->{ $item->{'homebranch'}.'--'.$item->{'itemcallnumber'} }->{branchcode} = $item->{homebranch}; } # notforloan, item level and biblioitem level - for my $key ( keys %$items ) { - #warn "key: $key"; + # last check for norequest : if itemtype is notforloan, it can't be reserved either, whatever the items + $norequests = 1 if $itemtypes{$oldbiblio->{itemtype}}->{notforloan}; + + for my $key ( sort keys %$items ) { my $this_item = { - branchname => $branches{$key}, - branchcode => $key, + branchname => $branches{$items->{$key}->{branchcode}}, + branchcode => $items->{$key}->{branchcode}, count => $items->{$key}->{count}, itemcallnumber => $items->{$key}->{itemcallnumber}, location => $items->{$key}->{location}, + onloancount => $items->{$key}->{onloancount}, + due_date => $items->{$key}->{due_date}, + wthdrawn => $items->{$key}->{wthdrawn}, + lost => $items->{$key}->{itemlost}, }; push @items_loop, $this_item; } $oldbiblio->{norequests} = $norequests; + $oldbiblio->{items_count} = $items_count; $oldbiblio->{items_loop} = \@items_loop; $oldbiblio->{onloancount} = $onloan_count; $oldbiblio->{wthdrawncount} = $wthdrawn_count; $oldbiblio->{itemlostcount} = $itemlost_count; - $oldbiblio->{bindingcount} = $itembinding_count; $oldbiblio->{orderedcount} = $ordered_count; - -# FIXME -# Ugh ... this is ugly, I'll re-write it better above then delete it -# my $norequests = 1; -# my $noitems = 1; -# if (@items) { -# $noitems = 0; -# foreach my $itm (@items) { -# $norequests = 0 unless $itm->{'itemnotforloan'}; -# } -# } -# $oldbiblio->{'noitems'} = $noitems; -# $oldbiblio->{'norequests'} = $norequests; -# $oldbiblio->{'even'} = $even = not $even; -# $oldbiblio->{'itemcount'} = $counts{'total'}; -# my $totalitemcounts = 0; -# foreach my $key (keys %counts){ -# if ($key ne 'total'){ -# $totalitemcounts+= $counts{$key}; -# $oldbiblio->{'locationhash'}->{$key}=$counts{$key}; -# } -# } -# my ($locationtext, $locationtextonly, $notavailabletext) = ('','',''); -# foreach (sort keys %{$oldbiblio->{'locationhash'}}) { -# if ($_ eq 'notavailable') { -# $notavailabletext="Not available"; -# my $c=$oldbiblio->{'locationhash'}->{$_}; -# $oldbiblio->{'not-available-p'}=$c; -# } else { -# $locationtext.="$_"; -# my $c=$oldbiblio->{'locationhash'}->{$_}; -# if ($_ eq 'Item Lost') { -# $oldbiblio->{'lost-p'} = $c; -# } elsif ($_ eq 'Withdrawn') { -# $oldbiblio->{'withdrawn-p'} = $c; -# } elsif ($_ eq 'On Loan') { -# $oldbiblio->{'on-loan-p'} = $c; -# } else { -# $locationtextonly.= $_; -# $locationtextonly.= " ($c)
" if $totalitemcounts > 1; -# } -# if ($totalitemcounts>1) { -# $locationtext.=" ($c)
"; -# } -# } -# } -# if ($notavailabletext) { -# $locationtext.= $notavailabletext; -# } else { -# $locationtext=~s/, $//; -# } -# $oldbiblio->{'location'} = $locationtext; -# $oldbiblio->{'location-only'} = $locationtextonly; -# $oldbiblio->{'use-location-flags-p'} = 1; - + $oldbiblio->{isbn} =~ s/-//g; # deleting - in isbn to enable amazon content push( @newresults, $oldbiblio ); } return @newresults; } + + +#---------------------------------------------------------------------- +# +# Non-Zebra GetRecords# +#---------------------------------------------------------------------- + +=head2 NZgetRecords + + NZgetRecords has the same API as zera getRecords, even if some parameters are not managed + +=cut + +sub NZgetRecords { + my ( + $koha_query, $federated_query, $sort_by_ref, + $servers_ref, $results_per_page, $offset, + $expanded_facet, $branches, $query_type, + $scan + ) = @_; + my $result = NZanalyse($koha_query); + return (undef,NZorder($result,@$sort_by_ref[0],$results_per_page,$offset),undef); +} + +=head2 NZanalyse + + NZanalyse : get a CQL string as parameter, and returns a list of biblionumber;title,biblionumber;title,... + the list is builded from inverted index in nozebra SQL table + note that title is here only for convenience : the sorting will be very fast when requested on title + if the sorting is requested on something else, we will have to reread all results, and that may be longer. + +=cut + +sub NZanalyse { + my ($string,$server) = @_; + # $server contains biblioserver or authorities, depending on what we search on. + #warn "querying : $string on $server"; + $server='biblioserver' unless $server; + # if we have a ", replace the content to discard temporarily any and/or/not inside + my $commacontent; + if ($string =~/"/) { + $string =~ s/"(.*?)"/__X__/; + $commacontent = $1; +# print "commacontent : $commacontent\n"; + } + # split the query string in 3 parts : X AND Y means : $left="X", $operand="AND" and $right="Y" + # then, call again NZanalyse with $left and $right + # (recursive until we find a leaf (=> something without and/or/not) + $string =~ /(.*)( and | or | not | AND | OR | NOT )(.*)/; + my $left = $1; + my $right = $3; + my $operand = lc($2); + # it's not a leaf, we have a and/or/not + if ($operand) { + # reintroduce comma content if needed + $right =~ s/__X__/"$commacontent"/ if $commacontent; + $left =~ s/__X__/"$commacontent"/ if $commacontent; +# warn "node : $left / $operand / $right\n"; + my $leftresult = NZanalyse($left,$server); + my $rightresult = NZanalyse($right,$server); + # OK, we have the results for right and left part of the query + # depending of operand, intersect, union or exclude both lists + # to get a result list + if ($operand eq ' and ') { + my @leftresult = split /;/, $leftresult; +# my @rightresult = split /;/,$leftresult; + my $finalresult; + # parse the left results, and if the biblionumber exist in the right result, save it in finalresult + # the result is stored twice, to have the same weight for AND than OR. + # example : TWO : 61,61,64,121 (two is twice in the biblio #61) / TOWER : 61,64,130 + # result : 61,61,61,61,64,64 for two AND tower : 61 has more weight than 64 + foreach (@leftresult) { + if ($rightresult =~ "$_;") { + $finalresult .= "$_;$_;"; + } + } + return $finalresult; + } elsif ($operand eq ' or ') { + # just merge the 2 strings + return $leftresult.$rightresult; + } elsif ($operand eq ' not ') { + my @leftresult = split /;/, $leftresult; +# my @rightresult = split /;/,$leftresult; + my $finalresult; + foreach (@leftresult) { + unless ($rightresult =~ "$_;") { + $finalresult .= "$_;"; + } + } + return $finalresult; + } else { + # this error is impossible, because of the regexp that isolate the operand, but just in case... + die "error : operand unknown : $operand for $string"; + } + # it's a leaf, do the real SQL query and return the result + } else { + $string =~ s/__X__/"$commacontent"/ if $commacontent; + $string =~ s/-|\.|\?|,|;|!|'|\(|\)|\[|\]|{|}|"|<|>|&|\+|\*|\// /g; +# warn "leaf : $string\n"; + # parse the string in in operator/operand/value again + $string =~ /(.*)(=|>|>=|<|<=)(.*)/; + my $left = $1; + my $operator = $2; + my $right = $3; + my $results; + # automatic replace for short operators + $left='title' if $left eq 'ti'; + $left='author' if $left eq 'au'; + $left='publisher' if $left eq 'pb'; + $left='subject' if $left eq 'su'; + $left='koha-Auth-Number' if $left eq 'an'; + $left='keyword' if $left eq 'kw'; + if ($operator) { + #do a specific search + my $dbh = C4::Context->dbh; + $operator='LIKE' if $operator eq '=' and $right=~ /%/; + my $sth = $dbh->prepare("SELECT biblionumbers FROM nozebra WHERE server=? AND indexname=? AND value $operator ?"); + # warn "$left / $operator / $right\n"; + # split each word, query the DB and build the biblionumbers result + foreach (split / /,$right) { + my $biblionumbers; + next unless $_; +# warn "EXECUTE : $server, $left, $_"; + $sth->execute($server, $left, $_); + while (my $line = $sth->fetchrow) { + $biblionumbers .= $line; +# warn "result : $line"; + } + # do a AND with existing list if there is one, otherwise, use the biblionumbers list as 1st result list + if ($results) { + my @leftresult = split /;/, $biblionumbers; + my $temp; + foreach (@leftresult) { + if ($results =~ "$_;") { + $temp .= "$_;$_;"; + } + } + $results = $temp; + } else { + $results = $biblionumbers; + } + } + } else { + #do a complete search (all indexes) + my $dbh = C4::Context->dbh; + my $sth = $dbh->prepare("SELECT biblionumbers FROM nozebra WHERE server=? AND value LIKE ?"); + # split each word, query the DB and build the biblionumbers result + foreach (split / /,$string) { + next if C4::Context->stopwords->{uc($_)}; # skip if stopword + #warn "search on all indexes on $_"; + my $biblionumbers; + next unless $_; + $sth->execute($server, $_); + while (my $line = $sth->fetchrow) { + $biblionumbers .= $line; + } + # do a AND with existing list if there is one, otherwise, use the biblionumbers list as 1st result list + if ($results) { + my @leftresult = split /;/, $biblionumbers; + my $temp; + foreach (@leftresult) { + if ($results =~ "$_;") { + $temp .= "$_;$_;"; + } + } + $results = $temp; + } else { + $results = $biblionumbers; + } + } + } +# warn "return : $results for LEAF : $string"; + return $results; + } +} + +=head2 NZorder + + $finalresult = NZorder($biblionumbers, $ordering,$results_per_page,$offset); + + TODO :: Description + +=cut + + +sub NZorder { + my ($biblionumbers, $ordering,$results_per_page,$offset) = @_; + # order title asc by default +# $ordering = '1=36 dbh; + # + # order by POPULARITY + # + if ($ordering =~ /1=9523/) { + my %result; + my %popularity; + # popularity is not in MARC record, it's builded from a specific query + my $sth = $dbh->prepare("select sum(issues) from items where biblionumber=?"); + foreach (split /;/,$biblionumbers) { + my ($biblionumber,$title) = split /,/,$_; + $result{$biblionumber}=GetMarcBiblio($biblionumber); + $sth->execute($biblionumber); + my $popularity= $sth->fetchrow ||0; + # hint : the key is popularity.title because we can have + # many results with the same popularity. In this cas, sub-ordering is done by title + # we also have biblionumber to avoid bug for 2 biblios with the same title & popularity + # (un-frequent, I agree, but we won't forget anything that way ;-) + $popularity{sprintf("%10d",$popularity).$title.$biblionumber} = $biblionumber; + } + # sort the hash and return the same structure as GetRecords (Zebra querying) + my $result_hash; + my $numbers=0; + if ($ordering eq '1=9523 >i') { # sort popularity DESC + foreach my $key (sort {$b cmp $a} (keys %popularity)) { + $result_hash->{'RECORDS'}[$numbers++] = $result{$popularity{$key}}->as_usmarc(); + } + } else { # sort popularity ASC + foreach my $key (sort (keys %popularity)) { + $result_hash->{'RECORDS'}[$numbers++] = $result{$popularity{$key}}->as_usmarc(); + } + } + my $finalresult=(); + $result_hash->{'hits'} = $numbers; + $finalresult->{'biblioserver'} = $result_hash; + return $finalresult; + # + # ORDER BY author + # + } elsif ($ordering eq '1=1003 preference('marcflavour') eq 'UNIMARC') { + $author=$record->subfield('200','f'); + $author=$record->subfield('700','a') unless $author; + } else { + $author=$record->subfield('100','a'); + } + # hint : the result is sorted by title.biblionumber because we can have X biblios with the same title + # and we don't want to get only 1 result for each of them !!! + $result{$author.$biblionumber}=$record; + } + # sort the hash and return the same structure as GetRecords (Zebra querying) + my $result_hash; + my $numbers=0; + if ($ordering eq '1=1003 {'RECORDS'}[$numbers++] = $result{$key}->as_usmarc(); + } + } else { # sort by author ASC + foreach my $key (sort { $a cmp $b } (keys %result)) { + $result_hash->{'RECORDS'}[$numbers++] = $result{$key}->as_usmarc(); + } + } + my $finalresult=(); + $result_hash->{'hits'} = $numbers; + $finalresult->{'biblioserver'} = $result_hash; + return $finalresult; + # + # ORDER BY callnumber + # + } elsif ($ordering eq '1=20 preference('marcflavour') eq 'UNIMARC') { + $callnumber=$record->subfield('200','f'); + } else { + $callnumber=$record->subfield('100','a'); + } + # hint : the result is sorted by title.biblionumber because we can have X biblios with the same title + # and we don't want to get only 1 result for each of them !!! + $result{$callnumber.$biblionumber}=$record; + } + # sort the hash and return the same structure as GetRecords (Zebra querying) + my $result_hash; + my $numbers=0; + if ($ordering eq '1=1003 {'RECORDS'}[$numbers++] = $result{$key}->as_usmarc(); + } + } else { # sort by title ASC + foreach my $key (sort { $a cmp $b } (keys %result)) { + $result_hash->{'RECORDS'}[$numbers++] = $result{$key}->as_usmarc(); + } + } + my $finalresult=(); + $result_hash->{'hits'} = $numbers; + $finalresult->{'biblioserver'} = $result_hash; + return $finalresult; + } elsif ($ordering =~ /1=31/){ #pub year + my %result; + foreach (split /;/,$biblionumbers) { + my ($biblionumber,$title) = split /,/,$_; + my $record=GetMarcBiblio($biblionumber); + my ($publicationyear_tag,$publicationyear_subfield)=GetMarcFromKohaField($dbh,'biblioitems.publicationyear'); + my $publicationyear=$record->subfield($publicationyear_tag,$publicationyear_subfield); + # hint : the result is sorted by title.biblionumber because we can have X biblios with the same title + # and we don't want to get only 1 result for each of them !!! + $result{$publicationyear.$biblionumber}=$record; + } + # sort the hash and return the same structure as GetRecords (Zebra querying) + my $result_hash; + my $numbers=0; + if ($ordering eq '1=31 {'RECORDS'}[$numbers++] = $result{$key}->as_usmarc(); + } + } else { # sort by pub year ASC + foreach my $key (sort { $b cmp $a } (keys %result)) { + $result_hash->{'RECORDS'}[$numbers++] = $result{$key}->as_usmarc(); + } + } + my $finalresult=(); + $result_hash->{'hits'} = $numbers; + $finalresult->{'biblioserver'} = $result_hash; + return $finalresult; + # + # ORDER BY title + # + } elsif ($ordering =~ /1=4/) { + # the title is in the biblionumbers string, so we just need to build a hash, sort it and return + my %result; + foreach (split /;/,$biblionumbers) { + my ($biblionumber,$title) = split /,/,$_; + # hint : the result is sorted by title.biblionumber because we can have X biblios with the same title + # and we don't want to get only 1 result for each of them !!! + # hint & speed improvement : we can order without reading the record + # so order, and read records only for the requested page ! + $result{$title.$biblionumber}=$biblionumber; + } + # sort the hash and return the same structure as GetRecords (Zebra querying) + my $result_hash; + my $numbers=0; + if ($ordering eq '1=4 {'RECORDS'}[$numbers++] = $result{$key}; + } + } else { # sort by title ASC + foreach my $key (sort { $b cmp $a } (keys %result)) { + $result_hash->{'RECORDS'}[$numbers++] = $result{$key}; + } + } + # limit the $results_per_page to result size if it's more + $results_per_page = $numbers-1 if $numbers < $results_per_page; + # for the requested page, replace biblionumber by the complete record + # speed improvement : avoid reading too much things + for (my $counter=$offset;$counter<=$offset+$results_per_page;$counter++) { + $result_hash->{'RECORDS'}[$counter] = GetMarcBiblio($result_hash->{'RECORDS'}[$counter])->as_usmarc; + } + my $finalresult=(); + $result_hash->{'hits'} = $numbers; + $finalresult->{'biblioserver'} = $result_hash; + return $finalresult; + } else { + # + # order by ranking + # + # we need 2 hashes to order by ranking : the 1st one to count the ranking, the 2nd to order by ranking + my %result; + my %count_ranking; + foreach (split /;/,$biblionumbers) { + my ($biblionumber,$title) = split /,/,$_; + $title =~ /(.*)-(\d)/; + # get weight + my $ranking =$2; + # note that we + the ranking because ranking is calculated on weight of EACH term requested. + # if we ask for "two towers", and "two" has weight 2 in biblio N, and "towers" has weight 4 in biblio N + # biblio N has ranking = 6 + $count_ranking{$biblionumber} += $ranking; + } + # build the result by "inverting" the count_ranking hash + # 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 +# warn "counting"; + foreach (keys %count_ranking) { + $result{sprintf("%10d",$count_ranking{$_}).'-'.$_} = $_; + } + # sort the hash and return the same structure as GetRecords (Zebra querying) + my $result_hash; + my $numbers=0; + foreach my $key (sort {$b cmp $a} (keys %result)) { + $result_hash->{'RECORDS'}[$numbers++] = $result{$key}; + } + # limit the $results_per_page to result size if it's more + $results_per_page = $numbers-1 if $numbers < $results_per_page; + # for the requested page, replace biblionumber by the complete record + # speed improvement : avoid reading too much things + for (my $counter=$offset;$counter<=$offset+$results_per_page;$counter++) { + $result_hash->{'RECORDS'}[$counter] = GetMarcBiblio($result_hash->{'RECORDS'}[$counter])->as_usmarc; + } + my $finalresult=(); + $result_hash->{'hits'} = $numbers; + $finalresult->{'biblioserver'} = $result_hash; + return $finalresult; + } +} +=head2 ModBiblios + +($countchanged,$listunchanged) = ModBiblios($listbiblios, $tagsubfield,$initvalue,$targetvalue,$test); + +this function changes all the values $initvalue in subfield $tag$subfield in any record in $listbiblios +test parameter if set donot perform change to records in database. + +=over 2 + +=item C + + * $listbiblios is an array ref to marcrecords to be changed + * $tagsubfield is the reference of the subfield to change. + * $initvalue is the value to search the record for + * $targetvalue is the value to set the subfield to + * $test is to be set only not to perform changes in database. + +=item C + * $countchanged counts all the changes performed. + * $listunchanged contains the list of all the biblionumbers of records unchanged. + +=item C + +=back + +my ($countchanged, $listunchanged) = EditBiblios($results->{RECORD}, $tagsubfield,$initvalue,$targetvalue);; +#If one wants to display unchanged records, you should get biblios foreach @$listunchanged +$template->param(countchanged => $countchanged, loopunchanged=>$listunchanged); + +=cut + +sub ModBiblios{ + my ($listbiblios,$tagsubfield,$initvalue,$targetvalue,$test)=@_; + my $countmatched; + my @unmatched; + my ($tag,$subfield)=($1,$2) if ($tagsubfield=~/^(\d{1,3})([a-z0-9A-Z@])?$/); + if ((length($tag)<3)&& $subfield=~/0-9/){ + $tag=$tag.$subfield; + undef $subfield; + } + my ($bntag,$bnsubf) = GetMarcFromKohaField('biblio.biblionumber'); + my ($itemtag,$itemsubf) = GetMarcFromKohaField('items.itemnumber'); + foreach my $usmarc (@$listbiblios){ + my $record; + $record=eval{MARC::Record->new_from_usmarc($usmarc)}; + my $biblionumber; + if ($@){ + # usmarc is not a valid usmarc May be a biblionumber + if ($tag eq $itemtag){ + my $bib=GetBiblioFromItemNumber($usmarc); + $record=GetMarcItem($bib->{'biblionumber'},$usmarc) ; + $biblionumber=$bib->{'biblionumber'}; + } else { + $record=GetMarcBiblio($usmarc); + $biblionumber=$usmarc; + } + } else { + if ($bntag >= 010){ + $biblionumber = $record->subfield($bntag,$bnsubf); + }else { + $biblionumber=$record->field($bntag)->data; + } + } + #GetBiblionumber is to be written. + #Could be replaced by TransformMarcToKoha (But Would be longer) + if ($record->field($tag)){ + my $modify=0; + foreach my $field ($record->field($tag)){ + if ($subfield){ + if ($field->delete_subfield('code' =>$subfield,'match'=>qr($initvalue))){ + $countmatched++; + $modify=1; + $field->update($subfield,$targetvalue) if ($targetvalue); + } + } else { + if ($tag >= 010){ + if ($field->delete_field($field)){ + $countmatched++; + $modify=1; + } + } else { + $field->data=$targetvalue if ($field->data=~qr($initvalue)); + } + } + } +# warn $record->as_formatted; + if ($modify){ + ModBiblio($record,$biblionumber,GetFrameworkCode($biblionumber)) unless ($test); + } else { + push @unmatched, $biblionumber; + } + } else { + push @unmatched, $biblionumber; + } + } + return ($countmatched,\@unmatched); +} + END { } # module clean-up code here (global destructor) 1;