more \Q...\E wrapping on regexes, to handle occassionally problematic strings.
[koha.git] / misc / migration_tools / rebuild_nozebra.pl
1 #!/usr/bin/perl
2
3 use C4::Context;
4 use Getopt::Long;
5 use C4::Biblio;
6 use C4::AuthoritiesMarc;
7
8 use strict;
9
10 # script that fills the nozebra table
11 #
12 #
13
14 $|=1; # flushes output
15
16 # limit for database dumping
17 my $limit;# = "LIMIT 100";
18 my $directory;
19 my $skip_export;
20 my $keep_export;
21 my $reset;
22 my $biblios;
23 my $authorities;
24 my $sysprefs;
25 my $commit;
26
27 GetOptions(
28     'd:s'      => \$directory,
29     'reset'      => \$reset,
30     's'        => \$skip_export,
31     'k'        => \$keep_export,
32     'b'        => \$biblios,
33     'a'        => \$authorities,
34     's'        => \$sysprefs,  # rebuild 'NoZebraIndexes' syspref
35     'commit:f'    => \$commit,
36     );
37
38 my $commitnum = 1000; 
39 $commitnum = $commit if ($commit) ;
40
41 $directory = "export" unless $directory;
42 my $dbh=C4::Context->dbh;
43 $dbh->do("update systempreferences set value=1 where variable='NoZebra'");
44
45 $dbh->do("truncate nozebra");
46
47 my %index = GetNoZebraIndexes();
48
49 if  (!%index || $sysprefs ) {
50     if (C4::Context->preference('marcflavour') eq 'UNIMARC') {
51         $dbh->do("UPDATE systempreferences SET value=\"'title' => '200a,200c,200d,200e,225a,225d,225e,225f,225h,225i,225v,500*,501*,503*,510*,512*,513*,514*,515*,516*,517*,518*,519*,520*,530*,531*,532*,540*,541*,545*,604t,610t,605a',
52         'author' =>'200f,600a,601a,604a,700a,700b,700c,700d,700a,701b,701c,701d,702a,702b,702c,702d,710a,710b,710c,710d,711a,711b,711c,711d,712a,712b,712c,712d',
53         'isbn' => '010a',
54         'issn' => '011a',
55         'biblionumber' =>'0909',
56         'itemtype' => '200b',
57         'language' => '101a',
58         'publisher' => '210c',
59         'date' => '210d',
60         'note' => '300a,301a,302a,303a,304a,305a,306az,307a,308a,309a,310a,311a,312a,313a,314a,315a,316a,317a,318a,319a,320a,321a,322a,323a,324a,325a,326a,327a,328a,330a,332a,333a,336a,337a,345a',
61         'Koha-Auth-Number' => '6009,6019,6029,6039,6049,6059,6069,6109,7009,7019,7029,7109,7119,7129',
62         'subject' => '600*,601*,606*,610*',
63         'dewey' => '676a',
64         'host-item' => '995a,995c',\" where variable='NoZebraIndexes'");
65         %index = GetNoZebraIndexes();
66     } elsif (C4::Context->preference('marcflavour') eq 'MARC21') {
67         $dbh->do("UPDATE systempreferences SET value=\"
68 'title' => '130a,210a,222a,240a,243a,245a,245b,246a,246b,247a,247b,250a,250b,440a,830a',
69 'author' => '100a,100b,100c,100d,110a,111a,111b,111c,111d,245c,700a,710a,711a,800a,810a,811a',
70 'isbn' => '020a',
71 'issn' => '022a',
72 'lccn' => '010a',
73 'biblionumber => '999c',
74 'itemtype' => '942c',
75 'publisher' => '260b',
76 'date' => '260c',
77 'note' => '500a, 501a,504a,505a,508a,511a,518a,520a,521a,522a,524a,526a,530a,533a,538a,541a,546a,555a,556a,562a,563a,583a,585a,582a',
78 'subject' => '600*,610*,611*,630*,650*,651*,653*,654*,655*,662*,690*',
79 'dewey' => '082',
80 'bc' => '952p',
81 'callnum' => '952o',
82 'an' => '6009,6109,6119',
83 'series' => 440*,490*,
84 'host-item' => '9529
85 'shelf' => '952c',
86 'collection' => '9528',
87 \"WHERE variable='NoZebraIndexes'");
88
89         %index = GetNoZebraIndexes();
90     }
91 }
92 $|=1;
93
94 $dbh->{AutoCommit} = 0;
95
96 print "***********************************\n";
97 print "***** building BIBLIO indexes *****\n";
98 print "***********************************\n";
99
100 my $sth;
101 $sth=$dbh->prepare("select biblionumber from biblioitems order by biblionumber $limit");
102 $sth->execute();
103 my $i=0;
104 my %result;
105 while (my ($biblionumber) = $sth->fetchrow) {
106         $i++;
107         print "\r$i";
108         my  $record;
109     eval{
110             $record = GetMarcBiblio($biblionumber);
111     };
112     if($@){
113             print "  There was some pb getting biblionumber : ".$biblionumber."\n";
114             next;
115     }
116     next unless $record;
117     # get title of the record (to store the 10 first letters with the index)
118     my ($titletag,$titlesubfield) = GetMarcFromKohaField('biblio.title');
119     my $title = lc($record->subfield($titletag,$titlesubfield));
120
121     # remove blancks comma (that could cause problem when decoding the string for CQL retrieval) and regexp specific values
122     $title =~ s/ |\.|,|;|\[|\]|\(|\)|\*|-|'|=|://g;
123     # limit to 10 char, should be enough, and limit the DB size
124     $title = substr($title,0,10);
125     #parse each field
126     foreach my $field ($record->fields()) {
127         #parse each subfield
128         next if $field->tag <10;
129         foreach my $subfield ($field->subfields()) {
130             my $tag = $field->tag();
131             my $subfieldcode = $subfield->[0];
132             my $indexed=0;
133             # check each index to see if the subfield is stored somewhere
134             # otherwise, store it in __RAW__ index
135             foreach my $key (keys %index) {
136                 if ($index{$key} =~ /\Q$tag\E\*/ or $index{$key} =~ /\Q$tag$subfieldcode\E/) {
137                     $indexed=1;
138                     my $line= lc $subfield->[1];
139                     # remove meaningless value in the field...
140                     $line =~ s/-|\.|\?|,|;|!|'|\(|\)|\[|\]|{|}|"|<|>|&|\+|\*|\/|=|:/ /g;
141                     # ... and split in words
142                     foreach (split / /,$line) {
143                         next unless $_; # skip  empty values (multiple spaces)
144                         # remove any accented char
145                         # if the entry is already here, improve weight
146                         if ($result{$key}->{"$_"} =~ /$biblionumber,\Q$title\E\-(\d);/) {
147                             my $weight=$1+1;
148                             $result{$key}->{"$_"} =~ s/$biblionumber,\Q$title\E\-(\d);//;
149                             $result{$key}->{"$_"} .= "$biblionumber,$title-$weight;";
150                         # otherwise, create it, with weight=1
151                         } else {
152                             $result{$key}->{"$_"}.="$biblionumber,$title-1;";
153                         }
154                     }
155                 }
156             }
157             # the subfield is not indexed, store it in __RAW__ index anyway
158             unless ($indexed) {
159                 my $line= lc $subfield->[1];
160                 $line =~ s/-|\.|\?|,|;|!|'|\(|\)|\[|\]|{|}|"|<|>|&|\+|\*|\/|=/ /g;
161                 foreach (split / /,$line) {
162                         next unless $_;
163 #                     warn $record->as_formatted."$_ =>".$title;
164                         if ($result{__RAW__}->{"$_"} =~ /$biblionumber,\Q$title\E\-(\d);/) {
165                             my $weight=$1+1;
166 #                             $weight++;
167                             $result{__RAW__}->{"$_"} =~ s/$biblionumber,\Q$title\E\-(\d);//;
168                             $result{__RAW__}->{"$_"} .= "$biblionumber,$title-$weight;";
169                         } else {
170                             $result{__RAW__}->{"$_"}.="$biblionumber,$title-1;";
171                         }
172                 }
173             }
174         }
175     }
176 }
177
178
179 print "\nInserting records...\n";
180 $i=0;
181
182 my $commitnum = 100;
183 $dbh->{AutoCommit} = 0;
184
185 $sth = $dbh->prepare("INSERT INTO nozebra (server,indexname,value,biblionumbers) VALUES ('biblioserver',?,?,?)");
186 foreach my $key (keys %result) {
187     foreach my $index (keys %{$result{$key}}) {
188         if (length($result{$key}->{$index}) > 1000000) {
189             print "very long index (".length($result{$key}->{$index}).")for $key / $index. update mySQL config file if you have an error just after this warning (max_paquet_size parameter)\n";
190         }
191         print "\r$i";
192         $i++;
193         $sth->execute($key,$index,$result{$key}->{$index});
194         $dbh->commit() if (0 == $i % $commitnum);
195     }
196    $dbh->commit() if (0 == $i % $commitnum);
197 }
198 $dbh->commit;
199
200
201 print "\nbiblios done\n";
202
203 print "\n***********************************\n";
204 print "***** building AUTHORITIES indexes *****\n";
205 print "***********************************\n";
206
207 $sth=$dbh->prepare("select authid from auth_header order by authid $limit");
208 $sth->execute();
209 $i=0;
210 %result = ();
211 while (my ($authid) = $sth->fetchrow) {
212     $i++;
213     print "\r$i";
214     my $record;
215     eval{
216         $record = GetAuthority($authid);
217     };
218     if($@){
219         print "  There was some pb getting authnumber : ".$authid."\n";
220         next;
221     }
222     
223     my %index;
224     # for authorities, the "title" is the $a mainentry
225     my $authref = C4::AuthoritiesMarc::GetAuthType(C4::AuthoritiesMarc::GetAuthTypeCode($authid));
226
227     warn "ERROR : authtype undefined for ".$record->as_formatted unless $authref;
228     my $title = $record->subfield($authref->{auth_tag_to_report},'a');
229     $index{'mainmainentry'}= $authref->{'auth_tag_to_report'}.'a';
230     $index{'mainentry'}    = $authref->{'auth_tag_to_report'}.'*';
231     $index{'auth_type'}    = '152b';
232
233     # remove blancks comma (that could cause problem when decoding the string for CQL retrieval) and regexp specific values
234     $title =~ s/ |\.|,|;|\[|\]|\(|\)|\*|-|'|:|=//g;
235     $title = quotemeta $title;
236     # limit to 10 char, should be enough, and limit the DB size
237     $title = substr($title,0,10);
238     #parse each field
239     foreach my $field ($record->fields()) {
240         #parse each subfield
241         next if $field->tag <10;
242         foreach my $subfield ($field->subfields()) {
243             my $tag = $field->tag();
244             my $subfieldcode = $subfield->[0];
245             my $indexed=0;
246             # check each index to see if the subfield is stored somewhere
247             # otherwise, store it in __RAW__ index
248             foreach my $key (keys %index) {
249                 if ($index{$key} =~ /$tag\*/ or $index{$key} =~ /$tag$subfieldcode/) {
250                     $indexed=1;
251                     my $line= lc $subfield->[1];
252                     # remove meaningless value in the field...
253                     $line =~ s/-|\.|\?|,|;|!|'|\(|\)|\[|\]|{|}|"|<|>|&|\+|\*|\/|=|:/ /g;
254                     # ... and split in words
255                     foreach (split / /,$line) {
256                         next unless $_; # skip  empty values (multiple spaces)
257                         # if the entry is already here, improve weight
258                         if ($result{$key}->{"$_"} =~ /$authid,$title\-(\d);/) {
259                             my $weight=$1+1;
260                             $result{$key}->{"$_"} =~ s/$authid,$title\-(\d);//;
261                             $result{$key}->{"$_"} .= "$authid,$title-$weight;";
262                         # otherwise, create it, with weight=1
263                         } else {
264                             $result{$key}->{"$_"}.="$authid,$title-1;";
265                         }
266                     }
267                 }
268             }
269             # the subfield is not indexed, store it in __RAW__ index anyway
270             unless ($indexed) {
271                 my $line= lc $subfield->[1];
272                 $line =~ s/-|\.|\?|,|;|!|'|\(|\)|\[|\]|{|}|"|<|>|&|\+|\*|\/|=/ /g;
273                 foreach (split / /,$line) {
274                         next unless $_;
275 #                     warn $record->as_formatted."$_ =>".$title;
276                         if ($result{__RAW__}->{"$_"} =~ /$authid,$title\-(\d);/) {
277                             my $weight=$1+1;
278 #                             $weight++;
279                             $result{__RAW__}->{"$_"} =~ s/$authid,$title\-(\d);//;
280                             $result{__RAW__}->{"$_"} .= "$authid,$title-$weight;";
281                         } else {
282                             $result{__RAW__}->{"$_"}.="$authid,$title-1;";
283                         }
284                 }
285             }
286         }
287     }
288 }
289
290
291
292 print "\nInserting...\n";
293 $i=0;
294
295 my $commitnum = 100;
296 $dbh->{AutoCommit} = 0;
297 $sth = $dbh->prepare("INSERT INTO nozebra (server,indexname,value,biblionumbers) VALUES ('authorityserver',?,?,?)");
298 foreach my $key (keys %result) {
299     foreach my $index (keys %{$result{$key}}) {
300         if (length($result{$key}->{$index}) > 1000000) {
301             print "very long index (".length($result{$key}->{$index}).")for $key / $index. update mySQL config file if you have an error just after this warning (max_paquet_size parameter)\n";
302         }
303         print "\r$i";
304         $i++;
305         $sth->execute($key,$index,$result{$key}->{$index});
306         $dbh->commit() if (0 == $i % $commitnum);
307     }
308    $dbh->commit() if (0 == $i % $commitnum);
309 }
310 $dbh->commit;
311 print "\nauthorities done\n";