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