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

   1 package OpenILS::Application::WoRM;
   2 use base qw/OpenSRF::Application/;
   3 use open qw/:utf8/;
   4
   5 use Unicode::Normalize;
   6 use OpenSRF::EX qw/:try/;
   7
   8 use OpenSRF::Utils::SettingsClient;
   9 use OpenSRF::Utils::Logger qw/:level/;
  10
  11 use OpenILS::Utils::FlatXML;
  12 use OpenILS::Utils::Fieldmapper;
  13 use JSON;
  14
  15 use OpenILS::Utils::Fieldmapper;
  16
  17 use XML::LibXML;
  18 use XML::LibXSLT;
  19 use Time::HiRes qw(time);
  20
  21
  22 our $log = 'OpenSRF::Utils::Logger';
  23 our $xml_util = OpenILS::Utils::FlatXML->new();
  24
  25 our $parser = XML::LibXML->new();
  26 our $xslt = XML::LibXSLT->new();
  27 our $mods_sheet;
  28 our $mads_sheet;
  29
  30 our $st_sess;
  31 sub st_sess {
  32         my $self = shift;
  33         my $sess = shift;
  34         $st_sess = $sess if ($sess);
  35         return $st_sess;
  36 }
  37
  38 our $xpathset = {};
  39
  40 sub initialize {}
  41 sub child_init {}
  42
  43 sub post_init {
  44         $log->debug("Running post_init", DEBUG);
  45
  46         unless ($mods_sheet) {
  47                 $log->debug("Loading MODS XSLT", DEBUG);
  48                 my $xslt_doc = $parser->parse_file(
  49                         OpenSRF::Utils::SettingsClient->new->config_value(dirs => 'xsl') .  "/MARC21slim2MODS.xsl");
  50                 $mods_sheet = $xslt->parse_stylesheet( $xslt_doc );
  51         }
  52
  53         #if (!__PACKAGE__->st_sess()) {
  54         #       $log->debug("Creating cached storage server session", DEBUG);
  55         #       __PACKAGE__->st_sess( OpenSRF::AppSession->create('open-ils.storage') );
  56         #}
  57
  58         unless (keys %$xpathset) {
  59                 my $req = __PACKAGE__->storage_req('open-ils.storage.direct.config.metabib_field.retrieve.all.atomic');
  60                 for my $f (@$req) {
  61                         $xpathset->{ $f->field_class }->{ $f->name }->{xpath} = $f->xpath;
  62                         $xpathset->{ $f->field_class }->{ $f->name }->{id} = $f->id;
  63                         $log->debug("Loaded XPath from DB: ".$f->field_class." => ".$f->name." : ".$f->xpath, DEBUG);
  64                 }
  65         }
  66 }
  67
  68
  69 sub in_transaction {
  70         OpenILS::Application::WoRM->post_init();
  71         return __PACKAGE__->storage_req( 'open-ils.storage.transaction.current' );
  72 }
  73
  74 sub begin_transaction {
  75         my $self = shift;
  76         my $client = shift;
  77
  78         OpenILS::Application::WoRM->post_init();
  79         my $outer_xact = __PACKAGE__->storage_req( 'open-ils.storage.transaction.current' );
  80
  81         try {
  82                 if (!$outer_xact) {
  83                         $log->debug("WoRM isn't inside a transaction, starting one now.", INFO);
  84                         #__PACKAGE__->st_sess->connect;
  85                         my $r = __PACKAGE__->storage_req( 'open-ils.storage.transaction.begin', $client );
  86                         unless (defined $r and $r) {
  87                                 __PACKAGE__->storage_req( 'open-ils.storage.transaction.rollback' );
  88                                 #__PACKAGE__->st_sess->disconnect;
  89                                 throw OpenSRF::EX::PANIC ("Couldn't BEGIN transaction!")
  90                         }
  91                 }
  92         } otherwise {
  93                 $log->debug("WoRM Couldn't BEGIN transaction!", ERROR)
  94         };
  95
  96         return __PACKAGE__->storage_req( 'open-ils.storage.transaction.current' );
  97 }
  98
  99 sub rollback_transaction {
 100         my $self = shift;
 101         my $client = shift;
 102
 103         OpenILS::Application::WoRM->post_init();
 104         my $outer_xact = __PACKAGE__->storage_req( 'open-ils.storage.transaction.current' );
 105
 106         try {
 107                 if ($outer_xact) {
 108                         __PACKAGE__->storage_req( 'open-ils.storage.transaction.rollback' );
 109                 } else {
 110                         $log->debug("WoRM isn't inside a transaction.", INFO);
 111                 }
 112         } catch Error with {
 113                 throw OpenSRF::EX::PANIC ("WoRM Couldn't COMMIT transaction!")
 114         };
 115
 116         return 1;
 117 }
 118
 119 sub commit_transaction {
 120         my $self = shift;
 121         my $client = shift;
 122
 123         OpenILS::Application::WoRM->post_init();
 124         my $outer_xact = __PACKAGE__->storage_req( 'open-ils.storage.transaction.current' );
 125
 126         try {
 127                 #if (__PACKAGE__->st_sess->connected && $outer_xact) {
 128                 if ($outer_xact) {
 129                         my $r = __PACKAGE__->storage_req( 'open-ils.storage.transaction.commit' );
 130                         unless (defined $r and $r) {
 131                                 __PACKAGE__->storage_req( 'open-ils.storage.transaction.rollback' );
 132                                 throw OpenSRF::EX::PANIC ("Couldn't COMMIT transaction!")
 133                         }
 134                         #__PACKAGE__->st_sess->disconnect;
 135                 } else {
 136                         $log->debug("WoRM isn't inside a transaction.", INFO);
 137                 }
 138         } catch Error with {
 139                 throw OpenSRF::EX::PANIC ("WoRM Couldn't COMMIT transaction!")
 140         };
 141
 142         return 1;
 143 }
 144
 145 sub storage_req {
 146         my $self = shift;
 147         my $method = shift;
 148         my @res = __PACKAGE__->method_lookup( $method )->run( @_ );
 149         return shift( @res );
 150 }
 151
 152 sub scrub_authority_record {
 153         my $self = shift;
 154         my $client = shift;
 155         my $rec = shift;
 156
 157         my $commit = 0;
 158         if (!OpenILS::Application::WoRM->in_transaction) {
 159                 OpenILS::Application::WoRM->begin_transaction($client) || throw OpenSRF::EX::PANIC ("Couldn't BEGIN transaction!");
 160                 $commit = 1;
 161         }
 162
 163         my $success = 1;
 164         try {
 165                 OpenILS::Application::WoRM->storage_req( 'open-ils.storage.savepoint.set', 'scrub_authority_record' );
 166
 167                 OpenILS::Application::WoRM->storage_req( 'open-ils.storage.direct.authority.full_rec.mass_delete', { record => $rec } );
 168                 OpenILS::Application::WoRM->storage_req( 'open-ils.storage.direct.authority.record_descriptor.mass_delete', { record => $rec } );
 169
 170                 OpenILS::Application::WoRM->storage_req( 'open-ils.storage.savepoint.release', 'scrub_authority_record' );
 171         } otherwise {
 172                 $log->debug('Scrubbing failed : '.shift(), ERROR);
 173                 OpenILS::Application::WoRM->storage_req( 'open-ils.storage.savepoint.rollback', 'scrub_authority_record' );
 174                 $success = 0;
 175         };
 176
 177         OpenILS::Application::WoRM->commit_transaction if ($commit && $success);
 178         OpenILS::Application::WoRM->rollback_transaction if ($commit && !$success);
 179         return $success;
 180 }
 181 __PACKAGE__->register_method(
 182         api_name        => "open-ils.worm.scrub.authority",
 183         method          => "scrub_authority_record",
 184         api_level       => 1,
 185         argc            => 1,
 186 );
 187
 188
 189 sub scrub_metabib_record {
 190         my $self = shift;
 191         my $client = shift;
 192         my $rec = shift;
 193
 194         my $commit = 0;
 195         if (!OpenILS::Application::WoRM->in_transaction) {
 196                 OpenILS::Application::WoRM->begin_transaction($client) || throw OpenSRF::EX::PANIC ("Couldn't BEGIN transaction!");
 197                 $commit = 1;
 198         }
 199
 200         my $success = 1;
 201         try {
 202                 OpenILS::Application::WoRM->storage_req( 'open-ils.storage.savepoint.set', 'scrub_metabib_record' );
 203
 204                 OpenILS::Application::WoRM->storage_req( 'open-ils.storage.direct.metabib.full_rec.mass_delete', { record => $rec } );
 205                 OpenILS::Application::WoRM->storage_req( 'open-ils.storage.direct.metabib.metarecord_source_map.mass_delete', { source => $rec } );
 206                 OpenILS::Application::WoRM->storage_req( 'open-ils.storage.direct.metabib.record_descriptor.mass_delete', { record => $rec } );
 207                 OpenILS::Application::WoRM->storage_req( 'open-ils.storage.direct.metabib.title_field_entry.mass_delete', { source => $rec } );
 208                 OpenILS::Application::WoRM->storage_req( 'open-ils.storage.direct.metabib.author_field_entry.mass_delete', { source => $rec } );
 209                 OpenILS::Application::WoRM->storage_req( 'open-ils.storage.direct.metabib.subject_field_entry.mass_delete', { source => $rec } );
 210                 OpenILS::Application::WoRM->storage_req( 'open-ils.storage.direct.metabib.keyword_field_entry.mass_delete', { source => $rec } );
 211                 OpenILS::Application::WoRM->storage_req( 'open-ils.storage.direct.metabib.series_field_entry.mass_delete', { source => $rec } );
 212
 213                 $log->debug( "Looking for metarecords whose master is $rec", DEBUG);
 214                 my $masters = OpenILS::Application::WoRM->storage_req( 'open-ils.storage.direct.metabib.metarecord.search.master_record.atomic', $rec );
 215
 216                 for my $mr (@$masters) {
 217                         $log->debug( "Found metarecord whose master is $rec", DEBUG);
 218                         my $others = OpenILS::Application::WoRM->storage_req(
 219                                         'open-ils.storage.direct.metabib.metarecord_source_map.search.metarecord.atomic', $mr->id );
 220
 221                         if (@$others) {
 222                                 $log->debug("Metarecord ".$mr->id." had master of $rec, setting to ".$others->[0]->source, DEBUG);
 223                                 $mr->master_record($others->[0]->source);
 224                                 OpenILS::Application::WoRM->storage_req(
 225                                         'open-ils.storage.direct.metabib.metarecord.remote_update',
 226                                         { id => $mr->id },
 227                                         { master_record => $others->[0]->source, mods => undef }
 228                                 );
 229                         } else {
 230                                 warn "Removing metarecord whose master is $rec";
 231                                 $log->debug( "Removing metarecord whose master is $rec", DEBUG);
 232                                 OpenILS::Application::WoRM->storage_req( 'open-ils.storage.direct.metabib.metarecord.delete', $mr->id );
 233                                 warn "Metarecord removed";
 234                                 $log->debug( "Metarecord removed", DEBUG);
 235                         }
 236                 }
 237
 238                 OpenILS::Application::WoRM->storage_req( 'open-ils.storage.savepoint.release', 'scrub_metabib_record' );
 239
 240         } otherwise {
 241                 $log->debug('Scrubbing failed : '.shift(), ERROR);
 242                 OpenILS::Application::WoRM->storage_req( 'open-ils.storage.savepoint.rollback', 'scrub_metabib_record' );
 243                 $success = 0;
 244         };
 245
 246         OpenILS::Application::WoRM->commit_transaction if ($commit && $success);
 247         OpenILS::Application::WoRM->rollback_transaction if ($commit && !$success);
 248         return $success;
 249 }
 250 __PACKAGE__->register_method(
 251         api_name        => "open-ils.worm.scrub.biblio",
 252         method          => "scrub_metabib_record",
 253         api_level       => 1,
 254         argc            => 1,
 255 );
 256
 257 sub wormize_biblio_record {
 258         my $self = shift;
 259         my $client = shift;
 260         my $rec = shift;
 261
 262         my $commit = 0;
 263         if (!OpenILS::Application::WoRM->in_transaction) {
 264                 OpenILS::Application::WoRM->begin_transaction($client) || throw OpenSRF::EX::PANIC ("Couldn't BEGIN transaction!");
 265                 $commit = 1;
 266         }
 267
 268         my $success = 1;
 269         try {
 270                 # clean up the cruft
 271                 unless ($self->api_name =~ /noscrub/o) {
 272                         $self->method_lookup( 'open-ils.worm.scrub.biblio' )->run( $rec ) || throw OpenSRF::EX::PANIC ("Couldn't scrub record $rec!");
 273                 }
 274
 275                 # now redo 'em
 276                 my $bibs = OpenILS::Application::WoRM->storage_req( 'open-ils.storage.direct.biblio.record_entry.search.id.atomic', $rec );
 277
 278                 my @full_rec = ();
 279                 my @rec_descriptor = ();
 280                 my %field_entry = (
 281                         title   => [],
 282                         author  => [],
 283                         subject => [],
 284                         keyword => [],
 285                         series  => [],
 286                 );
 287                 my @metarecord = ();
 288                 my @source_map = ();
 289                 for my $r (@$bibs) {
 290                         my $xml = $parser->parse_string($r->marc);
 291
 292                         # the full_rec stuff
 293                         for my $fr ( $self->method_lookup( 'open-ils.worm.flat_marc.biblio.xml' )->run( $xml ) ) {
 294                                 $fr->record( $r->id );
 295                                 push @full_rec, $fr;
 296                         }
 297
 298                         # the rec_descriptor stuff
 299                         my ($rd) = $self->method_lookup( 'open-ils.worm.biblio_leader.xml' )->run( $xml );
 300                         $rd->record( $r->id );
 301                         push @rec_descriptor, $rd;
 302
 303                         # the indexing field entry stuff
 304                         for my $class ( qw/title author subject keyword series/ ) {
 305                                 for my $fe ( $self->method_lookup( 'open-ils.worm.field_entry.class.xml' )->run( $xml, $class ) ) {
 306                                         $fe->source( $r->id );
 307                                         push @{$field_entry{$class}}, $fe;
 308                                 }
 309                         }
 310
 311                         #update the fingerprint
 312                         my ($fp) = $self->method_lookup( 'open-ils.worm.fingerprint.marc' )->run( $xml );
 313                         OpenILS::Application::WoRM->storage_req(
 314                                 'open-ils.storage.direct.biblio.record_entry.remote_update',
 315                                 { id => $r->id },
 316                                 { fingerprint => $fp }
 317                         ) if ($fp ne $r->fingerprint);
 318
 319                         unless ($self->api_name =~ /nomap/o) {
 320                                 my $mr = OpenILS::Application::WoRM->storage_req( 'open-ils.storage.direct.metabib.metarecord.search.fingerprint.atomic', $fp  )->[0];
 321
 322                                 unless ($mr) {
 323                                         $mr = Fieldmapper::metabib::metarecord->new;
 324                                         $mr->fingerprint( $fp );
 325                                         $mr->master_record( $r->id );
 326                                         $mr->id( OpenILS::Application::WoRM->storage_req( 'open-ils.storage.direct.metabib.metarecord.create', $mr) );
 327                                 }
 328
 329                                 my $mr_map = Fieldmapper::metabib::metarecord_source_map->new;
 330                                 $mr_map->metarecord( $mr->id );
 331                                 $mr_map->source( $r->id );
 332                                 push @source_map, $mr_map;
 333                         }
 334
 335                 }
 336
 337                 OpenILS::Application::WoRM->storage_req( 'open-ils.storage.savepoint.set', 'wormize_record' );
 338
 339                 OpenILS::Application::WoRM->storage_req( 'open-ils.storage.direct.metabib.metarecord_source_map.batch.create', @source_map ) if (@source_map);
 340                 OpenILS::Application::WoRM->storage_req( 'open-ils.storage.direct.metabib.record_descriptor.batch.create', @rec_descriptor ) if (@rec_descriptor);
 341                 OpenILS::Application::WoRM->storage_req( 'open-ils.storage.direct.metabib.full_rec.batch.create', @full_rec ) if (@full_rec);
 342                 OpenILS::Application::WoRM->storage_req( 'open-ils.storage.direct.metabib.title_field_entry.batch.create', @{ $field_entry{title} } ) if (@{ $field_entry{title} });
 343                 OpenILS::Application::WoRM->storage_req( 'open-ils.storage.direct.metabib.author_field_entry.batch.create', @{ $field_entry{author} } ) if (@{ $field_entry{author} });
 344                 OpenILS::Application::WoRM->storage_req( 'open-ils.storage.direct.metabib.subject_field_entry.batch.create', @{ $field_entry{subject} } ) if (@{ $field_entry{subject} });
 345                 OpenILS::Application::WoRM->storage_req( 'open-ils.storage.direct.metabib.keyword_field_entry.batch.create', @{ $field_entry{keyword} } ) if (@{ $field_entry{keyword} });
 346                 OpenILS::Application::WoRM->storage_req( 'open-ils.storage.direct.metabib.series_field_entry.batch.create', @{ $field_entry{series} } ) if (@{ $field_entry{series} });
 347
 348                 OpenILS::Application::WoRM->storage_req( 'open-ils.storage.savepoint.release', 'wormize_record' );
 349
 350         } otherwise {
 351                 $log->debug('Wormization failed : '.shift(), ERROR);
 352                 OpenILS::Application::WoRM->storage_req( 'open-ils.storage.savepoint.rollback', 'wormize_record' );
 353                 $success = 0;
 354         };
 355
 356         OpenILS::Application::WoRM->commit_transaction if ($commit && $success);
 357         OpenILS::Application::WoRM->rollback_transaction if ($commit && !$success);
 358         return $success;
 359 }
 360 __PACKAGE__->register_method(
 361         api_name        => "open-ils.worm.wormize.biblio",
 362         method          => "wormize_biblio_record",
 363         api_level       => 1,
 364         argc            => 1,
 365 );
 366 __PACKAGE__->register_method(
 367         api_name        => "open-ils.worm.wormize.biblio.nomap",
 368         method          => "wormize_biblio_record",
 369         api_level       => 1,
 370         argc            => 1,
 371 );
 372 __PACKAGE__->register_method(
 373         api_name        => "open-ils.worm.wormize.biblio.noscrub",
 374         method          => "wormize_biblio_record",
 375         api_level       => 1,
 376         argc            => 1,
 377 );
 378 __PACKAGE__->register_method(
 379         api_name        => "open-ils.worm.wormize.biblio.nomap.noscrub",
 380         method          => "wormize_biblio_record",
 381         api_level       => 1,
 382         argc            => 1,
 383 );
 384
 385 sub wormize_authority_record {
 386         my $self = shift;
 387         my $client = shift;
 388         my $rec = shift;
 389
 390         my $commit = 0;
 391         if (!OpenILS::Application::WoRM->in_transaction) {
 392                 OpenILS::Application::WoRM->begin_transaction($client) || throw OpenSRF::EX::PANIC ("Couldn't BEGIN transaction!");
 393                 $commit = 1;
 394         }
 395
 396         my $success = 1;
 397         try {
 398                 # clean up the cruft
 399                 unless ($self->api_name =~ /noscrub/o) {
 400                         $self->method_lookup( 'open-ils.worm.scrub.authority' )->run( $rec ) || throw OpenSRF::EX::PANIC ("Couldn't scrub record $rec!");
 401                 }
 402
 403                 # now redo 'em
 404                 my $bibs = OpenILS::Application::WoRM->storage_req( 'open-ils.storage.direct.authority.record_entry.search.id.atomic', $rec );
 405
 406                 my @full_rec = ();
 407                 my @rec_descriptor = ();
 408                 for my $r (@$bibs) {
 409                         my $xml = $parser->parse_string($r->marc);
 410
 411                         # the full_rec stuff
 412                         for my $fr ( $self->method_lookup( 'open-ils.worm.flat_marc.authority.xml' )->run( $xml ) ) {
 413                                 $fr->record( $r->id );
 414                                 push @full_rec, $fr;
 415                         }
 416
 417                         # the rec_descriptor stuff -- XXX What does this mean for authority records?
 418                         #my ($rd) = $self->method_lookup( 'open-ils.worm.authority_leader.xml' )->run( $xml );
 419                         #$rd->record( $r->id );
 420                         #push @rec_descriptor, $rd;
 421
 422                 }
 423
 424                 OpenILS::Application::WoRM->storage_req( 'open-ils.storage.savepoint.set', 'wormize_authority_record' );
 425
 426                 #OpenILS::Application::WoRM->storage_req( 'open-ils.storage.direct.authority.record_descriptor.batch.create', @rec_descriptor ) if (@rec_descriptor);
 427                 OpenILS::Application::WoRM->storage_req( 'open-ils.storage.direct.authority.full_rec.batch.create', @full_rec ) if (@full_rec);
 428
 429                 OpenILS::Application::WoRM->storage_req( 'open-ils.storage.savepoint.release', 'wormize_authority_record' );
 430
 431         } otherwise {
 432                 $log->debug('Wormization failed : '.shift(), ERROR);
 433                 OpenILS::Application::WoRM->storage_req( 'open-ils.storage.savepoint.rollback', 'wormize_authority_record' );
 434                 $success = 0;
 435         };
 436
 437         OpenILS::Application::WoRM->commit_transaction if ($commit && $success);
 438         OpenILS::Application::WoRM->rollback_transaction if ($commit && !$success);
 439         return $success;
 440 }
 441 __PACKAGE__->register_method(
 442         api_name        => "open-ils.worm.wormize.authority",
 443         method          => "wormize_authority_record",
 444         api_level       => 1,
 445         argc            => 1,
 446 );
 447 __PACKAGE__->register_method(
 448         api_name        => "open-ils.worm.wormize.authority.noscrub",
 449         method          => "wormize_authority_record",
 450         api_level       => 1,
 451         argc            => 1,
 452 );
 453
 454
 455 # --------------------------------------------------------------------------------
 456 # MARC index extraction
 457
 458 package OpenILS::Application::WoRM::XPATH;
 459 use base qw/OpenILS::Application::WoRM/;
 460 use Unicode::Normalize;
 461
 462 # give this a MODS documentElement and an XPATH expression
 463 sub _xpath_to_string {
 464         my $xml = shift;
 465         my $xpath = shift;
 466         my $ns_uri = shift;
 467         my $ns_prefix = shift;
 468         my $unique = shift;
 469
 470         $xml->setNamespace( $ns_uri, $ns_prefix, 1 ) if ($ns_uri && $ns_prefix);
 471
 472         my $string = "";
 473
 474         # grab the set of matching nodes
 475         my @nodes = $xml->findnodes( $xpath );
 476         for my $value (@nodes) {
 477
 478                 # grab all children of the node
 479                 my @children = $value->childNodes();
 480                 for my $child (@children) {
 481
 482                         # add the childs content to the growing buffer
 483                         my $content = quotemeta($child->textContent);
 484                         next if ($unique && $string =~ /$content/);  # uniquify the values
 485                         $string .= $child->textContent . " ";
 486                 }
 487                 if( ! @children ) {
 488                         $string .= $value->textContent . " ";
 489                 }
 490         }
 491         return NFC($string);
 492 }
 493
 494 sub class_all_index_string_xml {
 495         my $self = shift;
 496         my $client = shift;
 497         my $xml = shift;
 498         my $class = shift;
 499
 500         OpenILS::Application::WoRM->post_init();
 501         $xml = $parser->parse_string($xml) unless (ref $xml);
 502
 503         my $class_constructor = "Fieldmapper::metabib::${class}_field_entry";
 504         for my $type ( keys %{ $xpathset->{$class} } ) {
 505                 my $value =  _xpath_to_string(
 506                                 $mods_sheet->transform($xml)->documentElement,
 507                                 $xpathset->{$class}->{$type}->{xpath},
 508                                 "http://www.loc.gov/mods/",
 509                                 "mods",
 510                                 1
 511                 );
 512
 513                 next unless $value;
 514
 515                 $value =~ s/(\pM|\pC)//sgoe;
 516                 $value =~ s/[\x80-\xff]//sgoe;
 517                 $value = lc($value);
 518
 519                 my $fm = $class_constructor->new;
 520                 $fm->value( $value );
 521                 $fm->field( $xpathset->{$class}->{$type}->{id} );
 522                 $client->respond($fm);
 523         }
 524         return undef;
 525 }
 526 __PACKAGE__->register_method(
 527         api_name        => "open-ils.worm.field_entry.class.xml",
 528         method          => "class_all_index_string_xml",
 529         api_level       => 1,
 530         argc            => 1,
 531         stream          => 1,
 532 );
 533
 534 sub class_all_index_string_record {
 535         my $self = shift;
 536         my $client = shift;
 537         my $rec = shift;
 538         my $class = shift;
 539
 540         OpenILS::Application::WoRM->post_init();
 541         my $r = OpenILS::Application::WoRM->storage_req( "open-ils.storage.direct.biblio.record_entry.retrieve" => $rec );
 542
 543         for my $fm ($self->method_lookup("open-ils.worm.field_entry.class.xml")->run($r->marc, $class)) {
 544                 $fm->source($rec);
 545                 $client->respond($fm);
 546         }
 547         return undef;
 548 }
 549 __PACKAGE__->register_method(
 550         api_name        => "open-ils.worm.field_entry.class.record",
 551         method          => "class_all_index_string_record",
 552         api_level       => 1,
 553         argc            => 1,
 554         stream          => 1,
 555 );
 556
 557
 558 sub class_index_string_xml {
 559         my $self = shift;
 560         my $client = shift;
 561         my $xml = shift;
 562         my $class = shift;
 563         my $type = shift;
 564
 565         OpenILS::Application::WoRM->post_init();
 566         $xml = $parser->parse_string($xml) unless (ref $xml);
 567         return _xpath_to_string( $mods_sheet->transform($xml)->documentElement, $xpathset->{$class}->{$type}->{xpath}, "http://www.loc.gov/mods/", "mods", 1 );
 568 }
 569 __PACKAGE__->register_method(
 570         api_name        => "open-ils.worm.class.type.xml",
 571         method          => "class_index_string_xml",
 572         api_level       => 1,
 573         argc            => 1,
 574 );
 575
 576 sub class_index_string_record {
 577         my $self = shift;
 578         my $client = shift;
 579         my $rec = shift;
 580         my $class = shift;
 581         my $type = shift;
 582
 583         OpenILS::Application::WoRM->post_init();
 584         my $r = OpenILS::Application::WoRM->storage_req( "open-ils.storage.direct.biblio.record_entry.retrieve" => $rec );
 585
 586         my ($d) = $self->method_lookup("open-ils.worm.class.type.xml")->run($r->marc, $class => $type);
 587         $log->debug("XPath $class->$type for bib rec $rec returns ($d)", DEBUG);
 588         return $d;
 589 }
 590 __PACKAGE__->register_method(
 591         api_name        => "open-ils.worm.class.type.record",
 592         method          => "class_index_string_record",
 593         api_level       => 1,
 594         argc            => 1,
 595 );
 596
 597 sub xml_xpath {
 598         my $self = shift;
 599         my $client = shift;
 600         my $xml = shift;
 601         my $xpath = shift;
 602         my $uri = shift;
 603         my $prefix = shift;
 604         my $unique = shift;
 605
 606         OpenILS::Application::WoRM->post_init();
 607         $xml = $parser->parse_string($xml) unless (ref $xml);
 608         return _xpath_to_string( $xml->documentElement, $xpath, $uri, $prefix, $unique );
 609 }
 610 __PACKAGE__->register_method(
 611         api_name        => "open-ils.worm.xpath.xml",
 612         method          => "xml_xpath",
 613         api_level       => 1,
 614         argc            => 1,
 615 );
 616
 617 sub record_xpath {
 618         my $self = shift;
 619         my $client = shift;
 620         my $rec = shift;
 621         my $xpath = shift;
 622         my $uri = shift;
 623         my $prefix = shift;
 624         my $unique = shift;
 625
 626         OpenILS::Application::WoRM->post_init();
 627         my $r = OpenILS::Application::WoRM->storage_req( "open-ils.storage.direct.biblio.record_entry.retrieve" => $rec );
 628
 629         my ($d) = $self->method_lookup("open-ils.worm.xpath.xml")->run($r->marc, $xpath, $uri, $prefix, $unique );
 630         $log->debug("XPath [$xpath] bib rec $rec returns ($d)", DEBUG);
 631         return $d;
 632 }
 633 __PACKAGE__->register_method(
 634         api_name        => "open-ils.worm.xpath.record",
 635         method          => "record_xpath",
 636         api_level       => 1,
 637         argc            => 1,
 638 );
 639
 640
 641 # --------------------------------------------------------------------------------
 642 # MARC Descriptor
 643
 644 package OpenILS::Application::WoRM::Biblio::Leader;
 645 use base qw/OpenILS::Application::WoRM/;
 646 use Unicode::Normalize;
 647
 648 our %biblio_descriptor_code = (
 649         item_type => sub { substr($ldr,6,1); },
 650         item_form => sub { (substr($ldr,6,1) =~ /^(?:f|g|i|m|o|p|r)$/o) ? substr($oo8,29,1) : substr($oo8,23,1); },
 651         bib_level => sub { substr($ldr,7,1); },
 652         control_type => sub { substr($ldr,8,1); },
 653         char_encoding => sub { substr($ldr,9,1); },
 654         enc_level => sub { substr($ldr,17,1); },
 655         cat_form => sub { substr($ldr,18,1); },
 656         pub_status => sub { substr($ldr,5,1); },
 657         item_lang => sub { substr($oo8,35,3); },
 658         #lit_form => sub { (substr($ldr,6,1) =~ /^(?:f|g|i|m|o|p|r)$/) ? substr($oo8,33,1) : "0"; },
 659         audience => sub { substr($oo8,22,1); },
 660 );
 661
 662 sub _extract_biblio_descriptors {
 663         my $xml = shift;
 664
 665         local $ldr = $xml->findvalue('//*[local-name()="leader"]');
 666         local $oo8 = $xml->findvalue('//*[local-name()="controlfield" and @tag="008"]');
 667
 668         my $rd_obj = Fieldmapper::metabib::record_descriptor->new;
 669         for my $rd_field ( keys %biblio_descriptor_code ) {
 670                 $rd_obj->$rd_field( $biblio_descriptor_code{$rd_field}->() );
 671         }
 672
 673         return $rd_obj;
 674 }
 675
 676 sub extract_biblio_desc_xml {
 677         my $self = shift;
 678         my $client = shift;
 679         my $xml = shift;
 680
 681         $xml = $parser->parse_string($xml) unless (ref $xml);
 682
 683         return _extract_biblio_descriptors( $xml );
 684 }
 685 __PACKAGE__->register_method(
 686         api_name        => "open-ils.worm.biblio_leader.xml",
 687         method          => "extract_biblio_desc_xml",
 688         api_level       => 1,
 689         argc            => 1,
 690 );
 691
 692 sub extract_biblio_desc_record {
 693         my $self = shift;
 694         my $client = shift;
 695         my $rec = shift;
 696
 697         OpenILS::Application::WoRM->post_init();
 698         my $r = OpenILS::Application::WoRM->storage_req( "open-ils.storage.direct.biblio.record_entry.retrieve" => $rec );
 699
 700         my ($d) = $self->method_lookup("open-ils.worm.biblio_leader.xml")->run($r->marc);
 701         $log->debug("Record descriptor for bib rec $rec is ".JSON->perl2JSON($d), DEBUG);
 702         return $d;
 703 }
 704 __PACKAGE__->register_method(
 705         api_name        => "open-ils.worm.biblio_leader.record",
 706         method          => "extract_biblio_desc_record",
 707         api_level       => 1,
 708         argc            => 1,
 709 );
 710
 711 # --------------------------------------------------------------------------------
 712 # Flat MARC
 713
 714 package OpenILS::Application::WoRM::FlatMARC;
 715 use base qw/OpenILS::Application::WoRM/;
 716 use Unicode::Normalize;
 717
 718
 719 sub _marcxml_to_full_rows {
 720
 721         my $marcxml = shift;
 722         my $xmltype = shift || 'metabib';
 723
 724         my $type = "Fieldmapper::${xmltype}::full_rec";
 725
 726         my @ns_list;
 727
 728         my ($root) = $marcxml->findnodes('//*[local-name()="record"]');
 729
 730         for my $tagline ( @{$root->getChildrenByTagName("leader")} ) {
 731                 next unless $tagline;
 732
 733                 my $ns = $type->new;
 734
 735                 $ns->tag( 'LDR' );
 736                 my $val = $tagline->textContent;
 737                 $val = NFD($val);
 738                 $val =~ s/(\pM+)//gso;
 739                 $ns->value( $val );
 740
 741                 push @ns_list, $ns;
 742         }
 743
 744         for my $tagline ( @{$root->getChildrenByTagName("controlfield")} ) {
 745                 next unless $tagline;
 746
 747                 my $ns = $type->new;
 748
 749                 $ns->tag( $tagline->getAttribute( "tag" ) );
 750                 my $val = $tagline->textContent;
 751                 $val = NFD($val);
 752                 $val =~ s/(\pM+)//gso;
 753                 $ns->value( $val );
 754
 755                 push @ns_list, $ns;
 756         }
 757
 758         for my $tagline ( @{$root->getChildrenByTagName("datafield")} ) {
 759                 next unless $tagline;
 760
 761                 my $tag = $tagline->getAttribute( "tag" );
 762                 my $ind1 = $tagline->getAttribute( "ind1" );
 763                 my $ind2 = $tagline->getAttribute( "ind2" );
 764
 765                 for my $data ( $tagline->childNodes ) {
 766                         next unless $data;
 767
 768                         my $ns = $type->new;
 769
 770                         $ns->tag( $tag );
 771                         $ns->ind1( $ind1 );
 772                         $ns->ind2( $ind2 );
 773                         $ns->subfield( $data->getAttribute( "code" ) );
 774                         my $val = $data->textContent;
 775                         $val = NFD($val);
 776                         $val =~ s/(\pM+)//gso;
 777                         $ns->value( lc($val) );
 778
 779                         push @ns_list, $ns;
 780                 }
 781         }
 782
 783         $log->debug("Returning ".scalar(@ns_list)." Fieldmapper nodes from $xmltype xml", DEBUG);
 784         return @ns_list;
 785 }
 786
 787 sub flat_marc_xml {
 788         my $self = shift;
 789         my $client = shift;
 790         my $xml = shift;
 791
 792         $xml = $parser->parse_string($xml) unless (ref $xml);
 793
 794         my $type = 'metabib';
 795         $type = 'authority' if ($self->api_name =~ /authority/o);
 796
 797         OpenILS::Application::WoRM->post_init();
 798
 799         $client->respond($_) for (_marcxml_to_full_rows($xml, $type));
 800         return undef;
 801 }
 802 __PACKAGE__->register_method(
 803         api_name        => "open-ils.worm.flat_marc.authority.xml",
 804         method          => "flat_marc_xml",
 805         api_level       => 1,
 806         argc            => 1,
 807         stream          => 1,
 808 );
 809 __PACKAGE__->register_method(
 810         api_name        => "open-ils.worm.flat_marc.biblio.xml",
 811         method          => "flat_marc_xml",
 812         api_level       => 1,
 813         argc            => 1,
 814         stream          => 1,
 815 );
 816
 817 sub flat_marc_record {
 818         my $self = shift;
 819         my $client = shift;
 820         my $rec = shift;
 821
 822         my $type = 'biblio';
 823         $type = 'authority' if ($self->api_name =~ /authority/o);
 824
 825         OpenILS::Application::WoRM->post_init();
 826         my $r = OpenILS::Application::WoRM->storage_req( "open-ils.storage.direct.${type}.record_entry.retrieve" => $rec );
 827
 828         $client->respond($_) for ($self->method_lookup("open-ils.worm.flat_marc.$type.xml")->run($r->marc));
 829         return undef;
 830 }
 831 __PACKAGE__->register_method(
 832         api_name        => "open-ils.worm.flat_marc.biblio.record_entry",
 833         method          => "flat_marc_record",
 834         api_level       => 1,
 835         argc            => 1,
 836         stream          => 1,
 837 );
 838 __PACKAGE__->register_method(
 839         api_name        => "open-ils.worm.flat_marc.authority.record_entry",
 840         method          => "flat_marc_record",
 841         api_level       => 1,
 842         argc            => 1,
 843         stream          => 1,
 844 );
 845
 846
 847 # --------------------------------------------------------------------------------
 848 # Fingerprinting
 849
 850 package OpenILS::Application::WoRM::Biblio::Fingerprint;
 851 use base qw/OpenILS::Application::WoRM/;
 852 use Unicode::Normalize;
 853 use OpenSRF::EX qw/:try/;
 854
 855 my @fp_mods_xpath = (
 856         '//mods:mods/mods:typeOfResource[text()="text"]' => [
 857                         title   => {
 858                                         xpath   => [
 859                                                         '//mods:mods/mods:titleInfo[mods:title and (@type="uniform")]',
 860                                                         '//mods:mods/mods:titleInfo[mods:title and (@type="translated")]',
 861                                                         '//mods:mods/mods:titleInfo[mods:title and (@type="alternative")]',
 862                                                         '//mods:mods/mods:titleInfo[mods:title and not(@type)]',
 863                                         ],
 864                                         fixup   => sub {
 865                                                         $log->debug("Fingerprint text /durring/ fixup : [$text]", INTERNAL);
 866                                                         $text = NFD($text);
 867                                                         $log->debug("Fingerprint text /durring/ fixup : [$text]", INTERNAL);
 868                                                         $text =~ s/\pM+//gso;
 869                                                         $log->debug("Fingerprint text /durring/ fixup : [$text]", INTERNAL);
 870                                                         $text = lc($text);
 871                                                         $log->debug("Fingerprint text /durring/ fixup : [$text]", INTERNAL);
 872                                                         $text =~ s/\s+/ /sgo;
 873                                                         $log->debug("Fingerprint text /durring/ fixup : [$text]", INTERNAL);
 874                                                         $text =~ s/^\s*(.+)\s*$/$1/sgo;
 875                                                         $log->debug("Fingerprint text /durring/ fixup : [$text]", INTERNAL);
 876                                                         $text =~ s/\b(?:the|an?)\b//sgo;
 877                                                         $log->debug("Fingerprint text /durring/ fixup : [$text]", INTERNAL);
 878                                                         $text =~ s/\[.[^\]]+\]//sgo;
 879                                                         $log->debug("Fingerprint text /durring/ fixup : [$text]", INTERNAL);
 880                                                         $text =~ s/\s*[;\/\.]*$//sgo;
 881                                                         $log->debug("Fingerprint text /durring/ fixup : [$text]", INTERNAL);
 882                                                 },
 883                         },
 884                         author  => {
 885                                         xpath   => [
 886                                                         '//mods:mods/mods:name[mods:role/mods:text/text()="creator" and @type="personal"]/mods:namePart',
 887                                                         '//mods:mods/mods:name[mods:role/mods:text/text()="creator"]/mods:namePart',
 888                                         ],
 889                                         fixup   => sub {
 890                                                         $log->debug("Fingerprint text /durring/ fixup : [$text]", INTERNAL);
 891                                                         $text = NFD($text);
 892                                                         $log->debug("Fingerprint text /durring/ fixup : [$text]", INTERNAL);
 893                                                         $text =~ s/\pM+//gso;
 894                                                         $log->debug("Fingerprint text /durring/ fixup : [$text]", INTERNAL);
 895                                                         $text = lc($text);
 896                                                         $log->debug("Fingerprint text /durring/ fixup : [$text]", INTERNAL);
 897                                                         $text =~ s/\s+/ /sgo;
 898                                                         $log->debug("Fingerprint text /durring/ fixup : [$text]", INTERNAL);
 899                                                         $text =~ s/^\s*(.+)\s*$/$1/sgo;
 900                                                         $log->debug("Fingerprint text /durring/ fixup : [$text]", INTERNAL);
 901                                                         $text =~ s/,?\s+.*$//sgo;
 902                                                         $log->debug("Fingerprint text /durring/ fixup : [$text]", INTERNAL);
 903                                                 },
 904                         },
 905         ],
 906
 907         '//mods:mods/mods:relatedItem[@type!="host" and @type!="series"]' => [
 908                         title   => {
 909                                         xpath   => [
 910                                                         '//mods:mods/mods:relatedItem/mods:titleInfo[mods:title and (@type="uniform")]',
 911                                                         '//mods:mods/mods:relatedItem/mods:titleInfo[mods:title and (@type="translated")]',
 912                                                         '//mods:mods/mods:relatedItem/mods:titleInfo[mods:title and (@type="alternative")]',
 913                                                         '//mods:mods/mods:relatedItem/mods:titleInfo[mods:title and not(@type)]',
 914                                                         '//mods:mods/mods:titleInfo[mods:title and (@type="uniform")]',
 915                                                         '//mods:mods/mods:titleInfo[mods:title and (@type="translated")]',
 916                                                         '//mods:mods/mods:titleInfo[mods:title and (@type="alternative")]',
 917                                                         '//mods:mods/mods:titleInfo[mods:title and not(@type)]',
 918                                         ],
 919                                         fixup   => sub {
 920                                                         $log->debug("Fingerprint text /durring/ fixup : [$text]", INTERNAL);
 921                                                         $text = NFD($text);
 922                                                         $log->debug("Fingerprint text /durring/ fixup : [$text]", INTERNAL);
 923                                                         $text =~ s/\pM+//gso;
 924                                                         $log->debug("Fingerprint text /durring/ fixup : [$text]", INTERNAL);
 925                                                         $text = lc($text);
 926                                                         $log->debug("Fingerprint text /durring/ fixup : [$text]", INTERNAL);
 927                                                         $text =~ s/\s+/ /sgo;
 928                                                         $log->debug("Fingerprint text /durring/ fixup : [$text]", INTERNAL);
 929                                                         $text =~ s/^\s*(.+)\s*$/$1/sgo;
 930                                                         $log->debug("Fingerprint text /durring/ fixup : [$text]", INTERNAL);
 931                                                         $text =~ s/\b(?:the|an?)\b//sgo;
 932                                                         $log->debug("Fingerprint text /durring/ fixup : [$text]", INTERNAL);
 933                                                         $text =~ s/\[.[^\]]+\]//sgo;
 934                                                         $log->debug("Fingerprint text /durring/ fixup : [$text]", INTERNAL);
 935                                                         $text =~ s/\s*[;\/\.]*$//sgo;
 936                                                         $log->debug("Fingerprint text /durring/ fixup : [$text]", INTERNAL);
 937                                                 },
 938                         },
 939                         author  => {
 940                                         xpath   => [
 941                                                         '//mods:mods/mods:relatedItem/mods:name[mods:role/mods:text/text()="creator" and @type="personal"]/mods:namePart',
 942                                                         '//mods:mods/mods:relatedItem/mods:name[mods:role/mods:text/text()="creator"]/mods:namePart',
 943                                                         '//mods:mods/mods:name[mods:role/mods:text/text()="creator" and @type="personal"]/mods:namePart',
 944                                                         '//mods:mods/mods:name[mods:role/mods:text/text()="creator"]/mods:namePart',
 945                                         ],
 946                                         fixup   => sub {
 947                                                         $log->debug("Fingerprint text /durring/ fixup : [$text]", INTERNAL);
 948                                                         $text = NFD($text);
 949                                                         $log->debug("Fingerprint text /durring/ fixup : [$text]", INTERNAL);
 950                                                         $text =~ s/\pM+//gso;
 951                                                         $log->debug("Fingerprint text /durring/ fixup : [$text]", INTERNAL);
 952                                                         $text = lc($text);
 953                                                         $log->debug("Fingerprint text /durring/ fixup : [$text]", INTERNAL);
 954                                                         $text =~ s/\s+/ /sgo;
 955                                                         $log->debug("Fingerprint text /durring/ fixup : [$text]", INTERNAL);
 956                                                         $text =~ s/^\s*(.+)\s*$/$1/sgo;
 957                                                         $log->debug("Fingerprint text /durring/ fixup : [$text]", INTERNAL);
 958                                                         $text =~ s/,?\s+.*$//sgo;
 959                                                         $log->debug("Fingerprint text /durring/ fixup : [$text]", INTERNAL);
 960                                                 },
 961                         },
 962         ],
 963
 964 );
 965
 966 push @fp_mods_xpath, '//mods:mods/mods:titleInfo' => $fp_mods_xpath[1];
 967
 968 sub _fp_mods {
 969         my $mods = shift;
 970         $mods->setNamespace( "http://www.loc.gov/mods/", "mods", 1 );
 971
 972         my $fp_string = '';
 973
 974         my $match_index = 0;
 975         my $block_index = 1;
 976         while ( my $match_xpath = $fp_mods_xpath[$match_index] ) {
 977                 if ( my @nodes = $mods->findnodes( $match_xpath ) ) {
 978
 979                         my $block_name_index = 0;
 980                         my $block_value_index = 1;
 981                         my $block = $fp_mods_xpath[$block_index];
 982                         while ( my $part = $$block[$block_value_index] ) {
 983                                 local $text;
 984                                 for my $xpath ( @{ $part->{xpath} } ) {
 985                                         $text = $mods->findvalue( $xpath );
 986                                         last if ($text);
 987                                 }
 988
 989                                 $log->debug("Found fingerprint text using $$block[$block_name_index] : [$text]", DEBUG);
 990
 991                                 if ($text) {
 992                                         $$part{fixup}->();
 993                                         $log->debug("Fingerprint text after fixup : [$text]", DEBUG);
 994                                         $fp_string .= $text;
 995                                 }
 996
 997                                 $block_name_index += 2;
 998                                 $block_value_index += 2;
 999                         }
1000                 }
1001                 if ($fp_string) {
1002                         $fp_string =~ s/\W+//gso;
1003                         $log->debug("Fingerprint is [$fp_string]", INFO);;
1004                         return $fp_string;
1005                 }
1006
1007                 $match_index += 2;
1008                 $block_index += 2;
1009         }
1010         return undef;
1011 }
1012
1013 sub refingerprint_bibrec {
1014         my $self = shift;
1015         my $client = shift;
1016         my $rec = shift;
1017
1018         my $commit = 0;
1019         if (!OpenILS::Application::WoRM->in_transaction) {
1020                 OpenILS::Application::WoRM->begin_transaction($client) || throw OpenSRF::EX::PANIC ("Couldn't BEGIN transaction!");
1021                 $commit = 1;
1022         }
1023
1024         my $success = 1;
1025         try {
1026                 my $bibs = OpenILS::Application::WoRM->storage_req( 'open-ils.storage.direct.biblio.record_entry.search.id.atomic', $rec );
1027                 OpenILS::Application::WoRM->storage_req(
1028                         'open-ils.storage.direct.biblio.record_entry.remote_update',
1029                         { id => $_->id },
1030                         { fingerprint => $self->method_lookup( 'open-ils.worm.fingerprint.marc' )->run( $_->marc ) }
1031                 ) for (@$bibs);
1032         } otherwise {
1033                 $log->debug('Fingerprinting failed : '.shift(), ERROR);
1034                 $success = 0;
1035         };
1036
1037         OpenILS::Application::WoRM->commit_transaction if ($commit && $success);
1038         OpenILS::Application::WoRM->rollback_transaction if ($commit && !$success);
1039         return $success;
1040 }
1041 __PACKAGE__->register_method(
1042         api_name        => "open-ils.worm.fingerprint.record.update",
1043         method          => "refingerprint_bibrec",
1044         api_level       => 1,
1045         argc            => 1,
1046 );
1047
1048
1049 sub fingerprint_bibrec {
1050         my $self = shift;
1051         my $client = shift;
1052         my $rec = shift;
1053
1054         OpenILS::Application::WoRM->post_init();
1055         my $r = OpenILS::Application::WoRM->storage_req( 'open-ils.storage.direct.biblio.record_entry.retrieve' => $rec );
1056
1057         my ($fp) = $self->method_lookup('open-ils.worm.fingerprint.marc')->run($r->marc);
1058         $log->debug("Returning [$fp] as fingerprint for record $rec", INFO);
1059         return $fp;
1060
1061 }
1062 __PACKAGE__->register_method(
1063         api_name        => "open-ils.worm.fingerprint.record",
1064         method          => "fingerprint_bibrec",
1065         api_level       => 1,
1066         argc            => 1,
1067 );
1068
1069 sub fingerprint_mods {
1070         my $self = shift;
1071         my $client = shift;
1072         my $xml = shift;
1073
1074         OpenILS::Application::WoRM->post_init();
1075         my $mods = $parser->parse_string($xml)->documentElement;
1076
1077         return _fp_mods( $mods );
1078 }
1079 __PACKAGE__->register_method(
1080         api_name        => "open-ils.worm.fingerprint.mods",
1081         method          => "fingerprint_mods",
1082         api_level       => 1,
1083         argc            => 1,
1084 );
1085
1086 sub fingerprint_marc {
1087         my $self = shift;
1088         my $client = shift;
1089         my $xml = shift;
1090
1091         $xml = $parser->parse_string($xml) unless (ref $xml);
1092
1093         OpenILS::Application::WoRM->post_init();
1094         my $fp = _fp_mods( $mods_sheet->transform($xml)->documentElement );
1095         $log->debug("Returning [$fp] as fingerprint", INFO);
1096         return $fp;
1097 }
1098 __PACKAGE__->register_method(
1099         api_name        => "open-ils.worm.fingerprint.marc",
1100         method          => "fingerprint_marc",
1101         api_level       => 1,
1102         argc            => 1,
1103 );
1104
1105
1106 # --------------------------------------------------------------------------------
1107
1108 1;
1109 __END__
1110 my $in_xact;
1111 my $begin;
1112 my $commit;
1113 my $rollback;
1114 my $lookup;
1115 my $update_entry;
1116 my $mr_lookup;
1117 my $mr_update;
1118 my $mr_create;
1119 my $create_source_map;
1120 my $sm_lookup;
1121 my $rm_old_rd;
1122 my $rm_old_sm;
1123 my $rm_old_fr;
1124 my $rm_old_tr;
1125 my $rm_old_ar;
1126 my $rm_old_sr;
1127 my $rm_old_kr;
1128 my $rm_old_ser;
1129
1130 my $fr_create;
1131 my $rd_create;
1132 my $create = {};
1133
1134 my %descriptor_code = (
1135         item_type => 'substr($ldr,6,1)',
1136         item_form => '(substr($ldr,6,1) =~ /^(?:f|g|i|m|o|p|r)$/) ? substr($oo8,29,1) : substr($oo8,23,1)',
1137         bib_level => 'substr($ldr,7,1)',
1138         control_type => 'substr($ldr,8,1)',
1139         char_encoding => 'substr($ldr,9,1)',
1140         enc_level => 'substr($ldr,17,1)',
1141         cat_form => 'substr($ldr,18,1)',
1142         pub_status => 'substr($ldr,5,1)',
1143         item_lang => 'substr($oo8,35,3)',
1144         #lit_form => '(substr($ldr,6,1) =~ /^(?:f|g|i|m|o|p|r)$/) ? substr($oo8,33,1) : "0"',
1145         audience => 'substr($oo8,22,1)',
1146 );
1147
1148 sub wormize {
1149
1150         my $self = shift;
1151         my $client = shift;
1152         my @docids = @_;
1153
1154         my $no_map = 0;
1155         if ($self->api_name =~ /no_map/o) {
1156                 $no_map = 1;
1157         }
1158
1159         $in_xact = $self->method_lookup( 'open-ils.storage.transaction.current')
1160                 unless ($in_xact);
1161         $begin = $self->method_lookup( 'open-ils.storage.transaction.begin')
1162                 unless ($begin);
1163         $commit = $self->method_lookup( 'open-ils.storage.transaction.commit')
1164                 unless ($commit);
1165         $rollback = $self->method_lookup( 'open-ils.storage.transaction.rollback')
1166                 unless ($rollback);
1167         $sm_lookup = $self->method_lookup('open-ils.storage.direct.metabib.metarecord_source_map.search.source')
1168                 unless ($sm_lookup);
1169         $mr_lookup = $self->method_lookup('open-ils.storage.direct.metabib.metarecord.search.fingerprint')
1170                 unless ($mr_lookup);
1171         $mr_update = $self->method_lookup('open-ils.storage.direct.metabib.metarecord.batch.update')
1172                 unless ($mr_update);
1173         $lookup = $self->method_lookup('open-ils.storage.direct.biblio.record_entry.batch.retrieve')
1174                 unless ($lookup);
1175         $update_entry = $self->method_lookup('open-ils.storage.direct.biblio.record_entry.batch.update')
1176                 unless ($update_entry);
1177         $rm_old_sm = $self->method_lookup( 'open-ils.storage.direct.metabib.metarecord_source_map.mass_delete')
1178                 unless ($rm_old_sm);
1179         $rm_old_rd = $self->method_lookup( 'open-ils.storage.direct.metabib.record_descriptor.mass_delete')
1180                 unless ($rm_old_rd);
1181         $rm_old_fr = $self->method_lookup( 'open-ils.storage.direct.metabib.full_rec.mass_delete')
1182                 unless ($rm_old_fr);
1183         $rm_old_tr = $self->method_lookup( 'open-ils.storage.direct.metabib.title_field_entry.mass_delete')
1184                 unless ($rm_old_tr);
1185         $rm_old_ar = $self->method_lookup( 'open-ils.storage.direct.metabib.author_field_entry.mass_delete')
1186                 unless ($rm_old_ar);
1187         $rm_old_sr = $self->method_lookup( 'open-ils.storage.direct.metabib.subject_field_entry.mass_delete')
1188                 unless ($rm_old_sr);
1189         $rm_old_kr = $self->method_lookup( 'open-ils.storage.direct.metabib.keyword_field_entry.mass_delete')
1190                 unless ($rm_old_kr);
1191         $rm_old_ser = $self->method_lookup( 'open-ils.storage.direct.metabib.series_field_entry.mass_delete')
1192                 unless ($rm_old_ser);
1193         $mr_create = $self->method_lookup('open-ils.storage.direct.metabib.metarecord.create')
1194                 unless ($mr_create);
1195         $create_source_map = $self->method_lookup('open-ils.storage.direct.metabib.metarecord_source_map.batch.create')
1196                 unless ($create_source_map);
1197         $rd_create = $self->method_lookup( 'open-ils.storage.direct.metabib.record_descriptor.batch.create')
1198                 unless ($rd_create);
1199         $fr_create = $self->method_lookup( 'open-ils.storage.direct.metabib.full_rec.batch.create')
1200                 unless ($fr_create);
1201         $$create{title} = $self->method_lookup( 'open-ils.storage.direct.metabib.title_field_entry.batch.create')
1202                 unless ($$create{title});
1203         $$create{author} = $self->method_lookup( 'open-ils.storage.direct.metabib.author_field_entry.batch.create')
1204                 unless ($$create{author});
1205         $$create{subject} = $self->method_lookup( 'open-ils.storage.direct.metabib.subject_field_entry.batch.create')
1206                 unless ($$create{subject});
1207         $$create{keyword} = $self->method_lookup( 'open-ils.storage.direct.metabib.keyword_field_entry.batch.create')
1208                 unless ($$create{keyword});
1209         $$create{series} = $self->method_lookup( 'open-ils.storage.direct.metabib.series_field_entry.batch.create')
1210                 unless ($$create{series});
1211
1212
1213         my ($outer_xact) = $in_xact->run;
1214         try {
1215                 unless ($outer_xact) {
1216                         $log->debug("WoRM isn't inside a transaction, starting one now.", INFO);
1217                         my ($r) = $begin->run($client);
1218                         unless (defined $r and $r) {
1219                                 $rollback->run;
1220                                 throw OpenSRF::EX::PANIC ("Couldn't BEGIN transaction!")
1221                         }
1222                 }
1223         } catch Error with {
1224                 throw OpenSRF::EX::PANIC ("WoRM Couldn't BEGIN transaction!")
1225         };
1226
1227         my @source_maps;
1228         my @entry_list;
1229         my @mr_list;
1230         my @rd_list;
1231         my @ns_list;
1232         my @mods_data;
1233         my $ret = 0;
1234         for my $entry ( $lookup->run(@docids) ) {
1235                 # step -1: grab the doc from storage
1236                 next unless ($entry);
1237
1238                 if(!$mods_sheet) {
1239                         my $xslt_doc = $parser->parse_file(
1240                                 OpenSRF::Utils::SettingsClient->new->config_value(dirs => 'xsl') .  "/MARC21slim2MODS.xsl");
1241                         $mods_sheet = $xslt->parse_stylesheet( $xslt_doc );
1242                 }
1243
1244                 my $xml = $entry->marc;
1245                 my $docid = $entry->id;
1246                 my $marcdoc = $parser->parse_string($xml);
1247                 my $modsdoc = $mods_sheet->transform($marcdoc);
1248
1249                 my $mods = $modsdoc->documentElement;
1250                 $mods->setNamespace( "http://www.loc.gov/mods/", "mods", 1 );
1251
1252                 $entry->fingerprint( fingerprint_mods( $mods ) );
1253                 push @entry_list, $entry;
1254
1255                 $log->debug("Fingerprint for Record Entry ".$docid." is [".$entry->fingerprint."]", INFO);
1256
1257                 unless ($no_map) {
1258                         my ($mr) = $mr_lookup->run( $entry->fingerprint );
1259                         if (!$mr || !@$mr) {
1260                                 $log->debug("No metarecord found for fingerprint [".$entry->fingerprint."]; Creating a new one", INFO);
1261                                 $mr = new Fieldmapper::metabib::metarecord;
1262                                 $mr->fingerprint( $entry->fingerprint );
1263                                 $mr->master_record( $entry->id );
1264                                 my ($new_mr) = $mr_create->run($mr);
1265                                 $mr->id($new_mr);
1266                                 unless (defined $mr) {
1267                                         throw OpenSRF::EX::PANIC ("Couldn't run open-ils.storage.direct.metabib.metarecord.create!")
1268                                 }
1269                         } else {
1270                                 $log->debug("Retrieved metarecord, id is ".$mr->id, INFO);
1271                                 $mr->mods('');
1272                                 push @mr_list, $mr;
1273                         }
1274
1275                         my $sm = new Fieldmapper::metabib::metarecord_source_map;
1276                         $sm->metarecord( $mr->id );
1277                         $sm->source( $entry->id );
1278                         push @source_maps, $sm;
1279                 }
1280
1281                 my $ldr = $marcdoc->documentElement->getChildrenByTagName('leader')->pop->textContent;
1282                 my $oo8 = $marcdoc->documentElement->findvalue('//*[local-name()="controlfield" and @tag="008"]');
1283
1284                 my $rd_obj = Fieldmapper::metabib::record_descriptor->new;
1285                 for my $rd_field ( keys %descriptor_code ) {
1286                         $rd_obj->$rd_field( eval "$descriptor_code{$rd_field};" );
1287                 }
1288                 $rd_obj->record( $docid );
1289                 push @rd_list, $rd_obj;
1290
1291                 push @mods_data, { $docid => $self->modsdoc_to_values( $mods ) };
1292
1293                 # step 2: build the KOHA rows
1294                 my @tmp_list = _marcxml_to_full_rows( $marcdoc );
1295                 $_->record( $docid ) for (@tmp_list);
1296                 push @ns_list, @tmp_list;
1297
1298                 $ret++;
1299
1300                 last unless ($self->api_name =~ /batch$/o);
1301         }
1302
1303         $rm_old_rd->run( { record => \@docids } );
1304         $rm_old_fr->run( { record => \@docids } );
1305         $rm_old_sm->run( { source => \@docids } ) unless ($no_map);
1306         $rm_old_tr->run( { source => \@docids } );
1307         $rm_old_ar->run( { source => \@docids } );
1308         $rm_old_sr->run( { source => \@docids } );
1309         $rm_old_kr->run( { source => \@docids } );
1310         $rm_old_ser->run( { source => \@docids } );
1311
1312         unless ($no_map) {
1313                 my ($sm) = $create_source_map->run(@source_maps);
1314                 unless (defined $sm) {
1315                         throw OpenSRF::EX::PANIC ("Couldn't run open-ils.storage.direct.metabib.metarecord_source_map.batch.create!")
1316                 }
1317                 my ($mr) = $mr_update->run(@mr_list);
1318                 unless (defined $mr) {
1319                         throw OpenSRF::EX::PANIC ("Couldn't run open-ils.storage.direct.metabib.metarecord.batch.update!")
1320                 }
1321         }
1322
1323         my ($re) = $update_entry->run(@entry_list);
1324         unless (defined $re) {
1325                 throw OpenSRF::EX::PANIC ("Couldn't run open-ils.storage.direct.biblio.record_entry.batch.update!")
1326         }
1327
1328         my ($rd) = $rd_create->run(@rd_list);
1329         unless (defined $rd) {
1330                 throw OpenSRF::EX::PANIC ("Couldn't run open-ils.storage.direct.metabib.record_descriptor.batch.create!")
1331         }
1332
1333         my ($fr) = $fr_create->run(@ns_list);
1334         unless (defined $fr) {
1335                 throw OpenSRF::EX::PANIC ("Couldn't run open-ils.storage.direct.metabib.full_rec.batch.create!")
1336         }
1337
1338         # step 5: insert the new metadata
1339         for my $class ( qw/title author subject keyword series/ ) {
1340                 my @md_list = ();
1341                 for my $doc ( @mods_data ) {
1342                         my ($did) = keys %$doc;
1343                         my ($data) = values %$doc;
1344
1345                         my $fm_constructor = "Fieldmapper::metabib::${class}_field_entry";
1346                         for my $row ( keys %{ $$data{$class} } ) {
1347                                 next unless (exists $$data{$class}{$row});
1348                                 next unless ($$data{$class}{$row}{value});
1349                                 my $fm_obj = $fm_constructor->new;
1350                                 $fm_obj->value( $$data{$class}{$row}{value} );
1351                                 $fm_obj->field( $$data{$class}{$row}{field_id} );
1352                                 $fm_obj->source( $did );
1353                                 $log->debug("$class entry: ".$fm_obj->source." => ".$fm_obj->field." : ".$fm_obj->value, DEBUG);
1354
1355                                 push @md_list, $fm_obj;
1356                         }
1357                 }
1358
1359                 my ($cr) = $$create{$class}->run(@md_list);
1360                 unless (defined $cr) {
1361                         throw OpenSRF::EX::PANIC ("Couldn't run open-ils.storage.direct.metabib.${class}_field_entry.batch.create!")
1362                 }
1363         }
1364
1365         unless ($outer_xact) {
1366                 $log->debug("Commiting transaction started by the WoRM.", INFO);
1367                 my ($c) = $commit->run;
1368                 unless (defined $c and $c) {
1369                         $rollback->run;
1370                         throw OpenSRF::EX::PANIC ("Couldn't COMMIT changes!")
1371                 }
1372         }
1373
1374         return $ret;
1375 }
1376 __PACKAGE__->register_method(
1377         api_name        => "open-ils.worm.wormize",
1378         method          => "wormize",
1379         api_level       => 1,
1380         argc            => 1,
1381 );
1382 __PACKAGE__->register_method(
1383         api_name        => "open-ils.worm.wormize.no_map",
1384         method          => "wormize",
1385         api_level       => 1,
1386         argc            => 1,
1387 );
1388 __PACKAGE__->register_method(
1389         api_name        => "open-ils.worm.wormize.batch",
1390         method          => "wormize",
1391         api_level       => 1,
1392         argc            => 1,
1393 );
1394 __PACKAGE__->register_method(
1395         api_name        => "open-ils.worm.wormize.no_map.batch",
1396         method          => "wormize",
1397         api_level       => 1,
1398         argc            => 1,
1399 );
1400
1401
1402 my $ain_xact;
1403 my $abegin;
1404 my $acommit;
1405 my $arollback;
1406 my $alookup;
1407 my $aupdate_entry;
1408 my $amr_lookup;
1409 my $amr_update;
1410 my $amr_create;
1411 my $acreate_source_map;
1412 my $asm_lookup;
1413 my $arm_old_rd;
1414 my $arm_old_sm;
1415 my $arm_old_fr;
1416 my $arm_old_tr;
1417 my $arm_old_ar;
1418 my $arm_old_sr;
1419 my $arm_old_kr;
1420 my $arm_old_ser;
1421
1422 my $afr_create;
1423 my $ard_create;
1424 my $acreate = {};
1425
1426 sub authority_wormize {
1427
1428         my $self = shift;
1429         my $client = shift;
1430         my @docids = @_;
1431
1432         my $no_map = 0;
1433         if ($self->api_name =~ /no_map/o) {
1434                 $no_map = 1;
1435         }
1436
1437         $in_xact = $self->method_lookup( 'open-ils.storage.transaction.current')
1438                 unless ($in_xact);
1439         $begin = $self->method_lookup( 'open-ils.storage.transaction.begin')
1440                 unless ($begin);
1441         $commit = $self->method_lookup( 'open-ils.storage.transaction.commit')
1442                 unless ($commit);
1443         $rollback = $self->method_lookup( 'open-ils.storage.transaction.rollback')
1444                 unless ($rollback);
1445         $alookup = $self->method_lookup('open-ils.storage.direct.authority.record_entry.batch.retrieve')
1446                 unless ($alookup);
1447         $aupdate_entry = $self->method_lookup('open-ils.storage.direct.authority.record_entry.batch.update')
1448                 unless ($aupdate_entry);
1449         $arm_old_rd = $self->method_lookup( 'open-ils.storage.direct.authority.record_descriptor.mass_delete')
1450                 unless ($arm_old_rd);
1451         $arm_old_fr = $self->method_lookup( 'open-ils.storage.direct.authority.full_rec.mass_delete')
1452                 unless ($arm_old_fr);
1453         $ard_create = $self->method_lookup( 'open-ils.storage.direct.authority.record_descriptor.batch.create')
1454                 unless ($ard_create);
1455         $afr_create = $self->method_lookup( 'open-ils.storage.direct.authority.full_rec.batch.create')
1456                 unless ($afr_create);
1457
1458
1459         my ($outer_xact) = $in_xact->run;
1460         try {
1461                 unless ($outer_xact) {
1462                         $log->debug("WoRM isn't inside a transaction, starting one now.", INFO);
1463                         my ($r) = $begin->run($client);
1464                         unless (defined $r and $r) {
1465                                 $rollback->run;
1466                                 throw OpenSRF::EX::PANIC ("Couldn't BEGIN transaction!")
1467                         }
1468                 }
1469         } catch Error with {
1470                 throw OpenSRF::EX::PANIC ("WoRM Couldn't BEGIN transaction!")
1471         };
1472
1473         my @source_maps;
1474         my @entry_list;
1475         my @mr_list;
1476         my @rd_list;
1477         my @ns_list;
1478         my @mads_data;
1479         my $ret = 0;
1480         for my $entry ( $lookup->run(@docids) ) {
1481                 # step -1: grab the doc from storage
1482                 next unless ($entry);
1483
1484                 #if(!$mads_sheet) {
1485                 #       my $xslt_doc = $parser->parse_file(
1486                 #               OpenSRF::Utils::SettingsClient->new->config_value(dirs => 'xsl') .  "/MARC21slim2MODS.xsl");
1487                 #       $mads_sheet = $xslt->parse_stylesheet( $xslt_doc );
1488                 #}
1489
1490                 my $xml = $entry->marc;
1491                 my $docid = $entry->id;
1492                 my $marcdoc = $parser->parse_string($xml);
1493                 #my $madsdoc = $mads_sheet->transform($marcdoc);
1494
1495                 #my $mads = $madsdoc->documentElement;
1496                 #$mads->setNamespace( "http://www.loc.gov/mads/", "mads", 1 );
1497
1498                 push @entry_list, $entry;
1499
1500                 my $ldr = $marcdoc->documentElement->getChildrenByTagName('leader')->pop->textContent;
1501                 my $oo8 = $marcdoc->documentElement->findvalue('//*[local-name()="controlfield" and @tag="008"]');
1502
1503                 my $rd_obj = Fieldmapper::authority::record_descriptor->new;
1504                 for my $rd_field ( keys %descriptor_code ) {
1505                         $rd_obj->$rd_field( eval "$descriptor_code{$rd_field};" );
1506                 }
1507                 $rd_obj->record( $docid );
1508                 push @rd_list, $rd_obj;
1509
1510                 # step 2: build the KOHA rows
1511                 my @tmp_list = _marcxml_to_full_rows( $marcdoc, 'Fieldmapper::authority::full_rec' );
1512                 $_->record( $docid ) for (@tmp_list);
1513                 push @ns_list, @tmp_list;
1514
1515                 $ret++;
1516
1517                 last unless ($self->api_name =~ /batch$/o);
1518         }
1519
1520         $arm_old_rd->run( { record => \@docids } );
1521         $arm_old_fr->run( { record => \@docids } );
1522
1523         my ($rd) = $ard_create->run(@rd_list);
1524         unless (defined $rd) {
1525                 throw OpenSRF::EX::PANIC ("Couldn't run open-ils.storage.direct.authority.record_descriptor.batch.create!")
1526         }
1527
1528         my ($fr) = $fr_create->run(@ns_list);
1529         unless (defined $fr) {
1530                 throw OpenSRF::EX::PANIC ("Couldn't run open-ils.storage.direct.authority.full_rec.batch.create!")
1531         }
1532
1533         unless ($outer_xact) {
1534                 $log->debug("Commiting transaction started by the WoRM.", INFO);
1535                 my ($c) = $commit->run;
1536                 unless (defined $c and $c) {
1537                         $rollback->run;
1538                         throw OpenSRF::EX::PANIC ("Couldn't COMMIT changes!")
1539                 }
1540         }
1541
1542         return $ret;
1543 }
1544 __PACKAGE__->register_method(
1545         api_name        => "open-ils.worm.authortiy.wormize",
1546         method          => "wormize",
1547         api_level       => 1,
1548         argc            => 1,
1549 );
1550 __PACKAGE__->register_method(
1551         api_name        => "open-ils.worm.authority.wormize.batch",
1552         method          => "wormize",
1553         api_level       => 1,
1554         argc            => 1,
1555 );
1556
1557
1558 # --------------------------------------------------------------------------------
1559
1560
1561 sub _marcxml_to_full_rows {
1562
1563         my $marcxml = shift;
1564         my $type = shift || 'Fieldmapper::metabib::full_rec';
1565
1566         my @ns_list;
1567
1568         my $root = $marcxml->documentElement;
1569
1570         for my $tagline ( @{$root->getChildrenByTagName("leader")} ) {
1571                 next unless $tagline;
1572
1573                 my $ns = new Fieldmapper::metabib::full_rec;
1574
1575                 $ns->tag( 'LDR' );
1576                 my $val = NFD($tagline->textContent);
1577                 $val =~ s/(\pM+)//gso;
1578                 $ns->value( $val );
1579
1580                 push @ns_list, $ns;
1581         }
1582
1583         for my $tagline ( @{$root->getChildrenByTagName("controlfield")} ) {
1584                 next unless $tagline;
1585
1586                 my $ns = new Fieldmapper::metabib::full_rec;
1587
1588                 $ns->tag( $tagline->getAttribute( "tag" ) );
1589                 my $val = NFD($tagline->textContent);
1590                 $val =~ s/(\pM+)//gso;
1591                 $ns->value( $val );
1592
1593                 push @ns_list, $ns;
1594         }
1595
1596         for my $tagline ( @{$root->getChildrenByTagName("datafield")} ) {
1597                 next unless $tagline;
1598
1599                 my $tag = $tagline->getAttribute( "tag" );
1600                 my $ind1 = $tagline->getAttribute( "ind1" );
1601                 my $ind2 = $tagline->getAttribute( "ind2" );
1602
1603                 for my $data ( $tagline->childNodes ) {
1604                         next unless $data;
1605
1606                         my $ns = $type->new;
1607
1608                         $ns->tag( $tag );
1609                         $ns->ind1( $ind1 );
1610                         $ns->ind2( $ind2 );
1611                         $ns->subfield( $data->getAttribute( "code" ) );
1612                         my $val = NFD($data->textContent);
1613                         $val =~ s/(\pM+)//gso;
1614                         $ns->value( lc($val) );
1615
1616                         push @ns_list, $ns;
1617                 }
1618         }
1619         return @ns_list;
1620 }
1621
1622 sub _get_field_value {
1623
1624         my( $root, $xpath ) = @_;
1625
1626         my $string = "";
1627
1628         # grab the set of matching nodes
1629         my @nodes = $root->findnodes( $xpath );
1630         for my $value (@nodes) {
1631
1632                 # grab all children of the node
1633                 my @children = $value->childNodes();
1634                 for my $child (@children) {
1635
1636                         # add the childs content to the growing buffer
1637                         my $content = quotemeta($child->textContent);
1638                         next if ($string =~ /$content/);  # uniquify the values
1639                         $string .= $child->textContent . " ";
1640                 }
1641                 if( ! @children ) {
1642                         $string .= $value->textContent . " ";
1643                 }
1644         }
1645         $string = NFD($string);
1646         $string =~ s/(\pM)//gso;
1647         return lc($string);
1648 }
1649
1650
1651 sub modsdoc_to_values {
1652         my( $self, $mods ) = @_;
1653         my $data = {};
1654         for my $class (keys %$xpathset) {
1655                 $data->{$class} = {};
1656                 for my $type (keys %{$xpathset->{$class}}) {
1657                         $data->{$class}->{$type} = {};
1658                         $data->{$class}->{$type}->{field_id} = $xpathset->{$class}->{$type}->{id};
1659                 }
1660         }
1661         return $data;
1662 }
1663
1664
1665 1;
1666
1667