From ce9cb2755686bbd86b86a1fca7d855ee4ae96d67 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Fr=C3=A9d=C3=A9ric=20Demians?= <f.demians@tamil.fr>
Date: Mon, 3 Jan 2011 16:32:21 +0200
Subject: [PATCH] Bug 5572 Improve C4::AuthoritiesMarc->merge() function

A new syspref AuthCleanBiblios allows to control how modified info in a
modified authority are propagated to the attached biblio records. By
default, the merge() behavior isn't changed. When AuthCleanBiblio is set
to yes, the subfields of the authority heading are copied to biblio
field. If the biblio field contains subfields that are not anymore in
the authority, they are removed (this is true only for the authority
subfields that are neither ignored nor hidden in the authority editor)

This patch do some code refactoring:

  - New function C4::AuthoritiesMarc::GetBibliosByAuthid
  - New function C4::Biblios::GetBiblionumber($record)
  - Minimizing SQL queries, and caching
---
 C4/AuthoritiesMarc.pm                              | 415 ++++++++++++---------
 C4/Biblio.pm                                       |  21 ++
 installer/data/mysql/sysprefs.sql                  |   1 +
 installer/data/mysql/updatedatabase.pl             |  10 +
 .../en/modules/admin/preferences/authorities.pref  |   8 +
 5 files changed, 275 insertions(+), 180 deletions(-)

diff --git a/C4/AuthoritiesMarc.pm b/C4/AuthoritiesMarc.pm
index dd8be73..c93fa6c 100644
--- a/C4/AuthoritiesMarc.pm
+++ b/C4/AuthoritiesMarc.pm
@@ -16,8 +16,8 @@ package C4::AuthoritiesMarc;
 # You should have received a copy of the GNU General Public License
 # along with Koha; if not, see <http://www.gnu.org/licenses>.
 
-use strict;
-use warnings;
+use Modern::Perl;
+use YAML;
 use C4::Context;
 use MARC::Record;
 use C4::Biblio;
@@ -27,42 +27,43 @@ use C4::AuthoritiesMarc::UNIMARC;
 use C4::Charset;
 use C4::Log;
 use Koha::Authority;
+use Koha::Cache;
 
 use vars qw($VERSION @ISA @EXPORT);
 
 BEGIN {
-	# set the version for version checking
+    # set the version for version checking
     $VERSION = 3.07.00.049;
 
-	require Exporter;
-	@ISA = qw(Exporter);
-	@EXPORT = qw(
-	    &GetTagsLabels
-	    &GetAuthType
-	    &GetAuthTypeCode
-    	&GetAuthMARCFromKohaField 
-
-    	&AddAuthority
-    	&ModAuthority
-    	&DelAuthority
-    	&GetAuthority
-    	&GetAuthorityXML
-
-    	&CountUsage
-    	&CountUsageChildren
-    	&SearchAuthorities
-    
+    require Exporter;
+    @ISA = qw(Exporter);
+    @EXPORT = qw(
+        &GetTagsLabels
+        &GetAuthType
+        &GetAuthTypeCode
+        &GetAuthMARCFromKohaField
+
+        &AddAuthority
+        &ModAuthority
+        &DelAuthority
+        &GetAuthority
+        &GetAuthorityXML
+
+        &CountUsage
+        &CountUsageChildren
+        &SearchAuthorities
+
         &BuildSummary
         &BuildAuthHierarchies
         &BuildAuthHierarchy
         &GenerateHierarchy
-    
-    	&merge
-    	&FindDuplicateAuthority
+
+        &merge
+        &FindDuplicateAuthority
 
         &GuessAuthTypeCode
         &GuessAuthId
- 	);
+    );
 }
 
 
@@ -91,7 +92,7 @@ sub GetAuthMARCFromKohaField {
   my $sth = $dbh->prepare("select tagfield,tagsubfield from auth_subfield_structure where kohafield= ? and authtypecode=? ");
   $sth->execute($kohafield,$authtypecode);
   my ($tagfield,$tagsubfield) = $sth->fetchrow;
-    
+
   return  ($tagfield,$tagsubfield);
 }
 
