tons of storage server changes... see diffs
[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.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                                                         };
60                                         ',
61                         },
62                         author  => {
63                                         xpath   => [
64                                                         '//mods:mods/mods:name[mods:role/mods:text/text()="creator" and @type="personal"]/mods:namePart',
65                                                         '//mods:mods/mods:name[mods:role/mods:text/text()="creator"]/mods:namePart',
66                                         ],
67                                         fixup   => '
68                                                         do {
69                                                                 $text = lc($text);
70                                                                 $text =~ s/\s+/ /sgo;
71                                                                 $text =~ s/^\s*(.+)\s*$/$1/sgo;
72                                                                 ($text) = split ",", $text;
73                                                         };
74                                         ',
75                         },
76         ],
77
78         '//mods:mods/mods:relatedItem[@type!="host"]' => [
79                         title   => {
80                                         xpath   => [
81                                                         '//mods:mods/mods:relatedItem/mods:titleInfo[mods:title and (@type="uniform")]',
82                                                         '//mods:mods/mods:relatedItem/mods:titleInfo[mods:title and (@type="translated")]',
83                                                         '//mods:mods/mods:relatedItem/mods:titleInfo[mods:title and (@type="alternative")]',
84                                                         '//mods:mods/mods:relatedItem/mods:titleInfo[mods:title and not(@type)]',
85                                                         '//mods:mods/mods:titleInfo[mods:title and (@type="uniform")]',
86                                                         '//mods:mods/mods:titleInfo[mods:title and (@type="translated")]',
87                                                         '//mods:mods/mods:titleInfo[mods:title and (@type="alternative")]',
88                                                         '//mods:mods/mods:titleInfo[mods:title and not(@type)]',
89                                         ],
90                                         fixup   => '
91                                                         do {
92                                                                 $text = lc($text);
93                                                                 $text =~ s/\s+/ /sgo;
94                                                                 $text =~ s/^\s*(.+)\s*$/$1/sgo;
95                                                                 $text =~ s/\b(?:the|an?)\b//sgo;
96                                                                 $text =~ s/\[.[^\]]+\]//sgo;
97                                                                 $text =~ s/\s*[;\/\.]*$//sgo;
98                                                         };
99                                         ',
100                         },
101                         author  => {
102                                         xpath   => [
103                                                         '//mods:mods/mods:relatedItem/mods:name[mods:role/mods:text/text()="creator" and @type="personal"]/mods:namePart',
104                                                         '//mods:mods/mods:relatedItem/mods:name[mods:role/mods:text/text()="creator"]/mods:namePart',
105                                                         '//mods:mods/mods:name[mods:role/mods:text/text()="creator" and @type="personal"]/mods:namePart',
106                                                         '//mods:mods/mods:name[mods:role/mods:text/text()="creator"]/mods:namePart',
107                                         ],
108                                         fixup   => '
109                                                         do {
110                                                                 $text = lc($text);
111                                                                 $text =~ s/\s+/ /sgo;
112                                                                 $text =~ s/^\s*(.+)\s*$/$1/sgo;
113                                                                 ($text) = split ",", $text;
114                                                         };
115                                         ',
116                         },
117         ],
118
119 );
120
121 push @fp_mods_xpath, '//mods:mods/mods:titleInfo' => $fp_mods_xpath[1];
122
123 sub fingerprint_mods {
124         my $mods = shift;
125
126         my $fp_string = '';
127
128         my $match_index = 0;
129         my $block_index = 1;
130         while ( my $match_xpath = $fp_mods_xpath[$match_index] ) {
131                 if ( my @nodes = $mods->findnodes( $match_xpath ) ) {
132
133                         my $block_name_index = 0;
134                         my $block_value_index = 1;
135                         my $block = $fp_mods_xpath[$block_index];
136                         while ( my $part = $$block[$block_value_index] ) {
137                                 my $text;
138                                 for my $xpath ( @{ $part->{xpath} } ) {
139                                         $text = $mods->findvalue( $xpath );
140                                         last if ($text);
141                                 }
142
143                                 $log->debug("Found fingerprint text using $$block[$block_name_index] : [$text]", DEBUG);
144
145                                 if ($text) {
146                                         eval $$part{fixup};
147                                         $fp_string .= $text;
148                                 }
149
150                                 $block_name_index += 2;
151                                 $block_value_index += 2;
152                         }
153                 }
154                 if ($fp_string) {
155                         $log->debug("Fingerprint is [$fp_string]", INFO);;
156                         return $fp_string;
157                 }
158
159                 $match_index += 2;
160                 $block_index += 2;
161         }
162         return undef;
163 }
164
165
166
167 # --------------------------------------------------------------------------------
168
169 my $begin;
170 my $commit;
171 my $rollback;
172 my $lookup;
173 my $fetch_entry;
174 my $update_entry;
175 my $rm_old_rd;
176 my $rm_old_fr;
177 my $rm_old_tr;
178 my $rm_old_ar;
179 my $rm_old_sr;
180 my $rm_old_kr;
181
182 my $fr_create;
183 my $rd_create;
184 my $create = {};
185
186 my %descriptor_code = (
187         item_type => 'substr($ldr,6,1)',
188         item_form => '(substr($ldr,6,1) =~ /^(?:f|g|i|m|o|p|r)$/) ? substr($oo8,29,1) : substr($oo8,23,1)',
189         bib_level => 'substr($ldr,7,1)',
190         control_type => 'substr($ldr,8,1)',
191         char_encoding => 'substr($ldr,9,1)',
192         enc_level => 'substr($ldr,17,1)',
193         cat_form => 'substr($ldr,18,1)',
194         pub_status => 'substr($ldr,5,1)',
195         item_lang => 'substr($oo8,35,3)',
196         audience => 'substr($oo8,22,1)',
197 );
198
199 sub wormize {
200
201         my $self = shift;
202         my $client = shift;
203         my @docids = @_;
204
205         $begin = $self->method_lookup( 'open-ils.storage.transaction.begin')
206                 unless ($begin);
207         $commit = $self->method_lookup( 'open-ils.storage.transaction.commit')
208                 unless ($commit);
209         $rollback = $self->method_lookup( 'open-ils.storage.transaction.rollback')
210                 unless ($rollback);
211         $lookup = $self->method_lookup('open-ils.storage.direct.biblio.record_marc.batch.retrieve')
212                 unless ($lookup);
213         $fetch_entry = $self->method_lookup('open-ils.storage.direct.biblio.record_entry.retrieve')
214                 unless ($update_entry);
215         $update_entry = $self->method_lookup('open-ils.storage.direct.biblio.record_entry.batch.update')
216                 unless ($update_entry);
217         $rm_old_rd = $self->method_lookup( 'open-ils.storage.direct.metabib.record_descriptor.mass_delete')
218                 unless ($rm_old_rd);
219         $rm_old_fr = $self->method_lookup( 'open-ils.storage.direct.metabib.full_rec.mass_delete')
220                 unless ($rm_old_fr);
221         $rm_old_tr = $self->method_lookup( 'open-ils.storage.direct.metabib.title_field_entry.mass_delete')
222                 unless ($rm_old_tr);
223         $rm_old_ar = $self->method_lookup( 'open-ils.storage.direct.metabib.author_field_entry.mass_delete')
224                 unless ($rm_old_ar);
225         $rm_old_sr = $self->method_lookup( 'open-ils.storage.direct.metabib.subject_field_entry.mass_delete')
226                 unless ($rm_old_sr);
227         $rm_old_kr = $self->method_lookup( 'open-ils.storage.direct.metabib.keyword_field_entry.mass_delete')
228                 unless ($rm_old_kr);
229         $rd_create = $self->method_lookup( 'open-ils.storage.direct.metabib.record_descriptor.batch.create')
230                 unless ($rd_create);
231         $fr_create = $self->method_lookup( 'open-ils.storage.direct.metabib.full_rec.batch.create')
232                 unless ($fr_create);
233         $$create{title} = $self->method_lookup( 'open-ils.storage.direct.metabib.title_field_entry.batch.create')
234                 unless ($$create{title});
235         $$create{author} = $self->method_lookup( 'open-ils.storage.direct.metabib.author_field_entry.batch.create')
236                 unless ($$create{author});
237         $$create{subject} = $self->method_lookup( 'open-ils.storage.direct.metabib.subject_field_entry.batch.create')
238                 unless ($$create{subject});
239         $$create{keyword} = $self->method_lookup( 'open-ils.storage.direct.metabib.keyword_field_entry.batch.create')
240                 unless ($$create{keyword});
241
242
243         try {
244                 my ($r) = $begin->run($client);
245                 unless (defined $r and $r) {
246                         $rollback->run;
247                         throw OpenSRF::EX::PANIC ("Couldn't BEGIN transaction!")
248                 }
249         } catch Error with {
250                 throw OpenSRF::EX::PANIC ("WoRM Couldn't BEGIN transaction!")
251         };
252
253         my @entry_list;
254         my @rd_list;
255         my @ns_list;
256         my @mods_data;
257         my $ret = 0;
258         for my $marc ( $lookup->run(@docids) ) {
259                 # step -1: grab the doc from storage
260                 next unless ($marc);
261
262                 my $xml = $marc->marc;
263                 my $docid = $marc->id;
264                 my $marcdoc = $parser->parse_string($xml);
265                 my $modsdoc = $mods_sheet->transform($marcdoc);
266
267                 my $mods = $modsdoc->documentElement;
268                 $mods->setNamespace( "http://www.loc.gov/mods/", "mods", 1 );
269
270                 my ($entry) = $fetch_entry->run($docid);
271                 $entry->fingerprint( fingerprint_mods( $mods ) );
272                 push @entry_list, $entry;
273
274                 my $ldr = $marcdoc->documentElement->getChildrenByTagName('leader')->pop->textContent;
275                 my $oo8 = $marcdoc->documentElement->findvalue('//*[local-name()="controlfield" and @tag="008"]');
276
277                 my $rd_obj = Fieldmapper::metabib::record_descriptor->new;
278                 for my $rd_field ( keys %descriptor_code ) {
279                         $rd_obj->$rd_field( eval "$descriptor_code{$rd_field};" );
280                 }
281                 $rd_obj->record( $docid );
282                 push @rd_list, $rd_obj;
283
284                 push @mods_data, { $docid => $self->modsdoc_to_values( $mods ) };
285
286                 # step 2: build the KOHA rows
287                 my @tmp_list = _marcxml_to_full_rows( $marcdoc );
288                 $_->record( $docid ) for (@tmp_list);
289                 push @ns_list, @tmp_list;
290
291                 $ret++;
292
293                 last unless ($self->api_name =~ /batch$/o);
294         }
295
296         $rm_old_rd->run( { record => \@docids } );
297         $rm_old_fr->run( { record => \@docids } );
298         $rm_old_tr->run( { source => \@docids } );
299         $rm_old_ar->run( { source => \@docids } );
300         $rm_old_sr->run( { source => \@docids } );
301         $rm_old_kr->run( { source => \@docids } );
302
303         my ($re) = $update_entry->run(@entry_list);
304         unless (defined $re) {
305                 throw OpenSRF::EX::PANIC ("Couldn't run open-ils.storage.direct.biblio.record_entry.batch.update!")
306         }
307
308         my ($rd) = $rd_create->run(@rd_list);
309         unless (defined $rd) {
310                 throw OpenSRF::EX::PANIC ("Couldn't run open-ils.storage.direct.metabib.record_descriptor.batch.create!")
311         }
312
313         my ($fr) = $fr_create->run(@ns_list);
314         unless (defined $fr) {
315                 throw OpenSRF::EX::PANIC ("Couldn't run open-ils.storage.direct.metabib.full_rec.batch.create!")
316         }
317
318         # step 5: insert the new metadata
319         for my $class ( qw/title author subject keyword/ ) {
320                 my @md_list = ();
321                 for my $doc ( @mods_data ) {
322                         my ($did) = keys %$doc;
323                         my ($data) = values %$doc;
324
325                         my $fm_constructor = "Fieldmapper::metabib::${class}_field_entry";
326                         for my $row ( keys %{ $$data{$class} } ) {
327                                 next unless (exists $$data{$class}{$row});
328                                 next unless ($$data{$class}{$row}{value});
329                                 my $fm_obj = $fm_constructor->new;
330                                 $fm_obj->value( $$data{$class}{$row}{value} );
331                                 $fm_obj->field( $$data{$class}{$row}{field_id} );
332                                 $fm_obj->source( $did );
333                                 $log->debug("$class entry: ".$fm_obj->source." => ".$fm_obj->field." : ".$fm_obj->value, DEBUG);
334
335                                 push @md_list, $fm_obj;
336                         }
337                 }
338                         
339                 my ($cr) = $$create{$class}->run(@md_list);
340                 unless (defined $cr) {
341                         throw OpenSRF::EX::PANIC ("Couldn't run open-ils.storage.direct.metabib.${class}_field_entry.batch.create!")
342                 }
343         }
344
345         my ($c) = $commit->run;
346         unless (defined $c and $c) {
347                 $rollback->run;
348                 throw OpenSRF::EX::PANIC ("Couldn't COMMIT changes!")
349         }
350
351         return $ret;
352 }
353 __PACKAGE__->register_method( 
354         api_name        => "open-ils.worm.wormize",
355         method          => "wormize",
356         api_level       => 1,
357         argc            => 1,
358 );
359 __PACKAGE__->register_method( 
360         api_name        => "open-ils.worm.wormize.batch",
361         method          => "wormize",
362         api_level       => 1,
363         argc            => 1,
364 );
365
366
367 # --------------------------------------------------------------------------------
368
369
370 sub _marcxml_to_full_rows {
371
372         my $marcxml = shift;
373
374         my @ns_list;
375         
376         my $root = $marcxml->documentElement;
377
378         for my $tagline ( @{$root->getChildrenByTagName("leader")} ) {
379                 next unless $tagline;
380
381                 my $ns = new Fieldmapper::metabib::full_rec;
382
383                 $ns->tag( 'LDR' );
384                 my $val = $tagline->textContent;
385                 $val =~ s/(\pM)//gso;
386                 $ns->value( $val );
387
388                 push @ns_list, $ns;
389         }
390
391         for my $tagline ( @{$root->getChildrenByTagName("controlfield")} ) {
392                 next unless $tagline;
393
394                 my $ns = new Fieldmapper::metabib::full_rec;
395
396                 $ns->tag( $tagline->getAttribute( "tag" ) );
397                 my $val = $tagline->textContent;
398                 $val =~ s/(\pM)//gso;
399                 $ns->value( $val );
400
401                 push @ns_list, $ns;
402         }
403
404         for my $tagline ( @{$root->getChildrenByTagName("datafield")} ) {
405                 next unless $tagline;
406
407                 my $tag = $tagline->getAttribute( "tag" );
408                 my $ind1 = $tagline->getAttribute( "ind1" );
409                 my $ind2 = $tagline->getAttribute( "ind2" );
410
411                 for my $data ( $tagline->childNodes ) {
412                         next unless $data;
413
414                         my $ns = new Fieldmapper::metabib::full_rec;
415
416                         $ns->tag( $tag );
417                         $ns->ind1( $ind1 );
418                         $ns->ind2( $ind2 );
419                         $ns->subfield( $data->getAttribute( "code" ) );
420                         my $val = $data->textContent;
421                         $val =~ s/(\pM)//gso;
422                         $ns->value( lc($val) );
423
424                         push @ns_list, $ns;
425                 }
426         }
427         return @ns_list;
428 }
429
430 sub _get_field_value {
431
432         my( $root, $xpath ) = @_;
433
434         my $string = "";
435
436         # grab the set of matching nodes
437         my @nodes = $root->findnodes( $xpath );
438         for my $value (@nodes) {
439
440                 # grab all children of the node
441                 my @children = $value->childNodes();
442                 for my $child (@children) {
443
444                         # add the childs content to the growing buffer
445                         my $content = quotemeta($child->textContent);
446                         next if ($string =~ /$content/);  # uniquify the values
447                         $string .= $child->textContent . " ";
448                 }
449                 if( ! @children ) {
450                         $string .= $value->textContent . " ";
451                 }
452         }
453         $string =~ s/(\pM)//gso;
454         return lc($string);
455 }
456
457
458 sub modsdoc_to_values {
459         my( $self, $mods ) = @_;
460         my $data = {};
461         for my $class (keys %$xpathset) {
462                 $data->{$class} = {};
463                 for my $type (keys %{$xpathset->{$class}}) {
464                         $data->{$class}->{$type} = {};
465                         $data->{$class}->{$type}->{value} = _get_field_value( $mods, $xpathset->{$class}->{$type}->{xpath} );
466                         $data->{$class}->{$type}->{field_id} = $xpathset->{$class}->{$type}->{id};
467                 }
468         }
469         return $data;
470 }
471
472
473 1;
474
475