MT 1717 : Opac descriptions for authorised values
[srvgit] / C4 / Biblio.pm
old mode 100644 (file)
new mode 100755 (executable)
index a7c66f9..0e92d90
@@ -57,6 +57,11 @@ BEGIN {
                &GetBiblioItemByBiblioNumber
                &GetBiblioFromItemNumber
                
+               &GetRecordValue
+               &GetFieldMapping
+               &SetFieldMapping
+               &DeleteFieldMapping
+               
                &GetISBDView
 
                &GetMarcNotes
@@ -114,6 +119,19 @@ BEGIN {
        );
 }
 
+eval {
+    my $servers = C4::Context->config('memcached_servers');
+    if ($servers) {
+        require Memoize::Memcached;
+        import Memoize::Memcached qw(memoize_memcached);
+
+        my $memcached = {
+            servers    => [ $servers ],
+            key_prefix => C4::Context->config('memcached_namespace') || 'koha',
+        };
+        memoize_memcached('GetMarcStructure', memcached => $memcached, expire_time => 600); #cache for 10 minutes
+    }
+};
 =head1 NAME
 
 C4::Biblio - cataloging management functions
@@ -479,6 +497,115 @@ sub LinkBibHeadingsToAuthorities {
     return $num_headings_changed;
 }
 
+=head2 GetRecordValue
+
+=over 4
+
+my $values = GetRecordValue($field, $record, $frameworkcode);
+
+=back
+
+Get MARC fields from a keyword defined in fieldmapping table.
+
+=cut
+
+sub GetRecordValue {
+    my ($field, $record, $frameworkcode) = @_;
+    my $dbh = C4::Context->dbh;
+    
+    my $sth = $dbh->prepare('SELECT fieldcode, subfieldcode FROM fieldmapping WHERE frameworkcode = ? AND field = ?');
+    $sth->execute($frameworkcode, $field);
+    
+    my @result = ();
+    
+    while(my $row = $sth->fetchrow_hashref){
+        foreach my $field ($record->field($row->{fieldcode})){
+            if( ($row->{subfieldcode} ne "" && $field->subfield($row->{subfieldcode}))){
+                foreach my $subfield ($field->subfield($row->{subfieldcode})){
+                    push @result, { 'subfield' => $subfield };
+                }
+                
+            }elsif($row->{subfieldcode} eq "") {
+                push @result, {'subfield' => $field->as_string()};
+            }
+        }
+    }
+    
+    return \@result;
+}
+
+=head2 SetFieldMapping
+
+=over 4
+
+SetFieldMapping($framework, $field, $fieldcode, $subfieldcode);
+
+=back
+
+Set a Field to MARC mapping value, if it already exists we don't add a new one.
+
+=cut
+
+sub SetFieldMapping {
+    my ($framework, $field, $fieldcode, $subfieldcode) = @_;
+    my $dbh = C4::Context->dbh;
+    
+    my $sth = $dbh->prepare('SELECT * FROM fieldmapping WHERE fieldcode = ? AND subfieldcode = ? AND frameworkcode = ? AND field = ?');
+    $sth->execute($fieldcode, $subfieldcode, $framework, $field);
+    if(not $sth->fetchrow_hashref){
+        my @args;
+        $sth = $dbh->prepare('INSERT INTO fieldmapping (fieldcode, subfieldcode, frameworkcode, field) VALUES(?,?,?,?)');
+        
+        $sth->execute($fieldcode, $subfieldcode, $framework, $field);
+    }
+}
+
+=head2 DeleteFieldMapping
+
+=over 4
+
+DeleteFieldMapping($id);
+
+=back
+
+Delete a field mapping from an $id.
+
+=cut
+
+sub DeleteFieldMapping{
+    my ($id) = @_;
+    my $dbh = C4::Context->dbh;
+    
+    my $sth = $dbh->prepare('DELETE FROM fieldmapping WHERE id = ?');
+    $sth->execute($id);
+}
+
+=head2 GetFieldMapping
+
+=over 4
+
+GetFieldMapping($frameworkcode);
+
+=back
+
+Get all field mappings for a specified frameworkcode
+
+=cut
+
+sub GetFieldMapping {
+    my ($framework) = @_;
+    my $dbh = C4::Context->dbh;
+    
+    my $sth = $dbh->prepare('SELECT * FROM fieldmapping where frameworkcode = ?');
+    $sth->execute($framework);
+    
+    my @return;
+    while(my $row = $sth->fetchrow_hashref){
+        push @return, $row;
+    }
+    return \@return;
+}
+
 =head2 GetBiblioData
 
 =over 4
@@ -1145,19 +1272,22 @@ sub GetCOinSBiblio {
 =over 4
 
 my $subfieldvalue =get_authorised_value_desc(
-    $tag, $subf[$i][0],$subf[$i][1], '', $taglib, $category);
+    $tag, $subf[$i][0],$subf[$i][1], '', $taglib, $category, $opac);
 Retrieve the complete description for a given authorised value.
 
 Now takes $category and $value pair too.
 my $auth_value_desc =GetAuthorisedValueDesc(
     '','', 'DVD' ,'','','CCODE');
 
