Bug 12508: adding an error message if a contract cannot be removed
[koha_fer] / C4 / Search.pm
index c9f2560..1b5c6fa 100644 (file)
@@ -68,7 +68,6 @@ This module provides searching functions for Koha's bibliographic databases
   &searchResults
   &getRecords
   &buildQuery
-  &AddSearchHistory
   &GetDistinctValues
   &enabled_staff_search_views
   &PurgeSearchHistory
@@ -144,8 +143,11 @@ sub FindDuplicate {
     my @results;
     if (!defined $error) {
         foreach my $possible_duplicate_record (@{$searchresults}) {
-            my $marcrecord =
-            MARC::Record->new_from_usmarc($possible_duplicate_record);
+            my $marcrecord = new_record_from_zebra(
+                'biblioserver',
+                $possible_duplicate_record
+            );
+
             my $result = TransformMarcToKoha( $dbh, $marcrecord, '' );
 
             # FIXME :: why 2 $biblionumber ?
@@ -289,10 +291,11 @@ sub SimpleSearch {
             }
 
             for my $j ( $first_record .. $last_record ) {
-                my $record =
+                my $record = eval {
                   $tmpresults[ $i - 1 ]->record( $j - 1 )->raw()
                   ;    # 0 indexed
-                push @{$results}, $record;
+                };
+                push @{$results}, $record if defined $record;
             }
         }
     );
@@ -422,7 +425,7 @@ sub getRecords {
                 warn "Ignoring unrecognized sort '$sort' requested" if $sort_by;
             }
         }
