X-Git-Url: http://koha-dev.rot13.org:8081/gitweb/?a=blobdiff_plain;f=C4%2FSearch.pm;h=a7aa0f716f3761a613c411c898e89cb99451c817;hb=1b08f924513daadaff1258659e17d5caf0a53ea4;hp=d4ce9fb00887ef4a7515159a623a346ad7507fb1;hpb=9c0b2e408b496b999cdbede92e651f3aef588209;p=koha_fer

diff --git a/C4/Search.pm b/C4/Search.pm
index d4ce9fb008..a7aa0f716f 100644
--- a/C4/Search.pm
+++ b/C4/Search.pm
@@ -36,7 +36,7 @@ use URI::Escape;
 use Business::ISBN;
 use MARC::Record;
 use MARC::Field;
-
+use utf8;
 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $DEBUG);
 
 # set the version for version checking
@@ -71,7 +71,7 @@ This module provides searching functions for Koha's bibliographic databases
   &AddSearchHistory
   &GetDistinctValues
   &enabled_staff_search_views
-  &SimpleSearch
+  &PurgeSearchHistory
 );
 
 # make all your functions, whether exported or not;
@@ -112,6 +112,7 @@ sub FindDuplicate {
             $titleindex = 'title|exact';
             $authorindex = 'author|exact';
             $op = '&&';
+            $QParser->custom_data->{'QueryAutoTruncate'} = C4::Context->preference('QueryAutoTruncate');
         } else {
             $titleindex = 'ti,ext';
             $authorindex = 'au,ext';
@@ -233,6 +234,9 @@ sub SimpleSearch {
 
     my $QParser;
     $QParser = C4::Context->queryparser if (C4::Context->preference('UseQueryParser') && ! ($query =~ m/\w,\w|\w=\w/));
+    if ($QParser) {
+        $QParser->custom_data->{'QueryAutoTruncate'} = C4::Context->preference('QueryAutoTruncate');
+    }
 
     # Initialize & Search Zebra
     for ( my $i = 0 ; $i < @servers ; $i++ ) {
@@ -484,7 +488,6 @@ sub getRecords {
                     # not an index scan
                     else {
                         $record = $results[ $i - 1 ]->record($j)->raw();
-                        utf8::decode( $record );
 
                         # warn "RECORD $j:".$record;
                         $results_hash->{'RECORDS'}[$j] = $record;
@@ -502,7 +505,6 @@ sub getRecords {
                         for ( my $j = 0 ; $j < $jmax ; $j++ ) {
                             my $render_record =
                               $results[ $i - 1 ]->record($j)->render();
-                            utf8::decode($render_record);
                             my @used_datas = ();
                             foreach my $tag ( @{ $facet->{tags} } ) {
 
@@ -716,7 +718,6 @@ sub pazGetRecords {
         for (my $i = 0; $i < $count; $i++) {
             # FIXME -- may need to worry about diacritics here
             my $rec = $paz->record($recid, $i);
-            utf8::decode( $rec );
             push @{ $result_group->{'RECORDS'} }, $rec;
         }
 
@@ -750,7 +751,7 @@ sub _remove_stopwords {
     my @stopwords_removed;
 
     # phrase and exact-qualified indexes shouldn't have stopwords removed
-    if ( $index !~ m/phr|ext/ ) {
+    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.
@@ -846,6 +847,7 @@ sub _build_weighted_query {
     my $stemming      = C4::Context->preference("QueryStemming")     || 0;
     my $weight_fields = C4::Context->preference("QueryWeightFields") || 0;
     my $fuzzy_enabled = C4::Context->preference("QueryFuzzy")        || 0;
+    $operand =~ s/"/ /g;    # Bug 7518: searches with quotation marks don't work
 
     my $weighted_query .= "(rk=(";    # Specifies that we're applying rank
 
@@ -890,8 +892,11 @@ sub _build_weighted_query {
         $weighted_query .= " $index,ext,r1=\"$operand\"";    # exact index
           #$weighted_query .= " or (title-sort-az=0 or $index,startswithnt,st-word,r3=$operand #)";
         $weighted_query .= " or $index,phr,r3=\"$operand\"";    # phrase index
-        $weighted_query .=
-          " or $index,rt,wrdl,r3=\"$operand\"";    # word list index
+        $weighted_query .= " or $index,wrdl,r6=\"$operand\"";    # word list index
+        $weighted_query .= " or $index,wrdl,fuzzy,r8=\"$operand\""
+          if $fuzzy_enabled;    # add fuzzy, word list
+        $weighted_query .= " or $index,wrdl,rt,r9=\"$stemmed_operand\""
+          if ( $stemming and $stemmed_operand );    # add stemming, right truncation
     }
 
     $weighted_query .= "))";                       # close rank specification
@@ -952,6 +957,7 @@ sub getIndexes{
                     'Corporate-name-heading',
                     'Corporate-name-see',
                     'Corporate-name-seealso',
+                    'Country-publication',
                     'ctype',
                     'date-entered-on-file',
                     'Date-of-acquisition',
@@ -981,6 +987,7 @@ sub getIndexes{
                     'Koha-Auth-Number',
                     'l-format',
                     'language',
+                    'language-original',
                     'lc-card',
                     'LC-card-number',
                     'lcn',
@@ -1177,12 +1184,16 @@ sub parseQuery {
 
     if ($QParser)
     {
+        $QParser->custom_data->{'QueryAutoTruncate'} = C4::Context->preference('QueryAutoTruncate');
         $query = '';
         for ( my $ii = 0 ; $ii <= @operands ; $ii++ ) {
             next unless $operands[$ii];
             $query .= $operators[ $ii - 1 ] eq 'or' ? ' || ' : ' && '
               if ($query);
-            if ( $indexes[$ii] =~ m/su-/ ) {
+            if ( $operands[$ii] =~ /^[^"]\W*[-|_\w]*:\w.*[^"]$/ ) {
+                $query .= $operands[$ii];
+            }
+            elsif ( $indexes[$ii] =~ m/su-/ ) {
                 $query .= $indexes[$ii] . '(' . $operands[$ii] . ')';
             }
             else {
@@ -1275,7 +1286,7 @@ sub buildQuery {
 
     my $cclq       = 0;
     my $cclindexes = getIndexes();
-    if ( $query !~ /\s*ccl=/ ) {
+    if ( $query !~ /\s*(ccl=|pqf=|cql=)/ ) {
         while ( !$cclq && $query =~ /(?:^|\W)([\w-]+)(,[\w-]+)*[:=]/g ) {
             my $dx = lc($1);
             $cclq = grep { lc($_) eq $dx } @$cclindexes;
@@ -1293,17 +1304,17 @@ sub buildQuery {
         if ( @limits ) {
             $q .= ' and '.join(' and ', @limits);
         }
-        return ( undef, $q, $q, "q=ccl=".uri_escape_utf8($q), $q, '', '', '', '', 'ccl' );
+        return ( undef, $q, $q, "q=ccl=".uri_escape($q), $q, '', '', '', '', 'ccl' );
     }
     if ( $query =~ /^cql=/ ) {
-        return ( undef, $', $', "q=cql=".uri_escape_utf8($'), $', '', '', '', '', 'cql' );
+        return ( undef, $', $', "q=cql=".uri_escape($'), $', '', '', '', '', 'cql' );
     }
     if ( $query =~ /^pqf=/ ) {
         if ($query_desc) {
-            $query_cgi = "q=".uri_escape_utf8($query_desc);
+            $query_cgi = "q=".uri_escape($query_desc);
         } else {
             $query_desc = $';
-            $query_cgi = "q=pqf=".uri_escape_utf8($');
+            $query_cgi = "q=pqf=".uri_escape($');
         }
         return ( undef, $', $', $query_cgi, $query_desc, '', '', '', '', 'pqf' );
     }
@@ -1381,7 +1392,7 @@ sub buildQuery {
 
                 # Set default structure attribute (word list)
                 my $struct_attr = q{};
-                unless ( $indexes_set || !$index || $index =~ /(st-|phr|ext|wrdl|nb|ns)/ ) {
+                unless ( $indexes_set || !$index || $index =~ /,(st-|phr|ext|wrdl)/ || $index =~ /^(nb|ns)$/ ) {
                     $struct_attr = ",wrdl";
                 }
 
@@ -1399,7 +1410,7 @@ sub buildQuery {
                 }
 
                 if ($auto_truncation){
-					unless ( $index =~ /(st-|phr|ext)/ ) {
+                        unless ( $index =~ /,(st-|phr|ext)/ ) {
 						#FIXME only valid with LTR scripts
 						$operand=join(" ",map{
 											(index($_,"*")>0?"$_":"$_*")
@@ -1475,9 +1486,9 @@ sub buildQuery {
                         $query     .= " $operators[$i-1] ";
                         $query     .= " $index_plus " unless $indexes_set;
                         $query     .= " $operand";
-                        $query_cgi .= "&op=".uri_escape_utf8($operators[$i-1]);
-                        $query_cgi .= "&idx=".uri_escape_utf8($index) if $index;
-                        $query_cgi .= "&q=".uri_escape_utf8($operands[$i]) if $operands[$i];
+                        $query_cgi .= "&op=".uri_escape($operators[$i-1]);
+                        $query_cgi .= "&idx=".uri_escape($index) if $index;
+                        $query_cgi .= "&q=".uri_escape($operands[$i]) if $operands[$i];
                         $query_desc .=
                           " $operators[$i-1] $index_plus $operands[$i]";
                     }
@@ -1487,8 +1498,8 @@ sub buildQuery {
                         $query      .= " and ";
                         $query      .= "$index_plus " unless $indexes_set;
                         $query      .= "$operand";
-                        $query_cgi  .= "&op=and&idx=".uri_escape_utf8($index) if $index;
-                        $query_cgi  .= "&q=".uri_escape_utf8($operands[$i]) if $operands[$i];
+                        $query_cgi  .= "&op=and&idx=".uri_escape($index) if $index;
+                        $query_cgi  .= "&q=".uri_escape($operands[$i]) if $operands[$i];
                         $query_desc .= " and $index_plus $operands[$i]";
                     }
                 }
@@ -1500,8 +1511,8 @@ sub buildQuery {
                     $query .= " $index_plus " unless $indexes_set;
                     $query .= $operand;
                     $query_desc .= " $index_plus $operands[$i]";
-                    $query_cgi  .= "&idx=".uri_escape_utf8($index) if $index;
-                    $query_cgi  .= "&q=".uri_escape_utf8($operands[$i]) if $operands[$i];
+                    $query_cgi  .= "&idx=".uri_escape($index) if $index;
+                    $query_cgi  .= "&q=".uri_escape($operands[$i]) if $operands[$i];
                     $previous_operand = 1;
                 }
             }    #/if $operands
@@ -1675,7 +1686,9 @@ sub searchResults {
     while ( ( my $column ) = $sth2->fetchrow ) {
         my ( $tagfield, $tagsubfield ) =
           &GetMarcFromKohaField( "items." . $column, "" );
-        $subfieldstosearch{$column} = $tagsubfield;
+        if ( defined $tagsubfield ) {
+            $subfieldstosearch{$column} = $tagsubfield;
+        }
     }
 
     # handle which records to actually retrieve
@@ -1693,7 +1706,12 @@ sub searchResults {
 
     # loop through all of the records we've retrieved
     for ( my $i = $offset ; $i <= $times - 1 ; $i++ ) {
-        my $marcrecord = MARC::File::USMARC::decode( $marcresults->[$i] );
+        my $marcrecord = eval { MARC::File::USMARC::decode( $marcresults->[$i] ); };
+        if ( $@ ) {
+            warn "ERROR DECODING RECORD - $@: " . $marcresults->[$i];
+            next;
+        }
+
         my $fw = $scan
              ? undef
              : $bibliotag < 10
@@ -1810,7 +1828,7 @@ sub searchResults {
         my $onloan_count          = 0;
         my $longoverdue_count     = 0;
         my $other_count           = 0;
-        my $wthdrawn_count        = 0;
+        my $withdrawn_count        = 0;
         my $itemlost_count        = 0;
         my $hideatopac_count      = 0;
         my $itembinding_count     = 0;
@@ -1897,7 +1915,7 @@ sub searchResults {
                 # is item on the reserve shelf?
                 my $reservestatus = '';
 
-                unless ($item->{wthdrawn}
+                unless ($item->{withdrawn}
                         || $item->{itemlost}
                         || $item->{damaged}
                         || $item->{notforloan}
@@ -1920,42 +1938,36 @@ sub searchResults {
                 }
 
                 # item is withdrawn, lost, damaged, not for loan, reserved or in transit
-                if (   $item->{wthdrawn}
+                if (   $item->{withdrawn}
                     || $item->{itemlost}
                     || $item->{damaged}
                     || $item->{notforloan}
                     || $reservestatus eq 'Waiting'
                     || ($transfertwhen ne ''))
                 {
-                    $wthdrawn_count++        if $item->{wthdrawn};
+                    $withdrawn_count++        if $item->{withdrawn};
                     $itemlost_count++        if $item->{itemlost};
                     $itemdamaged_count++     if $item->{damaged};
                     $item_in_transit_count++ if $transfertwhen ne '';
                     $item_onhold_count++     if $reservestatus eq 'Waiting';
-                    $item->{status} = $item->{wthdrawn} . "-" . $item->{itemlost} . "-" . $item->{damaged} . "-" . $item->{notforloan};
-
-                    # can place hold on item ?
-                    if ( !$item->{itemlost} ) {
-                        if ( !$item->{wthdrawn} ){
-                            if ( $item->{damaged} ){
-                                if ( C4::Context->preference('AllowHoldsOnDamagedItems') ){
-                                    # can place a hold on a damaged item if AllowHoldsOnDamagedItems is true
-                                    if ( ( !$item->{notforloan} || $item->{notforloan} < 0 ) ){
-                                        # item is either for loan or has notforloan < 0
-                                        $can_place_holds = 1;
-                                    }
-                                }
-                            } elsif ( $item->{notforloan} < 0 ) {
-                                # item is not damaged and notforloan is < 0
-                                $can_place_holds = 1;
-                            }
-                        }
-                    }
+                    $item->{status} = $item->{withdrawn} . "-" . $item->{itemlost} . "-" . $item->{damaged} . "-" . $item->{notforloan};
+
+                    # can place a hold on a item if
+                    # not lost nor withdrawn
+                    # not damaged unless AllowHoldsOnDamagedItems is true
+                    # item is either for loan or on order (notforloan < 0)
+                    $can_place_holds = 1
+                      if (
+                           !$item->{itemlost}
+                        && !$item->{withdrawn}
+                        && ( !$item->{damaged} || C4::Context->preference('AllowHoldsOnDamagedItems') )
+                        && ( !$item->{notforloan} || $item->{notforloan} < 0 )
+                      );
 
                     $other_count++;
 
                     my $key = $prefix . $item->{status};
-                    foreach (qw(wthdrawn itemlost damaged branchname itemcallnumber)) {
+                    foreach (qw(withdrawn itemlost damaged branchname itemcallnumber)) {
                         $other_items->{$key}->{$_} = $item->{$_};
                     }
                     $other_items->{$key}->{intransit} = ( $transfertwhen ne '' ) ? 1 : 0;
@@ -2027,7 +2039,7 @@ sub searchResults {
         $oldbiblio->{onloanplural}         = 1 if $onloan_count > 1;
         $oldbiblio->{othercount}           = $other_count;
         $oldbiblio->{otherplural}          = 1 if $other_count > 1;
-        $oldbiblio->{wthdrawncount}        = $wthdrawn_count;
+        $oldbiblio->{withdrawncount}        = $withdrawn_count;
         $oldbiblio->{itemlostcount}        = $itemlost_count;
         $oldbiblio->{damagedcount}         = $itemdamaged_count;
         $oldbiblio->{intransitcount}       = $item_in_transit_count;
@@ -2212,6 +2224,13 @@ sub GetSearchHistory{
     return  $sth->fetchall_hashref({});
 }
 
+sub PurgeSearchHistory{
+    my ($pSearchhistory)=@_;
+    my $dbh = C4::Context->dbh;
+    my $sth = $dbh->prepare("DELETE FROM search_history WHERE time < DATE_SUB( NOW(), INTERVAL ? DAY )");
+    $sth->execute($pSearchhistory) or die $dbh->errstr;
+}
+
 =head2 z3950_search_args
 
 $arrayref = z3950_search_args($matchpoints)
@@ -2257,11 +2276,18 @@ $template->param ( MYLOOP => C4::Search::z3950_search_args($searchscalar) )
 
 sub z3950_search_args {
     my $bibrec = shift;
-    my $isbn = Business::ISBN->new($bibrec);
+
+    my $isbn_string = ref( $bibrec ) ? $bibrec->{title} : $bibrec;
+    my $isbn = Business::ISBN->new( $isbn_string );
 
     if (defined $isbn && $isbn->is_valid)
     {
-        $bibrec = { isbn => $bibrec } if !ref $bibrec;
+        if ( ref($bibrec) ) {
+            $bibrec->{isbn} = $isbn_string;
+            $bibrec->{title} = undef;
+        } else {
+            $bibrec = { isbn => $isbn_string };
+        }
     }
     else {
         $bibrec = { title => $bibrec } if !ref $bibrec;