Open-ILS/src/perlmods/lib/OpenILS/Application/Cat.pm

   1 use strict; use warnings;
   2 package OpenILS::Application::Cat;
   3 use OpenILS::Application::AppUtils;
   4 use OpenILS::Application;
   5 use OpenILS::Application::Cat::Merge;
   6 use OpenILS::Application::Cat::Authority;
   7 use OpenILS::Application::Cat::BibCommon;
   8 use OpenILS::Application::Cat::AssetCommon;
   9 use base qw/OpenILS::Application/;
  10 use Time::HiRes qw(time);
  11 use OpenSRF::EX qw(:try);
  12 use OpenSRF::Utils::JSON;
  13 use OpenILS::Utils::Fieldmapper;
  14 use OpenILS::Event;
  15 use OpenILS::Const qw/:const/;
  16
  17 use XML::LibXML;
  18 use Unicode::Normalize;
  19 use Data::Dumper;
  20 use OpenILS::Utils::CStoreEditor q/:funcs/;
  21 use OpenILS::Perm;
  22 use OpenSRF::Utils::SettingsClient;
  23 use OpenSRF::Utils::Logger qw($logger);
  24 use OpenSRF::AppSession;
  25
  26 my $U = "OpenILS::Application::AppUtils";
  27 my $conf;
  28 my %marctemplates;
  29 my $assetcom = 'OpenILS::Application::Cat::AssetCommon';
  30
  31 __PACKAGE__->register_method(
  32     method   => "retrieve_marc_template",
  33     api_name => "open-ils.cat.biblio.marc_template.retrieve",
  34     notes    => <<"    NOTES");
  35     Returns a MARC 'record tree' based on a set of pre-defined templates.
  36     Templates include : book
  37     NOTES
  38
  39 sub retrieve_marc_template {
  40     my( $self, $client, $type ) = @_;
  41     return $marctemplates{$type} if defined($marctemplates{$type});
  42     $marctemplates{$type} = _load_marc_template($type);
  43     return $marctemplates{$type};
  44 }
  45
  46 __PACKAGE__->register_method(
  47     method   => 'fetch_marc_template_types',
  48     api_name => 'open-ils.cat.marc_template.types.retrieve'
  49 );
  50
  51 my $marc_template_files;
  52
  53 sub fetch_marc_template_types {
  54     my( $self, $conn ) = @_;
  55     __load_marc_templates();
  56     return [ keys %$marc_template_files ];
  57 }
  58
  59 sub __load_marc_templates {
  60     return if $marc_template_files;
  61     if(!$conf) { $conf = OpenSRF::Utils::SettingsClient->new; }
  62
  63     $marc_template_files = $conf->config_value(
  64         "apps", "open-ils.cat","app_settings", "marctemplates" );
  65
  66     $logger->info("Loaded marc templates: " . Dumper($marc_template_files));
  67 }
  68
  69 sub _load_marc_template {
  70     my $type = shift;
  71
  72     __load_marc_templates();
  73
  74     my $template = $$marc_template_files{$type};
  75     open( F, $template ) or
  76         throw OpenSRF::EX::ERROR ("Unable to open MARC template file: $template : $@");
  77
  78     my @xml = <F>;
  79     close(F);
  80     my $xml = join('', @xml);
  81
  82     return XML::LibXML->new->parse_string($xml)->documentElement->toString;
  83 }
  84
  85
  86
  87 __PACKAGE__->register_method(
  88     method   => 'fetch_bib_sources',
  89     api_name => 'open-ils.cat.bib_sources.retrieve.all');
  90
  91 sub fetch_bib_sources {
  92     return OpenILS::Application::Cat::BibCommon->fetch_bib_sources();
  93 }
  94
  95 __PACKAGE__->register_method(
  96     method    => "create_record_xml",
  97     api_name  => "open-ils.cat.biblio.record.xml.create.override",
  98     signature => q/@see open-ils.cat.biblio.record.xml.create/);
  99
 100 __PACKAGE__->register_method(
 101     method    => "create_record_xml",
 102     api_name  => "open-ils.cat.biblio.record.xml.create",
 103     signature => q/
 104         Inserts a new biblio with the given XML
 105     /
 106 );
 107
 108 sub create_record_xml {
 109     my( $self, $client, $login, $xml, $source, $oargs, $strip_grps ) = @_;
 110
 111     my $override = 1 if $self->api_name =~ /override/;
 112     $oargs = { all => 1 } unless defined $oargs;
 113
 114     my( $user_obj, $evt ) = $U->checksesperm($login, 'CREATE_MARC');
 115     return $evt if $evt;
 116
 117     $logger->activity("user ".$user_obj->id." creating new MARC record");
 118
 119     my $meth = $self->method_lookup("open-ils.cat.biblio.record.xml.import");
 120
 121     $meth = $self->method_lookup(
 122         "open-ils.cat.biblio.record.xml.import.override") if $override;
 123
 124     my ($s) = $meth->run($login, $xml, $source, $oargs, $strip_grps);
 125     return $s;
 126 }
 127
 128
 129
 130 __PACKAGE__->register_method(
 131     method    => "biblio_record_replace_marc",
 132     api_name  => "open-ils.cat.biblio.record.xml.update",
 133     argc      => 3,
 134     signature => q/
 135         Updates the XML for a given biblio record.
 136         This does not change any other aspect of the record entry
 137         exception the XML, the editor, and the edit date.
 138         @return The update record object
 139     /
 140 );
 141
 142 __PACKAGE__->register_method(
 143     method    => 'biblio_record_replace_marc',
 144     api_name  => 'open-ils.cat.biblio.record.marc.replace',
 145     signature => q/
 146         @param auth The authtoken
 147         @param recid The record whose MARC we're replacing
 148         @param newxml The new xml to use
 149     /
 150 );
 151
 152 __PACKAGE__->register_method(
 153     method    => 'biblio_record_replace_marc',
 154     api_name  => 'open-ils.cat.biblio.record.marc.replace.override',
 155     signature => q/@see open-ils.cat.biblio.record.marc.replace/
 156 );
 157
 158 sub biblio_record_replace_marc  {
 159     my( $self, $conn, $auth, $recid, $newxml, $source, $oargs, $strip_grps ) = @_;
 160     my $e = new_editor(authtoken=>$auth, xact=>1);
 161     return $e->die_event unless $e->checkauth;
 162     return $e->die_event unless $e->allowed('UPDATE_MARC', $e->requestor->ws_ou);
 163
 164     my $fix_tcn = $self->api_name =~ /replace/o;
 165     if($self->api_name =~ /override/o) {
 166         $oargs = { all => 1 } unless defined $oargs;
 167     } else {
 168         $oargs = {};
 169     }
 170
 171     my $res = OpenILS::Application::Cat::BibCommon->biblio_record_replace_marc(
 172         $e, $recid, $newxml, $source, $fix_tcn, $oargs, $strip_grps);
 173
 174     $e->commit unless $U->event_code($res);
 175     $U->create_events_for_hook('bre.edit', $res, $e->requestor->ws_ou) unless $U->event_code($res);;
 176
 177     return $res;
 178 }
 179
 180 __PACKAGE__->register_method(
 181     method    => "template_overlay_biblio_record_entry",
 182     api_name  => "open-ils.cat.biblio.record_entry.template_overlay",
 183     stream    => 1,
 184     signature => q#
 185         Overlays biblio.record_entry MARC values
 186         @param auth The authtoken
 187         @param records The record ids to be updated by the template
 188         @param template The overlay template
 189         @return Stream of hashes record id in the key "record" and t or f for the success of the overlay operation in key "success"
 190     #
 191 );
 192
 193 sub template_overlay_biblio_record_entry {
 194     my($self, $conn, $auth, $records, $template) = @_;
 195     my $e = new_editor(authtoken=>$auth, xact=>1);
 196     return $e->die_event unless $e->checkauth;
 197
 198     $records = [$records] if (!ref($records));
 199
 200     for my $rid ( @$records ) {
 201         my $rec = $e->retrieve_biblio_record_entry($rid);
 202         next unless $rec;
 203
 204         unless ($e->allowed('UPDATE_RECORD', $rec->owner, $rec)) {
 205             $conn->respond({ record => $rid, success => 'f' });
 206             next;
 207         }
 208
 209         my $success = $e->json_query(
 210             { from => [ 'vandelay.template_overlay_bib_record', $template, $rid ] }
 211         )->[0]->{'vandelay.template_overlay_bib_record'};
 212         $U->create_events_for_hook('bre.edit', $rec, $e->requestor->ws_ou);
 213
 214         $conn->respond({ record => $rid, success => $success });
 215     }
 216
 217     $e->commit;
 218     return undef;
 219 }
 220
 221 __PACKAGE__->register_method(
 222     method    => "template_overlay_container",
 223     api_name  => "open-ils.cat.container.template_overlay",
 224     stream    => 1,
 225     signature => q#
 226         Overlays biblio.record_entry MARC values
 227         @param auth The authtoken
 228         @param container The container, um, containing the records to be updated by the template
 229         @param template The overlay template, or nothing and the method will look for a negative bib id in the container
 230         @return Stream of hashes record id in the key "record" and t or f for the success of the overlay operation in key "success"
 231     #
 232 );
 233
 234 __PACKAGE__->register_method(
 235     method    => "template_overlay_container",
 236     api_name  => "open-ils.cat.container.template_overlay.background",
 237     stream    => 1,
 238     signature => q#
 239         Overlays biblio.record_entry MARC values
 240         @param auth The authtoken
 241         @param container The container, um, containing the records to be updated by the template
 242         @param template The overlay template, or nothing and the method will look for a negative bib id in the container
 243         @param options Hash of options; currently supports:
 244             xact_per_record: Apply updates to each bib record within its own transaction.
 245         @return Cache key to check for status of the container overlay
 246     #
 247 );
 248
 249 sub template_overlay_container {
 250     my($self, $conn, $auth, $container, $template, $options) = @_;
 251     $options ||= {};
 252     my $xact_per_rec = $options->{xact_per_record};
 253
 254     my $e = new_editor(authtoken=>$auth, xact=>1);
 255     return $e->die_event unless $e->checkauth;
 256
 257     my $actor = OpenSRF::AppSession->create('open-ils.actor') if ($self->api_name =~ /background$/);
 258
 259     my $items = $e->search_container_biblio_record_entry_bucket_item({ bucket => $container });
 260
 261     my $titem;
 262     if (!$template) {
 263         ($titem) = grep { $_->target_biblio_record_entry < 0 } @$items;
 264         if (!$titem) {
 265             $e->rollback;
 266             return undef;
 267         }
 268         $items = [grep { $_->target_biblio_record_entry > 0 } @$items];
 269
 270         $template = $e->retrieve_biblio_record_entry( $titem->target_biblio_record_entry )->marc;
 271     }
 272
 273     my $num_total = scalar(@$items);
 274     my $num_failed = 0;
 275     my $num_succeeded = 0;
 276
 277     $conn->respond_complete(
 278         $actor->request('open-ils.actor.anon_cache.set_value', $auth,
 279             batch_edit_progress => {total => $num_total})->gather(1)
 280     ) if ($actor);
 281
 282     # read-only up to here.
 283     $e->rollback if $xact_per_rec;
 284
 285     for my $item ( @$items ) {
 286         $e->xact_begin if $xact_per_rec;
 287         my $rec = $e->retrieve_biblio_record_entry($item->target_biblio_record_entry);
 288         next unless $rec;
 289
 290         my $success = 'f';
 291         if ($e->allowed('UPDATE_RECORD', $rec->owner, $rec)) {
 292             $success = $e->json_query(
 293                 { from => [ 'vandelay.template_overlay_bib_record', $template, $rec->id ] }
 294             )->[0]->{'vandelay.template_overlay_bib_record'};
 295         }
 296
 297         if ($success eq 'f') {
 298             $num_failed++;
 299         } else {
 300             $U->create_events_for_hook('bre.edit', $rec, $e->requestor->ws_ou);
 301             $num_succeeded++;
 302         }
 303
 304         if ($actor) {
 305             $actor->request(
 306                 'open-ils.actor.anon_cache.set_value', $auth,
 307                 batch_edit_progress => {
 308                     total     => $num_total,
 309                     succeeded => $num_succeeded,
 310                     failed    => $num_failed
 311                 },
 312             );
 313         } else {
 314             $conn->respond({ record => $rec->id, success => $success });
 315         }
 316
 317         if ($success eq 't') {
 318             unless ($e->delete_container_biblio_record_entry_bucket_item($item)) {
 319                 $e->rollback;
 320                 if ($actor) {
 321                     $actor->request(
 322                         'open-ils.actor.anon_cache.set_value', $auth,
 323                         batch_edit_progress => {
 324                             complete => 1,
 325                             success  => 'f',
 326                             total     => $num_total,
 327                             succeeded => $num_succeeded,
 328                             failed    => $num_failed,
 329                         }
 330                     );
 331                     return undef;
 332                 } else {
 333                     return { complete => 1, success => 'f' };
 334                 }
 335             }
 336         }
 337         $e->xact_commit if $xact_per_rec;
 338     }
 339
 340     if ($titem && !$num_failed) {
 341         $e->xact_begin if $xact_per_rec;
 342         return $e->die_event unless ($e->delete_container_biblio_record_entry_bucket_item($titem));
 343         $e->xact_commit if $xact_per_rec;
 344     }
 345
 346     if ($xact_per_rec || $e->commit) {
 347         if ($actor) {
 348             $actor->request(
 349                 'open-ils.actor.anon_cache.set_value', $auth,
 350                 batch_edit_progress => {
 351                     complete => 1,
 352                     success  => 't',
 353                     total     => $num_total,
 354                     succeeded => $num_succeeded,
 355                     failed    => $num_failed,
 356                 }
 357             );
 358         } else {
 359             return { complete => 1, success => 't' };
 360         }
 361     } else {
 362         if ($actor) {
 363             $actor->request(
 364                 'open-ils.actor.anon_cache.set_value', $auth,
 365                 batch_edit_progress => {
 366                     complete => 1,
 367                     success  => 'f',
 368                     total     => $num_total,
 369                     succeeded => $num_succeeded,
 370                     failed    => $num_failed,
 371                 }
 372             );
 373         } else {
 374             return { complete => 1, success => 'f' };
 375         }
 376     }
 377     return undef;
 378 }
 379
 380 __PACKAGE__->register_method(
 381     method    => "update_biblio_record_entry",
 382     api_name  => "open-ils.cat.biblio.record_entry.update",
 383     signature => q/
 384         Updates a biblio.record_entry
 385         @param auth The authtoken
 386         @param record The record with updated values
 387         @return 1 on success, Event on error.
 388     /
 389 );
 390
 391 sub update_biblio_record_entry {
 392     my($self, $conn, $auth, $record) = @_;
 393     my $e = new_editor(authtoken=>$auth, xact=>1);
 394     return $e->die_event unless $e->checkauth;
 395     return $e->die_event unless $e->allowed('UPDATE_RECORD');
 396     $e->update_biblio_record_entry($record) or return $e->die_event;
 397     $e->commit;
 398     $U->create_events_for_hook('bre.edit', $record, $e->requestor->ws_ou);
 399     return 1;
 400 }
 401
 402 __PACKAGE__->register_method(
 403     method    => "undelete_biblio_record_entry",
 404     api_name  => "open-ils.cat.biblio.record_entry.undelete",
 405     signature => q/
 406         Un-deletes a record and sets active=true
 407         @param auth The authtoken
 408         @param record The record_id to ressurect
 409         @return 1 on success, Event on error.
 410     /
 411 );
 412 sub undelete_biblio_record_entry {
 413     my($self, $conn, $auth, $record_id) = @_;
 414     my $e = new_editor(authtoken=>$auth, xact=>1);
 415     return $e->die_event unless $e->checkauth;
 416     return $e->die_event unless $e->allowed('UPDATE_RECORD');
 417
 418     my $record = $e->retrieve_biblio_record_entry($record_id)
 419         or return $e->die_event;
 420     $record->deleted('f');
 421     $record->active('t');
 422
 423     # Set the leader/05 to indicate that the record has been corrected/revised
 424     my $marc = $record->marc();
 425     $marc =~ s{(<leader>.{5}).}{$1c};
 426     $record->marc($marc);
 427
 428     # no 2 non-deleted records can have the same tcn_value
 429     my $existing = $e->search_biblio_record_entry(
 430         {   deleted => 'f',
 431             tcn_value => $record->tcn_value,
 432             id => {'!=' => $record_id}
 433         }, {idlist => 1});
 434     return OpenILS::Event->new('TCN_EXISTS') if @$existing;
 435
 436     $e->update_biblio_record_entry($record) or return $e->die_event;
 437     $e->commit;
 438     $U->create_events_for_hook('bre.edit', $record, $e->requestor->ws_ou);
 439     return 1;
 440 }
 441
 442
 443 __PACKAGE__->register_method(
 444     method    => "biblio_record_xml_import",
 445     api_name  => "open-ils.cat.biblio.record.xml.import.override",
 446     signature => q/@see open-ils.cat.biblio.record.xml.import/);
 447
 448 __PACKAGE__->register_method(
 449     method    => "biblio_record_xml_import",
 450     api_name  => "open-ils.cat.biblio.record.xml.import",
 451     notes     => <<"    NOTES");
 452     Takes a marcxml record and imports the record into the database.  In this
 453     case, the marcxml record is assumed to be a complete record (i.e. valid
 454     MARC).  The title control number is taken from (whichever comes first)
 455     tags 001, 039[ab], 020a, 022a, 010, 035a and whichever does not already exist
 456     in the database.
 457     user_session must have IMPORT_MARC permissions
 458     NOTES
 459
 460
 461 sub biblio_record_xml_import {
 462     my( $self, $client, $authtoken, $xml, $source, $auto_tcn, $oargs, $strip_grps) = @_;
 463     my $e = new_editor(xact=>1, authtoken=>$authtoken);
 464     return $e->die_event unless $e->checkauth;
 465     return $e->die_event unless $e->allowed('IMPORT_MARC', $e->requestor->ws_ou);
 466
 467     if ($self->api_name =~ /override/) {
 468         $oargs = { all => 1 } unless defined $oargs;
 469     } else {
 470         $oargs = {};
 471     }
 472     my $record = OpenILS::Application::Cat::BibCommon->biblio_record_xml_import(
 473         $e, $xml, $source, $auto_tcn, $oargs, $strip_grps);
 474
 475     return $record if $U->event_code($record);
 476
 477     $e->commit;
 478
 479     return $record;
 480 }
 481
 482 __PACKAGE__->register_method(
 483     method        => "biblio_record_record_metadata",
 484     api_name      => "open-ils.cat.biblio.record.metadata.retrieve",
 485     authoritative => 1,
 486     argc          => 2, #(session_id, list of bre ids )
 487     notes         => "Returns a list of slim-downed bre objects based on the " .
 488                      "ids passed in",
 489 );
 490
 491 sub biblio_record_record_metadata {
 492     my( $self, $client, $authtoken, $ids ) = @_;
 493
 494     return [] unless $ids and @$ids;
 495
 496     my $editor = new_editor(authtoken => $authtoken);
 497     return $editor->event unless $editor->checkauth;
 498     return $editor->event unless $editor->allowed('VIEW_USER');
 499
 500     my @results;
 501
 502     for(@$ids) {
 503         return $editor->event unless
 504             my $rec = $editor->retrieve_biblio_record_entry($_);
 505         $rec->creator($editor->retrieve_actor_user($rec->creator));
 506         $rec->editor($editor->retrieve_actor_user($rec->editor));
 507         $rec->attrs($U->get_bre_attrs([$rec->id], $editor)->{$rec->id});
 508         $rec->clear_marc; # slim the record down
 509         push( @results, $rec );
 510     }
 511
 512     return \@results;
 513 }
 514
 515
 516
 517 __PACKAGE__->register_method(
 518     method    => "biblio_record_marc_cn",
 519     api_name  => "open-ils.cat.biblio.record.marc_cn.retrieve",
 520     argc      => 1, #(bib id )
 521     signature => {
 522         desc   => 'Extracts call number candidates from a bibliographic record',
 523         params => [
 524             {desc => 'Record ID', type => 'number'},
 525             {desc => '(Optional) Classification scheme ID', type => 'number'},
 526             {desc => '(Optional) Context org unit ID for default classification lookup', type => 'number'},
 527         ]
 528     },
 529     return => {desc => 'Hash of candidate call numbers identified by tag' }
 530 );
 531
 532 sub biblio_record_marc_cn {
 533     my( $self, $client, $id, $class, $ctx_org_id ) = @_;
 534
 535     my $e = new_editor();
 536     my $bre = $e->retrieve_biblio_record_entry($id);
 537     my $marc = $bre->marc;
 538
 539     my $doc = XML::LibXML->new->parse_string($marc);
 540     $doc->documentElement->setNamespace( "http://www.loc.gov/MARC21/slim", "marc", 1 );
 541
 542     if (!$class) {
 543         my $ctx_org = $ctx_org_id || $bre->owner || $U->get_org_tree->id; # root org
 544         $class = $U->ou_ancestor_setting_value(
 545             $ctx_org, 'cat.default_classification_scheme', $e);
 546     }
 547
 548     my @fields;
 549     my @res;
 550     if ($class) {
 551         # be sure the class ID provided exists.
 552         my $cn_class = $e->retrieve_asset_call_number_class($class) or return $e->event;
 553         @fields = split(/,/, $cn_class->field);
 554     } else {
 555         @fields = qw/050ab 055ab 060ab 070ab 080ab 082ab 086ab 088ab 090 092 096 098 099/;
 556     }
 557
 558     # Get field/subfield combos based on acnc value; for example "050ab,055ab"
 559
 560     foreach my $field (@fields) {
 561         my $tag = substr($field, 0, 3);
 562         $logger->debug("Tag = $tag");
 563         my @node = $doc->findnodes("//marc:datafield[\@tag='$tag']");
 564         next unless (@node);
 565
 566         # Now parse the subfields and build up the subfield XPath
 567         my @subfields = split(//, substr($field, 3));
 568
 569         # If they give us no subfields to parse, default to just the 'a'
 570         if (!@subfields) {
 571             @subfields = ('a');
 572         }
 573         my $xpath = 'marc:subfield[' . join(' or ', map { "\@code='$_'" } @subfields) . ']';
 574         $logger->debug("xpath = $xpath");
 575
 576         # Find the contents of the specified subfields
 577         foreach my $x (@node) {
 578             # We can't use find($xpath)->to_literal_delimited here because older 2.x
 579             # versions of the XML::LibXML module don't have to_literal_delimited().
 580             my $cn = join(
 581                 ' ',
 582                 map { $_->textContent } $x->findnodes($xpath)
 583             );
 584             push @res, {$tag => $cn} if ($cn);
 585         }
 586     }
 587
 588     return \@res;
 589 }
 590
 591 __PACKAGE__->register_method(
 592     method    => 'autogen_barcodes',
 593     api_name  => "open-ils.cat.item.barcode.autogen",
 594     signature => {
 595         desc   => 'Returns N generated barcodes following a specified barcode.',
 596         params => [
 597             {desc => 'Authentication token', type => 'string'},
 598             {desc => 'Barcode which the sequence should follow from', type => 'string'},
 599             {desc => 'Number of barcodes to generate', type => 'number'},
 600             {desc => 'Options hash.  Currently you can pass in checkdigit : false to disable the use of checkdigits.'}
 601         ],
 602         return => {desc => 'Array of generated barcodes'}
 603     }
 604 );
 605
 606 sub autogen_barcodes {
 607     my( $self, $client, $auth, $barcode, $num_of_barcodes, $options ) = @_;
 608     my $e = new_editor(authtoken => $auth);
 609     return $e->event unless $e->checkauth;
 610     return $e->event unless $e->allowed('UPDATE_COPY', $e->requestor->ws_ou);
 611     $options ||= {};
 612
 613     my $barcode_text = '';
 614     my $barcode_number = 0;
 615
 616     if ($barcode =~ /^(\D+)/) { $barcode_text = $1; }
 617     if ($barcode =~ /(\d+)$/) { $barcode_number = $1; }
 618
 619     my @res;
 620     for (my $i = 1; $i <= $num_of_barcodes; $i++) {
 621         my $calculated_barcode;
 622
 623         # default is to use checkdigits, so looking for an explicit false here
 624         if (defined $$options{'checkdigit'} && ! $$options{'checkdigit'}) {
 625             $calculated_barcode = $barcode_number + $i;
 626         } else {
 627             if ($barcode_number =~ /^\d{8}$/) {
 628                 $calculated_barcode = add_codabar_checkdigit($barcode_number + $i, 0);
 629             } elsif ($barcode_number =~ /^\d{9}$/) {
 630                 $calculated_barcode = add_codabar_checkdigit($barcode_number + $i*10, 1); # strip last digit
 631             } elsif ($barcode_number =~ /^\d{13}$/) {
 632                 $calculated_barcode = add_codabar_checkdigit($barcode_number + $i, 0);
 633             } elsif ($barcode_number =~ /^\d{14}$/) {
 634                 $calculated_barcode = add_codabar_checkdigit($barcode_number + $i*10, 1); # strip last digit
 635             } else {
 636                 $calculated_barcode = $barcode_number + $i;
 637             }
 638         }
 639         push @res, $barcode_text . $calculated_barcode;
 640     }
 641     return \@res
 642 }
 643
 644 # Codabar doesn't define a checkdigit algorithm, but this one is typically used by libraries.  gmcharlt++
 645 sub add_codabar_checkdigit {
 646     my $barcode = shift;
 647     my $strip_last_digit = shift;
 648
 649     return $barcode if $barcode =~ /\D/;
 650     $barcode = substr($barcode, 0, length($barcode)-1) if $strip_last_digit;
 651     my @digits = split //, $barcode;
 652     my $total = 0;
 653     for (my $i = 1; $i < length($barcode); $i+=2) { # for a 13/14 digit barcode, would expect 1,3,5,7,9,11
 654         $total += $digits[$i];
 655     }
 656     for (my $i = 0; $i < length($barcode); $i+=2) { # for a 13/14 digit barcode, would expect 0,2,4,6,8,10,12
 657         $total += (2 * $digits[$i] >= 10) ? (2 * $digits[$i] - 9) : (2 * $digits[$i]);
 658     }
 659     my $remainder = $total % 10;
 660     my $checkdigit = ($remainder == 0) ? $remainder : 10 - $remainder;
 661     return $barcode . $checkdigit;
 662 }
 663
 664 __PACKAGE__->register_method(
 665     method        => "orgs_for_title",
 666     authoritative => 1,
 667     api_name      => "open-ils.cat.actor.org_unit.retrieve_by_title"
 668 );
 669
 670 sub orgs_for_title {
 671     my( $self, $client, $record_id ) = @_;
 672
 673     my $vols = $U->simple_scalar_request(
 674         "open-ils.cstore",
 675         "open-ils.cstore.direct.asset.call_number.search.atomic",
 676         { record => $record_id, deleted => 'f' });
 677
 678     my $orgs = { map {$_->owning_lib => 1 } @$vols };
 679     return [ keys %$orgs ];
 680 }
 681
 682
 683 __PACKAGE__->register_method(
 684     method        => "retrieve_copies",
 685     authoritative => 1,
 686     api_name      => "open-ils.cat.asset.copy_tree.retrieve");
 687
 688 __PACKAGE__->register_method(
 689     method   => "retrieve_copies",
 690     api_name => "open-ils.cat.asset.copy_tree.global.retrieve");
 691
 692 # user_session may be null/undef
 693 sub retrieve_copies {
 694
 695     my( $self, $client, $user_session, $docid, @org_ids ) = @_;
 696
 697     if(ref($org_ids[0])) { @org_ids = @{$org_ids[0]}; }
 698
 699     $docid = "$docid";
 700
 701     # grabbing copy trees should be available for everyone..
 702     if(!@org_ids and $user_session) {
 703         my($user_obj, $evt) = OpenILS::Application::AppUtils->checkses($user_session);
 704         return $evt if $evt;
 705         @org_ids = ($user_obj->home_ou);
 706     }
 707
 708     # Create an editor that can be shared across all iterations of
 709     # _build_volume_list().  Otherwise, .authoritative calls can result
 710     # in creating too many cstore connections.
 711     my $e = new_editor();
 712
 713     if( $self->api_name =~ /global/ ) {
 714         return _build_volume_list($e, { record => $docid, deleted => 'f', label => { '<>' => '##URI##' } } );
 715
 716     } else {
 717
 718         my @all_vols;
 719         for my $orgid (@org_ids) {
 720             my $vols = _build_volume_list($e,
 721                     { record => $docid, owning_lib => $orgid, deleted => 'f', label => { '<>' => '##URI##' } } );
 722             push( @all_vols, @$vols );
 723         }
 724
 725         return \@all_vols;
 726     }
 727
 728     return undef;
 729 }
 730
 731
 732 sub _build_volume_list {
 733     my $e = shift;
 734     my $search_hash = shift;
 735
 736     $e ||= new_editor();
 737
 738     $search_hash->{deleted} = 'f';
 739
 740     my $vols = $e->search_asset_call_number([
 741         $search_hash,
 742         {
 743             flesh => 1,
 744             flesh_fields => { acn => ['prefix','suffix','label_class'] },
 745             'order_by' => { 'acn' => 'oils_text_as_bytea(label_sortkey), oils_text_as_bytea(label), id, owning_lib' }
 746         }
 747     ]);
 748
 749     my @volumes;
 750
 751     for my $volume (@$vols) {
 752
 753         my $copies = $e->search_asset_copy([
 754             { call_number => $volume->id , deleted => 'f' },
 755             {
 756                 join => {
 757                     acpm => {
 758                         type => 'left',
 759                         join => {
 760                             bmp => { type => 'left' }
 761                         }
 762                     }
 763                 },
 764                 flesh => 1,
 765                 flesh_fields => { acp => ['stat_cat_entries','parts'] },
 766                 order_by => [
 767                     {'class' => 'bmp', 'field' => 'label_sortkey', 'transform' => 'oils_text_as_bytea'},
 768                     {'class' => 'bmp', 'field' => 'label', 'transform' => 'oils_text_as_bytea'},
 769                     {'class' => 'acp', 'field' => 'barcode'}
 770                 ]
 771             }
 772         ]);
 773
 774         for my $c (@$copies) {
 775             if( $c->status == OILS_COPY_STATUS_CHECKED_OUT ) {
 776                 $c->circulations(
 777                     $e->search_action_circulation(
 778                         [
 779                             { target_copy => $c->id },
 780                             {
 781                                 order_by => { circ => 'xact_start desc' },
 782                                 limit => 1
 783                             }
 784                         ]
 785                     )
 786                 )
 787             }
 788         }
 789
 790         $volume->copies($copies);
 791         push( @volumes, $volume );
 792     }
 793
 794     #$session->disconnect();
 795     return \@volumes;
 796
 797 }
 798
 799
 800 __PACKAGE__->register_method(
 801     method   => "fleshed_copy_update",
 802     api_name => "open-ils.cat.asset.copy.fleshed.batch.update",);
 803
 804 __PACKAGE__->register_method(
 805     method   => "fleshed_copy_update",
 806     api_name => "open-ils.cat.asset.copy.fleshed.batch.update.override",);
 807
 808
 809 sub fleshed_copy_update {
 810     my( $self, $conn, $auth, $copies, $delete_stats, $oargs, $create_parts ) = @_;
 811     return 1 unless ref $copies;
 812     my( $reqr, $evt ) = $U->checkses($auth);
 813     return $evt if $evt;
 814     my $editor = new_editor(requestor => $reqr, xact => 1);
 815     if ($self->api_name =~ /override/) {
 816         $oargs = { all => 1 } unless defined $oargs;
 817     } else {
 818         $oargs = {};
 819     }
 820     my $retarget_holds = [];
 821     $evt = OpenILS::Application::Cat::AssetCommon->update_fleshed_copies(
 822         $editor, $oargs, undef, $copies, $delete_stats, $retarget_holds, undef, $create_parts);
 823
 824     if( $evt ) {
 825         $logger->info("fleshed copy update failed with event: ".OpenSRF::Utils::JSON->perl2JSON($evt));
 826         $editor->rollback;
 827         return $evt;
 828     }
 829
 830     $editor->commit;
 831     $logger->info("fleshed copy update successfully updated ".scalar(@$copies)." copies");
 832     reset_hold_list($auth, $retarget_holds);
 833
 834     return 1;
 835 }
 836
 837 sub reset_hold_list {
 838     my($auth, $hold_ids) = @_;
 839     return unless @$hold_ids;
 840     $logger->info("reseting holds after copy status change: @$hold_ids");
 841     my $ses = OpenSRF::AppSession->create('open-ils.circ');
 842     $ses->request('open-ils.circ.hold.reset.batch', $auth, $hold_ids);
 843 }
 844
 845 __PACKAGE__->register_method(
 846     method    => "transfer_copies_to_volume",
 847     api_name  => "open-ils.cat.transfer_copies_to_volume",
 848     argc      => 3,
 849     signature => {
 850         desc   => 'Transfers specified copies to the specified call number, and changes Circ Lib to match the new Owning Lib.',
 851         params => [
 852             {desc => 'Authtoken', type => 'string'},
 853             {desc => 'Call Number ID', type => 'number'},
 854             {desc => 'Array of Copy IDs', type => 'array'},
 855         ]
 856     },
 857     return => {desc => '1 on success, Event on error'}
 858 );
 859
 860 __PACKAGE__->register_method(
 861     method   => "transfer_copies_to_volume",
 862     api_name => "open-ils.cat.transfer_copies_to_volume.override",);
 863
 864 sub transfer_copies_to_volume {
 865     my( $self, $conn, $auth, $volume, $copies, $oargs ) = @_;
 866     my $delete_stats = 1;
 867     my $force_delete_empty_bib = undef;
 868     my $create_parts = undef;
 869
 870     # initial tests
 871
 872     return 1 unless ref $copies;
 873     my( $reqr, $evt ) = $U->checkses($auth);
 874     return $evt if $evt;
 875     my $editor = new_editor(requestor => $reqr, xact => 1);
 876     if ($self->api_name =~ /override/) {
 877         $oargs = { all => 1 } unless defined $oargs;
 878     } else {
 879         $oargs = {};
 880     }
 881
 882     # does the volume exist?  good, we also need its owning_lib later
 883     my( $cn, $cn_evt ) = $U->fetch_callnumber( $volume, 0, $editor );
 884     return $cn_evt if $cn_evt;
 885
 886     # flesh and munge the copies
 887     my $fleshed_copies = [];
 888     my $copy;
 889     foreach my $copy_id ( @{ $copies } ) {
 890         $copy = $editor->search_asset_copy([
 891             { id => $copy_id , deleted => 'f' },
 892             {
 893                 flesh => 1,
 894                 flesh_fields => { acp => ['parts', 'stat_cat_entries'] }
 895             }
 896         ])->[0];
 897         return OpenILS::Event->new('ASSET_COPY_NOT_FOUND') if !$copy;
 898         $copy->call_number( $volume );
 899         $copy->circ_lib( $cn->owning_lib() );
 900         $copy->ischanged( 't' );
 901         push @$fleshed_copies, $copy;
 902     }
 903
 904     # actual work
 905     my $retarget_holds = [];
 906     $evt = OpenILS::Application::Cat::AssetCommon->update_fleshed_copies(
 907         $editor, $oargs, undef, $fleshed_copies, $delete_stats, $retarget_holds, $force_delete_empty_bib, $create_parts);
 908
 909     if( $evt ) {
 910         $logger->info("copy to volume transfer failed with event: ".OpenSRF::Utils::JSON->perl2JSON($evt));
 911         $editor->rollback;
 912         return $evt;
 913     }
 914
 915     # take care of the parts
 916     for my $copy (@$fleshed_copies) {
 917         my $parts = $copy->parts;
 918         next unless $parts;
 919         my $part_objs = [];
 920         foreach my $part (@$parts) {
 921             my $part_label = $part->label;
 922             my $part_obj = $editor->search_biblio_monograph_part(
 923               {
 924                    label=>$part_label,
 925                    record=>$cn->record,
 926                    deleted=>'f'
 927               }
 928            )->[0];
 929            if (!$part_obj) {
 930                $part_obj = Fieldmapper::biblio::monograph_part->new();
 931                $part_obj->label( $part_label );
 932                $part_obj->record( $cn->record );
 933                unless($editor->create_biblio_monograph_part($part_obj)) {
 934                  return $editor->die_event if $editor->die_event;
 935                }
 936            }
 937            push @$part_objs, $part_obj;
 938         }
 939         $copy->parts( $part_objs );
 940         $copy->ischanged(1);
 941         $evt = OpenILS::Application::Cat::AssetCommon->update_copy_parts($editor, $copy, 1); #delete_parts=1
 942         return $evt if $evt;
 943     }
 944
 945     $editor->commit;
 946     $logger->info("copy to volume transfer successfully updated ".scalar(@$copies)." copies");
 947     reset_hold_list($auth, $retarget_holds);
 948
 949     return 1;
 950 }
 951
 952 __PACKAGE__->register_method(
 953     method    => 'in_db_merge',
 954     api_name  => 'open-ils.cat.biblio.records.merge',
 955     signature => q/
 956         Merges a group of records
 957         @param auth The login session key
 958         @param master The id of the record all other records should be merged into
 959         @param records Array of records to be merged into the master record
 960         @return 1 on success, Event on error.
 961     /
 962 );
 963
 964 sub in_db_merge {
 965     my( $self, $conn, $auth, $master, $records ) = @_;
 966
 967     my $editor = new_editor( authtoken => $auth, xact => 1 );
 968     return $editor->die_event unless $editor->checkauth;
 969     return $editor->die_event unless $editor->allowed('MERGE_BIB_RECORDS'); # TODO see below about record ownership
 970
 971     my $count = 0;
 972     for my $source ( @$records ) {
 973         #XXX we actually /will/ want to check perms for master and sources after record ownership exists
 974
 975         # This stored proc (asset.merge_record_assets(target,source)) has the side effects of
 976         # moving call_number, title-type (and some volume-type) hold_request and uri-mapping
 977         # objects from the source record to the target record, so must be called from within
 978         # a transaction.
 979
 980         $count += $editor->json_query({
 981             select => {
 982                 bre => [{
 983                     alias => 'count',
 984                     transform => 'asset.merge_record_assets',
 985                     column => 'id',
 986                     params => [$source]
 987                 }]
 988             },
 989             from   => 'bre',
 990             where  => { id => $master }
 991         })->[0]->{count}; # count of objects moved, of all types
 992
 993     }
 994
 995     $editor->commit;
 996     return $count;
 997 }
 998
 999 __PACKAGE__->register_method(
1000     method    => 'in_db_auth_merge',
1001     api_name  => 'open-ils.cat.authority.records.merge',
1002     signature => q/
1003         Merges a group of authority records
1004         @param auth The login session key
1005         @param master The id of the record all other records should be merged into
1006         @param records Array of records to be merged into the master record
1007         @return 1 on success, Event on error.
1008     /
1009 );
1010
1011 sub in_db_auth_merge {
1012     my( $self, $conn, $auth, $master, $records ) = @_;
1013
1014     my $editor = new_editor( authtoken => $auth, xact => 1 );
1015     return $editor->die_event unless $editor->checkauth;
1016     return $editor->die_event unless $editor->allowed('MERGE_AUTH_RECORDS'); # TODO see below about record ownership
1017
1018     my $count = 0;
1019     for my $source ( @$records ) {
1020         $count += $editor->json_query({
1021             select => {
1022                 are => [{
1023                     alias => 'count',
1024                     transform => 'authority.merge_records',
1025                     column => 'id',
1026                     params => [$source]
1027                 }]
1028             },
1029             from   => 'are',
1030             where  => { id => $master }
1031         })->[0]->{count}; # count of objects moved, of all types
1032     }
1033
1034     $editor->commit;
1035     return $count;
1036 }
1037
1038 __PACKAGE__->register_method(
1039     method    => 'calculate_marc_merge',
1040     api_name  => 'open-ils.cat.merge.marc.per_profile',
1041     signature => q/
1042         Calculate the result of merging one or more MARC records
1043         per the specified merge profile
1044         @param auth The login session key
1045         @param merge_profile ID of the record merge profile
1046         @param records Array of two or more MARCXML records to be
1047                        merged. If two are supplied, the first
1048                        is treated as the record to be overlaid,
1049                        and the the incoming record that will
1050                        overlay the first. If more than two are
1051                        supplied, the first is treated as the
1052                        record to be overlaid, and each following
1053                        record in turn will be merged into that
1054                        record.
1055         @return MARCXML string of the results of the merge
1056     /
1057 );
1058 __PACKAGE__->register_method(
1059     method    => 'calculate_bib_marc_merge',
1060     api_name  => 'open-ils.cat.merge.biblio.per_profile',
1061     signature => q/
1062         Calculate the result of merging one or more bib records
1063         per the specified merge profile
1064         @param auth The login session key
1065         @param merge_profile ID of the record merge profile
1066         @param records Array of two or more bib record IDs of
1067                        the bibs to be merged.
1068         @return MARCXML string of the results of the merge
1069     /
1070 );
1071 __PACKAGE__->register_method(
1072     method    => 'calculate_authority_marc_merge',
1073     api_name  => 'open-ils.cat.merge.authority.per_profile',
1074     signature => q/
1075         Calculate the result of merging one or more authority records
1076         per the specified merge profile
1077         @param auth The login session key
1078         @param merge_profile ID of the record merge profile
1079         @param records Array of two or more bib record IDs of
1080                        the bibs to be merged.
1081         @return MARCXML string of the results of the merge
1082     /
1083 );
1084
1085 sub _handle_marc_merge {
1086     my ($e, $merge_profile_id, $records) = @_;
1087
1088     my $result = shift @$records;
1089     foreach my $incoming (@$records) {
1090         my $response = $e->json_query({
1091             from => [
1092                 'vandelay.merge_record_xml_using_profile',
1093                 $incoming, $result,
1094                 $merge_profile_id
1095             ]
1096         });
1097         return unless ref($response);
1098         $result = $response->[0]->{'vandelay.merge_record_xml_using_profile'};
1099     }
1100     return $result;
1101 }
1102
1103 sub calculate_marc_merge {
1104     my( $self, $conn, $auth, $merge_profile_id, $records ) = @_;
1105
1106     my $e = new_editor(authtoken=>$auth, xact=>1);
1107     return $e->die_event unless $e->checkauth;
1108
1109     my $merge_profile = $e->retrieve_vandelay_merge_profile($merge_profile_id)
1110         or return $e->die_event;
1111     return $e->die_event unless ref($records) && @$records >= 2;
1112
1113     return _handle_marc_merge($e, $merge_profile_id, $records)
1114 }
1115
1116 sub calculate_bib_marc_merge {
1117     my( $self, $conn, $auth, $merge_profile_id, $bib_ids ) = @_;
1118
1119     my $e = new_editor(authtoken=>$auth, xact=>1);
1120     return $e->die_event unless $e->checkauth;
1121
1122     my $merge_profile = $e->retrieve_vandelay_merge_profile($merge_profile_id)
1123         or return $e->die_event;
1124     return $e->die_event unless ref($bib_ids) && @$bib_ids >= 2;
1125
1126     my $records = [];
1127     foreach my $id (@$bib_ids) {
1128         my $bre = $e->retrieve_biblio_record_entry($id) or return $e->die_event;
1129         push @$records, $bre->marc();
1130     }
1131
1132     return _handle_marc_merge($e, $merge_profile_id, $records)
1133 }
1134
1135 sub calculate_authority_marc_merge {
1136     my( $self, $conn, $auth, $merge_profile_id, $authority_ids ) = @_;
1137
1138     my $e = new_editor(authtoken=>$auth, xact=>1);
1139     return $e->die_event unless $e->checkauth;
1140
1141     my $merge_profile = $e->retrieve_vandelay_merge_profile($merge_profile_id)
1142         or return $e->die_event;
1143     return $e->die_event unless ref($authority_ids) && @$authority_ids >= 2;
1144
1145     my $records = [];
1146     foreach my $id (@$authority_ids) {
1147         my $are = $e->retrieve_authority_record_entry($id) or return $e->die_event;
1148         push @$records, $are->marc();
1149     }
1150
1151     return _handle_marc_merge($e, $merge_profile_id, $records)
1152 }
1153
1154 __PACKAGE__->register_method(
1155     method   => "fleshed_volume_update",
1156     api_name => "open-ils.cat.asset.volume.fleshed.batch.update",);
1157
1158 __PACKAGE__->register_method(
1159     method   => "fleshed_volume_update",
1160     api_name => "open-ils.cat.asset.volume.fleshed.batch.update.override",);
1161
1162 sub fleshed_volume_update {
1163     my( $self, $conn, $auth, $volumes, $delete_stats, $options, $oargs ) = @_;
1164     my( $reqr, $evt ) = $U->checkses($auth);
1165     return $evt if $evt;
1166     $options ||= {};
1167
1168     if ($self->api_name =~ /override/) {
1169         $oargs = { all => 1 } unless defined $oargs;
1170     } else {
1171         $oargs = {};
1172     }
1173     my $editor = new_editor( requestor => $reqr, xact => 1 );
1174     my $retarget_holds = [];
1175     my $auto_merge_vols = $options->{auto_merge_vols};
1176     my $create_parts = $options->{create_parts};
1177     my $copy_ids = [];
1178
1179     for my $vol (@$volumes) {
1180         $logger->info("vol-update: investigating volume ".$vol->id);
1181
1182         $vol->editor($reqr->id);
1183         $vol->edit_date('now');
1184
1185         my $copies = $vol->copies;
1186         $vol->clear_copies;
1187
1188         $vol->editor($editor->requestor->id);
1189         $vol->edit_date('now');
1190
1191         if( $vol->isdeleted ) {
1192
1193             $logger->info("vol-update: deleting volume");
1194             return $editor->die_event unless
1195                 $editor->allowed('UPDATE_VOLUME', $vol->owning_lib);
1196
1197             if(my $evt = $assetcom->delete_volume($editor, $vol, $oargs, $$options{force_delete_copies})) {
1198                 $editor->rollback;
1199                 return $evt;
1200             }
1201
1202             return $editor->die_event unless
1203                 $editor->update_asset_call_number($vol);
1204
1205         } elsif( $vol->isnew ) {
1206             $logger->info("vol-update: creating volume");
1207             ($vol,$evt) = $assetcom->create_volume( $auto_merge_vols ? { all => 1} : $oargs, $editor, $vol );
1208             return $evt if $evt;
1209
1210         } elsif( $vol->ischanged ) {
1211             $logger->info("vol-update: update volume");
1212
1213             # Three cases here:
1214             #   1) We're editing a volume, and not its copies.
1215             #   2) We're editing a volume, and a subset of its copies.
1216             #   3) We're editing a volume, and all of its copies.
1217             #
1218             # For 1) and 3), we definitely want to edit the volume
1219             # itself (and possibly auto-merge), but for 2), we want
1220             # to create a new volume (and possibly auto-merge).
1221
1222             if (scalar(@$copies) == 0) { # case 1
1223
1224                 my $resp = update_volume($vol, $editor, ($oargs->{all} or grep { $_ eq 'VOLUME_LABEL_EXISTS' } @{$oargs->{events}} or $auto_merge_vols));
1225                 return $resp->{evt} if $resp->{evt};
1226                 $vol = $resp->{merge_vol} if $resp->{merge_vol};
1227
1228             } else {
1229
1230                 my $resp = $editor->json_query({
1231                   select => {
1232                     acp => [
1233                       {transform => 'count', aggregate => 1, column => 'id', alias => 'count'}
1234                     ]
1235                   },
1236                   from => 'acp',
1237                   where => {
1238                     call_number => $vol->id,
1239                     deleted => 'f',
1240                     id => {'not in' => [ map { $_->id } @$copies ]}
1241                   }
1242                 });
1243                 if ($resp->[0]->{count} && $resp->[0]->{count} > 0) { # case 2
1244
1245                     ($vol,$evt) = $assetcom->create_volume( $auto_merge_vols ? { all => 1} : $oargs, $editor, $vol );
1246                     return $evt if $evt;
1247
1248                 } else { # case 3
1249
1250                     my $resp = update_volume($vol, $editor, ($oargs->{all} or grep { $_ eq 'VOLUME_LABEL_EXISTS' } @{$oargs->{events}} or $auto_merge_vols));
1251                     return $resp->{evt} if $resp->{evt};
1252                     $vol = $resp->{merge_vol} if $resp->{merge_vol};
1253                 }
1254
1255             }
1256         }
1257
1258         # now update any attached copies
1259         if( $copies and @$copies and !$vol->isdeleted ) {
1260             $_->call_number($vol->id) for @$copies;
1261             $evt = $assetcom->update_fleshed_copies(
1262                 $editor, $oargs, $vol, $copies, $delete_stats, $retarget_holds, undef, $create_parts);
1263             return $evt if $evt;
1264             push( @$copy_ids, $_->id ) for @$copies;
1265         }
1266     }
1267
1268     $editor->finish;
1269     reset_hold_list($auth, $retarget_holds);
1270     if ($options->{return_copy_ids}) {
1271         return $copy_ids;
1272     } else {
1273         return scalar(@$volumes);
1274     }
1275 }
1276
1277
1278 sub update_volume {
1279     my $vol = shift;
1280     my $editor = shift;
1281     my $auto_merge = shift;
1282     my $evt;
1283     my $merge_vol;
1284
1285     return {evt => $editor->event} unless
1286         $editor->allowed('UPDATE_VOLUME', $vol->owning_lib);
1287
1288     return {evt => $evt}
1289         if ( $evt = OpenILS::Application::Cat::AssetCommon->org_cannot_have_vols($editor, $vol->owning_lib) );
1290
1291     my $vols = $editor->search_asset_call_number({
1292         owning_lib => $vol->owning_lib,
1293         record     => $vol->record,
1294         label      => $vol->label,
1295         prefix     => $vol->prefix,
1296         suffix     => $vol->suffix,
1297         deleted    => 'f',
1298         id         => {'!=' => $vol->id}
1299     });
1300
1301     if(@$vols) {
1302
1303         if($auto_merge) {
1304
1305             # If the auto-merge option is on, merge our updated volume into the existing
1306             # volume with the same record + owner + label.
1307             ($merge_vol, $evt) = OpenILS::Application::Cat::Merge::merge_volumes($editor, [$vol], $vols->[0]);
1308             return {evt => $evt, merge_vol => $merge_vol};
1309
1310         } else {
1311             return {evt => OpenILS::Event->new('VOLUME_LABEL_EXISTS', payload => $vol->id)};
1312         }
1313     }
1314
1315     return {evt => $editor->die_event} unless $editor->update_asset_call_number($vol);
1316     return {};
1317 }
1318
1319
1320
1321 __PACKAGE__->register_method (
1322     method   => 'delete_bib_record',
1323     api_name => 'open-ils.cat.biblio.record_entry.delete');
1324
1325 sub delete_bib_record {
1326     my($self, $conn, $auth, $rec_id) = @_;
1327     my $e = new_editor(xact=>1, authtoken=>$auth);
1328     return $e->die_event unless $e->checkauth;
1329     return $e->die_event unless $e->allowed('DELETE_RECORD', $e->requestor->ws_ou);
1330     my $vols = $e->search_asset_call_number({record=>$rec_id, deleted=>'f'});
1331     return OpenILS::Event->new('RECORD_NOT_EMPTY', payload=>$rec_id) if @$vols;
1332     my $acq_li_count = $e->json_query({
1333         select => {jub => [{column => 'id', transform => 'count'}]},
1334     from => 'jub',
1335     where => {
1336         '+jub' => {
1337                  eg_bib_id => $rec_id,
1338                  state => ['new','pending-order','on-order']
1339             }
1340         }
1341     })->[0];
1342     return OpenILS::Event->new('RECORD_REFERENCED_BY_LINEITEM', payload => $rec_id) if ($acq_li_count->{id} > 0);
1343     my $evt = OpenILS::Application::Cat::BibCommon->delete_rec($e, $rec_id);
1344     if($evt) { $e->rollback; return $evt; }
1345     $e->commit;
1346     return 1;
1347 }
1348
1349
1350
1351 __PACKAGE__->register_method (
1352     method   => 'batch_volume_transfer',
1353     api_name => 'open-ils.cat.asset.volume.batch.transfer',
1354 );
1355
1356 __PACKAGE__->register_method (
1357     method   => 'batch_volume_transfer',
1358     api_name => 'open-ils.cat.asset.volume.batch.transfer.override',
1359 );
1360
1361
1362 sub batch_volume_transfer {
1363     my( $self, $conn, $auth, $args, $oargs ) = @_;
1364
1365     my $evt;
1366     my $rec     = $$args{docid};
1367     my $o_lib   = $$args{lib};
1368     my $vol_ids = $$args{volumes};
1369
1370     my $override = 1 if $self->api_name =~ /override/;
1371     $oargs = { all => 1 } unless defined $oargs;
1372
1373     $logger->info("merge: transferring volumes to lib=$o_lib and record=$rec");
1374
1375     my $e = new_editor(authtoken => $auth, xact =>1);
1376     return $e->event unless $e->checkauth;
1377     return $e->event unless $e->allowed('UPDATE_VOLUME', $o_lib);
1378
1379     my $dorg = $e->retrieve_actor_org_unit($o_lib)
1380         or return $e->event;
1381
1382     my $ou_type = $e->retrieve_actor_org_unit_type($dorg->ou_type)
1383         or return $e->event;
1384
1385     return $evt if ( $evt = OpenILS::Application::Cat::AssetCommon->org_cannot_have_vols($e, $o_lib) );
1386
1387     my $vols = $e->batch_retrieve_asset_call_number($vol_ids);
1388     my @seen;
1389
1390    my @rec_ids;
1391
1392     for my $vol (@$vols) {
1393
1394         # if we've already looked at this volume, go to the next
1395         next if !$vol or grep { $vol->id == $_ } @seen;
1396
1397         # grab all of the volumes in the list that have
1398         # the same label so they can be merged
1399         my @all = grep { $_->label eq $vol->label } @$vols;
1400
1401         # take note of the fact that we've looked at this set of volumes
1402         push( @seen, $_->id ) for @all;
1403         push( @rec_ids, $_->record ) for @all;
1404
1405         # for each volume, see if there are any copies that have a
1406         # remote circ_lib (circ_lib != vol->owning_lib and != $o_lib ).
1407         # if so, warn them
1408         unless( $override && ($oargs->{all} || grep { $_ eq 'COPY_REMOTE_CIRC_LIB' } @{$oargs->{events}}) ) {
1409             for my $v (@all) {
1410
1411                 $logger->debug("merge: searching for copies with remote circ_lib for volume ".$v->id);
1412                 my $args = {
1413                     call_number => $v->id,
1414                     circ_lib    => { "not in" => [ $o_lib, $v->owning_lib ] },
1415                     deleted     => 'f'
1416                 };
1417
1418                 my $copies = $e->search_asset_copy($args, {idlist=>1});
1419
1420                 # if the copy's circ_lib matches the destination lib,
1421                 # that's ok too
1422                 return OpenILS::Event->new('COPY_REMOTE_CIRC_LIB') if @$copies;
1423             }
1424         }
1425
1426         # record the difference between the destination bib and the present bib
1427         my $same_bib = $vol->record == $rec;
1428
1429         # see if there is a volume at the destination lib that
1430         # already has the requested label
1431         my $existing_vol = $e->search_asset_call_number(
1432             {
1433                 label      => $vol->label,
1434                 prefix     => $vol->prefix,
1435                 suffix     => $vol->suffix,
1436                 record     => $rec,
1437                 owning_lib => $o_lib,
1438                 deleted    => 'f'
1439             }
1440         )->[0];
1441
1442         if( $existing_vol ) {
1443
1444             if( grep { $_->id == $existing_vol->id } @all ) {
1445                 # this volume is already accounted for in our list of volumes to merge
1446                 $existing_vol = undef;
1447
1448             } else {
1449                 # this volume exists on the destination record/owning_lib and must
1450                 # be used as the destination for merging
1451                 $logger->debug("merge: volume already exists at destination record: ".
1452                     $existing_vol->id.' : '.$existing_vol->label) if $existing_vol;
1453             }
1454         }
1455
1456         if( @all > 1 || $existing_vol ) {
1457             $logger->info("merge: found collisions in volume transfer");
1458             my @args = ($e, \@all);
1459             @args = ($e, \@all, $existing_vol) if $existing_vol;
1460             ($vol, $evt) = OpenILS::Application::Cat::Merge::merge_volumes(@args);
1461             return $evt if $evt;
1462         }
1463
1464         if( !$existing_vol ) {
1465
1466             $vol->owning_lib($o_lib);
1467             $vol->record($rec);
1468             $vol->editor($e->requestor->id);
1469             $vol->edit_date('now');
1470
1471             $logger->info("merge: updating volume ".$vol->id);
1472             $e->update_asset_call_number($vol) or return $e->event;
1473
1474         } else {
1475             $logger->info("merge: bypassing volume update because existing volume used as target");
1476         }
1477
1478         # regardless of what volume was used as the destination,
1479         # update any copies that have moved over to the new lib
1480         my $copies = $e->search_asset_copy([
1481             { call_number => $vol->id , deleted => 'f' },
1482             {
1483                 flesh => 1,
1484                 flesh_fields => { acp => ['parts'] }
1485             }
1486         ]);
1487
1488         # update circ lib on the copies - make this a method flag?
1489         for my $copy (@$copies) {
1490             next if $copy->circ_lib == $o_lib;
1491             $logger->info("merge: transfer moving circ lib on copy ".$copy->id);
1492             $copy->circ_lib($o_lib);
1493             $copy->editor($e->requestor->id);
1494             $copy->edit_date('now');
1495             $e->update_asset_copy($copy) or return $e->event;
1496         }
1497
1498         # update parts if volume is moving bib records
1499         if( !$same_bib ) {
1500             for my $copy (@$copies) {
1501                 my $parts = $copy->parts;
1502                 next unless $parts;
1503                 my $part_objs = [];
1504                 foreach my $part (@$parts) {
1505                     my $part_label = $part->label;
1506                     my $part_obj = $e->search_biblio_monograph_part(
1507                        {
1508                             label=>$part_label,
1509                             record=>$rec,
1510                             deleted=>'f'
1511                        }
1512                     )->[0];
1513
1514                     if (!$part_obj) {
1515                         $part_obj = Fieldmapper::biblio::monograph_part->new();
1516                         $part_obj->label( $part_label );
1517                         $part_obj->record( $rec );
1518                         unless($e->create_biblio_monograph_part($part_obj)) {
1519                           return $e->die_event if $e->die_event;
1520                         }
1521                     }
1522                     push @$part_objs, $part_obj;
1523                 }
1524
1525                 $copy->parts( $part_objs );
1526                 $copy->ischanged(1);
1527                 $evt = OpenILS::Application::Cat::AssetCommon->update_copy_parts($e, $copy, 1); #delete_parts=1
1528                 return $evt if $evt;
1529             }
1530         }
1531
1532         # Now see if any empty records need to be deleted after all of this
1533         my $keep_on_empty = $U->ou_ancestor_setting_value($e->requestor->ws_ou, 'cat.bib.keep_on_empty', $e);
1534         unless ($U->is_true($keep_on_empty)) {
1535
1536             for (@rec_ids) {
1537                 $logger->debug("merge: seeing if we should delete record $_...");
1538                 if (OpenILS::Application::Cat::BibCommon->title_is_empty($e, $_)) {
1539                     # check for any title holds on the bib, bail if so
1540                     my $has_holds = OpenILS::Application::Cat::BibCommon->title_has_holds($e, $_);
1541                     return OpenILS::Event->new('TITLE_HAS_HOLDS', payload => $_) if $has_holds;
1542                     # we're good, delete the record
1543                     $evt = OpenILS::Application::Cat::BibCommon->delete_rec($e, $_);
1544                     return $evt if $evt;
1545                 }
1546             }
1547         }
1548     }
1549
1550     $logger->info("merge: transfer succeeded");
1551     $e->commit;
1552     return 1;
1553 }
1554
1555
1556
1557
1558 __PACKAGE__->register_method(
1559     api_name => 'open-ils.cat.call_number.find_or_create',
1560     method   => 'find_or_create_volume',
1561 );
1562
1563 sub find_or_create_volume {
1564     my( $self, $conn, $auth, $label, $record_id, $org_id, $prefix, $suffix, $label_class ) = @_;
1565     my $e = new_editor(authtoken=>$auth, xact=>1);
1566     return $e->die_event unless $e->checkauth;
1567     my ($vol, $evt, $exists) =
1568         OpenILS::Application::Cat::AssetCommon->find_or_create_volume($e, $label, $record_id, $org_id, $prefix, $suffix, $label_class);
1569     return $evt if $evt;
1570     $e->rollback if $exists;
1571     $e->commit if $vol;
1572     return { 'acn_id' => $vol->id, 'existed' => $exists };
1573 }
1574
1575
1576 __PACKAGE__->register_method(
1577     method    => "create_serial_record_xml",
1578     api_name  => "open-ils.cat.serial.record.xml.create.override",
1579     signature => q/@see open-ils.cat.serial.record.xml.create/);
1580
1581 __PACKAGE__->register_method(
1582     method    => "create_serial_record_xml",
1583     api_name  => "open-ils.cat.serial.record.xml.create",
1584     signature => q/
1585         Inserts a new serial record with the given XML
1586     /
1587 );
1588
1589 sub create_serial_record_xml {
1590     my( $self, $client, $login, $source, $owning_lib, $record_id, $xml, $oargs ) = @_;
1591
1592     my $override = 1 if $self->api_name =~ /override/; # not currently used
1593     $oargs = { all => 1 } unless defined $oargs; # Not currently used, but here for consistency.
1594
1595     my $e = new_editor(xact=>1, authtoken=>$login);
1596     return $e->die_event unless $e->checkauth;
1597     return $e->die_event unless $e->allowed('CREATE_MFHD_RECORD', $owning_lib);
1598
1599     # Auto-populate the location field of a placeholder MFHD record with the library name
1600     my $aou = $e->retrieve_actor_org_unit($owning_lib) or return $e->die_event;
1601
1602     my $mfhd = Fieldmapper::serial::record_entry->new;
1603
1604     $mfhd->source($source) if $source;
1605     $mfhd->record($record_id);
1606     $mfhd->creator($e->requestor->id);
1607     $mfhd->editor($e->requestor->id);
1608     $mfhd->create_date('now');
1609     $mfhd->edit_date('now');
1610     $mfhd->owning_lib($owning_lib);
1611
1612     # If the caller did not pass in MFHD XML, create a placeholder record.
1613     # The placeholder will only contain the name of the owning library.
1614     # The goal is to generate common patterns for the caller in the UI that
1615     # then get passed in here.
1616     if (!$xml) {
1617         my $aou_name = $aou->name;
1618         $xml = <<HERE;
1619 <record
1620  xsi:schemaLocation="http://www.loc.gov/MARC21/slim http://www.loc.gov/standards/marcxml/schema/MARC21slim.xsd"
1621  xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"
1622  xmlns="http://www.loc.gov/MARC21/slim">
1623 <leader>00307ny  a22001094  4500</leader>
1624 <controlfield tag="001">42153</controlfield>
1625 <controlfield tag="005">20090601182414.0</controlfield>
1626 <controlfield tag="004">$record_id</controlfield>
1627 <controlfield tag="008">      4u####8###l# 4   uueng1      </controlfield>
1628 <datafield tag="852" ind1=" " ind2=" "> <subfield code="b">$aou_name</subfield></datafield>
1629 </record>
1630 HERE
1631     }
1632     my $marcxml = XML::LibXML->new->parse_string($xml);
1633     $marcxml->documentElement->setNamespace("http://www.loc.gov/MARC21/slim", "marc", 1 );
1634     $marcxml->documentElement->setNamespace("http://www.loc.gov/MARC21/slim");
1635
1636     $mfhd->marc($U->entityize($marcxml->documentElement->toString));
1637
1638     $e->create_serial_record_entry($mfhd) or return $e->die_event;
1639
1640     $e->commit;
1641     return $mfhd->id;
1642 }
1643
1644 __PACKAGE__->register_method(
1645     method   => "create_update_asset_copy_template",
1646     api_name => "open-ils.cat.asset.copy_template.create_or_update"
1647 );
1648
1649 sub create_update_asset_copy_template {
1650     my ($self, $client, $authtoken, $act) = @_;
1651
1652     my $e = new_editor("xact" => 1, "authtoken" => $authtoken);
1653     return $e->die_event unless $e->checkauth;
1654     return $e->die_event unless $e->allowed(
1655         "ADMIN_ASSET_COPY_TEMPLATE", $act->owning_lib
1656     );
1657
1658     $act->editor($e->requestor->id);
1659     $act->edit_date("now");
1660
1661     my $retval;
1662     if (!$act->id) {
1663         $act->creator($e->requestor->id);
1664         $act->create_date("now");
1665
1666         $e->create_asset_copy_template($act) or return $e->die_event;
1667         $retval = $e->data;
1668     } else {
1669         $e->update_asset_copy_template($act) or return $e->die_event;
1670         $retval = $e->retrieve_asset_copy_template($e->data);
1671     }
1672     $e->commit and return $retval;
1673 }
1674
1675 __PACKAGE__->register_method(
1676     method      => "acn_sms_msg",
1677     api_name    => "open-ils.cat.acn.send_sms_text",
1678     signature   => q^
1679         Send an SMS text from an A/T template for specified call numbers.
1680
1681         First parameter is null or an auth token (whether a null is allowed
1682         depends on the sms.disable_authentication_requirement.callnumbers OU
1683         setting).
1684
1685         Second parameter is the id of the context org.
1686
1687         Third parameter is the code of the SMS carrier from the
1688         config.sms_carrier table.
1689
1690         Fourth parameter is the SMS number.
1691
1692         Fifth parameter is the ACN id's to target, though currently only the
1693         first ACN is used by the template (and the UI is only sending one).
1694     ^
1695 );
1696
1697 sub acn_sms_msg {
1698     my($self, $conn, $auth, $org_id, $carrier, $number, $target_ids) = @_;
1699
1700     my $sms_enable = $U->ou_ancestor_setting_value(
1701         $org_id || $U->get_org_tree->id,
1702         'sms.enable'
1703     );
1704     # We could maybe make a Validator for this on the templates
1705     if (! $U->is_true($sms_enable)) {
1706         return -1;
1707     }
1708
1709     my $disable_auth = $U->ou_ancestor_setting_value(
1710         $org_id || $U->get_org_tree->id,
1711         'sms.disable_authentication_requirement.callnumbers'
1712     );
1713
1714     my $e = new_editor(
1715         (defined $auth)
1716         ? (authtoken => $auth, xact => 1)
1717         : (xact => 1)
1718     );
1719     return $e->event unless $disable_auth || $e->checkauth;
1720
1721     my $targets = $e->batch_retrieve_asset_call_number($target_ids);
1722
1723     $e->rollback; # FIXME using transaction because of pgpool/slony setups, but not
1724                   # simply making this method authoritative because of weirdness
1725                   # with transaction handling in A/T code that causes rollback
1726                   # failure down the line if handling many targets
1727
1728     return undef unless @$targets;
1729     return $U->fire_object_event(
1730         undef,                    # event_def
1731         'acn.format.sms_text',    # hook
1732         $targets,
1733         $org_id,
1734         undef,                    # granularity
1735         {                         # user_data
1736             sms_carrier => $carrier,
1737             sms_notify => $number
1738         }
1739     );
1740 }
1741
1742
1743
1744 __PACKAGE__->register_method(
1745     method    => "fixed_field_values_by_rec_type",
1746     api_name  => "open-ils.cat.biblio.fixed_field_values.by_rec_type",
1747     argc      => 2,
1748     signature => {
1749         desc   => 'Given a record type (as in cmfpm.rec_type), return fixed fields and their possible values as known to the DB',
1750         params => [
1751             {desc => 'Record Type', type => 'string'},
1752             {desc => '(Optional) Fixed field', type => 'string'},
1753         ]
1754     },
1755     return => {desc => 'an object in which the keys are fixed fields and the values are arrays representing the set of all unique values for that fixed field in that record type', type => 'object' }
1756 );
1757
1758
1759 sub fixed_field_values_by_rec_type {
1760     my ($self, $conn, $rec_type, $fixed_field) = @_;
1761
1762     my $e = new_editor;
1763     my $values = $e->json_query({
1764         select => {
1765             crad  => ["fixed_field"],
1766             ccvm  => [qw/code value/],
1767             cmfpm => [qw/length default_val/],
1768         },
1769         distinct => 1,
1770         from => {
1771             ccvm => {
1772                 crad => {
1773                     join => {
1774                         cmfpm => {
1775                             fkey => "fixed_field",
1776                             field => "fixed_field"
1777                         }
1778                     }
1779                 }
1780             }
1781         },
1782         where => {
1783             "+cmfpm" => {rec_type => $rec_type},
1784             defined $fixed_field ?
1785                 ("+crad" => {fixed_field => $fixed_field}) : ()
1786         },
1787         order_by => [
1788             {class => "crad", field => "fixed_field"},
1789             {class => "ccvm", field => "code"}
1790         ]
1791     }) or return $e->die_event;
1792
1793     my $result = {};
1794     for my $row (@$values) {
1795         $result->{$row->{fixed_field}} ||= [];
1796         push @{$result->{$row->{fixed_field}}}, [@$row{qw/code value length default_val/}];
1797     }
1798
1799     return $result;
1800 }
1801
1802 __PACKAGE__->register_method(
1803     method    => "retrieve_tag_table",
1804     api_name  => "open-ils.cat.tag_table.all.retrieve.local",
1805     stream    => 1,
1806     argc      => 3,
1807     signature => {
1808         desc   => "Retrieve set of MARC tags, subfields, and indicator values for the user's OU",
1809         params => [
1810             {desc => 'Authtoken', type => 'string'},
1811             {desc => 'MARC Format', type => 'string'},
1812             {desc => 'MARC Record Type', type => 'string'},
1813         ]
1814     },
1815     return => {desc => 'Structure representing the tag table available to that user', type => 'object' }
1816 );
1817 __PACKAGE__->register_method(
1818     method    => "retrieve_tag_table",
1819     api_name  => "open-ils.cat.tag_table.all.retrieve.stock",
1820     stream    => 1,
1821     argc      => 3,
1822     signature => {
1823         desc   => 'Retrieve set of MARC tags, subfields, and indicator values for stock MARC standard',
1824         params => [
1825             {desc => 'Authtoken', type => 'string'},
1826             {desc => 'MARC Format', type => 'string'},
1827             {desc => 'MARC Record Type', type => 'string'},
1828         ]
1829     },
1830     return => {desc => 'Structure representing the stock tag table', type => 'object' }
1831 );
1832 __PACKAGE__->register_method(
1833     method    => "retrieve_tag_table",
1834     api_name  => "open-ils.cat.tag_table.field_list.retrieve.local",
1835     stream    => 1,
1836     argc      => 3,
1837     signature => {
1838         desc   => "Retrieve set of MARC tags for available to the user's OU",
1839         params => [
1840             {desc => 'Authtoken', type => 'string'},
1841             {desc => 'MARC Format', type => 'string'},
1842             {desc => 'MARC Record Type', type => 'string'},
1843         ]
1844     },
1845     return => {desc => 'Structure representing the tags available to that user', type => 'object' }
1846 );
1847 __PACKAGE__->register_method(
1848     method    => "retrieve_tag_table",
1849     api_name  => "open-ils.cat.tag_table.field_list.retrieve.stock",
1850     stream    => 1,
1851     argc      => 3,
1852     signature => {
1853         desc   => 'Retrieve set of MARC tags for stock MARC standard',
1854         params => [
1855             {desc => 'Authtoken', type => 'string'},
1856             {desc => 'MARC Format', type => 'string'},
1857             {desc => 'MARC Record Type', type => 'string'},
1858         ]
1859     },
1860     return => {desc => 'Structure representing the stock MARC tags', type => 'object' }
1861 );
1862
1863 sub retrieve_tag_table {
1864     my( $self, $conn, $auth, $marc_format, $marc_record_type ) = @_;
1865     my $e = new_editor( authtoken=>$auth, xact=>1 );
1866     return $e->die_event unless $e->checkauth;
1867
1868     my $field_list_only = ($self->api_name =~ /\.field_list\./) ? 1 : 0;
1869     my $context_ou;
1870     if ($self->api_name =~ /\.local$/) {
1871         $context_ou = $e->requestor->ws_ou;
1872     }
1873
1874     my %sf_by_tag;
1875     unless ($field_list_only) {
1876         my $subfields = $e->json_query(
1877             { from => [ 'config.ou_marc_subfields', 1, $marc_record_type, $context_ou ] }
1878         );
1879         foreach my $sf (@$subfields) {
1880             my $sf_data = {
1881                 code        => $sf->{code},
1882                 description => $sf->{description},
1883                 mandatory   => $sf->{mandatory},
1884                 repeatable   => $sf->{repeatable},
1885             };
1886             if ($sf->{value_ctype}) {
1887                 $sf_data->{value_list} = $e->json_query({
1888                     select => { ccvm => [
1889                                             'code',
1890                                             { column => 'value', alias => 'description' }
1891                                         ]
1892                               },
1893                     from   => 'ccvm',
1894                     where  => { ctype => $sf->{value_ctype} },
1895                     order_by => { ccvm => { code => {} } },
1896                 });
1897             }
1898             push @{ $sf_by_tag{$sf->{tag}} }, $sf_data;
1899         }
1900     }
1901
1902     my $fields = $e->json_query(
1903         { from => [ 'config.ou_marc_fields', 1, $marc_record_type, $context_ou ] }
1904     );
1905
1906     foreach my $field (@$fields) {
1907         next if $field->{hidden} eq 't';
1908         unless ($field_list_only) {
1909             my $tag = $field->{tag};
1910             if ($tag ge '010') {
1911                 for my $pos (1..2) {
1912                     my $ind_ccvm_key = "${marc_format}_${marc_record_type}_${tag}_ind_${pos}";
1913                     my $indvals = $e->json_query({
1914                         select => { ccvm => [
1915                                                 'code',
1916                                                 { column => 'value', alias => 'description' }
1917                                             ]
1918                                   },
1919                         from   => 'ccvm',
1920                         where  => { ctype => $ind_ccvm_key }
1921                     });
1922                     next unless defined($indvals);
1923                     $field->{"ind$pos"} = $indvals;
1924                 }
1925                 $field->{subfields} = exists($sf_by_tag{$tag}) ? $sf_by_tag{$tag} : [];
1926             }
1927         }
1928         $conn->respond($field);
1929     }
1930 }
1931
1932 1;
1933
1934 # vi:et:ts=4:sw=4