Adding details to OPAC search results RSS, described in Bug 2973.
[srvgit] / C4 / Search.pm
old mode 100755 (executable)
new mode 100644 (file)
index 853ab20..571edf7
@@ -16,6 +16,7 @@ package C4::Search;
 # Suite 330, Boston, MA  02111-1307 USA
 
 use strict;
+# use warnings; # FIXME
 require Exporter;
 use C4::Context;
 use C4::Biblio;    # GetMarcFromKohaField
@@ -25,6 +26,7 @@ use C4::Search::PazPar2;
 use XML::Simple;
 use C4::Dates qw(format_date);
 use C4::XSLT;
+use C4::Branch;
 
 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $DEBUG);
 
@@ -158,7 +160,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 +174,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 +196,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 +231,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 +241,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 +284,13 @@ sub SimpleSearch {
             }
         }
 
+        foreach my $result (@tmpresults) {
+            $result->destroy();
+        }
+        foreach my $zoom_query (@zoom_queries) {
+            $zoom_query->destroy();
+        }
+
         return ( undef, \@results, $total_hits );
     }
 }
@@ -597,7 +608,7 @@ sub getRecords {
                             expandable => $expandable,
                             expand     => $link_value,
                         }
-                      );
+                      ) unless ( ($facets_info->{$link_value}->{'label_value'} =~ /Libraries/) and (C4::Context->preference('singleBranchMode')) );
                 }
             }
         }
@@ -693,11 +704,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, $_;
             }
         }
@@ -740,6 +752,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' );
 
@@ -973,11 +992,8 @@ sub buildQuery {
                 }
 
                 # Detect Truncation
-                my ( $nontruncated, $righttruncated, $lefttruncated,
-                    $rightlefttruncated, $regexpr );
                 my $truncated_operand;
