#!/usr/bin/perl # script that rebuild thesaurus from biblio table. use strict; # Koha modules used use MARC::File::USMARC; use MARC::Record; use MARC::Batch; use C4::Context; use C4::Biblio; use C4::AuthoritiesMarc; use Time::HiRes qw(gettimeofday); use Getopt::Long; my ($version, $verbose, $mergefrom,$mergeto,$noconfirm); GetOptions( 'h' => \$version, 'f:s' => \$mergefrom, 't:s' => \$mergeto, 'v' => \$verbose, 'n' => \$noconfirm, ); if ($version || ($mergefrom eq '')) { print <dbh; # my @subf = $subfields =~ /(##\d\d\d##.)/g; $|=1; # flushes output my $authfrom = AUTHgetauthority($dbh,$mergefrom); my $authto = AUTHgetauthority($dbh,$mergeto); my $authtypecodefrom = AUTHfind_authtypecode($dbh,$mergefrom); my $authtypecodeto = AUTHfind_authtypecode($dbh,$mergeto); unless ($noconfirm) { print "************\n"; print "You will merge authority : $mergefrom ($authtypecodefrom)\n".$authfrom->as_formatted; print "\n*************\n"; print "Into authority : $mergeto ($authtypecodeto)\n".$authto->as_formatted; print "\n\nDo you confirm (enter YES)?"; my $confirm = ; chop $confirm; unless (uc($confirm) eq 'YES' and $authtypecodefrom eq $authtypecodeto) { print "IMPOSSIBLE : authorities are not of the same type ($authtypecodefrom vs $authtypecodeto) !!!\n" if $authtypecodefrom ne $authtypecodeto; print "Merge cancelled\n"; exit; } } 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 = MARCgetbiblio($dbh,$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($dbh,$bibid,$tag,$tagorder,$subfield->[0]); } &MARCdelsubfield($dbh,$bibid,$tag,$tagorder,'9'); foreach my $subfield (@record_to) { &MARCaddsubfield($dbh,$bibid,$tag,$tag_indicator,$tagorder,$subfield->[0],$subfieldorder,$subfield->[1]); } &MARCaddsubfield($dbh,$bibid,$tag,$tag_indicator,$tagorder,'9',$subfieldorder,$mergeto); my $biblio = MARCgetbiblio($dbh,$bibid); print "AFTER : ".$biblio->as_formatted."\n" if $verbose; $nbdone++; # &MARCdelsubfield($dbh,$bibid,$tag,$tagorder,$subfieldcode,$subfieldorder); } my $timeneeded = gettimeofday - $starttime; print "$nbdone authorities done in $timeneeded seconds" unless $noconfirm;