From 28d1d74c16be3ac28c51a619ede8567e06a02a27 Mon Sep 17 00:00:00 2001 From: Colin Campbell Date: Fri, 4 Oct 2013 11:01:27 +0100 Subject: [PATCH] Bug 10996: Allow numeric subfields to be stripped on export Regex assumed all numeric characters were part of the tag number This is obviously false as $9 would be a likely candidate to be removed on export. The code can be any printing ascii character other than space according to LoC's website. Also changed regexp to no longer allow a zero length tag number which is nonsensical. The old regex would accept shorter than 3 digit tags but these were not stripped so I've removed that option, considering it a bug not a feature NB assumption that the code makes that a tag is always numeric is incorrect but works in practice. Handling non-numeric tags is a 'To be done' Made code dependent on the regex succeeding. Picking up results from a previous regex on failure can lead to weird hard to identify bugs In the course of testing Paola Rossi spotted that the delete operation was flawed, only removing the first occurence of the specified tag/tag subfield. Reworked the delete loop to operate on all occurences Signed-off-by: Paola Rossi Signed-off-by: Jonathan Druart Signed-off-by: Galen Charlton (cherry picked from commit 248283fc29b46f59c56769a14f8d811cc61834ff) Signed-off-by: Fridolin SOMERS --- tools/export.pl | 29 ++++++++++++++++------------- 1 file changed, 16 insertions(+), 13 deletions(-) diff --git a/tools/export.pl b/tools/export.pl index 40c3b9b8a1..a516a6bbbf 100755 --- a/tools/export.pl +++ b/tools/export.pl @@ -358,19 +358,22 @@ if ( $op eq "export" ) { } if ($export_remove_fields) { - my @fields = split " ", $export_remove_fields; - foreach (@fields) { - /^(\d*)(\w)?$/; - my $field = $1; - my $subfield = $2; - - # skip if this record doesn't have this field - next if not defined $record->field($field); - if ($subfield) { - $record->field($field)->delete_subfields($subfield); - } - else { - $record->delete_field( $record->field($field) ); + for my $f ( split / /, $export_remove_fields ) { + if ( $f =~ m/^(\d{3})(.)?$/ ) { + my ( $field, $subfield ) = ( $1, $2 ); + + # skip if this record doesn't have this field + if ( defined $record->field($field) ) { + if ( defined $subfield ) { + my @tags = $record->field($field); + foreach my $t (@tags) { + $t->delete_subfields($subfield); + } + } + else { + $record->delete_fields($field); + } + } } } } -- 2.39.5