fixing nomenclature on files in misc/, adding a few new utilities
[koha.git] / 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 MARC::File::USMARC;
14 use MARC::Record;
15 use MARC::Batch;
16 use C4::Context;
17 use C4::Biblio;
18 use C4::AuthoritiesMarc;
19 use Time::HiRes qw(gettimeofday);
20
21 use Getopt::Long;
22 my ($version, $verbose, $mergefrom,$mergeto,$noconfirm);
23 GetOptions(
24     'h' => \$version,
25     'f:s' => \$mergefrom,
26     't:s' => \$mergeto,
27     'v' => \$verbose,
28     'n' => \$noconfirm,
29 );
30
31 if ($version || ($mergefrom eq '')) {
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
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 = AUTHgetauthority($mergefrom);
56 my $authto = AUTHgetauthority($mergeto);
57
58 my $authtypecodefrom = AUTHfind_authtypecode($mergefrom);
59 my $authtypecodeto = AUTHfind_authtypecode($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
78 # search the tag to report
79 my $sth = $dbh->prepare("select auth_tag_to_report from auth_types where authtypecode=?");
80 $sth->execute($authtypecodefrom);
81 my ($auth_tag_to_report) = $sth->fetchrow;
82 # my $record_to_report = $authto->field($auth_tag_to_report);
83 print "Reporting authority tag $auth_tag_to_report :\n" if $verbose;
84 my @record_to = $authto->field($auth_tag_to_report)->subfields();
85 my @record_from = $authfrom->field($auth_tag_to_report)->subfields();
86
87 # search all biblio tags using this authority.
88 $sth = $dbh->prepare("select distinct tagfield from marc_subfield_structure where authtypecode=?");
89 $sth->execute($authtypecodefrom);
90 my $tags_using_authtype;
91 while (my ($tagfield) = $sth->fetchrow) {
92     $tags_using_authtype.= "'".$tagfield."',";
93 }
94 chop $tags_using_authtype;
95 # now, find every biblio using this authority
96 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'";
97 $sth = $dbh->prepare($query);
98 $sth->execute;
99 my $nbdone;
100 # and delete entries before recreating them
101 while (my ($bibid,$tag,$tag_indicator,$tagorder,$subfieldcode,$subfieldorder) = $sth->fetchrow) {
102     my $biblio = GetMarcBiblio($bibid);
103     print "BEFORE : ".$biblio->as_formatted."\n" if $verbose;
104     # now, we know what uses the authority & where.
105     # 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)
106     # then recreate them with the new authority.
107     foreach my $subfield (@record_from) {
108         &MARCdelsubfield($bibid,$tag,$tagorder,$subfield->[0]);
109     }
110     &MARCdelsubfield($dbh,$bibid,$tag,$tagorder,'9');
111     foreach my $subfield (@record_to) {
112         &MARCaddsubfield($bibid,$tag,$tag_indicator,$tagorder,$subfield->[0],$subfieldorder,$subfield->[1]);
113     }
114     &MARCaddsubfield($bibid,$tag,$tag_indicator,$tagorder,'9',$subfieldorder,$mergeto);
115     $biblio = GetMarcBiblio($bibid);
116     print "AFTER : ".$biblio->as_formatted."\n" if $verbose;
117     $nbdone++;
118 #     &MARCdelsubfield($dbh,$bibid,$tag,$tagorder,$subfieldcode,$subfieldorder);
119     
120 }
121 my $timeneeded = gettimeofday - $starttime;
122 print "$nbdone authorities done in $timeneeded seconds" unless $noconfirm;