batchRebuildBiblioTables.pl doesn't crash anymore when GetMarcBiblio fails.
[koha.git] / C4 / Search.pm
index a80c79f..3f4ee15 100644 (file)
@@ -27,7 +27,10 @@ use XML::Simple;
 use C4::Dates qw(format_date);
 use C4::XSLT;
 use C4::Branch;
+use C4::Debug;
+use YAML;
 use URI::Escape;
+use C4::Charset;
 
 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $DEBUG);
 
@@ -58,6 +61,7 @@ This module provides searching functions for Koha's bibliographic databases
   &FindDuplicate
   &SimpleSearch
   &searchResults
+  &SearchAcquisitions
   &getRecords
   &buildQuery
   &NZgetRecords
@@ -443,6 +447,7 @@ sub getRecords {
                     # not an index scan
                     else {
                         $record = $results[ $i - 1 ]->record($j)->raw();
+                       warn $results[$i-1]->record($j)->render() ;
 
                         # warn "RECORD $j:".$record;
                         $results_hash->{'RECORDS'}[$j] = $record;
@@ -633,10 +638,12 @@ sub _remove_stopwords {
 #       we use IsAlpha unicode definition, to deal correctly with diacritics.
 #       otherwise, a French word like "leçon" woudl be split into "le" "çon", "le"
 #       is a stopword, we'd get "çon" and wouldn't find anything...
+#       
                foreach ( keys %{ C4::Context->stopwords } ) {
                        next if ( $_ =~ /(and|or|not)/ );    # don't remove operators
+                       $debug && warn "$_ Dump($operand)";
                        if ( my ($matched) = ($operand =~
-                               /(\P{IsAlnum}\Q$_\E\P{IsAlnum}|^\Q$_\E\P{IsAlnum}|\P{IsAlnum}\Q$_\E$|^\Q$_\E$)/gi) )
+                               /([^\X\p{isAlnum}]\Q$_\E[^\X\p{isAlnum}]|[^\X\p{isAlnum}]\Q$_\E$|^\Q$_\E[^\X\p{isAlnum}])/gi))
                        {
                                $operand =~ s/\Q$matched\E/ /gi;
                                push @stopwords_removed, $_;
@@ -772,6 +779,195 @@ sub _build_weighted_query {
     return $weighted_query;
 }
 
+=head2 getIndexes
+
+Return an array with available indexes.
+
+=cut
+
+sub getIndexes{
+    my @indexes = (
+                    # biblio indexes
+                    'ab',
+                    'Abstract',
+                    'acqdate',
+                    'allrecords',
+                    'an',
+                    'Any',
+                    'at',
+                    'au',
+                    'aub',
+                    'aud',
+                    'audience',
+                    'auo',
+                    'aut',
+                    'Author',
+                    'Author-in-order ',
+                    'Author-personal-bibliography',
+                    'Authority-Number',
+                    'authtype',
+                    'bc',
+                    'biblionumber',
+                    'bio',
+                    'biography',
+                    'callnum',          
+                    'cfn',
+                    'Chronological-subdivision',
+                    'cn-bib-source',
+                    'cn-bib-sort',
+                    'cn-class',
+                    'cn-item',
+                    'cn-prefix',
+                    'cn-suffix',
+                    'cpn',
+                    'Code-institution',
+                    'Conference-name',
+                    'Conference-name-heading',
+                    'Conference-name-see',
+                    'Conference-name-seealso',
+                    'Content-type',
+                    'Control-number',
+                    'copydate',
+                    'Corporate-name',
+                    'Corporate-name-heading',
+                    'Corporate-name-see',
+                    'Corporate-name-seealso',
+                    'ctype',
+                    'date-entered-on-file',
+                    'Date-of-acquisition',
+                    'Date-of-publication',
+                    'Dewey-classification',
+                    'extent',
+                    'fic',
+                    'fiction',
+                    'Form-subdivision',
+                    'format',
+                    'Geographic-subdivision',
+                    'he',
+                    'Heading',
+                    'Heading-use-main-or-added-entry',
+                    'Heading-use-series-added-entry ',
+                    'Heading-use-subject-added-entry',
+                    'Host-item',
+                    'id-other',
+                    'Illustration-code',
+                    'ISBN',
+                    'ISSN',
+                    'itemtype',
+                    'kw',
+                    'Koha-Auth-Number',
+                    'l-format',
+                    'language',
+                    'lc-card',
+                    'LC-card-number',
+                    'lcn',
+                    'llength',
+                    'ln',
+                    'Local-classification',
+                    'Local-number',
+                    'Match-heading',
+                    'Match-heading-see-from',
+                    'Material-type',
+                    'mc-itemtype',
+                    'mc-rtype',
+                    'mus',
+                    'Name-geographic',
+                    'Name-geographic-heading',
+                    'Name-geographic-see',
+                    'Name-geographic-seealso',
+                    'nb',
+                    'Note',
+                    'ns',
+                    'nt',
+                    'pb',
+                    'Personal-name',
+                    'Personal-name-heading',
+                    'Personal-name-see',
+                    'Personal-name-seealso',
+                    'pl',
+                    'Place-publication',
+                    'pn',
+                    'popularity',
+                    'pubdate',
+                    'Publisher',
+                    'Record-type',
+                    'rtype',
+                    'se',
+                    'See',
+                    'See-also',
+                    'sn',
+                    'Stock-number',
+                    'su',
+                    'Subject',
+                    'Subject-heading-thesaurus',
+                    'Subject-name-personal',
+                    'Subject-subdivision',
+                    'Summary',
+                    'Suppress',
+                    'su-geo',
+                    'su-na',
+                    'su-to',
+                    'su-ut',
+                    'ut',
+                    'Term-genre-form',
+                    'Term-genre-form-heading',
+                    'Term-genre-form-see',
+                    'Term-genre-form-seealso',
+                    'ti',
+                    'Title',
+                    'Title-cover',
+                    'Title-series',
+                    'Title-uniform',
+                    'Title-uniform-heading',
+                    'Title-uniform-see',
+                    'Title-uniform-seealso',
+                    'totalissues',
+                    'yr',
+                    
+                    # items indexes
+                    'acqsource',
+                    'barcode',
+                    'bc',
+                    'branch',
+                    'ccode',
+                    'classification-source',
+                    'cn-sort',
+                    'coded-location-qualifier',
+                    'copynumber',
+                    'damaged',
+                    'datelastborrowed',
+                    'datelastseen',
+                    'holdingbranch',
+                    'homebranch',
+                    'issues',
+                    'item',
+                    'itemnumber',
+                    'itype',
+                    'Local-classification',
+                    'location',
+                    'lost',
+                    'materials-specified',
+                    'mc-ccode',
+                    'mc-itype',
+                    'mc-loc',
+                    'notforloan',
+                    'onloan',
+                    'price',
+                    'renewals',
+                    'replacementprice',
+                    'replacementpricedate',
+                    'reserves',
+                    'restricted',
+                    'stack',
+                    'uri',
+                    'withdrawn',
+                    
+                    # subject related
+                  );
+                  
+    return \@indexes;
+}
+
 =head2 buildQuery
 
 ( $error, $query,
@@ -808,9 +1004,10 @@ sub buildQuery {
 
     # no stemming/weight/fuzzy in NoZebra
     if ( C4::Context->preference("NoZebra") ) {
-        $stemming      = 0;
-        $weight_fields = 0;
-        $fuzzy_enabled = 0;
+        $stemming         = 0;
+        $weight_fields    = 0;
+        $fuzzy_enabled    = 0;
+       $auto_truncation  = 0;
     }
 
     my $query        = $operands[0];
@@ -827,6 +1024,17 @@ sub buildQuery {
 
     my $stopwords_removed;    # flag to determine if stopwords have been removed
 
+    my $cclq;
+    my $cclindexes = getIndexes();
+    if( $query !~ /\s*ccl=/ ){
+        for my $index (@$cclindexes){
+            if($query =~ /($index)(,?\w)*[:=]/){
+                $cclq = 1;
+            }
+        }
+        $query = "ccl=$query" if($cclq);
+    }
+
 # for handling ccl, cql, pqf queries in diagnostic mode, skip the rest of the steps
 # DIAGNOSTIC ONLY!!
     if ( $query =~ /^ccl=/ ) {
@@ -901,6 +1109,11 @@ sub buildQuery {
                     ) = ( 0, 0, 0, 0, 0 );
 
                 }
+                
+                if(not $index){
+                    $index = 'kw';
+                }
+                
                 # Set default structure attribute (word list)
                 my $struct_attr;
                 unless ( $indexes_set || !$index || $index =~ /(st-|phr|ext|wrdl)/ ) {
@@ -921,11 +1134,13 @@ sub buildQuery {
                 }
 
                 if ($auto_truncation){
-                                       #FIXME only valid with LTR scripts
-                                       $operand=join(" ",map{ 
-                                                                                       "$_*" 
-                                                                            }split (/\s+/,$operand));
-                       warn $operand if $DEBUG;
+                                       unless ( $index =~ /(st-|phr|ext)/ ) {
+                                               #FIXME only valid with LTR scripts
+                                               $operand=join(" ",map{ 
+                                                                                       (index($_,"*")>0?"$_":"$_*")
+                                                                                        }split (/\s+/,$operand));
+                                               warn $operand if $DEBUG;
+                                       }
                                }
 
                 # Detect Truncation
@@ -1126,7 +1341,6 @@ sub searchResults {
     my ( $searchdesc, $hits, $results_per_page, $offset, $scan, @marcresults ) = @_;
     my $dbh = C4::Context->dbh;
     my @newresults;
-
     #Build branchnames hash
     #find branchname
     #get branch information.....
@@ -1184,12 +1398,29 @@ sub searchResults {
     else {
         $times = $hits;         # FIXME: if $hits is undefined, why do we want to equal it?
     }
+    my $marcflavour = C4::Context->preference("marcflavour");
 
+    # We get the biblionumber position in MARC 
+    my ($bibliotag,$bibliosubf)=GetMarcFromKohaField('biblio.biblionumber','');
+    my $fw = '';
+    
     # 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 $oldbiblio = TransformMarcToKoha( $dbh, $marcrecord, '' );
-        $oldbiblio->{subtitle} = C4::Biblio::get_koha_field_from_marc('bibliosubtitle', 'subtitle', $marcrecord, '');
+           SetUTF8Flag($marcrecord);
+               my $biblionumber;
+
+        if(not $scan){
+            if ($bibliotag<10){
+                $biblionumber = $marcrecord->field($bibliotag) ? $marcrecord->field($bibliotag)->data : undef;
+            }else{
+                $biblionumber = $marcrecord->subfield($bibliotag,$bibliosubf);
+            } 
+            $fw = (defined $biblionumber) ? GetFrameworkCode($biblionumber) : '';
+        }
+        
+        my $oldbiblio = TransformMarcToKoha( $dbh, $marcrecord, $fw );
+        $oldbiblio->{subtitle} = GetRecordValue('subtitle', $marcrecord, $fw);
         $oldbiblio->{result_number} = $i + 1;
 
         # add imageurl to itemtype if there is one
@@ -1205,8 +1436,6 @@ sub searchResults {
        $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});
-
-       # edition information, if any
         $oldbiblio->{edition} = $oldbiblio->{editionstatement};
        $oldbiblio->{description} = $itemtypes{ $oldbiblio->{itemtype} }->{description};
  # Build summary if there is one (the summary is defined in the itemtypes table)
@@ -1214,33 +1443,49 @@ sub searchResults {
         if ( $itemtypes{ $oldbiblio->{itemtype} }->{summary} ) {
             my $summary = $itemtypes{ $oldbiblio->{itemtype} }->{summary};
             my @fields  = $marcrecord->fields();
-            foreach my $field (@fields) {
-                my $tag      = $field->tag();
-                my $tagvalue = $field->as_string();
-                if (! utf8::is_utf8($tagvalue)) {
-                    utf8::decode($tagvalue);
+            
+            my $newsummary;
+            foreach my $line ( "$summary\n" =~ /(.*)\n/g ){
+                my $tags = {};
+                foreach my $tag ( $line =~ /\[(\d{3}[\w|\d])\]/ ) {
+                    $tag =~ /(.{3})(.)/;
+                    if($marcrecord->field($1)){
+                        my @abc = $marcrecord->field($1)->subfield($2);
+                        $tags->{$tag} = $#abc + 1 ;
+                    }
                 }
-
-                $summary =~
-                  s/\[(.?.?.?.?)$tag\*(.*?)]/$1$tagvalue$2\[$1$tag$2]/g;
-                unless ( $tag < 10 ) {
-                    my @subf = $field->subfields;
-                    for my $i ( 0 .. $#subf ) {
-                        my $subfieldcode  = $subf[$i][0];
-                        my $subfieldvalue = $subf[$i][1];
-                        if (! utf8::is_utf8($subfieldvalue)) {
-                            utf8::decode($subfieldvalue);
+                
+                # We catch how many times to repeat this line
+                my $max = 0;
+                foreach my $tag (keys(%$tags)){
+                    $max = $tags->{$tag} if($tags->{$tag} > $max);
+                 }
+                
+                # we replace, and repeat each line
+                for (my $i = 0 ; $i < $max ; $i++){
+                    my $newline = $line;
+
+                    foreach my $tag ( $newline =~ /\[(\d{3}[\w|\d])\]/g ) {
+                        $tag =~ /(.{3})(.)/;
+                        
+                        if($marcrecord->field($1)){
+                            my @repl = $marcrecord->field($1)->subfield($2);
+                            my $subfieldvalue = $repl[$i];
+                            
+                            if (! utf8::is_utf8($subfieldvalue)) {
+                                utf8::decode($subfieldvalue);
+                            }
+                             $newline =~ s/\[$tag\]/$subfieldvalue/g;
                         }
-                        my $tagsubf       = $tag . $subfieldcode;
-                        $summary =~
-s/\[(.?.?.?.?)$tagsubf(.*?)]/$1$subfieldvalue$2\[$1$tagsubf$2]/g;
                     }
+                    $newsummary .= "$newline\n";
                 }
             }
-            # FIXME: yuk
-            $summary =~ s/\[(.*?)]//g;
-            $summary =~ s/\n/<br\/>/g;
-            $oldbiblio->{summary} = $summary;
+
+            $newsummary =~ s/\[(.*?)]//g;
+            $newsummary =~ s/\n/<br\/>/g;
+            $oldbiblio->{summary} = $newsummary;
         }
 
         # Pull out the items fields
@@ -1307,6 +1552,7 @@ s/\[(.?.?.?.?)$tagsubf(.*?)]/$1$subfieldvalue$2\[$1$tagsubf$2]/g;
                                $onloan_items->{$key}->{itemcallnumber} = $item->{itemcallnumber};
                                $onloan_items->{$key}->{imageurl} = getitemtypeimagelocation( 'opac', $itemtypes{ $item->{itype} }->{imageurl} );
                                $onloan_items->{$key}->{barcode} = $item->{barcode};
+                               $onloan_items->{$key}->{reserved} = $item->{reserved};
                 # if something's checked out and lost, mark it as 'long overdue'
                 if ( $item->{itemlost} ) {
                     $onloan_items->{$prefix}->{longoverdue}++;
@@ -1431,7 +1677,7 @@ s/\[(.?.?.?.?)$tagsubf(.*?)]/$1$subfieldvalue$2\[$1$tagsubf$2]/g;
         # XSLT processing of some stuff
         if (C4::Context->preference("XSLTResultsDisplay") && !$scan) {
             $oldbiblio->{XSLTResultsRecord} = XSLTParse4Display(
-                $oldbiblio->{biblionumber}, $marcrecord, 'Results' );
+                $oldbiblio->{biblionumber}, $marcrecord, C4::Context->preference("XSLTResultsDisplay") );
         }
 
         # last check for norequest : if itemtype is notforloan, it can't be reserved either, whatever the items
@@ -1462,6 +1708,95 @@ s/\[(.?.?.?.?)$tagsubf(.*?)]/$1$subfieldvalue$2\[$1$tagsubf$2]/g;
     return @newresults;
 }
 
+=head2 SearchAcquisitions
+    Search for acquisitions 
+=cut
+
+sub SearchAcquisitions{
+    my ($datebegin, $dateend, $itemtypes,$criteria, $orderby) = @_;
+    
+    my $dbh=C4::Context->dbh;
+    # Variable initialization
+    my $str=qq|
+    SELECT marcxml 
+    FROM biblio 
+    LEFT JOIN biblioitems ON biblioitems.biblionumber=biblio.biblionumber
+    LEFT JOIN items ON items.biblionumber=biblio.biblionumber
+    WHERE dateaccessioned BETWEEN ? AND ? 
+    |;
+    
+    my (@params,@loopcriteria);
+    
+    push @params, $datebegin->output("iso");
+    push @params, $dateend->output("iso");
+
+    if (scalar(@$itemtypes)>0 and $criteria ne "itemtype" ){
+        if(C4::Context->preference("item-level_itypes")){
+            $str .= "AND items.itype IN (?".( ',?' x scalar @$itemtypes - 1 ).") ";
+        }else{
+            $str .= "AND biblioitems.itemtype IN (?".( ',?' x scalar @$itemtypes - 1 ).") ";
+        }    
+        push @params, @$itemtypes;
+    }
+        
+    if ($criteria =~/itemtype/){
+        if(C4::Context->preference("item-level_itypes")){
+            $str .= "AND items.itype=? ";
+        }else{
+            $str .= "AND biblioitems.itemtype=? ";
+        }
+        
+        if(scalar(@$itemtypes) == 0){
+            my $itypes = GetItemTypes();
+            for my $key (keys %$itypes){
+                push @$itemtypes, $key;
+            }
+        }
+        
+        @loopcriteria= @$itemtypes;
+    }elsif ($criteria=~/itemcallnumber/){
+        $str .= "AND (items.itemcallnumber LIKE CONCAT(?,'%') 
+                 OR items.itemcallnumber is NULL
+                 OR items.itemcallnumber = '')";
+
+        @loopcriteria = ("AA".."ZZ", "") unless (scalar(@loopcriteria)>0);  
+    }else {
+        $str .= "AND biblio.title LIKE CONCAT(?,'%') ";
+        @loopcriteria = ("A".."z") unless (scalar(@loopcriteria)>0);  
+    }
+        
+    if ($orderby =~ /date_desc/){
+        $str.=" ORDER BY dateaccessioned DESC";
+    } else {
+        $str.=" ORDER BY title";
+    }
+    
+    my $qdataacquisitions=$dbh->prepare($str);
+        
+    my @loopacquisitions;
+    foreach my $value(@loopcriteria){
+        push @params,$value;
+        my %cell;
+        $cell{"title"}=$value;
+        $cell{"titlecode"}=$value;
+        
+        eval{$qdataacquisitions->execute(@params);};
+  
+        if ($@){ warn "recentacquisitions Error :$@";}
+        else {
+            my @loopdata;
+            while (my $data=$qdataacquisitions->fetchrow_hashref){
+                push @loopdata, {"summary"=>GetBiblioSummary( $data->{'marcxml'} ) };
+            }
+            $cell{"loopdata"}=\@loopdata;
+        }
+        push @loopacquisitions,\%cell if (scalar(@{$cell{loopdata}})>0);
+        pop @params;
+    }
+    $qdataacquisitions->finish;
+    return \@loopacquisitions;
+}
+
 #----------------------------------------------------------------------
 #
 # Non-Zebra GetRecords#
@@ -1691,7 +2026,7 @@ sub NZanalyse {
             );
 
             # split each word, query the DB and build the biblionumbers result
-            foreach ( split / /, $string ) {
+            foreach ( split (/ /, $string )) {
                 next if C4::Context->stopwords->{ uc($_) };   # skip if stopword
                 warn "search on all indexes on $_" if $DEBUG;
                 my $biblionumbers;
@@ -1720,7 +2055,7 @@ sub NZanalyse {
 sub NZoperatorAND{
     my ($rightresult, $leftresult)=@_;
     
-    my @leftresult = split /;/, $leftresult;
+    my @leftresult = split (/;/, $leftresult);
     warn " @leftresult / $rightresult \n" if $DEBUG;
     
     #             my @rightresult = split /;/,$leftresult;
@@ -1794,8 +2129,8 @@ sub NZorder {
         # popularity is not in MARC record, it's builded from a specific query
         my $sth =
           $dbh->prepare("select sum(issues) from items where biblionumber=?");
-        foreach ( split /;/, $biblionumbers ) {
-            my ( $biblionumber, $title ) = split /,/, $_;
+        foreach ( split (/;/, $biblionumbers )) {
+            my ( $biblionumber, $title ) = split (/,/, $_);
             $result{$biblionumber} = GetMarcBiblio($biblionumber);
             $sth->execute($biblionumber);
             my $popularity = $sth->fetchrow || 0;
@@ -1834,8 +2169,8 @@ sub NZorder {
     }
     elsif ( $ordering =~ /author/ ) {
         my %result;
-        foreach ( split /;/, $biblionumbers ) {
-            my ( $biblionumber, $title ) = split /,/, $_;
+        foreach ( split (/;/, $biblionumbers )) {
+            my ( $biblionumber, $title ) = split (/,/, $_);
             my $record = GetMarcBiblio($biblionumber);
             my $author;
             if ( C4::Context->preference('marcflavour') eq 'UNIMARC' ) {
@@ -1877,8 +2212,8 @@ sub NZorder {
     }
     elsif ( $ordering =~ /callnumber/ ) {
         my %result;
-        foreach ( split /;/, $biblionumbers ) {
-            my ( $biblionumber, $title ) = split /,/, $_;
+        foreach ( split (/;/, $biblionumbers )) {
+            my ( $biblionumber, $title ) = split (/,/, $_);
             my $record = GetMarcBiblio($biblionumber);
             my $callnumber;
             my ( $callnumber_tag, $callnumber_subfield ) =
@@ -1920,8 +2255,8 @@ sub NZorder {
     }
     elsif ( $ordering =~ /pubdate/ ) {             #pub year
         my %result;
-        foreach ( split /;/, $biblionumbers ) {
-            my ( $biblionumber, $title ) = split /,/, $_;
+        foreach ( split (/;/, $biblionumbers )) {
+            my ( $biblionumber, $title ) = split (/,/, $_);
             my $record = GetMarcBiblio($biblionumber);
             my ( $publicationyear_tag, $publicationyear_subfield ) =
               GetMarcFromKohaField( 'biblioitems.publicationyear', '' );
@@ -1962,8 +2297,8 @@ sub NZorder {
 
 # the title is in the biblionumbers string, so we just need to build a hash, sort it and return
         my %result;
-        foreach ( split /;/, $biblionumbers ) {
-            my ( $biblionumber, $title ) = split /,/, $_;
+        foreach ( split (/;/, $biblionumbers )) {
+            my ( $biblionumber, $title ) = split (/,/, $_);
 
 # hint : the result is sorted by title.biblionumber because we can have X biblios with the same title
 # and we don't want to get only 1 result for each of them !!!
@@ -2095,6 +2430,37 @@ sub enabled_staff_search_views
        );
 }
 
+=head2 enabled_opac_search_views
+
+%hash = enabled_opac_search_views()
+
+This function returns a hash that contains two flags obtained from the system
+preferences, used to determine whether a particular opac search results view
+is enabled.
+
+=over 2
+
+=item C<Output arg:>
+
+    * $hash{can_view_MARC} is true only if the MARC view is enabled
+    * $hash{can_view_ISBD} is true only if the ISBD view is enabled
+
+=item C<usage in the script:>
+
+=back
+
+$template->param ( C4::Search::enabled_opac_search_views );
+
+=cut
+
+sub enabled_opac_search_views
+{
+       return (
+               can_opac_view_MARC              => C4::Context->preference('OPACviewMARC'),             # 1 if the opac search allows the MARC view
+               can_opac_view_ISBD              => C4::Context->preference('OPACviewISBD'),             # 1 if the opac search allows the ISBD view
+       );
+}
+
 
 =head2 z3950_search_args