Merge remote branch 'kc/new/pending_qa/enh/bug_3644' into kcmaster
[wip/koha-chris_n.git] / misc / migration_tools / merge_authority.pl
1 #!/usr/bin/perl
2 # script that rebuild thesaurus from biblio table.
3
4 use strict;
5 #use warnings; FIXME - Bug 2505
6 BEGIN {
7     # find Koha's Perl modules
8     # test carefully before changing this
9     use FindBin;
10     eval { require "$FindBin::Bin/kohalib.pl" };
11 }
12
13 # Koha modules used
14 use C4::Context;
15 use C4::Search;
16 use C4::Biblio;
17 use C4::AuthoritiesMarc;
18 use Time::HiRes qw(gettimeofday);
19
20 use Getopt::Long;
21 my ($version, $verbose, $mergefrom,$mergeto,$noconfirm,$batch);
22 GetOptions(
23     'h' => \$version,
24     'f:s' => \$mergefrom,
25     't:s' => \$mergeto,
26     'v' => \$verbose,
27     'n' => \$noconfirm,
28     'b' => \$batch, 
29 );
30
31 if ($version || ($mergefrom eq '' && !$batch)) {
32     print <<EOF
33 Script to merge an authority into another
34 parameters :
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)
40 \tb : batch Merging
41
42 All biblios with the authority in -t will be modified to be "connected" to authority -f
43 SAMPLE :
44 ./merge_authority.pl -f 2457 -t 531
45
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.
47 EOF
48 ;#
49 die;
50 }#/'
51
52 my $dbh = C4::Context->dbh;
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 || $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>;
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/tmp/modified_authorities")) {
81     $cgidir = C4::Context->intranetdir;
82     opendir(DIR, "$cgidir/tmp/modified_authorities") || die "can't opendir $cgidir/tmp/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       next unless ($MARCauth);
90       merge($authid,$MARCauth,$authid,$MARCauth) if ($MARCauth);
91       unlink $cgidir.'/tmp/modified_authorities/'.$authid.'.authid';
92     }
93   }
94   closedir DIR;
95 } else {
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) if ($mergefrom != $mergeto);
101 }
102 my $timeneeded = gettimeofday - $starttime;
103 print "Done in $timeneeded seconds" unless $noconfirm;