[Koha-patches] [PATCH] Bug Fixing merge_authority.pl
Henri-Damien LAURENT
henridamien.laurent at biblibre.com
Sat Aug 9 03:28:47 CEST 2008
merge works on the fly now.
But for an obscure reason, merge_authority.pl fails to update database when lanched on command line.
Adding one table to LOCK for noZebra UPDATE in Biblio.pm
You should remove C4::Search from merg_authority.pl
---
C4/AuthoritiesMarc.pm | 120 +++++++++++++++++-------------
C4/Biblio.pm | 5 +-
authorities/authorities.pl | 4 +-
misc/migration_tools/merge_authority.pl | 79 ++++++++------------
4 files changed, 103 insertions(+), 105 deletions(-)
diff --git a/C4/AuthoritiesMarc.pm b/C4/AuthoritiesMarc.pm
index d3d60c0..0f5f49d 100644
--- a/C4/AuthoritiesMarc.pm
+++ b/C4/AuthoritiesMarc.pm
@@ -538,8 +538,7 @@ sub AddAuthority {
,'a'=>$date."afrey50 ba0")
);
}
- }
-
+ }
my ($auth_type_tag, $auth_type_subfield) = get_auth_type_location($authtypecode);
if (!$authid and $format eq "MARC21") {
# only need to do this fix when modifying an existing authority
@@ -604,12 +603,8 @@ sub DelAuthority {
sub ModAuthority {
my ($authid,$record,$authtypecode,$merge)=@_;
my $dbh=C4::Context->dbh;
-# my ($oldrecord)=&GetAuthority($authid);
-# if ($oldrecord eq $record) {
-# return;
-# }
-# my $sth=$dbh->prepare("update auth_header set marc=?,marcxml=? where authid=?");
#Now rewrite the $record to table with an add
+ my $oldrecord=GetAuthority($authid);
$authid=AddAuthority($record,$authid,$authtypecode);
### If a library thinks that updating all biblios is a long process and wishes to leave that to a cron job to use merge_authotities.p
@@ -628,7 +623,7 @@ sub ModAuthority {
print AUTH $authid;
close AUTH;
} else {
-# &merge($authid,$record,$authid,$record);
+ &merge($authid,$oldrecord,$authid,$record);
}
return $authid;
}
@@ -1149,14 +1144,15 @@ Then we should add some new parameter : bibliotargettag, authtargettag
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);
# return if authority does not exist
my @X = $MARCfrom->fields();
- return if $#X == -1;
+ return "error MARCFROM not a marcrecord ".Data::Dumper::Dumper($MARCfrom) if $#X == -1;
@X = $MARCto->fields();
- return if $#X == -1;
+ return "error MARCTO not a marcrecord".Data::Dumper::Dumper($MARCto) if $#X == -1;
# search the tag to report
my $sth = $dbh->prepare("select auth_tag_to_report from auth_types where authtypecode=?");
$sth->execute($authtypecodefrom);
@@ -1167,62 +1163,82 @@ sub merge {
my @record_from;
@record_from = $MARCfrom->field($auth_tag_to_report)->subfields() if $MARCfrom->field($auth_tag_to_report);
+ my @reccache;
# search all biblio tags using this authority.
- $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."9" ;
- }
-
+ #Getting marcbiblios impacted by the change.
if (C4::Context->preference('NoZebra')) {
- warn "MERGE TO DO";
+ #nozebra way
+ my $dbh=C4::Context->dbh;
+ my $rq=$dbh->prepare(qq(SELECT biblionumbers from nozebra where indexname="an" and server="biblioserver" and value="$mergefrom" ));
+ $rq->execute;
+ while (my $biblionumbers=$rq->fetchrow){
+ my @biblionumbers=split /;/,$biblionumbers;
+ map {
+ my $biblionumber=$1 if ($_=~/(\d+),.*/);
+ my $marc=GetMarcBiblio($biblionumber);
+ push @reccache,$marc;
+ } @biblionumbers;
+ }
} else {
- # now, find every biblio using this authority
- my $oConnection=C4::Context->Zconn("biblioserver");
+ #zebra connection
+ my $oConnection=C4::Context->Zconn("biblioserver",0);
my $query;
- $query= "an= ".$mergefrom;
+ $query= "an=".$mergefrom;
my $oResult = $oConnection->search(new ZOOM::Query::CCL2RPN( $query, $oConnection ));
my $count=$oResult->size() if ($oResult);
- my @reccache;
my $z=0;
while ( $z<$count ) {
- my $rec;
- $rec=$oResult->record($z);
+ my $rec;
+ $rec=$oResult->record($z);
my $marcdata = $rec->raw();
- push @reccache, $marcdata;
+ push @reccache, $marcdata;
$z++;
}
- $oResult->destroy();
- foreach my $marc(@reccache){
- my $update;
- my $marcrecord;
- $marcrecord = MARC::File::USMARC::decode($marc);
- foreach my $tagfield (@tags_using_authtype){
- $tagfield=substr($tagfield,0,3);
- 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);
- foreach my $subfield (@record_to) {
- # warn "$subfield,$subfield->[0],$subfield->[1]";
- $tag->update($subfield->[0] =>$subfield->[1]);
- }#for $subfield
+ $oConnection->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 ;
+ }
+ 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){
+ my $update;
+ $marcrecord= MARC::File::USMARC::decode($marcrecord) unless(C4::Context->preference('NoZebra'));
+ foreach my $tagfield (@tags_using_authtype){
+ foreach my $field ($marcrecord->field($tagfield)){
+ 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);
+ foreach my $subfield (@record_to) {
+ $field_to->add_subfields($subfield->[0] =>$subfield->[1]);
+ }
+ $field->replace_with($field_to);
+ $update=1;
}
- $marcrecord->delete_field($tag);
- $marcrecord->add_fields($tag);
- $update=1;
}#for each tag
- }#foreach tagfield
- my $oldbiblio = TransformMarcToKoha($dbh,$marcrecord,"") ;
- if ($update==1){
+ }#foreach tagfield
+ my $oldbiblio = TransformMarcToKoha($dbh,$marcrecord,"") ;
+ if ($update==1){
&ModBiblio($marcrecord,$oldbiblio->{'biblionumber'},GetFrameworkCode($oldbiblio->{'biblionumber'})) ;
- }
-
- }#foreach $marc
- }
+ $counteditedbiblio++;
+ warn $counteditedbiblio if (($counteditedbiblio % 10) and $ENV{DEBUG});
+ }
+ }#foreach $marc
+ return $counteditedbiblio;
# now, find every other authority linked with this authority
# my $oConnection=C4::Context->Zconn("authorityserver");
# my $query;
diff --git a/C4/Biblio.pm b/C4/Biblio.pm
index a0406db..e4e2dc2 100755
--- a/C4/Biblio.pm
+++ b/C4/Biblio.pm
@@ -2140,8 +2140,8 @@ sub ModZebra {
# lock the nozebra table : we will read index lines, update them in Perl process
# and write everything in 1 transaction.
# lock the table to avoid someone else overwriting what we are doing
- $dbh->do('LOCK TABLES nozebra WRITE,biblio WRITE,biblioitems WRITE, systempreferences WRITE, auth_types WRITE, auth_header WRITE');
- my %result; # the result hash that will be builded by deletion / add, and written on mySQL at the end, to improve speed
+ $dbh->do('LOCK TABLES nozebra WRITE,biblio WRITE,biblioitems WRITE, systempreferences WRITE, auth_types WRITE, auth_header WRITE, auth_subfield_structure READ');
+ my %result; # the result hash that will be built by deletion / add, and written on mySQL at the end, to improve speed
if ($op eq 'specialUpdate') {
# OK, we have to add or update the record
# 1st delete (virtually, in indexes), if record actually exists
@@ -2163,7 +2163,6 @@ sub ModZebra {
}
}
$dbh->do('UNLOCK TABLES');
-
} else {
#
# we use zebra, just fill zebraqueue table
diff --git a/authorities/authorities.pl b/authorities/authorities.pl
index 26da895..a0ce203 100755
--- a/authorities/authorities.pl
+++ b/authorities/authorities.pl
@@ -580,7 +580,7 @@ if ($op eq "add") {
# it is not a duplicate (determined either by Koha itself or by user checking it's not a duplicate)
if (!$duplicateauthid or $confirm_not_duplicate) {
if ($is_a_modif ) {
- ModAuthority($authid,$record,$authtypecode,1);
+ ModAuthority($authid,$record,$authtypecode);
} else {
($authid) = AddAuthority($record,$authid,$authtypecode);
}
@@ -597,7 +597,7 @@ if ($op eq "add") {
}
} elsif ($op eq "delete") {
#------------------------------------------------------------------------------------------------------------------------------
- &AUTHdelauthority($authid);
+ &DelAuthority($authid);
if ($nonav){
print $input->redirect("auth_finder.pl");
}else{
diff --git a/misc/migration_tools/merge_authority.pl b/misc/migration_tools/merge_authority.pl
index 10d6aff..6345c9d 100755
--- a/misc/migration_tools/merge_authority.pl
+++ b/misc/migration_tools/merge_authority.pl
@@ -11,18 +11,20 @@ BEGIN {
# Koha modules used
use C4::Context;
+use C4::Search;
use C4::Biblio;
use C4::AuthoritiesMarc;
use Time::HiRes qw(gettimeofday);
use Getopt::Long;
-my ($version, $verbose, $mergefrom,$mergeto,$noconfirm);
+my ($version, $verbose, $mergefrom,$mergeto,$noconfirm,$batch);
GetOptions(
'h' => \$version,
'f:s' => \$mergefrom,
't:s' => \$mergeto,
'v' => \$verbose,
'n' => \$noconfirm,
+ 'b' => \$batch,
);
if ($version || ($mergefrom eq '')) {
@@ -34,6 +36,7 @@ parameters :
\tf : the authority number to merge (the one that can be deleted after the merge).
\tt : the authority number where to merge
\tn : don't ask for confirmation (useful for batch mergings, should not be used on command line)
+\tb : batch Merging
All biblios with the authority in -t will be modified to be "connected" to authority -f
SAMPLE :
@@ -49,11 +52,11 @@ my $dbh = C4::Context->dbh;
# my @subf = $subfields =~ /(##\d\d\d##.)/g;
$|=1; # flushes output
-my $authfrom = AUTHgetauthority($mergefrom);
-my $authto = AUTHgetauthority($mergeto);
+my $authfrom = GetAuthority($mergefrom);
+my $authto = GetAuthority($mergeto);
-my $authtypecodefrom = AUTHfind_authtypecode($mergefrom);
-my $authtypecodeto = AUTHfind_authtypecode($mergeto);
+my $authtypecodefrom = GetAuthTypeCode($mergefrom);
+my $authtypecodeto = GetAuthTypeCode($mergeto);
unless ($noconfirm) {
print "************\n";
@@ -71,49 +74,29 @@ unless ($noconfirm) {
}
my $starttime = gettimeofday;
print "Merging\n" unless $noconfirm;
-
-# 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) = $sth->fetchrow;
-# my $record_to_report = $authto->field($auth_tag_to_report);
-print "Reporting authority tag $auth_tag_to_report :\n" if $verbose;
-my @record_to = $authto->field($auth_tag_to_report)->subfields();
-my @record_from = $authfrom->field($auth_tag_to_report)->subfields();
-
-# search all biblio tags using this authority.
-$sth = $dbh->prepare("select distinct tagfield from marc_subfield_structure where authtypecode=?");
-$sth->execute($authtypecodefrom);
-my $tags_using_authtype;
-while (my ($tagfield) = $sth->fetchrow) {
- $tags_using_authtype.= "'".$tagfield."',";
-}
-chop $tags_using_authtype;
-# now, find every biblio using this authority
-my $query = "select bibid,tag,tag_indicator,tagorder,subfieldcode,subfieldorder from marc_subfield_table where tag in ($tags_using_authtype) and subfieldcode='9' and subfieldvalue='$mergefrom'";
-$sth = $dbh->prepare($query);
-$sth->execute;
-my $nbdone;
-# and delete entries before recreating them
-while (my ($bibid,$tag,$tag_indicator,$tagorder,$subfieldcode,$subfieldorder) = $sth->fetchrow) {
- my $biblio = GetMarcBiblio($bibid);
- print "BEFORE : ".$biblio->as_formatted."\n" if $verbose;
- # now, we know what uses the authority & where.
- # delete all subfields that are in the same tag/tagorder and that are in the authority (& that are not in tab ignore in the biblio)
- # then recreate them with the new authority.
- foreach my $subfield (@record_from) {
- &MARCdelsubfield($bibid,$tag,$tagorder,$subfield->[0]);
- }
- &MARCdelsubfield($dbh,$bibid,$tag,$tagorder,'9');
- foreach my $subfield (@record_to) {
- &MARCaddsubfield($bibid,$tag,$tag_indicator,$tagorder,$subfield->[0],$subfieldorder,$subfield->[1]);
+if ($batch) {
+ my @authlist;
+ my $cgidir = C4::Context->intranetdir ."/cgi-bin";
+ unless (opendir(DIR, "$cgidir/localfile/modified_authorities")) {
+ $cgidir = C4::Context->intranetdir;
+ opendir(DIR, "$cgidir/localfile/modified_authorities") || die "can't opendir $cgidir/localfile/modified_authorities: $!";
+ }
+ while (my $authid = readdir(DIR)) {
+ if ($authid =~ /\.authid$/) {
+ $authid =~ s/\.authid$//;
+ print "managing $authid\n" if $verbose;
+ my $MARCauth = GetAuthority($authid);
+ merge($authid,$MARCauth,$authid,$MARCauth) if ($MARCauth);
+ unlink $cgidir.'/localfile/modified_authorities/'.$authid.'.authid';
}
- &MARCaddsubfield($bibid,$tag,$tag_indicator,$tagorder,'9',$subfieldorder,$mergeto);
- $biblio = GetMarcBiblio($bibid);
- print "AFTER : ".$biblio->as_formatted."\n" if $verbose;
- $nbdone++;
-# &MARCdelsubfield($dbh,$bibid,$tag,$tagorder,$subfieldcode,$subfieldorder);
-
+ }
+ closedir DIR;
+} else {
+ my $MARCfrom = GetAuthority($mergefrom);
+ my $MARCto = GetAuthority($mergeto);
+ &merge($mergefrom,$MARCfrom,$mergeto,$MARCto);
+ #Could add mergefrom authority to mergeto rejected forms before deletion
+ DelAuthority($mergefrom);
}
my $timeneeded = gettimeofday - $starttime;
-print "$nbdone authorities done in $timeneeded seconds" unless $noconfirm;
+print "Done in $timeneeded seconds" unless $noconfirm;
--
1.5.4.3
More information about the Koha-patches
mailing list