+If the optional $opac parameter is set to a true value, displays OPAC descriptions rather than normal ones when they exist.
+
+
 =back
 
 =cut
 
 sub GetAuthorisedValueDesc {
-    my ( $tag, $subfield, $value, $framework, $tagslib, $category ) = @_;
+    my ( $tag, $subfield, $value, $framework, $tagslib, $category, $opac ) = @_;
     my $dbh = C4::Context->dbh;
 
     if (!$category) {
@@ -1181,11 +1311,11 @@ sub GetAuthorisedValueDesc {
     if ( $category ne "" ) {
         my $sth =
             $dbh->prepare(
-                    "SELECT lib FROM authorised_values WHERE category = ? AND authorised_value = ?"
+                    "SELECT lib, lib_opac FROM authorised_values WHERE category = ? AND authorised_value = ?"
                     );
         $sth->execute( $category, $value );
         my $data = $sth->fetchrow_hashref;
-        return $data->{'lib'};
+        return ($opac && $data->{'lib_opac'}) ? $data->{'lib_opac'} : $data->{'lib'};
     }
     else {
         return $value;    # if nothing is found return the original value
@@ -1272,10 +1402,10 @@ sub GetMarcSubjects {
         my $counter = 0;
         my @link_loop;
         # if there is an authority link, build the link with an= subfield9
-        my $subfield9 = $field->subfield('9');
+               my $found9=0;
         for my $subject_subfield (@subfields ) {
             # don't load unimarc subfields 3,4,5
-            next if (($marcflavour eq "UNIMARC") and ($subject_subfield->[0] =~ /3|4|5/ ) );
+            next if (($marcflavour eq "UNIMARC") and ($subject_subfield->[0] =~ /2|3|4|5/ ) );
             # don't load MARC21 subfields 2 (FIXME: any more subfields??)
             next if (($marcflavour eq "MARC21")  and ($subject_subfield->[0] =~ /2/ ) );
             my $code = $subject_subfield->[0];
@@ -1283,11 +1413,13 @@ sub GetMarcSubjects {
             my $linkvalue = $value;
             $linkvalue =~ s/(\(|\))//g;
             my $operator = " and " unless $counter==0;
-            if ($subfield9) {
-                @link_loop = ({'limit' => 'an' ,link => "$subfield9" });
-            } else {
-                push @link_loop, {'limit' => 'su', link => $linkvalue, operator => $operator };
-            }
+            if ($code eq 9) {
+                               $found9 = 1;
+                @link_loop = ({'limit' => 'an' ,link => "$linkvalue" });
+                       }
+                       if (not $found9) {
+                               push @link_loop, {'limit' => 'su', link => $linkvalue, operator => $operator };
+                       }
             my $separator = C4::Context->preference("authoritysep") unless $counter==0;
             # ignore $9
             my @this_link_loop = @link_loop;
@@ -1624,6 +1756,7 @@ $auth_type contains :
 sub TransformHtmlToXml {
     my ( $tags, $subfields, $values, $indicator, $ind_tag, $auth_type ) = @_;
     my $xml = MARC::File::XML::header('UTF-8');
+    $xml .= "<record>\n";
     $auth_type = C4::Context->preference('marcflavour') unless $auth_type;
     MARC::File::XML->default_record_format($auth_type);
     # in UNIMARC, field 100 contains the encoding
@@ -1661,19 +1794,17 @@ sub TransformHtmlToXml {
                 if (   ( @$tags[$i] && @$tags[$i] > 10 )
                     && ( @$values[$i] ne "" ) )
                 {
-                    my $ind1 = substr( @$indicator[$j], 0, 1 );
+                    my $ind1 = _default_ind_to_space(substr( @$indicator[$j], 0, 1 ));
                     my $ind2;
                     if ( @$indicator[$j] ) {
-                        $ind2 = substr( @$indicator[$j], 1, 1 );
+                        $ind2 = _default_ind_to_space(substr( @$indicator[$j], 1, 1 ));
                     }
                     else {
                         warn "Indicator in @$tags[$i] is empty";
                         $ind2 = " ";
                     }
-                    $xml .=
-"<datafield tag=\"@$tags[$i]\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
-                    $xml .=
-"<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
+                    $xml .= "<datafield tag=\"@$tags[$i]\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
+                    $xml .= "<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
                     $first = 0;
                 }
                 else {
@@ -1691,17 +1822,14 @@ sub TransformHtmlToXml {
                         # rest of the fixed fields
                     }
                     elsif ( @$tags[$i] < 10 ) {
-                        $xml .=
-"<controlfield tag=\"@$tags[$i]\">@$values[$i]</controlfield>\n";
+                        $xml .= "<controlfield tag=\"@$tags[$i]\">@$values[$i]</controlfield>\n";
                         $first = 1;
                     }
                     else {
-                        my $ind1 = substr( @$indicator[$j], 0, 1 );
-                        my $ind2 = substr( @$indicator[$j], 1, 1 );
-                        $xml .=
-"<datafield tag=\"@$tags[$i]\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
-                        $xml .=
-"<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
+                        my $ind1 = _default_ind_to_space( substr( @$indicator[$j], 0, 1 ) );
+                        my $ind2 = _default_ind_to_space( substr( @$indicator[$j], 1, 1 ) );
+                        $xml .= "<datafield tag=\"@$tags[$i]\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
+                        $xml .= "<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
                         $first = 0;
                     }
                 }
@@ -1712,14 +1840,12 @@ sub TransformHtmlToXml {
             }
             else {
                 if ($first) {
-                    my $ind1 = substr( @$indicator[$j], 0, 1 );
-                    my $ind2 = substr( @$indicator[$j], 1, 1 );
-                    $xml .=
-"<datafield tag=\"@$tags[$i]\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
+                    my $ind1 = _default_ind_to_space( substr( @$indicator[$j], 0, 1 ) );
+                    my $ind2 = _default_ind_to_space( substr( @$indicator[$j], 1, 1 ) );
+                    $xml .= "<datafield tag=\"@$tags[$i]\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
                     $first = 0;
                 }
-                $xml .=
-"<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
+                $xml .= "<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
             }
         }
         $prevtag = @$tags[$i];
@@ -1737,10 +1863,26 @@ sub TransformHtmlToXml {
         $xml .= "<subfield code=\"a\">$string</subfield>\n";
         $xml .= "</datafield>\n";
     }
+    $xml .= "</record>\n";
     $xml .= MARC::File::XML::footer();
     return $xml;
 }
 
+=head2 _default_ind_to_space
+
+Passed what should be an indicator returns a space
+if its undefined or zero length
+
+=cut
+
+sub _default_ind_to_space {
+    my $s = shift;
+    if (!defined $s || $s eq q{}) {
+        return ' ';
+    }
+    return $s;
+}
+
 =head2 TransformHtmlToMarc
 
     L<$record> = TransformHtmlToMarc(L<$params>,L<$cgi>)
@@ -1813,8 +1955,8 @@ sub TransformHtmlToMarc {
         elsif ($param =~ /^tag_(\d*)_indicator1_/){ # new field start when having 'input name="..._indicator1_..."
             my $tag  = $1;
             
-            my $ind1 = substr($cgi->param($param),0,1);
-            my $ind2 = substr($cgi->param($params->[$i+1]),0,1);
+            my $ind1 = _default_ind_to_space(substr($cgi->param($param),          0, 1));
+            my $ind2 = _default_ind_to_space(substr($cgi->param($params->[$i+1]), 0, 1));
             $newfield=0;
             my $j=$i+2;
             
@@ -1843,8 +1985,8 @@ sub TransformHtmlToMarc {
                         if ( $cgi->param($params->[$j+1]) ne '' ) { # creating only if there is a value (code => value)
                             $newfield = MARC::Field->new(
                                 $tag,
-                                ''.$ind1,
-                                ''.$ind2,
+                                $ind1,
+                                $ind2,
                                 $cgi->param($inner_param) => $cgi->param($params->[$j+1]),
                             );
                         }
@@ -2657,7 +2799,8 @@ sub _AddBiblioNoZebra {
                 foreach (split / /,$line) {
                     next unless $_; # skip  empty values (multiple spaces)
                     # if the entry is already here, improve weight
-                    if ($result{'__RAW__'}->{"$_"} =~ /$biblionumber,\Q$title\E\-(\d+);/) { 
+                    my $tmpstr = $result{'__RAW__'}->{"$_"} || "";
+                    if ($tmpstr =~ /$biblionumber,\Q$title\E\-(\d+);/) {
                         my $weight=$1+1;
                         $result{'__RAW__'}->{"$_"} =~ s/$biblionumber,\Q$title\E\-(\d+);//;
                         $result{'__RAW__'}->{"$_"} .= "$biblionumber,$title-$weight;";
@@ -2668,7 +2811,7 @@ sub _AddBiblioNoZebra {
                         # it exists
                         if ($existing_biblionumbers) {
                             $result{'__RAW__'}->{"$_"} =$existing_biblionumbers;
-                            my $weight=$1+1;
+                            my $weight = ($1 ? $1 : 0) + 1;
                             $result{'__RAW__'}->{"$_"} =~ s/$biblionumber,\Q$title\E\-(\d+);//;
                             $result{'__RAW__'}->{"$_"} .= "$biblionumber,$title-$weight;";
                         # create a new ligne for this entry
@@ -3259,9 +3402,8 @@ sub ModBiblioMarc {
 
     # deal with UNIMARC field 100 (encoding) : create it if needed & set encoding to unicode
     if ( $encoding eq "UNIMARC" ) {
-        my $string;
-        if ( length($record->subfield( 100, "a" )) == 35 ) {
-            $string = $record->subfield( 100, "a" );
+        my $string = $record->subfield( 100, "a" );
+        if ( ($string) && ( length($record->subfield( 100, "a" )) == 35 ) ) {
             my $f100 = $record->field(100);
             $record->delete_field($f100);
         }