Koha-community/Koha
13
7
Fork 0
Code Issues Releases Wiki Activity

NZSearch debugging

Browse source 
Adding NZoperatorAND NZoperatorOR NZoperatorNOT
Using NZOperatorAND NOT in NZanalyse
Some problem solved.

Please test.

Signed-off-by: Chris Cormack <crc@liblime.com>
Signed-off-by: Joshua Ferraro <jmf@liblime.com>
This commit is contained in:
Henri-Damien LAURENT 2008-01-02 13:01:58 -06:00 committed by Joshua Ferraro
parent 3c0b7eee62
commit ee252ad5af
1 changed files with 76 additions and 112 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

188
C4/Search.pm
View file

@ -28,7 +28,7 @@ use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $DEBUG);
# set the version for version checking # set the version for version checking
BEGIN { BEGIN {
$VERSION = 3.01; $VERSION = 3.01;
$DEBUG = ( $ENV{DEBUG} ) ? 1 : 0; $DEBUG = ($ENV{DEBUG}) ? 1 : 0;
} }
=head1 NAME =head1 NAME
@ -1487,9 +1487,9 @@ sub NZgetRecords {
sub NZanalyse { sub NZanalyse {
my ( $string, $server ) = @_; my ( $string, $server ) = @_;
warn "---------" if $DEBUG; # warn "---------" if $DEBUG;
warn "Enter NZanalyse" if $DEBUG; warn " NZanalyse" if $DEBUG;
warn "---------" if $DEBUG; # warn "---------" if $DEBUG;
# $server contains biblioserver or authorities, depending on what we search on. # $server contains biblioserver or authorities, depending on what we search on.
#warn "querying : $string on $server"; #warn "querying : $string on $server";
@ -1526,29 +1526,7 @@ sub NZanalyse {
# depending of operand, intersect, union or exclude both lists # depending of operand, intersect, union or exclude both lists
# to get a result list # to get a result list
if ( $operator eq ' and ' ) { if ( $operator eq ' and ' ) {
my @leftresult = split /;/, $leftresult; return NZoperatorAND($leftresult,$rightresult);
warn " @leftresult / $rightresult \n" if $DEBUG;
# 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) {
my $value = $_;
my $countvalue;
( $value, $countvalue ) = ( $1, $2 )
if $value =~ m/(.*)-(\d+)$/;
if ( $rightresult =~ /$value-(\d+);/ ) {
$countvalue = ( $1 > $countvalue ? $countvalue : $1 );
$finalresult .=
"$value-$countvalue;$value-$countvalue;";
}
}
warn " $finalresult \n" if $DEBUG;
return $finalresult;
} }
elsif ( $operator eq ' or ' ) { elsif ( $operator eq ' or ' ) {
@ -1556,32 +1534,20 @@ sub NZanalyse {
return $leftresult . $rightresult; return $leftresult . $rightresult;
} }
elsif ( $operator eq ' not ' ) { elsif ( $operator eq ' not ' ) {
my @leftresult = split /;/, $leftresult; return NZoperatorNOT($leftresult,$rightresult);
# my @rightresult = split /;/,$leftresult;
my $finalresult;
foreach (@leftresult) {
my $value = $_;
$value = $1 if $value =~ m/(.*)-\d+$/;
unless ( $rightresult =~ "$value-" ) {
}
}
return $finalresult;
} }
else { }
else {
# this error is impossible, because of the regexp that isolate the operand, but just in case... # this error is impossible, because of the regexp that isolate the operand, but just in case...
return $leftresult; return $leftresult;
exit; }
}
}
} }
warn "string :" . $string if $DEBUG; warn "string :" . $string if $DEBUG;
$string =~ /(.*?)( and | or | not | AND | OR | NOT )(.*)/; $string =~ /(.*?)( and | or | not | AND | OR | NOT )(.*)/;
my $left = $1; my $left = $1;
my $right = $3; my $right = $3;
my $operator = lc($2); # FIXME: and/or/not are operators, not operands my $operator = lc($2); # FIXME: and/or/not are operators, not operands
warn "dealing w/parenthesis. left :$left operator:$operator right:$right" warn "no parenthesis. left : $left operator: $operator right: $right"
if $DEBUG; if $DEBUG;
# it's not a leaf, we have a and/or/not # it's not a leaf, we have a and/or/not
@ -1593,26 +1559,14 @@ sub NZanalyse {
warn "node : $left / $operator / $right\n" if $DEBUG; warn "node : $left / $operator / $right\n" if $DEBUG;
my $leftresult = NZanalyse( $left, $server ); my $leftresult = NZanalyse( $left, $server );
my $rightresult = NZanalyse( $right, $server ); my $rightresult = NZanalyse( $right, $server );
warn " leftresult : $leftresult" if $DEBUG;
warn " rightresult : $rightresult" if $DEBUG;
# OK, we have the results for right and left part of the query # OK, we have the results for right and left part of the query
# depending of operand, intersect, union or exclude both lists # depending of operand, intersect, union or exclude both lists
# to get a result list # to get a result list
if ( $operator eq ' and ' ) { if ( $operator eq ' and ' ) {
my @leftresult = split /;/, $leftresult; warn "NZAND";
return NZoperatorAND($leftresult,$rightresult);
# 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 ( $operator eq ' or ' ) { elsif ( $operator eq ' or ' ) {
@ -1620,16 +1574,7 @@ sub NZanalyse {
return $leftresult . $rightresult; return $leftresult . $rightresult;
} }
elsif ( $operator eq ' not ' ) { elsif ( $operator eq ' not ' ) {
my @leftresult = split /;/, $leftresult; return NZoperatorNOT($leftresult,$rightresult);
# my @rightresult = split /;/,$leftresult;
my $finalresult;
foreach (@leftresult) {
unless ( $rightresult =~ "$_;" ) {
$finalresult .= "$_;";
}
}
return $finalresult;
} }
else { else {
@ -1649,21 +1594,21 @@ sub NZanalyse {
my $left = $1; my $left = $1;
my $operator = $2; my $operator = $2;
my $right = $3; my $right = $3;
warn "handling leaf... left:$left operator:$operator right:$right" # warn "handling leaf... left:$left operator:$operator right:$right"
if $DEBUG; # if $DEBUG;
unless ($operator) { unless ($operator) {
$string =~ /(.*)(>|<|=)(.*)/; $string =~ /(.*)(>|<|=)(.*)/;
$left = $1; $left = $1;
$operator = $2; $operator = $2;
$right = $3; $right = $3;
warn # warn
"handling unless (operator)... left:$left operator:$operator right:$right" # "handling unless (operator)... left:$left operator:$operator right:$right"
if $DEBUG; # if $DEBUG;
} }
my $results; my $results;
# strip adv, zebra keywords, currently not handled in nozebra: wrdl, ext, phr... # strip adv, zebra keywords, currently not handled in nozebra: wrdl, ext, phr...
$left =~ s/[ ,].*$//; $left =~ s/[, ].*$//;
# automatic replace for short operators # automatic replace for short operators
$left = 'title' if $left =~ '^ti$'; $left = 'title' if $left =~ '^ti$';
@ -1672,6 +1617,7 @@ sub NZanalyse {
$left = 'subject' if $left =~ '^su$'; $left = 'subject' if $left =~ '^su$';
$left = 'koha-Auth-Number' if $left =~ '^an$'; $left = 'koha-Auth-Number' if $left =~ '^an$';
$left = 'keyword' if $left =~ '^kw$'; $left = 'keyword' if $left =~ '^kw$';
warn "handling leaf... left:$left operator:$operator right:$right";
if ( $operator && $left ne 'keyword' ) { if ( $operator && $left ne 'keyword' ) {
#do a specific search #do a specific search
@ -1701,27 +1647,13 @@ sub NZanalyse {
unless ( $right =~ /^\d+$/ && $value =~ /\D/ ); unless ( $right =~ /^\d+$/ && $value =~ /\D/ );
warn "result : $value " warn "result : $value "
. ( $right =~ /\d/ ) . "==" . ( $right =~ /\d/ ) . "=="
. ( !$value =~ /\d/ ); #= $line"; . ( $value =~ /\D/?$line:"" ); #= $line";
} }
# do a AND with existing list if there is one, otherwise, use the biblionumbers list as 1st result list # do a AND with existing list if there is one, otherwise, use the biblionumbers list as 1st result list
if ($results) { if ($results) {
my @leftresult = split /;/, $biblionumbers; warn "NZAND";
my $temp; $results = NZoperatorAND($biblionumbers,$results);
foreach my $entry (@leftresult)
{ # $_ contains biblionumber,title-weight
# remove weight at the end
my $cleaned = $entry;
$cleaned =~ s/-\d*$//;
# if the entry already in the hash, take it & increase weight
warn "===== $cleaned =====" if $DEBUG;
if ( $results =~ "$cleaned" ) {
$temp .= "$entry;$entry;";
warn "INCLUDING $entry" if $DEBUG;
}
}
$results = $temp;
} }
else { else {
$results = $biblionumbers; $results = $biblionumbers;
@ -1750,24 +1682,7 @@ sub NZanalyse {
# do a AND with existing list if there is one, otherwise, use the biblionumbers list as 1st result list # do a AND with existing list if there is one, otherwise, use the biblionumbers list as 1st result list
if ($results) { if ($results) {
warn "RES for $_ = $biblionumbers" if $DEBUG; $results = NZoperatorAND($biblionumbers,$results);
my @leftresult = split /;/, $biblionumbers;
my $temp;
foreach my $entry (@leftresult)
{ # $_ contains biblionumber,title-weight
# remove weight at the end
my $cleaned = $entry;
$cleaned =~ s/-\d*$//;
# if the entry already in the hash, take it & increase weight
# warn "===== $cleaned =====" if $DEBUG;
if ( $results =~ "$cleaned" ) {
$temp .= "$entry;$entry;";
# warn "INCLUDING $entry" if $DEBUG;
}
}
$results = $temp;
} }
else { else {
warn "NEW RES for $_ = $biblionumbers" if $DEBUG; warn "NEW RES for $_ = $biblionumbers" if $DEBUG;
@ -1783,6 +1698,55 @@ sub NZanalyse {
warn "---------" if $DEBUG; warn "---------" if $DEBUG;
} }
sub NZoperatorAND{
my ($rightresult, $leftresult)=@_;
my @leftresult = split /;/, $leftresult;
warn " @leftresult / $rightresult \n" if $DEBUG;
# 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) {
my $value = $_;
my $countvalue;
( $value, $countvalue ) = ( $1, $2 ) if ($value=~/(.*)-(\d+)$/);
if ( $rightresult =~ /$value-(\d+);/ ) {
$countvalue = ( $1 > $countvalue ? $countvalue : $1 );
$finalresult .=
"$value-$countvalue;$value-$countvalue;";
}
}
warn " $finalresult \n" if $DEBUG;
return $finalresult;
}
sub NZoperatorOR{
my ($rightresult, $leftresult)=@_;
return $rightresult.$leftresult;
}
sub NZoperatorNOT{
my ($rightresult, $leftresult)=@_;
my @leftresult = split /;/, $leftresult;
# my @rightresult = split /;/,$leftresult;
my $finalresult;
foreach (@leftresult) {
my $value=$_;
$value=$1 if $value=~m/(.*)-\d+$/;
unless ($rightresult =~ "$value-") {
$finalresult .= "$_;";
}
}
return $finalresult;
}
=head2 NZorder =head2 NZorder
$finalresult = NZorder($biblionumbers, $ordering,$results_per_page,$offset); $finalresult = NZorder($biblionumbers, $ordering,$results_per_page,$offset);