[Koha-cvs] CVS: koha/misc merge_authority.pl,NONE,1.1.2.1

[Paul POULAIN]

Update of /cvsroot/koha/koha/misc
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv11363/misc

Added Files:
      Tag: rel_2_2
        merge_authority.pl 
Log Message:
tool to merge 2 authorities. Run ./merge_authority.pl to get syntax & help

--- NEW FILE ---
#!/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 <<EOF
Script to merge an authority into another
parameters :
\th : this version/help screen
\tv : verbose mode (show many things on screen)
\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)

All biblios with the authority in -t will be modified to be "connected" to 
authority -f
SAMPLE :
./merge_authority.pl -f 2457 -t 531

Before doing anything, the script will show both authorities and ask for 
confirmation. Of course, you can merge only 2 authorities of the same kind.
EOF
;#
die;
}#/'

my $dbh = C4::Context->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 = <STDIN>;
        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;