Bugfix #2630 2nd attempt
[koha.git] / C4 / Search.pm
index 9e49334..05aff80 100644 (file)
@@ -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 );
     }
 }
@@ -330,13 +339,7 @@ sub getRecords {
 
 # perform the search, create the results objects
 # if this is a local search, use the $koha-query, if it's a federated one, use the federated-query
-        my $query_to_use;
-        if ( $servers[$i] =~ /biblioserver/ ) {
-            $query_to_use = $koha_query;
-        }
-        else {
-            $query_to_use = $simple_query;
-        }
+        my $query_to_use = ($servers[$i] =~ /biblioserver/) ? $koha_query : $simple_query;
 
         #$query_to_use = $simple_query if $scan;
         warn $simple_query if ( $scan and $DEBUG );
@@ -467,26 +470,16 @@ sub getRecords {
                         my $tmpauthor;
 
                 # the minimal record in author/title (depending on MARC flavour)
-                        if ( C4::Context->preference("marcflavour") eq
-                            "UNIMARC" )
-                        {
-                            $tmptitle = MARC::Field->new(
-                                '200', ' ', ' ',
-                                a => $term,
-                                f => $occ
-                            );
+                        if (C4::Context->preference("marcflavour") eq "UNIMARC") {
+                            $tmptitle = MARC::Field->new('200',' ',' ', a => $term, f => $occ);
                             $tmprecord->append_fields($tmptitle);
-                        }
-                        else {
-                            $tmptitle =
-                              MARC::Field->new( '245', ' ', ' ', a => $term, );
-                            $tmpauthor =
-                              MARC::Field->new( '100', ' ', ' ', a => $occ, );
+                        } else {
+                            $tmptitle  = MARC::Field->new('245',' ',' ', a => $term,);
+                            $tmpauthor = MARC::Field->new('100',' ',' ', a => $occ,);
                             $tmprecord->append_fields($tmptitle);
                             $tmprecord->append_fields($tmpauthor);
                         }
-                        $results_hash->{'RECORDS'}[$j] =
-                          $tmprecord->as_usmarc();
+                        $results_hash->{'RECORDS'}[$j] = $tmprecord->as_usmarc();
                     }
 
                     # not an index scan
@@ -608,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')) );
                 }
             }
         }
@@ -710,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, $_;
             }
         }
@@ -757,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' );
 
