adding $DEBUG warnings to nozebra
[koha_fer] / 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 GetOptions(
26         'd:s'      => \$directory,
27         'reset'      => \$reset,
28         's'        => \$skip_export,
29         'k'        => \$keep_export,
30         'b'        => \$biblios,
31         'a'        => \$authorities,
32         's'        => \$sysprefs,  # rebuild 'NoZebraIndexes' syspref
33         );
34
35 $directory = "export" unless $directory;
36 my $dbh=C4::Context->dbh;
37 $dbh->do("update systempreferences set value=1 where variable='NoZebra'");
38
39 $dbh->do("truncate nozebra");
40
41 my %index = GetNoZebraIndexes();
42
43 if  (!%index || $sysprefs ) {
44     if (C4::Context->preference('marcflavour') eq 'UNIMARC') {
45         $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',
46         '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',
47         'isbn' => '010a',
48         'issn' => '011a',
49         'biblionumber' =>'0909',
50         'itemtype' => '200b',
51         'language' => '101a',
52         'publisher' => '210c',
53         'date' => '210d',
54         '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',
55         'Koha-Auth-Number' => '6009,6019,6029,6039,6049,6059,6069,6109,7009,7019,7029,7109,7119,7129',
56         'subject' => '600*,601*,606*,610*',
57         'dewey' => '676a',
58         'host-item' => '995a,995c',\" where variable='NoZebraIndexes'");
59         %index = GetNoZebraIndexes();
60     } elsif (C4::Context->preference('marcflavour') eq 'MARC21') {
61                 $dbh->do("UPDATE systempreferences SET value=\"
62                 'title' => '245a,245b',
63                 'author' => '100a',
64                 'isbn' => '020a',
65                 'issn' => '022a',
66                 'biblionumber => '999c',
67                 'itemtype' => '942c',
68                 'publisher' => '260b',
69                 'date' => '260c',
70                 'note' => '500a',
71                 'subject' => '600a, 650a',
72                 'dewey' => '082',
73                 'bc' => '952p',
74         'host-item' => '952a,952c',\" where variable='NoZebraIndexes'");
75         %index = GetNoZebraIndexes();
76     }
77 }
78 $|=1;
79
80 print "***********************************\n";
81 print "***** building BIBLIO indexes *****\n";
82 print "***********************************\n";
83 my $sth;
84 $sth=$dbh->prepare("select biblionumber from biblioitems order by biblionumber $limit");
85 $sth->execute();
86 my $i=0;
87 my %result;
88 while (my ($biblionumber) = $sth->fetchrow) {
89         $i++;
90         print "\r$i";
91         my  $record;
92     eval{
93             $record = GetMarcBiblio($biblionumber);
94     };
95     if($@){
96             print "  There was some pb getting biblionumber : ".$biblionumber."\n";
97             next;
98     }
99     next unless $record;
100     # get title of the record (to store the 10 first letters with the index)
101     my ($titletag,$titlesubfield) = GetMarcFromKohaField('biblio.title');
102     my $title = lc($record->subfield($titletag,$titlesubfield));
103
104     # remove blancks comma (that could cause problem when decoding the string for CQL retrieval) and regexp specific values
105     $title =~ s/ |,|;|\[|\]|\(|\)|\*|-|'|=//g;
106     # limit to 10 char, should be enough, and limit the DB size
107     $title = substr($title,0,10);
108     #parse each field
109     foreach my $field ($record->fields()) {
110         #parse each subfield
111         next if $field->tag <10;
112         foreach my $subfield ($field->subfields()) {
113             my $tag = $field->tag();
114             my $subfieldcode = $subfield->[0];
115             my $indexed=0;
116             # check each index to see if the subfield is stored somewhere
117             # otherwise, store it in __RAW__ index
118             foreach my $key (keys %index) {
119                 if ($index{$key} =~ /$tag\*/ or $index{$key} =~ /$tag$subfieldcode/) {
120                     $indexed=1;
121                     my $line= lc $subfield->[1];
122                     # remove meaningless value in the field...
123                     $line =~ s/-|\.|\?|,|;|!|'|\(|\)|\[|\]|{|}|"|<|>|&|\+|\*|\/|=|:/ /g;
124                     # ... and split in words
125                     foreach (split / /,$line) {
126                         next unless $_; # skip  empty values (multiple spaces)
127                         # remove any accented char
128                         # if the entry is already here, improve weight
129                         if ($result{$key}->{"$_"} =~ /$biblionumber,$title\-(\d);/) {
130                             my $weight=$1+1;
131                             $result{$key}->{"$_"} =~ s/$biblionumber,$title\-(\d);//;
132                             $result{$key}->{"$_"} .= "$biblionumber,$title-$weight;";
133                         # otherwise, create it, with weight=1
134                         } else {
135                             $result{$key}->{"$_"}.="$biblionumber,$title-1;";
136                         }
137                     }
138                 }
139             }
140             # the subfield is not indexed, store it in __RAW__ index anyway
141             unless ($indexed) {
142                 my $line= lc $subfield->[1];
143                 $line =~ s/-|\.|\?|,|;|!|'|\(|\)|\[|\]|{|}|"|<|>|&|\+|\*|\/|=/ /g;
144                 foreach (split / /,$line) {
145                         next unless $_;
146 #                     warn $record->as_formatted."$_ =>".$title;
147                         if ($result{__RAW__}->{"$_"} =~ /$biblionumber,$title\-(\d);/) {
148                             my $weight=$1+1;
149 #                             $weight++;
150                             $result{__RAW__}->{"$_"} =~ s/$biblionumber,$title\-(\d);//;
151                             $result{__RAW__}->{"$_"} .= "$biblionumber,$title-$weight;";
152                         } else {
153                             $result{__RAW__}->{"$_"}.="$biblionumber,$title-1;";
154                         }
155                 }
156             }
157         }
158     }
159 }
160 print "\nInserting records...\n";
161 $i=0;
162 my $sth = $dbh->prepare("INSERT INTO nozebra (server,indexname,value,biblionumbers) VALUES ('biblioserver',?,?,?)");
163 foreach my $key (keys %result) {
164     foreach my $index (keys %{$result{$key}}) {
165         if (length($result{$key}->{$index}) > 1000000) {
166             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";
167         }
168         print "\r$i";
169         $i++;
170         $sth->execute($key,$index,$result{$key}->{$index});
171     }
172 }
173 print "\nbiblios done\n";
174
175 print "\n***********************************\n";
176 print "***** building AUTHORITIES indexes *****\n";
177 print "***********************************\n";
178
179 my $sth;
180 $sth=$dbh->prepare("select authid from auth_header order by authid $limit");
181 $sth->execute();
182 my $i=0;
183 my %result;
184 while (my ($authid) = $sth->fetchrow) {
185     $i++;
186     print "\r$i";
187     my $record;
188     eval{
189         $record = GetAuthority($authid);
190     };
191     if($@){
192         print "  There was some pb getting authnumber : ".$authid."\n";
193         next;
194     }
195     
196     my %index;
197     # for authorities, the "title" is the $a mainentry
198     my $authref = C4::AuthoritiesMarc::GetAuthType($record->subfield(152,'b'));
199
200     warn "ERROR : authtype undefined for ".$record->as_formatted unless $authref;
201     my $title = $record->subfield($authref->{auth_tag_to_report},'a');
202     $index{'mainmainentry'}= $authref->{'auth_tag_to_report'}.'a';
203     $index{'mainentry'}    = $authref->{'auth_tag_to_report'}.'*';
204     $index{'auth_type'}    = '152b';
205
206     # remove blancks comma (that could cause problem when decoding the string for CQL retrieval) and regexp specific values
207     $title =~ s/ |,|;|\[|\]|\(|\)|\*|-|'|=//g;
208     $title = quotemeta $title;
209     # limit to 10 char, should be enough, and limit the DB size
210     $title = substr($title,0,10);
211     #parse each field
212     foreach my $field ($record->fields()) {
213         #parse each subfield
214         next if $field->tag <10;
215         foreach my $subfield ($field->subfields()) {
216             my $tag = $field->tag();
217             my $subfieldcode = $subfield->[0];
218             my $indexed=0;
219             # check each index to see if the subfield is stored somewhere
220             # otherwise, store it in __RAW__ index
221             foreach my $key (keys %index) {
222                 if ($index{$key} =~ /$tag\*/ or $index{$key} =~ /$tag$subfieldcode/) {
223                     $indexed=1;
224                     my $line= lc $subfield->[1];
225                     # remove meaningless value in the field...
226                     $line =~ s/-|\.|\?|,|;|!|'|\(|\)|\[|\]|{|}|"|<|>|&|\+|\*|\/|=|:/ /g;
227                     # ... and split in words
228                     foreach (split / /,$line) {
229                         next unless $_; # skip  empty values (multiple spaces)
230                         # if the entry is already here, improve weight
231                         if ($result{$key}->{"$_"} =~ /$authid,$title\-(\d);/) {
232                             my $weight=$1+1;
233                             $result{$key}->{"$_"} =~ s/$authid,$title\-(\d);//;
234                             $result{$key}->{"$_"} .= "$authid,$title-$weight;";
235                         # otherwise, create it, with weight=1
236                         } else {
237                             $result{$key}->{"$_"}.="$authid,$title-1;";
238                         }
239                     }
240                 }
241             }
242             # the subfield is not indexed, store it in __RAW__ index anyway
243             unless ($indexed) {
244                 my $line= lc $subfield->[1];
245                 $line =~ s/-|\.|\?|,|;|!|'|\(|\)|\[|\]|{|}|"|<|>|&|\+|\*|\/|=/ /g;
246                 foreach (split / /,$line) {
247                         next unless $_;
248 #                     warn $record->as_formatted."$_ =>".$title;
249                         if ($result{__RAW__}->{"$_"} =~ /$authid,$title\-(\d);/) {
250                             my $weight=$1+1;
251 #                             $weight++;
252                             $result{__RAW__}->{"$_"} =~ s/$authid,$title\-(\d);//;
253                             $result{__RAW__}->{"$_"} .= "$authid,$title-$weight;";
254                         } else {
255                             $result{__RAW__}->{"$_"}.="$authid,$title-1;";
256                         }
257                 }
258             }
259         }
260     }
261 }
262 print "\nInserting...\n";
263 $i=0;
264 my $sth = $dbh->prepare("INSERT INTO nozebra (server,indexname,value,biblionumbers) VALUES ('authorityserver',?,?,?)");
265 foreach my $key (keys %result) {
266     foreach my $index (keys %{$result{$key}}) {
267         if (length($result{$key}->{$index}) > 1000000) {
268             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";
269         }
270         print "\r$i";
271         $i++;
272         $sth->execute($key,$index,$result{$key}->{$index});
273     }
274 }
275 print "\nauthorities done\n";