batchRebuildBiblioTables.pl doesn't crash anymore when GetMarcBiblio fails.
[koha.git] / C4 / Search.pm
index 74539f6..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, $_;
@@ -933,6 +940,7 @@ sub getIndexes{
                     'holdingbranch',
                     'homebranch',
                     'issues',
+                    'item',
                     'itemnumber',
                     'itype',
                     'Local-classification',
@@ -1020,7 +1028,7 @@ sub buildQuery {
     my $cclindexes = getIndexes();
     if( $query !~ /\s*ccl=/ ){
         for my $index (@$cclindexes){
-            if($query =~ /($index)(,?\w)*:/){
+            if($query =~ /($index)(,?\w)*[:=]/){
                 $cclq = 1;
             }
         }
@@ -1129,7 +1137,7 @@ sub buildQuery {
                                        unless ( $index =~ /(st-|phr|ext)/ ) {
                                                #FIXME only valid with LTR scripts
                                                $operand=join(" ",map{ 
-                                                                                               "$_*" 
+                                                                                       (index($_,"*")>0?"$_":"$_*")
                                                                                         }split (/\s+/,$operand));
                                                warn $operand if $DEBUG;
                                        }
@@ -1333,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.....
@@ -1400,15 +1407,16 @@ 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] );
+           SetUTF8Flag($marcrecord);
                my $biblionumber;
-        
+
         if(not $scan){
             if ($bibliotag<10){
-                $biblionumber = $marcrecord->field($bibliotag)->data;
+                $biblionumber = $marcrecord->field($bibliotag) ? $marcrecord->field($bibliotag)->data : undef;
             }else{
                 $biblionumber = $marcrecord->subfield($bibliotag,$bibliosubf);
             } 
-            $fw = GetFrameworkCode($biblionumber);
+            $fw = (defined $biblionumber) ? GetFrameworkCode($biblionumber) : '';
         }
         
         my $oldbiblio = TransformMarcToKoha( $dbh, $marcrecord, $fw );
@@ -1435,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
@@ -1528,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}++;
@@ -1652,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
@@ -1683,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#
@@ -1912,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;
@@ -1941,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;
@@ -2015,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;
@@ -2055,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' ) {
@@ -2098,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 ) =
@@ -2141,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', '' );
@@ -2183,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 !!!
@@ -2316,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