2 # script that rebuild thesaurus from biblio table.
6 # find Koha's Perl modules
7 # test carefully before changing this
9 eval { require "$FindBin::Bin/kohalib.pl" };
16 use C4::AuthoritiesMarc;
17 use Time::HiRes qw(gettimeofday);
20 my ($version, $verbose, $mergefrom,$mergeto,$noconfirm,$batch);
30 if ($version || ($mergefrom eq '' && !$batch)) {
32 Script to merge an authority into another
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)
41 All biblios with the authority in -t will be modified to be "connected" to authority -f
43 ./merge_authority.pl -f 2457 -t 531
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.
51 my $dbh = C4::Context->dbh;
53 $|=1; # flushes output
54 my $authfrom = GetAuthority($mergefrom);
55 my $authto = GetAuthority($mergeto);
57 my $authtypecodefrom = GetAuthTypeCode($mergefrom);
58 my $authtypecodeto = GetAuthTypeCode($mergeto);
60 unless ($noconfirm || $batch) {
61 print "************\n";
62 print "You will merge authority : $mergefrom ($authtypecodefrom)\n".$authfrom->as_formatted;
63 print "\n*************\n";
64 print "Into authority : $mergeto ($authtypecodeto)\n".$authto->as_formatted;
65 print "\n\nDo you confirm (enter YES)?";
66 my $confirm = <STDIN>;
68 unless (uc($confirm) eq 'YES' and $authtypecodefrom eq $authtypecodeto) {
69 print "IMPOSSIBLE : authorities are not of the same type ($authtypecodefrom vs $authtypecodeto) !!!\n" if $authtypecodefrom ne $authtypecodeto;
70 print "Merge cancelled\n";
74 my $starttime = gettimeofday;
75 print "Merging\n" unless $noconfirm;
78 my $cgidir = C4::Context->intranetdir ."/cgi-bin";
79 unless (opendir(DIR, "$cgidir/tmp/modified_authorities")) {
80 $cgidir = C4::Context->intranetdir;
81 opendir(DIR, "$cgidir/tmp/modified_authorities") || die "can't opendir $cgidir/tmp/modified_authorities: $!";
83 while (my $authid = readdir(DIR)) {
84 if ($authid =~ /\.authid$/) {
85 $authid =~ s/\.authid$//;
86 print "managing $authid\n" if $verbose;
87 my $MARCauth = GetAuthority($authid) ;
88 next unless ($MARCauth);
89 merge($authid,$MARCauth,$authid,$MARCauth) if ($MARCauth);
90 unlink $cgidir.'/tmp/modified_authorities/'.$authid.'.authid';
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);
101 my $timeneeded = gettimeofday - $starttime;
102 print "Done in $timeneeded seconds" unless $noconfirm;