Bug 13904: Make unimarc_field_4XX displays usefull 200 subfield data
[srvgit] / C4 / AuthoritiesMarc.pm
index 9409853..c311fb2 100644 (file)
@@ -3,18 +3,18 @@ package C4::AuthoritiesMarc;
 #
 # This file is part of Koha.
 #
-# Koha is free software; you can redistribute it and/or modify it under the
-# terms of the GNU General Public License as published by the Free Software
-# Foundation; either version 2 of the License, or (at your option) any later
-# version.
+# Koha is free software; you can redistribute it and/or modify it
+# under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3 of the License, or
+# (at your option) any later version.
 #
-# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
-# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
-# A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+# Koha is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
 #
-# You should have received a copy of the GNU General Public License along
-# with Koha; if not, write to the Free Software Foundation, Inc.,
-# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+# You should have received a copy of the GNU General Public License
+# along with Koha; if not, see <http://www.gnu.org/licenses>.
 
 use strict;
 use warnings;
@@ -109,6 +109,7 @@ sub SearchAuthorities {
     my ($tags, $and_or, $excluding, $operator, $value, $offset,$length,$authtypecode,$sortby,$skipmetadata) = @_;
     # warn Dumper($tags, $and_or, $excluding, $operator, $value, $offset,$length,$authtypecode,$sortby);
     my $dbh=C4::Context->dbh;
+    $sortby="" unless $sortby;
     my $query;
     my $qpquery = '';
     my $QParser;
@@ -140,61 +141,68 @@ sub SearchAuthorities {
     my $and=" \@and " ;
     my $q2;
     my $attr_cnt = 0;
-    for(my $i = 0 ; $i <= $#{$value} ; $i++)
-    {
-        if (@$value[$i]){
-            if ( @$tags[$i] eq "mainmainentry" ) {
-                $attr = " \@attr 1=Heading-Main ";
-            }
-            elsif ( @$tags[$i] eq "mainentry" ) {
-                $attr = " \@attr 1=Heading ";
-            }
-            elsif ( @$tags[$i] eq "match" ) {
-                $attr = " \@attr 1=Match ";
-            }
-            elsif ( @$tags[$i] eq "match-heading" ) {
-                $attr = " \@attr 1=Match-heading ";
-            }
-            elsif ( @$tags[$i] eq "see-from" ) {
-                $attr = " \@attr 1=Match-heading-see-from ";
-            }
-            elsif ( @$tags[$i] eq "thesaurus" ) {
-                $attr = " \@attr 1=Subject-heading-thesaurus ";
-            }
-            else { # Assume any if no index was specified
+    for ( my $i = 0 ; $i <= $#{$value} ; $i++ ) {
+        if ( @$value[$i] ) {
+            if ( @$tags[$i] ) {
+                if ( @$tags[$i] eq "mainmainentry" ) {
+                    $attr = " \@attr 1=Heading-Main ";
+                }
+                elsif ( @$tags[$i] eq "mainentry" ) {
+                    $attr = " \@attr 1=Heading ";
+                }
+                elsif ( @$tags[$i] eq "match" ) {
+                    $attr = " \@attr 1=Match ";
+                }
+                elsif ( @$tags[$i] eq "match-heading" ) {
+                    $attr = " \@attr 1=Match-heading ";
+                }
+                elsif ( @$tags[$i] eq "see-from" ) {
+                    $attr = " \@attr 1=Match-heading-see-from ";
+                }
+                elsif ( @$tags[$i] eq "thesaurus" ) {
+                    $attr = " \@attr 1=Subject-heading-thesaurus ";
+                }
+                else {    # Assume any if no index was specified
+                    $attr = " \@attr 1=Any ";
+                }
+            }         #if @$tags[$i]
+            else {    # Assume any if no index was specified
                 $attr = " \@attr 1=Any ";
             }
-            if ( @$operator[$i] eq 'is' ) {
+
+            my $operator = @$operator[$i];
+            if ( $operator and $operator eq 'is' ) {
                 $attr .= " \@attr 4=1  \@attr 5=100 "
-                  ; ##Phrase, No truncation,all of subfield field must match
+                  ;    ##Phrase, No truncation,all of subfield field must match
             }
-            elsif ( @$operator[$i] eq "=" ) {
+            elsif ( $operator and $operator eq "=" ) {
                 $attr .= " \@attr 4=107 ";    #Number Exact match
             }
-            elsif ( @$operator[$i] eq "start" ) {
+            elsif ( $operator and $operator eq "start" ) {
                 $attr .= " \@attr 3=2 \@attr 4=1 \@attr 5=1 "
                   ;    #Firstinfield Phrase, Right truncated
             }
-            elsif ( @$operator[$i] eq "exact" ) {
+            elsif ( $operator and $operator eq "exact" ) {
                 $attr .= " \@attr 4=1  \@attr 5=100 \@attr 6=3 "
-                  ; ##Phrase, No truncation,all of subfield field must match
+                  ;    ##Phrase, No truncation,all of subfield field must match
             }
             else {
                 $attr .= " \@attr 5=1 \@attr 4=6 "
                   ;    ## Word list, right truncated, anywhere
-                  if ($sortby eq 'Relevance') {
-                      $attr .= "\@attr 2=102 ";
-                  }
+                if ( $sortby eq 'Relevance' ) {
+                    $attr .= "\@attr 2=102 ";
+                }
             }
-            @$value[$i] =~ s/"/\\"/g; # Escape the double-quotes in the search value
-            $attr =$attr."\"".@$value[$i]."\"";
-            $q2 .=$attr;
-            $dosearch=1;
+            @$value[$i] =~
+              s/"/\\"/g;    # Escape the double-quotes in the search value
+            $attr = $attr . "\"" . @$value[$i] . "\"";
+            $q2 .= $attr;
+            $dosearch = 1;
             ++$attr_cnt;
             if ($QParser) {
                 $qpquery .= " $tags->[$i]:\"$value->[$i]\"";
             }
-        }#if value
+        }    #if value
     }
     ##Add how many queries generated
     if (defined $query && $query=~/\S+/){
@@ -266,7 +274,7 @@ sub SearchAuthorities {
         
         ##Here we have to extract MARC record and $authid from ZEBRA AUTHORITIES
         my $rec=$oAResult->record($counter);
-        my $separator=C4::Context->preference('authoritysep');
+        my $separator=C4::Context->preference('AuthoritySeparator');
         my $authrecord = C4::Search::new_record_from_zebra(
             'authorityserver',
             $rec->raw()
@@ -277,12 +285,12 @@ sub SearchAuthorities {
             next;
         }
 
+        SetUTF8Flag( $authrecord );
+
         my $authid=$authrecord->field('001')->data();
         my %newline;
         $newline{authid} = $authid;
         if ( !$skipmetadata ) {
-            my $summary =
-              BuildSummary( $authrecord, $authid, GetAuthTypeCode($authid) );
             my $query_auth_tag =
 "SELECT auth_tag_to_report FROM auth_types WHERE authtypecode=?";
             my $sth = $dbh->prepare($query_auth_tag);
@@ -291,15 +299,18 @@ sub SearchAuthorities {
             my $reported_tag;
             my $mainentry = $authrecord->field($auth_tag_to_report);
             if ($mainentry) {
-
                 foreach ( $mainentry->subfields() ) {
                     $reported_tag .= '$' . $_->[0] . $_->[1];
                 }
             }
-            my $thisauthtype = GetAuthType(GetAuthTypeCode($authid));
+            my $thisauthtypecode = GetAuthTypeCode($authid);
+            my $thisauthtype = GetAuthType($thisauthtypecode);
             unless (defined $thisauthtype) {
-                $thisauthtype = GetAuthType($authtypecode) if $authtypecode;
+                $thisauthtypecode = $authtypecode;
+                $thisauthtype = GetAuthType($authtypecode);
             }
+            my $summary = BuildSummary( $authrecord, $authid, $thisauthtypecode );
+
             $newline{authtype}     = defined($thisauthtype) ?
                                         $thisauthtype->{'authtypetext'} : '';
             $newline{summary}      = $summary;
@@ -852,7 +863,7 @@ sub FindDuplicateAuthority {
         $op = 'and';
     }
     my $query='at:'.$authtypecode.' ';
-    my $filtervalues=qr([\001-\040\!\'\"\`\#\$\%\&\*\+,\-\./:;<=>\?\@\(\)\{\[\]\}_\|\~]);
+    my $filtervalues=qr([\001-\040\Q!'"`#$%&*+,-./:;<=>?@(){[}_|~\E\]]);
     if ($record->field($auth_tag_to_report)) {
         foreach ($record->field($auth_tag_to_report)->subfields()) {
             $_->[1]=~s/$filtervalues/ /g; $query.= " $op he:\"".$_->[1]."\"" if ($_->[0]=~/[A-z]/);
@@ -888,12 +899,20 @@ sub BuildSummary {
     my ($record,$authid,$authtypecode)=@_;
     my $dbh=C4::Context->dbh;
     my %summary;
+    my $summary_template;
     # handle $authtypecode is NULL or eq ""
     if ($authtypecode) {
         my $authref = GetAuthType($authtypecode);
         $summary{authtypecode} = $authref->{authtypecode};
         $summary{type} = $authref->{authtypetext};
-        $summary{summary} = $authref->{summary};
+        $summary_template = $authref->{summary};
+        # for MARC21, the authority type summary displays a label meant for
+        # display
+        if (C4::Context->preference('marcflavour') ne 'UNIMARC') {
+            $summary{label} = $authref->{summary};
+        } else {
+            $summary{summary} = $authref->{summary};
+        }
     }
     my $marc21subfields = 'abcdfghjklmnopqrstuvxyz68';
     my %marc21controlrefs = ( 'a' => 'earlier',
@@ -927,34 +946,36 @@ sub BuildSummary {
 #         feature will be enabled only for UNIMARC for backwards
 #         compatibility.
     if ($summary{summary} and C4::Context->preference('marcflavour') eq 'UNIMARC') {
-        my @fields = $record->fields();
-#             $reported_tag = '$9'.$result[$counter];
-        my @stringssummary;
-        foreach my $field (@fields) {
-            my $tag = $field->tag();
-            my $tagvalue = $field->as_string();
-            my $localsummary= $summary{summary};
-            $localsummary =~ s/\[(.?.?.?.?)$tag\*(.*?)\]/$1$tagvalue$2\[$1$tag$2\]/g;
-            if ($tag<10) {
-                if ($tag eq '001') {
-                    $reported_tag.='$3'.$field->data();
-                }
-            } else {
-                my @subf = $field->subfields;
-                for my $i (0..$#subf) {
-                    my $subfieldcode = $subf[$i][0];
-                    my $subfieldvalue = $subf[$i][1];
-                    my $tagsubf = $tag.$subfieldcode;
-                    $localsummary =~ s/\[(.?.?.?.?)$tagsubf(.*?)\]/$1$subfieldvalue$2\[$1$tagsubf$2\]/g;
+        my @matches = ($summary{summary} =~ m/\[(.*?)(\d{3})([\*a-z0-9])(.*?)\]/g);
+        my (@textbefore, @tag, @subtag, @textafter);
+        for(my $i = 0; $i < scalar @matches; $i++){
+            push @textbefore, $matches[$i] if($i%4 == 0);
+            push @tag,        $matches[$i] if($i%4 == 1);
+            push @subtag,     $matches[$i] if($i%4 == 2);
+            push @textafter,  $matches[$i] if($i%4 == 3);
+        }
+        for(my $i = scalar @tag; $i >= 0; $i--){
+            my $textbefore = $textbefore[$i] || '';
+            my $tag = $tag[$i] || '';
+            my $subtag = $subtag[$i] || '';
+            my $textafter = $textafter[$i] || '';
+            my $value = '';
+            my $field = $record->field($tag);
+            if ( $field ) {
+                if($subtag eq '*') {
+                    if($tag < 10) {
+                        $value = $textbefore . $field->data() . $textafter;
+                    }
+                } else {
+                    my @subfields = $field->subfield($subtag);
+                    if(@subfields > 0) {
+                        $value = $textbefore . join (" - ", @subfields) . $textafter;
+                    }
                 }
             }
-            push @stringssummary, $localsummary if ($localsummary ne $summary{summary});
+            $summary{summary} =~ s/\[\Q$textbefore$tag$subtag$textafter\E\]/$value/;
         }
-        my $resultstring;
-        $resultstring = join(" -- ",@stringssummary);
-        $resultstring =~ s/\[(.*?)\]//g;
-        $resultstring =~ s/\n/<br>/g;
-        $summary{summary}      =  $resultstring;
+        $summary{summary} =~ s/\\n/<br \/>/g;
     }
     my @authorized;
     my @notes;
@@ -967,7 +988,7 @@ sub BuildSummary {
         foreach my $field ($record->field('2..')) {
             push @authorized, {
                 heading => $field->as_string('abcdefghijlmnopqrstuvwxyz'),
-                hemain  => $field->subfield('a'),
+                hemain  => ( $field->subfield('a') // undef ),
                 field   => $field->tag(),
             };
         }
@@ -979,7 +1000,7 @@ sub BuildSummary {
             my $thesaurus = $field->subfield('2') ? "thes. : ".$thesaurus{"$field->subfield('2')"}." : " : '';
             push @seefrom, {
                 heading => $thesaurus . $field->as_string('abcdefghijlmnopqrstuvwxyz'),
-                hemain  => $field->subfield('a'),
+                hemain  => ( $field->subfield('a') // undef ),
                 type    => 'seefrom',
                 field   => $field->tag(),
             };
@@ -993,9 +1014,9 @@ sub BuildSummary {
                 field   => $_->tag,
                 type    => $type,
                 heading => $heading,
-                hemain  => $_->subfield('a'),
+                hemain  => ( $_->subfield('a') // undef ),
                 search  => $heading,
-                authid  => $_->subfield('9'),
+                authid  => ( $_->subfield('9') // undef ),
             }
         } $record->field('5..');
 
@@ -1044,17 +1065,15 @@ sub BuildSummary {
                 $subfields_to_report = 'vxyz';
             }
             if ($subfields_to_report) {
-                my $hemain = $field->subfield( substr($subfields_to_report, 0, 1) );
                 push @authorized, {
                     heading => $field->as_string($subfields_to_report),
-                    hemain  => $hemain,
+                    hemain  => ( $field->subfield( substr($subfields_to_report, 0, 1) ) // undef ),
                     field   => $tag,
                 };
             } else {
-                my $hemain = $field->subfield( 'a' );
                 push @authorized, {
                     heading => $field->as_string(),
-                    hemain  => $hemain,
+                    hemain  => ( $field->subfield( 'a' ) // undef ),
                     field   => $tag,
                 };
             }