-        if ($sort_by && !$scan) {
+        if ( $sort_by && !$scan && $results[$i] ) {
             if ( $results[$i]->sort( "yaz", $sort_by ) < 0 ) {
                 warn "WARNING sort $sort_by failed";
             }
@@ -446,13 +449,14 @@ sub getRecords {
                 else {
                     $times = $size;
                 }
+
                 for ( my $j = $offset ; $j < $times ; $j++ ) {
                     my $records_hash;
                     my $record;
 
                     ## Check if it's an index scan
                     if ($scan) {
-                        my ( $term, $occ ) = $results[ $i - 1 ]->term($j);
+                        my ( $term, $occ ) = $results[ $i - 1 ]->display_term($j);
 
                  # here we create a minimal MARC record and hand it off to the
                  # template just like a normal result ... perhaps not ideal, but
@@ -488,7 +492,6 @@ sub getRecords {
                     # not an index scan
                     else {
                         $record = $results[ $i - 1 ]->record($j)->raw();
-
                         # warn "RECORD $j:".$record;
                         $results_hash->{'RECORDS'}[$j] = $record;
                     }
@@ -503,39 +506,37 @@ sub getRecords {
                       $size > $facets_maxrecs ? $facets_maxrecs : $size;
                     for my $facet (@$facets) {
                         for ( my $j = 0 ; $j < $jmax ; $j++ ) {
-                            my $render_record =
-                              $results[ $i - 1 ]->record($j)->render();
+
+                            my $marc_record = new_record_from_zebra (
+                                    'biblioserver',
+                                    $results[ $i - 1 ]->record($j)->raw()
+                            );
+
+                            if ( ! defined $marc_record ) {
+                                warn "ERROR DECODING RECORD - $@: " .
+                                    $results[ $i - 1 ]->record($j)->raw();
+                                next;
+                            }
+
                             my @used_datas = ();
+
                             foreach my $tag ( @{ $facet->{tags} } ) {
 
                                 # avoid first line
                                 my $tag_num = substr( $tag, 0, 3 );
-                                my $letters = substr( $tag, 3 );
-                                my $field_pattern =
-                                  '\n' . $tag_num . ' ([^z][^\n]+)';
-                                $field_pattern = '\n' . $tag_num . ' ([^\n]+)'
-                                  if ( int($tag_num) < 10 );
-                                my @field_tokens =
-                                  ( $render_record =~ /$field_pattern/g );
-                                foreach my $field_token (@field_tokens) {
-                                    my @subf = ( $field_token =~
-                                          /\$([a-zA-Z0-9]) ([^\$]+)/g );
-                                    my @values;
-                                    for ( my $i = 0 ; $i < @subf ; $i += 2 ) {
-                                        if ( $letters =~ $subf[$i] ) {
-                                            my $value = $subf[ $i + 1 ];
-                                            $value =~ s/^ *//;
-                                            $value =~ s/ *$//;
-                                            push @values, $value;
-                                        }
-                                    }
-                                    my $data = join( $facet->{sep}, @values );
-                                    unless ( $data ~~ @used_datas ) {
-                                        $facets_counter->{ $facet->{idx} }
-                                          ->{$data}++;
+                                my $subfield_letters = substr( $tag, 3 );
+                                # Removed when as_string fixed
+                                my @subfields = $subfield_letters =~ /./sg;
+
+                                my @fields = $marc_record->field($tag_num);
+                                foreach my $field (@fields) {
+                                    my $data = $field->as_string( $subfield_letters, $facet->{sep} );
+
+                                    unless ( grep { /^$data$/ } @used_datas ) {
                                         push @used_datas, $data;
+                                        $facets_counter->{ $facet->{idx} }->{$data}++;
                                     }
-                                }    # fields
+                                } # fields
                             }    # field codes
                         }    # records
                         $facets_info->{ $facet->{idx} }->{label_value} =
@@ -567,7 +568,7 @@ sub getRecords {
                           )
                         {
                             $number_of_facets++;
-                            if (   ( $number_of_facets < 6 )
+                            if (   ( $number_of_facets <= 5 )
                                 || ( $expanded_facet eq $link_value )
                                 || ( $facets_info->{$link_value}->{'expanded'} )
                               )
@@ -644,7 +645,7 @@ sub getRecords {
                         # handle expanded option
                         unless ( $facets_info->{$link_value}->{'expanded'} ) {
                             $expandable = 1
-                              if ( ( $number_of_facets > 6 )
+                              if ( ( $number_of_facets > 5 )
                                 && ( $expanded_facet ne $link_value ) );
                         }
                         push @facets_loop,
@@ -847,6 +848,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
 
@@ -856,6 +858,7 @@ sub _build_weighted_query {
           "Title-cover,ext,r1=\"$operand\"";    # exact title-cover
         $weighted_query .= " or ti,ext,r2=\"$operand\"";    # exact title
         $weighted_query .= " or Title-cover,phr,r3=\"$operand\"";    # phrase title
+        $weighted_query .= " or ti,wrdl,r4=\"$operand\"";    # words in title
           #$weighted_query .= " or any,ext,r4=$operand";               # exact any
           #$weighted_query .=" or kw,wrdl,r5=\"$operand\"";            # word list any
         $weighted_query .= " or wrdl,fuzzy,r8=\"$operand\""
@@ -958,10 +961,12 @@ sub getIndexes{
                     'Corporate-name-seealso',
                     'Country-publication',
                     'ctype',
+                    'curriculum',
                     'date-entered-on-file',
                     'Date-of-acquisition',
                     'Date-of-publication',
                     'Dewey-classification',
+                    'Dissertation-information',
                     'EAN',
                     'extent',
                     'fic',
@@ -977,6 +982,8 @@ sub getIndexes{
                     'Host-item',
                     'id-other',
                     'Illustration-code',
+                    'Index-term-genre',
+                    'Index-term-uncontrolled',
                     'ISBN',
                     'isbn',
                     'ISSN',
@@ -986,11 +993,15 @@ sub getIndexes{
                     'Koha-Auth-Number',
                     'l-format',
                     'language',
+                    'language-original',
                     'lc-card',
                     'LC-card-number',
                     'lcn',
+                    'lex',
                     'llength',
                     'ln',
+                    'ln-audio',
+                    'ln-subtitle',
                     'Local-classification',
                     'Local-number',
                     'Match-heading',
@@ -1042,7 +1053,6 @@ sub getIndexes{
                     'su-to',
                     'su-ut',
                     'ut',
-                    'UPC',
                     'Term-genre-form',
                     'Term-genre-form-heading',
                     'Term-genre-form-see',
@@ -1051,7 +1061,6 @@ sub getIndexes{
                     'Title',
                     'Title-cover',
                     'Title-series',
-                    'Title-host',
                     'Title-uniform',
                     'Title-uniform-heading',
                     'Title-uniform-see',
@@ -1086,6 +1095,7 @@ sub getIndexes{
                     'mc-itype',
                     'mc-loc',
                     'notforloan',
+                    'Number-local-acquisition',
                     'onloan',
                     'price',
                     'renewals',
@@ -1188,7 +1198,10 @@ sub parseQuery {
             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 {
@@ -1281,7 +1294,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;
@@ -1473,43 +1486,19 @@ sub buildQuery {
 
                 warn "FIELD WEIGHTED OPERAND: >$weighted_operand<" if $DEBUG;
 
-                # If there's a previous operand, we need to add an operator
-                if ($previous_operand) {
-
-                    # User-specified operator
-                    if ( $operators[ $i - 1 ] ) {
-                        $query     .= " $operators[$i-1] ";
-                        $query     .= " $index_plus " unless $indexes_set;
-                        $query     .= " $operand";
-                        $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]";
-                    }
-
-                    # Default operator is and
-                    else {
-                        $query      .= " and ";
-                        $query      .= "$index_plus " unless $indexes_set;
-                        $query      .= "$operand";
-                        $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]";
-                    }
-                }
-
-                # There isn't a pervious operand, don't need an operator
-                else {
+                ($query,$query_cgi,$query_desc,$previous_operand) = _build_initial_query({
+                    query => $query,
+                    query_cgi => $query_cgi,
+                    query_desc => $query_desc,
+                    operator => ($operators[ $i - 1 ]) ? $operators[ $i - 1 ] : '',
+                    parsed_operand => $operand,
+                    original_operand => ($operands[$i]) ? $operands[$i] : '',
+                    index => $index,
+                    index_plus => $index_plus,
+                    indexes_set => $indexes_set,
+                    previous_operand => $previous_operand,
+                });
 
-                    # Field-weighted queries already have indexes set
-                    $query .= " $index_plus " unless $indexes_set;
-                    $query .= $operand;
-                    $query_desc .= " $index_plus $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
         }    # /for
     }
@@ -1544,7 +1533,7 @@ sub buildQuery {
             $group_OR_limits{$k} .= " or " if $group_OR_limits{$k};
             $limit_desc      .= " or " if $group_OR_limits{$k};
             $group_OR_limits{$k} .= "$this_limit";
-            $limit_cgi       .= "&limit=$this_limit";
+            $limit_cgi       .= "&limit=" . uri_escape($this_limit);
             $limit_desc      .= " $this_limit";
         }
 
@@ -1552,7 +1541,7 @@ sub buildQuery {
         else {
             $limit .= " and " if $limit || $query;
             $limit      .= "$this_limit";
-            $limit_cgi  .= "&limit=$this_limit";
+            $limit_cgi  .= "&limit=" . uri_escape($this_limit);
             if ($this_limit =~ /^branch:(.+)/) {
                 my $branchcode = $1;
                 my $branchname = GetBranchName($branchcode);
@@ -1614,6 +1603,42 @@ sub buildQuery {
     );
 }
 
+=head2 _build_initial_query
+
+  ($query, $query_cgi, $query_desc, $previous_operand) = _build_initial_query($initial_query_params);
+
+  Build a section of the initial query containing indexes, operators, and operands.
+
+=cut
+
+sub _build_initial_query {
+    my ($params) = @_;
+
+    my $operator = "";
+    if ($params->{previous_operand}){
+        #If there is a previous operand, add a supplied operator or the default 'and'
+        $operator = ($params->{operator}) ? " ".($params->{operator})." " : ' and ';
+    }
+
+    #NOTE: indexes_set is typically set when doing truncation or field weighting
+    my $operand = ($params->{indexes_set}) ? $params->{parsed_operand} : $params->{index_plus}.$params->{parsed_operand};
+
+    #e.g. "kw,wrdl:test"
+    #e.g. " and kw,wrdl:test"
+    $params->{query} .= $operator . $operand;
+
+    $params->{query_cgi} .= "&op=".uri_escape($operator) if $operator;
+    $params->{query_cgi} .= "&idx=".uri_escape($params->{index}) if $params->{index};
+    $params->{query_cgi} .= "&q=".uri_escape($params->{original_operand}) if $params->{original_operand};
+
+    #e.g. " and kw,wrdl: test"
+    $params->{query_desc} .= $operator . $params->{index_plus} . " " . $params->{original_operand};
+
+    $params->{previous_operand} = 1 unless $params->{previous_operand}; #If there is no previous operand, mark this as one
+
+    return ($params->{query}, $params->{query_cgi}, $params->{query_desc}, $params->{previous_operand});
+}
+
 =head2 searchResults
 
   my @search_results = searchResults($search_context, $searchdesc, $hits, 
@@ -1681,7 +1706,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,16 +1720,28 @@ sub searchResults {
         $times = $hits;         # FIXME: if $hits is undefined, why do we want to equal it?
     }
 
-       my $marcflavour = C4::Context->preference("marcflavour");
+    my $marcflavour = C4::Context->preference("marcflavour");
     # We get the biblionumber position in MARC
     my ($bibliotag,$bibliosubf)=GetMarcFromKohaField('biblio.biblionumber','');
 
     # loop through all of the records we've retrieved
     for ( my $i = $offset ; $i <= $times - 1 ; $i++ ) {
-        my $marcrecord = eval { MARC::File::USMARC::decode( $marcresults->[$i] ); };
-        if ( $@ ) {
-            warn "ERROR DECODING RECORD - $@: " . $marcresults->[$i];
-            next;
+
+        my $marcrecord;
+        if ($scan) {
+            # For Scan searches we built USMARC data
+            $marcrecord = MARC::Record->new_from_usmarc( $marcresults->[$i]);
+        } else {
+            # Normal search, render from Zebra's output
+            $marcrecord = new_record_from_zebra(
+                'biblioserver',
+                $marcresults->[$i]
+            );
+
+            if ( ! defined $marcrecord ) {
+                warn "ERROR DECODING RECORD - $@: " . $marcresults->[$i];
+                next;
+            }
         }
 
         my $fw = $scan
@@ -1829,6 +1868,7 @@ sub searchResults {
         my $item_in_transit_count = 0;
         my $can_place_holds       = 0;
         my $item_onhold_count     = 0;
+        my $notforloan_count      = 0;
         my $items_count           = scalar(@fields);
         my $maxitems_pref = C4::Context->preference('maxItemsinSearchResults');
         my $maxitems = $maxitems_pref ? $maxitems_pref - 1 : 1;
@@ -1899,6 +1939,8 @@ sub searchResults {
                 # item is on order
                 if ( $item->{notforloan} < 0 ) {
                     $ordered_count++;
+                } elsif ( $item->{notforloan} > 0 ) {
+                    $notforloan_count++;
                 }
 
                 # is item in transit?
@@ -2038,6 +2080,7 @@ sub searchResults {
         $oldbiblio->{intransitcount}       = $item_in_transit_count;
         $oldbiblio->{onholdcount}          = $item_onhold_count;
         $oldbiblio->{orderedcount}         = $ordered_count;
+        $oldbiblio->{notforloancount}      = $notforloan_count;
 
         if (C4::Context->preference("AlternateHoldingsField") && $items_count == 0) {
             my $fieldspec = C4::Context->preference("AlternateHoldingsField");
@@ -2195,28 +2238,6 @@ sub enabled_staff_search_views
        );
 }
 
-sub AddSearchHistory{
-       my ($borrowernumber,$session,$query_desc,$query_cgi, $total)=@_;
-    my $dbh = C4::Context->dbh;
-
-    # Add the request the user just made
-    my $sql = "INSERT INTO search_history(userid, sessionid, query_desc, query_cgi, total, time) VALUES(?, ?, ?, ?, ?, NOW())";
-    my $sth   = $dbh->prepare($sql);
-    $sth->execute($borrowernumber, $session, $query_desc, $query_cgi, $total);
-       return $dbh->last_insert_id(undef, 'search_history', undef,undef,undef);
-}
-
-sub GetSearchHistory{
-       my ($borrowernumber,$session)=@_;
-    my $dbh = C4::Context->dbh;
-
-    # Add the request the user just made
-    my $query = "SELECT FROM search_history WHERE (userid=? OR sessionid=?)";
-    my $sth   = $dbh->prepare($query);
-       $sth->execute($borrowernumber, $session);
-    return  $sth->fetchall_hashref({});
-}
-
 sub PurgeSearchHistory{
     my ($pSearchhistory)=@_;
     my $dbh = C4::Context->dbh;
@@ -2230,7 +2251,7 @@ $arrayref = z3950_search_args($matchpoints)
 
 This function returns an array reference that contains the search parameters to be
 passed to the Z39.50 search script (z3950_search.pl). The array elements
-are hash refs whose keys are name, value and encvalue, and whose values are the
+are hash refs whose keys are name and value, and whose values are the
 name of a search parameter, the value of that search parameter and the URL encoded
 value of that parameter.
 
@@ -2241,7 +2262,7 @@ data is in a hash reference in $matchpoints, as returned by Biblio::GetBiblioDat
 
 If $matchpoints is a scalar, it is assumed to be an unnamed query descriptor, e.g.
 a general purpose search argument. In this case, the returned array contains only
-entry: the key is 'title' and the value and encvalue are derived from $matchpoints.
+entry: the key is 'title' and the value is derived from $matchpoints.
 
 If a search parameter value is undefined or empty, it is not included in the returned
 array.
@@ -2269,11 +2290,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;
@@ -2281,8 +2309,8 @@ sub z3950_search_args {
     my $array = [];
     for my $field (qw/ lccn isbn issn title author dewey subject /)
     {
-        my $encvalue = URI::Escape::uri_escape_utf8($bibrec->{$field});
-        push @$array, { name=>$field, value=>$bibrec->{$field}, encvalue=>$encvalue } if defined $bibrec->{$field};
+        push @$array, { name => $field, value => $bibrec->{$field} }
+          if defined $bibrec->{$field};
     }
     return $array;
 }
@@ -2365,6 +2393,43 @@ sub _ZOOM_event_loop {
     }
 }
 
+=head2 new_record_from_zebra
+
+Given raw data from a Zebra result set, return a MARC::Record object
+
+This helper function is needed to take into account all the involved
+system preferences and configuration variables to properly create the
+MARC::Record object.
+
+If we are using GRS-1, then the raw data we get from Zebra should be USMARC
+data. If we are using DOM, then it has to be MARCXML.
+
+=cut
+
+sub new_record_from_zebra {
+
+    my $server   = shift;
+    my $raw_data = shift;
+    # Set the default indexing modes
+    my $index_mode = ( $server eq 'biblioserver' )
+                        ? C4::Context->config('zebra_bib_index_mode') // 'grs1'
+                        : C4::Context->config('zebra_auth_index_mode') // 'dom';
+
+    my $marc_record =  eval {
+        if ( $index_mode eq 'dom' ) {
+            MARC::Record->new_from_xml( $raw_data, 'UTF-8' );
+        } else {
+            MARC::Record->new_from_usmarc( $raw_data );
+        }
+    };
+
+    if ($@) {
+        return;
+    } else {
+        return $marc_record;
+    }
+
+}
 
 END { }    # module clean-up code here (global destructor)