misc/migration_tools/merge_authority.pl

   1 #!/usr/bin/perl
   2 # script that rebuild thesaurus from biblio table.
   3
   4 use strict;
   5 BEGIN {
   6     # find Koha's Perl modules
   7     # test carefully before changing this
   8     use FindBin;
   9     eval { require "$FindBin::Bin/kohalib.pl" };
  10 }
  11
  12 # Koha modules used
  13 use C4::Context;
  14 use C4::Search;
  15 use C4::Biblio;
  16 use C4::AuthoritiesMarc;
  17 use Time::HiRes qw(gettimeofday);
  18
  19 use Getopt::Long;
  20 my ($version, $verbose, $mergefrom,$mergeto,$noconfirm,$batch);
  21 GetOptions(
  22     'h' => \$version,
  23     'f:s' => \$mergefrom,
  24     't:s' => \$mergeto,
  25     'v' => \$verbose,
  26     'n' => \$noconfirm,
  27     'b' => \$batch,
  28 );
  29
  30 if ($version || ($mergefrom eq '')) {
  31     print <<EOF
  32 Script to merge an authority into another
  33 parameters :
  34 \th : this version/help screen
  35 \tv : verbose mode (show many things on screen)
  36 \tf : the authority number to merge (the one that can be deleted after the merge).
  37 \tt : the authority number where to merge
  38 \tn : don't ask for confirmation (useful for batch mergings, should not be used on command line)
  39 \tb : batch Merging
  40
  41 All biblios with the authority in -t will be modified to be "connected" to authority -f
  42 SAMPLE :
  43 ./merge_authority.pl -f 2457 -t 531
  44
  45 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.
  46 EOF
  47 ;#
  48 die;
  49 }#/'
  50
  51 my $dbh = C4::Context->dbh;
  52 # my @subf = $subfields =~ /(##\d\d\d##.)/g;
  53
  54 $|=1; # flushes output
  55 my $authfrom = GetAuthority($mergefrom);
  56 my $authto = GetAuthority($mergeto);
  57
  58 my $authtypecodefrom = GetAuthTypeCode($mergefrom);
  59 my $authtypecodeto = GetAuthTypeCode($mergeto);
  60
  61 unless ($noconfirm) {
  62     print "************\n";
  63     print "You will merge authority : $mergefrom ($authtypecodefrom)\n".$authfrom->as_formatted;
  64     print "\n*************\n";
  65     print "Into authority : $mergeto ($authtypecodeto)\n".$authto->as_formatted;
  66     print "\n\nDo you confirm (enter YES)?";
  67     my $confirm = <STDIN>;
  68     chop $confirm;
  69     unless (uc($confirm) eq 'YES' and $authtypecodefrom eq $authtypecodeto) {
  70         print "IMPOSSIBLE : authorities are not of the same type ($authtypecodefrom vs $authtypecodeto) !!!\n" if $authtypecodefrom ne $authtypecodeto;
  71         print "Merge cancelled\n";
  72         exit;
  73     }
  74 }
  75 my $starttime = gettimeofday;
  76 print "Merging\n" unless $noconfirm;
  77 if ($batch) {
  78   my @authlist;
  79   my $cgidir = C4::Context->intranetdir ."/cgi-bin";
  80   unless (opendir(DIR, "$cgidir/localfile/modified_authorities")) {
  81     $cgidir = C4::Context->intranetdir;
  82     opendir(DIR, "$cgidir/localfile/modified_authorities") || die "can't opendir $cgidir/localfile/modified_authorities: $!";
  83   }
  84   while (my $authid = readdir(DIR)) {
  85     if ($authid =~ /\.authid$/) {
  86       $authid =~ s/\.authid$//;
  87       print "managing $authid\n" if $verbose;
  88       my $MARCauth = GetAuthority($authid);
  89       merge($authid,$MARCauth,$authid,$MARCauth) if ($MARCauth);
  90       unlink $cgidir.'/localfile/modified_authorities/'.$authid.'.authid';
  91     }
  92   }
  93   closedir DIR;
  94 } else {
  95   my $MARCfrom = GetAuthority($mergefrom);
  96   my $MARCto = GetAuthority($mergeto);
  97   &merge($mergefrom,$MARCfrom,$mergeto,$MARCto);
  98   #Could add mergefrom authority to mergeto rejected forms before deletion
  99   DelAuthority($mergefrom);
 100 }
 101 my $timeneeded = gettimeofday - $starttime;
 102 print "Done in $timeneeded seconds" unless $noconfirm;