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     my $iter = 0;
 621     for (my $i = 1; $i <= $num_of_barcodes; $i++) {
 622
 623         my $full_barcode;
 624         while (1) {
 625             $iter++;
 626
 627             my $calculated_barcode = next_auto_barcode($barcode_number, $iter, $options);
 628             $full_barcode = $barcode_text . $calculated_barcode;
 629
 630             # If we're not checking dupes, assume the barcode we have is fine.
 631             last unless $options->{skip_dupes};
 632
 633             my $dupe = $e->search_asset_copy(
 634                 {barcode => $full_barcode, deleted => 'f'},
 635                 {idlist => 1}
 636             )->[0];
 637
 638             # If we find a duplicate, circle around again for another try.
 639             last unless $dupe;
 640         }
 641
 642         push @res, $full_barcode;
 643     }
 644
 645     return \@res
 646 }
 647
 648 sub next_auto_barcode {
 649     my ($barcode_number, $iter, $options) = @_;
 650
 651     my $calculated_barcode;
 652
 653     # default is to use checkdigits, so looking for an explicit false here
 654     if (defined $$options{'checkdigit'} && ! $$options{'checkdigit'}) {
 655         $calculated_barcode = $barcode_number + $iter;
 656     } else {
 657         if ($barcode_number =~ /^\d{8}$/) {
 658             $calculated_barcode = add_codabar_checkdigit($barcode_number + $iter, 0);
 659         } elsif ($barcode_number =~ /^\d{9}$/) {
 660             $calculated_barcode = add_codabar_checkdigit($barcode_number + $iter*10, 1); # strip last digit
 661         } elsif ($barcode_number =~ /^\d{13}$/) {
 662             $calculated_barcode = add_codabar_checkdigit($barcode_number + $iter, 0);
 663         } elsif ($barcode_number =~ /^\d{14}$/) {
 664             $calculated_barcode = add_codabar_checkdigit($barcode_number + $iter*10, 1); # strip last digit
 665         } else {
 666             $calculated_barcode = $barcode_number + $iter;
 667         }
 668     }
 669
 670     return $calculated_barcode;
 671 }
 672
 673 # Codabar doesn't define a checkdigit algorithm, but this one is typically used by libraries.  gmcharlt++
 674 sub add_codabar_checkdigit {
 675     my $barcode = shift;
 676     my $strip_last_digit = shift;
 677
 678     return $barcode if $barcode =~ /\D/;
 679     $barcode = substr($barcode, 0, length($barcode)-1) if $strip_last_digit;
 680     my @digits = split //, $barcode;
 681     my $total = 0;
 682     for (my $i = 1; $i < length($barcode); $i+=2) { # for a 13/14 digit barcode, would expect 1,3,5,7,9,11
 683         $total += $digits[$i];
 684     }
 685     for (my $i = 0; $i < length($barcode); $i+=2) { # for a 13/14 digit barcode, would expect 0,2,4,6,8,10,12
 686         $total += (2 * $digits[$i] >= 10) ? (2 * $digits[$i] - 9) : (2 * $digits[$i]);
 687     }
 688     my $remainder = $total % 10;
 689     my $checkdigit = ($remainder == 0) ? $remainder : 10 - $remainder;
 690     return $barcode . $checkdigit;
 691 }
 692
 693 __PACKAGE__->register_method(
 694     method        => "orgs_for_title",
 695     authoritative => 1,
 696     api_name      => "open-ils.cat.actor.org_unit.retrieve_by_title"
 697 );
 698
 699 sub orgs_for_title {
 700     my( $self, $client, $record_id ) = @_;
 701
 702     my $vols = $U->simple_scalar_request(
 703         "open-ils.cstore",
 704         "open-ils.cstore.direct.asset.call_number.search.atomic",
 705         { record => $record_id, deleted => 'f' });
 706
 707     my $orgs = { map {$_->owning_lib => 1 } @$vols };
 708     return [ keys %$orgs ];
 709 }
 710
 711
 712 __PACKAGE__->register_method(
 713     method        => "retrieve_copies",
 714     authoritative => 1,
 715     api_name      => "open-ils.cat.asset.copy_tree.retrieve");
 716
 717 __PACKAGE__->register_method(
 718     method   => "retrieve_copies",
 719     api_name => "open-ils.cat.asset.copy_tree.global.retrieve");
 720
 721 # user_session may be null/undef
 722 sub retrieve_copies {
 723
 724     my( $self, $client, $user_session, $docid, @org_ids ) = @_;
 725
 726     if(ref($org_ids[0])) { @org_ids = @{$org_ids[0]}; }
 727
 728     $docid = "$docid";
 729
 730     # grabbing copy trees should be available for everyone..
 731     if(!@org_ids and $user_session) {
 732         my($user_obj, $evt) = OpenILS::Application::AppUtils->checkses($user_session);
 733         return $evt if $evt;
 734         @org_ids = ($user_obj->home_ou);
 735     }
 736
 737     # Create an editor that can be shared across all iterations of
 738     # _build_volume_list().  Otherwise, .authoritative calls can result
 739     # in creating too many cstore connections.
 740     my $e = new_editor();
 741
 742     if( $self->api_name =~ /global/ ) {
 743         return _build_volume_list($e, { record => $docid, deleted => 'f', label => { '<>' => '##URI##' } } );
 744
 745     } else {
 746
 747         my @all_vols;
 748         for my $orgid (@org_ids) {
 749             my $vols = _build_volume_list($e,
 750                     { record => $docid, owning_lib => $orgid, deleted => 'f', label => { '<>' => '##URI##' } } );
 751             push( @all_vols, @$vols );
 752         }
 753
 754         return \@all_vols;
 755     }
 756
 757     return undef;
 758 }
 759
 760
 761 sub _build_volume_list {
 762     my $e = shift;
 763     my $search_hash = shift;
 764
 765     $e ||= new_editor();
 766
 767     $search_hash->{deleted} = 'f';
 768
 769     my $vols = $e->search_asset_call_number([
 770         $search_hash,
 771         {
 772             flesh => 1,
 773             flesh_fields => { acn => ['prefix','suffix','label_class'] },
 774             'order_by' => { 'acn' => 'oils_text_as_bytea(label_sortkey), oils_text_as_bytea(label), id, owning_lib' }
 775         }
 776     ]);
 777
 778     my @volumes;
 779
 780     for my $volume (@$vols) {
 781
 782         my $copies = $e->search_asset_copy([
 783             { call_number => $volume->id , deleted => 'f' },
 784             {
 785                 join => {
 786                     acpm => {
 787                         type => 'left',
 788                         join => {
 789                             bmp => { type => 'left' }
 790                         }
 791                     }
 792                 },
 793                 flesh => 1,
 794                 flesh_fields => { acp => ['stat_cat_entries','parts'] },
 795                 order_by => [
 796                     {'class' => 'bmp', 'field' => 'label_sortkey', 'transform' => 'oils_text_as_bytea'},
 797                     {'class' => 'bmp', 'field' => 'label', 'transform' => 'oils_text_as_bytea'},
 798                     {'class' => 'acp', 'field' => 'barcode'}
 799                 ]
 800             }
 801         ]);
 802
 803         for my $c (@$copies) {
 804             if( $c->status == OILS_COPY_STATUS_CHECKED_OUT ) {
 805                 $c->circulations(
 806                     $e->search_action_circulation(
 807                         [
 808                             { target_copy => $c->id },
 809                             {
 810                                 order_by => { circ => 'xact_start desc' },
 811                                 limit => 1
 812                             }
 813                         ]
 814                     )
 815                 )
 816             }
 817         }
 818
 819         $volume->copies($copies);
 820         push( @volumes, $volume );
 821     }
 822
 823     #$session->disconnect();
 824     return \@volumes;
 825
 826 }
 827
 828
 829 __PACKAGE__->register_method(
 830     method   => "fleshed_copy_update",
 831     api_name => "open-ils.cat.asset.copy.fleshed.batch.update",);
 832
 833 __PACKAGE__->register_method(
 834     method   => "fleshed_copy_update",
 835     api_name => "open-ils.cat.asset.copy.fleshed.batch.update.override",);
 836
 837
 838 sub fleshed_copy_update {
 839     my( $self, $conn, $auth, $copies, $delete_stats, $oargs, $create_parts ) = @_;
 840     return 1 unless ref $copies;
 841     my( $reqr, $evt ) = $U->checkses($auth);
 842     return $evt if $evt;
 843     my $editor = new_editor(requestor => $reqr, xact => 1);
 844     if ($self->api_name =~ /override/) {
 845         $oargs = { all => 1 } unless defined $oargs;
 846     } else {
 847         $oargs = {};
 848     }
 849     my $retarget_holds = [];
 850     $evt = OpenILS::Application::Cat::AssetCommon->update_fleshed_copies(
 851         $editor, $oargs, undef, $copies, $delete_stats, $retarget_holds, undef, $create_parts);
 852
 853     if( $evt ) {
 854         $logger->info("fleshed copy update failed with event: ".OpenSRF::Utils::JSON->perl2JSON($evt));
 855         $editor->rollback;
 856         return $evt;
 857     }
 858
 859     $editor->commit;
 860     $logger->info("fleshed copy update successfully updated ".scalar(@$copies)." copies");
 861     reset_hold_list($auth, $retarget_holds);
 862
 863     return 1;
 864 }
 865
 866 sub reset_hold_list {
 867     my($auth, $hold_ids) = @_;
 868     return unless @$hold_ids;
 869     $logger->info("reseting holds after copy status change: @$hold_ids");
 870     my $ses = OpenSRF::AppSession->create('open-ils.circ');
 871     $ses->request('open-ils.circ.hold.reset.batch', $auth, $hold_ids);
 872 }
 873
 874 __PACKAGE__->register_method(
 875     method    => "transfer_copies_to_volume",
 876     api_name  => "open-ils.cat.transfer_copies_to_volume",
 877     argc      => 3,
 878     signature => {
 879         desc   => 'Transfers specified copies to the specified call number, and changes Circ Lib to match the new Owning Lib.',
 880         params => [
 881             {desc => 'Authtoken', type => 'string'},
 882             {desc => 'Call Number ID', type => 'number'},
 883             {desc => 'Array of Copy IDs', type => 'array'},
 884         ]
 885     },
 886     return => {desc => '1 on success, Event on error'}
 887 );
 888
 889 __PACKAGE__->register_method(
 890     method   => "transfer_copies_to_volume",
 891     api_name => "open-ils.cat.transfer_copies_to_volume.override",);
 892
 893 sub transfer_copies_to_volume {
 894     my( $self, $conn, $auth, $volume, $copies, $oargs ) = @_;
 895     my $delete_stats = 1;
 896     my $force_delete_empty_bib = undef;
 897     my $create_parts = undef;
 898
 899     # initial tests
 900
 901     return 1 unless ref $copies;
 902     my( $reqr, $evt ) = $U->checkses($auth);
 903     return $evt if $evt;
 904     my $editor = new_editor(requestor => $reqr, xact => 1);
 905     if ($self->api_name =~ /override/) {
 906         $oargs = { all => 1 } unless defined $oargs;
 907     } else {
 908         $oargs = {};
 909     }
 910
 911     # does the volume exist?  good, we also need its owning_lib later
 912     my( $cn, $cn_evt ) = $U->fetch_callnumber( $volume, 0, $editor );
 913     return $cn_evt if $cn_evt;
 914
 915     # flesh and munge the copies
 916     my $fleshed_copies = [];
 917     my $copy;
 918     foreach my $copy_id ( @{ $copies } ) {
 919         $copy = $editor->search_asset_copy([
 920             { id => $copy_id , deleted => 'f' },
 921             {
 922                 flesh => 1,
 923                 flesh_fields => { acp => ['parts', 'stat_cat_entries'] }
 924             }
 925         ])->[0];
 926         return OpenILS::Event->new('ASSET_COPY_NOT_FOUND') if !$copy;
 927         $copy->call_number( $volume );
 928         $copy->circ_lib( $cn->owning_lib() );
 929         $copy->ischanged( 't' );
 930         push @$fleshed_copies, $copy;
 931     }
 932
 933     # actual work
 934     my $retarget_holds = [];
 935     $evt = OpenILS::Application::Cat::AssetCommon->update_fleshed_copies(
 936         $editor, $oargs, undef, $fleshed_copies, $delete_stats, $retarget_holds, $force_delete_empty_bib, $create_parts);
 937
 938     if( $evt ) {
 939         $logger->info("copy to volume transfer failed with event: ".OpenSRF::Utils::JSON->perl2JSON($evt));
 940         $editor->rollback;
 941         return $evt;
 942     }
 943
 944     # take care of the parts
 945     for my $copy (@$fleshed_copies) {
 946         my $parts = $copy->parts;
 947         next unless $parts;
 948         my $part_objs = [];
 949         foreach my $part (@$parts) {
 950             my $part_label = $part->label;
 951             my $part_obj = $editor->search_biblio_monograph_part(
 952               {
 953                    label=>$part_label,
 954                    record=>$cn->record,
 955                    deleted=>'f'
 956               }
 957            )->[0];
 958            if (!$part_obj) {
 959                $part_obj = Fieldmapper::biblio::monograph_part->new();
 960                $part_obj->label( $part_label );
 961                $part_obj->record( $cn->record );
 962                unless($editor->create_biblio_monograph_part($part_obj)) {
 963                  return $editor->die_event if $editor->die_event;
 964                }
 965            }
 966            push @$part_objs, $part_obj;
 967         }
 968         $copy->parts( $part_objs );
 969         $copy->ischanged(1);
 970         $evt = OpenILS::Application::Cat::AssetCommon->update_copy_parts($editor, $copy, 1); #delete_parts=1
 971         return $evt if $evt;
 972     }
 973
 974     $editor->commit;
 975     $logger->info("copy to volume transfer successfully updated ".scalar(@$copies)." copies");
 976     reset_hold_list($auth, $retarget_holds);
 977
 978     return 1;
 979 }
 980
 981 __PACKAGE__->register_method(
 982     method    => 'in_db_merge',
 983     api_name  => 'open-ils.cat.biblio.records.merge',
 984     signature => q/
 985         Merges a group of records
 986         @param auth The login session key
 987         @param master The id of the record all other records should be merged into
 988         @param records Array of records to be merged into the master record
 989         @return 1 on success, Event on error.
 990     /
 991 );
 992
 993 sub in_db_merge {
 994     my( $self, $conn, $auth, $master, $records ) = @_;
 995
 996     my $editor = new_editor( authtoken => $auth, xact => 1 );
 997     return $editor->die_event unless $editor->checkauth;
 998     return $editor->die_event unless $editor->allowed('MERGE_BIB_RECORDS'); # TODO see below about record ownership
 999
1000     my $count = 0;
1001     for my $source ( @$records ) {
1002         #XXX we actually /will/ want to check perms for master and sources after record ownership exists
1003
1004         # This stored proc (asset.merge_record_assets(target,source)) has the side effects of
1005         # moving call_number, title-type (and some volume-type) hold_request and uri-mapping
1006         # objects from the source record to the target record, so must be called from within
1007         # a transaction.
1008
1009         $count += $editor->json_query({
1010             select => {
1011                 bre => [{
1012                     alias => 'count',
1013                     transform => 'asset.merge_record_assets',
1014                     column => 'id',
1015                     params => [$source]
1016                 }]
1017             },
1018             from   => 'bre',
1019             where  => { id => $master }
1020         })->[0]->{count}; # count of objects moved, of all types
1021
1022     }
1023
1024     $editor->commit;
1025     return $count;
1026 }
1027
1028 __PACKAGE__->register_method(
1029     method    => 'in_db_auth_merge',
1030     api_name  => 'open-ils.cat.authority.records.merge',
1031     signature => q/
1032         Merges a group of authority records
1033         @param auth The login session key
1034         @param master The id of the record all other records should be merged into
1035         @param records Array of records to be merged into the master record
1036         @return 1 on success, Event on error.
1037     /
1038 );
1039
1040 sub in_db_auth_merge {
1041     my( $self, $conn, $auth, $master, $records ) = @_;
1042
1043     my $editor = new_editor( authtoken => $auth, xact => 1 );
1044     return $editor->die_event unless $editor->checkauth;
1045     return $editor->die_event unless $editor->allowed('MERGE_AUTH_RECORDS'); # TODO see below about record ownership
1046
1047     my $count = 0;
1048     for my $source ( @$records ) {
1049         $count += $editor->json_query({
1050             select => {
1051                 are => [{
1052                     alias => 'count',
1053                     transform => 'authority.merge_records',
1054                     column => 'id',
1055                     params => [$source]
1056                 }]
1057             },
1058             from   => 'are',
1059             where  => { id => $master }
1060         })->[0]->{count}; # count of objects moved, of all types
1061     }
1062
1063     $editor->commit;
1064     return $count;
1065 }
1066
1067 __PACKAGE__->register_method(
1068     method    => 'calculate_marc_merge',
1069     api_name  => 'open-ils.cat.merge.marc.per_profile',
1070     signature => q/
1071         Calculate the result of merging one or more MARC records
1072         per the specified merge profile
1073         @param auth The login session key
1074         @param merge_profile ID of the record merge profile
1075         @param records Array of two or more MARCXML records to be
1076                        merged. If two are supplied, the first
1077                        is treated as the record to be overlaid,
1078                        and the the incoming record that will
1079                        overlay the first. If more than two are
1080                        supplied, the first is treated as the
1081                        record to be overlaid, and each following
1082                        record in turn will be merged into that
1083                        record.
1084         @return MARCXML string of the results of the merge
1085     /
1086 );
1087 __PACKAGE__->register_method(
1088     method    => 'calculate_bib_marc_merge',
1089     api_name  => 'open-ils.cat.merge.biblio.per_profile',
1090     signature => q/
1091         Calculate the result of merging one or more bib records
1092         per the specified merge profile
1093         @param auth The login session key
1094         @param merge_profile ID of the record merge profile
1095         @param records Array of two or more bib record IDs of
1096                        the bibs to be merged.
1097         @return MARCXML string of the results of the merge
1098     /
1099 );
1100 __PACKAGE__->register_method(
1101     method    => 'calculate_authority_marc_merge',
1102     api_name  => 'open-ils.cat.merge.authority.per_profile',
1103     signature => q/
1104         Calculate the result of merging one or more authority records
1105         per the specified merge profile
1106         @param auth The login session key
1107         @param merge_profile ID of the record merge profile
1108         @param records Array of two or more bib record IDs of
1109                        the bibs to be merged.
1110         @return MARCXML string of the results of the merge
1111     /
1112 );
1113
1114 sub _handle_marc_merge {
1115     my ($e, $merge_profile_id, $records) = @_;
1116
1117     my $result = shift @$records;
1118     foreach my $incoming (@$records) {
1119         my $response = $e->json_query({
1120             from => [
1121                 'vandelay.merge_record_xml_using_profile',
1122                 $incoming, $result,
1123                 $merge_profile_id
1124             ]
1125         });
1126         return unless ref($response);
1127         $result = $response->[0]->{'vandelay.merge_record_xml_using_profile'};
1128     }
1129     return $result;
1130 }
1131
1132 sub calculate_marc_merge {
1133     my( $self, $conn, $auth, $merge_profile_id, $records ) = @_;
1134
1135     my $e = new_editor(authtoken=>$auth, xact=>1);
1136     return $e->die_event unless $e->checkauth;
1137
1138     my $merge_profile = $e->retrieve_vandelay_merge_profile($merge_profile_id)
1139         or return $e->die_event;
1140     return $e->die_event unless ref($records) && @$records >= 2;
1141
1142     return _handle_marc_merge($e, $merge_profile_id, $records)
1143 }
1144
1145 sub calculate_bib_marc_merge {
1146     my( $self, $conn, $auth, $merge_profile_id, $bib_ids ) = @_;
1147
1148     my $e = new_editor(authtoken=>$auth, xact=>1);
1149     return $e->die_event unless $e->checkauth;
1150
1151     my $merge_profile = $e->retrieve_vandelay_merge_profile($merge_profile_id)
1152         or return $e->die_event;
1153     return $e->die_event unless ref($bib_ids) && @$bib_ids >= 2;
1154
1155     my $records = [];
1156     foreach my $id (@$bib_ids) {
1157         my $bre = $e->retrieve_biblio_record_entry($id) or return $e->die_event;
1158         push @$records, $bre->marc();
1159     }
1160
1161     return _handle_marc_merge($e, $merge_profile_id, $records)
1162 }
1163
1164 sub calculate_authority_marc_merge {
1165     my( $self, $conn, $auth, $merge_profile_id, $authority_ids ) = @_;
1166
1167     my $e = new_editor(authtoken=>$auth, xact=>1);
1168     return $e->die_event unless $e->checkauth;
1169
1170     my $merge_profile = $e->retrieve_vandelay_merge_profile($merge_profile_id)
1171         or return $e->die_event;
1172     return $e->die_event unless ref($authority_ids) && @$authority_ids >= 2;
1173
1174     my $records = [];
1175     foreach my $id (@$authority_ids) {
1176         my $are = $e->retrieve_authority_record_entry($id) or return $e->die_event;
1177         push @$records, $are->marc();
1178     }
1179
1180     return _handle_marc_merge($e, $merge_profile_id, $records)
1181 }
1182
1183 __PACKAGE__->register_method(
1184     method   => "fleshed_volume_update",
1185     api_name => "open-ils.cat.asset.volume.fleshed.batch.update",);
1186
1187 __PACKAGE__->register_method(
1188     method   => "fleshed_volume_update",
1189     api_name => "open-ils.cat.asset.volume.fleshed.batch.update.override",);
1190
1191 sub fleshed_volume_update {
1192     my( $self, $conn, $auth, $volumes, $delete_stats, $options, $oargs ) = @_;
1193     my( $reqr, $evt ) = $U->checkses($auth);
1194     return $evt if $evt;
1195     $options ||= {};
1196
1197     if ($self->api_name =~ /override/) {
1198         $oargs = { all => 1 } unless defined $oargs;
1199     } else {
1200         $oargs = {};
1201     }
1202     my $editor = new_editor( requestor => $reqr, xact => 1 );
1203     my $retarget_holds = [];
1204     my $auto_merge_vols = $options->{auto_merge_vols};
1205     my $create_parts = $options->{create_parts};
1206     my $copy_ids = [];
1207
1208     for my $vol (@$volumes) {
1209         $logger->info("vol-update: investigating volume ".$vol->id);
1210
1211         $vol->editor($reqr->id);
1212         $vol->edit_date('now');
1213
1214         my $copies = $vol->copies;
1215         $vol->clear_copies;
1216
1217         $vol->editor($editor->requestor->id);
1218         $vol->edit_date('now');
1219
1220         if( $vol->isdeleted ) {
1221
1222             $logger->info("vol-update: deleting volume");
1223             return $editor->die_event unless
1224                 $editor->allowed('UPDATE_VOLUME', $vol->owning_lib);
1225
1226             if(my $evt = $assetcom->delete_volume($editor, $vol, $oargs, $$options{force_delete_copies})) {
1227                 $editor->rollback;
1228                 return $evt;
1229             }
1230
1231             return $editor->die_event unless
1232                 $editor->update_asset_call_number($vol);
1233
1234         } elsif( $vol->isnew ) {
1235             $logger->info("vol-update: creating volume");
1236             ($vol,$evt) = $assetcom->create_volume( $auto_merge_vols ? { all => 1} : $oargs, $editor, $vol );
1237             return $evt if $evt;
1238
1239         } elsif( $vol->ischanged ) {
1240             $logger->info("vol-update: update volume");
1241
1242             # Three cases here:
1243             #   1) We're editing a volume, and not its copies.
1244             #   2) We're editing a volume, and a subset of its copies.
1245             #   3) We're editing a volume, and all of its copies.
1246             #
1247             # For 1) and 3), we definitely want to edit the volume
1248             # itself (and possibly auto-merge), but for 2), we want
1249             # to create a new volume (and possibly auto-merge).
1250
1251             if (scalar(@$copies) == 0) { # case 1
1252
1253                 my $resp = update_volume($vol, $editor, ($oargs->{all} or grep { $_ eq 'VOLUME_LABEL_EXISTS' } @{$oargs->{events}} or $auto_merge_vols));
1254                 return $resp->{evt} if $resp->{evt};
1255                 $vol = $resp->{merge_vol} if $resp->{merge_vol};
1256
1257             } else {
1258
1259                 my $resp = $editor->json_query({
1260                   select => {
1261                     acp => [
1262                       {transform => 'count', aggregate => 1, column => 'id', alias => 'count'}
1263                     ]
1264                   },
1265                   from => 'acp',
1266                   where => {
1267                     call_number => $vol->id,
1268                     deleted => 'f',
1269                     id => {'not in' => [ map { $_->id } @$copies ]}
1270                   }
1271                 });
1272                 if ($resp->[0]->{count} && $resp->[0]->{count} > 0) { # case 2
1273
1274                     ($vol,$evt) = $assetcom->create_volume( $auto_merge_vols ? { all => 1} : $oargs, $editor, $vol );
1275                     return $evt if $evt;
1276
1277                 } else { # case 3
1278
1279                     my $resp = update_volume($vol, $editor, ($oargs->{all} or grep { $_ eq 'VOLUME_LABEL_EXISTS' } @{$oargs->{events}} or $auto_merge_vols));
1280                     return $resp->{evt} if $resp->{evt};
1281                     $vol = $resp->{merge_vol} if $resp->{merge_vol};
1282                 }
1283
1284             }
1285         }
1286
1287         # now update any attached copies
1288         if( $copies and @$copies and !$vol->isdeleted ) {
1289             $_->call_number($vol->id) for @$copies;
1290             $evt = $assetcom->update_fleshed_copies(
1291                 $editor, $oargs, $vol, $copies, $delete_stats, $retarget_holds, undef, $create_parts);
1292             return $evt if $evt;
1293             push( @$copy_ids, $_->id ) for @$copies;
1294         }
1295     }
1296
1297     $editor->finish;
1298     reset_hold_list($auth, $retarget_holds);
1299     if ($options->{return_copy_ids}) {
1300         return $copy_ids;
1301     } else {
1302         return scalar(@$volumes);
1303     }
1304 }
1305
1306
1307 sub update_volume {
1308     my $vol = shift;
1309     my $editor = shift;
1310     my $auto_merge = shift;
1311     my $evt;
1312     my $merge_vol;
1313
1314     return {evt => $editor->event} unless
1315         $editor->allowed('UPDATE_VOLUME', $vol->owning_lib);
1316
1317     return {evt => $evt}
1318         if ( $evt = OpenILS::Application::Cat::AssetCommon->org_cannot_have_vols($editor, $vol->owning_lib) );
1319
1320     my $vols = $editor->search_asset_call_number({
1321         owning_lib => $vol->owning_lib,
1322         record     => $vol->record,
1323         label      => $vol->label,
1324         prefix     => $vol->prefix,
1325         suffix     => $vol->suffix,
1326         deleted    => 'f',
1327         id         => {'!=' => $vol->id}
1328     });
1329
1330     if(@$vols) {
1331
1332         if($auto_merge) {
1333
1334             # If the auto-merge option is on, merge our updated volume into the existing
1335             # volume with the same record + owner + label.
1336             ($merge_vol, $evt) = OpenILS::Application::Cat::Merge::merge_volumes($editor, [$vol], $vols->[0]);
1337             return {evt => $evt, merge_vol => $merge_vol};
1338
1339         } else {
1340             return {evt => OpenILS::Event->new('VOLUME_LABEL_EXISTS', payload => $vol->id)};
1341         }
1342     }
1343
1344     return {evt => $editor->die_event} unless $editor->update_asset_call_number($vol);
1345     return {};
1346 }
1347
1348
1349
1350 __PACKAGE__->register_method (
1351     method   => 'delete_bib_record',
1352     api_name => 'open-ils.cat.biblio.record_entry.delete');
1353
1354 sub delete_bib_record {
1355     my($self, $conn, $auth, $rec_id) = @_;
1356     my $e = new_editor(xact=>1, authtoken=>$auth);
1357     return $e->die_event unless $e->checkauth;
1358     return $e->die_event unless $e->allowed('DELETE_RECORD', $e->requestor->ws_ou);
1359     my $vols = $e->search_asset_call_number({record=>$rec_id, deleted=>'f'});
1360     return OpenILS::Event->new('RECORD_NOT_EMPTY', payload=>$rec_id) if @$vols;
1361     my $acq_li_count = $e->json_query({
1362         select => {jub => [{column => 'id', transform => 'count'}]},
1363     from => 'jub',
1364     where => {
1365         '+jub' => {
1366                  eg_bib_id => $rec_id,
1367                  state => ['new','pending-order','on-order']
1368             }
1369         }
1370     })->[0];
1371     return OpenILS::Event->new('RECORD_REFERENCED_BY_LINEITEM', payload => $rec_id) if ($acq_li_count->{id} > 0);
1372     my $evt = OpenILS::Application::Cat::BibCommon->delete_rec($e, $rec_id);
1373     if($evt) { $e->rollback; return $evt; }
1374     $e->commit;
1375     return 1;
1376 }
1377
1378
1379
1380 __PACKAGE__->register_method (
1381     method   => 'batch_volume_transfer',
1382     api_name => 'open-ils.cat.asset.volume.batch.transfer',
1383 );
1384
1385 __PACKAGE__->register_method (
1386     method   => 'batch_volume_transfer',
1387     api_name => 'open-ils.cat.asset.volume.batch.transfer.override',
1388 );
1389
1390
1391 sub batch_volume_transfer {
1392     my( $self, $conn, $auth, $args, $oargs ) = @_;
1393
1394     my $evt;
1395     my $rec     = $$args{docid};
1396     my $o_lib   = $$args{lib};
1397     my $vol_ids = $$args{volumes};
1398
1399     my $override = 1 if $self->api_name =~ /override/;
1400     $oargs = { all => 1 } unless defined $oargs;
1401
1402     $logger->info("merge: transferring volumes to lib=$o_lib and record=$rec");
1403
1404     my $e = new_editor(authtoken => $auth, xact =>1);
1405     return $e->event unless $e->checkauth;
1406     return $e->event unless $e->allowed('UPDATE_VOLUME', $o_lib);
1407
1408     my $dorg = $e->retrieve_actor_org_unit($o_lib)
1409         or return $e->event;
1410
1411     my $ou_type = $e->retrieve_actor_org_unit_type($dorg->ou_type)
1412         or return $e->event;
1413
1414     return $evt if ( $evt = OpenILS::Application::Cat::AssetCommon->org_cannot_have_vols($e, $o_lib) );
1415
1416     my $vols = $e->batch_retrieve_asset_call_number($vol_ids);
1417     my @seen;
1418
1419    my @rec_ids;
1420
1421     for my $vol (@$vols) {
1422
1423         # if we've already looked at this volume, go to the next
1424         next if !$vol or grep { $vol->id == $_ } @seen;
1425
1426         # grab all of the volumes in the list that have
1427         # the same label so they can be merged
1428         my @all = grep { $_->label eq $vol->label } @$vols;
1429
1430         # take note of the fact that we've looked at this set of volumes
1431         push( @seen, $_->id ) for @all;
1432         push( @rec_ids, $_->record ) for @all;
1433
1434         # for each volume, see if there are any copies that have a
1435         # remote circ_lib (circ_lib != vol->owning_lib and != $o_lib ).
1436         # if so, warn them
1437         unless( $override && ($oargs->{all} || grep { $_ eq 'COPY_REMOTE_CIRC_LIB' } @{$oargs->{events}}) ) {
1438             for my $v (@all) {
1439
1440                 $logger->debug("merge: searching for copies with remote circ_lib for volume ".$v->id);
1441                 my $args = {
1442                     call_number => $v->id,
1443                     circ_lib    => { "not in" => [ $o_lib, $v->owning_lib ] },
1444                     deleted     => 'f'
1445                 };
1446
1447                 my $copies = $e->search_asset_copy($args, {idlist=>1});
1448
1449                 # if the copy's circ_lib matches the destination lib,
1450                 # that's ok too
1451                 return OpenILS::Event->new('COPY_REMOTE_CIRC_LIB') if @$copies;
1452             }
1453         }
1454
1455         # record the difference between the destination bib and the present bib
1456         my $same_bib = $vol->record == $rec;
1457
1458         # see if there is a volume at the destination lib that
1459         # already has the requested label
1460         my $existing_vol = $e->search_asset_call_number(
1461             {
1462                 label      => $vol->label,
1463                 prefix     => $vol->prefix,
1464                 suffix     => $vol->suffix,
1465                 record     => $rec,
1466                 owning_lib => $o_lib,
1467                 deleted    => 'f'
1468             }
1469         )->[0];
1470
1471         if( $existing_vol ) {
1472
1473             if( grep { $_->id == $existing_vol->id } @all ) {
1474                 # this volume is already accounted for in our list of volumes to merge
1475                 $existing_vol = undef;
1476
1477             } else {
1478                 # this volume exists on the destination record/owning_lib and must
1479                 # be used as the destination for merging
1480                 $logger->debug("merge: volume already exists at destination record: ".
1481                     $existing_vol->id.' : '.$existing_vol->label) if $existing_vol;
1482             }
1483         }
1484
1485         if( @all > 1 || $existing_vol ) {
1486             $logger->info("merge: found collisions in volume transfer");
1487             my @args = ($e, \@all);
1488             @args = ($e, \@all, $existing_vol) if $existing_vol;
1489             ($vol, $evt) = OpenILS::Application::Cat::Merge::merge_volumes(@args);
1490             return $evt if $evt;
1491         }
1492
1493         if( !$existing_vol ) {
1494
1495             $vol->owning_lib($o_lib);
1496             $vol->record($rec);
1497             $vol->editor($e->requestor->id);
1498             $vol->edit_date('now');
1499
1500             $logger->info("merge: updating volume ".$vol->id);
1501             $e->update_asset_call_number($vol) or return $e->event;
1502
1503         } else {
1504             $logger->info("merge: bypassing volume update because existing volume used as target");
1505         }
1506
1507         # regardless of what volume was used as the destination,
1508         # update any copies that have moved over to the new lib
1509         my $copies = $e->search_asset_copy([
1510             { call_number => $vol->id , deleted => 'f' },
1511             {
1512                 flesh => 1,
1513                 flesh_fields => { acp => ['parts'] }
1514             }
1515         ]);
1516
1517         # update circ lib on the copies - make this a method flag?
1518         for my $copy (@$copies) {
1519             next if $copy->circ_lib == $o_lib;
1520             $logger->info("merge: transfer moving circ lib on copy ".$copy->id);
1521             $copy->circ_lib($o_lib);
1522             $copy->editor($e->requestor->id);
1523             $copy->edit_date('now');
1524             $e->update_asset_copy($copy) or return $e->event;
1525         }
1526
1527         # update parts if volume is moving bib records
1528         if( !$same_bib ) {
1529             for my $copy (@$copies) {
1530                 my $parts = $copy->parts;
1531                 next unless $parts;
1532                 my $part_objs = [];
1533                 foreach my $part (@$parts) {
1534                     my $part_label = $part->label;
1535                     my $part_obj = $e->search_biblio_monograph_part(
1536                        {
1537                             label=>$part_label,
1538                             record=>$rec,
1539                             deleted=>'f'
1540                        }
1541                     )->[0];
1542
1543                     if (!$part_obj) {
1544                         $part_obj = Fieldmapper::biblio::monograph_part->new();
1545                         $part_obj->label( $part_label );
1546                         $part_obj->record( $rec );
1547                         unless($e->create_biblio_monograph_part($part_obj)) {
1548                           return $e->die_event if $e->die_event;
1549                         }
1550                     }
1551                     push @$part_objs, $part_obj;
1552                 }
1553
1554                 $copy->parts( $part_objs );
1555                 $copy->ischanged(1);
1556                 $evt = OpenILS::Application::Cat::AssetCommon->update_copy_parts($e, $copy, 1); #delete_parts=1
1557                 return $evt if $evt;
1558             }
1559         }
1560
1561         # Now see if any empty records need to be deleted after all of this
1562         my $keep_on_empty = $U->ou_ancestor_setting_value($e->requestor->ws_ou, 'cat.bib.keep_on_empty', $e);
1563         unless ($U->is_true($keep_on_empty)) {
1564
1565             for (@rec_ids) {
1566                 $logger->debug("merge: seeing if we should delete record $_...");
1567                 if (OpenILS::Application::Cat::BibCommon->title_is_empty($e, $_)) {
1568                     # check for any title holds on the bib, bail if so
1569                     my $has_holds = OpenILS::Application::Cat::BibCommon->title_has_holds($e, $_);
1570                     return OpenILS::Event->new('TITLE_HAS_HOLDS', payload => $_) if $has_holds;
1571                     # we're good, delete the record
1572                     $evt = OpenILS::Application::Cat::BibCommon->delete_rec($e, $_);
1573                     return $evt if $evt;
1574                 }
1575             }
1576         }
1577     }
1578
1579     $logger->info("merge: transfer succeeded");
1580     $e->commit;
1581     return 1;
1582 }
1583
1584
1585
1586
1587 __PACKAGE__->register_method(
1588     api_name => 'open-ils.cat.call_number.find_or_create',
1589     method   => 'find_or_create_volume',
1590 );
1591
1592 sub find_or_create_volume {
1593     my( $self, $conn, $auth, $label, $record_id, $org_id, $prefix, $suffix, $label_class ) = @_;
1594     my $e = new_editor(authtoken=>$auth, xact=>1);
1595     return $e->die_event unless $e->checkauth;
1596     my ($vol, $evt, $exists) =
1597         OpenILS::Application::Cat::AssetCommon->find_or_create_volume($e, $label, $record_id, $org_id, $prefix, $suffix, $label_class);
1598     return $evt if $evt;
1599     $e->rollback if $exists;
1600     $e->commit if $vol;
1601     return { 'acn_id' => $vol->id, 'existed' => $exists };
1602 }
1603
1604
1605 __PACKAGE__->register_method(
1606     method    => "create_serial_record_xml",
1607     api_name  => "open-ils.cat.serial.record.xml.create.override",
1608     signature => q/@see open-ils.cat.serial.record.xml.create/);
1609
1610 __PACKAGE__->register_method(
1611     method    => "create_serial_record_xml",
1612     api_name  => "open-ils.cat.serial.record.xml.create",
1613     signature => q/
1614         Inserts a new serial record with the given XML
1615     /
1616 );
1617
1618 sub create_serial_record_xml {
1619     my( $self, $client, $login, $source, $owning_lib, $record_id, $xml, $oargs ) = @_;
1620
1621     my $override = 1 if $self->api_name =~ /override/; # not currently used
1622     $oargs = { all => 1 } unless defined $oargs; # Not currently used, but here for consistency.
1623
1624     my $e = new_editor(xact=>1, authtoken=>$login);
1625     return $e->die_event unless $e->checkauth;
1626     return $e->die_event unless $e->allowed('CREATE_MFHD_RECORD', $owning_lib);
1627
1628     # Auto-populate the location field of a placeholder MFHD record with the library name
1629     my $aou = $e->retrieve_actor_org_unit($owning_lib) or return $e->die_event;
1630
1631     my $mfhd = Fieldmapper::serial::record_entry->new;
1632
1633     $mfhd->source($source) if $source;
1634     $mfhd->record($record_id);
1635     $mfhd->creator($e->requestor->id);
1636     $mfhd->editor($e->requestor->id);
1637     $mfhd->create_date('now');
1638     $mfhd->edit_date('now');
1639     $mfhd->owning_lib($owning_lib);
1640
1641     # If the caller did not pass in MFHD XML, create a placeholder record.
1642     # The placeholder will only contain the name of the owning library.
1643     # The goal is to generate common patterns for the caller in the UI that
1644     # then get passed in here.
1645     if (!$xml) {
1646         my $aou_name = $aou->name;
1647         $xml = <<HERE;
1648 <record
1649  xsi:schemaLocation="http://www.loc.gov/MARC21/slim http://www.loc.gov/standards/marcxml/schema/MARC21slim.xsd"
1650  xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"
1651  xmlns="http://www.loc.gov/MARC21/slim">
1652 <leader>00307ny  a22001094  4500</leader>
1653 <controlfield tag="001">42153</controlfield>
1654 <controlfield tag="005">20090601182414.0</controlfield>
1655 <controlfield tag="004">$record_id</controlfield>
1656 <controlfield tag="008">      4u####8###l# 4   uueng1      </controlfield>
1657 <datafield tag="852" ind1=" " ind2=" "> <subfield code="b">$aou_name</subfield></datafield>
1658 </record>
1659 HERE
1660     }
1661     my $marcxml = XML::LibXML->new->parse_string($xml);
1662     $marcxml->documentElement->setNamespace("http://www.loc.gov/MARC21/slim", "marc", 1 );
1663     $marcxml->documentElement->setNamespace("http://www.loc.gov/MARC21/slim");
1664
1665     $mfhd->marc($U->entityize($marcxml->documentElement->toString));
1666
1667     $e->create_serial_record_entry($mfhd) or return $e->die_event;
1668
1669     $e->commit;
1670     return $mfhd->id;
1671 }
1672
1673 __PACKAGE__->register_method(
1674     method   => "create_update_asset_copy_template",
1675     api_name => "open-ils.cat.asset.copy_template.create_or_update"
1676 );
1677
1678 sub create_update_asset_copy_template {
1679     my ($self, $client, $authtoken, $act) = @_;
1680
1681     my $e = new_editor("xact" => 1, "authtoken" => $authtoken);
1682     return $e->die_event unless $e->checkauth;
1683     return $e->die_event unless $e->allowed(
1684         "ADMIN_ASSET_COPY_TEMPLATE", $act->owning_lib
1685     );
1686
1687     $act->editor($e->requestor->id);
1688     $act->edit_date("now");
1689
1690     my $retval;
1691     if (!$act->id) {
1692         $act->creator($e->requestor->id);
1693         $act->create_date("now");
1694
1695         $e->create_asset_copy_template($act) or return $e->die_event;
1696         $retval = $e->data;
1697     } else {
1698         $e->update_asset_copy_template($act) or return $e->die_event;
1699         $retval = $e->retrieve_asset_copy_template($e->data);
1700     }
1701     $e->commit and return $retval;
1702 }
1703
1704 __PACKAGE__->register_method(
1705     method      => "acn_sms_msg",
1706     api_name    => "open-ils.cat.acn.send_sms_text",
1707     signature   => q^
1708         Send an SMS text from an A/T template for specified call numbers.
1709
1710         First parameter is null or an auth token (whether a null is allowed
1711         depends on the sms.disable_authentication_requirement.callnumbers OU
1712         setting).
1713
1714         Second parameter is the id of the context org.
1715
1716         Third parameter is the code of the SMS carrier from the
1717         config.sms_carrier table.
1718
1719         Fourth parameter is the SMS number.
1720
1721         Fifth parameter is the ACN id's to target, though currently only the
1722         first ACN is used by the template (and the UI is only sending one).
1723     ^
1724 );
1725
1726 sub acn_sms_msg {
1727     my($self, $conn, $auth, $org_id, $carrier, $number, $target_ids) = @_;
1728
1729     my $sms_enable = $U->ou_ancestor_setting_value(
1730         $org_id || $U->get_org_tree->id,
1731         'sms.enable'
1732     );
1733     # We could maybe make a Validator for this on the templates
1734     if (! $U->is_true($sms_enable)) {
1735         return -1;
1736     }
1737
1738     my $disable_auth = $U->ou_ancestor_setting_value(
1739         $org_id || $U->get_org_tree->id,
1740         'sms.disable_authentication_requirement.callnumbers'
1741     );
1742
1743     my $e = new_editor(
1744         (defined $auth)
1745         ? (authtoken => $auth, xact => 1)
1746         : (xact => 1)
1747     );
1748     return $e->event unless $disable_auth || $e->checkauth;
1749
1750     my $targets = $e->batch_retrieve_asset_call_number($target_ids);
1751
1752     $e->rollback; # FIXME using transaction because of pgpool + logical replication
1753                   # setups where statements in an explicit transaction are sent to
1754                   # the primary database in the replica set, but not
1755                   # simply making this method authoritative because of weirdness
1756                   # with transaction handling in A/T code that causes rollback
1757                   # failure down the line if handling many targets
1758
1759     return undef unless @$targets;
1760     return $U->fire_object_event(
1761         undef,                    # event_def
1762         'acn.format.sms_text',    # hook
1763         $targets,
1764         $org_id,
1765         undef,                    # granularity
1766         {                         # user_data
1767             sms_carrier => $carrier,
1768             sms_notify => $number
1769         }
1770     );
1771 }
1772
1773
1774
1775 __PACKAGE__->register_method(
1776     method    => "fixed_field_values_by_rec_type",
1777     api_name  => "open-ils.cat.biblio.fixed_field_values.by_rec_type",
1778     argc      => 2,
1779     signature => {
1780         desc   => 'Given a record type (as in cmfpm.rec_type), return fixed fields and their possible values as known to the DB',
1781         params => [
1782             {desc => 'Record Type', type => 'string'},
1783             {desc => '(Optional) Fixed field', type => 'string'},
1784         ]
1785     },
1786     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' }
1787 );
1788
1789
1790 sub fixed_field_values_by_rec_type {
1791     my ($self, $conn, $rec_type, $fixed_field) = @_;
1792
1793     my $e = new_editor;
1794     my $values = $e->json_query({
1795         select => {
1796             crad  => ["fixed_field"],
1797             ccvm  => [qw/code value/],
1798             cmfpm => [qw/length default_val/],
1799         },
1800         distinct => 1,
1801         from => {
1802             ccvm => {
1803                 crad => {
1804                     join => {
1805                         cmfpm => {
1806                             fkey => "fixed_field",
1807                             field => "fixed_field"
1808                         }
1809                     }
1810                 }
1811             }
1812         },
1813         where => {
1814             "+cmfpm" => {rec_type => $rec_type},
1815             defined $fixed_field ?
1816                 ("+crad" => {fixed_field => $fixed_field}) : ()
1817         },
1818         order_by => [
1819             {class => "crad", field => "fixed_field"},
1820             {class => "ccvm", field => "code"}
1821         ]
1822     }) or return $e->die_event;
1823
1824     my $result = {};
1825     for my $row (@$values) {
1826         $result->{$row->{fixed_field}} ||= [];
1827         push @{$result->{$row->{fixed_field}}}, [@$row{qw/code value length default_val/}];
1828     }
1829
1830     return $result;
1831 }
1832
1833 __PACKAGE__->register_method(
1834     method    => "retrieve_tag_table",
1835     api_name  => "open-ils.cat.tag_table.all.retrieve.local",
1836     stream    => 1,
1837     argc      => 3,
1838     signature => {
1839         desc   => "Retrieve set of MARC tags, subfields, and indicator values for the user's OU",
1840         params => [
1841             {desc => 'Authtoken', type => 'string'},
1842             {desc => 'MARC Format', type => 'string'},
1843             {desc => 'MARC Record Type', type => 'string'},
1844         ]
1845     },
1846     return => {desc => 'Structure representing the tag table available to that user', type => 'object' }
1847 );
1848 __PACKAGE__->register_method(
1849     method    => "retrieve_tag_table",
1850     api_name  => "open-ils.cat.tag_table.all.retrieve.stock",
1851     stream    => 1,
1852     argc      => 3,
1853     signature => {
1854         desc   => 'Retrieve set of MARC tags, subfields, and indicator values for stock MARC standard',
1855         params => [
1856             {desc => 'Authtoken', type => 'string'},
1857             {desc => 'MARC Format', type => 'string'},
1858             {desc => 'MARC Record Type', type => 'string'},
1859         ]
1860     },
1861     return => {desc => 'Structure representing the stock tag table', type => 'object' }
1862 );
1863 __PACKAGE__->register_method(
1864     method    => "retrieve_tag_table",
1865     api_name  => "open-ils.cat.tag_table.field_list.retrieve.local",
1866     stream    => 1,
1867     argc      => 3,
1868     signature => {
1869         desc   => "Retrieve set of MARC tags for available to the user's OU",
1870         params => [
1871             {desc => 'Authtoken', type => 'string'},
1872             {desc => 'MARC Format', type => 'string'},
1873             {desc => 'MARC Record Type', type => 'string'},
1874         ]
1875     },
1876     return => {desc => 'Structure representing the tags available to that user', type => 'object' }
1877 );
1878 __PACKAGE__->register_method(
1879     method    => "retrieve_tag_table",
1880     api_name  => "open-ils.cat.tag_table.field_list.retrieve.stock",
1881     stream    => 1,
1882     argc      => 3,
1883     signature => {
1884         desc   => 'Retrieve set of MARC tags for stock MARC standard',
1885         params => [
1886             {desc => 'Authtoken', type => 'string'},
1887             {desc => 'MARC Format', type => 'string'},
1888             {desc => 'MARC Record Type', type => 'string'},
1889         ]
1890     },
1891     return => {desc => 'Structure representing the stock MARC tags', type => 'object' }
1892 );
1893
1894 sub retrieve_tag_table {
1895     my( $self, $conn, $auth, $marc_format, $marc_record_type ) = @_;
1896     my $e = new_editor( authtoken=>$auth, xact=>1 );
1897     return $e->die_event unless $e->checkauth;
1898
1899     my $field_list_only = ($self->api_name =~ /\.field_list\./) ? 1 : 0;
1900     my $context_ou;
1901     if ($self->api_name =~ /\.local$/) {
1902         $context_ou = $e->requestor->ws_ou;
1903     }
1904
1905     my %sf_by_tag;
1906     unless ($field_list_only) {
1907         my $subfields = $e->json_query(
1908             { from => [ 'config.ou_marc_subfields', 1, $marc_record_type, $context_ou ] }
1909         );
1910         foreach my $sf (@$subfields) {
1911             my $sf_data = {
1912                 code        => $sf->{code},
1913                 description => $sf->{description},
1914                 mandatory   => $sf->{mandatory},
1915                 repeatable   => $sf->{repeatable},
1916             };
1917             if ($sf->{value_ctype}) {
1918                 $sf_data->{value_list} = $e->json_query({
1919                     select => { ccvm => [
1920                                             'code',
1921                                             { column => 'value', alias => 'description' }
1922                                         ]
1923                               },
1924                     from   => 'ccvm',
1925                     where  => { ctype => $sf->{value_ctype} },
1926                     order_by => { ccvm => { code => {} } },
1927                 });
1928             }
1929             push @{ $sf_by_tag{$sf->{tag}} }, $sf_data;
1930         }
1931     }
1932
1933     my $fields = $e->json_query(
1934         { from => [ 'config.ou_marc_fields', 1, $marc_record_type, $context_ou ] }
1935     );
1936
1937     foreach my $field (@$fields) {
1938         next if $field->{hidden} eq 't';
1939         unless ($field_list_only) {
1940             my $tag = $field->{tag};
1941             if ($tag ge '010') {
1942                 for my $pos (1..2) {
1943                     my $ind_ccvm_key = "${marc_format}_${marc_record_type}_${tag}_ind_${pos}";
1944                     my $indvals = $e->json_query({
1945                         select => { ccvm => [
1946                                                 'code',
1947                                                 { column => 'value', alias => 'description' }
1948                                             ]
1949                                   },
1950                         from   => 'ccvm',
1951                         where  => { ctype => $ind_ccvm_key }
1952                     });
1953                     next unless defined($indvals);
1954                     $field->{"ind$pos"} = $indvals;
1955                 }
1956                 $field->{subfields} = exists($sf_by_tag{$tag}) ? $sf_by_tag{$tag} : [];
1957             }
1958         }
1959         $conn->respond($field);
1960     }
1961 }
1962
1963 __PACKAGE__->register_method(
1964     method    => "volcopy_data",
1965     api_name  => "open-ils.cat.volcopy.data",
1966     stream    => 1,
1967     argc      => 3,
1968     signature => {
1969         desc   => q|Returns a batch of org-scoped data types needed by the
1970             volume/copy editor|,
1971         params => [
1972             {desc => 'Authtoken', type => 'string'}
1973         ]
1974     },
1975     return => {desc => 'Stream of various object type lists', type => 'array'}
1976 );
1977
1978 sub volcopy_data {
1979     my ($self, $client, $auth) = @_;
1980     my $e = new_editor(authtoken => $auth);
1981
1982     $e->checkauth or return $e->event;
1983     my $org_ids = $U->get_org_ancestors($e->requestor->ws_ou);
1984
1985     $client->respond({
1986         acp_location => $e->search_asset_copy_location([
1987             {deleted => 'f', owning_lib => $org_ids},
1988             {order_by => {acpl => 'name'}}
1989         ])
1990     });
1991
1992     # Provide a reasonable default copy location.  Typically "Stacks"
1993     $client->respond({
1994         acp_default_location => $e->search_asset_copy_location([
1995             {deleted => 'f', owning_lib => $org_ids},
1996             {order_by => {acpl => 'id'}, limit => 1}
1997         ])->[0]
1998     });
1999
2000     $client->respond({
2001         acp_status => $e->search_config_copy_status([
2002             {id => {'!=' => undef}},
2003             {order_by => {ccs => 'name'}}
2004         ])
2005     });
2006
2007     $client->respond({
2008         acp_age_protect => $e->search_config_rules_age_hold_protect([
2009             {id => {'!=' => undef}},
2010             {order_by => {crahp => 'name'}}
2011         ])
2012     });
2013
2014     $client->respond({
2015         acp_floating_group => $e->search_config_floating_group([
2016             {id => {'!=' => undef}},
2017             {order_by => {cfg => 'name'}}
2018         ])
2019     });
2020
2021     $client->respond({
2022         acp_circ_modifier => $e->search_config_circ_modifier([
2023             {code => {'!=' => undef}},
2024             {order_by => {ccm => 'name'}}
2025         ])
2026     });
2027
2028     $client->respond({
2029         acp_item_type_map => $e->search_config_item_type_map([
2030             {code => {'!=' => undef}},
2031             {order_by => {ccm => 'value'}}
2032         ])
2033     });
2034
2035     $client->respond({
2036         acn_class => $e->search_asset_call_number_class([
2037             {id => {'!=' => undef}},
2038             {order_by => {acnc => 'name'}}
2039         ])
2040     });
2041
2042     $client->respond({
2043         acn_prefix => $e->search_asset_call_number_prefix([
2044             {owning_lib => $org_ids},
2045             {order_by => {acnp => 'label_sortkey'}}
2046         ])
2047     });
2048
2049     $client->respond({
2050         acn_suffix => $e->search_asset_call_number_suffix([
2051             {owning_lib => $org_ids},
2052             {order_by => {acns => 'label_sortkey'}}
2053         ])
2054     });
2055
2056     # Some object types require more complex sorting, etc.
2057
2058     my $cats = $e->search_asset_stat_cat([
2059         {owner => $org_ids},
2060         {   flesh => 2,
2061             flesh_fields => {asc => ['owner', 'entries'], aou => ['ou_type']}
2062         }
2063     ]);
2064
2065     # Sort stat cats by depth then by name within each depth group.
2066     $cats = [
2067         sort {
2068             my $d1 = $a->owner->ou_type->depth;
2069             my $d2 = $b->owner->ou_type->depth;
2070             return $a->name cmp $b->name if $d1 == $d2;
2071
2072             # Sort cats closer to the workstation org unit to the front.
2073             return $d1 > $d2 ? -1 : 1;
2074         }
2075         @$cats
2076     ];
2077
2078     for my $cat (@$cats) {
2079         # de-flesh org data
2080         $cat->owner($cat->owner->id);
2081
2082         # sort entries
2083         $cat->entries([sort {$a->value cmp $b->value} @{$cat->entries}]);
2084     }
2085
2086     $client->respond({acp_stat_cat => $cats});
2087
2088     return undef;
2089 }
2090
2091 __PACKAGE__->register_method(
2092     method    => "update_copy_barcode",
2093     api_name  => "open-ils.cat.update_copy_barcode",
2094     argc      => 3,
2095     signature => {
2096         desc   => q|Updates the barcode for a item, checking for either the UPDATE_COPY permission or the UPDATE_COPY_BARCODE permission.|,
2097         params => [
2098             {desc => 'Authtoken', type => 'string'},
2099             {desc => 'Copy ID', type => 'number'},
2100             {desc => 'New Barcode', type => 'string'}
2101         ]
2102     },
2103     return => {desc => 'Returns the copy ID if successful, an ILS event otherwise.', type => 'string'}
2104 );
2105
2106 sub update_copy_barcode {
2107     my ($self, $client, $auth, $copy_id, $barcode) = @_;
2108     my $e = new_editor(authtoken => $auth, xact => 1);
2109
2110     $e->checkauth or return $e->event;
2111
2112     my $copy = $e->retrieve_asset_copy($copy_id)
2113         or return $e->event;
2114
2115     # make sure there is no undeleted copy (including the same one?) with the same barcode
2116     my $existing = $e->search_asset_copy({barcode => $barcode, deleted => 'f'}, {idlist=>1});
2117     return OpenILS::Event->new('ITEM_BARCODE_EXISTS') if @$existing;
2118
2119     # if both of these perm checks fail, we'll report it for UPDATE_COPY_BARCODE as it is more specific
2120     return $e->event unless $e->allowed('UPDATE_COPY', $copy->circ_lib) || $e->allowed('UPDATE_COPY_BARCODE', $copy->circ_lib);
2121
2122     $copy->barcode( $barcode );
2123
2124     $e->update_asset_copy( $copy ) or return $e->event;
2125     $e->commit or return $e->event;
2126
2127     return $copy->id;
2128 }
2129
2130 1;
2131
2132 # vi:et:ts=4:sw=4