]> git.evergreen-ils.org Git - Evergreen.git/blob - Open-ILS/src/perlmods/OpenILS/Application/Storage/WORM.pm
making hold capture processor faster
[Evergreen.git] / Open-ILS / src / perlmods / OpenILS / Application / Storage / WORM.pm
1 package OpenILS::Application::Storage::WORM;
2 use base qw/OpenILS::Application::Storage/;
3 use strict; use warnings;
4
5 use OpenSRF::EX qw/:try/;
6
7 use OpenSRF::Utils::Logger qw/:level/;
8 my $log = 'OpenSRF::Utils::Logger';
9
10 use OpenILS::Utils::FlatXML;
11 use OpenILS::Utils::Fieldmapper;
12 use JSON;
13
14 use XML::LibXML;
15 use XML::LibXSLT;
16 use Time::HiRes qw(time);
17
18 my $xml_util    = OpenILS::Utils::FlatXML->new();
19
20 my $parser              = XML::LibXML->new();
21 my $xslt                        = XML::LibXSLT->new();
22 my $xslt_doc    =       $parser->parse_file( "/home/miker/cvs/OpenILS/app_server/stylesheets/MARC21slim2MODS.xsl" );
23 #my $xslt_doc   = $parser->parse_file( "/pines/cvs/ILS/Open-ILS/xsl/MARC21slim2MODS.xsl" );
24 my $mods_sheet = $xslt->parse_stylesheet( $xslt_doc );
25
26 use open qw/:utf8/;
27
28 my $xpathset = {};
29
30 sub child_init {
31         my $meth = __PACKAGE__->method_lookup('open-ils.storage.direct.config.metabib_field.retrieve.all');
32         for my $f ($meth->run) {
33                 $xpathset->{ $f->field_class }->{ $f->name }->{xpath} = $f->xpath;
34                 $xpathset->{ $f->field_class }->{ $f->name }->{id} = $f->id;
35                 $log->debug("Loaded XPath from DB: ".$f->field_class." => ".$f->name." : ".$f->xpath, DEBUG);
36         }
37 }
38
39 # --------------------------------------------------------------------------------
40 # Fingerprinting
41
42 my @fp_mods_xpath = (
43         '//mods:mods/mods:typeOfResource[text()="text"]' => [
44                         title   => {
45                                         xpath   => [
46                                                         '//mods:mods/mods:titleInfo[mods:title and (@type="uniform")]',
47                                                         '//mods:mods/mods:titleInfo[mods:title and (@type="translated")]',
48                                                         '//mods:mods/mods:titleInfo[mods:title and (@type="alternative")]',
49                                                         '//mods:mods/mods:titleInfo[mods:title and not(@type)]',
50                                         ],
51                                         fixup   => '
52                                                         do {
53                                                                 $text = lc($text);
54                                                                 $text =~ s/\s+/ /sgo;
55                                                                 $text =~ s/^\s*(.+)\s*$/$1/sgo;
56                                                                 $text =~ s/\b(?:the|an?)\b//sgo;
57                                                                 $text =~ s/\[.[^\]]+\]//sgo;
58                                                                 $text =~ s/\s*[;\/\.]*$//sgo;
59                                                                 $text =~ s/\pM+//gso;
60                                                         };
61                                         ',
62                         },
63                         author  => {
64                                         xpath   => [
65                                                         '//mods:mods/mods:name[mods:role/mods:text/text()="creator" and @type="personal"]/mods:namePart',
66                                                         '//mods:mods/mods:name[mods:role/mods:text/text()="creator"]/mods:namePart',
67                                         ],
68                                         fixup   => '
69                                                         do {
70                                                                 $text = lc($text);
71                                                                 $text =~ s/\s+/ /sgo;
72                                                                 $text =~ s/^\s*(.+)\s*$/$1/sgo;
73                                                                 $text =~ s/,?\s+.*$//sgo;
74                                                                 $text =~ s/\pM+//gso;
75                                                         };
76                                         ',
77                         },
78         ],
79
80         '//mods:mods/mods:relatedItem[@type!="host" and @type!="series"]' => [
81                         title   => {
82                                         xpath   => [
83                                                         '//mods:mods/mods:relatedItem/mods:titleInfo[mods:title and (@type="uniform")]',
84                                                         '//mods:mods/mods:relatedItem/mods:titleInfo[mods:title and (@type="translated")]',
85                                                         '//mods:mods/mods:relatedItem/mods:titleInfo[mods:title and (@type="alternative")]',
86                                                         '//mods:mods/mods:relatedItem/mods:titleInfo[mods:title and not(@type)]',
87                                                         '//mods:mods/mods:titleInfo[mods:title and (@type="uniform")]',
88                                                         '//mods:mods/mods:titleInfo[mods:title and (@type="translated")]',
89                                                         '//mods:mods/mods:titleInfo[mods:title and (@type="alternative")]',
90                                                         '//mods:mods/mods:titleInfo[mods:title and not(@type)]',
91                                         ],
92                                         fixup   => '
93                                                         do {
94                                                                 $text = lc($text);
95                                                                 $text =~ s/\s+/ /sgo;
96                                                                 $text =~ s/^\s*(.+)\s*$/$1/sgo;
97                                                                 $text =~ s/\b(?:the|an?)\b//sgo;
98                                                                 $text =~ s/\[.[^\]]+\]//sgo;
99                                                                 $text =~ s/\s*[;\/\.]*$//sgo;
100                                                                 $text =~ s/\pM+//gso;
101                                                         };
102                                         ',
103                         },
104                         author  => {
105                                         xpath   => [
106                                                         '//mods:mods/mods:relatedItem/mods:name[mods:role/mods:text/text()="creator" and @type="personal"]/mods:namePart',
107                                                         '//mods:mods/mods:relatedItem/mods:name[mods:role/mods:text/text()="creator"]/mods:namePart',
108                                                         '//mods:mods/mods:name[mods:role/mods:text/text()="creator" and @type="personal"]/mods:namePart',
109                                                         '//mods:mods/mods:name[mods:role/mods:text/text()="creator"]/mods:namePart',
110                                         ],
111                                         fixup   => '
112                                                         do {
113                                                                 $text = lc($text);
114                                                                 $text =~ s/\s+/ /sgo;
115                                                                 $text =~ s/^\s*(.+)\s*$/$1/sgo;
116                                                                 $text =~ s/,?\s+.*$//sgo;
117                                                                 $text =~ s/\pM+//gso;
118                                                         };
119                                         ',
120                         },
121         ],
122
123 );
124
125 push @fp_mods_xpath, '//mods:mods/mods:titleInfo' => $fp_mods_xpath[1];
126
127 sub fingerprint_mods {
128         my $mods = shift;
129
130         my $fp_string = '';
131
132         my $match_index = 0;
133         my $block_index = 1;
134         while ( my $match_xpath = $fp_mods_xpath[$match_index] ) {
135                 if ( my @nodes = $mods->findnodes( $match_xpath ) ) {
136
137                         my $block_name_index = 0;
138                         my $block_value_index = 1;
139                         my $block = $fp_mods_xpath[$block_index];
140                         while ( my $part = $$block[$block_value_index] ) {
141                                 my $text;
142                                 for my $xpath ( @{ $part->{xpath} } ) {
143                                         $text = $mods->findvalue( $xpath );
144                                         last if ($text);
145                                 }
146
147                                 $log->debug("Found fingerprint text using $$block[$block_name_index] : [$text]", DEBUG);
148
149                                 if ($text) {
150                                         eval $$part{fixup};
151                                         $fp_string .= $text;
152                                 }
153
154                                 $block_name_index += 2;
155                                 $block_value_index += 2;
156                         }
157                 }
158                 if ($fp_string) {
159                         $fp_string =~ s/\W+//gso;
160                         $log->debug("Fingerprint is [$fp_string]", INFO);;
161                         return $fp_string;
162                 }
163
164                 $match_index += 2;
165                 $block_index += 2;
166         }
167         return undef;
168 }
169
170
171
172 # --------------------------------------------------------------------------------
173
174 my $in_xact;
175 my $begin;
176 my $commit;
177 my $rollback;
178 my $lookup;
179 my $update_entry;
180 my $mr_lookup;
181 my $mr_update;
182 my $mr_create;
183 my $create_source_map;
184 my $sm_lookup;
185 my $rm_old_rd;
186 my $rm_old_sm;
187 my $rm_old_fr;
188 my $rm_old_tr;
189 my $rm_old_ar;
190 my $rm_old_sr;
191 my $rm_old_kr;
192 my $rm_old_ser;
193
194 my $fr_create;
195 my $rd_create;
196 my $create = {};
197
198 my %descriptor_code = (
199         item_type => 'substr($ldr,6,1)',
200         item_form => '(substr($ldr,6,1) =~ /^(?:f|g|i|m|o|p|r)$/) ? substr($oo8,29,1) : substr($oo8,23,1)',
201         bib_level => 'substr($ldr,7,1)',
202         control_type => 'substr($ldr,8,1)',
203         char_encoding => 'substr($ldr,9,1)',
204         enc_level => 'substr($ldr,17,1)',
205         cat_form => 'substr($ldr,18,1)',
206         pub_status => 'substr($ldr,5,1)',
207         item_lang => 'substr($oo8,35,3)',
208         #lit_form => '(substr($ldr,6,1) =~ /^(?:f|g|i|m|o|p|r)$/) ? substr($oo8,33,1) : "0"',
209         audience => 'substr($oo8,22,1)',
210 );
211
212 sub wormize {
213
214         my $self = shift;
215         my $client = shift;
216         my @docids = @_;
217
218         my $no_map = 0;
219         if ($self->api_name =~ /no_map/o) {
220                 $no_map = 1;
221         }
222
223         $in_xact = $self->method_lookup( 'open-ils.storage.transaction.current')
224                 unless ($in_xact);
225         $begin = $self->method_lookup( 'open-ils.storage.transaction.begin')
226                 unless ($begin);
227         $commit = $self->method_lookup( 'open-ils.storage.transaction.commit')
228                 unless ($commit);
229         $rollback = $self->method_lookup( 'open-ils.storage.transaction.rollback')
230                 unless ($rollback);
231         $sm_lookup = $self->method_lookup('open-ils.storage.direct.metabib.metarecord_source_map.search.source')
232                 unless ($sm_lookup);
233         $mr_lookup = $self->method_lookup('open-ils.storage.direct.metabib.metarecord.search.fingerprint')
234                 unless ($mr_lookup);
235         $mr_update = $self->method_lookup('open-ils.storage.direct.metabib.metarecord.batch.update')
236                 unless ($mr_update);
237         $mr_create = $self->method_lookup('open-ils.storage.direct.metabib.metarecord.create')
238                 unless ($mr_create);
239         $create_source_map = $self->method_lookup('open-ils.storage.direct.metabib.metarecord_source_map.batch.create')
240                 unless ($create_source_map);
241         $lookup = $self->method_lookup('open-ils.storage.direct.biblio.record_entry.batch.retrieve')
242                 unless ($lookup);
243         $update_entry = $self->method_lookup('open-ils.storage.direct.biblio.record_entry.batch.update')
244                 unless ($update_entry);
245         $rm_old_sm = $self->method_lookup( 'open-ils.storage.direct.metabib.metarecord_source_map.mass_delete')
246                 unless ($rm_old_sm);
247         $rm_old_rd = $self->method_lookup( 'open-ils.storage.direct.metabib.record_descriptor.mass_delete')
248                 unless ($rm_old_rd);
249         $rm_old_fr = $self->method_lookup( 'open-ils.storage.direct.metabib.full_rec.mass_delete')
250                 unless ($rm_old_fr);
251         $rm_old_tr = $self->method_lookup( 'open-ils.storage.direct.metabib.title_field_entry.mass_delete')
252                 unless ($rm_old_tr);
253         $rm_old_ar = $self->method_lookup( 'open-ils.storage.direct.metabib.author_field_entry.mass_delete')
254                 unless ($rm_old_ar);
255         $rm_old_sr = $self->method_lookup( 'open-ils.storage.direct.metabib.subject_field_entry.mass_delete')
256                 unless ($rm_old_sr);
257         $rm_old_kr = $self->method_lookup( 'open-ils.storage.direct.metabib.keyword_field_entry.mass_delete')
258                 unless ($rm_old_kr);
259         $rm_old_ser = $self->method_lookup( 'open-ils.storage.direct.metabib.series_field_entry.mass_delete')
260                 unless ($rm_old_ser);
261         $rd_create = $self->method_lookup( 'open-ils.storage.direct.metabib.record_descriptor.batch.create')
262                 unless ($rd_create);
263         $fr_create = $self->method_lookup( 'open-ils.storage.direct.metabib.full_rec.batch.create')
264                 unless ($fr_create);
265         $$create{title} = $self->method_lookup( 'open-ils.storage.direct.metabib.title_field_entry.batch.create')
266                 unless ($$create{title});
267         $$create{author} = $self->method_lookup( 'open-ils.storage.direct.metabib.author_field_entry.batch.create')
268                 unless ($$create{author});
269         $$create{subject} = $self->method_lookup( 'open-ils.storage.direct.metabib.subject_field_entry.batch.create')
270                 unless ($$create{subject});
271         $$create{keyword} = $self->method_lookup( 'open-ils.storage.direct.metabib.keyword_field_entry.batch.create')
272                 unless ($$create{keyword});
273         $$create{series} = $self->method_lookup( 'open-ils.storage.direct.metabib.series_field_entry.batch.create')
274                 unless ($$create{series});
275
276
277         my ($outer_xact) = $in_xact->run;
278         try {
279                 unless ($outer_xact) {
280                         $log->debug("WoRM isn't inside a transaction, starting one now.", INFO);
281                         my ($r) = $begin->run($client);
282                         unless (defined $r and $r) {
283                                 $rollback->run;
284                                 throw OpenSRF::EX::PANIC ("Couldn't BEGIN transaction!")
285                         }
286                 }
287         } catch Error with {
288                 throw OpenSRF::EX::PANIC ("WoRM Couldn't BEGIN transaction!")
289         };
290
291         my @source_maps;
292         my @entry_list;
293         my @mr_list;
294         my @rd_list;
295         my @ns_list;
296         my @mods_data;
297         my $ret = 0;
298         for my $entry ( $lookup->run(@docids) ) {
299                 # step -1: grab the doc from storage
300                 next unless ($entry);
301
302                 my $xml = $entry->marc;
303                 my $docid = $entry->id;
304                 my $marcdoc = $parser->parse_string($xml);
305                 my $modsdoc = $mods_sheet->transform($marcdoc);
306
307                 my $mods = $modsdoc->documentElement;
308                 $mods->setNamespace( "http://www.loc.gov/mods/", "mods", 1 );
309
310                 $entry->fingerprint( fingerprint_mods( $mods ) );
311                 push @entry_list, $entry;
312
313                 $log->debug("Fingerprint for Record Entry ".$docid." is [".$entry->fingerprint."]", INFO);
314
315                 unless ($no_map) {
316                         my ($mr) = $mr_lookup->run( $entry->fingerprint );
317                         if (!$mr || !@$mr) {
318                                 $log->debug("No metarecord found for fingerprint [".$entry->fingerprint."]; Creating a new one", INFO);
319                                 $mr = new Fieldmapper::metabib::metarecord;
320                                 $mr->fingerprint( $entry->fingerprint );
321                                 $mr->master_record( $entry->id );
322                                 my ($new_mr) = $mr_create->run($mr);
323                                 $mr->id($new_mr);
324                                 unless (defined $mr) {
325                                         throw OpenSRF::EX::PANIC ("Couldn't run open-ils.storage.direct.metabib.metarecord.create!")
326                                 }
327                         } else {
328                                 $log->debug("Retrieved metarecord, id is ".$mr->id, INFO);
329                                 $mr->mods('');
330                                 push @mr_list, $mr;
331                         }
332
333                         my $sm = new Fieldmapper::metabib::metarecord_source_map;
334                         $sm->metarecord( $mr->id );
335                         $sm->source( $entry->id );
336                         push @source_maps, $sm;
337                 }
338
339                 my $ldr = $marcdoc->documentElement->getChildrenByTagName('leader')->pop->textContent;
340                 my $oo8 = $marcdoc->documentElement->findvalue('//*[local-name()="controlfield" and @tag="008"]');
341
342                 my $rd_obj = Fieldmapper::metabib::record_descriptor->new;
343                 for my $rd_field ( keys %descriptor_code ) {
344                         $rd_obj->$rd_field( eval "$descriptor_code{$rd_field};" );
345                 }
346                 $rd_obj->record( $docid );
347                 push @rd_list, $rd_obj;
348
349                 push @mods_data, { $docid => $self->modsdoc_to_values( $mods ) };
350
351                 # step 2: build the KOHA rows
352                 my @tmp_list = _marcxml_to_full_rows( $marcdoc );
353                 $_->record( $docid ) for (@tmp_list);
354                 push @ns_list, @tmp_list;
355
356                 $ret++;
357
358                 last unless ($self->api_name =~ /batch$/o);
359         }
360
361         $rm_old_rd->run( { record => \@docids } );
362         $rm_old_fr->run( { record => \@docids } );
363         $rm_old_sm->run( { source => \@docids } ) unless ($no_map);
364         $rm_old_tr->run( { source => \@docids } );
365         $rm_old_ar->run( { source => \@docids } );
366         $rm_old_sr->run( { source => \@docids } );
367         $rm_old_kr->run( { source => \@docids } );
368         $rm_old_ser->run( { source => \@docids } );
369
370         unless ($no_map) {
371                 my ($sm) = $create_source_map->run(@source_maps);
372                 unless (defined $sm) {
373                         throw OpenSRF::EX::PANIC ("Couldn't run open-ils.storage.direct.metabib.metarecord_source_map.batch.create!")
374                 }
375                 my ($mr) = $mr_update->run(@mr_list);
376                 unless (defined $mr) {
377                         throw OpenSRF::EX::PANIC ("Couldn't run open-ils.storage.direct.metabib.metarecord.batch.update!")
378                 }
379         }
380
381         my ($re) = $update_entry->run(@entry_list);
382         unless (defined $re) {
383                 throw OpenSRF::EX::PANIC ("Couldn't run open-ils.storage.direct.biblio.record_entry.batch.update!")
384         }
385
386         my ($rd) = $rd_create->run(@rd_list);
387         unless (defined $rd) {
388                 throw OpenSRF::EX::PANIC ("Couldn't run open-ils.storage.direct.metabib.record_descriptor.batch.create!")
389         }
390
391         my ($fr) = $fr_create->run(@ns_list);
392         unless (defined $fr) {
393                 throw OpenSRF::EX::PANIC ("Couldn't run open-ils.storage.direct.metabib.full_rec.batch.create!")
394         }
395
396         # step 5: insert the new metadata
397         for my $class ( qw/title author subject keyword series/ ) {
398                 my @md_list = ();
399                 for my $doc ( @mods_data ) {
400                         my ($did) = keys %$doc;
401                         my ($data) = values %$doc;
402
403                         my $fm_constructor = "Fieldmapper::metabib::${class}_field_entry";
404                         for my $row ( keys %{ $$data{$class} } ) {
405                                 next unless (exists $$data{$class}{$row});
406                                 next unless ($$data{$class}{$row}{value});
407                                 my $fm_obj = $fm_constructor->new;
408                                 $fm_obj->value( $$data{$class}{$row}{value} );
409                                 $fm_obj->field( $$data{$class}{$row}{field_id} );
410                                 $fm_obj->source( $did );
411                                 $log->debug("$class entry: ".$fm_obj->source." => ".$fm_obj->field." : ".$fm_obj->value, DEBUG);
412
413                                 push @md_list, $fm_obj;
414                         }
415                 }
416                         
417                 my ($cr) = $$create{$class}->run(@md_list);
418                 unless (defined $cr) {
419                         throw OpenSRF::EX::PANIC ("Couldn't run open-ils.storage.direct.metabib.${class}_field_entry.batch.create!")
420                 }
421         }
422
423         unless ($outer_xact) {
424                 $log->debug("Commiting transaction started by the WoRM.", INFO);
425                 my ($c) = $commit->run;
426                 unless (defined $c and $c) {
427                         $rollback->run;
428                         throw OpenSRF::EX::PANIC ("Couldn't COMMIT changes!")
429                 }
430         }
431
432         return $ret;
433 }
434 __PACKAGE__->register_method( 
435         api_name        => "open-ils.worm.wormize",
436         method          => "wormize",
437         api_level       => 1,
438         argc            => 1,
439 );
440 __PACKAGE__->register_method( 
441         api_name        => "open-ils.worm.wormize.no_map",
442         method          => "wormize",
443         api_level       => 1,
444         argc            => 1,
445 );
446 __PACKAGE__->register_method( 
447         api_name        => "open-ils.worm.wormize.batch",
448         method          => "wormize",
449         api_level       => 1,
450         argc            => 1,
451 );
452 __PACKAGE__->register_method( 
453         api_name        => "open-ils.worm.wormize.no_map.batch",
454         method          => "wormize",
455         api_level       => 1,
456         argc            => 1,
457 );
458
459
460 # --------------------------------------------------------------------------------
461
462
463 sub _marcxml_to_full_rows {
464
465         my $marcxml = shift;
466
467         my @ns_list;
468         
469         my $root = $marcxml->documentElement;
470
471         for my $tagline ( @{$root->getChildrenByTagName("leader")} ) {
472                 next unless $tagline;
473
474                 my $ns = new Fieldmapper::metabib::full_rec;
475
476                 $ns->tag( 'LDR' );
477                 my $val = $tagline->textContent;
478                 $val =~ s/(\pM)//gso;
479                 $ns->value( $val );
480
481                 push @ns_list, $ns;
482         }
483
484         for my $tagline ( @{$root->getChildrenByTagName("controlfield")} ) {
485                 next unless $tagline;
486
487                 my $ns = new Fieldmapper::metabib::full_rec;
488
489                 $ns->tag( $tagline->getAttribute( "tag" ) );
490                 my $val = $tagline->textContent;
491                 $val =~ s/(\pM)//gso;
492                 $ns->value( $val );
493
494                 push @ns_list, $ns;
495         }
496
497         for my $tagline ( @{$root->getChildrenByTagName("datafield")} ) {
498                 next unless $tagline;
499
500                 my $tag = $tagline->getAttribute( "tag" );
501                 my $ind1 = $tagline->getAttribute( "ind1" );
502                 my $ind2 = $tagline->getAttribute( "ind2" );
503
504                 for my $data ( $tagline->childNodes ) {
505                         next unless $data;
506
507                         my $ns = new Fieldmapper::metabib::full_rec;
508
509                         $ns->tag( $tag );
510                         $ns->ind1( $ind1 );
511                         $ns->ind2( $ind2 );
512                         $ns->subfield( $data->getAttribute( "code" ) );
513                         my $val = $data->textContent;
514                         $val =~ s/(\pM)//gso;
515                         $ns->value( lc($val) );
516
517                         push @ns_list, $ns;
518                 }
519         }
520         return @ns_list;
521 }
522
523 sub _get_field_value {
524
525         my( $root, $xpath ) = @_;
526
527         my $string = "";
528
529         # grab the set of matching nodes
530         my @nodes = $root->findnodes( $xpath );
531         for my $value (@nodes) {
532
533                 # grab all children of the node
534                 my @children = $value->childNodes();
535                 for my $child (@children) {
536
537                         # add the childs content to the growing buffer
538                         my $content = quotemeta($child->textContent);
539                         next if ($string =~ /$content/);  # uniquify the values
540                         $string .= $child->textContent . " ";
541                 }
542                 if( ! @children ) {
543                         $string .= $value->textContent . " ";
544                 }
545         }
546         $string =~ s/(\pM)//gso;
547         return lc($string);
548 }
549
550
551 sub modsdoc_to_values {
552         my( $self, $mods ) = @_;
553         my $data = {};
554         for my $class (keys %$xpathset) {
555                 $data->{$class} = {};
556                 for my $type (keys %{$xpathset->{$class}}) {
557                         $data->{$class}->{$type} = {};
558                         $data->{$class}->{$type}->{value} = _get_field_value( $mods, $xpathset->{$class}->{$type}->{xpath} );
559                         $data->{$class}->{$type}->{field_id} = $xpathset->{$class}->{$type}->{id};
560                 }
561         }
562         return $data;
563 }
564
565
566 1;
567
568