2 # script that rebuild thesaurus from biblio table.
5 #use warnings; FIXME - Bug 2505
7 # find Koha's Perl modules
8 # test carefully before changing this
10 eval { require "$FindBin::Bin/kohalib.pl" };
17 use C4::AuthoritiesMarc;
18 use Time::HiRes qw(gettimeofday);
21 my ($version, $verbose, $mergefrom,$mergeto,$noconfirm,$batch);
31 if ($version || ($mergefrom eq '' && !$batch)) {
33 Script to merge an authority into another
35 \th : this version/help screen
36 \tv : verbose mode (show many things on screen)
37 \tf : the authority number to merge (the one that can be deleted after the merge).
38 \tt : the authority number where to merge
39 \tn : don't ask for confirmation (useful for batch mergings, should not be used on command line)
42 All biblios with the authority in -t will be modified to be "connected" to authority -f
44 ./merge_authority.pl -f 2457 -t 531
46 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.
52 my $dbh = C4::Context->dbh;
54 $|=1; # flushes output
55 my $authfrom = GetAuthority($mergefrom);
56 my $authto = GetAuthority($mergeto);
58 my $authtypecodefrom = GetAuthTypeCode($mergefrom);
59 my $authtypecodeto = GetAuthTypeCode($mergeto);
61 unless ($noconfirm || $batch) {
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>;
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";
75 my $starttime = gettimeofday;
76 print "Merging\n" unless $noconfirm;
79 my $cgidir = C4::Context->intranetdir ."/cgi-bin";
80 unless (opendir(DIR, "$cgidir/tmp/modified_authorities")) {
81 $cgidir = C4::Context->intranetdir;
82 opendir(DIR, "$cgidir/tmp/modified_authorities") || die "can't opendir $cgidir/tmp/modified_authorities: $!";
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 next unless ($MARCauth);
90 merge($authid,$MARCauth,$authid,$MARCauth) if ($MARCauth);
91 unlink $cgidir.'/tmp/modified_authorities/'.$authid.'.authid';
96 my $MARCfrom = GetAuthority($mergefrom);
97 my $MARCto = GetAuthority($mergeto);
98 &merge($mergefrom,$MARCfrom,$mergeto,$MARCto);
99 #Could add mergefrom authority to mergeto rejected forms before deletion
100 DelAuthority($mergefrom);
102 my $timeneeded = gettimeofday - $starttime;
103 print "Done in $timeneeded seconds" unless $noconfirm;