@@ -951,22 +951,14 @@ sub buildQuery {
                 if ( $index eq 'yr' ) {
                     $index .= ",st-numeric";
                     $indexes_set++;
-                    (
-                        $stemming,      $auto_truncation,
-                        $weight_fields, $fuzzy_enabled,
-                        $remove_stopwords
-                    ) = ( 0, 0, 0, 0, 0 );
+                                       $stemming = $auto_truncation = $weight_fields = $fuzzy_enabled = $remove_stopwords = 0;
                 }
 
                 # Date of Acquisition
                 elsif ( $index eq 'acqdate' ) {
                     $index .= ",st-date-normalized";
                     $indexes_set++;
-                    (
-                        $stemming,      $auto_truncation,
-                        $weight_fields, $fuzzy_enabled,
-                        $remove_stopwords
-                    ) = ( 0, 0, 0, 0, 0 );
+                                       $stemming = $auto_truncation = $weight_fields = $fuzzy_enabled = $remove_stopwords = 0;
                 }
                 # ISBN,ISSN,Standard Number, don't need special treatment
                 elsif ( $index eq 'nb' || $index eq 'ns' ) {
@@ -1190,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;
@@ -1230,12 +1222,9 @@ sub searchResults {
       );
     $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'};
+               foreach (qw(description imageurl summary notforloan)) {
+               $itemtypes{ $bdata->{'itemtype'} }->{$_} = $bdata->{$_};
+               }
     }
 
     #search item field code
@@ -1262,34 +1251,25 @@ sub searchResults {
         $times = $offset + $results_per_page;
     }
     else {
-        $times = $hits;
+        $times = $hits;         # FIXME: if $hits is undefined, why do we want to equal it?
     }
 
     # loop through all of the records we've retrieved
     for ( my $i = $offset ; $i <= $times - 1 ; $i++ ) {
-        my $marcrecord;
-        $marcrecord = MARC::File::USMARC::decode( $marcresults[$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
-        if ( $itemtypes{ $oldbiblio->{itemtype} }->{imageurl} =~ /^http:/ ) {
-            $oldbiblio->{imageurl} =
-              $itemtypes{ $oldbiblio->{itemtype} }->{imageurl};
-            $oldbiblio->{description} =
-              $itemtypes{ $oldbiblio->{itemtype} }->{description};
-        }
-        else {
-            $oldbiblio->{imageurl} =
-              getitemtypeimagesrc() . "/"
-              . $itemtypes{ $oldbiblio->{itemtype} }->{imageurl}
-              if ( $itemtypes{ $oldbiblio->{itemtype} }->{imageurl} );
-            $oldbiblio->{description} =
-              $itemtypes{ $oldbiblio->{itemtype} }->{description};
-        }
-        my $aisbn=$oldbiblio->{'isbn'};
-        $aisbn =~ /(\d*[X]*)/;
-        $oldbiblio->{'amazonisbn'} = $1;
+        $oldbiblio->{imageurl} = getitemtypeimagelocation( 'opac', $itemtypes{ $oldbiblio->{itemtype} }->{imageurl} );
+
+               my $biblio_authorised_value_images = C4::Items::get_authorised_value_images( C4::Biblio::get_biblio_authorised_values( $oldbiblio->{biblionumber} ) );
+               $oldbiblio->{authorised_value_images} = $biblio_authorised_value_images;
+        (my $aisbn) = $oldbiblio->{isbn} =~ /([\d-]*[X]*)/;
+        $aisbn =~ s/-//g;
+        $oldbiblio->{amazonisbn} = $aisbn;
+               $oldbiblio->{description} = $itemtypes{ $oldbiblio->{itemtype} }->{description};
  # Build summary if there is one (the summary is defined in the itemtypes table)
  # FIXME: is this used anywhere, I think it can be commented out? -- JF
         if ( $itemtypes{ $oldbiblio->{itemtype} }->{summary} ) {
@@ -1343,29 +1323,16 @@ s/\[(.?.?.?.?)$tagsubf(.*?)]/$1$subfieldvalue$2\[$1$tagsubf$2]/g;
             }
             $searchhighlightblob = ' ... '.$searchhighlightblob if $searchhighlightblob;
             $oldbiblio->{'searchhighlightblob'} = $searchhighlightblob;
-    
-            # Add search-term highlighting to the title, subtitle, etc. fields
-            for my $term ( keys %$span_terms_hashref ) {
-                my $old_term = $term;
-                if ( length($term) > 3 ) {
-                    $term =~ s/(.*=|\)|\(|\+|\.|\?|\[|\]|\\|\*)//g;
-                    $oldbiblio->{'title'} =~
-                    s/$term/<span class=\"term\">$&<\/span>/gi;
-                    $oldbiblio->{'subtitle'} =~
-                    s/$term/<span class=\"term\">$&<\/span>/gi;
-                    $oldbiblio->{'author'} =~
-                    s/$term/<span class=\"term\">$&<\/span>/gi;
-                    $oldbiblio->{'publishercode'} =~
-                    s/$term/<span class=\"term\">$&<\/span>/gi;
-                    $oldbiblio->{'place'} =~
-                    s/$term/<span class=\"term\">$&<\/span>/gi;
-                    $oldbiblio->{'pages'} =~
-                    s/$term/<span class=\"term\">$&<\/span>/gi;
-                    $oldbiblio->{'notes'} =~
-                    s/$term/<span class=\"term\">$&<\/span>/gi;
-                    $oldbiblio->{'size'} =~
-                    s/$term/<span class=\"term\">$&<\/span>/gi;
-                }
+        }
+
+        # Add search-term highlighting to the title, subtitle, etc. fields
+        for my $term ( keys %$span_terms_hashref ) {
+            my $old_term = $term;
+            if ( length($term) > 3 ) {
+                $term =~ s/(.*=|\)|\(|\+|\.|\?|\[|\]|\\|\*)//g;
+                               foreach(qw(title subtitle author publishercode place pages notes size)) {
+                       $oldbiblio->{$_} =~ s/$term/<span class=\"term\">$&<\/span>/gi;
+                               }
             }
         }
 
@@ -1383,17 +1350,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') )
@@ -1429,7 +1397,7 @@ s/\[(.?.?.?.?)$tagsubf(.*?)]/$1$subfieldvalue$2\[$1$tagsubf$2]/g;
                                $onloan_items->{$key}->{branchname} = $item->{branchname};
                                $onloan_items->{$key}->{location} = $shelflocations->{ $item->{location} };
                                $onloan_items->{$key}->{itemcallnumber} = $item->{itemcallnumber};
-                               $onloan_items->{$key}->{imageurl} = getitemtypeimagesrc() . "/" . $itemtypes{ $item->{itype} }->{imageurl};
+                               $onloan_items->{$key}->{imageurl} = getitemtypeimagelocation( 'opac', $itemtypes{ $item->{itype} }->{imageurl} );
                 # if something's checked out and lost, mark it as 'long overdue'
                 if ( $item->{itemlost} ) {
                     $onloan_items->{$prefix}->{longoverdue}++;
@@ -1447,15 +1415,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++;
 
@@ -1463,10 +1458,11 @@ 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} };
-                                       $other_items->{$key}->{imageurl} = getitemtypeimagesrc() . "/" . $itemtypes{ $item->{itype} }->{imageurl};
+                                       $other_items->{$key}->{imageurl} = getitemtypeimagelocation( 'opac', $itemtypes{ $item->{itype} }->{imageurl} );
                 }
                 # item is available
                 else {
@@ -1477,7 +1473,7 @@ s/\[(.?.?.?.?)$tagsubf(.*?)]/$1$subfieldvalue$2\[$1$tagsubf$2]/g;
                        $available_items->{$prefix}->{$_} = $item->{$_};
                                        }
                                        $available_items->{$prefix}->{location} = $shelflocations->{ $item->{location} };
-                                       $available_items->{$prefix}->{imageurl} = getitemtypeimagesrc() . "/" . $itemtypes{ $item->{itype} }->{imageurl};
+                                       $available_items->{$prefix}->{imageurl} = getitemtypeimagelocation( 'opac', $itemtypes{ $item->{itype} }->{imageurl} );
                 }
             }
         }    # notforloan, item level and biblioitem level
@@ -1500,7 +1496,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;
         }
@@ -1523,9 +1519,11 @@ 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
+        $oldbiblio->{'authorised_value_images'}  = C4::Items::get_authorised_value_images( C4::Biblio::get_biblio_authorised_values( $oldbiblio->{'biblionumber'} ) );
         push( @newresults, $oldbiblio );
     }
     return @newresults;
@@ -1623,10 +1621,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;
 
@@ -1672,20 +1674,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;
 
@@ -1811,7 +1822,7 @@ sub NZoperatorOR{
 }
 
 sub NZoperatorNOT{
-    my ($rightresult, $leftresult)=@_;
+    my ($leftresult, $rightresult)=@_;
     
     my @leftresult = split /;/, $leftresult;