1 package OpenILS::Application::WORM;
2 use base qw/OpenSRF::Application/;
3 use strict; use warnings;
5 use OpenILS::Utils::FlatXML;
6 use OpenILS::Utils::Fieldmapper;
11 use Time::HiRes qw(time);
13 my $xml_util = OpenILS::Utils::FlatXML->new();
15 my $parser = XML::LibXML->new();
16 my $xslt = XML::LibXSLT->new();
17 my $xslt_doc = $parser->parse_file( "/home/miker/cvs/OpenILS/app_server/stylesheets/MARC21slim2MODS.xsl" );
18 my $mods_sheet = $xslt->parse_stylesheet( $xslt_doc );
23 #__PACKAGE__->method_lookup('i.do.not.exist');
28 # get me from the database
34 "//mods:mods/mods:titleInfo[mods:title and (\@type='abreviated')]",
37 "//mods:mods/mods:titleInfo[mods:title and (\@type='translated')]",
40 "//mods:mods/mods:titleInfo[mods:title and (\@type='uniform')]",
43 "//mods:mods/mods:titleInfo[mods:title and not (\@type)]",
49 "//mods:mods/mods:name[\@type='corporate']/*[local-name()='namePart']".
50 "[../mods:role/mods:text[text()='creator']][1]",
53 "//mods:mods/mods:name[\@type='personal']/*[local-name()='namePart']".
54 "[../mods:role/mods:text[text()='creator']][1]",
57 "//mods:mods/mods:name[\@type='conference']/*[local-name()='namePart']".
58 "[../mods:role/mods:text[text()='creator']][1]",
61 "//mods:mods/mods:name[\@type='personal']/*[local-name()='namePart']",
67 "//mods:mods/*[local-name()='subject']/*[local-name()='geographic']",
70 "//mods:mods/*[local-name()='subject']/*[local-name()='name']",
73 "//mods:mods/*[local-name()='subject']/*[local-name()='temporal']",
76 "//mods:mods/*[local-name()='subject']/*[local-name()='topic']",
80 keyword => { keyword => "//mods:mods/*[not(local-name()='originInfo')]", },
85 # --------------------------------------------------------------------------------
87 __PACKAGE__->register_method(
88 api_name => "open-ils.worm.wormize",
97 my( $self, $client, $docid ) = @_;
99 my $st_ses = $client->session->create('open-ils.storage');
100 throw OpenSRF::EX::PANIC ("WORM can't connect to the open-is.storage server!")
101 if (!$st_ses->connect);
103 my $xact_req = $st_ses->request('open-ils.storage.transaction.begin');
104 $xact_req->wait_complete;
106 my $resp = $xact_req->recv;
107 throw OpenSRF::EX::PANIC ("Couldn't start a transaction! -- $resp")
108 unless (UNIVERSAL::can($resp, 'content'));
109 throw OpenSRF::EX::PANIC ("Transaction creation failed! -- ".$resp->content)
110 unless ($resp->content);
115 # step -1: grab the doc from storage
116 my $marc_req = $st_ses->request('open-ils.storage.biblio.record_marc.retrieve', $docid);
117 $marc_req->wait_complete;
119 $resp = $marc_req->recv;
120 unless (UNIVERSAL::can($resp, 'content')) {
121 my $rb = $st_ses->request('open-ils.storage.biblio.transaction.rollback');
123 throw OpenSRF::EX::PANIC ("Couldn't run .record_marc.retrieve! -- $resp")
125 unless ($resp->content) {
126 my $rb = $st_ses->request('open-ils.storage.biblio.transaction.rollback');
128 throw OpenSRF::EX::PANIC ("Couldn't find doc for docid $docid failed! -- ".$resp->content)
134 my $marcxml = $resp->content->marc;
136 # step 0: turn the doc into marcxml and mods
137 if(!$marcxml) { throw OpenSRF::EX::PANIC ("Can't build XML from nodeset for $docid'"); }
138 my $marcdoc = $parser->parse_string($marcxml);
141 # step 1: build the KOHA rows
142 my @ns_list = _marcxml_to_full_rows( $marcdoc );
143 $_->record( $docid ) for (@ns_list);
145 my $fr_req = $st_ses->request( 'open-ils.storage.metabib.full_rec.batch.create', @ns_list );
146 $fr_req->wait_complete;
148 $resp = $fr_req->recv;
150 unless (UNIVERSAL::can($resp, 'content')) {
151 my $rb = $st_ses->request('open-ils.storage.biblio.transaction.rollback');
153 throw OpenSRF::EX::PANIC ("Couldn't run .full_rec.batch.create! -- $resp")
155 unless ($resp->content) {
156 my $rb = $st_ses->request('open-ils.storage.biblio.transaction.rollback');
158 throw OpenSRF::EX::PANIC ("Didn't create any full_rec entries! -- ".$resp->content)
163 # That's all for now!
164 my $commit_req = $st_ses->request( 'open-ils.storage.transaction.commit' );
165 $commit_req->wait_complete;
167 $resp = $commit_req->recv;
169 unless (UNIVERSAL::can($resp, 'content')) {
170 my $rb = $st_ses->request('open-ils.storage.transaction.rollback');
172 throw OpenSRF::EX::PANIC ("Error commiting transaction! -- $resp")
174 unless ($resp->content) {
175 my $rb = $st_ses->request('open-ils.storage.transaction.rollback');
177 throw OpenSRF::EX::PANIC ("Transaction commit failed! -- ".$resp->content)
180 $commit_req->finish();
182 $st_ses->disconnect();
187 my $mods = $mods_sheet->transform($marcdoc);
190 for my $class (keys %$xpathset) {
191 for my $type(keys %{$xpathset->{$class}}) {
192 my $value = _get_field_value( $mods, $xpathset->{$class}->{$type} );
200 # --------------------------------------------------------------------------------
203 sub _marcxml_to_full_rows {
209 my $root = $marcxml->documentElement;
211 for my $tagline ( @{$root->getChildrenByTagName("leader")} ) {
212 next unless $tagline;
214 my $ns = new Fieldmapper::metabib::full_rec;
217 $ns->value( $tagline->textContent );
222 for my $tagline ( @{$root->getChildrenByTagName("controlfield")} ) {
223 next unless $tagline;
225 my $ns = new Fieldmapper::metabib::full_rec;
227 $ns->tag( $tagline->getAttribute( "tag" ) );
228 $ns->value( $tagline->textContent );
233 for my $tagline ( @{$root->getChildrenByTagName("datafield")} ) {
234 next unless $tagline;
236 for my $data ( @{$tagline->getChildrenByTagName("subfield")} ) {
237 next unless $tagline;
239 my $ns = new Fieldmapper::metabib::full_rec;
241 $ns->tag( $tagline->getAttribute( "tag" ) );
242 $ns->ind1( $tagline->getAttribute( "ind1" ) );
243 $ns->ind2( $tagline->getAttribute( "ind2" ) );
244 $ns->subfield( $data->getAttribute( "code" ) );
245 $ns->value( $data->textContent );
253 sub _get_field_value {
255 my( $mods, $xpath ) = @_;
258 my $root = $mods->documentElement;
259 $root->setNamespace( "http://www.loc.gov/mods/", "mods", 1 );
261 # grab the set of matching nodes
262 my @nodes = $root->findnodes( $xpath );
263 for my $value (@nodes) {
265 # grab all children of the node
266 my @children = $value->childNodes();
267 for my $child (@children) {
269 # add the childs content to the growing buffer
270 next if ($string =~ $child->textContent); # uniquify the values
271 $string .= $child->textContent . " ";
274 $string .= $value->textContent . " ";
281 sub modsdoc_to_values {
282 my( $self, $mods ) = @_;
284 for my $class (keys %$xpathset) {
285 $data->{$class} = {};
286 for my $type(keys %{$xpathset->{$class}}) {
287 my $value = _get_field_value( $mods, $xpathset->{$class}->{$type} );
288 $data->{$class}->{$type} = $value;