Merge remote branch 'kc/new/pending_qa/enh/bug_3644' into kcmaster
[wip/koha-chris_n.git] / misc / migration_tools / build6xx.pl
1 #!/usr/bin/perl
2 # script that rebuild thesaurus from biblio table.
3
4 # delete  FROM  `marc_subfield_table`  WHERE tag =  "606" AND subfieldcode = 9;
5 use strict;
6 #use warnings; FIXME - Bug 2505
7
8 # Koha modules used
9 use MARC::File::USMARC;
10 use MARC::Record;
11 use MARC::Batch;
12 use C4::Context;
13 use C4::Biblio;
14 use C4::AuthoritiesMarc;
15 use Time::HiRes qw(gettimeofday);
16
17 use Getopt::Long;
18 my ( $input_marc_file, $number) = ('',0);
19 my ($version, $verbose, $test_parameter, $field,$delete,$category,$subfields);
20 GetOptions(
21     'h' => \$version,
22     'd' => \$delete,
23     't' => \$test_parameter,
24     's:s' => \$subfields,
25     'v' => \$verbose,
26     'c:s' => \$category,
27 );
28
29 if ($version || ($category eq '')) {
30     print <<EOF
31 small script to recreate a authority table into Koha.
32 parameters :
33 \tc : thesaurus category. Can be filled with anything, the NC is hardcoded. But mandatory to confirm that you want to rebuild 6xx
34 \d : delete every entry of the selected category before doing work.
35
36 SAMPLES :
37  ./build6xx.pl -c NC -d 
38 EOF
39 ;#
40 die;
41 }
42
43 my $dbh = C4::Context->dbh;
44 my @subf = $subfields =~ /(##\d\d\d##.)/g;
45 if ($delete) {
46     print "deleting thesaurus\n";
47     my $del1 = $dbh->prepare("delete from auth_subfield_table where authid=?");
48     my $del2 = $dbh->prepare("delete from auth_word where authid=?");
49     my $sth = $dbh->prepare("select authid from auth_header where authtypecode='NC'");
50     $sth->execute;
51     while (my ($authid) = $sth->fetchrow) {
52         $del1->execute($authid);
53         $del2->execute($authid);
54     }
55     $dbh->do("delete from auth_header where authtypecode='NC'");
56     $dbh->do("delete from marc_subfield_table where tag='606' and subfieldcode='9'");
57     $dbh->do("delete from marc_word where tagsubfield='6069'");
58 }
59
60 if ($test_parameter) {
61     print "TESTING MODE ONLY\n    DOING NOTHING\n===============\n";
62 }
63 $|=1; # flushes output
64 my $starttime = gettimeofday;
65 my $sth = $dbh->prepare("select bibid from marc_biblio");
66 $sth->execute;
67 my $i=1;
68 my %alreadydone;
69
70 # search biblios to "connect" to an authority with any number of $x (limited to 4 $x in this script)
71 my $sthBIBLIOS = $dbh->prepare("select distinct m1.bibid,m1.tag,m1.tagorder,m1.subfieldorder from marc_subfield_table as m1 where tag in (606) and subfieldcode='a' and subfieldvalue=?");
72 my $sthBIBLIOSx = $dbh->prepare("select distinct m1.bibid,m1.tag,m1.tagorder,m1.subfieldorder from marc_subfield_table as m1 left join marc_subfield_table as m2 on m1.bibid=m2.bibid where m1.tag in (606) and m1.subfieldcode='a' and m2.subfieldcode='x' and m1.subfieldvalue=? and m2.subfieldvalue=?");
73 my $sthBIBLIOSxx = $dbh->prepare("select distinct m1.bibid,m1.tag,m1.tagorder,m1.subfieldorder from marc_subfield_table as m1 left join marc_subfield_table as m2 on m1.bibid=m2.bibid left join marc_subfield_table as m3 on m1.bibid=m3.bibid where m1.tag in (606) and m1.subfieldcode='a' and m2.subfieldcode='x' and m3.subfieldcode='x' and m1.subfieldvalue=? and m2.subfieldvalue=? and m3.subfieldvalue=?");
74 my $sthBIBLIOSxxx = $dbh->prepare("select distinct m1.bibid,m1.tag,m1.tagorder,m1.subfieldorder from marc_subfield_table as m1 left join marc_subfield_table as m2 on m1.bibid=m2.bibid left join marc_subfield_table as m3 on m1.bibid=m4.bibid left join marc_subfield_table as m4 on m1.bibid=m4.bibid where m1.tag in (606) and m1.subfieldcode='a' and m2.subfieldcode='x' and m3.subfieldcode='x' and m4.subfieldcode='x' and m1.subfieldvalue=? and m2.subfieldvalue=? and m3.subfieldvalue=? and m4.subfieldvalue=?");
75 my $sthBIBLIOSxxxx = $dbh->prepare("select distinct m1.bibid,m1.tag,m1.tagorder,m1.subfieldorder from marc_subfield_table as m1 left join marc_subfield_table as m2 on m1.bibid=m2.bibid left join marc_subfield_table as m3 on m1.bibid=m4.bibid left join marc_subfield_table as m4 on m1.bibid=m4.bibid left join marc_subfield_table as m5 on m1.bibid=m5.bibid where m1.tag in (606) and m1.subfieldcode='a' and m2.subfieldcode='x' and m3.subfieldcode='x' and m4.subfieldcode='x' and m5.subfieldcode='x' and m1.subfieldvalue=? and m2.subfieldvalue=? and m3.subfieldvalue=? and m4.subfieldvalue=? and m5.subfieldvalue=?");
76
77 # loop through each biblio
78 while (my ($bibid) = $sth->fetchrow) {
79     my $record = GetMarcBiblio($bibid);
80     my $timeneeded = gettimeofday - $starttime;
81     print "$i in $timeneeded s\n" unless ($i % 50);
82     foreach my $field ($record->field(995)) {
83         $record->delete_field($field);
84     }
85     my $totdone=0;
86     my $authid;
87     # search the 606 field(s)
88     foreach my $field ($record->field("606")) {
89         foreach my $authentry ($field->subfield("a")) {
90             # the hashentry variable contains all $x fields and the $a in a single string. Used to differenciate
91             # $xsomething$aelse and $asomething else
92             my $hashentry = $authentry;
93             foreach my $x ($field->subfield('x')) {
94                 $hashentry.=" -- $x";
95             }
96             # remove ��$e...
97             # all the same for mysql, but NOT for perl hashes !
98             # without those lines, t� is not tot and pat� is not patee
99             $hashentry =~ s/���e/g;
100             $hashentry =~ s/��a/g;
101             $hashentry =~ s/�i/g;
102             $hashentry =~ s/�o/g;
103             $hashentry =~ s/|/u/g;
104             # uppercase all, in case of typing error.
105             $hashentry = uc($hashentry);
106             $totdone++;
107             if ($alreadydone{$hashentry}) {
108                 $authid = $alreadydone{$hashentry};
109                 print ".";
110             } else {
111                 print "*";
112                 #create authority.
113                 my $authorityRecord = MARC::Record->new();
114                 my $newfield = MARC::Field->new(250,'','','a' => "".$authentry);
115                 foreach my $x ($field->subfield('x')) {
116                     $newfield->add_subfields('x' => $x);
117                 }
118                 foreach my $z ($field->subfield('z')) {
119                     $newfield->add_subfields('z' => $z);
120                 }
121                 $authorityRecord->insert_fields_ordered($newfield);
122                 $authid=AUTHaddauthority($dbh,$authorityRecord,'','NC');
123                 $alreadydone{$hashentry} = $authid;
124                 # we have the authority number, now we update all biblios that use this authority...
125                 my @x = $field->subfield('x'); # depending on the number of $x in the subfield
126                 if ($#x eq -1) { # no $x
127                     $sthBIBLIOS->execute($authentry);
128                     while (my ($bibid,$tag,$tagorder,$subfieldorder) = $sthBIBLIOS->fetchrow) {
129                         # check that the field does not already have a $x (if it has, it will or has been managed by another authority
130                         my $inbiblio = GetMarcBiblio($bibid);
131                         my $isOK = 0;
132                         # loop in each 606 field
133                         foreach my $in606 ($inbiblio->field('606')) {
134                             my $inEntry = $in606->subfield('a');
135                             # and rebuild the $x -- $x -- $a string (like for $hashentry, few lines before)
136                             foreach my $x ($in606->subfield('x')) {
137                                 $inEntry.=" -- $x";
138                             }
139                             $inEntry =~ s/���e/g;
140                             $inEntry =~ s/��a/g;
141                             $inEntry =~ s/�i/g;
142                             $inEntry =~ s/�o/g;
143                             $inEntry =~ s/|/u/g;
144                             $inEntry = uc($inEntry);
145                             # ok, it's confirmed that we must add the $9 subfield for this biblio, so...
146                             $isOK=1 if $inEntry eq $hashentry;
147                         }
148                         # ... add it !
149                         C4::Biblio::MARCaddsubfield($dbh,$bibid,$tag,'',$tagorder,9,$subfieldorder,$authid) if $isOK;
150                     }
151                 }
152                 if ($#x eq 0) { # one $x
153                     $sthBIBLIOSx->execute($authentry,$x[0]);
154                     while (my ($bibid,$tag,$tagorder,$subfieldorder) = $sthBIBLIOSx->fetchrow) {
155                         my $inbiblio = GetMarcBiblio($bibid);
156                         my $isOK = 0;
157                         foreach my $in606 ($inbiblio->field('606')) {
158                             my $inEntry = $in606->subfield('a');
159                             foreach my $x ($in606->subfield('x')) {
160                                 $inEntry.=" -- $x";
161                             }
162                             $inEntry =~ s/���e/g;
163                             $inEntry =~ s/��a/g;
164                             $inEntry =~ s/�i/g;
165                             $inEntry =~ s/�o/g;
166                             $inEntry =~ s/|/u/g;
167                             $inEntry = uc($inEntry);
168                             $isOK=1 if $inEntry eq $hashentry;
169                         }
170                         C4::Biblio::MARCaddsubfield($dbh,$bibid,$tag,'',$tagorder,9,$subfieldorder,$authid) if $isOK;
171                     }
172                 }
173                 if ($#x eq 1) { # two $x
174                     $sthBIBLIOSxx->execute($authentry,$x[0],$x[1]);
175                     while (my ($bibid,$tag,$tagorder,$subfieldorder) = $sthBIBLIOSxx->fetchrow) {
176                         my $inbiblio = GetMarcBiblio($bibid);
177                         my $isOK = 0;
178                         foreach my $in606 ($inbiblio->field('606')) {
179                             my $inEntry = $in606->subfield('a');
180                             foreach my $x ($in606->subfield('x')) {
181                                 $inEntry.=" -- $x";
182                             }
183                             $inEntry =~ s/���e/g;
184                             $inEntry =~ s/��a/g;
185                             $inEntry =~ s/�i/g;
186                             $inEntry =~ s/�o/g;
187                             $inEntry =~ s/|/u/g;
188                             $inEntry = uc($inEntry);
189                             $isOK=1 if $inEntry eq $hashentry;
190                         }
191                         C4::Biblio::MARCaddsubfield($dbh,$bibid,$tag,'',$tagorder,9,$subfieldorder,$authid) if $isOK;
192                     }
193                 }
194                 if ($#x eq 2) { # 3 $x
195                     $sthBIBLIOSxxx->execute($authentry,$x[0],$x[1],$x[2]);
196                     while (my ($bibid,$tag,$tagorder,$subfieldorder) = $sthBIBLIOSxxx->fetchrow) {
197                         my $inbiblio = GetMarcBiblio($bibid);
198                         my $isOK = 0;
199                         foreach my $in606 ($inbiblio->field('606')) {
200                             my $inEntry = $in606->subfield('a');
201                             foreach my $x ($in606->subfield('x')) {
202                                 $inEntry.=" -- $x";
203                             }
204                             $inEntry =~ s/���e/g;
205                             $inEntry =~ s/��a/g;
206                             $inEntry =~ s/�i/g;
207                             $inEntry =~ s/�o/g;
208                             $inEntry =~ s/|/u/g;
209                             $inEntry = uc($inEntry);
210                             $isOK=1 if $inEntry eq $hashentry;
211                         }
212                         C4::Biblio::MARCaddsubfield($dbh,$bibid,$tag,'',$tagorder,9,$subfieldorder,$authid) if $isOK;
213                     }
214                 }
215                 if ($#x eq 3) { # 3 $x
216                     $sthBIBLIOSxxxx->execute($authentry,$x[0],$x[1],$x[2],$x[3]);
217                     while (my ($bibid,$tag,$tagorder,$subfieldorder) = $sthBIBLIOSxxxx->fetchrow) {
218                         my $inbiblio = GetMarcBiblio($bibid);
219                         my $isOK = 0;
220                         foreach my $in606 ($inbiblio->field('606')) {
221                             my $inEntry = $in606->subfield('a');
222                             foreach my $x ($in606->subfield('x')) {
223                                 $inEntry.=" -- $x";
224                             }
225                             $inEntry =~ s/���e/g;
226                             $inEntry =~ s/��a/g;
227                             $inEntry =~ s/�i/g;
228                             $inEntry =~ s/�o/g;
229                             $inEntry =~ s/|/u/g;
230                             $inEntry = uc($inEntry);
231                             $isOK=1 if $inEntry eq $hashentry;
232                         }
233                         C4::Biblio::MARCaddsubfield($dbh,$bibid,$tag,'',$tagorder,9,$subfieldorder,$authid) if $isOK;
234                     }
235                 }
236                 if ($#x >4) {
237                     # too many $x, not handled, warn the developper that tries to migrate
238                     print "warning there is ".$#x.'$x values';
239                 }
240             }
241         }
242     }
243     $i++;
244 }
245 my $timeneeded = gettimeofday - $starttime;
246 print "$i entries done in $timeneeded seconds (".($i/$timeneeded)." per second)\n";