From 83addd15eabd60fba5902a5ef41cb256f6091333 Mon Sep 17 00:00:00 2001 From: simith Date: Wed, 27 Aug 2014 08:17:07 -0400 Subject: [PATCH] Bug 6681 - When importing a biblio record via Z39.50, authority links and items also get imported. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit This patch removes the content of subfield 9 for all authority headings and items in biblios imported from a Z39.50 server. Changes: C4/Biblio.pm - new function RemoveItemsAndAuthidsFromRecord added acqui/neworderempty.pl - calls new function cataloguing/addbiblio.pl - calls new function t/Biblio.t - new tests added Testing: I Before applying the patch 0) Add a koha z39.50 server (Home › Administration › Z39.50 servers); 1) in Home > Cataloging click <>; 2) Import a record with an autority link (with zone 100 subzone 9 for example); 3) Validate: The record imported have zone 100, subzone 9; II After applying the patch 1) in Home > Cataloging click <>; 2) Import a record with an autority link (with zone 100 subzone 9 for example); 3) Validate: The record imported don't have the subzone 9 in the zone 100; --- C4/Biblio.pm | 37 +++++++++++++++++++++++++++++++++++++ acqui/neworderempty.pl | 6 ++---- cataloguing/addbiblio.pl | 3 ++- t/Biblio.t | 9 ++++++++- 4 files changed, 49 insertions(+), 6 deletions(-) diff --git a/C4/Biblio.pm b/C4/Biblio.pm index d465cf6..4e0d1b8 100644 --- a/C4/Biblio.pm +++ b/C4/Biblio.pm @@ -136,6 +136,7 @@ BEGIN { &TransformHtmlToMarc &TransformHtmlToXml prepare_host_field + &RemoveItemsAndAuthidsFromRecord ); } @@ -2777,6 +2778,42 @@ sub get_koha_field_from_marc { return $kohafield; } +=head2 RemoveItemsAndAuthidsFromRecord + + RemoveItemsAndAuthidsFromRecord($record); + + Remove all items (952) from the record. + Also removes all authids (subfield 9 in headings) + +=cut + +sub RemoveItemsAndAuthidsFromRecord { + my $record = shift; + my $frameworkcode = shift || ''; + + if (!$record) { + carp('RemoveItemsAndAuthidsFromRecord called with undefined record'); + return; + } + + my ( $itemtag, $itemsubfield ) = GetMarcFromKohaField( "items.itemnumber", $frameworkcode ); + + # Remove all the items from the record + foreach my $item ($record->field($itemtag)) { + $record->delete_field($item); + } + + # Remove all subfield ($9) in the record (marcflavour independent) + my @fields = $record->fields(); + foreach my $field (@fields) { + next if ( $field->is_control_field()); + $field->delete_subfield(code => '9'); + unless($field->subfields()) { + $record->delete_field($field); + } + } +} + =head2 TransformMarcToKohaOneField $result = TransformMarcToKohaOneField( $kohatable, $kohafield, $record, $result, $frameworkcode ) diff --git a/acqui/neworderempty.pl b/acqui/neworderempty.pl index 256175a..57e12b1 100755 --- a/acqui/neworderempty.pl +++ b/acqui/neworderempty.pl @@ -145,10 +145,8 @@ if ( $ordernumber eq '' and defined $params->{'breedingid'}){ my ($marcrecord, $encoding) = MARCfindbreeding($params->{'breedingid'}); die("Could not find the selected record in the reservoir, bailing") unless $marcrecord; - # Remove all the items (952) from the imported record - foreach my $item ($marcrecord->field('952')) { - $marcrecord->delete_field($item); - } + # Do a cleanup on the imported record + RemoveItemsAndAuthidsFromRecord($marcrecord, $params->{'frameworkcode'}); my $duplicatetitle; #look for duplicates diff --git a/cataloguing/addbiblio.pl b/cataloguing/addbiblio.pl index 5b06706..368323b 100755 --- a/cataloguing/addbiblio.pl +++ b/cataloguing/addbiblio.pl @@ -795,7 +795,8 @@ if (($biblionumber) && !($breedingid)){ $record = GetMarcBiblio($biblionumber); } if ($breedingid) { - ( $record, $encoding ) = MARCfindbreeding( $breedingid ) ; + ( $record, $encoding ) = MARCfindbreeding( $breedingid ); + RemoveItemsAndAuthidsFromRecord($record, $frameworkcode) if $record; } #populate hostfield if hostbiblionumber is available diff --git a/t/Biblio.t b/t/Biblio.t index 8662c40..ff05a41 100755 --- a/t/Biblio.t +++ b/t/Biblio.t @@ -17,7 +17,7 @@ use Modern::Perl; -use Test::More tests => 42; +use Test::More tests => 44; use Test::Warn; BEGIN { @@ -155,4 +155,11 @@ warning_is { $ret = RemoveAllNsb() } ok( !defined $ret, 'RemoveAllNsb returns undef if not passed rec'); + +warning_is { @arr = RemoveItemsAndAuthidsFromRecord(undef, q{}) } + { carped => 'RemoveItemsAndAuthidsFromRecord called with undefined record'}, + "RemoveItemsAndAuthidsFromRecord returns carped warning on undef record"; + +ok( !defined $ret, 'RemoveItemsAndAuthidsFromRecord returns undef if not passed rec'); + 1; -- 1.9.1