@@ -, +, @@ authority headings 1 - Set AutoCreateAuthorities to 'generate' 2 - Set BiblioAddsAuthorities to 'true' 3 - Set CatalogModuleRelink to 'Do' 4 - Find or create a record with: a 100 field with a subfield e preceded by a comma: 100 $aBoring, M. Eugene M ,$e author an 830 field with a volume preceded by a semicolon: 650$aLord of the rings ;$v 3. 5 - Save the records and check the links 6 - Note punctuation is passed through 7 - Save again, auth records are created again 8 - Apply patch 9 - Save again, new auth records are created again --- C4/Biblio.pm | 24 +++++++++++++++--------- C4/Heading/MARC21.pm | 2 +- 2 files changed, 16 insertions(+), 10 deletions(-) --- a/C4/Biblio.pm +++ a/C4/Biblio.pm @@ -542,16 +542,22 @@ sub LinkBibHeadingsToAuthorities { } $field->delete_subfield( code => '9' ) if defined $current_link; - my $authfield = - MARC::Field->new( $authority_type->auth_tag_to_report, - '', '', "a" => "" . $field->subfield('a') ); - map { - $authfield->add_subfields( $_->[0] => $_->[1] ) - if ( $_->[0] =~ /[A-z]/ && $_->[0] ne "a" + my @auth_subfields; + foreach my $subfield ( $field->subfields() ){ + if ( $subfield->[0] =~ /[A-z]/ && C4::Heading::valid_bib_heading_subfield( - $field->tag, $_->[0] ) - ); - } $field->subfields(); + $field->tag, $subfield->[0] ) + ){ + push @auth_subfields, $subfield->[0] => $subfield->[1]; + } + } + # Bib headings contain some ending punctuation that should NOT + # be included in the authority record. Strip those before creation + next unless @auth_subfields; # Don't try to create a record if we have no fields; + my $last_sub = pop @auth_subfields; + $last_sub =~ s/[\s]*[,.:=;!%\/][\s]*$//; + push @auth_subfields, $last_sub; + my $authfield = MARC::Field->new( $authority_type->auth_tag_to_report, '', '', @auth_subfields ); $marcrecordauth->insert_fields_ordered($authfield); # bug 2317: ensure new authority knows it's using UTF-8; currently --- a/C4/Heading/MARC21.pm +++ a/C4/Heading/MARC21.pm @@ -256,7 +256,7 @@ sub _get_search_heading { my $code = $subfields[$i]->[0]; my $code_re = quotemeta $code; my $value = $subfields[$i]->[1]; - $value =~ s/[-,.:=;!%\/]$//; + $value =~ s/[\s]*[-,.:=;!%\/][\s]*$//; next unless $subfields =~ qr/$code_re/; if ($first) { $first = 0; --