bug 2518: remove useless patron and branch lookups
[koha_fer] / C4 / Search.pm
old mode 100644 (file)
new mode 100755 (executable)
index 45a4a06..1509f49
@@ -33,7 +33,7 @@ BEGIN {
     $VERSION = 3.01;
     $DEBUG = ($ENV{DEBUG}) ? 1 : 0;
 }
-
+$DEBUG=1;
 =head1 NAME
 
 C4::Search - Functions for searching the Koha catalog.
@@ -158,7 +158,7 @@ sub FindDuplicate {
 
 =head2 SimpleSearch
 
-($error,$results) = SimpleSearch( $query, $offset, $max_results, [ @servers ] );
+( $error, $results, $total_hits ) = SimpleSearch( $query, $offset, $max_results, [@servers] );
 
 This function provides a simple search API on the bibliographic catalog
 
@@ -172,15 +172,17 @@ This function provides a simple search API on the bibliographic catalog
     * $max_results - if present, determines the maximum number of records to fetch. undef is All. defaults to undef.
 
 
-=item C<Output arg:>
+=item C<Output:>
+
     * $error is a empty unless an error is detected
     * \@results is an array of records.
+    * $total_hits is the number of hits that would have been returned with no limit
 
 =item C<usage in the script:>
 
 =back
 
-my ($error, $marcresults) = SimpleSearch($query);
+my ( $error, $marcresults, $total_hits ) = SimpleSearch($query);
 
 if (defined $error) {
     $template->param(query_error => $error);
@@ -192,7 +194,7 @@ if (defined $error) {
 my $hits = scalar @$marcresults;
 my @results;
 
-for(my $i=0;$i<$hits;$i++) {
+for my $i (0..$hits) {
     my %resultsloop;
     my $marcrecord = MARC::File::USMARC::decode($marcresults->[$i]);
     my $biblio = TransformMarcToKoha(C4::Context->dbh,$marcrecord,'');
@@ -227,6 +229,7 @@ sub SimpleSearch {
         # FIXME hardcoded value. See catalog/search.pl & opac-search.pl too.
         my @servers = defined ( $servers ) ? @$servers : ( "biblioserver" );
         my @results;
+        my @zoom_queries;
         my @tmpresults;
         my @zconns;
         my $total_hits;
@@ -236,9 +239,8 @@ sub SimpleSearch {
         for ( my $i = 0 ; $i < @servers ; $i++ ) {
             eval {
                 $zconns[$i] = C4::Context->Zconn( $servers[$i], 1 );
-                $tmpresults[$i] =
-                  $zconns[$i]
-                  ->search( new ZOOM::Query::CCL2RPN( $query, $zconns[$i] ) );
+                $zoom_queries[$i] = new ZOOM::Query::CCL2RPN( $query, $zconns[$i]);
+                $tmpresults[$i] = $zconns[$i]->search( $zoom_queries[$i] );
 
                 # error handling
                 my $error =
@@ -280,6 +282,13 @@ sub SimpleSearch {
             }
         }
 
+        foreach my $result (@tmpresults) {
+            $result->destroy();
+        }
+        foreach my $zoom_query (@zoom_queries) {
+            $zoom_query->destroy();
+        }
+
         return ( undef, \@results, $total_hits );
     }
 }
@@ -592,13 +601,12 @@ sub getRecords {
                         {
                             type_link_value => $link_value,
                             type_id         => $link_value . "_id",
-                            type_label =>
-                              $facets_info->{$link_value}->{'label_value'},
+                            "type_label_" . $facets_info->{$link_value}->{'label_value'} => 1, 
                             facets     => \@this_facets_array,
                             expandable => $expandable,
                             expand     => $link_value,
                         }
-                      );
+                      ) unless ( ($facets_info->{$link_value}->{'label_value'} =~ /Libraries/) and (C4::Context->preference('singleBranchMode')) );
                 }
             }
         }
@@ -694,11 +702,12 @@ sub _remove_stopwords {
         foreach ( keys %{ C4::Context->stopwords } ) {
             next if ( $_ =~ /(and|or|not)/ );    # don't remove operators
             if ( $operand =~
-                /(\P{IsAlpha}$_\P{IsAlpha}|^$_\P{IsAlpha}|\P{IsAlpha}$_$)/ )
+                /(\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;
+                               $operand =~ s/$1//gi;
                 push @stopwords_removed, $_;
             }
         }
@@ -741,6 +750,13 @@ sub _build_stemmed_operand {
     my ($operand) = @_;
     my $stemmed_operand;
 
+    # If operand contains a digit, it is almost certainly an identifier, and should
+    # not be stemmed.  This is particularly relevant for ISBNs and ISSNs, which
+    # can contain the letter "X" - for example, _build_stemmend_operand would reduce 
+    # "014100018X" to "x ", which for a MARC21 database would bring up irrelevant
+    # results (e.g., "23 x 29 cm." from the 300$c).  Bug 2098.
+    return $operand if $operand =~ /\d/;
+
 # FIXME: the locale should be set based on the user's language and/or search choice
     my $stemmer = Lingua::Stem->new( -locale => 'EN-US' );
 
@@ -1166,7 +1182,7 @@ Format results in a form suitable for passing to the template
 # IMO this subroutine is pretty messy still -- it's responsible for
 # building the HTML output for the template
 sub searchResults {
-    my ( $searchdesc, $hits, $results_per_page, $offset, @marcresults ) = @_;
+    my ( $searchdesc, $hits, $results_per_page, $offset, $scan, @marcresults ) = @_;
     my $dbh = C4::Context->dbh;
     my $even = 1;
     my @newresults;
@@ -1242,6 +1258,7 @@ sub searchResults {
     for ( my $i = $offset ; $i <= $times - 1 ; $i++ ) {
         my $marcrecord = MARC::File::USMARC::decode( $marcresults[$i] );
         my $oldbiblio = TransformMarcToKoha( $dbh, $marcrecord, '' );
+        $oldbiblio->{subtitle} = C4::Biblio::get_koha_field_from_marc('bibliosubtitle', 'subtitle', $marcrecord, '');
         $oldbiblio->{result_number} = $i + 1;
 
         # add imageurl to itemtype if there is one
@@ -1340,17 +1357,18 @@ s/\[(.?.?.?.?)$tagsubf(.*?)]/$1$subfieldvalue$2\[$1$tagsubf$2]/g;
         my $onloan_items;
         my $other_items;
 
-        my $ordered_count     = 0;
-        my $available_count   = 0;
-        my $onloan_count      = 0;
-        my $longoverdue_count = 0;
-        my $other_count       = 0;
-        my $wthdrawn_count    = 0;
-        my $itemlost_count    = 0;
-        my $itembinding_count = 0;
-        my $itemdamaged_count = 0;
-        my $can_place_holds   = 0;
-        my $items_count       = scalar(@fields);
+        my $ordered_count         = 0;
+        my $available_count       = 0;
+        my $onloan_count          = 0;
+        my $longoverdue_count     = 0;
+        my $other_count           = 0;
+        my $wthdrawn_count        = 0;
+        my $itemlost_count        = 0;
+        my $itembinding_count     = 0;
+        my $itemdamaged_count     = 0;
+        my $item_in_transit_count = 0;
+        my $can_place_holds       = 0;
+        my $items_count           = scalar(@fields);
         my $items_counter;
         my $maxitems =
           ( C4::Context->preference('maxItemsinSearchResults') )
@@ -1404,15 +1422,42 @@ s/\[(.?.?.?.?)$tagsubf(.*?)]/$1$subfieldvalue$2\[$1$tagsubf$2]/g;
                     $ordered_count++;
                 }
 
+                # is item in transit?
+                my $transfertwhen = '';
+                my ($transfertfrom, $transfertto);
+                
+                unless ($item->{wthdrawn}
+                        || $item->{itemlost}
+                        || $item->{damaged}
+                        || $item->{notforloan}
+                        || $items_count > 20) {
+
+                    # A couple heuristics to limit how many times
+                    # we query the database for item transfer information, sacrificing
+                    # accuracy in some cases for speed;
+                    #
+                    # 1. don't query if item has one of the other statuses
+                    # 2. don't check transit status if the bib has
+                    #    more than 20 items
+                    #
+                    # FIXME: to avoid having the query the database like this, and to make
+                    #        the in transit status count as unavailable for search limiting,
+                    #        should map transit status to record indexed in Zebra.
+                    #
+                    ($transfertwhen, $transfertfrom, $transfertto) = C4::Circulation::GetTransfers($item->{itemnumber});
+                }
+
                 # item is withdrawn, lost or damaged
                 if (   $item->{wthdrawn}
                     || $item->{itemlost}
                     || $item->{damaged}
-                    || $item->{notforloan} )
+                    || $item->{notforloan} 
+                    || ($transfertwhen ne ''))
                 {
-                    $wthdrawn_count++    if $item->{wthdrawn};
-                    $itemlost_count++    if $item->{itemlost};
-                    $itemdamaged_count++ if $item->{damaged};
+                    $wthdrawn_count++        if $item->{wthdrawn};
+                    $itemlost_count++        if $item->{itemlost};
+                    $itemdamaged_count++     if $item->{damaged};
+                    $item_in_transit_count++ if $transfertwhen ne '';
                     $item->{status} = $item->{wthdrawn} . "-" . $item->{itemlost} . "-" . $item->{damaged} . "-" . $item->{notforloan};
                     $other_count++;
 
@@ -1420,6 +1465,7 @@ s/\[(.?.?.?.?)$tagsubf(.*?)]/$1$subfieldvalue$2\[$1$tagsubf$2]/g;
                                        foreach (qw(wthdrawn itemlost damaged branchname itemcallnumber)) {
                        $other_items->{$key}->{$_} = $item->{$_};
                                        }
+                    $other_items->{$key}->{intransit} = ($transfertwhen ne '') ? 1 : 0;
                                        $other_items->{$key}->{notforloan} = GetAuthorisedValueDesc('','',$item->{notforloan},'','',$notforloan_authorised_value) if $notforloan_authorised_value;
                                        $other_items->{$key}->{count}++ if $item->{homebranch};
                                        $other_items->{$key}->{location} = $shelflocations->{ $item->{location} };
@@ -1457,7 +1503,7 @@ s/\[(.?.?.?.?)$tagsubf(.*?)]/$1$subfieldvalue$2\[$1$tagsubf$2]/g;
         }
 
         # XSLT processing of some stuff
-        if (C4::Context->preference("XSLTResultsDisplay") ) {
+        if (C4::Context->preference("XSLTResultsDisplay") && !$scan) {
             my $newxmlrecord = XSLTParse4Display($oldbiblio->{biblionumber},C4::Context->config('opachtdocs')."/prog/en/xslt/MARC21slim2OPACResults.xsl");
             $oldbiblio->{XSLTResultsRecord} = $newxmlrecord;
         }
@@ -1480,6 +1526,7 @@ s/\[(.?.?.?.?)$tagsubf(.*?)]/$1$subfieldvalue$2\[$1$tagsubf$2]/g;
         $oldbiblio->{wthdrawncount}        = $wthdrawn_count;
         $oldbiblio->{itemlostcount}        = $itemlost_count;
         $oldbiblio->{damagedcount}         = $itemdamaged_count;
+        $oldbiblio->{intransitcount}       = $item_in_transit_count;
         $oldbiblio->{orderedcount}         = $ordered_count;
         $oldbiblio->{isbn} =~
           s/-//g;    # deleting - in isbn to enable amazon content
@@ -1581,10 +1628,14 @@ sub NZanalyse {
         } 
     }
     warn "string :" . $string if $DEBUG;
-    $string =~ /(.*?)( and | or | not | AND | OR | NOT )(.*)/;
-    my $left     = $1;
-    my $right    = $3;
-    my $operator = lc($2);    # FIXME: and/or/not are operators, not operands
+    my $left = "";
+    my $right = "";
+    my $operator = "";
+    if ($string =~ /(.*?)( and | or | not | AND | OR | NOT )(.*)/) {
+        $left     = $1;
+        $right    = $3;
+        $operator = lc($2);    # FIXME: and/or/not are operators, not operands
+    }
     warn "no parenthesis. left : $left operator: $operator right: $right"
       if $DEBUG;
 
@@ -1630,20 +1681,29 @@ sub NZanalyse {
         warn "leaf:$string" if $DEBUG;
 
         # parse the string in in operator/operand/value again
-        $string =~ /(.*)(>=|<=)(.*)/;
-        my $left     = $1;
-        my $operator = $2;
-        my $right    = $3;
-#         warn "handling leaf... left:$left operator:$operator right:$right"
-#           if $DEBUG;
-        unless ($operator) {
-            $string =~ /(.*)(>|<|=)(.*)/;
+        my $left = "";
+        my $operator = "";
+        my $right = "";
+        if ($string =~ /(.*)(>=|<=)(.*)/) {
             $left     = $1;
             $operator = $2;
             $right    = $3;
-            warn
-"handling unless (operator)... left:$left operator:$operator right:$right"
-              if $DEBUG;
+        } else {
+            $left = $string;
+        }
+#         warn "handling leaf... left:$left operator:$operator right:$right"
+#           if $DEBUG;
+        unless ($operator) {
+            if ($string =~ /(.*)(>|<|=)(.*)/) {
+                $left     = $1;
+                $operator = $2;
+                $right    = $3;
+                warn
+    "handling unless (operator)... left:$left operator:$operator right:$right"
+                if $DEBUG;
+            } else {
+                $left = $string;
+            }
         }
         my $results;
 
@@ -1769,7 +1829,7 @@ sub NZoperatorOR{
 }
 
 sub NZoperatorNOT{
-    my ($rightresult, $leftresult)=@_;
+    my ($leftresult, $rightresult)=@_;
     
     my @leftresult = split /;/, $leftresult;