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

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