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" };
15 use C4::AuthoritiesMarc;
16 use Time::HiRes qw(gettimeofday);
19 my ($version, $verbose, $mergefrom,$mergeto,$noconfirm);
28 if ($version || ($mergefrom eq '')) {
30 Script to merge an authority into another
32 \th : this version/help screen
33 \tv : verbose mode (show many things on screen)
34 \tf : the authority number to merge (the one that can be deleted after the merge).
35 \tt : the authority number where to merge
36 \tn : don't ask for confirmation (useful for batch mergings, should not be used on command line)
38 All biblios with the authority in -t will be modified to be "connected" to authority -f
40 ./merge_authority.pl -f 2457 -t 531
42 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.
48 my $dbh = C4::Context->dbh;
49 # my @subf = $subfields =~ /(##\d\d\d##.)/g;
51 $|=1; # flushes output
52 my $authfrom = AUTHgetauthority($mergefrom);
53 my $authto = AUTHgetauthority($mergeto);
55 my $authtypecodefrom = AUTHfind_authtypecode($mergefrom);
56 my $authtypecodeto = AUTHfind_authtypecode($mergeto);
59 print "************\n";
60 print "You will merge authority : $mergefrom ($authtypecodefrom)\n".$authfrom->as_formatted;
61 print "\n*************\n";
62 print "Into authority : $mergeto ($authtypecodeto)\n".$authto->as_formatted;
63 print "\n\nDo you confirm (enter YES)?";
64 my $confirm = <STDIN>;
66 unless (uc($confirm) eq 'YES' and $authtypecodefrom eq $authtypecodeto) {
67 print "IMPOSSIBLE : authorities are not of the same type ($authtypecodefrom vs $authtypecodeto) !!!\n" if $authtypecodefrom ne $authtypecodeto;
68 print "Merge cancelled\n";
72 my $starttime = gettimeofday;
73 print "Merging\n" unless $noconfirm;
75 # search the tag to report
76 my $sth = $dbh->prepare("select auth_tag_to_report from auth_types where authtypecode=?");
77 $sth->execute($authtypecodefrom);
78 my ($auth_tag_to_report) = $sth->fetchrow;
79 # my $record_to_report = $authto->field($auth_tag_to_report);
80 print "Reporting authority tag $auth_tag_to_report :\n" if $verbose;
81 my @record_to = $authto->field($auth_tag_to_report)->subfields();
82 my @record_from = $authfrom->field($auth_tag_to_report)->subfields();
84 # search all biblio tags using this authority.
85 $sth = $dbh->prepare("select distinct tagfield from marc_subfield_structure where authtypecode=?");
86 $sth->execute($authtypecodefrom);
87 my $tags_using_authtype;
88 while (my ($tagfield) = $sth->fetchrow) {
89 $tags_using_authtype.= "'".$tagfield."',";
91 chop $tags_using_authtype;
92 # now, find every biblio using this authority
93 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'";
94 $sth = $dbh->prepare($query);
97 # and delete entries before recreating them
98 while (my ($bibid,$tag,$tag_indicator,$tagorder,$subfieldcode,$subfieldorder) = $sth->fetchrow) {
99 my $biblio = GetMarcBiblio($bibid);
100 print "BEFORE : ".$biblio->as_formatted."\n" if $verbose;
101 # now, we know what uses the authority & where.
102 # 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)
103 # then recreate them with the new authority.
104 foreach my $subfield (@record_from) {
105 &MARCdelsubfield($bibid,$tag,$tagorder,$subfield->[0]);
107 &MARCdelsubfield($dbh,$bibid,$tag,$tagorder,'9');
108 foreach my $subfield (@record_to) {
109 &MARCaddsubfield($bibid,$tag,$tag_indicator,$tagorder,$subfield->[0],$subfieldorder,$subfield->[1]);
111 &MARCaddsubfield($bibid,$tag,$tag_indicator,$tagorder,'9',$subfieldorder,$mergeto);
112 $biblio = GetMarcBiblio($bibid);
113 print "AFTER : ".$biblio->as_formatted."\n" if $verbose;
115 # &MARCdelsubfield($dbh,$bibid,$tag,$tagorder,$subfieldcode,$subfieldorder);
118 my $timeneeded = gettimeofday - $starttime;
119 print "$nbdone authorities done in $timeneeded seconds" unless $noconfirm;