Open-ILS/src/perlmods/OpenILS/Application/WORM.pm

   1 package OpenILS::Application::WORM;
   2 use base qw/OpenSRF::Application/;
   3 use strict; use warnings;
   4
   5 use OpenILS::Utils::FlatXML;
   6 use OpenILS::Utils::Fieldmapper;
   7 use JSON;
   8
   9 use XML::LibXML;
  10 use XML::LibXSLT;
  11 use Time::HiRes qw(time);
  12
  13 my $xml_util    = OpenILS::Utils::FlatXML->new();
  14
  15 my $parser              = XML::LibXML->new();
  16 my $xslt                        = XML::LibXSLT->new();
  17 my $xslt_doc    =       $parser->parse_file( "/pines/cvs/ILS/Open-ILS/xsl/MARC21slim2MODS.xsl" );
  18 my $mods_sheet = $xslt->parse_stylesheet( $xslt_doc );
  19
  20 use open qw/:utf8/;
  21
  22 sub child_init {
  23         __PACKAGE__->method_lookup('i.do.not.exist');
  24 }
  25
  26
  27
  28 # get me from the database
  29 my $xpathset = {
  30
  31         title => {
  32
  33                 abbreviated =>
  34                         "//mods:mods/mods:titleInfo[mods:title and (\@type='abreviated')]",
  35
  36                 translated =>
  37                         "//mods:mods/mods:titleInfo[mods:title and (\@type='translated')]",
  38
  39                 uniform =>
  40                         "//mods:mods/mods:titleInfo[mods:title and (\@type='uniform')]",
  41
  42                 proper =>
  43                         "//mods:mods/mods:titleInfo[mods:title and not (\@type)]",
  44         },
  45
  46         author => {
  47
  48                 corporate =>
  49                         "//mods:mods/mods:name[\@type='corporate']/*[local-name()='namePart']".
  50                                 "[../mods:role/mods:text[text()='creator']][1]",
  51
  52                 personal =>
  53                         "//mods:mods/mods:name[\@type='personal']/*[local-name()='namePart']".
  54                                 "[../mods:role/mods:text[text()='creator']][1]",
  55
  56                 conference =>
  57                         "//mods:mods/mods:name[\@type='conference']/*[local-name()='namePart']".
  58                                 "[../mods:role/mods:text[text()='creator']][1]",
  59
  60                 other =>
  61                         "//mods:mods/mods:name[\@type='personal']/*[local-name()='namePart']",
  62         },
  63
  64         subject => {
  65
  66                 geographic =>
  67                         "//mods:mods/*[local-name()='subject']/*[local-name()='geographic']",
  68
  69                 name =>
  70                         "//mods:mods/*[local-name()='subject']/*[local-name()='name']",
  71
  72                 temporal =>
  73                         "//mods:mods/*[local-name()='subject']/*[local-name()='temporal']",
  74
  75                 topic =>
  76                         "//mods:mods/*[local-name()='subject']/*[local-name()='topic']",
  77
  78         },
  79
  80         keyword => { keyword => "//mods:mods/*[not(local-name()='originInfo')]", },
  81
  82 };
  83
  84
  85 # --------------------------------------------------------------------------------
  86
  87 __PACKAGE__->register_method(
  88                 api_name => "open-ils.worm.wormize",
  89                 method  => "wormize",
  90                 api_level       => 1,
  91                 argc    => 1,
  92                 stream => 0,
  93                 );
  94
  95 sub wormize {
  96
  97         my( $self, $client, $docid ) = @_;
  98
  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);
 102
 103         my $xact_req = $st_ses->request('open-ils.storage.transaction.begin');
 104         $xact_req->wait_complete;
 105
 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);
 111         $xact_req->finish();
 112
 113
 114         # step -1: grab the doc from storage
 115         my $marc_req = $st_ses->request('open-ils.storage.biblio.record_marc.retrieve', $docid);
 116         $marc_req->wait_complete;
 117
 118         $resp = $marc_req->recv;
 119         unless (UNIVERSAL::can($resp, 'content')) {
 120                 my $rb = $st_ses->request('open-ils.storage.biblio.transaction.rollback');
 121                 $rb->wait_complete;
 122                 throw OpenSRF::EX::PANIC ("Couldn't run .record_marc.retrieve! -- $resp")
 123         }
 124         unless ($resp->content) {
 125                 my $rb = $st_ses->request('open-ils.storage.biblio.transaction.rollback');
 126                 $rb->wait_complete;
 127                 throw OpenSRF::EX::PANIC ("Couldn't find doc for docid $docid failed! -- ".$resp->content)
 128         }
 129
 130         $marc_req->finish();
 131
 132
 133         my $marcxml = $resp->content->marc;
 134
 135         # step 0: turn the doc into marcxml and mods
 136         if(!$marcxml) { throw OpenSRF::EX::PANIC ("Can't build XML from nodeset for $docid'"); }
 137         my $marcdoc = $parser->parse_string($marcxml);
 138
 139
 140         # step 1: build the KOHA rows
 141         my @ns_list = _marcxml_to_full_rows( $marcdoc );
 142         $_->record = $docid for (@ns_list);
 143
 144         my $fr_req = $st_ses->request( 'open-ils.storage.metabib.full_rec.batch.create', @ns_list );
 145         $fr_req->wait_complete;
 146
 147         $resp = $fr_req->recv;
 148
 149         unless (UNIVERSAL::can($resp, 'content')) {
 150                 my $rb = $st_ses->request('open-ils.storage.biblio.transaction.rollback');
 151                 $rb->wait_complete;
 152                 throw OpenSRF::EX::PANIC ("Couldn't run .full_rec.batch.create! -- $resp")
 153         }
 154         unless ($resp->content) {
 155                 my $rb = $st_ses->request('open-ils.storage.biblio.transaction.rollback');
 156                 $rb->wait_complete;
 157                 throw OpenSRF::EX::PANIC ("Didn't create any full_rec entries! -- ".$resp->content)
 158         }
 159
 160         $fr_req->finish();
 161
 162         # That's all for now!
 163         my $commit_req = $st_ses->request( 'open-ils.storage.trasaction.commit' );
 164         $commit_req->wait_complete;
 165
 166         $resp = $commit_req->recv;
 167
 168         unless (UNIVERSAL::can($resp, 'content')) {
 169                 my $rb = $st_ses->request('open-ils.storage.biblio.transaction.rollback');
 170                 $rb->wait_complete;
 171                 throw OpenSRF::EX::PANIC ("Error commiting transaction! -- $resp")
 172         }
 173         unless ($resp->content) {
 174                 my $rb = $st_ses->request('open-ils.storage.biblio.transaction.rollback');
 175                 $rb->wait_complete;
 176                 throw OpenSRF::EX::PANIC ("Transaction commit failed! -- ".$resp->content)
 177         }
 178
 179         $commit_req->finish();
 180
 181         $st_ses->finish();
 182         $st_ses->disconnect();
 183         $st_ses->kill_me();
 184
 185         return 1;
 186
 187         my $mods = $mods_sheet->transform($marcdoc);
 188
 189         # step 2;
 190         for my $class (keys %$xpathset) {
 191                 for my $type(keys %{$xpathset->{$class}}) {
 192                         my $value = _get_field_value( $mods, $xpathset->{$class}->{$type} );
 193                 }
 194         }
 195
 196 }
 197
 198
 199
 200 # --------------------------------------------------------------------------------
 201
 202
 203 sub _marcxml_to_full_rows {
 204
 205         my $marcxml = shift;
 206
 207         my @ns_list;
 208
 209         my $root = $marcxml->documentElement;
 210
 211         for my $tagline ( @{$root->getChildrenByTagName("leader")} ) {
 212                 next unless $tagline;
 213
 214                 my $ns = new Fieldmapper::metabib::full_rec;
 215
 216                 $ns->tag( 'LDR' );
 217                 $ns->value( $tagline->textContent );
 218
 219                 push @ns_list, $ns;
 220         }
 221
 222         for my $tagline ( @{$root->getChildrenByTagName("controlfield")} ) {
 223                 next unless $tagline;
 224
 225                 my $ns = new Fieldmapper::metabib::full_rec;
 226
 227                 $ns->tag( $tagline->getAttribute( "tag" ) );
 228                 $ns->value( $tagline->textContent );
 229
 230                 push @ns_list, $ns;
 231         }
 232
 233         for my $tagline ( @{$root->getChildrenByTagName("datafield")} ) {
 234                 next unless $tagline;
 235
 236                 for my $data ( @{$tagline->getChildrenByTagName("subfield")} ) {
 237                         next unless $tagline;
 238
 239                         my $ns = new Fieldmapper::metabib::full_rec;
 240
 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 );
 246
 247                         push @ns_list, $ns;
 248                 }
 249         }
 250         return @ns_list;
 251 }
 252
 253 sub _get_field_value {
 254
 255         my( $mods, $xpath ) = @_;
 256
 257         my $string = "";
 258         my $root = $mods->documentElement;
 259         $root->setNamespace( "http://www.loc.gov/mods/", "mods", 1 );
 260
 261         # grab the set of matching nodes
 262         my @nodes = $root->findnodes( $xpath );
 263         for my $value (@nodes) {
 264
 265                 # grab all children of the node
 266                 my @children = $value->childNodes();
 267                 for my $child (@children) {
 268
 269                         # add the childs content to the growing buffer
 270                         next if ($string =~ $child->textContent);  # uniquify the values
 271                         $string .= $child->textContent . " ";
 272                 }
 273                 if( ! @children ) {
 274                         $string .= $value->textContent . " ";
 275                 }
 276         }
 277         return $string;
 278 }
 279
 280
 281 sub modsdoc_to_values {
 282         my( $self, $mods ) = @_;
 283         my $data = {};
 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;
 289                 }
 290         }
 291         return $data;
 292 }
 293
 294
 295 1;
 296
 297