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