Merge remote-tracking branch 'origin/new/bug_8597'
[koha.git] / C4 / Search.pm
index ee7d8d9..2b78f75 100644 (file)
@@ -34,6 +34,8 @@ use C4::Charset;
 use YAML;
 use URI::Escape;
 use Business::ISBN;
+use MARC::Record;
+use MARC::Field;
 
 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $DEBUG);
 
@@ -248,7 +250,7 @@ sub SimpleSearch {
                   . $@->code() . ") "
                   . $@->addinfo() . " "
                   . $@->diagset();
-                warn $error;
+                warn $error." for query: $query";
                 return ( $error, undef, undef );
             }
         }
@@ -287,7 +289,7 @@ sub SimpleSearch {
 ( undef, $results_hashref, \@facets_loop ) = getRecords (
 
         $koha_query,       $simple_query, $sort_by_ref,    $servers_ref,
-        $results_per_page, $offset,       $expanded_facet, $branches,
+        $results_per_page, $offset,       $expanded_facet, $branches,$itemtypes,
         $query_type,       $scan
     );
 
@@ -301,7 +303,7 @@ See verbse embedded documentation.
 sub getRecords {
     my (
         $koha_query,       $simple_query, $sort_by_ref,    $servers_ref,
-        $results_per_page, $offset,       $expanded_facet, $branches,
+        $results_per_page, $offset,       $expanded_facet, $branches,$itemtypes,
         $query_type,       $scan
     ) = @_;
 
@@ -477,7 +479,8 @@ sub getRecords {
                                 # avoid first line
                                 my $tag_num = substr($tag, 0, 3);
                                 my $letters = substr($tag, 3);
-                                my $field_pattern = '\n' . $tag_num . ' ([^\n]+)';
+                                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 );
@@ -555,6 +558,17 @@ sub getRecords {
                                                                        $facet_label_value = "*";
                                                                }
                             }
+                            # if it's a itemtype, label by the name, not the code,
+                            if ( $link_value =~ /itype/ ) {
+                                if (defined $itemtypes
+                                    && ref($itemtypes) eq "HASH"
+                                    && defined $itemtypes->{$one_facet}
+                                    && ref ($itemtypes->{$one_facet}) eq "HASH")
+                                {
+                                    $facet_label_value =
+                                        $itemtypes->{$one_facet}->{'description'};
+                                }
+                            }
 
                             # but we're down with the whole label being in the link's title.
                             push @this_facets_array, {
@@ -721,7 +735,7 @@ sub _detect_truncation {
 sub _build_stemmed_operand {
     my ($operand,$lang) = @_;
     require Lingua::Stem::Snowball ;
-    my $stemmed_operand;
+    my $stemmed_operand=q{};
 
     # 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
@@ -1017,6 +1031,104 @@ sub getIndexes{
     return \@indexes;
 }
 
+=head2 _handle_exploding_index
+
+    my $query = _handle_exploding_index($index, $term)
+
+Callback routine to generate the search for "exploding" indexes (i.e.
+those indexes which are turned into multiple or-connected searches based
+on authority data).
+
+=cut
+
+sub _handle_exploding_index {
+    my ( $index, $term ) = @_;
+
+    return unless ($index =~ m/(su-br|su-na|su-rl)/ && $term);
+
+    my $marcflavour = C4::Context->preference('marcflavour');
+
+    my $codesubfield = $marcflavour eq 'UNIMARC' ? '5' : 'w';
+    my $wantedcodes = '';
+    my @subqueries = ( "(su=\"$term\")");
+    my ($error, $results, $total_hits) = SimpleSearch( "Heading,wrdl=$term", undef, undef, [ "authorityserver" ] );
+    foreach my $auth (@$results) {
+        my $record = MARC::Record->new_from_usmarc($auth);
+        my @references = $record->field('5..');
+        if (@references) {
+            if ($index eq 'su-br') {
+                $wantedcodes = 'g';
+            } elsif ($index eq 'su-na') {
+                $wantedcodes = 'h';
+            } elsif ($index eq 'su-rl') {
+                $wantedcodes = '';
+            }
+            foreach my $reference (@references) {
+                my $codes = $reference->subfield($codesubfield);
+                push @subqueries, '(su="' . $reference->as_string('abcdefghijlmnopqrstuvxyz') . '")' if (($codes && $codes eq $wantedcodes) || !$wantedcodes);
+            }
+        }
+    }
+    return join(' or ', @subqueries);
+}
+
+=head2 parseQuery
+
+    ( $operators, $operands, $indexes, $limits,
+      $sort_by, $scan, $lang ) =
+            buildQuery ( $operators, $operands, $indexes, $limits, $sort_by, $scan, $lang);
+
+Shim function to ease the transition from buildQuery to a new QueryParser.
+This function is called at the beginning of buildQuery, and modifies
+buildQuery's input. If it can handle the input, it returns a query that
+buildQuery will not try to parse.
+=cut
+
+sub parseQuery {
+    my ( $operators, $operands, $indexes, $limits, $sort_by, $scan, $lang) = @_;
+
+    my @operators = $operators ? @$operators : ();
+    my @indexes   = $indexes   ? @$indexes   : ();
+    my @operands  = $operands  ? @$operands  : ();
+    my @limits    = $limits    ? @$limits    : ();
+    my @sort_by   = $sort_by   ? @$sort_by   : ();
+
+    my $query = $operands[0];
+    my $index;
+    my $term;
+
+# TODO: once we are using QueryParser, all this special case code for
+#       exploded search indexes will be replaced by a callback to
+#       _handle_exploding_index
+    if ( $query =~ m/^(.*)\b(su-br|su-na|su-rl)[:=](\w.*)$/ ) {
+        $query = $1;
+        $index = $2;
+        $term  = $3;
+    } else {
+        $query = '';
+        for ( my $i = 0 ; $i <= @operands ; $i++ ) {
+            if ($operands[$i] && $indexes[$i] =~ m/(su-br|su-na|su-rl)/) {
+                $index = $indexes[$i];
+                $term = $operands[$i];
+            } elsif ($operands[$i]) {
+                $query .= $operators[$i] eq 'or' ? ' or ' : ' and ' if ($query);
+                $query .= "($indexes[$i]:$operands[$i])";
+            }
+        }
+    }
+
+    if ($index) {
+        my $queryPart = _handle_exploding_index($index, $term);
+        if ($queryPart) {
+            $query .= "($queryPart)";
+        }
+        $operators = ();
+        $operands[0] = "ccl=$query";
+    }
+
+    return ( $operators, \@operands, $indexes, $limits, $sort_by, $scan, $lang);
+}
+
 =head2 buildQuery
 
 ( $error, $query,
@@ -1038,6 +1150,8 @@ sub buildQuery {
 
     warn "---------\nEnter buildQuery\n---------" if $DEBUG;
 
+    ( $operators, $operands, $indexes, $limits, $sort_by, $scan, $lang) = parseQuery($operators, $operands, $indexes, $limits, $sort_by, $scan, $lang);
+
     # dereference
     my @operators = $operators ? @$operators : ();
     my @indexes   = $indexes   ? @$indexes   : ();
@@ -1089,7 +1203,8 @@ sub buildQuery {
         my $q=$';
         # This is needed otherwise ccl= and &limit won't work together, and
         # this happens when selecting a subject on the opac-detail page
-        if (@limits) {
+        @limits = grep {!/^$/} @limits;
+        if ( @limits ) {
             $q .= ' and '.join(' and ', @limits);
         }
         return ( undef, $q, $q, "q=ccl=$q", $q, '', '', '', '', 'ccl' );
@@ -1306,6 +1421,7 @@ sub buildQuery {
     my %group_OR_limits;
     my $availability_limit;
     foreach my $this_limit (@limits) {
+        next unless $this_limit;
         if ( $this_limit =~ /available/ ) {
 #
 ## 'available' is defined as (items.onloan is NULL) and (items.itemlost = 0)
@@ -1404,7 +1520,7 @@ sub buildQuery {
 
   my @search_results = searchResults($search_context, $searchdesc, $hits, 
                                      $results_per_page, $offset, $scan, 
-                                     @marcresults, $hidelostitems);
+                                     @marcresults);
 
 Format results in a form suitable for passing to the template
 
@@ -1458,12 +1574,7 @@ sub searchResults {
     }
 
     #search item field code
-    my $sth =
-      $dbh->prepare(
-"SELECT tagfield FROM marc_subfield_structure WHERE kohafield LIKE 'items.itemnumber'"
-      );
-    $sth->execute;
-    my ($itemtag) = $sth->fetchrow;
+    my ($itemtag, undef) = &GetMarcFromKohaField( "items.itemnumber", "" );
 
     ## find column names of items related to MARC
     my $sth2 = $dbh->prepare("SHOW COLUMNS FROM items");
@@ -1618,9 +1729,9 @@ sub searchResults {
         my $items_count           = scalar(@fields);
         my $maxitems_pref = C4::Context->preference('maxItemsinSearchResults');
         my $maxitems = $maxitems_pref ? $maxitems_pref - 1 : 1;
+        my @hiddenitems; # hidden itemnumbers based on OpacHiddenItems syspref
 
         # loop through every item
-             my @hiddenitems;
         foreach my $field (@fields) {
             my $item;
 
@@ -1630,11 +1741,20 @@ sub searchResults {
             }
             $item->{description} = $itemtypes{ $item->{itype} }{description};
 
-               # Hidden items
+               # OPAC hidden items
             if ($is_opac) {
+                # hidden because lost
+                if ($hidelostitems && $item->{itemlost}) {
+                    $hideatopac_count++;
+                    next;
+                }
+                # hidden based on OpacHiddenItems syspref
                 my @hi = C4::Items::GetHiddenItemnumbers($item);
-                $item->{'hideatopac'} = @hi;
-                push @hiddenitems, @hi;
+                if (scalar @hi) {
+                    push @hiddenitems, @hi;
+                    $hideatopac_count++;
+                    next;
+                }
             }
 
             my $hbranch     = C4::Context->preference('HomeOrHoldingBranch') eq 'homebranch' ? 'homebranch'    : 'holdingbranch';
@@ -1713,14 +1833,12 @@ sub searchResults {
                     || $item->{itemlost}
                     || $item->{damaged}
                     || $item->{notforloan} > 0
-                    || $item->{hideatopac}
                    || $reservestatus eq 'Waiting'
                     || ($transfertwhen ne ''))
                 {
                     $wthdrawn_count++        if $item->{wthdrawn};
                     $itemlost_count++        if $item->{itemlost};
                     $itemdamaged_count++     if $item->{damaged};
-                    $hideatopac_count++      if $item->{hideatopac};
                     $item_in_transit_count++ if $transfertwhen ne '';
                    $item_onhold_count++     if $reservestatus eq 'Waiting';
                     $item->{status} = $item->{wthdrawn} . "-" . $item->{itemlost} . "-" . $item->{damaged} . "-" . $item->{notforloan};
@@ -1736,7 +1854,7 @@ sub searchResults {
                     $other_count++;
 
                     my $key = $prefix . $item->{status};
-                    foreach (qw(wthdrawn itemlost damaged branchname itemcallnumber hideatopac)) {
+                    foreach (qw(wthdrawn itemlost damaged branchname itemcallnumber)) {
                         $other_items->{$key}->{$_} = $item->{$_};
                     }
                     $other_items->{$key}->{intransit} = ( $transfertwhen ne '' ) ? 1 : 0;
@@ -1752,7 +1870,7 @@ sub searchResults {
                     $can_place_holds = 1;
                     $available_count++;
                                        $available_items->{$prefix}->{count}++ if $item->{$hbranch};
-                                       foreach (qw(branchname itemcallnumber hideatopac description)) {
+                                       foreach (qw(branchname itemcallnumber description)) {
                        $available_items->{$prefix}->{$_} = $item->{$_};
                                        }
                                        $available_items->{$prefix}->{location} = $shelflocations->{ $item->{location} };
@@ -1760,10 +1878,12 @@ sub searchResults {
                 }
             }
         }    # notforloan, item level and biblioitem level
-       if ($items_count > 0) {
-        next if $is_opac       && $hideatopac_count >= $items_count;
-        next if $hidelostitems && $itemlost_count   >= $items_count;
-       }
+
+        # if all items are hidden, do not show the record
+        if ($items_count > 0 && $hideatopac_count == $items_count) {
+            next;
+        }
+
         my ( $availableitemscount, $onloanitemscount, $otheritemscount );
         for my $key ( sort keys %$onloan_items ) {
             (++$onloanitemscount > $maxitems) and last;
@@ -1781,7 +1901,7 @@ sub searchResults {
         # XSLT processing of some stuff
        use C4::Charset;
        SetUTF8Flag($marcrecord);
-       $debug && warn $marcrecord->as_formatted;
+        warn $marcrecord->as_formatted if $DEBUG;
        my $interface = $search_context eq 'opac' ? 'OPAC' : '';
        if (!$scan && C4::Context->preference($interface . "XSLTResultsDisplay")) {
             $oldbiblio->{XSLTResultsRecord} = XSLTParse4Display($oldbiblio->{biblionumber}, $marcrecord, $interface."XSLTResultsDisplay", 1, \@hiddenitems);
@@ -1812,8 +1932,6 @@ sub searchResults {
         $oldbiblio->{intransitcount}       = $item_in_transit_count;
         $oldbiblio->{onholdcount}          = $item_onhold_count;
         $oldbiblio->{orderedcount}         = $ordered_count;
-        # deleting - in isbn to enable amazon content
-        $oldbiblio->{isbn} =~ s/-//g;
 
         if (C4::Context->preference("AlternateHoldingsField") && $items_count == 0) {
             my $fieldspec = C4::Context->preference("AlternateHoldingsField");