From 3058caef250d84e145fe3c2efd02c7b34faee13f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Tom=C3=A1s=20Cohen=20Arazi?= Date: Mon, 26 Jan 2026 16:31:00 -0300 Subject: [PATCH] Bug 41714: Add a way to let the authority linker honor frameworks (MARC21) --- C4/Heading.pm | 41 +++++++++++++++++++++++++++++++++++++++-- C4/Heading/MARC21.pm | 38 ++++++++++++++++++++++++++++++++++---- C4/Heading/UNIMARC.pm | 12 +++--------- 3 files changed, 76 insertions(+), 15 deletions(-) diff --git a/C4/Heading.pm b/C4/Heading.pm index 7cf7e8c401..c79a2e739b 100644 --- a/C4/Heading.pm +++ b/C4/Heading.pm @@ -31,6 +31,9 @@ use C4::Context; use Module::Load qw( load ); use List::Util qw( none first ); +# Package-level cache for authority types from frameworks +my %authority_type_cache; + =head1 NAME C4::Heading @@ -71,7 +74,11 @@ sub new_from_field { my $frameworkcode = shift; #FIXME this is not used? my $auth = shift; my $marcflavour = C4::Context->preference('marcflavour'); - my $marc_handler = _marc_format_handler($marcflavour); + + # Enable framework lookup for MARC21 if LinkerUseFrameworkAuthTypes is enabled + my $use_frameworks = $marcflavour eq 'MARC21' + && C4::Context->preference('LinkerUseFrameworkAuthTypes'); + my $marc_handler = _marc_format_handler( $marcflavour, { use_frameworks => $use_frameworks } ); return unless $field; my $tag = $field->tag(); @@ -304,6 +311,35 @@ sub _filter_diacritics { =head1 INTERNAL FUNCTIONS +=head2 _load_authority_types_from_frameworks + +Load authority type mappings from marc_subfield_structure. +Shared by both MARC21 and UNIMARC implementations. +Results are cached at package level. + +=cut + +sub _load_authority_types_from_frameworks { + my $cache_key = shift // 'default'; + + unless ( exists $authority_type_cache{$cache_key} ) { + my $dbh = C4::Context->dbh; + my $sth = $dbh->prepare( + "SELECT DISTINCT tagfield, authtypecode + FROM marc_subfield_structure + WHERE frameworkcode = '' AND authtypecode <> ''" + ); + $sth->execute(); + + $authority_type_cache{$cache_key} = {}; + while ( my ( $tag, $auth_type ) = $sth->fetchrow ) { + $authority_type_cache{$cache_key}->{$tag} = $auth_type; + } + } + + return $authority_type_cache{$cache_key}; +} + =head2 _marc_format_handler Returns a C4::Heading::MARC21 or C4::Heading::UNIMARC object @@ -313,9 +349,10 @@ depending on the selected MARC flavour. sub _marc_format_handler { my $marcflavour = uc shift; + my $params = shift // {}; my $pname = "C4::Heading::$marcflavour"; load $pname; - return $pname->new(); + return $pname->new($params); } =head1 AUTHOR diff --git a/C4/Heading/MARC21.pm b/C4/Heading/MARC21.pm index fc7fad7b9c..6976d1931f 100644 --- a/C4/Heading/MARC21.pm +++ b/C4/Heading/MARC21.pm @@ -245,13 +245,40 @@ my %subdivisions = ( =head2 new - my $marc_handler = C4::Heading::MARC21->new(); + my $marc_handler = C4::Heading::MARC21->new(); + my $marc_handler = C4::Heading::MARC21->new( { use_frameworks => 1 } ); + +Creates a new MARC21 heading handler. + +If use_frameworks is true, authority types are loaded from marc_subfield_structure +instead of using the hardcoded defaults. This allows local customization of +authority types per tag via MARC bibliographic frameworks. =cut sub new { - my $class = shift; - return bless {}, $class; + my $class = shift; + my $params = shift // {}; + + my $self = bless {}, $class; + + if ( $params->{use_frameworks} ) { + $self->_load_from_frameworks(); + } + + return $self; +} + +=head2 _load_from_frameworks + +Load authority type mappings from marc_subfield_structure. +Uses shared method from C4::Heading with package-level caching. + +=cut + +sub _load_from_frameworks { + my $self = shift; + $self->{_framework_overrides} = C4::Heading::_load_authority_types_from_frameworks('marc21'); } =head2 valid_heading_tag @@ -331,7 +358,10 @@ sub parse_heading { my $heading_fields = $auth ? {%$auth_heading_fields} : {%$bib_heading_fields}; my $field_info = $heading_fields->{$tag}; - my $auth_type = $field_info->{'auth_type'}; + + # Use framework override if available, otherwise use hardcoded default + my $auth_type = $self->{_framework_overrides}->{$tag} // $field_info->{'auth_type'}; + my $thesaurus = $tag =~ m/6../ ? _get_subject_thesaurus($field) diff --git a/C4/Heading/UNIMARC.pm b/C4/Heading/UNIMARC.pm index 7c2969dce9..9c928359b9 100644 --- a/C4/Heading/UNIMARC.pm +++ b/C4/Heading/UNIMARC.pm @@ -68,17 +68,11 @@ sub new { my $class = shift; unless ( defined $bib_heading_fields ) { - my $dbh = C4::Context->dbh; - my $sth = $dbh->prepare( - "SELECT tagfield, authtypecode - FROM marc_subfield_structure - WHERE frameworkcode = '' AND authtypecode <> ''" - ); - $sth->execute(); + my $types = C4::Heading::_load_authority_types_from_frameworks('unimarc'); $bib_heading_fields = {}; - while ( my ( $tag, $auth_type ) = $sth->fetchrow ) { + foreach my $tag ( keys %$types ) { $bib_heading_fields->{$tag} = { - auth_type => $auth_type, + auth_type => $types->{$tag}, subfields => 'abcdefghjklmnopqrstvxyz', }; } -- 2.50.1 (Apple Git-155)