Adding MARC preview to acqui screens
[koha_fer] / C4 / Search.pm
index 0e54fee..3909e6b 100644 (file)
@@ -117,7 +117,7 @@ sub FindDuplicate {
         # remove valid operators
         $result->{title} =~ s/(and|or|not)//g;
         $query = "ti,ext=$result->{title}";
-        $query .= " and mt=$result->{itemtype}" if ($result->{itemtype});    
+        $query .= " and itemtype=$result->{itemtype}" if ($result->{itemtype});    
         if ($result->{author}){
           $result->{author} =~ s /\\//g;
           $result->{author} =~ s /\"//g;
@@ -287,8 +287,8 @@ sub getRecords {
             $query_to_use = $simple_query;
         }
 
-               $query_to_use = $simple_query if $scan;
-
+               #$query_to_use = $simple_query if $scan;
+               #warn $simple_query if ($scan && $DEBUG);
         # check if we've got a query_type defined
         eval {
             if ($query_type)
@@ -320,7 +320,7 @@ sub getRecords {
             }
             else {
                 if ($scan) {
-                                     warn "preparing to scan:$query_to_use";
+                     #               warn "preparing to scan:$query_to_use";
                     $results[$i] =
                       $zconns[$i]->scan(
                         new ZOOM::Query::CCL2RPN( $query_to_use, $zconns[$i] )
@@ -558,20 +558,24 @@ sub getRecords {
 # STOPWORDS
 sub _remove_stopwords {
     my ($operand,$index) = @_;
-    # phrase and exact-qualified indexes shoudln't have stopwords removed
+       my @stopwords_removed;
+    # phrase and exact-qualified indexes shouldn't have stopwords removed
     if ($index!~m/phr|ext/){
     # 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" woudl be split into "le" "çon", le 
-    #       is an empty word, we get "çon" and wouldn't find anything...
+    #       otherwise, a French word like "leçon" woudl be split into "le" "çon", le 
+    #       is an empty word, we'd get "çon" and wouldn't find anything...
         foreach (keys %{C4::Context->stopwords}) {
-            next if ($_ =~/(and|or|not)/); # don't remove operators 
-            $operand=~ s/\P{IsAlpha}$_\P{IsAlpha}/ /i;
-            $operand=~ s/^$_\P{IsAlpha}/ /i;
-            $operand=~ s/\P{IsAlpha}$_$/ /i;
+            next if ($_ =~/(and|or|not)/); # don't remove operators
+                       if ($operand =~ /(\P{IsAlpha}$_\P{IsAlpha}|^$_\P{IsAlpha}|\P{IsAlpha}$_$)/) {
+               $operand=~ s/\P{IsAlpha}$_\P{IsAlpha}/ /gi;
+               $operand=~ s/^$_\P{IsAlpha}/ /gi;
+               $operand=~ s/\P{IsAlpha}$_$/ /gi;
+                               push @stopwords_removed, $_;
+                       }
         }
     }
-    return $operand;
+    return ($operand, \@stopwords_removed);
 }
 
 # TRUNCATION
@@ -647,6 +651,9 @@ sub _build_weighted_query {
        # embedded sorting: 0 a-z; 1 z-a
        # $weighted_query .= ") or (sort1,aut=1";
     }
+       elsif ( $index eq 'bc' ) {
+               $weighted_query .= "bc=\"$operand\"";
+       }
     # if the index already has more than one qualifier, just wrap the operand 
     # in quotes and pass it back
     elsif ($index =~ ',') {
@@ -665,7 +672,7 @@ sub _build_weighted_query {
 
 # build the query itself
 sub buildQuery {
-    my ( $operators, $operands, $indexes, $limits, $sort_by ) = @_;
+    my ( $operators, $operands, $indexes, $limits, $sort_by, $scan) = @_;
 
     my @operators = @$operators if $operators;
     my @indexes   = @$indexes   if $indexes;
@@ -673,37 +680,39 @@ 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 $stemming      = C4::Context->preference("QueryStemming")               || 0;
+       my $auto_truncation = C4::Context->preference("QueryAutoTruncate")              || 0;
+    my $weight_fields = C4::Context->preference("QueryWeightFields")           || 0;
+    my $fuzzy_enabled = C4::Context->preference("QueryFuzzy")                          || 0;
+       my $remove_stopwords = C4::Context->preference("QueryRemoveStopwords")  || 0;
 
     my $query = $operands[0];
        my $simple_query = $operands[0];
        my $query_cgi;
-       my $query_search_desc;
+       my $query_desc;
+       my $query_type;
 
        my $limit;
        my $limit_cgi;
        my $limit_desc;
 
-# STEP I: determine if this is a form-based / simple query or if it's complex (if complex,
-# pass it off to zebra directly)
+       my $stopwords_removed;
 
-# check if this is a known query language query, if it is, return immediately,
-# the user is responsible for constructing valid syntax:
+       # for handling ccl, cql, pqf queries in diagnostic mode, skip the rest of the steps
+       # DIAGNOSTIC ONLY!!
     if ( $query =~ /^ccl=/ ) {
-        return ( undef, $', $', $', '', '', '', 'ccl' );
+        return ( undef, $', $', $', $', '', '', '', '', 'ccl' );
     }
     if ( $query =~ /^cql=/ ) {
-        return ( undef, $', $', $', '', '', '', 'cql' );
+        return ( undef, $', $', $', $', '', '', '', '', 'cql' );
     }
     if ( $query =~ /^pqf=/ ) {
-        return ( undef, $', $', $', '', '', '', 'pqf' );
+        return ( undef, $', $', $', $', '', '', '', '', 'pqf' );
     }
 
-# FIXME: this is bound to be broken now
-    if ( $query =~ /(\(|\))/ ) {    # sorry, too complex, assume CCL
-        return ( undef, $query, $query_cgi, $query_search_desc, $limit, $limit_cgi, $limit_desc, 'ccl' );
+       # pass nested queries directly
+    if ( $query =~ /(\(|\))/ ) {
+        return ( undef, $query, $simple_query, $query_cgi, $query, $limit, $limit_cgi, $limit_desc, $stopwords_removed, 'ccl' );
     }
 
 # form-based queries are limited to non-nested at a specific depth, so we can easily
@@ -720,28 +729,37 @@ sub buildQuery {
             # COMBINE OPERANDS, INDEXES AND OPERATORS
             if ( $operands[$i] ) {
 
-                               $weight_fields = 0 if $operands[$i] =~ /(:|=)/;
+                               # a flag to determine whether or not to add the index to the query
+                               my $indexes_set;
+                               # if the user is sophisticated enough to specify an index, turn off some defaults
+                               if ($operands[$i] =~ /(:|=)/ || $scan) {
+                                       $weight_fields = 0;
+                                       $stemming = 0;
+                                       $remove_stopwords = 0;
+                               }
                 my $operand = $operands[$i];
                 my $index   = $indexes[$i];
 
-                # if there's no index, don't use one, it will throw a CCL error
+                               # some helpful index modifs
                 my $index_plus = "$index:" if $index;
                 my $index_plus_comma="$index," if $index;
 
-                # Remove Stopwords  
-                $operand = _remove_stopwords($operand,$index);
-                warn "OPERAND w/out STOPWORDS: >$operand<" if $DEBUG;
-
-                my $indexes_set;
+                # Remove Stopwords
+                               if ($remove_stopwords) {
+                ($operand, $stopwords_removed) = _remove_stopwords($operand,$index);
+                       warn "OPERAND w/out STOPWORDS: >$operand<" if $DEBUG;
+                                       warn "REMOVED STOPWORDS: @$stopwords_removed" if ($stopwords_removed && $DEBUG);
+                               }
 
                 # Detect Truncation
                 my ($nontruncated,$righttruncated,$lefttruncated,$rightlefttruncated,$regexpr);
                 my $truncated_operand;
                 ($nontruncated,$righttruncated,$lefttruncated,$rightlefttruncated,$regexpr) = _detect_truncation($operand,$index);
                 warn "TRUNCATION: NON:>@$nontruncated< RIGHT:>@$righttruncated< LEFT:>@$lefttruncated< RIGHTLEFT:>@$rightlefttruncated< REGEX:>@$regexpr<" if $DEBUG;
+
                 # Apply Truncation
-                # Problem is when build_weights gets ahold if this is wraps in quotes which breaks the truncation :/
                 if (scalar(@$righttruncated)+scalar(@$lefttruncated)+scalar(@$rightlefttruncated)>0){
+                                       # don't field weight or add the index to the query, we do it here
                     $indexes_set = 1;
                     undef $weight_fields;
                     my $previous_truncation_operand;
@@ -791,7 +809,7 @@ sub buildQuery {
                                                $query_cgi .="&op=$operators[$i-1]";
                                                $query_cgi .="&idx=$index" if $index;
                                                $query_cgi .="&q=$operands[$i]" if $operands[$i];
-                                               $query_search_desc .=" $operators[$i-1] $index_plus $operands[$i]";
+                                               $query_desc .=" $operators[$i-1] $index_plus $operands[$i]";
                     }
 
                     # the default operator is and
@@ -801,15 +819,16 @@ sub buildQuery {
                         $query .= "$operand";
                                                $query_cgi .="&op=and&idx=$index" if $index;
                                                $query_cgi .="&q=$operands[$i]" if $operands[$i];
-                        $query_search_desc .= " and $index_plus $operands[$i]";
+                        $query_desc .= " and $index_plus $operands[$i]";
                     }
                 }
 
+                               # there isn't a pervious operand, don't need an operator
                 else { 
                                        # field-weighted queries already have indexes set
                                        $query .=" $index_plus " unless $indexes_set;
                                        $query .= $operand;
-                                       $query_search_desc .= " $index_plus $operands[$i]";
+                                       $query_desc .= " $index_plus $operands[$i]";
                                        $query_cgi.="&idx=$index" if $index;
                                        $query_cgi.="&q=$operands[$i]" if $operands[$i];
 
@@ -822,10 +841,11 @@ sub buildQuery {
 
     # add limits
        my $group_OR_limits;
+       my $availability_limit;
     foreach my $this_limit (@limits) {
         if ( $this_limit =~ /available/ ) {
-                       # FIXME: switch to zebra search for null values
-            $limit .= " (($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))";
+                       # available is defined as (items.notloan is NULL) and (items.itemlost > 0 or NULL) (last clause handles NULL values for lost in zebra)
+                       $availability_limit .="( ( allrecords,AlwaysMatches='' not onloan,AlwaysMatches='') and ((lost,st-numeric gt 0) or ( allrecords,AlwaysMatches='' not lost,AlwaysMatches='')) )";
                        $limit_cgi .= "&limit=available";
                        $limit_desc .="";
         }
@@ -851,29 +871,33 @@ sub buildQuery {
                $limit.=" and " if ($query || $limit );
                $limit.="($group_OR_limits)";
        }
+       if ($availability_limit) {
+               $limit.=" not " if ($query || $limit );
+               $limit.="$availability_limit";
+       }
        # normalize the strings
-       for ($query, $query_search_desc, $limit, $limit_desc) {
+       $query =~ s/:/=/g;
+       $limit =~ s/:/=/g;
+       for ($query, $query_desc, $limit, $limit_desc) {
                $_ =~ s/  / /g;    # remove extra spaces
        $_ =~ s/^ //g;     # remove any beginning spaces
-               $_ =~ s/ $//g;     # remove any beginning spaces
-       $_ =~ s/:/=/g;     # causes probs for server
+               $_ =~ s/ $//g;     # remove any ending spaces
        $_ =~ s/==/=/g;    # remove double == from query
 
        }
-               
        $query_cgi =~ s/^&//;
 
        # append the limit to the query
-       $query .= $limit;
+       $query .= " ".$limit;
 
     warn "QUERY:".$query if $DEBUG;
        warn "QUERY CGI:".$query_cgi if $DEBUG;
-    warn "QUERY DESC:".$query_search_desc if $DEBUG;
+    warn "QUERY DESC:".$query_desc if $DEBUG;
     warn "LIMIT:".$limit if $DEBUG;
     warn "LIMIT CGI:".$limit_cgi if $DEBUG;
     warn "LIMIT DESC:".$limit_desc if $DEBUG;
 
-       return ( undef, $query,$simple_query,$query_cgi,$query_search_desc,$limit,$limit_cgi,$limit_desc );
+       return ( undef, $query,$simple_query,$query_cgi,$query_desc,$limit,$limit_cgi,$limit_desc,$stopwords_removed,$query_type );
 }
 
 # IMO this subroutine is pretty messy still -- it's responsible for
@@ -947,6 +971,7 @@ sub searchResults {
         my $marcrecord;
         $marcrecord = MARC::File::USMARC::decode( $marcresults[$i] );
         my $oldbiblio = TransformMarcToKoha( $dbh, $marcrecord, '' );
+               $oldbiblio->{result_number} = $i+1;
         # add image url if there is one
         if ( $itemtypes{ $oldbiblio->{itemtype} }->{imageurl} =~ /^http:/ ) {
             $oldbiblio->{imageurl} =
@@ -1080,8 +1105,9 @@ sub searchResults {
 
         # last check for norequest : if itemtype is notforloan, it can't be reserved either, whatever the items
         $norequests = 1 if $itemtypes{$oldbiblio->{itemtype}}->{notforloan};
-
+               my $itemscount;
         for my $key ( sort keys %$items ) {
+                       $itemscount++;
             my $this_item = {
                 branchname     => $branches{$items->{$key}->{branchcode}},
                 branchcode     => $items->{$key}->{branchcode},
@@ -1093,7 +1119,9 @@ sub searchResults {
                 wthdrawn      => $items->{$key}->{wthdrawn},
                 lost         => $items->{$key}->{itemlost},
             };
-            push @items_loop, $this_item;
+                       # only show the number specified by the user
+                       my $maxitems = (C4::Context->preference('maxItemsinSearchResults')) ? C4::Context->preference('maxItemsinSearchResults')- 1 : 1;
+            push @items_loop, $this_item unless $itemscount > $maxitems;;
         }
         $oldbiblio->{norequests}    = $norequests;
         $oldbiblio->{items_count}    = $items_count;
@@ -1120,22 +1148,16 @@ sub searchResults {
   NZgetRecords has the same API as zera getRecords, even if some parameters are not managed
 
 =cut
-
 sub NZgetRecords {
-    my (
-        $koha_query,     $simple_query,  $sort_by_ref,
-        $servers_ref,    $results_per_page, $offset,
-        $expanded_facet, $branches,         $query_type,
-        $scan
-    ) = @_;
-    my $result = NZanalyse($koha_query);
+    my ($query,$simple_query,$sort_by_ref,$servers_ref,$results_per_page,$offset,$expanded_facet,$branches,$query_type,$scan) = @_;
+    my $result = NZanalyse($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
+  the list is built from an inverted index in the 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.
 
@@ -1146,12 +1168,13 @@ sub NZanalyse {
     # $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";
+               warn "commacontent : $commacontent" if $DEBUG;
     }
     # 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
@@ -1159,13 +1182,13 @@ sub NZanalyse {
     $string =~ /(.*)( and | or | not | AND | OR | NOT )(.*)/;
     my $left = $1;
     my $right = $3;
-    my $operand = lc($2);
+    my $operand = lc($2); # FIXME: and/or/not are operators, not operands
     # 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";
+        warn "node : $left / $operand / $right\n" if $DEBUG;
         my $leftresult = NZanalyse($left,$server);
         my $rightresult = NZanalyse($right,$server);
         # OK, we have the results for right and left part of the query
@@ -1206,7 +1229,7 @@ sub NZanalyse {
     } else {
         $string =~  s/__X__/"$commacontent"/ if $commacontent;
         $string =~ s/-|\.|\?|,|;|!|'|\(|\)|\[|\]|{|}|"|&|\+|\*|\// /g;
-#         warn "leaf : $string\n";
+         warn "leaf : $string\n" if $DEBUG;
         # parse the string in in operator/operand/value again
         $string =~ /(.*)(>=|<=)(.*)/;
         my $left = $1;
@@ -1237,7 +1260,7 @@ sub NZanalyse {
                 my ($biblionumbers,$value);
                 next unless $_;
                 warn "EXECUTE : $server, $left, $_";
-                $sth->execute($server, $left, $_);
+                $sth->execute($server, $left, $_) or warn "execute failed: $!";
                 while (my ($line,$value) = $sth->fetchrow) {
                     # if we are dealing with a numeric value, use only numeric results (in case of >=, <=, > or <)
                     # otherwise, fill the result
@@ -1253,10 +1276,10 @@ sub NZanalyse {
                         my $cleaned = $entry;
                         $cleaned =~ s/-\d*$//;
                         # if the entry already in the hash, take it & increase weight
-#                         warn "===== $cleaned =====";
+                         warn "===== $cleaned =====" if $DEBUG;
                         if ($results =~ "$cleaned") {
                             $temp .= "$entry;$entry;";
-#                             warn "INCLUDING $entry";
+                             warn "INCLUDING $entry" if $DEBUG;
                         }
                     }
                     $results = $temp;
@@ -1271,7 +1294,7 @@ sub NZanalyse {
             # 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 $_";
+                warn "search on all indexes on $_" if $DEBUG;
                 my $biblionumbers;
                 next unless $_;
                 $sth->execute($server, $_);
@@ -1280,7 +1303,7 @@ sub NZanalyse {
                 }
                 # do a AND with existing list if there is one, otherwise, use the biblionumbers list as 1st result list
                 if ($results) {
-#                 warn "RES for $_ = $biblionumbers";
+                 warn "RES for $_ = $biblionumbers" if $DEBUG;
                     my @leftresult = split /;/, $biblionumbers;
                     my $temp;
                     foreach my $entry (@leftresult) { # $_ contains biblionumber,title-weight
@@ -1288,20 +1311,20 @@ sub NZanalyse {
                         my $cleaned = $entry;
                         $cleaned =~ s/-\d*$//;
                         # if the entry already in the hash, take it & increase weight
-#                         warn "===== $cleaned =====";
+                         warn "===== $cleaned =====" if $DEBUG;
                         if ($results =~ "$cleaned") {
                             $temp .= "$entry;$entry;";
-#                             warn "INCLUDING $entry";
+                             warn "INCLUDING $entry" if $DEBUG;
                         }
                     }
                     $results = $temp;
                 } else {
-#                 warn "NEW RES for $_ = $biblionumbers";
+                 warn "NEW RES for $_ = $biblionumbers" if $DEBUG;
                     $results = $biblionumbers;
                 }
             }
         }
-#         warn "return : $results for LEAF : $string";
+         warn "return : $results for LEAF : $string" if $DEBUG;
         return $results;
     }
 }