@@ -271,7 +272,7 @@ sub SearchAuthorities {
     # my ($authidfield,$authidsubfield)=GetAuthMARCFromKohaField($dbh,"auth_header.authid",$authtypecode[0]);
     # my ($linkidfield,$linkidsubfield)=GetAuthMARCFromKohaField($dbh,"auth_header.linkid",$authtypecode[0]);
         while (($counter < $nbresults) && ($counter < ($offset + $length))) {
-        
+
         ##Here we have to extract MARC record and $authid from ZEBRA AUTHORITIES
         my $rec=$oAResult->record($counter);
         my $separator=C4::Context->preference('AuthoritySeparator');
@@ -349,7 +350,7 @@ sub CountUsage {
         ### ZOOM search here
         my $query;
         $query= "an:".$authid;
-  		my ($err,$res,$result) = C4::Search::SimpleSearch($query,0,10);
+                  my ($err,$res,$result) = C4::Search::SimpleSearch($query,0,10);
         if ($err) {
             warn "Error: $err from search $query";
             $result = 0;
@@ -414,18 +415,18 @@ sub GuessAuthTypeCode {
         '182'=>{authtypecode=>'CHRON_SUBD'},
         '185'=>{authtypecode=>'FORM_SUBD'},
     },
-#200 Personal name	700, 701, 702 4-- with embedded 700, 701, 702 600
+#200 Personal name        700, 701, 702 4-- with embedded 700, 701, 702 600
 #                    604 with embedded 700, 701, 702
-#210 Corporate or meeting name	710, 711, 712 4-- with embedded 710, 711, 712 601 604 with embedded 710, 711, 712
-#215 Territorial or geographic name 	710, 711, 712 4-- with embedded 710, 711, 712 601, 607 604 with embedded 710, 711, 712
-#216 Trademark 	716 [Reserved for future use]
-#220 Family name 	720, 721, 722 4-- with embedded 720, 721, 722 602 604 with embedded 720, 721, 722
-#230 Title 	500 4-- with embedded 500 605
-#240 Name and title (embedded 200, 210, 215, or 220 and 230) 	4-- with embedded 7-- and 500 7--  604 with embedded 7-- and 500 500
-#245 Name and collective title (embedded 200, 210, 215, or 220 and 235) 	4-- with embedded 7-- and 501 604 with embedded 7-- and 501 7-- 501
-#250 Topical subject 	606
-#260 Place access 	620
-#280 Form, genre or physical characteristics 	608
+#210 Corporate or meeting name        710, 711, 712 4-- with embedded 710, 711, 712 601 604 with embedded 710, 711, 712
+#215 Territorial or geographic name         710, 711, 712 4-- with embedded 710, 711, 712 601, 607 604 with embedded 710, 711, 712
+#216 Trademark         716 [Reserved for future use]
+#220 Family name         720, 721, 722 4-- with embedded 720, 721, 722 602 604 with embedded 720, 721, 722
+#230 Title         500 4-- with embedded 500 605
+#240 Name and title (embedded 200, 210, 215, or 220 and 230)         4-- with embedded 7-- and 500 7--  604 with embedded 7-- and 500 500
+#245 Name and collective title (embedded 200, 210, 215, or 220 and 235)         4-- with embedded 7-- and 501 604 with embedded 7-- and 501 7-- 501
+#250 Topical subject         606
+#260 Place access         620
+#280 Form, genre or physical characteristics         608
 #
 #
 # Could also be represented with :
@@ -593,7 +594,7 @@ sub AddAuthority {
 # pass the MARC::Record to this function, and it will create the records in the authority table
   my ($record,$authid,$authtypecode) = @_;
   my $dbh=C4::Context->dbh;
-	my $leader='     nz  a22     o  4500';#Leader for incomplete MARC21 record
+        my $leader='     nz  a22     o  4500';#Leader for incomplete MARC21 record
 
 # if authid empty => true add, find a new authid number
     my $format;
@@ -615,17 +616,17 @@ sub AddAuthority {
     }
 
     SetUTF8Flag($record);
-	if ($format eq "MARC21") {
-		if (!$record->leader) {
-			$record->leader($leader);
-		}
-		if (!$record->field('003')) {
-			$record->insert_fields_ordered(
-				MARC::Field->new('003',C4::Context->preference('MARCOrgCode'))
-			);
-		}
-		my $date=POSIX::strftime("%y%m%d",localtime);
-		if (!$record->field('008')) {
+        if ($format eq "MARC21") {
+                if (!$record->leader) {
+                        $record->leader($leader);
+                }
+                if (!$record->field('003')) {
+                        $record->insert_fields_ordered(
+                                MARC::Field->new('003',C4::Context->preference('MARCOrgCode'))
+                        );
+                }
+                my $date=POSIX::strftime("%y%m%d",localtime);
+                if (!$record->field('008')) {
             # Get a valid default value for field 008
             my $default_008 = C4::Context->preference('MARCAuthorityControlField008');
             if(!$default_008 or length($default_008)<34) {
@@ -636,33 +637,33 @@ sub AddAuthority {
             }
 
             $record->insert_fields_ordered( MARC::Field->new('008',$date.$default_008) );
-		}
-		if (!$record->field('040')) {
-		 $record->insert_fields_ordered(
+                }
+                if (!$record->field('040')) {
+                 $record->insert_fields_ordered(
         MARC::Field->new('040','','',
-				'a' => C4::Context->preference('MARCOrgCode'),
-				'c' => C4::Context->preference('MARCOrgCode')
-				) 
-			);
+                                'a' => C4::Context->preference('MARCOrgCode'),
+                                'c' => C4::Context->preference('MARCOrgCode')
+                                )
+                        );
     }
-	}
+        }
 
   if ($format eq "UNIMARCAUTH") {
         $record->leader("     nx  j22             ") unless ($record->leader());
         my $date=POSIX::strftime("%Y%m%d",localtime);
-	my $defaultfield100 = C4::Context->preference('UNIMARCAuthorityField100');
+        my $defaultfield100 = C4::Context->preference('UNIMARCAuthorityField100');
     if (my $string=$record->subfield('100',"a")){
-      	$string=~s/fre50/frey50/;
-      	$record->field('100')->update('a'=>$string);
+              $string=~s/fre50/frey50/;
+              $record->field('100')->update('a'=>$string);
     }
     elsif ($record->field('100')){
           $record->field('100')->update('a'=>$date.$defaultfield100);
-    } else {      
+    } else {
         $record->append_fields(
         MARC::Field->new('100',' ',' '
             ,'a'=>$date.$defaultfield100)
         );
-    }      
+    }
   }
   my ($auth_type_tag, $auth_type_subfield) = get_auth_type_location($authtypecode);
   if (!$authid and $format eq "MARC21") {
@@ -754,7 +755,7 @@ sub ModAuthority {
   } else {
       # save a record in need_merge_authorities table
       my $sqlinsert="INSERT INTO need_merge_authorities (authid, done) ".
-	"VALUES (?,?)";
+        "VALUES (?,?)";
       $dbh->do($sqlinsert,undef,($authid,0));
   }
   logaction( "AUTHORITIES", "MODIFY", $authid, "authority BEFORE=>" . $oldrecord->as_formatted ) if C4::Context->preference("AuthoritiesLog");
@@ -1401,6 +1402,8 @@ sub _get_authid_subfield{
     my ($field)=@_;
     return $field->subfield('9')||$field->subfield('3');
 }
+
+
 =head2 GetHeaderAuthority
 
   $ref= &GetHeaderAuthority( $authid)
@@ -1436,130 +1439,182 @@ sub AddAuthorityTrees{
   return $rq->execute($trees,$authid);
 }
 
+
+# Returns a hashref of heading tag & letters per type of authority.
+# The letters identify the subfields from the heading tag that are
+# displayed in an authority editor tab and are not hidden.
+#
+# For example:
+# GEO:
+#   type: GEO
+#   tag: 151
+#   letters: 68abvxyz
+#   bibtags: 691
+# PERSO_NAME:
+#   type: PERSO_NAME
+#   tag: 100
+#   letters: 68abcdefghjklmnopqrstvxyz
+#   bibtags: []
+# THEME:
+#   type: THEME
+#   tag: 150
+#   letters: 68abvxyz
+#   bibtags: 690|691
+sub auth_heading_def {
+    my ($type, $tag) = @_;
+
+    my $cache = Koha::Cache->get_instance();
+    my $key = "AuthHeading";
+    my $heading = $cache->get_from_cache($key);
+    unless ($heading) {
+        my $sth = C4::Context->dbh->prepare("
+            SELECT DISTINCT
+              auth_types.authtypecode AS type,
+              auth_tag_to_report AS tag,
+              GROUP_CONCAT(DISTINCT tagsubfield SEPARATOR '') AS letters,
+              (SELECT DISTINCT
+                 GROUP_CONCAT(DISTINCT tagfield SEPARATOR '|')
+               FROM
+                 marc_subfield_structure
+               WHERE
+                 authtypecode = auth_types.authtypecode
+              ) AS bibtags
+            FROM
+              auth_types, auth_subfield_structure
+            WHERE
+              auth_types.authtypecode = auth_subfield_structure.authtypecode
+            AND
+              tagfield = auth_tag_to_report
+            AND
+              tab >= 0
+            AND
+              hidden = 0
+            GROUP BY
+              auth_types.authtypecode, auth_tag_to_report
+        ");
+        $sth->execute;
+        $heading = { map { $_->{type} => $_ } @{$sth->fetchall_arrayref({})} };
+        $cache->set_in_cache($key, $heading);
+    }
+    return $heading;
+}
+
+
+=head2 GetBiblioByAuthid
+
+  $records = GetBibliosByAuthid($authid)
+
+returns an arrayref of biblio records linked to an authority identified by its
+authid.
+
+=cut
+
+sub GetBibliosByAuthid {
+    my $authid = shift;
+    my $conn = C4::Context->Zconn("biblioserver", 0);
+    my $result = $conn->search(
+        ZOOM::Query::CCL2RPN->new( "an=$authid", $conn ));
+    my @records;
+    if ( my $count = $result && $result->size() ) {
+        for (my $z = 0; $z < $count; $z++ ) {
+            my $record = C4::Search::new_record_from_zebra(
+                'biblioserver',
+                $result->record($z)->raw()
+            );
+            # Take the biblio from the DB rather than Zebra
+            push @records, GetMarcBiblio(GetBiblionumber($record));
+        }
+    }
+    $conn->destroy();
+    return \@records;
+}
+
+
 =head2 merge
 
-  $ref= &merge(mergefrom,$MARCfrom,$mergeto,$MARCto)
+  $ref= &merge($from_authid, $from_record, $to_authid, $to_record);
 
-Could add some feature : Migrating from a typecode to an other for instance.
-Then we should add some new parameter : bibliotargettag, authtargettag
+Merge two authorties, and modify linked biblio records.
 
 =cut
 
 sub merge {
-    my ($mergefrom,$MARCfrom,$mergeto,$MARCto) = @_;
-    my ($counteditedbiblio,$countunmodifiedbiblio,$counterrors)=(0,0,0);        
-    my $dbh=C4::Context->dbh;
-    my $authtypecodefrom = GetAuthTypeCode($mergefrom);
-    my $authtypecodeto = GetAuthTypeCode($mergeto);
-#     warn "mergefrom : $authtypecodefrom $mergefrom mergeto : $authtypecodeto $mergeto ";
-    # return if authority does not exist
-    return "error MARCFROM not a marcrecord ".Data::Dumper::Dumper($MARCfrom) if scalar($MARCfrom->fields()) == 0;
-    return "error MARCTO not a marcrecord".Data::Dumper::Dumper($MARCto) if scalar($MARCto->fields()) == 0;
-    # search the tag to report
-    my $sth = $dbh->prepare("select auth_tag_to_report from auth_types where authtypecode=?");
-    $sth->execute($authtypecodefrom);
-    my ($auth_tag_to_report_from) = $sth->fetchrow;
-    $sth->execute($authtypecodeto);
-    my ($auth_tag_to_report_to) = $sth->fetchrow;
-    
-    my @record_to;
-    @record_to = $MARCto->field($auth_tag_to_report_to)->subfields() if $MARCto->field($auth_tag_to_report_to);
-    my @record_from;
-    @record_from = $MARCfrom->field($auth_tag_to_report_from)->subfields() if $MARCfrom->field($auth_tag_to_report_from);
-    
-    my @reccache;
-    # search all biblio tags using this authority.
-    #Getting marcbiblios impacted by the change.
-    #zebra connection
-    my $oConnection=C4::Context->Zconn("biblioserver",0);
-    # We used to use XML syntax here, but that no longer works.
-    # Thankfully, we don't need it.
-    my $query;
-    $query= "an=".$mergefrom;
-    my $oResult = $oConnection->search(new ZOOM::Query::CCL2RPN( $query, $oConnection ));
-    my $count = 0;
-    if  ($oResult) {
-        $count=$oResult->size();
-    }
-    my $z=0;
-    while ( $z<$count ) {
-        my $marcrecordzebra = C4::Search::new_record_from_zebra(
-            'biblioserver',
-            $oResult->record($z)->raw()
-        );
-        my ( $biblionumbertagfield, $biblionumbertagsubfield ) = &GetMarcFromKohaField( "biblio.biblionumber", '' );
-        my $i = ($biblionumbertagfield < 10)
-            ? $marcrecordzebra->field( $biblionumbertagfield )->data
-            : $marcrecordzebra->subfield( $biblionumbertagfield, $biblionumbertagsubfield );
-        my $marcrecorddb = GetMarcBiblio($i);
-        push @reccache, $marcrecorddb;
-        $z++;
-    }
-    $oResult->destroy();
-    #warn scalar(@reccache)." biblios to update";
-    # Get All candidate Tags for the change 
-    # (This will reduce the search scope in marc records).
-    $sth = $dbh->prepare("select distinct tagfield from marc_subfield_structure where authtypecode=?");
-    $sth->execute($authtypecodefrom);
-    my @tags_using_authtype;
-    while (my ($tagfield) = $sth->fetchrow) {
-        push @tags_using_authtype,$tagfield ;
+
+    # First, build a hashref with two keys, from & to, giving info about
+    # authorities to be merged:
+    # from:
+    #   id: 5391
+    #   tag: 151
+    #   type: GEO
+    #   subf: => all MARC::Field heading subfields
+    #     -
+    #       - a
+    #       - Afrique orientale britannique (1888-1920)
+    #   letters: 68abvxyz
+    #   bibtags: => biblio records tag containing this authority
+    #     - 691
+    #     - 692
+    # to:
+    my $heading = auth_heading_def();
+    my $auth;
+    for (qw/ from to /) {
+        my $a = {};
+        my $id = $a->{id} = shift;
+        my $record = shift;
+        return "Invalid $_ MARC record " . Dump($record) if $record->fields() == 0;
+        my $type = $a->{type} = GetAuthTypeCode($id);
+        my $h = $heading->{$type};
+        $a->{$_} = $h->{$_} for qw/tag letters bibtags/;
+        $a->{subf} = [ $record->field($a->{tag})->subfields() ];
+        $auth->{$_} = $a;
     }
-    my $tag_to=0;  
-    if ($authtypecodeto ne $authtypecodefrom){  
-        # If many tags, take the first
-        $sth->execute($authtypecodeto);    
-        $tag_to=$sth->fetchrow;
-        #warn $tag_to;    
-    }  
-    # BulkEdit marc records
-    # May be used as a template for a bulkedit field  
-    foreach my $marcrecord(@reccache){
+
+    # Is is necessary to change biblio record tag since the target authority
+    # has another type?
+    my $tag_to = $auth->{to}->{type} ne $auth->{from}->{type}
+                 ? $auth->{to}->{bibtags}->[0] : 0;
+    my $auth_clean_biblios = C4::Context->preference('AuthCleanBiblios');
+
+    # Modify all biblios containing the 'from' authority
+    my $modified = 0;
+    foreach my $record ( @{GetBibliosByAuthid($auth->{from}->{id})} ) {
         my $update = 0;
-        foreach my $tagfield (@tags_using_authtype){
-#             warn "tagfield : $tagfield ";
-            foreach my $field ($marcrecord->field($tagfield)){
-                # biblio is linked to authority with $9 subfield containing authid
-                my $auth_number=$field->subfield("9");
-                my $tag=$field->tag();          
-                if ($auth_number==$mergefrom) {
-                my $field_to=MARC::Field->new(($tag_to?$tag_to:$tag),$field->indicator(1),$field->indicator(2),"9"=>$mergeto);
-		my $exclude='9';
-                foreach my $subfield (grep {$_->[0] ne '9'} @record_to) {
-                    $field_to->add_subfields($subfield->[0] =>$subfield->[1]);
-		    $exclude.= $subfield->[0];
-                }
-		$exclude='['.$exclude.']';
-#		add subfields in $field not included in @record_to
-		my @restore= grep {$_->[0]!~/$exclude/} $field->subfields();
-                foreach my $subfield (@restore) {
-                   $field_to->add_subfields($subfield->[0] =>$subfield->[1]);
-		}
-                $marcrecord->delete_field($field);
-                $marcrecord->insert_grouped_field($field_to);            
-                $update=1;
-                }
-            }#for each tag
-        }#foreach tagfield
-        my ($bibliotag,$bibliosubf) = GetMarcFromKohaField("biblio.biblionumber","") ;
-        my $biblionumber;
-        if ($bibliotag<10){
-            $biblionumber=$marcrecord->field($bibliotag)->data;
-        }
-        else {
-            $biblionumber=$marcrecord->subfield($bibliotag,$bibliosubf);
+        foreach my $field ($record->field($auth->{from}->{bibtags})) {
+            # biblio is linked to authority with $9 subfield containing authid
+            next unless $auth->{from}->{id} == $field->subfield('9');
+            my $field_to = MARC::Field->new(
+                $tag_to ? $tag_to : $field->tag,
+                $field->indicator(1), $field->indicator(2),
+                9 => $auth->{to}->{id} );
+            my $exclude = '9';
+            foreach my $subfield (grep {$_->[0] ne '9'} @{$auth->{to}->{subf}}) {
+                $field_to->add_subfields($subfield->[0] => $subfield->[1]);
+                $exclude .= $subfield->[0];
+            }
+            $exclude .= $auth->{to}->{letters} if $auth_clean_biblios;
+            $exclude = "[$exclude]";
+            # Add subfields that are in the biblio field but are not in
+            # authority heading
+            my @restore = grep { $_->[0] !~ /$exclude/ } $field->subfields();
+            foreach my $subfield (@restore) {
+               $field_to->add_subfields($subfield->[0] => $subfield->[1]);
+            }
+            $record->delete_field($field);
+            $record->insert_grouped_field($field_to);
+            $update = 1;
         }
+        my $biblionumber = GetBiblionumber($record);
         unless ($biblionumber){
-            warn "pas de numéro de notice bibliographique dans : ".$marcrecord->as_formatted;
+            warn "No biblionumber in: " . $record->as_formatted;
             next;
         }
-        if ($update==1){
-            &ModBiblio($marcrecord,$biblionumber,GetFrameworkCode($biblionumber)) ;
-            $counteditedbiblio++;
-            warn $counteditedbiblio if (($counteditedbiblio % 10) and $ENV{DEBUG});
-        }    
-    }#foreach $marc
-    return $counteditedbiblio;  
+        if ( $update ) {
+            ModBiblio($record, $biblionumber, GetFrameworkCode($biblionumber));
+            $modified++;
+            warn $modified if (($modified % 10) and $ENV{DEBUG});
+        }
+    }
+    return $modified;
   # now, find every other authority linked with this authority
   # now, find every other authority linked with this authority
 #   my $oConnection=C4::Context->Zconn("authorityserver");
@@ -1567,7 +1622,7 @@ sub merge {
 # # att 9210               Auth-Internal-authtype
 # # att 9220               Auth-Internal-LN
 # # ccl.properties to add for authorities
-#   $query= "= ".$mergefrom;
+#   $query= "= ".$auth->{from}->{id};
 #   my $oResult = $oConnection->search(new ZOOM::Query::CCL2RPN( $query, $oConnection ));
 #   my $count=$oResult->size() if  ($oResult);
 #   my @reccache;
@@ -1589,9 +1644,9 @@ sub merge {
 #       my @tags = $marcrecord->field($tagfield);
 #       foreach my $tag (@tags){
 #         my $tagsubs=$tag->subfield("9");
-#     #warn "$tagfield:$tagsubs:$mergefrom";
-#         if ($tagsubs== $mergefrom) {
-#           $tag->update("9" =>$mergeto);
+#     #warn "$tagfield:$tagsubs:$auth->{from}->{id}";
+#         if ($tagsubs== $auth->{from}->{id}) {
+#           $tag->update("9" =>$auth->{to}->{id});
 #           foreach my $subfield (@record_to) {
 #     #        warn "$subfield,$subfield->[0],$subfield->[1]";
 #             $tag->update($subfield->[0] =>$subfield->[1]);
diff --git a/C4/Biblio.pm b/C4/Biblio.pm
index 2e8827a..405799c 100644
--- a/C4/Biblio.pm
+++ b/C4/Biblio.pm
@@ -93,6 +93,7 @@ BEGIN {
       &GetMarcFromKohaField
       &GetMarcSubfieldStructureFromKohaField
       &GetFrameworkCode
+      &GetBiblionumber
       &TransformKohaToMarc
       &PrepHostMarcField
 
@@ -2196,6 +2197,26 @@ sub GetFrameworkCode {
     return $frameworkcode;
 }
 
+
+=head2 GetBiblionumber
+
+  $biblionumber = GetBiblionumber($record);
+
+Returns the biblionumber of a given biblio record.
+
+=cut
+sub GetBiblionumber {
+    my $record = shift;
+
+    return unless $record;
+
+    my ($tag, $letter) = GetMarcFromKohaField("biblio.biblionumber", "");
+    $tag < 10
+        ? $record->field($tag)->data
+        : $record->subfield($tag, $letter);
+}
+
+
 =head2 TransformKohaToMarc
 
     $record = TransformKohaToMarc( $hash )
diff --git a/installer/data/mysql/sysprefs.sql b/installer/data/mysql/sysprefs.sql
index 2e4a019..65a4be2 100644
--- a/installer/data/mysql/sysprefs.sql
+++ b/installer/data/mysql/sysprefs.sql
@@ -120,6 +120,7 @@ INSERT INTO systempreferences ( `variable`, `value`, `options`, `explanation`, `
 ('DisplayMultiPlaceHold','1','','Display the ability to place multiple holds or not','YesNo'),
 ('DisplayOPACiconsXSLT','1','','If ON, displays the format, audience, and material type icons in XSLT MARC21 results and detail pages in the OPAC.','YesNo'),
 ('dontmerge','1',NULL,'If ON, modifying an authority record will not update all associated bibliographic records immediately, ask your system administrator to enable the merge_authorities.pl cron job','YesNo'),
+('AuthCleanBiblios','0',NULL,'If ON, attached biblio records related fields are cleaned when an authority is updated','YesNo'),
 ('DumpTemplateVarsIntranet',  '0', NULL ,  'If enabled, dump all Template Toolkit variable to a comment in the html source for the staff intranet.',  'YesNo'),
 ('DumpTemplateVarsOpac',  '0', NULL ,  'If enabled, dump all Template Toolkit variable to a comment in the html source for the opac.',  'YesNo'),
 ('EasyAnalyticalRecords','0','','If on, display in the catalogue screens tools to easily setup analytical record relationships','YesNo'),
diff --git a/installer/data/mysql/updatedatabase.pl b/installer/data/mysql/updatedatabase.pl
index 8a1d1b0..aa3c403 100755
--- a/installer/data/mysql/updatedatabase.pl
+++ b/installer/data/mysql/updatedatabase.pl
@@ -11341,6 +11341,16 @@ if ( CheckVersion($DBversion) ) {
     SetVersion($DBversion);
 }
 
+$DBversion = "3.21.00.XXX";
+if ( CheckVersion($DBversion) ) {
+    $dbh->do(q{
+        INSERT IGNORE INTO systempreferences (variable,value,explanation,options,type)
+        VALUES ('AuthCleanBiblios','0','If ON, attached biblio records related fields are cleaned when an authority is updated','','YesNo')
+    });
+    print "Upgrade to $DBversion done (Bug 5572: Cleaning attached biblio records when updating an authority)\n";
+    SetVersion($DBversion);
+}
+
 # DEVELOPER PROCESS, search for anything to execute in the db_update directory
 # SEE bug 13068
 # if there is anything in the atomicupdate, read and execute it.
diff --git a/koha-tmpl/intranet-tmpl/prog/en/modules/admin/preferences/authorities.pref b/koha-tmpl/intranet-tmpl/prog/en/modules/admin/preferences/authorities.pref
index 2762411..307228e 100644
--- a/koha-tmpl/intranet-tmpl/prog/en/modules/admin/preferences/authorities.pref
+++ b/koha-tmpl/intranet-tmpl/prog/en/modules/admin/preferences/authorities.pref
@@ -31,6 +31,14 @@ Authorities:
                   no: Do
             - automatically update attached biblios when changing an authority record. If this is off, please ask your administrator to enable the merge_authority.pl cronjob.
         -
+            - When updating an authority
+            - pref: AuthCleanBiblios
+              default: no
+              choices:
+                  yes: clean
+                  no: "don't clean"
+            - the attached biblio records (see merge preference). Cleaning means removing subfields of the biblio record fields linked to the authority that are not present in the authority heading tag, specifically the subfields that are neither ignored nor hidden in the authority editor.
+        -
             - Use the following text for the contents of MARC21 authority control field 008 position 06-39 (fixed length data elements). Do NOT include the date (position 00-05).
             - pref: MARCAuthorityControlField008
               default: "|| aca||aabn           | a|a     d"
-- 
2.6.2