-                (
-                    $nontruncated, $righttruncated, $lefttruncated,
+                my( $nontruncated, $righttruncated, $lefttruncated,
                     $rightlefttruncated, $regexpr
                 ) = _detect_truncation( $operand, $index );
                 warn
@@ -1110,7 +1126,17 @@ sub buildQuery {
             $limit .= " and " if $limit || $query;
             $limit      .= "$this_limit";
             $limit_cgi  .= "&limit=$this_limit";
-            $limit_desc .= " $this_limit";
+            if ($this_limit =~ /^branch:(.+)/) {
+                my $branchcode = $1;
+                my $branchname = GetBranchName($branchcode);
+                if (defined $branchname) {
+                    $limit_desc .= " branch:$branchname";
+                } else {
+                    $limit_desc .= " $this_limit";
+                }
+            } else {
+                $limit_desc .= " $this_limit";
+            }
         }
     }
     if ($group_OR_limits) {
@@ -1165,7 +1191,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;
@@ -1237,6 +1263,7 @@ sub searchResults {
         $times = $hits;         # FIXME: if $hits is undefined, why do we want to equal it?
     }
 
+       my $marcflavour = C4::Context->preference("marcflavour");
     # 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] );
@@ -1245,20 +1272,14 @@ sub searchResults {
         $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};
-        } else {
-            $oldbiblio->{imageurl} =
-              getitemtypeimagesrc() . "/"
-              . $itemtypes{ $oldbiblio->{itemtype} }->{imageurl}
-              if ( $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'};
-        $aisbn =~ /(\d*[X]*)/;
-        $oldbiblio->{amazonisbn} = $1;
+        $oldbiblio->{imageurl} = getitemtypeimagelocation( 'opac', $itemtypes{ $oldbiblio->{itemtype} }->{imageurl} );
+
+        $oldbiblio->{'authorised_value_images'}  = C4::Items::get_authorised_value_images( C4::Biblio::get_biblio_authorised_values( $oldbiblio->{'biblionumber'}, $marcrecord ) );
+               $oldbiblio->{normalized_upc} = GetNormalizedUPC($marcrecord,$marcflavour);
+               $oldbiblio->{normalized_ean} = GetNormalizedEAN($marcrecord,$marcflavour);
+               $oldbiblio->{normalized_oclc} = GetNormalizedOCLCNumber($marcrecord,$marcflavour);
+               $oldbiblio->{normalized_isbn} = GetNormalizedISBN(undef,$marcrecord,$marcflavour);
+               $oldbiblio->{content_identifier_exists} = 1 if ($oldbiblio->{normalized_isbn} or $oldbiblio->{normalized_oclc} or $oldbiblio->{normalized_ean} or $oldbiblio->{normalized_upc});
                $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
@@ -1290,6 +1311,7 @@ s/\[(.?.?.?.?)$tagsubf(.*?)]/$1$subfieldvalue$2\[$1$tagsubf$2]/g;
         # save an author with no <span> tag, for the <a href=search.pl?q=<!--tmpl_var name="author"-->> link
         $oldbiblio->{'author_nospan'} = $oldbiblio->{'author'};
         $oldbiblio->{'title_nospan'} = $oldbiblio->{'title'};
+        $oldbiblio->{'subtitle_nospan'} = $oldbiblio->{'subtitle'};
         # Add search-term highlighting to the whole record where they match using <span>s
         if (C4::Context->preference("OpacHighlightedWords")){
             my $searchhighlightblob;
@@ -1340,18 +1362,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 $items_counter;
+        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 $maxitems =
           ( C4::Context->preference('maxItemsinSearchResults') )
           ? C4::Context->preference('maxItemsinSearchResults') - 1
@@ -1360,7 +1382,6 @@ s/\[(.?.?.?.?)$tagsubf(.*?)]/$1$subfieldvalue$2\[$1$tagsubf$2]/g;
         # loop through every item
         foreach my $field (@fields) {
             my $item;
-            $items_counter++;
 
             # populate the items hash
             foreach my $code ( keys %subfieldstosearch ) {
@@ -1382,11 +1403,11 @@ s/\[(.?.?.?.?)$tagsubf(.*?)]/$1$subfieldvalue$2\[$1$tagsubf$2]/g;
                 $onloan_count++;
                                my $key = $prefix . $item->{due_date};
                                $onloan_items->{$key}->{due_date} = format_date($item->{onloan});
-                               $onloan_items->{$key}->{count}++ if $item->{homebranch};
+                               $onloan_items->{$key}->{count}++ if $item->{$hbranch};
                                $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}++;
@@ -1404,15 +1425,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,21 +1468,22 @@ 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}->{count}++ if $item->{$hbranch};
                                        $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 {
                     $can_place_holds = 1;
                     $available_count++;
-                                       $available_items->{$prefix}->{count}++ if $item->{homebranch};
+                                       $available_items->{$prefix}->{count}++ if $item->{$hbranch};
                                        foreach (qw(branchname itemcallnumber)) {
                        $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
@@ -1457,8 +1506,8 @@ s/\[(.?.?.?.?)$tagsubf(.*?)]/$1$subfieldvalue$2\[$1$tagsubf$2]/g;
         }
 
         # XSLT processing of some stuff
-        if (C4::Context->preference("XSLTResultsDisplay") ) {
-            my $newxmlrecord = XSLTParse4Display($oldbiblio->{biblionumber},C4::Context->config('opachtdocs')."/prog/en/xslt/MARC21slim2OPACResults.xsl");
+        if (C4::Context->preference("XSLTResultsDisplay") && !$scan) {
+            my $newxmlrecord = XSLTParse4Display($oldbiblio->{biblionumber}, $marcrecord, C4::Context->config('opachtdocs')."/prog/en/xslt/MARC21slim2OPACResults.xsl");
             $oldbiblio->{XSLTResultsRecord} = $newxmlrecord;
         }
 
@@ -1480,10 +1529,8 @@ 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;
@@ -1913,15 +1960,13 @@ sub NZorder {
             my ( $biblionumber, $title ) = split /,/, $_;
             my $record = GetMarcBiblio($biblionumber);
             my $callnumber;
-            my ( $callnumber_tag, $callnumber_subfield ) =
-              GetMarcFromKohaField( $dbh, 'items.itemcallnumber' );
-            ( $callnumber_tag, $callnumber_subfield ) =
-              GetMarcFromKohaField('biblioitems.callnumber')
-              unless $callnumber_tag;
+            my $frameworkcode = GetFrameworkCode($biblionumber);
+            my ( $callnumber_tag, $callnumber_subfield ) = GetMarcFromKohaField(  'items.itemcallnumber', $frameworkcode);
+               ( $callnumber_tag, $callnumber_subfield ) = GetMarcFromKohaField('biblioitems.callnumber', $frameworkcode)
+                unless $callnumber_tag;
             if ( C4::Context->preference('marcflavour') eq 'UNIMARC' ) {
                 $callnumber = $record->subfield( '200', 'f' );
-            }
-            else {
+            } else {
                 $callnumber = $record->subfield( '100', 'a' );
             }
 
@@ -2135,8 +2180,8 @@ sub ModBiblios {
         $tag = $tag . $subfield;
         undef $subfield;
     }
-    my ( $bntag,   $bnsubf )   = GetMarcFromKohaField('biblio.biblionumber');
-    my ( $itemtag, $itemsubf ) = GetMarcFromKohaField('items.itemnumber');
+    my ( $bntag,   $bnsubf )   = GetMarcFromKohaField('biblio.biblionumber', '');
+    my ( $itemtag, $itemsubf ) = GetMarcFromKohaField('items.itemnumber', '');
     if ($tag eq $itemtag) {
         # do not allow the embedded item tag to be 
         # edited from here