misc/merge_authority.pl

   1 #!/usr/bin/perl
   2 # script that rebuild thesaurus from biblio table.
   3
   4 use strict;
   5
   6 # Koha modules used
   7 use MARC::File::USMARC;
   8 use MARC::Record;
   9 use MARC::Batch;
  10 use C4::Context;
  11 use C4::Biblio;
  12 use C4::AuthoritiesMarc;
  13 use Time::HiRes qw(gettimeofday);
  14
  15 use Getopt::Long;
  16 my ($version, $verbose, $mergefrom,$mergeto,$noconfirm);
  17 GetOptions(
  18     'h' => \$version,
  19     'f:s' => \$mergefrom,
  20     't:s' => \$mergeto,
  21     'v' => \$verbose,
  22     'n' => \$noconfirm,
  23 );
  24
  25 if ($version || ($mergefrom eq '')) {
  26     print <<EOF
  27 Script to merge an authority into another
  28 parameters :
  29 \th : this version/help screen
  30 \tv : verbose mode (show many things on screen)
  31 \tf : the authority number to merge (the one that can be deleted after the merge).
  32 \tt : the authority number where to merge
  33 \tn : don't ask for confirmation (useful for batch mergings, should not be used on command line)
  34
  35 All biblios with the authority in -t will be modified to be "connected" to authority -f
  36 SAMPLE :
  37 ./merge_authority.pl -f 2457 -t 531
  38
  39 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.
  40 EOF
  41 ;#
  42 die;
  43 }#/'
  44
  45 my $dbh = C4::Context->dbh;
  46 # my @subf = $subfields =~ /(##\d\d\d##.)/g;
  47
  48 $|=1; # flushes output
  49 my $authfrom = AUTHgetauthority($mergefrom);
  50 my $authto = AUTHgetauthority($mergeto);
  51
  52 my $authtypecodefrom = AUTHfind_authtypecode($mergefrom);
  53 my $authtypecodeto = AUTHfind_authtypecode($mergeto);
  54
  55 unless ($noconfirm) {
  56     print "************\n";
  57     print "You will merge authority : $mergefrom ($authtypecodefrom)\n".$authfrom->as_formatted;
  58     print "\n*************\n";
  59     print "Into authority : $mergeto ($authtypecodeto)\n".$authto->as_formatted;
  60     print "\n\nDo you confirm (enter YES)?";
  61     my $confirm = <STDIN>;
  62     chop $confirm;
  63     unless (uc($confirm) eq 'YES' and $authtypecodefrom eq $authtypecodeto) {
  64         print "IMPOSSIBLE : authorities are not of the same type ($authtypecodefrom vs $authtypecodeto) !!!\n" if $authtypecodefrom ne $authtypecodeto;
  65         print "Merge cancelled\n";
  66         exit;
  67     }
  68 }
  69 my $starttime = gettimeofday;
  70 print "Merging\n" unless $noconfirm;
  71
  72 # search the tag to report
  73 my $sth = $dbh->prepare("select auth_tag_to_report from auth_types where authtypecode=?");
  74 $sth->execute($authtypecodefrom);
  75 my ($auth_tag_to_report) = $sth->fetchrow;
  76 # my $record_to_report = $authto->field($auth_tag_to_report);
  77 print "Reporting authority tag $auth_tag_to_report :\n" if $verbose;
  78 my @record_to = $authto->field($auth_tag_to_report)->subfields();
  79 my @record_from = $authfrom->field($auth_tag_to_report)->subfields();
  80
  81 # search all biblio tags using this authority.
  82 $sth = $dbh->prepare("select distinct tagfield from marc_subfield_structure where authtypecode=?");
  83 $sth->execute($authtypecodefrom);
  84 my $tags_using_authtype;
  85 while (my ($tagfield) = $sth->fetchrow) {
  86     $tags_using_authtype.= "'".$tagfield."',";
  87 }
  88 chop $tags_using_authtype;
  89 # now, find every biblio using this authority
  90 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'";
  91 $sth = $dbh->prepare($query);
  92 $sth->execute;
  93 my $nbdone;
  94 # and delete entries before recreating them
  95 while (my ($bibid,$tag,$tag_indicator,$tagorder,$subfieldcode,$subfieldorder) = $sth->fetchrow) {
  96     my $biblio = GetMarcBiblio($bibid);
  97     print "BEFORE : ".$biblio->as_formatted."\n" if $verbose;
  98     # now, we know what uses the authority & where.
  99     # 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)
 100     # then recreate them with the new authority.
 101     foreach my $subfield (@record_from) {
 102         &MARCdelsubfield($bibid,$tag,$tagorder,$subfield->[0]);
 103     }
 104     &MARCdelsubfield($dbh,$bibid,$tag,$tagorder,'9');
 105     foreach my $subfield (@record_to) {
 106         &MARCaddsubfield($bibid,$tag,$tag_indicator,$tagorder,$subfield->[0],$subfieldorder,$subfield->[1]);
 107     }
 108     &MARCaddsubfield($bibid,$tag,$tag_indicator,$tagorder,'9',$subfieldorder,$mergeto);
 109     my $biblio = GetMarcBiblio($bibid);
 110     print "AFTER : ".$biblio->as_formatted."\n" if $verbose;
 111     $nbdone++;
 112 #     &MARCdelsubfield($dbh,$bibid,$tag,$tagorder,$subfieldcode,$subfieldorder);
 113
 114 }
 115 my $timeneeded = gettimeofday - $starttime;
 116 print "$nbdone authorities done in $timeneeded seconds" unless $noconfirm;