Bug 27266: Move GetMarcAuthors to Koha namespace
[srvgit] / C4 / Biblio.pm
index ebebe41..ce2b949 100644 (file)
@@ -35,7 +35,6 @@ BEGIN {
         GetMarcISBN
         GetMarcISSN
         GetMarcSubjects
-        GetMarcAuthors
         GetMarcSeries
         GetMarcUrls
         GetUsedMarcStructure
@@ -61,6 +60,7 @@ BEGIN {
         DelBiblio
         BiblioAutoLink
         LinkBibHeadingsToAuthorities
+        ApplyMarcOverlayRules
         TransformMarcToKoha
         TransformHtmlToMarc
         TransformHtmlToXml
@@ -91,7 +91,7 @@ use Module::Load::Conditional qw( can_load );
 use C4::Koha;
 use C4::Log qw( logaction );    # logaction
 use C4::Budgets;
-use C4::ClassSource qw( GetClassSort );
+use C4::ClassSource qw( GetClassSort GetClassSource );
 use C4::Charset qw(
     nsb_clean
     SetMarcUnicodeFlag
@@ -109,6 +109,7 @@ use Koha::Acquisition::Currencies;
 use Koha::Biblio::Metadatas;
 use Koha::Holds;
 use Koha::ItemTypes;
+use Koha::MarcOverlayRules;
 use Koha::Plugins;
 use Koha::SearchEngine;
 use Koha::SearchEngine::Indexer;
@@ -310,7 +311,7 @@ sub AddBiblio {
 
 =head2 ModBiblio
 
-  ModBiblio( $record,$biblionumber,$frameworkcode, $disable_autolink);
+  ModBiblio($record, $biblionumber, $frameworkcode, $options);
 
 Replace an existing bib record identified by C<$biblionumber>
 with one supplied by the MARC::Record object C<$record>.  The embedded
@@ -326,16 +327,32 @@ in the C<biblio> and C<biblioitems> tables, as well as
 which fields are used to store embedded item, biblioitem,
 and biblionumber data for indexing.
 
-Unless C<$disable_autolink> is passed ModBiblio will relink record headings
+The C<$options> argument is a hashref with additional parameters:
+
+=over 4
+
+=item C<overlay_context>
+
+This parameter is forwarded to L</ApplyMarcOverlayRules> where it is used for
+selecting the current rule set if MARCOverlayRules is enabled.
+See L</ApplyMarcOverlayRules> for more details.
+
+=item C<disable_autolink>
+
+Unless C<disable_autolink> is passed ModBiblio will relink record headings
 to authorities based on settings in the system preferences. This flag allows
 us to not relink records when the authority linker is saving modifications.
 
+=back
+
 Returns 1 on success 0 on failure
 
 =cut
 
 sub ModBiblio {
-    my ( $record, $biblionumber, $frameworkcode, $disable_autolink ) = @_;
+    my ( $record, $biblionumber, $frameworkcode, $options ) = @_;
+    $options //= {};
+
     if (!$record) {
         carp 'No record passed to ModBiblio';
         return 0;
@@ -346,7 +363,7 @@ sub ModBiblio {
         logaction( "CATALOGUING", "MODIFY", $biblionumber, "biblio BEFORE=>" . $newrecord->as_formatted );
     }
 
-    if ( !$disable_autolink && C4::Context->preference('BiblioAddsAuthorities') ) {
+    if ( !$options->{disable_autolink} && C4::Context->preference('BiblioAddsAuthorities') ) {
         BiblioAutoLink( $record, $frameworkcode );
     }
 
@@ -367,6 +384,21 @@ sub ModBiblio {
 
     _strip_item_fields($record, $frameworkcode);
 
+    # apply overlay rules
+    if (   C4::Context->preference('MARCOverlayRules')
+        && $biblionumber
+        && defined $options
+        && exists $options->{overlay_context} )
+    {
+        $record = ApplyMarcOverlayRules(
+            {
+                biblionumber    => $biblionumber,
+                record          => $record,
+                overlay_context => $options->{overlay_context},
+            }
+        );
+    }
+
     # update biblionumber and biblioitemnumber in MARC
     # FIXME - this is assuming a 1 to 1 relationship between
     # biblios and biblioitems
@@ -383,7 +415,7 @@ sub ModBiblio {
     _koha_marc_update_biblioitem_cn_sort( $record, $oldbiblio, $frameworkcode );
 
     # update the MARC record (that now contains biblio and items) with the new record data
-    &ModBiblioMarc( $record, $biblionumber );
+    ModBiblioMarc( $record, $biblionumber );
 
     # modify the other koha tables
     _koha_modify_biblio( $dbh, $oldbiblio, $frameworkcode );
@@ -1265,7 +1297,7 @@ sub GetMarcPrice {
     my @listtags;
     my $subfield;
     
-    if ( $marcflavour eq "MARC21" || $marcflavour eq "NORMARC" ) {
+    if ( $marcflavour eq "MARC21" ) {
         @listtags = ('345', '020');
         $subfield="c";
     } elsif ( $marcflavour eq "UNIMARC" ) {
@@ -1426,6 +1458,11 @@ sub GetAuthorisedValueDesc {
             return $itemtype ? $itemtype->translated_description : q||;
         }
 
+        if ( $tagslib->{$tag}->{$subfield}->{'authorised_value'} eq "cn_source" ) {
+            my $source = GetClassSource($value);
+            return $source ? $source->{description} : q||;
+        }
+
         #---- "true" authorized value
         $category = $tagslib->{$tag}->{$subfield}->{'authorised_value'};
     }
@@ -1456,9 +1493,9 @@ sub GetMarcControlnumber {
         return;
     }
     my $controlnumber = "";
-    # Control number or Record identifier are the same field in MARC21, UNIMARC and NORMARC
+    # Control number or Record identifier are the same field in MARC21 and UNIMARC
     # Keep $marcflavour for possible later use
-    if ($marcflavour eq "MARC21" || $marcflavour eq "UNIMARC" || $marcflavour eq "NORMARC") {
+    if ($marcflavour eq "MARC21" || $marcflavour eq "UNIMARC" ) {
         my $controlnumberField = $record->field('001');
         if ($controlnumberField) {
             $controlnumber = $controlnumberField->data();
@@ -1520,7 +1557,7 @@ sub GetMarcISSN {
     if ( $marcflavour eq "UNIMARC" ) {
         $scope = '011';
     }
-    else {    # assume MARC21 or NORMARC
+    else {    # assume MARC21
         $scope = '022';
     }
     my @marcissns;
@@ -1551,7 +1588,7 @@ sub GetMarcSubjects {
         $mintag = "600";
         $maxtag = "611";
         $fields_filter = '6..';
-    } else { # marc21/normarc
+    } else { # marc21
         $mintag = "600";
         $maxtag = "699";
         $fields_filter = '6..';
@@ -1620,105 +1657,6 @@ sub GetMarcSubjects {
     return \@marcsubjects;
 }    #end getMARCsubjects
 
-=head2 GetMarcAuthors
-
-  authors = GetMarcAuthors($record,$marcflavour);
-
-Get all authors from the MARC record and returns them in an array.
-The authors are stored in different fields depending on MARC flavour
-
-=cut
-
-sub GetMarcAuthors {
-    my ( $record, $marcflavour ) = @_;
-    if (!$record) {
-        carp 'GetMarcAuthors called on undefined record';
-        return;
-    }
-    my ( $mintag, $maxtag, $fields_filter );
-
-    # tagslib useful only for UNIMARC author responsibilities
-    my $tagslib;
-    if ( $marcflavour eq "UNIMARC" ) {
-        # FIXME : we don't have the framework available, we take the default framework. May be buggy on some setups, will be usually correct.
-        $tagslib = GetMarcStructure( 1, '', { unsafe => 1 });
-        $mintag = "700";
-        $maxtag = "712";
-        $fields_filter = '7..';
-    } else { # marc21/normarc
-        $mintag = "700";
-        $maxtag = "720";
-        $fields_filter = '7..';
-    }
-
-    my @marcauthors;
-    my $AuthoritySeparator = C4::Context->preference('AuthoritySeparator');
-
-    foreach my $field ( $record->field($fields_filter) ) {
-        next unless $field->tag() >= $mintag && $field->tag() <= $maxtag;
-        my @subfields_loop;
-        my @link_loop;
-        my @subfields  = $field->subfields();
-        my $count_auth = 0;
-
-        # if there is an authority link, build the link with Koha-Auth-Number: subfield9
-        my $subfield9 = $field->subfield('9');
-        if ($subfield9) {
-            my $linkvalue = $subfield9;
-            $linkvalue =~ s/(\(|\))//g;
-            @link_loop = ( { 'limit' => 'an', 'link' => $linkvalue } );
-        }
-
-        # other subfields
-        my $unimarc3;
-        for my $authors_subfield (@subfields) {
-            next if ( $authors_subfield->[0] eq '9' );
-
-            # unimarc3 contains the $3 of the author for UNIMARC.
-            # For french academic libraries, it's the "ppn", and it's required for idref webservice
-            $unimarc3 = $authors_subfield->[1] if $marcflavour eq 'UNIMARC' and $authors_subfield->[0] =~ /3/;
-
-            # don't load unimarc subfields 3, 5
-            next if ( $marcflavour eq 'UNIMARC' and ( $authors_subfield->[0] =~ /3|5/ ) );
-
-            my $code = $authors_subfield->[0];
-            my $value        = $authors_subfield->[1];
-            my $linkvalue    = $value;
-            $linkvalue =~ s/(\(|\))//g;
-            # UNIMARC author responsibility
-            if ( $marcflavour eq 'UNIMARC' and $code eq '4' ) {
-                $value = GetAuthorisedValueDesc( $field->tag(), $code, $value, '', $tagslib );
-                $linkvalue = "($value)";
-            }
-            # if no authority link, build a search query
-            unless ($subfield9) {
-                push @link_loop, {
-                    limit    => 'au',
-                    'link'   => $linkvalue,
-                    operator => (scalar @link_loop) ? ' and ' : undef
-                };
-            }
-            my @this_link_loop = @link_loop;
-            # do not display $0
-            unless ( $code eq '0') {
-                push @subfields_loop, {
-                    tag       => $field->tag(),
-                    code      => $code,
-                    value     => $value,
-                    link_loop => \@this_link_loop,
-                    separator => (scalar @subfields_loop) ? $AuthoritySeparator : ''
-                };
-            }
-        }
-        push @marcauthors, {
-            MARCAUTHOR_SUBFIELDS_LOOP => \@subfields_loop,
-            authoritylink => $subfield9,
-            unimarc3 => $unimarc3
-        };
-    }
-    return \@marcauthors;
-}
-
 =head2 GetMarcUrls
 
   $marcurls = GetMarcUrls($record,$marcflavour);
@@ -1800,7 +1738,7 @@ sub GetMarcSeries {
         $mintag = "225";
         $maxtag = "225";
         $fields_filter = '2..';
-    } else {    # marc21/normarc
+    } else {    # marc21
         $mintag = "440";
         $maxtag = "490";
         $fields_filter = '4..';
@@ -1996,7 +1934,7 @@ sub PrepHostMarcField {
     my $item = Koha::Items->find($hostitemnumber);
 
        my $hostmarcfield;
-    if ( $marcflavour eq "MARC21" || $marcflavour eq "NORMARC" ) {
+    if ( $marcflavour eq "MARC21" ) {
        
         #main entry
         my $mainentry;
@@ -2086,7 +2024,7 @@ sub TransformHtmlToXml {
 
     my $xml = MARC::File::XML::header('UTF-8');
     $xml .= "<record>\n";
-    $auth_type = C4::Context->preference('marcflavour') unless $auth_type;
+    $auth_type = C4::Context->preference('marcflavour') unless $auth_type; # FIXME auth_type must be removed
     MARC::File::XML->default_record_format($auth_type);
 
     # in UNIMARC, field 100 contains the encoding
@@ -2461,16 +2399,11 @@ sub _adjust_pubyear {
         $retval = $1;
     } elsif( $retval =~ m/(\d\d\d\d)/ && $1 > 0 ) {
         $retval = $1;
-    } elsif( $retval =~ m/
-             (?<year>\d)[-]?[.Xx?]{3}
-            |(?<year>\d{2})[.Xx?]{2}
-            |(?<year>\d{3})[.Xx?]
-            |(?<year>\d)[-]{3}\?
-            |(?<year>\d\d)[-]{2}\?
-            |(?<year>\d{3})[-]\?
-    /xms ) { # the form 198-? occurred in Dutch ISBD rules
-        my $digits = $+{year};
-        $retval = $digits * ( 10 ** ( 4 - length($digits) ));
+    } elsif( $retval =~ m/(?<year>\d{1,3})[.Xx?-]/ ) {
+        # See also bug 24674: enough to look at one unknown year char like .Xx-?
+        # At this point in code 1234? or 1234- already passed the earlier regex
+        # Things like 2-, 1xx, 1??? are now converted to a four positions-year.
+        $retval = $+{year} * ( 10 ** (4-length($+{year})) );
     } else {
         $retval = undef;
     }
@@ -2916,7 +2849,7 @@ sub _koha_delete_biblio_metadata {
 
 =head2 ModBiblioMarc
 
-  &ModBiblioMarc($newrec,$biblionumber);
+  ModBiblioMarc($newrec,$biblionumber);
 
 Add MARC XML data for a biblio to koha
 
@@ -3014,7 +2947,7 @@ sub prepare_host_field {
     my %sfd;
     my $field;
     my $host_field;
-    if ( $marcflavour eq 'MARC21' || $marcflavour eq 'NORMARC' ) {
+    if ( $marcflavour eq 'MARC21' ) {
         if ( $field = $host->field('100') || $host->field('110') || $host->field('11') ) {
             my $s = $field->as_string('ab');
             if ($s) {
@@ -3228,8 +3161,65 @@ sub RemoveAllNsb {
     return $record;
 }
 
-1;
+=head2 ApplyMarcOverlayRules
+
+    my $record = ApplyMarcOverlayRules($params)
+
+Applies marc merge rules to a record.
+
+C<$params> is expected to be a hashref with below keys defined.
+
+=over 4
+
+=item C<biblionumber>
+biblionumber of old record
 
+=item C<record>
+Incoming record that will be merged with old record
+
+=item C<overlay_context>
+hashref containing at least one context module and filter value on
+the form {module => filter, ...}.
+
+=back
+
+Returns:
+
+=over 4
+
+=item C<$record>
+
+Merged MARC record based with merge rules for C<context> applied. If no old
+record for C<biblionumber> can be found, C<record> is returned unchanged.
+Default action when no matching context is found to return C<record> unchanged.
+If no rules are found for a certain field tag the default is to overwrite with
+fields with this field tag from C<record>.
+
+=back
+
+=cut
+
+sub ApplyMarcOverlayRules {
+    my ($params) = @_;
+    my $biblionumber = $params->{biblionumber};
+    my $incoming_record = $params->{record};
+
+    if (!$biblionumber) {
+        carp 'ApplyMarcOverlayRules called on undefined biblionumber';
+        return;
+    }
+    if (!$incoming_record) {
+        carp 'ApplyMarcOverlayRules called on undefined record';
+        return;
+    }
+    my $old_record = GetMarcBiblio({ biblionumber => $biblionumber });
+
+    # Skip overlay rules if called with no context
+    if ($old_record && defined $params->{overlay_context}) {
+        return Koha::MarcOverlayRules->merge_records($old_record, $incoming_record, $params->{overlay_context});
+    }
+    return $incoming_record;
+}
 
 =head2 _after_biblio_action_hooks
 
@@ -3254,6 +3244,8 @@ sub _after_biblio_action_hooks {
     );
 }
 
+1;
+
 __END__
 
 =head1 AUTHOR